PureBoard

Code: Alles auswählen

#File_Log = 2

#Log$ = "Log.log"
#Temp$ = "Temp"
#Error$ = "Error.html"

Procedure WriteLog(Text$)
  ProcedureReturn WriteStringN(#File_Log, FormatDate("%dd.%mm.%yyyy - %hh:%ii:%ss    ", Date())+Text$)
EndProcedure

Procedure DL(URL$, File$)
  ProcedureReturn URLDownloadToFile(URL$, File$)  ;--Bitte auf ändern!!
EndProcedure

If Not OpenFile(#File_Log, #Log$)
  End
EndIf

FileSeek(#File_Log, Lof(#File_Log))

If InitNetwork() = 0
  writelog("Can't initialize the network !")
  End
EndIf

Port = 8080
WriteLog("Port: "+Str(Port))

Global EOL$

EOL$ = Chr(13)+Chr(10)

*Buffer = AllocateMemory(10000)

If CreateNetworkServer(0, Port)
  
  WriteLog("Server gestartet")
  
  Repeat
    
    Repeat
      WEvent = WindowEvent()

      If WEvent = #PB_Event_CloseWindow : Quit = 1 : EndIf
    Until WEvent = 0
    
    SEvent = NetworkServerEvent()
  
    If SEvent
      ClientID.l = EventClient()
  
      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
      Delay(20)  ; Don't stole the whole CPU !
    EndIf
    
  Until Quit = 1 
    
  CloseNetworkServer(0)
Else
  WriteLog("Error: can't create the server (port in use ?).")
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$, 5, Position-5)      ; Automatically remove the leading '/'
      RequestedFile$ = RTrim(RequestedFile$)
    Else
      RequestedFile$ = Mid(a$, 6, MaxPosition-5)   ; When a command like 'GET /' is sent..
    EndIf
      
      Debug RequestedFile$
      
      If FindString(LCase(RequestedFile$), "server.shutdown", 0)
        WriteLog("Server wird beended")
        End
      EndIf
      
      DL(RequestedFile$, #Temp$)
      WriteLog(IPString(GetClientIP(ClientID))+" request "+RequestedFile$)
      ; Test if the file exists, and if not display the error message
      ;   

      If ReadFile(0, #Temp$)
      
        FileLength = Lof(0)
        
        Ext$ = LCase(GetExtensionPart(StringField(RequestedFile$, 1, "?")))
        
        Select Ext$
          Case "gif"
            ContentType$ = "image/gif"

          Case "jpg"
            ContentType$ = "image/jpeg"

          Case "txt"
            ContentType$ = "text/plain"

          Case "zip"
            ContentType$ = "application/zip"
            
          Case "html"
            ContentType$ = "text/html"
            
          Case "htm"
            ContentType$ = "text/html"
          
          Case "php"
            contentType$ = "text/html"

          Default
            ContentType$ = "application/"+ext$

        EndSelect
        
        *FileBuffer   = AllocateMemory(FileLength+200)
        *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)

        ReadData(0, *BufferOffset, FileLength)

        CloseFile(0)
 
        SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+FileLength)
        FreeMemory(*FileBuffer)
      Else
        If ReadFile(0, #Error$)
          FileLength = Lof(0)
          ContentType$ = "text/html"

          *FileBuffer   = AllocateMemory(FileLength+200)
          *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)

          ReadData(0, *BufferOffset, FileLength)
          CloseFile(0)
   
          SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+FileLength)
          FreeMemory(*FileBuffer)
        EndIf
      EndIf
  EndIf
  
  DeleteFile(#Temp$)
  
Return