PureBoard

Code: Alles auswählen

ServerName$ = "RazorBlade Web Server 0.1a"
ServerPort = 80
MaxClients = 5

Global Dim Clients(MaxClients-1,5)  

Procedure.l BuildRequestHeader(*Buffer, DataLength.l, ContentType$)
  
  Date$ = RSet(Str(Day(Date())), 2, "0")+"."+RSet(Str(Month(Date())), 2, "0")+"."+RSet(Str(Year(Date())), 2, "0")
  Time$ = RSet(Str(Hour(Date())), 2, "0")+":"+RSet(Str(Minute(Date())), 2, "0")+":"+RSet(Str(Second(Date())), 2, "0")
  
  EOL$ = Chr(13)+Chr(10)
  
  Length = PokeS(*Buffer, "HTTP/1.1 200 OK"+EOL$)                     : *Buffer+Length
  Length = PokeS(*Buffer, "Date: "+Date$+" "+Time$+" CET"+EOL$) : *Buffer+Length
  Length = PokeS(*Buffer, "Server: RazorBlade Web Server 0.1a"+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, "Connection: close"+EOL$) : *Buffer+Length
  Length = PokeS(*Buffer, EOL$)                                       : *Buffer+Length

  ProcedureReturn *Buffer
EndProcedure

Structure SendFile
  ClientID.l
  File.s
  PackageSize.l
EndStructure

