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:
- checks if it is been called as a cgi-process, aborting otherwise
- does a minimal authentification by checking the requestors IP-address against an auth-file (if present); if env(remote_addr) is not in this allowed-table, aborting
- constructing the .TKD-database filename from it's own name (same path, same name, but .tkd extension)
- allocating and calling an appropiate tclkit-interpreter with wikit.kit and database.tkd as arguments (note: wikit.kit should be in the same directory)
'******************************************************************************* '* 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/
![](/ext.png)
Category Wikit | Category Windows