[JOB] Another approach to solve the problem of how to execute a program (could be a .tcl script, a windws .bat or .exe) which is shipped within a starpack-vfs. * The program takes care about os dependencies (temporary directory, as well as different behaviour when executing a .tcl script). * When copying files out from a starpack's VFS, eventually existing files in the temporary files are overwritten. * The only thing what I still miss up to now is an option to force a file to be copied out, e.g. for default (sqlite-database) files. * Note: The demo section is quite poor, you really need to have a starpack and some executables within to test the package. ====== # execcmd.tcl --- # ------------------------------------------------------------------------- # Copyright (c) 2009 Johann Oberdorfer, johann.oberdorfer@gmail.com # This source file is distributed under the BSD license. # # $Id: execcmd.tcl,v0.1 2009/06/20 12:00:00 job Exp $ # ------------------------------------------------------------------------- # PURPOSE: # # execcmd - A helper package to simplify the execution of programs and # batch files which are distributed within (*)starpacks. # To execute such files, they need to be copied out from vfs into a # temporary directory beforehand. # # DESCRIPTION: # The following logic is implemented: # # - determine, if the command is: # # - a command, which is provided within the (*)starpack currently # running, and if so, # - recursively scan the starpack starting from the # vfs root or from a given entry point, within the current # starpack, specified by the argument -vfsroot # to find the rel.location # - then, copy the executable (which can be of any kind, # typically a .tcl, .sh, .bat, .exe, ...) out of the vfs # into a temporary directory on your local hard disk # - and finally, execute it from here, # - after a delay, delete the local copy again # # if no starpack / no vfs avail, fallback to: # # - an external appl. and if so, # - check with auto_execok, it is directly executeable, # - append the -exeprefix to the executable's name and try # again to evaluate execution ! # # SYNOPSIS: # # execcmd ?options? exec_command # # OPTIONS: # # -vfsroot ... vfs directory, from where to start searching to find # the specified executable # default = "", in this case, the complete vfs # starting from ::starkit::topdir is processed # -exeprefix . additional directory outside vfs which is used as prefix, # in case the executable can't be found neither in vfs nor # with auto_execok # -tempdir ... where to store a temporary copy of the executable # default = "", in this case, the "standard" dir # (os dependant) is used # -wishcmd ... for windows only and only relevant if a .tcl is to be # executed, specify your own wish binary executable # default = "", in this case, wish needs to be part of your # current PATH environment variable! # # exec_command a list, to specify system command + arguments # which is going to be executed # EXAMPLE CALL: # # use "list" to prevent from backslash substitution on windows: # # eval ::execcmd::execcmd \ # -vfsroot [list $CONFIG_DIR] \ # -exeprefix "" \ # -wishcmd "" \ # $exec_command & # # ------------------------------------------------------------------------- # Mod.History: # June 09, Johann Oberdorfer, V0.1, initial release # ------------------------------------------------------------------------- package provide execcmd 0.1 namespace eval ::execcmd:: { variable options variable tempDir variable delDelay 800 variable debug_mode 0 namespace export execcmd # valid options / default settings # -wishcmd is only required on windows array set options { -vfsroot "" -exeprefix "" -tempdir "" -wishcmd "" } } ## -- unused right now -- # a workaround for "file normalize" under windows ## proc ::execcmd::ShortName {fullPathName} { if { $::tcl_platform(platform) eq "windows" } { if { [catch {file attributes $fullPathName} attr] == 0 && [set idx [lsearch -exact attr "-shortname"]] != -1 } { return [lindex $attr [expr {$idx + 1}]] } } if {[file exists $fullPathName]} { return [file normalize $fullPathName] } return $fullPathName } ## # determine, where to store temporary files... # to-do: fileutil offers a function for temporary storage handling # -> might be a good candidate ?! ## proc ::execcmd::SetTempDir {} { switch -- $::tcl_platform(platform) { "windows" { set tempDir $::env(TEMP) } "unix" - default { set tempDir "/tmp" } } return $tempDir } ## # a helper function to remove all occurences of a # given option/value pair from an argument list, # returns the modified argument list, # and the option value is passed pack by reference in val ## proc ::execcmd::GetArgument {args keystr val} { upvar $val cvalue set cvalue "" while {[set i [lsearch -exact $args $keystr]] >= 0} { set j [expr {$i + 1}] set cvalue [lindex $args $j] set args [lreplace $args $i $j] } return $args } ## recursively search within vfs for a given file name # note: a vfs acts like a normal file system. # except file normalize doesn't seem to work... ## proc ::execcmd::VFSFileFind {searchDir fileName} { variable _dirCache variable _fileFind if { ![info exists _dirCache] } { set _dirCache {} } if { ![info exists _fileFind] } { set _fileFind "" } # return/start condition if { [file tail $fileName] == $_fileFind } { return $_fileFind } else { set _fileFind "" } # try to find file name in cache list: foreach f $_dirCache { if { [file tail $f] == $fileName } { set _fileFind $f return $_fileFind } } foreach item [glob -nocomplain -- [file join $searchDir "*"]] { # puts $item if { [file isdirectory $item] } { VFSFileFind $item $fileName continue } else { # puts "--> [file tail $item] == $fileName" # maintain cache list: if { [lsearch $_dirCache $item] == -1 } { lappend _dirCache $item } # try to find file: if { [file tail $item] == $fileName } { set _fileFind $item return $item } } } return $_fileFind } proc ::execcmd::exec_now { args rcode rc } { upvar $rcode _rcode upvar $rc _rc variable options variable debug_mode set fileExt [file extension [lindex $args 0]] if { $debug_mode } { puts \ "--> Status prior to exec: vfs Root Dir: $options(-vfsroot) Execution command: $args File extension: $fileExt " catch {console show} } switch -- $::tcl_platform(platform) { "windows" { switch -- [string tolower $fileExt] { ".tcl" { # executing script, using tcl/tk' wish.exe # prevents from backslash substitution # which otherwise might happen for WISHCMD string # which is a qualified WIN directory string like # "x:\mypath\to\command..." set _rcode [catch {eval exec [file normalize $options(-wishcmd)] $args} _rc] } ".bat" - ".exe" - default { set _rcode [catch {eval exec $args} _rc] } } } "unix" - default { set _rcode [catch {eval exec $args} _rc] } } } ## # exec command implementation # ## proc ::execcmd::execcmd {args} { variable options variable delDelay variable tmpExecName "" variable debug_mode # argument processing comes 1st: # ------------------------------ set args [GetArgument $args "-vfsroot" vfsRoot] set args [GetArgument $args "-exeprefix" exeprefix] set args [GetArgument $args "-tempdir" tempDir] set args [GetArgument $args "-wishcmd" wishcmd] if { [string length $vfsRoot] && [file isdirectory $vfsRoot] } { set options(-vfsroot) $vfsRoot } if { [string length $exeprefix] && [file isdirectory $exeprefix] } { set options(-exeprefix) $exeprefix } if { ![string length $tempDir] } { set options(-tempdir) [SetTempDir] } if { [string length $wishcmd] != "" } { set options(-wishcmd) $wishcmd } else { if { $::tcl_platform(platform) eq "windows"} { # a guess, no guarantee that it 'll work: # (has been left untested for the moment) set options(-wishcmd) [auto_execok "wish.exe"] } } if { ![string length $options(-vfsroot)] && [info exists ::starkit::topdir] && [file isdirectory $::starkit::topdir] } { set options(-vfsroot) $::starkit::topdir } # ------------------------------ set execFullPath [lindex $args 0] set execName [file tail $execFullPath] if { $debug_mode } { puts \ "--> execFullPath ... \"$execFullPath\" execName ....... \"$execName\"" } # -- if vfs is avail, then check out, # if the executable is available the vfs file system: if { [string length $options(-vfsroot)] } { # ---------------------------------------------------------- set _execFullPath [VFSFileFind $options(-vfsroot) $execName] # ---------------------------------------------------------- if { $_execFullPath != "" } { # o.k. carry on with executing the file: if { $debug_mode } { puts "--> Executable \"$execName\" is available in the vfs!" } if {[catch {file copy -force -- $_execFullPath $options(-tempdir)} rc]} { return -code error $rc } set tmpExecName [file join $options(-tempdir) [file tail $_execFullPath]] # setting the executable flag is only required on unix: if { $::tcl_platform(platform) eq "unix" && [catch {file attribute $tmpExecName -permissions +x} rc]} { return -code error $rc } set args [lreplace $args 0 0 $tmpExecName] # lset args 0 $tmpExecName exec_now $args rcode rc # cleanup: if { !$debug_mode && [string length $tmpExecName] } { after $delDelay { catch {file delete -force -- $::execcmd::tmpExecName} } } # return PID / return code ... return -code $rcode $rc } else { if { $debug_mode } { puts "--> Executable \"$execName\" is not available in the vfs!" } } } # -- determine, if the command is an external appl., # but is *not* available in the temp dir (!) # and if so, execute it directly set exeDir [file normalize [file rootname $execFullPath]] set exeDir [string range $exeDir 0 [expr {[string length $options(-tempdir)] - 1}]] if { $exeDir != $options(-tempdir) && [auto_execok $execName] != "" } { exec_now $args rcode rc return -code $rcode $rc } # -- last approach to find the executable is # to add the execprefix option (if avail.) if { [string length $options(-exeprefix)] } { set _execFullPath [file join $options(-exeprefix) $execFullPath] set args [lreplace $args 0 0 $_execFullPath] exec_now $args rcode rc return -code $rcode $rc } return -code error "execution of $args was not successful!" } # test code ... if 0 { puts "*** [::execcmd::execcmd ls -ltr] ***" # puts [::execcmd::execcmd netstat -i] set CONFIG_DIR [file join $::starkit::topdir "config"] set cmd "uname -n" # using list is to prevent from backslash substitution on windows ! eval ::execcmd::execcmd \ -vfsroot [list $CONFIG_DIR] \ -exeprefix "" \ -wishcmd "" \ $cmd & } ======