Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Erik Olson WebServer with CGI add by Don McRae

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Erik Olson WebServer with CGI add by Don McRae

    Code:
    ' Author: Erik Olson [email protected]
    ' Author: Erik Olson [email protected]
    ' for more information refer to RFC 1945
    ' Compiled with PBCC 1.0
    ' Public Domain
    ' HOW TO RUN (must have TCP/IP installed)
    ' Create a web page. Run PBHTTP from that directory. Look at the page
    ' with your browser. There it is. If you are connected to the internet,
    ' then everyone else can see it too. Use this source code to build
    ' really fast custom web applications. Read the RFC's.
    '
    ' HOW IT WORKS (because you really want to know)
    ' This program sets up a socket host and then launches a thread called
    ' LISTENTHREAD. This thread listens for connection requests on port 80
    ' (the standard web server port) and upon receiving a connection will
    ' spawn a thread to handle it. The function spawned is SOCKETTHREAD
    ' which receives one line at a time from the web browser. This initial
    ' data is the header which looks something like this:
    '
    ' GET /mypage.htm HTTP/1.0
    ' Connection: keep -Alive
    ' User-Agent: Mozilla/4.01 [en] [WinNT; I]
    ' Host: 204.96.208.229
    '
    '
    ' This is what the web browser actually sends to the web server. The initial
    ' hit will probably be an HTML page. If the page contains any references to
    ' other objects from the server (or any other server) such as .gif or .jpg
    ' images, the web browser will instantly (and simultaneously) attach concurrent
    ' connections to the server and ask for these items too.
    '
    ' The server opens the requested file and loads it into a string. It then
    ' gets the length and type of file to create a header to send back that
    ' looks like this:
    '
    ' HTTP/1.0 200 OK
    ' Server: PBHTTP 1.0
    ' Content-Type: text/html
    ' Accept-Ranges: bytes
    ' Content-Length: 3423
    '
    ' This header is followed by an exact binary image of the file (be it a web
    ' page or gif image). Throw in a little error trapping, a few bells and
    ' whistles, and there you have yourself a web server!
    '
    ' Finally, MONITORTHREAD wakes up every 10 seconds and checks to see if
    ' any threads are more than 20 seconds old (stuck). If they are, it issues a
    ' STOP command to the thread. During the next 10 second wake-up, it will
    ' see that the thread has responded to the stop command and will issue
    ' a KILL command to the thread to delete it from memory. A thread that
    ' has not been STOPped cannot be KILLed. (see the commands PS,STOP, and
    ' KILL)
    ' The main body of the program displays a command prompt and accepts
    ' commands. This command shell will be used to control the server. Right
    ' now the only commands it supports are as follows:
    ' QUIT - stops the server
    ' PS - (ProcesS) lists all active threads, run times, and modes
    ' ECHO ON, ECHO OFF, ECHO - turns on and off quiet mode, or shows mode
    ' STOP <thread> tells thread to stop
    ' KILL <thread> deletes a stopped thread from memory
    ' MON <thread> monitors the i/o on a thread's socket
    '
    ' more commands can be added to kill threads, move files, etc.
    '
    ' Web Server Features (existing, and the kind you might want):
    ' - defaults to default.htm if no page specified.
    ' - Supports html, gif, jpeg. all other types considered binary files. Browser will download them.
    ' - Error checking (some exists, and an error page is returned to the browser)
    ' - CGI (not implemented. Shell to DOS and execute an .exe, then echo back the output)
    ' - Display a directory if no default.htm exists. (not implemented)
    ' potential enhancements
    ' - Add your own html extensions for server side commands and functions, or database support
    ' (simplifies the creation of CGI scripts, speeds up server response time)
    ' - Recompile under pbdll for a graphical server interface
    ' - Use this code as the starting point for your own proxy server or BBS-internet interface
    ' (client asks server for page. this program connects to a remote server and gets the page,
    ' then echoes it back to the client.)
    '
    '
    ' LIMITATIONS
    ' supports up to 9999 concurrent threads
    ' A thread can survive for no more than 20 seconds. After that, it is
    ' terminated by the function MONITORTHREAD. 20 seconds is more than
    ' sufficient for retrieving a hypertext document or graphic.
    ' this server currently will not retrieve any objects larger than 62000 bytes.
    ' this limit is easily overcome by increasing the size of the string variable
    ' buf in SOCKETTHREAD
    ' WARNING: the logic used to calculate the age of a thread will not operate
    ' properly if the thread was created before midnight, and it exists into the
    ' new day. MONITORTHREAD will see it as a negative run time and will not
    ' terminate the thread. This will have the effect of eventually building up
    ' unterminated threads over time. These threads can be manually STOPped and
    ' KILLed using the PS, STOP, and KILL commands.
    ' All output is terminated with a Carriage-return/line feed pair. I set it up
    ' to check for what kind of line termination a client was using, and to use
    ' that kind in return, but http transmits a CRLF and wants a CRLF, so I just
    ' made it all CRLF.
    $INCLUDE "..\..\winapi\WIN32API.INC"
    $INCLUDE "..\..\winapi\WSOCK32.INC"
    %PORTNUM = 80
    DECLARE FUNCTION SocketThread ( BYVAL hsocket AS LONG ) AS LONG
    DECLARE FUNCTION ListenThread( BYVAL hsocket AS LONG ) AS LONG
    DECLARE FUNCTION MonitorThread( BYVAL hsocket AS LONG ) AS LONG
    DECLARE FUNCTION TimeFile$
    DECLARE FUNCTION CrLf$(hSocket AS LONG)
    DECLARE SUB WriteErrorPage
    DECLARE FUNCTION Process$(HTML$)
    DECLARE FUNCTION readInCgi() AS STRING
    FUNCTION PBMAIN
    DIM result AS WORD
    DIM wDat AS WSAdata
    DIM Sockin AS Sockaddr_in
    DIM s AS LONG
    DIM ns AS LONG
    DIM pid AS LONG
    GLOBAL flags AS LONG
    GLOBAL NumberOfThreads AS INTEGER
    GLOBAL BADCHARS AS STRING
    GLOBAL Quiet AS INTEGER ' if true shuts up threads from announcing status
    DIM Buf AS ASCIIZ * 512
    DIM IdThread(9999) AS GLOBAL LONG 'array to store thread handles
    DIM TimeThread(9999) AS GLOBAL LONG ' array to store start time of thread
    DIM CRLFThread(9999) AS GLOBAL BYTE ' array to store thread output characteristics
    DIM Mon AS GLOBAL INTEGER
    DIM n&
    buf$ = ""
    BADCHARS = CHR$( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26 )
    result = WsaStartup( 257, wdat )
    STDOUT "Adonsee : Web Server version 1.0 1999"
    STDOUT "Parts written by Don McRae, from original PBHTTP server by Erik Olson
    STDOUT "Added post and get for cgi
    STDOUT "Type ECHO OFF to disable display or ECHO ON to re-enable display of messages."
    STDOUT "Press Control-Break or type QUIT to terminate server."
    DIM Title AS ASCIIZ * 80
    Title = "Adonsee Web Server"
    SetConsoleTitle( Title )
    Dummy& = 0
    THREAD CREATE ListenThread( Dummy& ) TO hLISTEN&
    THREAD CREATE MonitorThread( Dummy& ) TO hMONITOR&
    SLEEP 2000 ' give threads a chance to start
    DO
    STDOUT CHR$(13,10)+"Command:"; ' display a prompt
    STDIN LINE a$ ' ...............................get input from keyboard
    Mon = 0 '...................set monitoring to 0 always after any input
    STDOUT CHR$(13,10); ' ....print a carriage return after keyboard input
    a$ = UCASE$(LTRIM$(RTRIM$(a$))) ' ................upper case the input
    IF a$ = "" THEN
    ITERATE DO '.........................go to top of loop if no input
    END IF
    IF INSTR(a$," ") > 1 THEN '...................if line has a space then
    Cmd$ = LEFT$(a$,INSTR(a$," ")-1) '.....separate out the first word
    Arg$ = MID$(a$,INSTR(a$," ")+1) '........from the rest of the line
    ELSE
    Cmd$ = a$ '...........................otherwise it's just one word
    END IF
    SELECT CASE Cmd$'...................execute the command you just typed
    CASE "STOP"
    n& = VAL("&H" + Arg$)
    IF TIMEThread(n&) = -1 THEN
    STDOUT CHR$(13,10)+"Thread is stopped"+CHR$(13,10)
    ELSEIF TIMEThread(n&) = 99999 THEN
    STDOUT CHR$(13,10)+"Thread is dying"+CHR$(13,10)
    ELSEIF TIMEThread(n&)=0 THEN
    STDOUT CHR$(13,10)+"Thread does not exist"+CHR$(13,10)
    ELSE
    TIMEThread(n&)=-1
    END IF
    CASE "KILL"
    n& = VAL("&H" + Arg$)
    IF TIMEThread(n&) = -1 THEN
    STDOUT CHR$(13,10)+"Thread still running"+CHR$(13,10)
    ELSEIF TIMEThread(n&) = 99999 THEN
    STDOUT CHR$(13,10)+"Killing thread, result =";
    THREAD CLOSE idThread(n&) TO r&
    STDOUT STR$(r&)+CHR$(13,10)
    IF r& = -1 THEN
    idThread(n&)=0
    TIMEThread(n&)=0
    CRLFThread(n&)=0
    END IF
    ELSEIF TIMEThread(n&)=0 THEN
    STDOUT CHR$(13,10)+"Thread does not exist"+CHR$(13,10)
    ELSE
    STDOUT CHR$(13,10)+"Thread has not been told to stop"+CHR$(13,10)
    END IF
    
    CASE "MON"
    Mon = VAL("&H"+Arg$) '..........................monitor this thread
    CASE "QUIT"
    EXIT SELECT
    CASE "ECHO"
    IF Arg$ = "ON" THEN '.arg$ is what comes after the first space
    Quiet = 0
    ELSEIF Arg$ = "OFF" THEN
    Quiet = -1
    ELSE
    STDOUT "ECHO IS "; '.....if no ON or OFF then show status
    IF Quiet THEN STDOUT "OFF" ELSE STDOUT "ON"
    END IF
    CASE "PS"
    sts& = 0
    THREAD STATUS hListen& TO sts&
    STDOUT "Listen Thread status " + HEX$(sts&)
    THREAD STATUS hTransmit& TO sts&
    STDOUT "Transmit Thread status " + HEX$(sts&)
    THREAD STATUS hMonitor& TO sts&
    STDOUT "Monitor Thread status " + HEX$(sts&)
    FOR y% = 1 TO 9999
    IF idThread(y%) THEN
    sts& = 0
    THREAD STATUS idThread(y%) TO sts&
    STDOUT "Thread " + HEX$(y%) ;
    STDOUT " status " + HEX$(sts&) ;
    IF TIMEThread(y%)=-1 THEN
    STDOUT " STOPPED";
    ELSEIF TIMEThread(y%) = 99999 THEN
    STDOUT " DEAD ";
    ELSE
    STDOUT " Runtime " + STR$(TIMER - timethread(y%)) ;
    END IF
    STDOUT " newline " + STR$(CRLFThread(y%))
    END IF
    NEXT y%
    CASE ELSE '........................an unknown command was entered
    STDOUT "Unknown Command - " + Cmd$ + CHR$(13,10)
    ' of course, we could shell to DOS (console) whatever command
    ' was typed (like DIR or COPY or MKDIR) and since this is a
    ' multithreaded app it would not interrupt the server. Cool.
    ' if this is NT
    ' SHELL environ$("SYSTEM_ROOT")+"\system32\cmd.exe /c " + a$
    ' else
    ' SHELL "COMMAND.COM /C pbcgi.exe > temp.htm"
    ' endif
    END SELECT
    IF Cmd$ = "QUIT" THEN
    EXIT LOOP
    END IF
    LOOP
    
    END FUNCTION ' terminates all threads
    
    FUNCTION SocketThread( BYVAL hsocket AS LONG ) AS LONG
    ' This is a distinct thread for each client
    ' this function receives data and writes it
    ' into the IN directory
    DIM Buf AS ASCIIZ * 62000
    DIM pBuf AS ASCIIZ PTR
    DIM ThisThread AS INTEGER
    DIM Finished AS INTEGER
    DIM FF AS INTEGER
    DIM FormBuf AS STRING
    DIM FormBuf2 AS STRING
    DIM b1 AS INTEGER
    Formbuf2 = ""
    b1 = 0
    
    IF NOT quiet THEN
    STDOUT CHR$(13,10) + "Thread " + HEX$(hsocket) + " Created." + CHR$(13,10)
    END IF
    cmd& = %FIONBIO
    argp& = 1
    n& = ioctlsocket( hSocket, cmd&, argp& )
    '
    IF n& = - 1 THEN
    STDOUT "IOCTL error"
    closesocket hSocket
    EXIT FUNCTION
    END IF
    DO UNTIL TIMEThread(hSocket) < 0
    
    SLEEP 1 'release CPU time
    i% = RRECV( hSocket, buf, SIZEOF( buf ), 0 )
    IF i% > 0 THEN
    a$ = LEFT$( buf, i% )
    IF INSTR( a$, CHR$( 4 )) THEN
    EXIT LOOP
    END IF
    ELSE
    a$ = ""
    END IF
    IF LEN( a$ ) > 0 THEN
    TIMEThread(hSocket) = TIMER
    ' Add input data to buffer
    a$ = REMOVE$( a$, ANY BADCHARS )
    REPLACE CHR$(13,10) WITH CHR$(13) IN a$ ' filter out crlf pairs, make them cr
    InBuffer$ = InBuffer$ + a$
    DO WHILE INSTR( InBuffer$, CHR$( 13 ))
    SLEEP 1 'release CPU time
    InBuffer$ = REMOVE$( InBuffer$, ANY BADCHARS )
    Cmd$ = LEFT$( InBuffer$, INSTR( InBuffer$, CHR$( 13 )) - 1 )
    InBuffer$ = MID$( InBuffer$, INSTR( InBuffer$, CHR$( 13 )) + 1 )
    'gets the post or get form info
    
     FormBuf = MID$(InBuffer$,INSTR(InBuffer$," ") + 1,LEN(InBuffer$) - INSTR(InBuffer$," ") - 1)
    
     FormBuf = REMOVE$( FormBuf, ANY CHR$(13))
     IF b1 = 1 THEN FormBuf2 = FormBuf
    
      IF FormBuf = "" THEN b1 = 1
     'ff = FREEFILE
     'OPEN "what3.txt" FOR OUTPUT AS #FF '..........read the page from disk into HTML$
     'write# ff, FormBuf$
     'CLOSE #ff
    
    IF NOT Quiet THEN
    STDOUT "["+Cmd$+"]"
    END IF
    
    
    '...............GET /page.htm HTTP/1.x or post or get form info
    IF LEFT$(Cmd$,4)="POST" THEN RequestM$ = "POST" 'above the path & cgi.exe
    IF LEFT$(Cmd$,4)="POST" THEN cgipath$ = MID$(Cmd$,6) '...............POST /cgi-bin/cgi.exe HTTP/1.x
    IF LEFT$(Cmd$,4)="POST" THEN cgipath$ = LEFT$(cgipath$,INSTR(cgipath$," ")-1)
    
    IF (LEFT$(Cmd$,3)="GET" OR (RequestM$ = "POST" AND LEN(FormBuf2) > 0)) THEN
    IF LEFT$(Cmd$,3)="GET" THEN RequestM$ = "GET"
    IF LEFT$(Cmd$,3)="GET" THEN cgipath1$ = MID$(Cmd$,5)
    IF LEFT$(Cmd$,3)="GET" THEN cgipath$ = LEFT$(cgipath1$,INSTR(cgipath1$,"?")-1)
    IF LEFT$(Cmd$,3)="GET" THEN QueryStr$ = TRIM$(MID$(cgipath1$,INSTR(cgipath1$,"?")+1))
    IF LEFT$(Cmd$,3)="GET" THEN QueryStr$ = TRIM$(LEFT$(QueryStr$,INSTR(QueryStr$," ")-1))
    
    
    IF INSTR(Cmd$," ") THEN
    cgipath$ = LEFT$(cgipath$,INSTR(cgipath$," ")-1)
    END IF
    cgipath$ = TRIM$(cgipath$)
    '''' STDOUT "path : " + cgipath$
    
    IF cgipath$  = "/" OR cgipath$  = "\" OR cgipath$  = "" THEN cgipath$  = "default.htm"
    REPLACE "/" WITH "\" IN cgipath$  ' ........................change unix style slashes
    IF LEFT$(cgipath$ ,1)="\" THEN cgipath$  = MID$(cgipath$ ,2) ' .............use current dir as root
    IF RIGHT$(cgipath$ ,1)="\" THEN cgipath$  = cgipath$  + "default.htm"
    ''''STDOUT "requested " + cgipath$
    ' Should actually do real http error headers here, but this is good enough
    ' if page is not found then use "error.htm" as custom error msg. Create if not exist
    IF INSTR(cgipath$ ,".")=0 THEN
    cgipath$  = cgipath$  + ".htm"
    END IF '.........................default to .htm extension (how nice!)
         'do not use fi$ = "pbcgi.exe" 'keeps getting error.htm
    IF DIR$(cgipath$) = "" THEN cgipath$ = "error.htm" : IF DIR$("error.htm")="" THEN WriteErrorPage
    ''''STDOUT "sending " + cgipath$
    'STDOUT "request by " + RequestM$
    'STDOUT "sending form data " + FormBuf$
    
    ' establish filename for data type. All files are binary files (even html files)
    ext$ = MID$(cgipath$ ,INSTR(cgipath$ ,".")+1)
    
    
    SELECT CASE LCASE$(ext$)
    CASE "htm", "html"
    Content$ = "text/html"
    QueryStr$ = ""
    CASE "jpg","jpeg"
    Content$ = "image/jpeg"
    QueryStr$ = ""
    CASE "gif"
    Content$ = "image/gif"
    QueryStr$ = ""
    CASE "exe", "com", "bat", "cgi", "cmd", "bin"
    Content$ = "text/html"' this needs to be updated for data from database with images
      ' need to shell fi$ with < stdin > stdout and echo back output
      '==============================================================
      'cgi code
    
        DIM hParentRead&
        DIM hParentWrite&
        DIM hChildRead&
        DIM hChildWrite&
        DIM hStdIn&
        DIM hStdOut&
        DIM hProcess&
        DIM hDuplicateWrite&
        DIM res&
        DIM written&
        DIM inbuf2 AS ASCIIZ * 62000 'make plenty of room for message
        DIM t$,tt$
        DIM lread2&, lavail&, lmessage&
        DIM sa AS SECURITY_ATTRIBUTES
        DIM si AS STARTUPINFO
        DIM pi AS PROCESS_INFORMATION
        'Set the SECURITY_ATTRIBUTES
        sa.nLength = LEN(SECURITY_ATTRIBUTES)
        sa.lpSecurityDescriptor = 0
        sa.bInheritHandle = 1
        'Set the STARTUPINFO
        si.cb = LEN(si)
    
    
         'if post, data to send to child through the pipe...FormBuf$
       IF RequestM$ = "POST" THEN
          inbuf2 = FormBuf$
          QueryStr$ = FormBuf$
       END IF
    
    
      'Set the environment variables for child cgi
     SetEnvironmentVariable "REQUEST_METHOD",BYCOPY RequestM$
     SetEnvironmentVariable "QUERY_STRING",BYCOPY QueryStr$
     SetEnvironmentVariable "CONTENT_LENGTH",STR$(LEN(QueryStr$))
     SetEnvironmentVariable "CONTENT_TYPE",BYCOPY Content$
    
    
         'Firstly we need to get the existing stdin / stdout handles
         'as we will need to re-assign them back to parent ( self)
        hStdIn  = GetStdHandle(%STD_INPUT_HANDLE)
        hStdOut = GetStdHandle(%STD_OUTPUT_HANDLE)
    
        'we need to create four pipe handles for reading and writing
        'at each end of the pipe.
        'Using default system buffer size, assigned 0
        res = CreatePipe(hChildRead, hParentWrite,sa,0)
        'if not succeed, tell us, then vammoose
         IF res = 0 THEN
            STDOUT "Can't create the pipe for ChildRead/ParentWrite"
            SLEEP 1000
            EXIT FUNCTION
        END IF
    
        res = CreatePipe(hParentRead, hChildWrite,sa,0)
         'if not succeed, tell us, then vammoose
         IF res = 0 THEN
            STDOUT "Can't create the pipe for ParentRead/ChildWrite"
            SLEEP 1000
            EXIT FUNCTION
        END IF
    
    
        'Set the stdin/stdout for child cgi
        CALL SetStdHandle(%STD_INPUT_HANDLE, hChildRead)
        CALL SetStdHandle(%STD_OUTPUT_HANDLE, hChildWrite)
    
        'Get current process for assigning a duplicate handle
        hProcess = GetCurrentProcess
        'Create duplicate handle for writing to pipe
        'AS parent and child cannot write to same pipe with same handle.
        CALL DuplicateHandle(hProcess,hParentWrite,hProcess,hDuplicateWrite,0,0,%DUPLICATE_SAME_ACCESS)
        'Close parent pipe handle as we no longer need it.
        CALL  CloseHandle(hParentWrite)
    
        ' The child process inherits the handles
         res = CreateProcess(BYCOPY cgipath$, "", sa, sa, 1, %NORMAL_PRIORITY_CLASS,BYVAL 0&, "", si, pi)
        IF res = 0 THEN
           STDOUT "Can't create process"
           SLEEP 1000
           EXIT FUNCTION
        END IF
    
        'Before we can write and read back child data in pipe,
        'we must assign original pipe handles back to parent.
        CALL SetStdHandle(%STD_INPUT_HANDLE,hStdIn)
        CALL SetStdHandle(%STD_OUTPUT_HANDLE,hStdOut)
    
        ' STDOUT inbuf
        'Write the data to pipe in one go.
            CALL WriteFile(hDuplicateWrite, inbuf2, LEN(inbuf2)  , written,BYVAL 0&)
    
            'we do not need DuplicateWrite handle any more, so close it
            CALL CloseHandle(hDuplicateWrite)
    
      'Wait until cgi has finished writing data to pipe,
      'allowing 5000ms for timing out child if it is taking too long to
      'process and write data to pipe..may need to change according to
      'the amount of time needed...very important
      'if recv no data, this will be the problem..lengthen wait time..
      'i.e. may need longer time for database queries.
        res =  WaitForInputIdle(pi.hProcess, %INFINITE)
           IF pi.hProcess THEN
              res =  WaitForSingleObject(pi.hProcess, 5000)
           END IF
    
        ' Make sure no left-over's if we do not get message
        inbuf2 = ""
    
       'Do we have any messages in the pipe?
        res = PeekNamedPipe(hParentRead, BYVAL 0&, 0, lread2, lavail, lmessage)
        IF res <> 0 AND lavail > 0 THEN
    
           'yes! we have a message in the pipe...comeon get it!
          CALL ReadFile(hParentRead, inbuf2, lavail, lread2,BYVAL 0&)
    
        END IF
        'we have finished
        HTML$ = inbuf2
        IF inbuf2 = "" THEN HTML$ = "error.htm" : IF DIR$("error.htm")="" THEN WriteErrorPage
    
       '   test for data received back
       '   KILL "testpipe.txt"
       '   ff = FREEFILE
       '   OPEN "testpipe.txt" FOR BINARY SHARED AS #ff
       '   PUT$ #ff,inbuf2
       '   CLOSE #ff
       '   Display output
       '   STDOUT inbuf2
    
    
        ' Always close the process handles
        CALL CloseHandle(pi.hProcess)
        CALL CloseHandle(pi.hThread)
    
        'As a precautionary measure, need to make sure
        'ALL pipe handles are closed,otherwise pipe
        'will still be alive in memory after
        'both applications have shut down.
     IF hChildWrite <> 0 THEN
            CALL CloseHandle(hChildWrite)
         '   STDOUT "CALLED CLOSE HANDLE hChildWrite"
    
        END IF
     IF hChildRead <> 0 THEN
            CALL CloseHandle(hChildRead)
         '  STDOUT "CALLED CLOSE HANDLE hChildRead"
             END IF
     IF hParentWrite <> 0 THEN
            CALL CloseHandle(hParentWrite)
         '   STDOUT "CALLED CLOSE HANDLE hParentWrite"
    
        END IF
     IF hParentRead <> 0 THEN
            CALL CloseHandle(hParentRead)
         '   STDOUT "CALLED CLOSE HANDLE hParentRead"
             END IF
       ' SLEEP 1000
     'end of cgi
     '==============================================================
    
     'test for variables
     '   ff = FREEFILE
    'OPEN "what2.txt" FOR OUTPUT AS #FF
    ' write# ff, "cgi & path : " + cgipath$ '"/cgi-bin/PBcgi.exe"
    ' write# ff, "Request method get: " + RequestM$       'POST or GET
    ' write# ff, "Query string : " + QueryStr$       'Query string
    ' write# ff, "Form query : " + FormBuf$ ' post or get form info
    ' CLOSE #ff
    ' test html
    'HTML$ = "<HTML><HEAD>" + CHR$( 13 )
    'HTML$ = HTML$ + "<TITLE> Nice Day</TITLE>" + CHR$( 13 )
    'HTML$ = HTML$ + "</HEAD><BODY>" + CHR$( 13 )
    'HTML$ = HTML$ +"<H1><CENTRE>Have a nice day!</CENTRE></H1>" + CHR$( 13 )
    'HTML$ = HTML$ + "</BODY>" + CHR$( 13 )
    'HTML$ = HTML$ + "</HTML>"
    
    'fi$ = "temp.htm" ' show output of shell cmd
    CASE ELSE
    Content$ = "application/octet-stream"
    END SELECT
    ''''STDOUT ext$ + " is " + Content$
    END IF  'end of get & post
    IF Cmd$="" THEN '.............CRLF on a line by itself indicates header is over
     IF (RequestM$ <> "POST" AND QueryStr$ = "") THEN
    ff = FREEFILE
    OPEN cgipath$ FOR BINARY SHARED AS #ff '..........read the page from disk into HTML$
    GET$ #ff, LOF(FF), HTML$
    CLOSE #ff
    END IF
    'HTML$ = Process$(HTML$) '............... Do any custom stuff to the web page
    ' ...................................... create the header for this page
    HEADER$ = "HTTP/1.0 200 OK" + CrLf$(hSocket)
    HEADER$ = HEADER$ + "Server: PBHTTP 1.0"+ CrLf$(hSocket)
    HEADER$ = HEADER$ + "Content-Type: " + Content$ + CrLf$(hSocket)
    HEADER$ = HEADER$ + "Accept-Ranges: bytes"+CrLf(hSocket)
    HEADER$ = HEADER$ + "Content-Length: " + LTRIM$(STR$(LEN(HTML$)))+ CrLf$(hSocket)
    HEADER$ = HEADER$ + CrLf$(hSocket)
    ' Show Time ! ! !
    TIMEThread(hSocket) = TIMER '...............update activity timer
    buf = HEADER$ + HTML$
    IF LEN( Buf ) > 0 THEN
    IF SSEND( hSocket, buf, LEN( HEADER$ ) + LEN( HTML$ ), flags ) = - 1 THEN
    STDOUT "Send Error on socket " + HEX$(hSocket) + CHR$(13,10)
    END IF
    IF Mon = hSocket THEN '.............monitor activity on a thread
    STDOUT Buf
    STDOUT CHR$(13,10)
    END IF
    
    END IF
    finished = -1
    EXIT LOOP
    END IF
    LOOP
    END IF
    LOOP WHILE NOT finished
    'Sleep 2000
    closesocket hSocket
    ''''STDOUT CHR$(13,10) + "Thread (" + LTRIM$( STR$( ThisThread )) + ") ended.==================="
    TIMEThread(hSocket)=99999 ' tell monitorthread to kill us
    END FUNCTION
    
    SUB Sprint ( hSocket AS LONG, Txt AS STRING )
    DIM buf AS ASCIIZ * 512
    Buf = Txt
    i% = SSEND( hSocket, Buf, LEN( Buf ),flags)
    END SUB
    FUNCTION TimeFile$
    ' create a unique file name
    ' number of seconds past midnight (to the tenth of a second)
    ' and then a random letter.
    ' 8 letters
    ' no extension
    RANDOMIZE TIMER
    FUNCTION = CHR$(INT(RND(1)*25)+65) + _
    CHR$(INT(RND(1)*25)+65) + _
    CHR$(INT(RND(1)*25)+65) + _
    CHR$(INT(RND(1)*25)+65) + _
    CHR$(INT(RND(1)*25)+65) + _
    CHR$(INT(RND(1)*25)+65) + _
    CHR$(INT(RND(1)*25)+65) + _
    CHR$(INT(RND(1)*25)+65)
    END FUNCTION
    FUNCTION CrLf$(hSocket AS LONG)
    ' can be used to select end-of-line character based on socket used
    FUNCTION = CHR$(13,10)
    END FUNCTION
    FUNCTION ListenThread( BYVAL hsocket AS LONG ) AS LONG
    ' this is a single thread that operates independantly
    ' this thread listens for client connection requests
    ' and spawns SOCKETTHREAD for each client.
    '
    DIM result AS WORD
    DIM wDat AS WSAdata
    DIM Sockin AS Sockaddr_in
    DIM s AS LONG
    DIM ns AS LONG
    DIM pid AS LONG
    DIM Buf AS ASCIIZ * 512
    DIM FF AS INTEGER
    STDOUT "Listen Thread Active" + CHR$(13,10)
    ' Create a socket
    s = socket( %PF_INET, %SOCK_STREAM, %IPPROTO_TCP )
    IF s = - 1 THEN
    STDOUT "create socket error"
    EXIT FUNCTION
    END IF
    sockin.sin_family = %AF_INET
    sockin.sin_port = htons( %PORTNUM )
    sockin.sin_addr.s = CHR$( 0, 0, 0, 0 ) '''''htonl(%INADDR_ANY)
    
    n& = bind( s, Sockin, SIZEOF( Sockin ))
    IF n& = - 1 THEN
    STDOUT "BIND Error"
    closesocket S
    wsaCleanup
    EXIT FUNCTION
    END IF
    n& = listen( s, 5 )
    IF n& = - 1 THEN
    STDOUT "LISTEN Error"
    closesocket S
    wsaCleanup
    EXIT FUNCTION
    END IF
    DO
    ns = AACCEPT( s, Sockin, SIZEOF( Sockin ))
    IF ns = - 1 THEN
    STDOUT "ACCEPT Error"
    closesocket S
    wsaCleanup
    EXIT FUNCTION
    END IF
    THREAD CREATE SocketThread( ns ) TO idthread( ns )
    timethread(ns)=TIMER
    LOOP
    ' stop winsock
    closesocket S
    wsaCleanup
    END FUNCTION
    FUNCTION MonitorThread( BYVAL hsocket AS LONG ) AS LONG
    ' every 10 seconds, check all of the threads. if any are
    ' over 60 seconds old, tell them to die. If any threads
    ' have responded to the death instruction, close them.
    SLEEP 500
    DIM R&
    DIM y%
    STDOUT "Monitor Thread Active" + CHR$(13,10)
    DO
    SLEEP 10000
    
    FOR y% = 1 TO 9999
    IF idThread(y%) THEN
    sts& = 0
    THREAD STATUS idThread(y%) TO sts&
    IF TIMEThread(y%)=-1 THEN
    ' thread has been told to die
    ELSEIF TIMEThread(y%) = 99999 THEN ' close the dead thread
    SLEEP 1000
    THREAD CLOSE idThread(y%) TO r&
    IF NOT quiet THEN
    STDOUT "Closed thread " + HEX$(y%)+" result = " + STR$(r&)
    END IF
    TIMEThread(y%)=0
    CRLFThread(y%)=0
    idThread(y%)=0
    ELSE
    IF TIMER - timethread(y%) > 15 THEN
    TIMEThread(y%) = -1
    END IF
    END IF
    END IF
    NEXT y%
    LOOP
    END FUNCTION
    SUB WriteErrorPage
    DIM ff AS INTEGER
    ff = FREEFILE
    OPEN "Error.htm" FOR OUTPUT AS #ff
    PRINT #ff, "<HTML><HEAD><TITLE>PBHTTP ERROR</TITLE></HEAD><BODY><H1>URL not found or application timed out!</H1></BODY></HTML>"
    CLOSE #ff
    END SUB
    FUNCTION Process$(HTML$)
    ' do anything to the web page that floats your boat before sending it. Invent your own
    ' server side script language, for example.
    
    
    FUNCTION = HTML$
    END FUNCTION


    ------------------

  • #2
    Have tested the above code on old Pentium 90 win95 using the
    excellent WebStress.exe Homepage: http://www.paessler.com
    obtain average 12,000 hits per hour with pbcgi.exe.
    works excellently with database connection that sends text back
    but needs to check for images that are piped back direct from database.
    e.g needs to check content type in the buffer so if image, changes
    content type to image/gif or what ever.(sending images from a
    database is too process intensive, should always store images
    in an image directory). Anyway have fun. My thoughts are
    to make it into a NTier server as well.
    Last comment, not bad for 30k size!

    ------------------

    Comment


    • #3
      This program works fine for "GET" method.
      But when I use the "POST" method on the form... I get an empty
      (blank) page as an aswer from the web server.

      (should I post this here or on the PBCC section???? )

      Any idea of to solve this?

      Regards,

      Carlos


      ------------------
      =========================
      Carlos Valencia Dongo
      Inkared.com
      [email protected]
      =========================
      =========================
      Carlos Valencia Dongo
      Inkared.com
      [email protected]
      =========================

      Comment

      Working...
      X