Version 13 of Matthias Hoffmann - Tcl-Code-Snippets - Starkit/pack-related

Updated 2005-09-13 14:14:46

execx - EXECuting transparently out of the VFS of a starkit/starpack

The following simplifies the execution of .EXEs which are inside of a Starkits/Starpacks VFS by transparently copying them ot of the VFS to a temporary location and EXECing them from there (just as it already works from the tcl core with LOADing DLLs). I pack various external tools needed by my scripts in the VFS because it's not always clear, if the machine the script is later running on has such tools installed in the path or if the tool-versions are correct. So it's safer to deliver the tools right within the script and to make a temp copy out of the VFS and call them from there. However, the default is to use an external available tool (to save the copy step).

Todo/Notes:

  • the code just has to be more generalized, reviewed and documented, but it already works...
  • make the VFS-source-location a parameter
  • make the temporary-destination-location a parameter, at least more robust (%temp% may not exist everywhere or may not be writable...)
  • add errorhandling
  • see sourcecode for additional comments and ideas
 # execx.tcl, M.Hoffmann 2003-2004

 package provide execx 1.1

 #----------------------------------------------------------------------------------

 namespace eval execx {
      variable running     ; #
      variable exectrace 0 ; # 1: display on stdout what's going on
      variable force 0     ; # 1: force use of the VFS-internal program, (if 0, look
                           ; # first if an external program is available and use
                           ; # internal copy only, if no external found)
 }

 #----------------------------------------------------------------------------------
 # a little wrapping...
 proc execx::setforce {setting} {
      set execx::force $setting
 }
 proc execx::settrace {setting} {
      set execx::exectrace $setting
 }
 proc execx::gettemps {} {
      return [array get running]; # untested so far
 }

 #----------------------------------------------------------------------------------
 # args - same format of parameters as in the original EXEC-command (I hope...)
 # return - same as EXEC (again, I hope...)
 # remarks - if a program es executed in the background with &, the temporary copy
 #  is not removed, because at least on win32 it is locked. For this reason, to help
 #  the caller to do this later, the namespace array execx::running is populated
 #  with the names of the temporary program copies (the keys are the PIDs)
 #
 proc execx::execx1 {args} {
      variable running
      set progIdx -1
      set force   -1
      # locate the programspec in the exec-cmd
      foreach a $args {
              incr progIdx
              if {$a != "-keepnewline" && $a != "--"} {
                 break;
              }
      }
      set progCallOrg [lindex $args $progIdx]
      set progCallTst {}
      set progCallNew {}
      if {!$::execx::force} {
         # search for external callable program
         set progCallTst [auto_execok $progCallOrg]
      }
      if {[string equal $progCallTst ""]} {
         # no external program available, or 'force' specified
         # I alway use the tools-Subdirectory in my starpacks for standaloneprograms:
         set toolDir     [file join [file dirname [info script]] .. tools]
         set progName    [file tail $progCallOrg]
         set progCallNew [file join $::env(temp) $progName]; # critical, see notes
         catch {file copy -force -- [file join $toolDir $progName] $progCallNew}; # missing error-return...
         lset args $progIdx [list $progCallNew]
      }
      if {$execx::exectrace} {
         puts -nonewline {>>> }
         puts $args
      }
      catch {eval exec $args} rc; # Question: is UPLEVEL more suitable?????
      if {$progCallNew != ""} {
         if {[lindex $args end] != "&"} {
            # on can add an switch for -nodeltemp, if required
            catch {file delete -force -- $progCallNew}
         } else {
            # see notes
            set running($rc) $progCallNew
         }
      }
      return $rc
 }

Starpacks: How and why to copy the own executable and launching the copied instance

The Problem
Executables, like starpacks, are often called from network shares from many users. So the chance is good, that someone always has one instance of a specific program running. Now the administration wants to update that program. But this is not possible (at least) under MS-Windows, because each executable on disk, which has running instances active, is locked.
The Solution
Each user has to launch his own version of the program. But this must not lead to an distribution overhead: the program is still distributed only once to the network share, then each calling instance copies itself to a temporary position and runs from there. The main executable is only locked a short time, so it remains in a state where it can be overwritten for update purposes. Ideally, the per-user-copy of the program is stored in an temporary location which is periodically freed, so the harddisk will not be cluttered.
Problems
I've discovered (anyone out there who can acknowledge this?) that a starpack cannot copy itself with tcl commands like file copy or a open/read/put/close-sequence. Maybe it has something to do with the underlaying VFS-Implementation... one must use an external copy/xcopy etc. instead.

Put the following sequence at the top of your starpack script:

 set myself [info nameofexecutable]
 set mytemp [file join $::env(temp) [file tail $myself]]
 if {[string compare -nocase $myself $mytemp]} {
    set mytempP $::env(temp)
    if {[catch {exec -- [auto_execok xcopy] [file nativename $myself] [file nativename $mytempP] /Y} rc]} {
       tk_messageBox -type ok -title Fehler:\
          -message "Copy failed:\n\n$rc\n" -icon error
       exit 253
    }
    if {[catch {eval exec -- $mytemp $argv &} rc]} {
       tk_messageBox -type ok -title Fehler:\
          -message "Exec failed:\n\n$rc\n" -icon error
       exit 252
    }
    exit 0
 }   

Category Tclkit