To support the execution of wikit.kit via CGI under tclhttpd on windows, I've written a little wrapper script
(Yes, sometimes it is required or simply better or faster to not use tcl... but only in very rare cases....)
This PowerBASIC-program addresses some difficulties under windows to get things running, and does the following:
The programcode is as follows and not yet translated to the english language. To compile it, you need to buy the PB/CC-Compiler from www.powerbasic.com :-(, but if anyone is interested, I'll compile a general usable, much more documented version and post it to my personal homepage with a link to it here...
'*******************************************************************************
'* wikiwrap<x>.bas 1.40 - Aufrufschale für TCLKIT/WIKIT für WebSrv M.Hoffmann *
'* Compiler: PB/CC 3.0x, 4.x *
'*******************************************************************************
'* Stand: 27.09.2002 - 1.0: erste Version *
'* 09.04.2003 - 1.1: Autentifizierung anhand REMOTE_USER; *
'* DBName anhand EXE-Name! *
'* 14.07.2003 - 1.2: Auch tclkit-win32-sh.exe als Prognamen versuchen; *
'* #option version 5; Systemfehler melden.- *
'* 16.02.2005 - 1.3: Autenti anhand Namenstabelle, nicht IP-Tabelle; *
'* 21.02.2005 - 1.34: WinXP registriert nicht alle NetBIOS-Namen!! Fuer *
'* solche Faelle den Computernamen verwenden! *
'* 09.03.2005 - 1.35: Falls NBTSTAT gar nicht geht (XP@home), IP-Addr *
'* wieder zur Autenti heranziehen. *
'* 14.02.2006 - 1.40: Einträge in .auth-File können DOS-Wildcards * ? *
'* beinhalten. Ohne win32api.inc. %dbg-Flag. *
'* ACHTUNG: SHELL (handles,...) erforderlich wg. *
'* vermuteter Inkompatibilität PB/CC 3.x/4.x, siehe *
'* http://www.powerbasic.com/support/forums/Forum5/HTML/003302.html *
'*******************************************************************************
'*******************************************************************************
'* Compiler-Optionen *
'*******************************************************************************
#compiler pbcc
#console on ' wegen Hilfeanzeige, sonst eigentlich OFF
#compile exe ' Standard
#debug error off ' keine erweiterten Fehlerpruefungen
#dim all ' Alle Variablen deklarieren
#option version5 ' => W2k
#register default ' Vorgabe
#tools off ' Kein Ballast
'*******************************************************************************
'* Konstanten *
'*******************************************************************************
%dbg = 0 ' auf -1 setzen für Durchlauf von Testroutinen, sonst 0
%ccwin = 0 ' keine GUI-Calls
$release = "1.40 14.02.2006"
'*******************************************************************************
'* Externe Module *
'*******************************************************************************
'include "win32api.inc" ' für exeName()
DECLARE FUNCTION GetModuleFileName LIB "KERNEL32.DLL" ALIAS "GetModuleFileNameA" _
(BYVAL hModule AS DWORD, lpFileName AS ASCIIZ, BYVAL nSize AS DWORD) AS DWORD
'*******************************************************************************
'* Unterprogramme *
'*******************************************************************************
'-------------------------------------------------------------------------------
' Hilfsroutine zur Bestimmung des Programmnames
'
function exeName () as string
local mfn as asciiz*256
static buf as string
local ret as long
if len(buf) = 0 then ' Caching
ret = GetModuleFileName(byval 0,mfn,sizeof(mfn)) ' statt %NULL (ohne .inc)
if ret then
buf = left$(mfn,ret)
buf = mid$(buf,instr(-1,buf,"\")+1)
buf = extract$(buf$,".")
end if
end if
function = buf
end function
'-------------------------------------------------------------------------------
' Benutzername aus IP ermitteln. Leere Rückgabe -> Fehler!
'
function userFromIP (ip as string) as string
dim tmpFile as local string
dim fh as local long
dim buf as local string
dim i as local long
dim nname as local string
dim ncode as local string
dim ntype as local string
dim pc as local string
dim usr as local string
dim dom as local string
#if %dbg
stdout "IP: " & ip
#endif
' temporäre Ausgabedatei für NBTSTAT bereitstellen
tmpFile = rtrim$(environ$("temp"),"\") & "\identusr_" & guidtxt$(guid$()) & ".$$$"
' NBTSTAT aufrufen
''''''''''' Zur Vermeidung des zeitaufwendigen Involvierens von CMD.EXE wäre
''''''''''' der interne WinEXEC-Befehl (siehe CMDAUTHD.EXE) anzuwenden, jedoch
''''''''''' inkl. interner Ausgabeumleitung (wie das geht, ist noch nicht ganz
''''''''''' klar; - dies wäre allgemeingültig zu lösen: Entwicklung in Richtung
''''''''''' des TCL-EXEC-Befehls...)
shell environ$("COMSPEC") & " /C nbtstat -A " & ip & ">" & tmpFile
if err then
exit function
end if
' Nun diese Datei PARSEN (natürlich - so einfach wie in TCL ist's sicher nicht...)
fh = freefile
open tmpFile for input access read lock shared as #fh
while not eof(fh)
line input #fh,buf
regexpr "^.+<..> +(UNIQUE)|(GROUP).+$" in buf to i
if i then
' Schwachsinn: jedes Vorkommen von 'Delim' wird als EINZELNER Sep gewertet...
' Es sind also einige Vorausmaßnahmen zu treffen...
while instr(buf," ")
replace " " with " " in buf
wend
buf = ucase$(ltrim$(buf))
nname = trim$(parse$(buf,$SPC,1))
ncode = trim$(parse$(buf,$SPC,2))
ntype = trim$(parse$(buf,$SPC,3))
if ncode = "<00>" and ntype = "UNIQUE" then
pc = nname
elseif ncode = "<00>" and ntype = "GROUP" then
dom = nname
elseif ncode = "<03>" and ntype = "UNIQUE" and len(pc) <> 0 then
' passt entweder auf pcname, pcname$ oder username
' Voraussetzung: `pc` wurde VORHER gefunden!!!
if isfalse(left$(nname,len(pc))=pc) then
usr = nname
end if
end if
end if
wend
close fh
kill tmpFile
if len(usr) then
function = usr
elseif len(pc) then ' 1.34
function = pc ' 1.34
end if
end function
'*******************************************************************************
'* Unterroutine, aus PB/DOS übernommen (! 11.05.95) und angepasst *
'* (ASC statt ASCII(MID$..., LONG statt INT, MAX& statt MAX%) *
'*******************************************************************************
function CompDW (Strg1 AS STRING, Strg2 AS STRING) as integer
' Compare/DOS Wildcards
' Vergleicht zwei Strings unter Berücksichtigung der Wildcards
' * und ? wie bei MS-DOS. Die Argumente werden in Uppercase umgewandelt.
' ACHTUNG: abc auf maske abc?? ergibt einen Match! ? am Ende werden offenbar
' ignoriert (siehe dir).
' Ergebnisse:
' 1 = Match
' 0 = Kein Match
dim a1 as local long ' ASCII-Code eines Zeichens aus s1
dim a2 as local long ' ASCII-Code eines Zeichens aus S2
dim s1 as local string ' Strg1 in UPPERCASE
dim s2 as local string ' Strg2 in UPPERCASE
dim l as local long ' Länge des längeren Strings
dim i as local long ' Zähler
' function = 0 ' Default
s1 = ucase$(Strg1) : s2 = ucase$(Strg2) : l = max&(len(s1),len(s2))
for i=1 to l
a1 = ASC(s1,i) : a2 = ASC(s2,i)
if a1 = 63 or a2 = 63 then
iterate for
elseif a1 = 42 or a2 = 42 then
exit for
elseif a1 <> a2 then
exit function
end if
next
function = 1
end function
'*******************************************************************************
'* Einsprungpunkt *
'*******************************************************************************
function pbmain ()
local path_info as string
local path_translated as string
local usrallow as string
local user as string
local ip as string
local hostname as string
local ipnum as long
local p as byte ptr
local i as long
local ua() as string
local match as long
path_translated = environ$("PATH_TRANSLATED")
path_info = environ$("PATH_INFO")
ip = environ$("REMOTE_ADDR")
#if not %dbg
if isfalse(len(path_translated) > 0 and len(ip) > 0) then
stdout exeName() & $spc & $release & " - Wrapper-Aufruf tclkit/wikit"
stdout "Dieses Programm muss als CGI-Prozess vom Webserver aufgerufen werden:"
stdout "http://xxxx/cgi-bin/.../" & exeName() & "/"
stdout "Es fuehrt dann folgende Operation aus:"
stdout "(tclkitsh-win32|tclkit-win32-sh).exe wikit.kit " & exeName() & ".tkd"
stdout "Wenn " & exeName() & ".auth-Datei vorhanden, werden nur dort genannte"
stdout "BenutzerIDs, PCNamen, IP-Adressen (ein Eintrag je Zeile) zugelassen;"
stdout "diese k”nnen die DOS-Wildcards * und/oder ? enthalten."
stdout "Um verschiedenen Wiki's anzulegen, einfach eine umbenannte Kopie dieses"
stdout "Programms aufrufen! Zur Autentifizierung wird NBTSTAT.EXE (MS) benutzt."
stdout "Ausgewertete Umgebungsvariablen: path_translated, path_info, remote_addr."
stdout "rc(1)"
function = 1
exit function
end if
path_translated = rtrim$(path_translated, path_info)
path_translated = left$(path_translated, instr(-1,path_translated,"/")-1)
' replace "/" with "\" in path_translated ' nicht notwendig, Win32 arbeitet auch mit '/'!
chdrive left$(path_translated,2)
chdir path_translated
#endif
' Neu v1.1: Autentifizierung (momentan anhand IP-Addr; siehe identusr.tcl!)
' Evtl. auch cmdauth vorschleifen; aber: Cookies erforderlich!
open exeName() & ".auth" for binary access read as #1
get$ #1,lof(1),usrallow
close #1
' Sonderfall: Benutzer und Webserver auf dem selben Rechner ->
' remote_addr erhält immer 127.0.0.1.
' Bei 127.0.0.1 ist NBTSTAT langsam und liefert ausser der tatsächlichen
' IP-Adresse nichts weiter. Um sich den Aufwand zu ersparen, gleich eine
' echte IP-Adresse liefern. ABER: Wie sieht eigentlich die Namenstabelle
' auf, wie sie der Webserver ermittelt? Der Webserver läuft ja üblicherweise
' als SERVICE, die Namenstabelle enthält dann keinen Benutzer. In diesem
' Falle bliebe nur, denn lokalen Access immer abzuweisen (was auf Servern
' vielleicht Sinn macht), oder immer zuzulassen, was beim lokalen Testen
' wiederum eleganter wäre.....
if len(usrallow) then
usrallow = ucase$(usrallow)
dim ua(1:parsecount(usrallow, $CRLF)-1)
parse usrallow,ua(),$CRLF
#if %dbg
for i=1 to ubound(ua(1))
stdout ua(i)
next
ip = "127.0.0.1"
#endif
' bei winXP@home klappt noch nicht mal dies, wenn der Netzadapter nicht aktiv
' ist (liegt wohl an fehlendem Hub).
if ip = "127.0.0.1" then
' Methode zum Ermitteln der eigenen IP-Adresse, siehe PowerBASIC-Helpfile
host name to hostname
host addr to ipnum
p = varptr(ipnum)
ip = using$("#_.#_.#_.#", @p, @p[1], @p[2], @p[3])
end if
user = userFromIP(ip) ' Offen: was kommt hier bei einem Server heraus?
' Vermutlich LEERSTRING, heisst also: Kein Access
' möglich. Bliebe als letzte Alternative noch,
' das Feld REMOTE_USER heranzuziehen, was es aber
' nur gibt, wenn eine Webserver-Autentifizierung
' überhaupt stattgefunden hat (dann auch aus CGI-Sicht?)
if len(user) = 0 then
' 09.03.05 deaktiviert:
' stdout "Content-Type: text/html"
' stdout ""
' stdout "<html>"
' stdout " <head>"
' stdout " <title>Fehler-Hinweis:</title>
' stdout " </head>"
' stdout " <body>"
' stdout " <p>"
' stdout " Der Benutzer/PC zur IP <b>" & environ$("REMOTE_ADDR") & "</b> kann nicht mittels NBTSTAT ermittelt werden,"
' stdout " der Zugriff wird daher aus Sicherheitsgründen verweigert!"
' stdout " <p>"
' stdout " </body>"
' stdout "</html>"
' function = 4 ' Historisch bedingte Nummernsprünge
' exit function
'
' 09.03.2005: Wenn auch der PCNAME nicht ermittelt werden kann, die IP-Adresse (wie früher)
' zur Autentifizierung heranziehen. Das ist keine Sicherheitslücke, da ja in der .auth-Datei
' i.d.R. solche Adressen nicht mehr enthalten sind, ermöglicht aber das Testen unter Windows/XP
' @ home.
user = ip
end if
#if %dbg
user = command$
#endif
for i=1 to ubound(ua(1))
#if %dbg
stdout "Comp " & ua(i) & "," & user
#endif
if CompDW(ua(i),user) then
match = 1
exit for
end if
next
' if isfalse(instr(usrallow,user & $CRLF)) then
if isfalse(match) then
stdout "Content-Type: text/html"
stdout ""
stdout "<html>"
stdout " <head>"
stdout " <title>Fehler-Hinweis:</title>
stdout " </head>"
stdout " <body>"
stdout " <p>"
stdout " Benutzer/PC/IP <b>" & user & "</b> ist nicht berechtigt, diese Seite aufzurufen!"
stdout " <p>"
stdout " </body>"
stdout "</html>"
function = 2
exit function
end if
end if
#if %dbg
exit function
#endif
' ////////////////////////////////////////////
' /// ACHTUNG: SHELL(handles,...) ///
' /// erforderlich, sonst empfängt ///
' /// Prozess keine POST-Daten (PB/CC 4.x) ///
' ////////////////////////////////////////////
' tclkit muss aus PATH heraus aufrufbar sein! (Performance-Aspekt; ggF.
' später Shortcut einbauen, z.B. absoluten Call-Pfad aus Datei lesen)
function = shell(handles,"tclkit-win32-sh.exe wikit.kit " & exeName() & ".tkd",0)
if errclear then
function = shell(handles,"tclkitsh-win32.exe wikit.kit " & exeName() & ".tkd",0)
if errclear then
stdout "Content-Type: text/html"
stdout ""
stdout "<html>"
stdout " <head>"
stdout " <title>System-Fehler:</title>
stdout " </head>"
stdout " <body>"
stdout " <p>"
stdout " <b>Der TCLKIT-Kommando-Interpreter ist nicht aufrufbar!</b>"
stdout " <p>"
stdout " </body>"
stdout "</html>"
function = 3
exit function
end if
end if
end function
'*******************************************************************************URLs to my wiki-web now are in the form http://host/cgi-bin/wiki/wikiwrap1.exe/ , etc.