---- '''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!''' * Be sure to protect the directory this proc is called from (.tclaccess) to not open an unwanted security hole! * Move the proc in it's own subdirectory; only commands from within these directory are accessible via CGIFRAME ---- #****h* Webserver/cgiframe.tcl # # NAME # # cgiframe.tcl - Rahmenprogramm zur Integration von Kommandozeilentools # v0.12, 13.10.2005 # # AUTHOR # # M.Hoffmann, HMK, DAK # # PORTABILITY # # Siehe TCL; getestet nur Win2000/XP # # USAGE # # .../cgi-bin/cgiframe.tcl?exec=progspec[&title=title][&filter=globstyle] # [&timeout=millisecs] # # USES # # Pakete tcllib/ncgi, tcllib/html, bgexec # # NOTES # # -- Beispielanwendungen: checkusrgrp.tcl, getprint.tcl... # -- 's immer RELATIV zum CGI-Pfad! # -- Anleihen zur Ausgabeformatierung siehe LDAPBOOK, SHOWLOG1, FDF, SPF etc. # # BUGS # # -- Timeout-Abbruch führt zu 'Broken-Pipe'-Error mit unkontrolliertem Output # -- Die Parameter der GERUFENEN PROGRAMME können einen Zugriff auf ausserhalb # des CGI-BINs bewirken (indirekt), Beispiel: Describe ./ # (Sicherheitslücke!). Also: nur SICHERE Programme über CGIFRAME zV stellen! # -- Unsymmetrie oberer unterer Rand zwischen # -- Encoding von eingefangenen STDOUT ist falsch (aufklären) # -- STDERR-Capturing geht möglicherweise nicht (Windows-Bug?, siehe bgexec) # # TODO # # -- Paralleles Starten (via BgExec) MEHRERER Prozesse ermöglichen! # -- Script in wiki.tcl.tk zV stellen # -- Parameter help oder leer sollte Hilfe anzeigen # -- Wahlweise als Application-Domain-Handler in den Webserver integrieren # -- Formatierungen mittels (Inline-)CSS # -- Evtl. CGI.TCL nutzen für fortgeschrittenere Formatier-Verschachtelungen! # -- Ungültige, d.h. absolute Pfadangaben als Fehler melden! # -- Formulierung als Starkit/Starpack mit integrierten Lib's, Exec's # -- Abbruch-Button (würde aber sofortiges Verlassen des Skripts bewirken, # entspräche dem Browser-Backbutton -> heikel!) # # IDEAS # # -- Synchroner ODER asynchroner Programmstart denkbar; bei letzterem # schnellere Response, aber komplizierteres Handling (siehe NETSENDG) # Evtl. Auswahl über Parameter! # -- Autorisierung als zusätzliche Sicherheit integrieren (siehe FTPD) # -- (Event-)logging integrieren (ggf. mit Standard-Tcl-Logging-Modul) # # HISTORY # # v0.01 29.01.2004 - Arbeitsversion # v0.02 31.08.2004 - Ausgabezeilen anhand glob-style matching filterbar mit # filter=, timeout=millisekunden, geändertes Abbruch- # Handling # v0.03 01.09.2004 - Filter in der Ergebnisüberschrift ggf. anzeigen, # Versionsvariable eingeführt und im Footer angezeigt, # Aktualisierung von websrv..lib/bgexec, stdout/in # -blocking 0, Standard-Timeout 20 Minuten # v0.04 02.09.2004 - Zurückkehren-Link # v0.05 06.09.2004 - Quoting geändert: auch in Befehlsparametern wurde '\' # zu '/' (in jedem Falle '\' doppelt als '\\' angeben!) # v0.06 07.09.2004 - Bei Timeout auch Prozess mit (externem KILL) beenden # v0.07 18.10.2004 - ENCODING global einstellen, nicht bei jedem PUTS! # v0.08 21.10.2004 - Security-Bugfix # v0.09 19.01.2005 - Bugfix, Quoting (auch innerhalb 
 erforderlich!)
 #     v0.10 02.06.2005 - Color-Toggle
 #     v0.11 08.07.2005 - Rückgabe von Textdateien (für Wiki)
 #     v0.12 13.10.2005 - Rückkehren-Link auch ganz oben
 #
 #  SOURCE
 #
 ################################################################################

 set cgiframe_version 0.12

 #===============================================================================
 # 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
$prog
 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">
                       
                       
Zurück
"
      }
 }

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

 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 "
Zurück
"
      }
      puts "
[ncgi::value title] © 2002-2005 MH, HMK,DAK \
            
 \
            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"
      puts [html::end]
 }

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

 proc abort {args} {
    puts "

             

                Fehler:
             

             

                [join $args]
             

             

                (Das Skript wurde vorzeitig beendet)
             

          
"
    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://wiki.tcl.tk/13008
      return [string map {
                            ä ä
                            Ä Ä
                            ö ö
                            Ö Ö
                            ü ü
                            Ü Ü
                            ß ß
                         } $data]
 }

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

 proc toggleColor data {
      global lineColor
      if {$lineColor == "#fffacd"} {
         set lineColor "white"
      } else {
         set lineColor "#fffacd"
      }
      return "$data"
 }

 #===============================================================================
 # 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 $exec"
 if {[string equal $::cgiframe_filter ""]} {
    puts ":
"
 } else {
    puts " (Filter='$::cgiframe_filter'):
"
 }
 puts 
 ; # 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 

       puts "$::lineCount Zeile(n) Output"
       abort Abbruch durch Timeout! 
 ($rc)
    }
    vwait pCount
 }
 puts

puts "$::lineCount Zeile(n) Output" footer exit 0 #******************************************************************************* ---- [LES]: Very useful contribution. But: * Shouldn't it have been added to the [tclhttpd] page instead of having been given its own page? * Would someone please volunteer to translate the comments from German to English? MH: Just loaded up a new, modified version with some enhancements. I will translate it myself as soon as possible! The headings are in special formatting required for the '''robodoc'''-Documentation-Utility which prints out nice documentation in various formats, see [http://www.xs4all.nl/~rfsber/Robo/index.html]. Does someone know where I can umpload the html-Output from robodoc for this program (cgiframe) to? I can put some example outputs from cgiframe there, too.