----
'''Calling arbitrary commandline tools via cgi, showing output as html-page'''

   * Current Version is '''0.16''' (Bugfix: ''Zurueck'' (Goback) not working after a ''Refresh'')
   * Updated to '''0.17''' (documentation, input field for filter-entry)

'''''Example'''''

Showing the system-log-events happened the last 24 hours from ''server'', displaying only events with the string ''testprog'' in it, and limit the execution time to 3 seconds:

 http://host/cgi-bin/prog/cgiframe.tcl?exec=eldump.exe -s server -l system -l -M -L -A 24 -Q&filter=*testprog*&timeout=3000

'''Attention!'''

   * Be sure to protect the directory this proc is called from (.tclaccess) to not open an unwanted security hole!
   * Move the proc in its own subdirectory; only commands ''from within these directory'' are accessible via CGIFRAME
   * Make shure that programs called via cgiframe are not dangerous by themselves; if users know how to specify commandline args to dubious programs, big trouble would be guaranteed....
   * For the '''bgexec''' module, see [Matthias Hoffmann - Tcl-Code-Snippets - Misc - Bgexec]
----
 #****h* Webserver/cgiframe.tcl
 #
 #  NAME
 #
 #     cgiframe.tcl - Rahmenprogramm zur Integration von Kommandozeilentools
 #     v0.19, 30.11.2006
 #
 #  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]
 #     .../cgi-bin/cgiframe.tcl?exec=-list filespec...
 #
 #  USES
 #
 #     Pakete tcllib/ncgi, tcllib/html, bgexec
 #
 #  NOTES
 #
 #  -- Beispielanwendungen: checkusrgrp.tcl, getprint.tcl...
 #  -- <progspec>'s immer RELATIV zum CGI-Pfad!
 #  -- ACHTUNG: -list kann Dateien AUSSERHALB DES HTTP-Roots ANSPRECHEN!!!
 #
 #  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!
 #  -- Encoding von eingefangenen STDOUT ist teilweise falsch (aufklären)
 #  -- STDERR-Capturing geht möglicherweise nicht (hängt von Tcl-Version ab)
 #
 #  TODO
 #
 #  -- Paralleles Starten (via BgExec) MEHRERER Prozesse ermöglichen!
 #  -- 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 (werden momentan
 #     ignoriert)
 #  -- 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
 #
 #  -- Umstellen auf NAMESPACE
 #  -- JavaScript-Strukturen generieren
 #  -- 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 <pre> 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
 #     v0.13 16.11.2005 - Refresh-Button
 #     v0.14 16.11.2005 - <//pre//>-Ausgabe des gerufenen Scripts bewirkt </pre>
 #                        und Ende des Quotings (damit gerufenes Script HMTL
 #                        anhängen kann!)
 #     v0.15 17.11.2005 - Angepasst für bgExec v1.5: bgExec handelt Timeouts!
 #                        Timeout-Default von 20 auf 5 Minuten verkürzt. Benutzt
 #                        PV.EXE, wenn vorhanden, als Prozesskiller. Optimierung.
 #     v0.16 18.11.2005 - "Zurück" auch nach "Refresh" korrekt (Bugfix).
 #     v0.17 12.05.2006 - Dokuupdate; Filter-Entry
 #     v0.18 14.09.2006 - Bugfix (CGI-header wurde nicht ausgegeben!)
 #     v0.19 30.11.2006 - Fehlerabfangung fehlender/leerer Parm exec; Sicher-
 #                        heitshinweis für -list. Version# beim require für
 #                        bgexec entfernt. Aufruf von Kommandozeile mit Parame-
 #                        terübergabe unterstützt. Doku modifiziert.
 #
 #  SOURCE
 #
 ################################################################################

 set cgiframe_version 0.19

 #===============================================================================
 # 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 addLinks {} {
      set ::goback [ncgi::value goback]
      if {[string equal $::goback ""]} {
         # 1. Aufruf -> versuchen, REFERER als Rückkehrziel zu setzen
         catch {set ::goback $::env(HTTP_REFERER)}
      }
      if {![string equal $::goback ""]} {
         # Handling von Rückkehr nach Refreshs!
         append ::env(REQUEST_URI) & goback = [ncgi::encode $::goback]
         # besser mittels JS-Button siehe hamue_user.tcl (self.location)
         puts "<br><div align=\"right\"><a href=\"$::env(REQUEST_URI)\">Refresh</a> <a href=\"$::goback\">Zur&uuml;ck</a></div>"
      } elseif {[info exists ::env(REQUEST_URI)]} {
         puts "<br><div align=\"right\"><a href=\"$::env(REQUEST_URI)\">Refresh</a></div>"
      }
 }

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

 proc header {} {
      # CGI- und HTML-Header
      # Möglichen Aufruf von der Kommandozeile zu Debuggingzwecken berücksichtigen
      if {![info exists ::env(REQUEST_URI)]} {
         # lokaler Aufruf!
         ncgi::reset $::argv
      } else {
         puts -nonewline [ncgi::header]; # schon hier, falls Fehlermeldungen früh generiert werden!
      }
      ncgi::parse
      # 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 300000; # 5 Minuten * 60 Sekunden * 1000
      }
      addLinks
 }

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

 proc footer {{noEnd ""}} {
      if {$::preOpen == 1} {
         puts </pre></b><p>
      } else {
         puts <p>
      }
      puts "$::lineCount Zeile(n) Output"
      addLinks
      if {$::lineCount} {
       # puts "<form name=\"frm1\" method=\"post\" action=\"[lindex [split $::env(REQUEST_URI) ?] 0]\">"
         puts "<form name=\"frm1\" method=\"post\">"
         if {[info exists ::env(REQUEST_URI)]} {
            puts "Filter: <input type=\"text\" name=\"filter\" size=\"40\" value=\"$::cgiframe_filter\" />"
            puts "<input type=\"submit\" name=\"Setzen\" />"
         }
         puts "<input type=\"hidden\" name=\"exec\"    value=\"[ncgi::value exec]\" />"
         puts "<input type=\"hidden\" name=\"title\"   value=\"[ncgi::value title]\" />"
         puts "<input type=\"hidden\" name=\"timeout\" value=\"$::cgiframe_timeout\" />"
         puts "<input type=\"hidden\" name=\"goback\"  value=\"$::goback\" /></form>"
      }
      puts "<p><hr><small>[ncgi::value title] &copy 2002-2006 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>"
      if {[string equal $noEnd ""]} {
         puts [html::end]
      }
 }

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

 proc abort {args} {
    footer noEnd
    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>"
    puts [html::end]
    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]} {
         # puts [encoding convertfrom cp437 $data]; # bis v0.6
         # v0.14 <pre> ist durch Ausgabe von </pre> in der Quelle abschaltbar,
         # damit Links etc. generiert werden können! (externe Steuerung!)
         # Gefahr: Darf nicht im Originaltext enthalten sein, daher ungültige
         # Syntax verwendet!
         if {[string equal $data "<//pre//>"]} {
            puts </pre></b><p>
            set ::preOpen 0
         } else {
            incr ::lineCount
            puts [toggleColor [quote $data]]
         }
      }
 }

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

 proc quote data {
      # v0.14: Formatierung nur im <pre>-Modus aktiv!
      if {$::preOpen == 0} {
         return $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 {ä &auml; Ä &Auml; ö &ouml; Ö &Ouml;
                          ü &uuml; Ü &Uuml; ß &szlig;} $data]
 }

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

 proc toggleColor data {
      global lineColor
      # v.014: nicht mehr Farbe wechseln nach </pre>
      if {$::preOpen == 0} {
         set $lineColor "white"
      } elseif {$lineColor == "#fffacd"} {
         set lineColor "white"
      } else {
         set lineColor "#fffacd"
      }
      return "<span style=\"background-color:$lineColor\">$data</span>"
 }

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

 proc timeOut PIDs {
      foreach PID $PIDs {
          # Versuchen, den wildgewordenen Prozess abzubrechen
          catch {exec -- [auto_execok pv] -k -f -i $PID} rc
          puts $rc
      }
      abort Abbruch durch Timeout! <p>
 }

 #===============================================================================
 # Main
 #===============================================================================

 set preOpen   0
 set lineCount 0
 set lineColor "#fffacd"
 header
 set exec [ncgi::value exec]
 if {[string length $exec] == 0} {
    abort Parameter <b>exec</b> oder Wert fehlt!
 }
 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
 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.
 set preOpen 1
 # Erweiterung v0.11: Dateianzeigen intern handeln (Dateieinbindung aus Wiki)
 # später eleganter über bgExec integrieren!
 if {[lindex $exec 0] == "-list"} {
    # ACHTUNG: Sicherheitslücke: es kann JEDWEDE Datei, auch AUSSERHALB DES
    # HTTPROOTS angezeigt werden! Nur Programmausführungen werden restriktiv
    # gehandhabt.
    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 $::cgiframe_timeout timeOut]
    fconfigure $processHandle -encoding cp437; # v0.7; entspr. BgExec-Option fehlt!
    vwait pCount
 }
 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? [MHo]: just created a new section in there, called ''user contributions'', and put a link there to this page...
    * Would someone please volunteer to translate the comments from German to English?

[MHo]: 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]. Here's a simple robodoc-generated doc which not use much of robodocs features, though: http://home.arcor.de/hoffenbar/prog/cgiframe.html.
----
[Category TclHttpd]