* [Matthias Hoffmann - Other Utilities - Dirwatcher]
----

'''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)

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.
----
[Category Wikit] | [Category Windows]