Webserver bzw. Problem mit SendNetworkData()
- NicTheQuick
- Ein Admin
- Beiträge: 8679
- Registriert: 29.08.2004 20:20
- Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti - Wohnort: Saarbrücken
- Kontaktdaten:
Re: Webserver bzw. Problem mit SendNetworkData()
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()
/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.
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
Markus
- NicTheQuick
- Ein Admin
- Beiträge: 8679
- Registriert: 29.08.2004 20:20
- Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti - Wohnort: Saarbrücken
- Kontaktdaten:
Re: Webserver bzw. Problem mit SendNetworkData()
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.
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()
Ja, CreateNetworkServer(#PB_Any, Port)
Wenn ich zu Hause bin, schick ich mal den Code, den ich unter Linux ausführe.
Wenn ich zu Hause bin, schick ich mal den Code, den ich unter Linux ausführe.
Gruß
Markus
Markus
Re: Webserver bzw. Problem mit SendNetworkData()
Tatsächlich, der "Atomic Web Server" ist nur bei der PB-Windows-Version enthalten.
Hatte ihn für Linux etwas angepasst; ganz vergessen.
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
Markus
-
- Beiträge: 659
- Registriert: 19.10.2014 15:51
- Kontaktdaten:
Re: Webserver bzw. Problem mit SendNetworkData()
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.
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 nur noch mit Linux.
Linux Mint 21.x
Linux Mint 21.x
- NicTheQuick
- Ein Admin
- Beiträge: 8679
- Registriert: 29.08.2004 20:20
- Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti - Wohnort: Saarbrücken
- Kontaktdaten:
Re: Webserver bzw. Problem mit SendNetworkData()
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.
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.
-
- Beiträge: 659
- Registriert: 19.10.2014 15:51
- Kontaktdaten:
Re: Webserver bzw. Problem mit SendNetworkData()
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.
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 nur noch mit Linux.
Linux Mint 21.x
Linux Mint 21.x
- NicTheQuick
- Ein Admin
- Beiträge: 8679
- Registriert: 29.08.2004 20:20
- Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti - Wohnort: Saarbrücken
- Kontaktdaten:
Re: Webserver bzw. Problem mit SendNetworkData()
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.