Webserver bzw. Problem mit SendNetworkData()

In dieser Linux-Ecke dürfen nur Themen rund um Linux geschrieben werden.
Beiträge, die plattformübergreifend sind, gehören ins 'Allgemein'-Forum.
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8375
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 20.10
NVIDIA Quadro P2200
Wohnort: Saarbrücken
Kontaktdaten:

Re: Webserver bzw. Problem mit SendNetworkData()

Beitrag 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.
Bild
Gimbly
Beiträge: 169
Registriert: 28.12.2005 14:26
Wohnort: NRW

Re: Webserver bzw. Problem mit SendNetworkData()

Beitrag 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
Gruß
Markus
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8375
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 20.10
NVIDIA Quadro P2200
Wohnort: Saarbrücken
Kontaktdaten:

Re: Webserver bzw. Problem mit SendNetworkData()

Beitrag 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.
Bild
Gimbly
Beiträge: 169
Registriert: 28.12.2005 14:26
Wohnort: NRW

Re: Webserver bzw. Problem mit SendNetworkData()

Beitrag von Gimbly »

Ja, CreateNetworkServer(#PB_Any, Port)

Wenn ich zu Hause bin, schick ich mal den Code, den ich unter Linux ausführe.
Gruß
Markus
Gimbly
Beiträge: 169
Registriert: 28.12.2005 14:26
Wohnort: NRW

Re: Webserver bzw. Problem mit SendNetworkData()

Beitrag 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
Gruß
Markus
Gimbly
Beiträge: 169
Registriert: 28.12.2005 14:26
Wohnort: NRW

Re: Webserver bzw. Problem mit SendNetworkData()

Beitrag von Gimbly »

Hallo, ist da jemand?
Gruß
Markus
stevie1401
Beiträge: 595
Registriert: 19.10.2014 15:51
Kontaktdaten:

Re: Webserver bzw. Problem mit SendNetworkData()

Beitrag 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.
Ich programmiere plattformunabhängig und suche immer Lösungen für alle Plattformen.
Win 7/10, Linux Mint Cindy 3 (Debian), Mint 18.3 / 19.1
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8375
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 20.10
NVIDIA Quadro P2200
Wohnort: Saarbrücken
Kontaktdaten:

Re: Webserver bzw. Problem mit SendNetworkData()

Beitrag 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.
Bild
stevie1401
Beiträge: 595
Registriert: 19.10.2014 15:51
Kontaktdaten:

Re: Webserver bzw. Problem mit SendNetworkData()

Beitrag 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.
Ich programmiere plattformunabhängig und suche immer Lösungen für alle Plattformen.
Win 7/10, Linux Mint Cindy 3 (Debian), Mint 18.3 / 19.1
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8375
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 20.10
NVIDIA Quadro P2200
Wohnort: Saarbrücken
Kontaktdaten:

Re: Webserver bzw. Problem mit SendNetworkData()

Beitrag 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.
Bild
Antworten