Seite 4 von 5

Re: Webserver bzw. Problem mit SendNetworkData()

Verfasst: 14.02.2020 13:07
von NicTheQuick
Atomic -Webserver? Wo gibt's den? War das nicht mal ein Beispiel-Code von Purebasic? In meinem examples-Ordner ist er leider nicht drin.

Re: Webserver bzw. Problem mit SendNetworkData()

Verfasst: 14.02.2020 14:12
von Gimbly
/Examples/Sources - Advanced/Atomic Web Server/Atomic Web Server.pb

Hier die Windows-Variante. Hab momentan (im Büro) keinen Zugriff auf mein Linux.

Port auf 8080 geändert.

Code: Alles auswählen

;
; ------------------------------------------------------------
;
;       Atomic Web Server in PureBasic
;
;          (c) Fantaisie Software
;
; ------------------------------------------------------------
;

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

Port = 80
BaseDirectory$ = "www/"
DefaultPage$   = "Index.html"
AtomicTitle$   = "Atomic Web Server v1.0"

Global EOL$

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

*Buffer = AllocateMemory(10000)

If CreateNetworkServer(0, Port)

  OpenWindow(0, 100, 200, 230, 0, "Atomic Web Server (Port "+Str(Port)+")")
  
  Repeat
    
    Repeat
      WEvent = WindowEvent()

      If WEvent = #PB_Event_CloseWindow : Quit = 1 : EndIf
    Until WEvent = 0
    
    SEvent = NetworkServerEvent()
  
    If SEvent
      ClientID = EventClient()
  
      Select SEvent
      
        Case 1  ; When a new client has been connected...
          
        Case 4  ; When a client has closed the connection...
  
        Default
          RequestLength = ReceiveNetworkData(ClientID, *Buffer, 2000)
          Gosub ProcessRequest
          
      EndSelect

    Else
      Delay(20)  ; Don't stole the whole CPU !
    EndIf
    
  Until Quit = 1 
    
  CloseNetworkServer(0)
Else
  MessageRequester(AtomicTitle$, "Error: can't create the server (port in use ?).", 0)
EndIf
  
End 



