;
; ------------------------------------------------------------
;
;       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.
;

InitFile(0)
InitWindow(0)

If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize the network !", 0)
  End
EndIf

DefType.l

Port = 80
BaseDirectory$ = "www\"
DefaultPage$   = "Index.html"
AtomicTitle$   = "Atomic Web Server v1.0"

Global EOL$

EOL$ = Chr(13)+Chr(10)

*Buffer = GlobalAlloc_(#GMEM_FIXED | #GMEM_ZEROINIT, 10000)

If CreateNetworkServer(Port)

  OpenWindow(0, 100, 100, 230, 0, #PB_Window_SystemMenu, "Atomic Web Server (Port "+Str(Port)+")")
  
  Repeat
    
    WEvent.l = WindowEvent()
    SEvent.l = NetworkServerEvent()
  
    If WEvent = #PB_EventCloseWindow
      Quit = 1
    EndIf

    If SEvent

      ClientID.l = NetworkClientID()
  
      Select SEvent
      
        Case 1  ; When a new client has been connected...
          
        Case 4  ; When a client has closed the connection...
  
        Default
          RequestLength.l = ReceiveNetworkData(ClientID, *Buffer, 2000)
          Gosub ProcessRequest
          
      EndSelect
    Else
      Sleep_(20)  ; Don't stole the whole CPU !
    EndIf
    
  Until Quit = 1 
    
  CloseNetworkServer()
Else
  MessageRequester(AtomicTitle$, "Error: can't create the server (port in use ?).", #MB_ICONERROR)
EndIf
  
End 



Procedure.l BuildRequestHeader(*Buffer, DataLength.l, ContentType$)

  Length = PokeS(*Buffer, "HTTP/1.1 200 OK"+EOL$)                     : *Buffer+Length
  Length = PokeS(*Buffer, "Date: Wed, 07 Aug 1996 11:15:43 GMT"+EOL$) : *Buffer+Length
  Length = PokeS(*Buffer, "Server: Atomic Web Server 0.2b"+EOL$)      : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Length: "+Str(DataLength)+EOL$)    : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Type: "+ContentType$+EOL$)         : *Buffer+Length
  Length = PokeS(*Buffer, EOL$)                                       : *Buffer+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

  ProcedureReturn *Buffer
EndProcedure


ProcessRequest:

  a$ = PeekS(*Buffer)
  
  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$ = StripTrail(RequestedFile$)
    Else
      RequestedFile$ = Mid(a$, 6, MaxPosition-5)   ; When a command like 'GET /' is sent..
    EndIf

      ; The following routine transforme all '/' in '\' (Windows format)
      ;
      Structure tmp
        a.b
      EndStructure

      If RequestedFile$ = ""
        RequestedFile$ = DefaultPage$
      Else
        *t.tmp = @RequestedFile$
        While *t\a <> 0
          If *t\a = '/' : *t\a = '\' : EndIf
          *t+1
        Wend
      EndIf

      ; Test if the file exists, and if not display the error message
      ;   
      If ReadFile(0, BaseDirectory$+RequestedFile$) : CloseFile(0) : Else : RequestedFile$ = "AtomicWebServer_Error.html" : EndIf

      If ReadFile(0, BaseDirectory$+RequestedFile$)
        FileLength = Lof()

        Select Right(RequestedFile$,4)
          Case ".gif"
            ContentType$ = "image/gif"

          Case ".jpg"
            ContentType$ = "image/jpeg"

          Case ".txt"
            ContentType$ = "text/plain"

          Case ".zip"
            ContentType$ = "application/zip"

          Default
            ContentType$ = "text/html"

        EndSelect
        
        *FileBuffer   = GlobalAlloc_(#GMEM_FIXED|#GMEM_ZEROINIT, FileLength+200)
        *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)

        ReadMemory(*BufferOffset, FileLength)

        CloseFile(0)
 
        SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+FileLength)
        GlobalFree_(*FileBuffer)
      Else
        MessageRequester(AtomicTitle$, "Error: Can't open the file "+BaseDirectory$+RequestedFile$, #MB_ICONERROR)
      EndIf
  EndIf

Return 
; EnableAsm
; Executable=C:\Programmation\PureBasic\Examples\Atomic Web Server\Atomic Web Server.exe
; DisableDebugger