Tweet
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
------------------
Comment