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)
- 2006-11-30: 0.19: better support for offline-usage (from commandline) and doc/minor code changes. A security note: viewing files via exec=-list file can view files outside the httproot (by design)!
http://host/cgi-bin/prog/cgiframe.tcl?exec=eldump.exeAttention!-s server -l system -l -M -L -A 24 -Q&filter=*testprog*&timeout=3000
- 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ü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] © 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 {ä ä Ä Ä ö ö Ö Ö
ü ü Ü Ü ß ß} $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?
.