Calling arbitrary commandline tools via cgi, showing output as html-page
Example
Showing the system-log-events happened the last 24 hours from server:
http://host/cgi-bin/prog/cgiframe.tcl?exec=eldump.exe -s server -l system -l -M -L -A 24 -Q
Attention!
set cgiframe_version 0.11 #=============================================================================== # Packages #=============================================================================== # Achtung: Nicht-Standard-Paket bgexec erforderlich! if {[catch {package require ncgi package require html package require bgexec} rc]} { # absoluter Notausstieg - keine CGI-Header! puts "Content-Type: text/plain\n\nFehler `$rc` - Abbruch!" exit 1 } #=============================================================================== # Unterprozeduren #=============================================================================== proc progSpec path { # Pfadangabe IMMER als relativ zu CGI-BIN betrachten, Dirs aber erlauben! # 0.08: möglicherweise kommt Drivespec nicht zuerst; da aber bei file join # die zuletzt angegebene DriveSpec 'gewinnt' (wenn sie am Anfang steht), # wäre durch ../../d:/.. die Prüfung kompromittierbar! daher schon am # Anfang mögliche ./\\ wegnehmen! # Erweiterung v0.11: Dateianzeigen intern handeln (Dateieinbindung aus Wiki) if {[lindex $path 0] == "-list"} { return $path } # Erweiterung Ende set path [string trimleft $path {./\\}] if {[string range $path 1 1] == ":"} { set path [string replace $path 0 1] } set path [string trimleft $path {./\\}] # Fehler (bis v0.04): durch Folgendes wird ein Backslash auch in den # KommandoPARAMETERN in einen Slash umgesetzt!! #set path [file join [pwd] $path]; # Voraussetzung: PWD liefert CGI-BIN! set path "[file join [pwd] [lindex $path 0]] [lrange $path 1 end]" # ggf. hier Fehler melden! set prog [lindex $path 0] if {![file isfile $prog] || ![file executable $prog]} { abort Die Datei<br><b>$prog</b><br> existiert nicht oder ist nicht \ ausführbar oder kein Programm! } return $path } #------------------------------------------------------------------------------- proc header {} { # CGI- und HTML-Header # Möglichen Aufruf von der Kommandozeile zu Debuggingzwecken berücksichtigen if {[info exists ::env(REQUEST_URI)]} { ncgi::reset ncgi::parse ncgi::header ; # schon hier, falls Fehlermeldungen früh generiert werden! } # CSS hier einfügen oder einbinden ::html::headTag {style type="text/css"> <!-- --> </style} puts [html::head [ncgi::value title]] puts [html::bodyTag] set ::cgiframe_filter [ncgi::value filter] set ::cgiframe_timeout [ncgi::value timeout] if {![string is integer $::cgiframe_timeout] || \ [string equal $::cgiframe_timeout ""]} { set ::cgiframe_timeout 1200000; # 20 Minuten * 60 Sekunden * 1000 } } #------------------------------------------------------------------------------- proc footer {} { set goback {} catch {set goback $::env(HTTP_REFERER)} if {![string equal $goback ""]} { # besser mittels JS-Button siehe hamue_user.tcl (self.location) puts "<br><div align=\"right\"><a href=\"$goback\">Zurück</a></div>" } puts "<p><hr><small>[ncgi::value title] © 2002-2005 MH, HMK,DAK \ <br> \ Diese HTML-Seite wurde generiert am \ [clock format [clock seconds] -format {%d.%m.%Y um %H:%M:%S Uhr}] \ vom Script [info script], Version $::cgiframe_version</small>" puts [html::end] } #------------------------------------------------------------------------------- proc abort {args} { puts "<p><table align=\"center\" bgcolor=\"silver\" border=\"3\" width=\"50%\" \ cellpadding=\"5\" frame=\"box\" height=\"30%\"> <tr> <th align=\"left\" height=\"10%\">Fehler:</th> </tr> <tr> <td align=\"left\" valign=\"top\">[join $args]</td> </tr> <tr> <td align=\"right\" height=\"10%\">(Das Skript wurde vorzeitig beendet)</th> </tr> </table><p>" footer exit 1 } #------------------------------------------------------------------------------- proc outLine data { # später hier alles wunderschön als Tabelle formatieren... # oder nur wechselnde Hintergründe je Zeile # evtl. sollte PID hier zV stehen (für gemischte Ausgaben versch. Procs) if {[string equal $::cgiframe_filter ""] || \ [string match -nocase $::cgiframe_filter $data]} { incr ::lineCount # puts [encoding convertfrom cp437 $data]; # bis v0.6 puts [toggleColor [quote $data]] } } #------------------------------------------------------------------------------- proc quote data { set data [::html::quoteFormValue $data]; # einige HTML-Zchn quoten (<>...) # berücksichtig leider nicht die Umlaute und sonstige HTML-Sonderzeichen, # daher einige Sonderzeichen hier explizit behandeln (eine fertige Routine # dafür konnte ich auf die Schnelle nicht finden... - siehe aber auch # http://mini.net/tcl/13008 return [string map { ä ä Ä Ä ö ö Ö Ö ü ü Ü Ü ß ß } $data] } #------------------------------------------------------------------------------- proc toggleColor data { global lineColor if {$lineColor == "#fffacd"} { set lineColor "white" } else { set lineColor "#fffacd" } return "<span style=\"background-color:$lineColor\">$data</span>" } #=============================================================================== # Main #=============================================================================== set lineColor "#fffacd" header set exec [ncgi::value exec] set exec [progSpec $exec] # was ist mit STDERR? Offenbar gibt der tclhttpd stderr standardmässig zurück... fconfigure stdout -buffering line -blocking 0 fconfigure stdin -buffering line -blocking 0 set lineCount 0 puts "Ergebnis von <b>$exec</b>" if {[string equal $::cgiframe_filter ""]} { puts ":<hr>" } else { puts " (Filter='$::cgiframe_filter'):<hr>" } puts <b><pre> ; # später Tabellenbeginn etc. # Erweiterung v0.11: Dateianzeigen intern handeln (Dateieinbindung aus Wiki) # später eleganter über bgExec integrieren! if {[lindex $exec 0] == "-list"} { if {![catch {open [lindex $exec 1] r} fh]} { while {![eof $fh]} { outLine [gets $fh] } close $fh } else { outLine "Fehler beim Lesen der Datei:\n$fh" } # Erweiterung Ende } else { set processHandle [bgExec $exec outLine pCount] fconfigure $processHandle -encoding cp437; # v0.7; entspr. BgExec-Option fehlt! # Abbruch nicht von bgExec behandeln lassen, da dort (noch) kein Process-Kill! after $::cgiframe_timeout { # set pCount 0; # eigentlich nicht nötig, da Ausstieg via Abort! # Prozess beenden: catch {exec -- [auto_execok pv.exe] -k -f -i [pid $processHandle]} rc; # Callback zurücksetzen - keine Fehler mehr ausgeben! Nützt nichts: # proc outLine data {} catch {close $processHandle} rc; # bewirkt Broken_Pipe zumindest bei Tcl- # Progs, die dadurch natürlich auch enden. Was ist mit anderen Progs? testen! puts </pre></b><p> puts "$::lineCount Zeile(n) Output" abort Abbruch durch Timeout! <p> ($rc) } vwait pCount } puts </pre></b><p> puts "$::lineCount Zeile(n) Output" footer exit 0 #*******************************************************************************
LES: Very useful contribution. But: