'''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 * retranslate the new Version '''1.2''' to the english language ################################################################################### # Modul : execx.tcl # # Stand : 21.10.2005 # # Zweck : Erweiterter Exec-Befehl, um .EXE-Programme direkt aus Starkits/- # # packs heraus ausführen zu können. Dazu wird das Programm an eine # # temporäre Position kopiert, bevor EXEC gerufen wird. # # Autor : M.Hoffmann # # Historie : 1.0 21.10.2003: Urversion # # : 1.0 05.08.2004: Review Urversion (list $progCallNew) # # : 1.1 09.08.2004: execx::setforce execx::settrace # # : 1.2 21.10.2005: Handling für &-Prozesse geändert; running geändert; # # Uplevel statt eval. # # Weiteres : # ################################################################################### package provide execx 1.2 namespace eval execx { variable running variable exectrace 0 variable force 0 } proc execx::setforce {setting} { # später Abfrage mit -1, altes Setting zurückliefern set execx::force $setting } #---------------------------------------------------------------------------------- proc execx::settrace {setting} { # später Abfrage mit -1, altes Setting zurückliefern set execx::exectrace $setting } #---------------------------------------------------------------------------------- #---------------------------------------------------------------------------------- # args - Parameter genau wie für Originalexec-Befehl # Rückgabe: wie Originalbefehl # Sofern ein Programm nicht im Hintergrund gestartet wird, wird eine evtl. # temporäre Kopie wieder gelöscht; ansonsten wird ein Namespacearray mit dem # Programmnamen gefüllt. # proc execx::execx1 {args} { variable running set progIdx -1 set force -1 foreach a $args { incr progIdx if {$a != "-keepnewline" && $a != "--"} { break; } } set progCallOrg [lindex $args $progIdx] set progCallTst {} set progCallNew {} if {!$::execx::force} { # nach Originalprogramm suchen set progCallTst [auto_execok $progCallOrg] } if {[string equal $progCallTst ""]} { # auführbare Datei nicht auffindbar oder -force; also aus Starpack-Dir # vfs/TOOLS in Tempverzeichnis kopieren (sofern Src/Desk vorhanden...) set toolDir [file join [file dirname [info script]] .. tools] set progName [file tail $progCallOrg] set progCallNew [file join $::env(temp) $progName]; # Problem möglich, wenn %temp% fehlt! catch {file copy -force -- [file join $toolDir $progName] $progCallNew} lset args $progIdx [list $progCallNew]; # 5.8.2004: list } if {$execx::exectrace} { puts -nonewline {>>> } puts $args } catch {uplevel exec $args} rc # TempProgramm löschen, sofern es nicht im Hintergrund läuft # Ansonsten den Namen für späteres Löschen in execx::running(PID) sichern # für späteres Löschen if {[lindex $args end] != "&"} { # Programm lief im Vordergrund if {$progCallNew != ""} { # und war aus VFS einkopiert -> Beseitigen catch {file delete -force -- $progCallNew} } } else { # Programm läuft noch im Hintergrund -> # als Hilfe für späteres Löschen durch MainProg Aufruf sicherstellen set running($rc) $args } return $rc; # PID oder Ergebnis zurückgeben } #================================================================================== '''Testroutine''' ################################################################################### # Modul : execxtest.tcl # # Stand : 09.08.2004, 21.10.2005 # # Zweck : Tests des Pakets execx (nur syntaktisch, da kein VFS vorhanden) # ################################################################################### lappend auto_path ./ package require execx 1.2 execx::settrace 1 # Achtung: ^& angeben, um Interpretation durch CMD.EXE zu vermeiden! puts Start # Achtung: mit '&' CONSOL-Programme bleiben hängen, weil Fordergrundprogramm # schon geendet hat. Solche lieber mittels BgExec starten! puts [eval execx::execx1 $argv]; # bei Aufruf von CMD `eval` erforderlich!! puts Ende catch {parray ::execx::running} if {[lindex $argv end] == "&"} { puts "Wenn Programm beendet, Strg+C drücken...." vwait forever } #================================================================================== '''Examples''' tclsh execxtest.tcl msgbox test tclsh execxtest.tcl msgbox test ^& Yes, you need a standard '''pkgIndex.tcl'''-file which is not included here. There are some diffuculties starting ''Consol-mode''-programs in the background with this method, because when execx has finished launching such kind of progs and finishes itself immediately, the exec'd program looses its console-connection, it seems. Not shure yet what happens in detail - but one have to press a key then to terminate the whole thing. That's why I included a '''vwait forever''' in the test routine. For such programs, it is better to launch them in the background with this tool: * [Matthias Hoffmann - Tcl-Code-Snippets - Misc - Bgexec] - Launching cmdlineprograms in the background, catching there stdout and stderr via eventloop, don't blocking the mainprog ---- '''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]