PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Atomic Web Server Conversion (1000 threads)

https://www.purebasic.fr/english/viewtopic.php?t=36954

Page 1 of 1

Atomic Web Server Conversion (1000 threads)

Posted: Wed Apr 01, 2009 1:16 pm
by Booger
Hello all. I cobbled up the Atomic Web Server Example and turned it into a multithreaded server.

I thought I might post the code back to the community before it gets more boogered up with (cgi,isapi,post,etc) attempts. Thanks to all who post code examples. This really helps people out.

The Server Code:

Code: Select all

CompilerIf #PB_Compiler_Thread=1;Leave Here!!!!!!!! 
  IncludeFile "ServerMacros.pbi";Leave Here!!!!!!!! 
; ------------------------------------------------------------
;
;       Atomic Web Server in PureBasic by AlphaSND
;
;           (c) 2001 - Fantaisie Software
;
; ------------------------------------------------------------
;
; 25/03/2001
;   Added path relative feature. It can be started everywhere
;   Added the window to kill it easely
;
; 19/03/2001
;   Added some new features (clients closed automatically)
;
; 17/03/2001
;   First version.
;***************************************Modified by Booger***********************************
;***************************************Attempted Threading***********************************
Globals;_______________Macro_______________
NumberOfThreads = 1000;*******************Number of threads you want to run****LEAVE HERE!!**********
Structures;_______________Macro_______________
OpenConsole()
Declare ProcessRequest(ClientId)
Declare CloseConnection()
PrintN("Initializing Network Please Wait...")
If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize the network !", 0)
  End
EndIf
PrintN("Finished,  Moving on...")

Port = 80