Procedure.l SendFile(*Parameters.SendFile)
  PackSize = *Parameters\PackageSize * 1024
  FileID.l = ReadFile(#PB_Any, *Parameters\File)
  If FileID
    FileLength.l = Lof(FileID)
    *SendBuffer = AllocateMemory(PackSize)
    Extension$ = LCase(GetExtensionPart(*Parameters\File))
    Select Extension$
      Case "mp3" : ContentType$ = "audio/mpeg"
      Case "gif" : ContentType$ = "image/gif"
      Case "jpg" : ContentType$ = "image/jpeg"
      Case "jpeg" : ContentType$ = "image/jpeg"
      Case "txt" : ContentType$ = "text/plain"
      Case "zip" : ContentType$ = "application/zip"
      Case "html" : ContentType$ = "text/html"
      Case "htm" : ContentType$ = "text/html"
    EndSelect
        
      
    *BufferOffset = BuildRequestHeader(*SendBuffer, FileLength, ContentType$)
    HeaderLength.l = *BufferOffset-*SendBuffer
    n = 0
    Repeat
      If PackSize > HeaderLength - n
        sended = SendNetworkData(*Parameters\ClientID, *SendBuffer+n, HeaderLength-n)
        n + sended
      ElseIf PackSize <= HeaderLength - n
        sended = SendNetworkData(*Parameters\ClientID, *SendBuffer+n, PackSize)
        n + sended
      EndIf
    Until n >= HeaderLength
    n = 0
    Repeat
      FileSeek(FileID, n)
      If PackSize > FileLength - n
        ReadData(FileID, *SendBuffer, FileLength - n)
        sended = SendNetworkData(*Parameters\ClientID, *SendBuffer, FileLength-n)
        If sended < 0
          sended = 0
        EndIf
        n + sended
      ElseIf PackSize <= FileLength - n
        ReadData(FileID, *SendBuffer, PackSize)
        sended = SendNetworkData(*Parameters\ClientID, *SendBuffer, PackSize)
        If sended < 0
          sended = 0
        EndIf
        n + sended
      EndIf
      Delay(1)
    Until n = FileLength
    FreeMemory(*SendBuffer)
    CloseFile(FileID)
  EndIf
  ClearStructure(*Parameters, SendFile)
  FreeMemory(*Parameters)
EndProcedure

If InitNetwork() = 0
  MessageRequester("Error: "+ServerName$, "Can't initialize the network!", 0)
  End
EndIf

If MaxClients < 1
  MessageRequester("Error: "+ServerName$, "Nobody can connect to Server with max. "+Str(MaxClients)+" Clients.", 0)
  End
EndIf

If CreateNetworkServer(0, 80) = 0
  MessageRequester("Error: "+ServerName$, "Server can't start. Is Port "+"ServerPort"+" in use?", 0)
  End
EndIf
  
*Buffer = AllocateMemory(10 * 1024)

  Repeat
    
    SEvent = NetworkServerEvent()
  
    If SEvent
      ClientID.l = EventClient()
  
      Select SEvent
      
        Case 1  ; When a new client has been connected...
          Debug "Connected"
          For x = 0 To MaxClients-1
            If Clients(x, 0) = 0
              Clients(x, 0) = ClientID
              Break
            ElseIf x = MaxClients-1 And Clients(x,0) <> 0
              CloseNetworkConnection(ClientID)
            EndIf
          Next x
  
        Case 2
          Debug "Receive Data"
          RequestLength.l = ReceiveNetworkData(ClientID, *Buffer, 2000)
          FirstLine$ = PeekS(*Buffer)
          If Left(FirstLine$, 3) = "GET"
            
            MaxPosition = FindString(FirstLine$, Chr(13), 5)
            Position = FindString(FirstLine$, " ", 5)
            If Position < MaxPosition
              RequestedFile$ = Mid(FirstLine$, 6, Position-5)      ; Automatically remove the leading '/'
              RequestedFile$ = RTrim(RequestedFile$)
              If FindString(RequestedFile$,"?",0)
                RequestedFile$ = Left(RequestedFile$,FindString(RequestedFile$,"?",0)-1)
              EndIf
            Else
              RequestedFile$ = Mid(FirstLine$, 6, MaxPosition-5)   ; When a command like 'GET /' is sent..
            EndIf
            
            If RequestedFile$ = "" Or RequestedFile$ = "index" Or RequestedFile$ = "index.htm"
              RequestedFile$ = "index.html"
            EndIf
            
            If FileSize("http\"+RequestedFile$) < 0
              RequestedFile$ = "404.html"
            EndIf

            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
            
            Debug RequestedFile$
            
            
            *Parameters.SendFile = AllocateMemory(SizeOf(SendFile))
            *Parameters\ClientID = ClientID
            *Parameters\File = "http\"+RequestedFile$
            *Parameters\PackageSize = 10
            For x = 0 To MaxClients-1
              If Clients(x, 0) = ClientID
                If Clients(x,1) = 0 Or IsThread(Clients(x,1)) = 0
                  Clients(x,1) = CreateThread(@SendFile(), *Parameters)
                EndIf
                Break
              EndIf
            Next x
          Else
            CloseNetworkConnection(ClientID)
            For x = 0 To MaxClients-1
              If Clients(x, 0) = ClientID
                Clients(x, 0) = 0
                If Clients(x, 1) <> 0
                  If IsThread(Clients(x, 1))
                    KillThread(Clients(x, 1))
                  EndIf
                  Clients(x, 1) = 0
                EndIf
                Break
              EndIf
            Next x
          EndIf
          
        Case 3
          Debug "Receive File"
          CloseNetworkConnection(ClientID)
          For x = 0 To MaxClients-1
            If Clients(x, 0) = ClientID
              Clients(x, 0) = 0
              If Clients(x, 1) <> 0
                If IsThread(Clients(x, 1))
                  KillThread(Clients(x, 1))
                EndIf
                Clients(x, 1) = 0
              EndIf
              Break
            EndIf
          Next x
          
        Case 4  ; When a client has closed the connection...
          Debug "Disconnected"
          For x = 0 To MaxClients-1
            If Clients(x, 0) = ClientID
              Clients(x, 0) = 0
              If Clients(x, 1) <> 0
                If IsThread(Clients(x, 1))
                  KillThread(Clients(x, 1))
                EndIf
                Clients(x, 1) = 0
              EndIf
              Break
            EndIf
          Next x
          
      EndSelect

    Else
      Delay(20)  ; Don't stole the whole CPU !
    EndIf
    
  Until Quit = 1 
    
  CloseNetworkServer(0)
  
End