Procedure.l BuildRequestHeader(*Buffer, DataLength, ContentType$)

  Length = PokeS(*Buffer, "HTTP/1.1 200 OK"+EOL$, -1, #PB_UTF8)                     : *Buffer+Length
  Length = PokeS(*Buffer, "Date: Wed, 11 Fec 2017 11:15:43 GMT"+EOL$, -1, #PB_UTF8) : *Buffer+Length
  Length = PokeS(*Buffer, "Server: Atomic Web Server 0.2b"+EOL$, -1, #PB_UTF8)      : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Length: "+Str(DataLength)+EOL$, -1, #PB_UTF8)    : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Type: "+ContentType$+EOL$, -1, #PB_UTF8)         : *Buffer+Length
  Length = PokeS(*Buffer, #CRLF$, -1, #PB_UTF8)                                     : *Buffer+Length

  ; Length = PokeS(*Buffer, "Last-modified: Thu, 27 Jun 1996 16:40:50 GMT"+Chr(13)+Chr(10), -1, #PB_UTF8) : *Buffer+Length
  ; Length = PokeS(*Buffer, "Accept-Ranges: bytes"+EOL$, -1, #PB_UTF8) : *Buffer+Length
  ; Length = PokeS(*Buffer, "Connection: close"+EOL$, -1, #PB_UTF8) : *Buffer+Length

  ProcedureReturn *Buffer
EndProcedure


ProcessRequest:

  a$ = PeekS(*Buffer, -1, #PB_UTF8)
  
  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

      ; 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$, #PB_UTF8)
      
        FileLength = Lof(0)

        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   = 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, BaseDirectory$+"AtomicWebServer_Error.html")
          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

Return

Re: Webserver bzw. Problem mit SendNetworkData()

Verfasst: 14.02.2020 14:52
von NicTheQuick
Den Code gibt es in meiner Installation nicht. Gibt es das vielleicht nur in der Windows-Installation? Komisch.

Hast du den Code auch auf #PB_Any umgeschrieben oder hast du CreateNetworkServer(0, ...) weiterhin benutzt? Denn damit geht es ja nicht.
Bei mir funktioniert der Code übrigens überhaupt nicht. Abgesehen davon, dass ich die notwendigen Dateien auch nicht besitze, kommt nicht mal eine Fehlermeldung oder vergleichbares.

Vielleicht schaue ich nochmal genauer, wenn ich mehr Zeit habe. Momentan bin ich ja auf der Arbeit.

Re: Webserver bzw. Problem mit SendNetworkData()

Verfasst: 14.02.2020 15:54
von Gimbly
Ja, CreateNetworkServer(#PB_Any, Port)

Wenn ich zu Hause bin, schick ich mal den Code, den ich unter Linux ausführe.

Re: Webserver bzw. Problem mit SendNetworkData()

Verfasst: 14.02.2020 18:52
von Gimbly
Tatsächlich, der "Atomic Web Server" ist nur bei der PB-Windows-Version enthalten.
Hatte ihn für Linux etwas angepasst; ganz vergessen.

Code: Alles auswählen

;
;
; ------------------------------------------------------------
;
;       Atomic Web Server in PureBasic
;
;          (c) Fantaisie Software
;
;         (modifiziert v. Gimbly mit Hilfe v. NicTheQuick)
; ------------------------------------------------------------
;

CompilerIf #PB_Compiler_OS = #PB_OS_Linux
   #SOL_SOCKET = 1
   #SO_REUSEADDR = 2
   #SO_REUSEPORT = 15
   
   Procedure CreateNetworkServerEx(ServerID.i, Port.i, Modus, BindedIP$)
      Protected handle.i
      If ServerID.i = #PB_Any
         handle.i = CreateNetworkServer(#PB_Any, Port, Modus, BindedIP$)
         If Not handle
            ProcedureReturn handle
         EndIf
         Protected hSocket.l = PeekL(handle), enable.l = 1
         If setsockopt_(hSocket, #SOL_SOCKET, #SO_REUSEADDR, @enable, SizeOf(enable)) < 0
            Debug "Error setting SO_REUSEADDR"
            End
         EndIf
         If setsockopt_(hSocket, #SOL_SOCKET, #SO_REUSEPORT, @enable, SizeOf(enable)) < 0
            Debug "Error setting SO_REUSEPORT"
            End
         EndIf
         ProcedureReturn handle
      Else
         ProcedureReturn CreateNetworkServer(ServerID, Port, Modus, BindedIP$)
      EndIf
   EndProcedure
   Macro CreateNetworkServer(a, b, c = #PB_Network_TCP | #PB_Network_IPv4, d = "0.0.0.0")
      CreateNetworkServerEx(a, b, c, d)
   EndMacro
CompilerEndIf

CompilerIf #PB_Compiler_OS=#PB_OS_Linux
  Procedure mitStrgCbeendet(signal.i) :  CloseNetworkServer(0) : PrintN("Server beendet!") : PrintN("Drücke Return zum Schließen.") : Input() : CloseConsole() : End : EndProcedure
CompilerEndIf


#EOL=Chr(10)

Port = 8080
BaseDirectory$ = "www/"
DefaultPage$   = "Index.html"
ServerTitle$   = "Atomic Web Server v1.0"

If OpenConsole(ServerTitle$+" (Port "+Str(Port)+")") = 0 : End : EndIf

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

Global *FileBuffer

*Buffer = AllocateMemory(100000)

If CreateNetworkServer(#PB_Any, Port)
  CompilerIf #PB_Compiler_OS=#PB_OS_Linux : signal_(2,@mitStrgCbeendet()) ;SIGINT (STRG+C)
    signal_(15,@mitStrgCbeendet()) ;SIGTERM
  CompilerEndIf

  PrintN("Server gestartet auf Port "+Str(Port))

  Repeat
    
    SEvent = NetworkServerEvent()
 
    If SEvent
      ClientID = EventClient()
 
      Select SEvent
     
        Case 1  ; When a new client has been connected...
         
        Case 4  ; When a client has closed the connection...
 
        Default
          RequestLength = ReceiveNetworkData(ClientID, *Buffer, 2000)
          Gosub ProcessRequest
         
      EndSelect

    Else
      Delay(20)  ; Don't stole the whole CPU !
    EndIf
   
  ForEver
   
  CloseNetworkServer(0)
Else
  PrintN("Error: can't create the server (port in use ?).") : PrintN("Drücke Return zum Schließen.") : Input()
EndIf  
End 



Procedure BuildRequestHeader(*Buffer, DataLength, ContentType$)

  Length = PokeS(*Buffer, "HTTP/1.1 200 OK"+#EOL, -1, #PB_Ascii|#PB_String_NoZero)                     : *Buffer+Length
  Length = PokeS(*Buffer, "Date: Wed, 11 Fec 2017 11:15:43 GMT"+#EOL, -1, #PB_Ascii|#PB_String_NoZero) : *Buffer+Length
  Length = PokeS(*Buffer, "Server: Atomic Web Server 0.2b"+#EOL, -1, #PB_Ascii|#PB_String_NoZero)      : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Length: "+Str(DataLength)+#EOL, -1, #PB_Ascii|#PB_String_NoZero)    : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Type: "+ContentType$+#EOL, -1, #PB_Ascii|#PB_String_NoZero)         : *Buffer+Length
  Length = PokeS(*Buffer, #CRLF$, -1, #PB_Ascii)                                                       : *Buffer+Length

  ProcedureReturn *Buffer
EndProcedure

ProcessRequest:

  a$ = PeekS(*Buffer, -1, #PB_Ascii)
 
  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

      ; 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$, #PB_Ascii)
     
        FileLength = Lof(0)

        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   = 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, BaseDirectory$+"AtomicWebServer_Error.html")
          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

Return

Re: Webserver bzw. Problem mit SendNetworkData()

Verfasst: 02.03.2020 18:58
von Gimbly
Hallo, ist da jemand?

Re: Webserver bzw. Problem mit SendNetworkData()

Verfasst: 29.07.2020 22:36
von stevie1401
Ja, ich.
In einem neuen Thread, ich habe diesen nicht gesehen, habe ich genau diesen Bug angesprochen.
Leider ist er bis heute nicht gefixed.
Ich suche auch nach einer Lösung.

Re: Webserver bzw. Problem mit SendNetworkData()

Verfasst: 29.07.2020 23:29
von NicTheQuick
Sagen wir mal. Wenn überhaupt sind das ja nur Notlösungen. Im Idealfall schießt man seine Programme ja nicht unkontrolliert ab, sondern gibt die Ressourcen wieder sauber frei. Dann gibt es auch keine geblockten Ports.
Mit meiner Lösung sollte es aber eigentlich funktionieren. Und falls das immer noch nicht hilft, dann wäre es an der Zeit einen Bug Report dafür zu schreiben.

Re: Webserver bzw. Problem mit SendNetworkData()

Verfasst: 30.07.2020 09:06
von stevie1401
Das kann ich leider nicht so bestätigen.
Die Ports werden auch dann nicht freigegeben, wenn man das Serverprogramm "sauber" beendet.
Für mich ergibt sich das Problem, dass ich mehrere Serverprogramme auf einem Rechner laufen habe auf die Clients zugreifen.
Da kann ich nicht einfach Linux neu starten, damit ich ein abgestürztes Serverprogramm wieder neu starten kann.

Re: Webserver bzw. Problem mit SendNetworkData()

Verfasst: 30.07.2020 09:58
von NicTheQuick
Ja, wie gesagt, dann ist es ein Bug in Purebasic. Es liegt ja jedenfalls nicht an Linux, sonst hätte das Problem jedes Programm und das wäre fatal. Ich muss öfter mal Serverprozesse abschießen, und danach kann ich sie direkt wieder starten.