SetUpMimeTypeStructure;Leave Here!!!!!!!!_______________Macro_______________
PrintN("Creating Servers...")
If CreateNetworkServer(0, Port) And CreateNetworkServer(1, 443)
PrintN("Servers Created !!!")
  OpenWindow(0, 0, 200, 400, 0, "Booger's HTTP Server (Port " + Str(Port) + ")" + "  HTTPS Server (Port 443)")
  PrintN("Attempting to Create Threads")
  For ScratchVariable = 1 To NumberOfThreads
    ;Debug scratchvariable
    ClientThreads(ScratchVariable)\thread = CreateThread(@ProcessRequest(), ScratchVariable)
    While ClientThreads(ScratchVariable)\thread =0
    PrintN("Unable to create Thread #"+Str(ScratchVariable)+" TRYING AGAIN")
    ClientThreads(ScratchVariable)\thread = CreateThread(@ProcessRequest(), ScratchVariable)
    Delay(20)
    Wend
  Next ScratchVariable
  PrintN("Threads Created !!!")
  Repeat
    Repeat
      WEvent = WindowEvent()
      If WEvent = #PB_Event_CloseWindow : Quit = 1 : EndIf
    Until WEvent = 0
    SEvent = NetworkServerEvent()
    If SEvent
      networkEvent = #True
      ClientID = EventClient()
      ;Debug clientid
      Select SEvent
          
        Case 1  ; When a new client has been connected...
          MessageBeep_(#MB_ICONASTERISK)
          Threadcount + 1
            If ThreadCount>NumberOfThreads
            CloseConnection()
              CloseNetworkConnection(ClientID)
              Threadcount - 1
            Else

              For ScratchVariable = 1 To NumberOfThreads
                If ClientThreads(ScratchVariable)\client = 0
                  ClientThreads(ScratchVariable)\client = ClientId
                  ClientThreads(ScratchVariable)\REMOTE_PORT=Str(GetClientPort(ClientId))
                  ClientThreads(ScratchVariable)\REMOTE_ADDR=IPString(GetClientIP(ClientId))
                    If EventServer()=0
                      ClientThreads(ScratchVariable)\SERVER_PORT=Str(80)
                    Else
                      ClientThreads(ScratchVariable)\SERVER_PORT=Str(443)
                    EndIf 
                  ;ThreadID = ScratchVariable
                ;**This code and Purebasic Create/detroy threads is very unstable after 1300 count.
                ;**So instead of create/destroy threads on fly we just track NumberOfThreads threads always running
                  ClientThreads(ScratchVariable)\thread = ScratchVariable;CreateThread(@ProcessRequest(), ClientId)
                 Break
                EndIf
              Next ScratchVariable           
          While ClientThreads(ScratchVariable)\working = 0 And ClientThreads(ScratchVariable)\Finished = 0 And ClientThreads(ScratchVariable)\client<>0: PrintN("Waiting on thread to start:" + Str(ClientThreads(ScratchVariable)\thread)) : Delay(1) : Wend; Wait till thread starts processing
          PrintN("Thread Started")
            EndIf
        Case 4  ; When a client has closed the connection...
          MessageBeep_(#MB_ICONASTERISK)
          CloseConnection()

          
      EndSelect
      
      For ScratchVariable = 1 To NumberOfThreads
        If ClientThreads(ScratchVariable)\client = ClientID
          networkevent = #False
          While ClientThreads(ScratchVariable)\working = 0  And ClientThreads(ScratchVariable)\Finished = 0 And ClientThreads(ScratchVariable)\thread<>0 : PrintN("Waiting on thread:" + Str(ClientThreads(ScratchVariable)\thread)) : Delay(1) : Wend; Wait till thread starts processing
          Break
        EndIf
      Next ScratchVariable
    EndIf
    Delay(1)
  Until Quit = 1
  
  
  CloseNetworkServer(0)
Else
  MessageRequester(AtomicTitle$, "Error: can't create the server (port in use ?).", 0)
EndIf

End

Procedure CloseConnection()
NetworkEvent=#False
          For ScratchVariable = 1 To NumberOfThreads
            If ClientThreads(ScratchVariable)\client = ClientID
              While ClientThreads(ScratchVariable)\finished = 0 And ClientThreads(ScratchVariable)\working = 1  : PrintN("Waiting on thread to finish:" + Str(ClientThreads(ScratchVariable)\thread)) : Delay(1) : Wend; Wait till thread starts processing
            
              ClientThreads(ScratchVariable)\client = 0
              ClientThreads(ScratchVariable)\working = 0
              ClientThreads(ScratchVariable)\Finished = 0
              ;KillThread(ClientThreads(ScratchVariable)\Thread)
              
              ThreadCount-1
              PrintN("Reset Thread=" + Str(ScratchVariable) + "  Threads remaining=" + Str(ThreadCount))
              Break
            EndIf
          Next ScratchVariable
          NetworkEvent=0

EndProcedure



Procedure ProcessRequest(ThreadSync)
  Protected *Buffer = AllocateMemory(8200);Alocate 8 bytes more than needed, perhaps a little safety for code errors
  ;Protected thread = ThreadID
  Protected sync = ThreadSync
  
  Repeat
    While ClientID = 0
      Delay(20)
    Wend
    If ClientId = ClientThreads(Sync)\client;  Is the request for my connection?  If yes, process it Else loop
      ClientThreads(Sync)\working = 1 : ClientThreads(Sync)\Finished = 0
      If ClientThreads(Sync)\client
      RequestLength = ReceiveNetworkData(ClientThreads(Sync)\client, *Buffer, 8192)
      EndIf
      If RequestLength>0
        
        a$ = PeekS(*Buffer, RequestLength)
 ;PrintN(a$)
 ;Debug a$
        
        If Left(a$, 3) = "GET"
          
          MaxPosition = FindString(a$, Chr(13), 5)
          Position = FindString(a$, " ", 5)
          If Position<MaxPosition
            RequestedFile$ = Mid(a$, 6, Position-5)      ; Automatically remove the leading '/'
            RequestedFile$ = RTrim(RequestedFile$)
          Else
            RequestedFile$ = Mid(a$, 6, MaxPosition-5)   ; When a command like 'GET /' is sent..
          EndIf
          
CompilerIf #PB_Compiler_OS = #PB_OS_Linux         
            If RequestedFile$ = ""
              RequestedFile$ = DefaultPage$
            EndIf
CompilerEndIf
           
CompilerIf #PB_Compiler_OS=#PB_OS_Windows
; The following routine transforme all '/' in '\' (Windows format)
          If RequestedFile$ = ""
            RequestedFile$ = DefaultPage$
          Else
            *t.tmp = @RequestedFile$
            While *t\a<>0
              If *t\a = '/'
                *t\a = '\'
              EndIf
              *t + 1
            Wend
          EndIf
CompilerEndIf
          If LCase(Right(RequestedFile$,5))="stats"
          
          SendStats;_______________Macro_______________
          BuildResponseHeader;_______________Macro_______________
          PokeS(*BufferOffSet,Http$,FileLength)
          If ClientThreads(Sync)\client
            SendFileToClient;_______________Macro_______________
          EndIf
          Else
          
          ; Test if the file exists, and if not display the error message
          result = ReadFile(#PB_Any, BaseDirectory$ + RequestedFile$)
          If result;<>0
            FileLength = Lof(result)
            
            FindFileContentType;_______________Macro_______________

            *FileBuffer = AllocateMemory(FileLength + 200)
            *BufferOffset = *FileBuffer
                        
            BuildResponseHeader;_______________Macro_______________
            
            ReadData(result, *BufferOffset, FileLength)
            CloseFile(result)
            If ClientThreads(Sync)\client
              SendFileToClient;_______________Macro_______________
            EndIf
          Else
                     
            result = ReadFile(#PB_Any, BaseDirectory$ + "AtomicWebServer_Error.html")
            If result
              FileLength = Lof(result)
              ContentType$ = "text/html"
              *FileBuffer = AllocateMemory(FileLength + 200)
              *BufferOffset = *FileBuffer
              
              BuildResponseHeader;_______________Macro_______________
              ReadData(result, *BufferOffset, FileLength)
              CloseFile(result) 
              If ClientThreads(Sync)\client            
                SendFileToClient;_______________Macro_______________
              EndIf
            EndIf
          EndIf
          EndIf
          
      ElseIf Left(a$, 4) = "POST" ;****************Start of Post Code
      
    Repeat
      in= FindString(a$,EOL$,0)
      If in
        Debug Left(a$,in-1)
      EndIf
      a$=Mid(a$,in+2,Len(a$))  
    Until in=0 
    EndIf
        EndIf
                
        While networkEvent = #True : Delay(1) : Wend
        ClientThreads(Sync)\working = 0
        ClientThreads(Sync)\Finished = 1
      EndIf

  ;EndIf

    Delay(20)
  ForEver
  

EndProcedure
 CompilerElse;Leave Here!!!!!!!! 
 CompilerError "This must be compiled in Thread Safe mode only.";Leave Here!!!!!!!! 
 CompilerEndIf;Leave Here!!!!!!!!
And the ServerMacros.pbi
This Server uses the Apache (Mime.Types) renamed to (mime.txt) file from an Apache Installation. You can find it in your apache\conf\ folder. It is required for the server to SERVE.

Code: Select all

Macro BuildResponseHeader


            Length = PokeS(*BufferOffset, "HTTP/1.1 200 OK" + EOL$) : *BufferOffset + Length
            Length = PokeS(*BufferOffset, "Date: Wed, 07 Aug 1996 11:15:43 GMT" + EOL$) : *BufferOffset + Length
            Length = PokeS(*BufferOffset, "Server: Booger's Web Server 0.1" + EOL$) : *BufferOffset + Length
            Length = PokeS(*BufferOffset, "Content-Length: " + Str(FileLength) + EOL$) : *BufferOffset + Length
            Length = PokeS(*BufferOffset, "Content-Type: " + ContentType$ + EOL$) : *BufferOffset + Length
            Length = PokeS(*BufferOffset, EOL$) : *BufferOffset + Length
            
            ; Length = PokeS(*Buffer, "Last-modified: Thu, 27 Jun 1996 16:40:50 GMT"+Chr(13)+Chr(10)  , *Buffer) : *Buffer+Length
            ; Length = PokeS(*Buffer, "Accept-Ranges: bytes"+EOL$                 , *Buffer) : *Buffer+Length
            ; Length = PokeS(*Buffer, "Connection: close"+EOL$) : *Buffer+Length
            
EndMacro
Macro FindFileContentType


            
            
            ExtensionDot = FindString(RequestedFile$, ".", 0)
            Extension$ = Mid(RequestedFile$, ExtensionDot, Len(RequestedFile$)-ExtensionDot + 1)
            
            For ScratchVariable = 0 To MimeCounter
              
              If Extension$ = MimeList(ScratchVariable)\Mime_Ext$
                ContentType$ = MimeList(ScratchVariable)\Mime_Type$
                Match = 1
                Break
              Else
                ContentType$ = "text/plain" 
              EndIf
              
            Next ScratchVariable
            Debug Extension$ + "=" + ContentType$
            
EndMacro
Macro SendFileToClient

            SendNetworkData(ClientThreads(Sync)\client, *FileBuffer, *BufferOffset-*FileBuffer + FileLength)
            FreeMemory(*FileBuffer)
EndMacro
Macro Structures
  Structure ClientTrack
    client.l
    thread.l
    working.l
    finished.l
    AUTH_TYPE.s
    CONTENT_LENGTH.s
    CONTENT_TYPE.s
    DOCUMENT_ROOT.s
    GATEWAY_INTERFACE.s
    PATH_INFO.s
    PATH_TRANSLATED.s
    QUERY_STRING.s
    REMOTE_ADDR.s
    REMOTE_HOST.s
    REMOTE_IDENT.s
    REMOTE_PORT.s
    REMOTE_USER.s
    REQUEST_URI.s
    REQUEST_METHOD.s
    SCRIPT_NAME.s
    SCRIPT_FILENAME.s
    SERVER_ADMIN.s
    SERVER_NAME.s
    SERVER_PORT.s
    SERVER_PROTOCOL.s
    SERVER_SIGNATURE.s
    SERVER_SOFTWARE.s
    HTTP_ACCEPT.s
    HTTP_ACCEPT_ENCODING.s
    HTTP_ACCEPT_LANGUAGE.s
    HTTP_COOKIE.s
    HTTP_FORWARDED.s
    HTTP_HOST.s
    HTTP_PRAGMA.s
    HTTP_REFERER.s
    HTTP_USER_AGENT.s
    Header.s
  EndStructure
  
Global Dim ClientThreads.ClientTrack(NumberOfThreads)
Structure tmp
  a.b
EndStructure

EndMacro
Macro Globals
Global BaseDirectory$ = "www\";C:\Documents and Settings\Booger\Desktop\mysite\
Global DefaultPage$ = "Index.html"
Global AtomicTitle$ = "Booger's Web Server v0.1"
Global ClientId
Global SEvent
Global EOL$
;Global RequestLength  ;this is bad, was used only to detect clash and stability
Global ThreadCount
Global BufferLocked
Global ThreadID
Global MimeLock
Global NetworkEvent
Global EOL$ = Chr(13) + Chr(10)
Global NumberOfThreads

EndMacro
Macro SendStats
Http$ = ""
info$ = ""

Http$ + "<html>"+#CRLF$
Http$ + "<head>"+#CRLF$
Http$ + "<meta http-equiv= "+Chr(39)+"refresh"+Chr(39)+" content= "+Chr(39)+"1"+Chr(39)+" />"+#CRLF$

Http$ + " <link rel="+Chr(39)+"stylesheet"+Chr(39)+" href="+Chr(39)+"/Default.css"+Chr(39)+" type="+Chr(39)+"text/css"+Chr(39)+" />"+#CRLF$
Http$ + "</head>"
; Http$ + "<header>"
; Http$ + "<title>"+Chr(39)+"Stats"+Chr(39)+"</title>"
; Http$ + "</header>"
Http$ + "<body>"
Http$ + "Hi, Here is your STATS:<br>"


Info$ + "<br>"
Info$ + "Number of Active Threads="+Str(ThreadCount) + "<br>"
Info$ + "Current Thread Serving This Page="+Str(Sync) + "<br>"


Info$ +  " AUTH_TYPE=" + "<br>"
Info$ +  " CONTENT_LENGTH="+Str(filelength)+ "<br>"
Info$ +  " CONTENT_TYPE="+ClientThreads(Sync)\CONTENT_TYPE+ "<br>"
Info$ +  " DOCUMENT_ROOT="+ClientThreads(Sync)\DOCUMENT_ROOT+ "<br>"
Info$ +  " GATEWAY_INTERFACE="+ClientThreads(Sync)\GATEWAY_INTERFACE  + "<br>"
Info$ +  " PATH_INFO="+ClientThreads(Sync)\PATH_INFO + "<br>"
Info$ +  " PATH_TRANSLATED="+ClientThreads(Sync)\PATH_TRANSLATED + "<br>"
Info$ +  " QUERY_STRING="+ClientThreads(Sync)\ QUERY_STRING + "<br>"
Info$ +  " REMOTE_ADDR="+ClientThreads(Sync)\REMOTE_ADDR+ "<br>"
Info$ +  " REMOTE_HOST="+ClientThreads(Sync)\REMOTE_HOST  + "<br>"
Info$ +  " REMOTE_IDENT="+ClientThreads(Sync)\REMOTE_IDENT  + "<br>"
Info$ +  "  REMOTE_PORT="+ClientThreads(Sync)\REMOTE_PORT+ "<br>"
Info$ +  " REMOTE_USER="+ClientThreads(Sync)\REMOTE_USER  + "<br>"
Info$ +  " REQUEST_URI="+ClientThreads(Sync)\REQUEST_URI  + "<br>"
Info$ +  " REQUEST_METHOD="+ClientThreads(Sync)\REQUEST_METHOD  + "<br>"
Info$ +  " SCRIPT_NAME="+ClientThreads(Sync)\SCRIPT_NAME  + "<br>"
Info$ +  " SCRIPT_FILENAME="+ClientThreads(Sync)\SCRIPT_FILENAME  + "<br>"
Info$ +  " SERVER_ADMIN="+ClientThreads(Sync)\SERVER_ADMIN  + "<br>"
Info$ +  " SERVER_NAME="+ClientThreads(Sync)\SERVER_NAME  + "<br>"
Info$ +  " SERVER_PORT="+ClientThreads(Sync)\SERVER_PORT  + "<br>"
Info$ +  " SERVER_PROTOCOL="+ClientThreads(Sync)\SERVER_PROTOCOL  + "<br>"
Info$ +  " SERVER_SIGNATURE="+ClientThreads(Sync)\SERVER_SIGNATURE  + "<br>"
Info$ +  " SERVER_SOFTWARE="+ClientThreads(Sync)\ SERVER_SOFTWARE + "<br>"
Info$ +  " HTTP_ACCEPT="+ClientThreads(Sync)\HTTP_ACCEPT  + "<br>"
Info$ +  " HTTP_ACCEPT_ENCODING="+ClientThreads(Sync)\HTTP_ACCEPT_ENCODING  + "<br>"
Info$ +  " HTTP_ACCEPT_LANGUAGE="+ClientThreads(Sync)\HTTP_ACCEPT_LANGUAGE  + "<br>"
Info$ +  " HTTP_COOKIE="+ClientThreads(Sync)\HTTP_COOKIE  + "<br>"
Info$ +  " HTTP_FORWARDED="+ClientThreads(Sync)\HTTP_FORWARDED  + "<br>"
Info$ +  " HTTP_HOST="+ClientThreads(Sync)\HTTP_HOST  + "<br>"
Info$ +  " HTTP_PRAGMA="+ClientThreads(Sync)\HTTP_PRAGMA + "<br>"
Info$ +  " HTTP_REFERER="+ClientThreads(Sync)\HTTP_REFERER + "<br>"
Info$ +  " HTTP_USER_AGENT="+ClientThreads(Sync)\HTTP_USER_AGENT  + "<br>"     

Http$ + Info$

Http$ + "</body>"
Http$ + "</html>"
contentType$="text/html"
FileLength=Len(Http$)
*FileBuffer = AllocateMemory(FileLength + 200)
*BufferOffset=*FileBuffer


EndMacro

Macro SetUpMimeTypeStructure
;*********************************************************************
;*                 Code by Epidemicz                                 *
;*********************************************************************
; reads apache mime.types file renamed to mime.txt
; skips comments   (DO NOT PUT COMMENTS ON SAME LINE AS MIME/TYPES)

Structure mime
  Mime_Type$
  Mime_Ext$
EndStructure

Global Dim MimeList.mime(1000)
;***********************************************************************************************************************
Global mimecounter  ;changed counter name and made global so server procedures may access this variable  03262009 21:30 Booger
;***********************************************************************************************************************
;open/read file
file = OpenFile(#PB_Any, "mime.txt")
;Debug file
While Eof(file) = 0
  oldcounter = mimecounter
  ;read entire line
  tmp$ = LTrim(ReadString(file))
  ;********************************************************************************************
  While Left(tmp$, 1) = "#" And Eof(file) = 0 ; added to skip commented lines  03272009 08:30 Booger
    tmp$ = LTrim(ReadString(file))
  Wend
  ;********************************************************************************************
  ;parse out the mime type
  mime$ = Mid(tmp$, 0, FindString(tmp$, Chr(9), 1)-1)
  
  If mime$<>""
    MimeList(mimecounter)\Mime_Type$ = mime$
    current_mime$ = mime$
    
    ;Debug MimeList(mimecounter)\Mime_Type$
    ;Debug Len(MimeList(mimecounter)\Mime_Type$)
    ;Debug mimecounter
  EndIf
  
  ;find out how many extensions per mime type
  
  ;this actually gets the extension list
  ext$ = Mid(tmp$, FindString(tmp$, Chr(9), 1))
  
  If Not FindString(ext$, "/", 0)
    ext$ = ReplaceString(ext$, Chr(9), "")
    numOfExts = CountString(ext$, " ")
    
    
    If numOfExts>0
      ;********************************************************************************************************************
      For x = 1 To numOfExts + 1  ;*****Changed x=0 to x=1 to fix double first extension bug for now 03/26/2009 21:23 Booger
      ;********************************************************************************************************************
        MimeList(mimecounter)\Mime_Type$ = current_mime$
        MimeList(mimecounter)\Mime_Ext$ = "." + StringField(ext$, x, " ")
        ;Debug MimeList(mimecounter)\Mime_Type$
        ;Debug MimeList(mimecounter)\Mime_Ext$
        mimecounter + 1
      Next
    Else
      MimeList(mimecounter)\Mime_Ext$ = "." + ext$
    EndIf
  EndIf
  
  If oldcounter = mimecounter And MimeList(mimecounter)\Mime_Type$<>""
    mimecounter + 1
  EndIf
Wend


; For x = 0 To mimecounter -1
;   PrintN ("MimeList(" + Str(x) + ")=" + MimeList(x)\Mime_Type$ + " : " + MimeList(x)\Mime_Ext$)
; Next
;parse file somehow

;do stuff for determining the mimetype
EndMacro
Feel free to post any improvement to this code. I am not by far a thread Guru.


Edit: Updated bad code 04/04/2009

Any code crashes=Please copy console contents and Variable contents and post here+Processor model and clock.

Thanks.

Posted: Wed Apr 01, 2009 11:15 pm
by X
Thanks for providing the code :)

BTW: please, please feel free to share your future code when you add support for that cgi, ispi, etc. :)

Posted: Fri Apr 03, 2009 4:15 am
by idle
Thanks Booger.

Posted: Sat Apr 04, 2009 6:47 pm
by Booger
Updated Bad Code and Thread Tracking. See first post.

Find a bug, please report, thanks.

Re: Atomic Web Server Conversion (1000 threads)

Posted: Sun Dec 13, 2009 7:13 pm
by votan
Thanks for sharing! :)
But I always get a compile error "Line 41: Structure field not found: Mime_Type".
Maybe you can update us on your progress with this project?

Re: Atomic Web Server Conversion (1000 threads)

Posted: Wed Dec 16, 2009 1:58 pm
by JackWebb
Votan,

Just do a search and replace of Mime_Type$ to Mime_Type.s and Mime_Ext$ to Mime_Ext.s in the INCLUDE file.

Jack
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited