2020-11-03 19:09:17 +01:00
;********************************
;*
;* lweb-srv.pbi V0.9
;*
;* LiHaSo Webserver Hauptmodule
;*
;* Dieser Webserver ist auch Alleine Nutzbar muss allerdings in einem Hauptprogramm Korrekt zusammengesetzt werden.
;*
2020-11-27 11:52:35 +01:00
XIncludeFile "ltls.pbi"
2020-11-03 19:09:17 +01:00
Module lhs_web
;********************************
;*
;* WebServer Variabeln / Parameter
;*
;{
2020-11-08 23:26:35 +01:00
2020-11-03 19:09:17 +01:00
;*
;* Identifikation des Servers.
;*
2020-11-08 23:26:35 +01:00
2020-11-03 19:09:17 +01:00
Global.s conf_version = "V0.9"
Global.s conf_titel = "LiHaSo Webserver " + conf_version
;*
;* Diese Parameter müssen entsprechend angepasst sein.
;* Später ausgelagert in ein nicht synchronisiertes lweb-cfg.pbi
;* Folgende Parameter müssen im Hauptprogramm definiert sein.
Global.s conf_defaultfile = "index.html"
Global.s conf_basedir = "/srv/lweb-srv/"
Global.s conf_error400 = "integrated" ; Kann "integrated" sein wass die integrierte Standard Fehlermeldung hervorruft.
Global.i conf_max_clients = 100 ; Max gleichzeitige HTTP Verbindungen. Dieser Wert ist anzupassen an das jeweilige System
; Pro Thread werden mindestens 384KBytes benötigt (3 * (64 KByte Standard Buffer + 64 KByte Overhead Buffer))
Global.i conf_server_type = 0
Global.i conf_port = 8080
Global.s conf_binding = "127.0.0.1"
Global.i conf_cache_time = 120 ;120Sekunden
Global.i conf_cache_maxsize = 1 ;1 Mbyte
Global.i conf_cache_current = 0
2020-11-27 21:43:38 +01:00
Global.i conf_cache_enable = 0
2020-11-27 11:52:35 +01:00
Global.i conf_TLS_Port = 8443
Global.s conf_TLS_binding = "127.0.0.1"
Global.i conf_TLS_enable = 0 ;SSL Server
Global.s conf_TLS_CA = ""
Global.s conf_TLS_Cert = ""
Global.s conf_TLS_Key = ""
Global.s conf_TLS_Key_Pass = ""
2020-11-03 19:09:17 +01:00
2020-11-08 17:31:26 +01:00
Enumeration s_client_do ;client_do_cli
#CLI_DO_NOP ;Keine Arbeit
#CLI_DO_DataWorking ;Datenverarbeitung
#CLI_DO_DataToSend ;Daten zum Senden vorhanden
#CLI_DO_WaitDataReceive ;Wartet auf Datenempfang
#CLI_DO_WaitDataSend ;Wartet auf gesendete Daten
2020-11-03 19:09:17 +01:00
EndEnumeration
2020-11-08 17:31:26 +01:00
Enumeration s_server_do ;client_do_srv
#SRV_DO_NOP ;Keine Arbeit
#SRV_DO_NewDatainBuffer ;Neue Daten im incoming Buffer zur bearbeitung.
#SRV_DO_MoreDatainBuffer ;Weitere Daten im incoming Buffer
#SRV_DO_DataReceive ;Datem Empfangen Client Thread muss sich darum Kümmern
#SRV_DO_DataReceiveCompleted ;Empfang der Daten Abgeschlossen
#SRV_DO_DataReceiveFailes ;Beim Empfangen der Daten ist ein fehler passiert.
#SRV_DO_DataSendOK ;Daten erfolgreich gesendet, Thread kann weiterarbeiten.
#SRV_DO_DataSendNOK ;Daten nicht erfolgreich gesendet.
#SRV_DO_ClientDisconnect ;Beenden des Threads Client hat verbindung getrennt.
2020-11-03 19:09:17 +01:00
EndEnumeration
#http_method_get = "GET"
#http_method_post = "POST"
2020-11-08 17:31:26 +01:00
#http_method_put = "PUT"
2020-11-03 19:09:17 +01:00
;***********************
;* s_lweb_client Struktur Jeder Clientthread muss in die Liste eingetragen werden.:
;*
;* client_id = Client ID von EventClient()
;* client_mutex = Client Thread Blockierer für den Hauptthread um gefahrenlos Daten in den Buffer Speichern zu können. (Vorsichtshalber drinn)
;* client_datenbuffer = 128KByte Speicherblock in diesen Speicher Schreibt nur der Hauptthread.
;* client_output_datenbuffer = 128KByte Speicherblock in diesen Speicher Schreibt nur der Clientthread.
;* client_datenbuffer = 128KByte Speicherblock für die Module achtung dieser Speicherblock wird unter umständen von den Modulen
;* vergrössert wird nach abgeschlossener Arbeit wieder auf Default gesetzt.
;*
Structure s_client_memory
2020-11-27 11:52:35 +01:00
*Buffer
2020-11-03 19:09:17 +01:00
Initialized.b
2020-11-08 01:31:57 +01:00
Size.i
2020-11-03 19:09:17 +01:00
EndStructure
Structure s_file_cache
2020-11-27 11:52:35 +01:00
*Buffer
2020-11-03 19:09:17 +01:00
Size.i
Timer.i
Is.i
EndStructure
Structure s_clients
client_id.i
client_do_cli.i
client_do_srv.i
2020-11-27 11:52:35 +01:00
client_ssl.i ;Client ist von einem SSL Server
2020-11-03 19:09:17 +01:00
client_mutex.i
client_thread.i
List datenbuffer.s_client_memory()
client_test_cli.i
client_test_srv.i
2020-11-27 11:52:35 +01:00
client_cctx.i
2020-11-03 19:09:17 +01:00
EndStructure
2020-11-08 01:31:57 +01:00
Structure s_request_handler
call.i
type.i
routetype.i
EndStructure
Enumeration cli_handler_infos 1
#get_handler_procedure ;Funktion die Aufgerufen werden muss
#get_handler_prototype ;Welcher Prototype
EndEnumeration
2020-11-03 19:09:17 +01:00
Global.i server_id
Global.i server_mutex = CreateMutex() ;Dieser Mutex dient zu der Sicherheit der Element Liste.
Global.i file_cache_mutex = CreateMutex()
Global.i file_cache_semaphore = CreateSemaphore()
Global.i file_cache_semaphore_thread = CreateSemaphore()
Global NewMap m_file_cache_map.i()
Global NewMap m_file_cache.s_file_cache()
Global NewMap m_clients.s_clients(conf_max_clients)
2020-11-08 01:31:57 +01:00
Global NewMap m_request.s_request_handler()
2020-11-03 19:09:17 +01:00
;}
2020-11-08 01:31:57 +01:00
;********************************
;*
;* Handler Prototypen
;*
Prototype.s WebHandler_Get(Map handler_Map.s())
Prototype.s WebHandler_Post(Map handler_Map.s(), ContentString.s)
Prototype.s WebHandler_Universal(Map handler_Map.s(), ContentString.s)
2020-11-03 19:09:17 +01:00
;********************************
;*
;* Proceduren Deklarierung
;*
Declare server(network_server_id.i)
2020-11-27 11:52:35 +01:00
Declare server_SSL(network_server_id.i)
2020-11-03 19:09:17 +01:00
Declare client(network_client_id.i)
Declare AddFileToCache(MemoryID.i, FileName.s, Size.i)
Declare FileCache(Information.i)
2020-11-08 01:31:57 +01:00
Declare call_request(RequestString.s, Info.i=#get_handler_procedure)
2020-11-03 19:09:17 +01:00
Declare.s http_day(Tag.i)
Declare.s http_month(Monat.i)
Declare.s http_header_generate(Map Header.s())
Declare.s Work_Header_to_JSONMap(String.s)
2020-11-08 01:31:57 +01:00
Declare.s Work_Post_ToJSON_x_www_form_urlencoded(ContentLength.i, MemorSize.i, Memory.i)
2020-11-03 19:09:17 +01:00
Declare.s GetFileFromCache(FileName.s, MemoryID.i)
Procedure set_config(parameter.i=#conf_defaultfile, setting.s="index.html")
Select parameter
Case #conf_port
conf_port = Val(setting)
2020-11-27 11:52:35 +01:00
Case #conf_TLS_Port
conf_TLS_Port = Val(setting)
2020-11-03 19:09:17 +01:00
Case #conf_binding
If IsIPStringValid(setting)
conf_binding = setting
Else
conf_binding = "127.0.0.1"
ProcedureReturn #False
EndIf
2020-11-27 11:52:35 +01:00
Case #conf_TLS_Binding
If IsIPStringValid(setting)
conf_binding = setting
Else
conf_binding = "127.0.0.1"
ProcedureReturn #False
EndIf
Case #conf_TLS_CA
conf_TLS_CA = setting
Case #conf_TLS_Cert
conf_TLS_Cert = setting
Case #conf_TLS_Key
conf_TLS_Key = setting
Case #conf_TLS_Key_Pass
conf_TLS_Key_Pass = setting
Case #conf_TLS_Enable
conf_TLS_enable = Val(setting)
2020-11-03 19:09:17 +01:00
Case #conf_defaultfile
conf_defaultfile = setting
Case #conf_basedir
conf_basedir = setting
Case #conf_error400
conf_error400 = setting ; Kann "integrated" sein wass die integrierte Standard Fehlermeldung hervorruft.
Case #conf_max_clients
If MemoryStatus(#PB_System_FreePhysical) > (Val(setting)*(1024*384))
conf_max_clients = Val(setting)
Else
conf_max_clients = 100
ProcedureReturn #False
EndIf
Case #conf_server_type
conf_server_type = Val(setting)
Case #conf_cache_enable
conf_cache_enable = Val(Setting)
Default
ProcedureReturn #False
EndSelect
ProcedureReturn #True
EndProcedure
Procedure.s get_config(parameter.i=#conf_defaultfile)
Select parameter
Case #conf_defaultfile
ProcedureReturn conf_defaultfile
Case #conf_basedir
ProcedureReturn conf_basedir
Case #conf_error400
ProcedureReturn conf_error400
Case #conf_max_clients
ProcedureReturn Str(conf_max_clients)
Case #conf_server_type
ProcedureReturn Str(conf_server_type)
2020-11-08 01:31:57 +01:00
Case #conf_port
ProcedureReturn Str(conf_port)
2020-11-27 11:52:35 +01:00
Case #conf_TLS_Port
ProcedureReturn Str(conf_TLS_Port)
2020-11-03 19:09:17 +01:00
Default
ProcedureReturn ""
EndSelect
EndProcedure
Procedure start_server()
Global NewMap m_clients.s_clients(conf_max_clients)
2020-11-27 11:52:35 +01:00
Protected tlsresponse.i
;TODO: Create SSL Server
2020-11-03 19:09:17 +01:00
server_id = CreateNetworkServer(#PB_Any, conf_port, #PB_Network_TCP, conf_binding)
2020-11-27 11:52:35 +01:00
If conf_TLS_enable = 1
server_SSL_id = lsocket::CreateSocket(conf_TLS_Port, conf_max_clients, lsocket::#SOCK_STREAM, lsocket::#AF_INET, conf_TLS_binding)
If server_SSL_id
2020-11-28 10:42:10 +01:00
tlsresponse = ltls::InitSimpleTLS(conf_TLS_CA, conf_TLS_Cert, conf_TLS_Key, conf_TLS_Key_Pass)
2020-11-27 11:52:35 +01:00
If tlsresponse > 0
CreateThread(@server_SSL(), server_SSL_id)
Else
2020-11-28 10:42:10 +01:00
Debug "TLS Fehler:"+Str(tlsresponse)
2020-11-27 11:52:35 +01:00
ProcedureReturn #False
EndIf
Else
ProcedureReturn #False
EndIf
EndIf
2020-11-03 19:09:17 +01:00
If server_id
CreateThread(@server(), server_id)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
2020-11-27 11:52:35 +01:00
Procedure server_SSL(network_server_id.i)
;**************************
;*
;* Hauptthread welcher den Netzwerkport verwaltet und den Datenfluss.
;* Erstellt die Subthreads für Clients
;*
Protected.i count_client
Protected.i client_id
thread_alive = #True
Debug "TLS Server Started."
Repeat
client_id = ltls::WaitTLSSocket(network_server_id)
Debug "New TLS Client:"+Str(client_id)
If client_id > 0
If count_client <= conf_max_clients
m_clients(Str(client_id))\client_id = client_id
m_clients(Str(client_id))\client_do_cli = #CLI_DO_WaitDataReceive
m_clients(Str(client_id))\client_do_srv = #SRV_DO_DataReceive
m_clients(Str(client_id))\client_ssl = 1
;Thread erstellen
m_clients(Str(client_id))\client_thread = CreateThread(@client(), client_id)
count_client + 1
Else
Debug "Max TLS Clients reached..."
2020-11-28 10:42:10 +01:00
ltls::CloseTLSSocket(client_id)
2020-11-27 11:52:35 +01:00
EndIf
Else
Break
EndIf
ForEver
2020-11-28 10:42:10 +01:00
ltls::CloseTLS(network_server_id)
2020-11-27 11:52:35 +01:00
EndProcedure
2020-11-03 19:09:17 +01:00
Procedure server(network_server_id.i)
;**************************
;*
;* Hauptthread welcher den Netzwerkport verwaltet und den Datenfluss.
;* Erstellt die Subthreads für Clients
;*
Protected.i network_event , client_id, thread_alive, file_cache_thread
Protected.i count_client
If conf_cache_enable = 1 : file_cache_thread = CreateThread(@FileCache(), 1) : EndIf
thread_alive = #True
Debug "AllOk"
Repeat
2020-11-08 01:31:57 +01:00
;Ist etwas passiert ?
2020-11-27 11:52:35 +01:00
;TODO: SSL Server
2020-11-03 19:09:17 +01:00
network_event = NetworkServerEvent(network_server_id)
Select network_event
Case #PB_NetworkEvent_None
;Kein Event kleine bedenkzeit und CPU entlastung für den Thread einlegen.
Delay(1)
Case #PB_NetworkEvent_Connect
client_id = EventClient()
Debug "***** Client Connected:" + Str(client_id)
If count_client <= conf_max_clients
m_clients(Str(client_id))\client_id = client_id
m_clients(Str(client_id))\client_do_cli = #CLI_DO_WaitDataReceive
;Thread erstellen
m_clients(Str(client_id))\client_thread = CreateThread(@client(), client_id)
count_client + 1
Else
Debug "Max Clients reached..."
CloseNetworkConnection(client_id)
EndIf
Case #PB_NetworkEvent_Data
;Auslesen und in thread speicher geben.
Debug "Client Sent Data:" + Str(client_id)
client_id = EventClient()
If m_clients(Str(client_id))\client_do_cli = #CLI_DO_WaitDataReceive
;Es ist kein Speicher vorhanden... hinzufügen:
m_clients(Str(client_id))\client_do_srv = #SRV_DO_DataReceive
ElseIf m_clients(Str(client_id))\client_do_cli = #CLI_DO_DataWorking
;Clientthread ist noch am Datenverarbeiten.
;Signalisieren das Datenbereitstehen und der Netzwerkthread Blockiert ist...
;10msec Warten bis Thread wieder Arbeiten darf.
m_clients(Str(client_id))\client_do_srv = #SRV_DO_NewDatainBuffer
;Delay()
Else
;* Thread nicht existent?
If IsThread(m_clients(Str(client_id))\client_thread)
;Thread ist existent... funktioniert jedoch was nicht mer...
CloseNetworkConnection(client_id)
m_clients(Str(client_id))\client_do_srv = #SRV_DO_ClientDisconnect
Else
Debug "Systemabsturz ^.^"
CloseNetworkConnection(client_id)
End
EndIf
EndIf
Case #PB_NetworkEvent_Disconnect
;Nur für Debugzweck
Debug "***** Client Disconnected:" + Str(client_id)
client_id = EventClient()
m_clients(Str(client_id))\client_do_srv = #SRV_DO_ClientDisconnect
count_client - 1
EndSelect
Until thread_alive = #False
KillThread(file_cache_thread)
Debug "HTTP Server gestoppt"
EndProcedure
Procedure IsIPStringValid(Adress.s)
Static My_Regex_v4
Static My_Regex_v6_nocompress
Static My_Regex_v6_compress
Static Valid = 0
My_Regex_v4 = CreateRegularExpression(#PB_Any, "^((25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)$")
My_Regex_v6_nocompress = CreateRegularExpression(#PB_Any, "^[0-9a-fA-F]{1,4}(:[0-9a-fA-F]{1,4}){7}$")
My_Regex_v6_compress = CreateRegularExpression(#PB_Any, "^(([0-9A-Fa-f]{1,4}(:[0-9A-Fa-f]{1,4}){0,5})?)::(([0-9A-Fa-f]{1,4}(:[0-9A-Fa-f]{1,4}){0,5})?)$")
If MatchRegularExpression(My_Regex_v4, Adress) And Valid = 0
Debug "My_Regex_v4"
Valid = 1
EndIf
If MatchRegularExpression(My_Regex_v6_nocompress, Adress) And Valid = 0
Debug "My_Regex_v6_nocompress"
Valid = 1
EndIf
If MatchRegularExpression(My_Regex_v6_compress, Adress) And Valid = 0
Debug "My_Regex_v6_compress"
Valid = 1
EndIf
FreeRegularExpression(My_Regex_v4)
FreeRegularExpression(My_Regex_v6_nocompress)
FreeRegularExpression(My_Regex_v6_compress)
If Valid = 1
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure client(network_client_id.i)
2020-11-27 11:52:35 +01:00
Protected thread_cli_id = network_client_id, sent
2020-11-08 23:26:35 +01:00
Protected MyThreadJSON, ToCall, ToCallType
Protected thread_temp_cache.s, thread_temp_cache_memory, temp_receivelength, thread_temp_decode_memory
Protected thread_reasign
2020-11-08 01:31:57 +01:00
Protected thread_data_size, thread_file_handle
Protected.s thread_requested, thread_type, thread_date, thread_header, thread_work, JSONStringToMap, Handler_Response, response_status, PostMapString
2020-11-03 19:09:17 +01:00
Protected thread_buffer, thread_buffer_offset, thread_buffer_length, buffer_sent
2020-11-27 21:43:38 +01:00
Protected sent_length, sent_buffer_address, sent_total
2020-11-03 19:09:17 +01:00
Protected.b thread_alive = #True, error_message = #False
Define NewMap Header.s()
2020-11-08 01:31:57 +01:00
Define NewMap Response.s()
Define NewMap Post.s()
2020-11-03 19:09:17 +01:00
Debug "Client Thread Started. ID:" + Str(network_client_id)
Repeat
;Prüfen ob der Thread was zu tun hat.
;{ Main Server Triggered Things
Select m_clients(Str(thread_cli_id))\client_do_srv
Case #SRV_DO_NOP
;Ressourcen freigeben und Threadzeit reduzieren
Delay(1)
Case #SRV_DO_DataReceive
LastElement(m_clients(Str(thread_cli_id))\datenbuffer())
AddElement(m_clients(Str(thread_cli_id))\datenbuffer())
m_clients(Str(thread_cli_id))\datenbuffer()\Buffer = AllocateMemory(131072)
If m_clients(Str(thread_cli_id))\datenbuffer()\Buffer
m_clients(Str(thread_cli_id))\datenbuffer()\Initialized = #True
Else
Debug "Buffer Initialisierung fehlgeschlagen."
Break
EndIf
2020-11-27 11:52:35 +01:00
;TODO: SSL Read
If m_clients(Str(thread_cli_id))\client_ssl = 1
temp_receivelength = ltls::ReadTLSSocket(thread_cli_id, m_clients(Str(thread_cli_id))\datenbuffer()\Buffer, 65536)
Else
temp_receivelength = ReceiveNetworkData(thread_cli_id, m_clients(Str(thread_cli_id))\datenbuffer()\Buffer, 65536)
EndIf
2020-11-03 19:09:17 +01:00
If temp_receivelength = -1
2020-11-08 01:31:57 +01:00
Debug "Empfangsfehler."
2020-11-03 19:09:17 +01:00
Break
ElseIf temp_receivelength = 65536
2020-11-08 01:31:57 +01:00
m_clients(Str(thread_cli_id))\datenbuffer()\Size = temp_receivelength
2020-11-03 19:09:17 +01:00
counter_mem_buffers = 2
Repeat
AddElement(m_clients(Str(thread_cli_id))\datenbuffer())
m_clients(Str(thread_cli_id))\datenbuffer()\Buffer = AllocateMemory(131072)
If m_clients(Str(thread_cli_id))\datenbuffer()\Buffer
m_clients(Str(thread_cli_id))\datenbuffer()\Initialized = #True
Else
Debug "Buffer Initialisierung fehlgeschlagen."
Break 2
EndIf
2020-11-27 11:52:35 +01:00
;TODO: SSL Read 2
If m_clients(Str(thread_cli_id))\client_ssl = 1
temp_receivelength = ltls::ReadTLSSocket(thread_cli_id, m_clients(Str(thread_cli_id))\datenbuffer()\Buffer, 65536)
Else
temp_receivelength = ReceiveNetworkData(thread_cli_id, m_clients(Str(thread_cli_id))\datenbuffer()\Buffer, 65536)
EndIf
2020-11-08 01:31:57 +01:00
m_clients(Str(thread_cli_id))\datenbuffer()\Size = temp_receivelength
2020-11-03 19:09:17 +01:00
counter_mem_buffers + 1
If temp_receivelength = -1
Break 2
EndIf
Until temp_receivelength < 65536
2020-11-08 01:31:57 +01:00
Else
m_clients(Str(thread_cli_id))\datenbuffer()\Size = temp_receivelength
2020-11-03 19:09:17 +01:00
EndIf
;Alle Daten empfangen.
Debug "Anzahl Buffer:" + Str(ListSize(m_clients(Str(thread_cli_id))\datenbuffer()))
m_clients(Str(thread_cli_id))\client_do_srv = #SRV_DO_NOP
m_clients(Str(thread_cli_id))\client_do_cli = #CLI_DO_DataWorking
Case #SRV_DO_ClientDisconnect
;Thread beenden
Debug "#SRV_DO_ClientDisconnect"
thread_alive = #False
;* Alles IO
Default
;Ressourcen freigeben und Threadzeit reduzieren
Delay(1)
Debug "--------------------------------------------------------- FAILING ???"
EndSelect
;}
;{ Client Side Triggered Things
If thread_alive = #True
Select m_clients(Str(thread_cli_id))\client_do_cli
Case #CLI_DO_DataWorking
;Empfang abgeschlossen
;Buffer Bearbeiten
2020-11-08 01:31:57 +01:00
;Thread in Bearbeitungsmodus Setzen.
;TODO: Was ist mit zusammenhängenden Datenbuffern grosse Post/Put z.B.
2020-11-03 19:09:17 +01:00
;{
Debug "Daten vollständig empfangen. Abarbeiten."
m_clients(Str(thread_cli_id))\client_do_cli = #CLI_DO_DataWorking
;Abarbeiten der Anforderung...
ResetList(m_clients(Str(thread_cli_id))\datenbuffer())
While NextElement(m_clients(Str(thread_cli_id))\datenbuffer())
2020-11-08 01:31:57 +01:00
thread_work = PeekS(m_clients(Str(thread_cli_id))\datenbuffer()\Buffer, m_clients(Str(thread_cli_id))\datenbuffer()\Size, #PB_Ascii)
2020-11-03 19:09:17 +01:00
;Header to Map
2020-11-27 21:43:38 +01:00
;Debug "Datenbuffer:"+ Mid(thread_work,1,256)
2020-11-03 19:09:17 +01:00
JSONStringToMap = Work_Header_to_JSONMap(thread_work)
If JSONStringToMap <> #error_string
MyThreadJSON = ParseJSON(#PB_Any, JSONStringToMap)
If MyThreadJSON
ClearMap(Header())
ExtractJSONMap(JSONValue(MyThreadJSON), Header())
FreeJSON(MyThreadJSON)
Else
;WTF ???
2020-11-08 01:31:57 +01:00
Break 2 ; Thread abschiessen
2020-11-03 19:09:17 +01:00
EndIf
Else
error_message = #True
EndIf
2020-11-27 21:43:38 +01:00
;Debug "JSONString:"+ JSONStringToMap
2020-11-08 01:31:57 +01:00
thread_type = ""
Select Header(#http_head_method)
Case #http_method_get
;********************************
;*
;* Default GET
;*
;{
Debug #http_method_get
If Header(#http_head_request) = "/"
thread_requested = conf_defaultfile
Else
thread_requested = Header(#http_head_request)
EndIf
Debug "Requested:"+thread_requested
ToCallType = call_request(thread_requested, #get_handler_prototype)
If ToCallType = #handler_proto_universal Or ToCallType = #handler_proto_get
ToCall = call_request(thread_requested)
Else
ToCall = 0
EndIf
2020-11-03 19:09:17 +01:00
2020-11-08 01:31:57 +01:00
If ToCall > 0 ;Dann ist eine Funktion hinterlegt und zulässig aufgerufen zu werden.
;{ Dynamischer WebHandler
Select ToCallType
Case #handler_proto_universal
Define.WebHandler_Universal ToCallProcedure = ToCall
Handler_Response = ToCallProcedure(Header(), "")
Case #handler_proto_get
Define.WebHandler_Get ToCallProcedure = ToCall
Handler_Response = ToCallProcedure(Header())
EndSelect
Debug "Main Client Response :"+Handler_Response
MyThreadJSON = ParseJSON(#PB_Any, Handler_Response)
If MyThreadJSON
ClearMap(Response())
ExtractJSONMap(JSONValue(MyThreadJSON), Response())
FreeJSON(MyThreadJSON)
2020-11-03 19:09:17 +01:00
Else
2020-11-08 01:31:57 +01:00
;WTF ???
Debug "Fehler Absturz"
Break 2 ; Thread abschiessen
EndIf
Debug "Response Content:"+Response(#cha_R_ResponseContentType)
Select Response(#cha_R_ResponseContentType)
Case #response_Memory
thread_data_size = Val(Response(#cha_R_MemorySize))
thread_temp_cache_memory = Val(Response(#cha_R_MemoryAdress))
thread_type = Response(#cha_R_ResponseType)
Case #response_string
thread_temp_decode_memory = AllocateMemory(StringByteLength(Response(#cha_R_StringBase64)))
thread_data_size = Base64Decoder(Response(#cha_R_StringBase64), thread_temp_decode_memory, StringByteLength(Response(#cha_R_StringBase64)))
thread_temp_cache_memory = AllocateMemory(thread_data_size)
CopyMemory(thread_temp_decode_memory, thread_temp_cache_memory, thread_data_size)
FreeMemory(thread_temp_decode_memory)
thread_type = Response(#cha_R_ResponseType)
Default
;Solte ja nicht passieren.
EndSelect
Debug "Content Finished"
;}
ElseIf conf_cache_enable = 1
;{ Cached File Handling BUGGY!!!!!!!
thread_temp_cache_memory = AllocateMemory(1024)
thread_temp_cache = GetFileFromCache(thread_requested, thread_temp_cache_memory)
If thread_temp_cache = #error_string
thread_file_handle = ReadFile(#PB_Any, conf_basedir + thread_requested,#PB_File_SharedRead)
If thread_file_handle
;Alles Ok
Else
thread_file_handle = ReadFile(#PB_Any, conf_basedir + conf_defaultfile,#PB_File_SharedRead)
Debug "FileDir:" + conf_basedir + conf_defaultfile
If Not thread_file_handle
thread_file_handle = ReadFile(#PB_Any, "error.html")
EndIf
2020-11-03 19:09:17 +01:00
EndIf
2020-11-08 01:31:57 +01:00
thread_data_size = Lof(thread_file_handle)
thread_temp_cache_memory = ReAllocateMemory(thread_temp_cache_memory, thread_data_size)
ReadData(thread_file_handle, thread_temp_cache_memory, thread_data_size)
CloseFile(thread_file_handle)
AddFileToCache(thread_temp_cache_memory, thread_requested, thread_data_size)
2020-11-03 19:09:17 +01:00
2020-11-08 01:31:57 +01:00
Else
thread_data_size = Val(StringField(thread_temp_cache, 1, ":"))
thread_temp_cache_memory = Val(StringField(thread_temp_cache, 2, ":"))
2020-11-03 19:09:17 +01:00
EndIf
2020-11-08 01:31:57 +01:00
;}
2020-11-03 19:09:17 +01:00
Else
2020-11-08 01:31:57 +01:00
;{ Uncached File Handling scheint stabil zu funktionieren mit Getestet 200 Clients à 100 Requests
thread_file_handle = ReadFile(#PB_Any, conf_basedir + thread_requested,#PB_File_SharedRead)
If Not thread_file_handle
thread_file_handle = ReadFile(#PB_Any, conf_basedir + conf_defaultfile,#PB_File_SharedRead)
Debug "FileDir:" + conf_basedir + conf_defaultfile
If Not thread_file_handle
thread_file_handle = ReadFile(#PB_Any, "error.html")
EndIf
EndIf
thread_data_size = Lof(thread_file_handle)
thread_temp_cache_memory = AllocateMemory(thread_data_size)
ReadData(thread_file_handle, thread_temp_cache_memory, thread_data_size)
CloseFile(thread_file_handle)
;}
2020-11-03 19:09:17 +01:00
EndIf
2020-11-08 01:31:57 +01:00
;}
Case #http_method_post
2020-11-03 19:09:17 +01:00
2020-11-08 01:31:57 +01:00
;********************************
;*
;* POST
;*
Debug #http_method_post
;PrintN("POST")
If LCase(Header(#http_head_content_type)) = #http_content_type_application_x_www_form_urlencoded
PostMapString = Work_Post_ToJSON_x_www_form_urlencoded(Val(Header(#http_head_content_length)), m_clients(Str(thread_cli_id))\datenbuffer()\Size, m_clients(Str(thread_cli_id))\datenbuffer()\Buffer)
MyThreadJSON = ParseJSON(#PB_Any, PostMapString)
If MyThreadJSON
ClearMap(Post())
ExtractJSONMap(JSONValue(MyThreadJSON), Post())
FreeJSON(MyThreadJSON)
Else
;WTF ???
Debug "Fehler Absturz"
Break 2 ; Thread abschiessen
EndIf
2020-11-03 19:09:17 +01:00
EndIf
2020-11-08 01:31:57 +01:00
If Header(#http_head_request) = "/"
thread_requested = conf_defaultfile
Else
thread_requested = Header(#http_head_request)
EndIf
Debug "Requested:"+thread_requested
ToCallType = call_request(thread_requested, #get_handler_prototype)
If ToCallType = #handler_proto_universal Or ToCallType = #handler_proto_post
ToCall = call_request(thread_requested)
Else
ToCall = 0
EndIf
2020-11-03 19:09:17 +01:00
2020-11-08 01:31:57 +01:00
If ToCall > 0 ;Dann ist eine Funktion hinterlegt und zulässig aufgerufen zu werden.
;{ Dynamischer WebHandler
Select ToCallType
Case #handler_proto_universal
Define.WebHandler_Universal ToCallProcedure = ToCall
Handler_Response = ToCallProcedure(Header(), PostMapString )
Case #handler_proto_post
Define.WebHandler_Post ToCallProcedure = ToCall
Handler_Response = ToCallProcedure(Header(), PostMapString)
EndSelect
Debug "Main Client Response :"+Handler_Response
MyThreadJSON = ParseJSON(#PB_Any, Handler_Response)
If MyThreadJSON
ClearMap(Response())
ExtractJSONMap(JSONValue(MyThreadJSON), Response())
FreeJSON(MyThreadJSON)
Else
;WTF ???
Debug "Fehler Absturz"
Break 2 ; Thread abschiessen
EndIf
Debug "Response Content:"+Response(#cha_R_ResponseContentType)
Select Response(#cha_R_ResponseContentType)
Case #response_Memory
thread_data_size = Val(Response(#cha_R_MemorySize))
thread_temp_cache_memory = Val(Response(#cha_R_MemoryAdress))
thread_type = Response(#cha_R_ResponseType)
Case #response_string
thread_temp_decode_memory = AllocateMemory(StringByteLength(Response(#cha_R_StringBase64)))
thread_data_size = Base64Decoder(Response(#cha_R_StringBase64), thread_temp_decode_memory, StringByteLength(Response(#cha_R_StringBase64)))
thread_temp_cache_memory = AllocateMemory(thread_data_size)
CopyMemory(thread_temp_decode_memory, thread_temp_cache_memory, thread_data_size)
FreeMemory(thread_temp_decode_memory)
thread_type = Response(#cha_R_ResponseType)
Default
;Solte ja nicht passieren.
EndSelect
Debug "Content Finished"
;}
ElseIf conf_cache_enable = 1
;{ Cached File Handling BUGGY!!!!!!!
thread_temp_cache_memory = AllocateMemory(1024)
thread_temp_cache = GetFileFromCache(thread_requested, thread_temp_cache_memory)
If thread_temp_cache = #error_string
thread_file_handle = ReadFile(#PB_Any, conf_basedir + thread_requested,#PB_File_SharedRead)
If thread_file_handle
;Alles Ok
Else
thread_file_handle = ReadFile(#PB_Any, conf_basedir + conf_defaultfile,#PB_File_SharedRead)
Debug "FileDir:" + conf_basedir + conf_defaultfile
If Not thread_file_handle
thread_file_handle = ReadFile(#PB_Any, "error.html")
EndIf
EndIf
thread_data_size = Lof(thread_file_handle)
thread_temp_cache_memory = ReAllocateMemory(thread_temp_cache_memory, thread_data_size)
ReadData(thread_file_handle, thread_temp_cache_memory, thread_data_size)
CloseFile(thread_file_handle)
AddFileToCache(thread_temp_cache_memory, thread_requested, thread_data_size)
Else
thread_data_size = Val(StringField(thread_temp_cache, 1, ":"))
thread_temp_cache_memory = Val(StringField(thread_temp_cache, 2, ":"))
EndIf
;}
Else
;{ Uncached File Handling scheint stabil zu funktionieren mit Getestet 200 Clients à 100 Requests
thread_file_handle = ReadFile(#PB_Any, conf_basedir + thread_requested,#PB_File_SharedRead)
If Not thread_file_handle
thread_file_handle = ReadFile(#PB_Any, conf_basedir + conf_defaultfile,#PB_File_SharedRead)
Debug "FileDir:" + conf_basedir + conf_defaultfile
If Not thread_file_handle
thread_file_handle = ReadFile(#PB_Any, "error.html")
EndIf
EndIf
thread_data_size = Lof(thread_file_handle)
thread_temp_cache_memory = AllocateMemory(thread_data_size)
ReadData(thread_file_handle, thread_temp_cache_memory, thread_data_size)
CloseFile(thread_file_handle)
;}
EndIf
If Header(#http_head_request) = "/"
thread_requested = conf_defaultfile
Else
thread_requested = Header(#http_head_request)
EndIf
thread_file_handle = ReadFile(#PB_Any, conf_basedir + thread_requested,#PB_File_SharedRead)
If Not thread_file_handle
thread_file_handle = ReadFile(#PB_Any, conf_basedir + conf_defaultfile,#PB_File_SharedRead)
Debug "FileDir:" + conf_basedir + thread_requested
If Not thread_file_handle
thread_file_handle = ReadFile(#PB_Any, "error.html")
EndIf
EndIf
2020-11-08 17:31:26 +01:00
2020-11-08 01:31:57 +01:00
Default
;************************************
;*
;* Not a supported Command in HTTP Header Cleanup.
;*
;* Read Buffer to Memory and Clear Buffer to Zero until the complete Networkbuffer from this Client is Cleaned.
;*
EndSelect
2020-11-08 17:31:26 +01:00
If thread_data_size
If thread_type =""
thread_type = mimetype(GetExtensionPart(thread_requested))
EndIf
thread_date = http_day(DayOfWeek(Date())) +
Str(Day(Date())) +
http_month(Month(Date())) +
Str(Year(Date())) +
" " +
FormatDate("%hh:%ii:%ss GMT+1", Date())
ClearMap(Header())
If Response(#cha_R_http_head_status) <> ""
Header(#http_head_status) = Response(#cha_R_http_head_status)
ElseIf response_status <> ""
Header(#http_head_status) = response_status
Else
Header(#http_head_status) = "200 OK"
EndIf
Header(#http_head_content_length) = Str(thread_data_size)
Header(#http_head_content_type) = thread_type
Header(#http_head_connection) = "Keep-Alive"
Header(#http_head_keep_alive) = "timeout=15, max=1000"
thread_header = http_header_generate(Header())
thread_buffer = AllocateMemory(thread_data_size+StringByteLength(thread_header)+12)
thread_buffer_offset = thread_buffer
thread_buffer_length = PokeS(thread_buffer_offset, thread_header,-1, #PB_UTF8|#PB_String_NoZero) : thread_buffer_offset + thread_buffer_length
Debug "Header Finished"
EndIf
2020-11-27 21:43:38 +01:00
If thread_temp_cache_memory <> 0 And thread_buffer_offset <> 0 And thread_data_size <> 0
CopyMemory(thread_temp_cache_memory, thread_buffer_offset, thread_data_size)
FreeMemory(thread_temp_cache_memory)
Else
Debug "File Buffer Troubles."
EndIf
2020-11-03 19:09:17 +01:00
; EndIf
Debug "HTTP File Buffer Cleaned."
;Löschen des eingang Speichers.
2020-11-08 01:31:57 +01:00
If m_clients(Str(thread_cli_id))\datenbuffer()\Buffer > 0
FreeMemory(m_clients(Str(thread_cli_id))\datenbuffer()\Buffer)
EndIf
2020-11-03 19:09:17 +01:00
DeleteElement(m_clients(Str(thread_cli_id))\datenbuffer())
;Daten Senden...
2020-11-27 11:52:35 +01:00
;TODO: SSL Send
2020-11-27 21:43:38 +01:00
sent_total = thread_data_size+(thread_buffer_offset-thread_buffer)
2020-11-27 11:52:35 +01:00
If m_clients(Str(thread_cli_id))\client_ssl = 1
2020-11-27 21:43:38 +01:00
sent_length = sent_total
sent_buffer_address = thread_buffer
sent_total = 0
Repeat
sent = ltls::WriteTLSSocket(thread_cli_id, sent_buffer_address , sent_length)
If sent <> -1
Debug "TLS Sent:"+Str(sent)+" bytes"
sent_length - sent
sent_buffer_address + sent
sent_total + sent
Else
Debug "TLS Sent error:"+ltls::ErrorTLSCli(thread_cli_id)
EndIf
Until sent_length <= 0
sent = sent_total
thread_alive = #False
2020-11-27 11:52:35 +01:00
Else
sent = SendNetworkData(thread_cli_id, thread_buffer , thread_data_size+(thread_buffer_offset-thread_buffer))
EndIf
2020-11-03 19:09:17 +01:00
2020-11-27 11:52:35 +01:00
If sent = thread_data_size+(thread_buffer_offset-thread_buffer)
2020-11-03 19:09:17 +01:00
;Ok
;Debug "Gesendet:" + PeekS(thread_buffer,thread_buffer_length, #PB_Ascii)
FreeMemory(thread_buffer)
m_clients(Str(thread_cli_id))\client_do_cli = #CLI_DO_WaitDataReceive
m_clients(Str(thread_cli_id))\client_do_srv = #SRV_DO_NOP
Else
;Fehler beim Senden ... Thread beenden.
2020-11-27 21:43:38 +01:00
Debug "Fehler:" + Str(Sent)
2020-11-03 19:09:17 +01:00
thread_alive = #False
EndIf
;
Wend
;}
m_clients(Str(thread_cli_id))\client_do_cli = #CLI_DO_WaitDataReceive
EndSelect
EndIf
2020-11-08 01:31:57 +01:00
;}
2020-11-03 19:09:17 +01:00
Until thread_alive = #False
ResetList(m_clients(Str(thread_cli_id))\datenbuffer())
While NextElement(m_clients(Str(thread_cli_id))\datenbuffer())
If m_clients(Str(thread_cli_id))\datenbuffer()\Initialized
FreeMemory(m_clients(Str(thread_cli_id))\datenbuffer()\Buffer)
DeleteElement(m_clients(Str(thread_cli_id))\datenbuffer())
Else
DeleteElement(m_clients(Str(thread_cli_id))\datenbuffer())
EndIf
Wend
2020-11-27 21:43:38 +01:00
If m_clients(Str(thread_cli_id))\client_ssl = 1
ltls::CloseTLSSocket(thread_cli_id)
EndIf
2020-11-03 19:09:17 +01:00
DeleteMapElement(m_clients(), Str(thread_cli_id))
Debug "Thread Beendet."
EndProcedure
2020-11-08 01:31:57 +01:00
2020-11-03 19:09:17 +01:00
Procedure.s mimetype(file.s)
Select file
Case "png"
ProcedureReturn "image/png"
Case "gif"
ProcedureReturn "image/gif"
Case "jpg"
ProcedureReturn "image/jpeg"
Case "jpeg"
ProcedureReturn "image/jpeg"
Case "txt"
ProcedureReturn "text/plain"
Case "html"
ProcedureReturn "text/html"
Case "htm"
ProcedureReturn "text/html"
Case "mss"
ProcedureReturn "text/html"
Case "css"
ProcedureReturn "text/css"
Case "js"
ProcedureReturn "text/javascript"
Default
ProcedureReturn "text/html"
EndSelect
EndProcedure
Procedure.s http_day(Tag.i)
Select DayOfWeek(Date())
Case 0
ProcedureReturn "Sun, "
Case 1
ProcedureReturn "Mon, "
Case 2
ProcedureReturn "Tue, "
Case 3
ProcedureReturn "Wed, "
Case 4
ProcedureReturn "Thur, "
Case 5
ProcedureReturn "Fri, "
Case 6
ProcedureReturn "Sat, "
EndSelect
EndProcedure
Procedure.s http_month(Monat.i)
Select Month(Date())
Case 1
ProcedureReturn " Jan "
Case 2
ProcedureReturn " Feb "
Case 3
ProcedureReturn " Mar "
Case 4
ProcedureReturn " Apr "
Case 5
ProcedureReturn " May "
Case 6
ProcedureReturn " June "
Case 7
ProcedureReturn " July "
Case 8
ProcedureReturn " Aug "
Case 9
ProcedureReturn " Sept "
Case 10
ProcedureReturn " Oct "
Case 11
ProcedureReturn " Nov "
Case 12
ProcedureReturn " Dec "
EndSelect
EndProcedure
Procedure.s http_header_generate(Map Header.s())
Protected.s v_http_header, v_current
If Not FindMapElement(Header(), #http_head_status) : Header(#http_head_status) = "400 Bad Request" : EndIf
If Not FindMapElement(Header(), #http_head_date) : Header(#http_head_date) = http_day(DayOfWeek(Date())) +
Str(Day(Date())) +
http_month(Month(Date())) +
Str(Year(Date())) +
" " +
FormatDate("%hh:%ii:%ss GMT+1", Date()) : EndIf
If Not FindMapElement(Header(), #http_head_server) : Header(#http_head_server) = conf_titel : EndIf
If Not FindMapElement(Header(), #http_head_content_length) : Header(#http_head_content_length) = "0" : EndIf
If Not FindMapElement(Header(), #http_head_content_type) : Header(#http_head_content_type) = "text/txt" : EndIf
2020-11-08 23:26:35 +01:00
v_http_header = "HTTP/1.1 " + Header(#http_head_status) + #CRLF$ +
#http_head_date + " " + Header(#http_head_date) + #CRLF$ +
#http_head_server + " " + Header(#http_head_server) + #CRLF$ +
#http_head_content_length + " " + Header(#http_head_content_length) + #CRLF$ +
#http_head_content_type + " " + Header(#http_head_content_type) + #CRLF$
2020-11-03 19:09:17 +01:00
If MapSize(Header()) > 5
ResetMap(Header())
While NextMapElement(Header())
v_current = MapKey(Header())
If Bool(v_current <> #http_head_status And v_current <> #http_head_date And v_current <> #http_head_server And v_current <> #http_head_content_length And v_current <> #http_head_content_type)
2020-11-08 23:26:35 +01:00
v_http_header + v_current + " " + Header(v_current) + #CRLF$
2020-11-03 19:09:17 +01:00
EndIf
Wend
EndIf
2020-11-08 23:26:35 +01:00
v_http_header + #CRLF$
2020-11-03 19:09:17 +01:00
ProcedureReturn v_http_header
EndProcedure
Procedure.s Work_Header_to_JSONMap(String.s)
Protected NewMap Header.s()
Define.s JSONString, Working, Working_Line
Define CountLines, Lines, JSON
2020-11-08 23:26:35 +01:00
If CountString(String,#CRLF$+#CRLF$)
Working = StringField(String,1,#CRLF$+#CRLF$)
2020-11-03 19:09:17 +01:00
Else
ProcedureReturn #error_string
EndIf
Lines = CountString(Working,#CRLF$)
If Lines
Working_Line = StringField(Working,1,#CRLF$)
If CountString(Working_Line," ")
Header(#http_head_method) = UCase(StringField(Working_Line,1," "))
Header(#http_head_request) = StringField(Working_Line,2," ")
Header(#http_head_protocol) = UCase(StringField(Working_Line,3," "))
If CountString(Header(#http_head_request), "?")
Header(#http_head_query) = StringField(Header(#http_head_request),2,"?")
Header(#http_head_request) = StringField(Header(#http_head_request),1,"?")
Else
Header(#http_head_query) = ""
EndIf
For CountLines = 2 To Lines
Working_Line = StringField(Working,CountLines,#CRLF$)
Header(LCase(Trim(StringField(Working_Line,1,":")))+":") = Trim(StringField(Working_Line,2,":"))
Next
Else
FreeMap(Header())
ProcedureReturn #error_string
EndIf
Else
FreeMap(Header())
ProcedureReturn #error_string
EndIf
JSON = CreateJSON(#PB_Any)
If JSON
InsertJSONMap(JSONValue(JSON), Header())
JSONString = ComposeJSON(JSON)
FreeMap(Header())
FreeJSON(JSON)
ProcedureReturn JSONString.s
Else
ProcedureReturn #error_string
EndIf
EndProcedure
2020-11-08 01:31:57 +01:00
Procedure call_request(RequestString.s, Info.i = #get_handler_procedure)
Protected CurrPos, Count, Counter, PartString.s
If m_request(GetExtensionPart(RequestString))\routetype = #handler_type
Select Info
Case #get_handler_procedure
ProcedureReturn m_request(GetExtensionPart(RequestString))\call
Case #get_handler_prototype
ProcedureReturn m_request(GetExtensionPart(RequestString))\type
Default
ProcedureReturn 0
EndSelect
EndIf
If m_request(RequestString)\routetype = #handler_only Or m_request(RequestString)\routetype = #handler_sub
Select Info
Case #get_handler_procedure
ProcedureReturn m_request(RequestString)\call
Case #get_handler_prototype
ProcedureReturn m_request(RequestString)\type
Default
ProcedureReturn 0
EndSelect
ElseIf m_request(GetExtensionPart(RequestString))\routetype = #handler_sub
Select Info
Case #get_handler_procedure
ProcedureReturn m_request(GetExtensionPart(RequestString))\call
Case #get_handler_prototype
ProcedureReturn m_request(GetExtensionPart(RequestString))\type
Default
ProcedureReturn 0
EndSelect
EndIf
;Check auf Sub
Counter = CountString(RequestString, "/")
Count = 0
CurrPos = 0
While Count < Counter
CurrPos = FindString(RequestString, "/", 2 + CurrPos )
PartString = Mid(RequestString, 1, CurrPos)
If m_request(PartString)\routetype = #handler_sub
Select Info
Case #get_handler_procedure
ProcedureReturn m_request(PartString)\call
Case #get_handler_prototype
ProcedureReturn m_request(PartString)\type
Default
ProcedureReturn 0
EndSelect
EndIf
Count + 1
Wend
ProcedureReturn 0
EndProcedure
2020-11-27 11:58:18 +01:00
Procedure.s MapToJSONString(Map ConvertMap.s())
2020-11-08 01:31:57 +01:00
Protected MyJSON
Protected.s Response
MyJSON = CreateJSON(#PB_Any)
If MyJSON
InsertJSONMap(JSONValue(MyJSON), ConvertMap())
Response = ComposeJSON(MyJSON)
FreeJSON(MyJSON)
ProcedureReturn Response
EndIf
ProcedureReturn #error_string
EndProcedure
Procedure.s Work_Post_ToJSON_x_www_form_urlencoded(ContentLength.i, MemorSize.i, Memory.i)
Define.s JSONString, Working, ContentString
Define CountParams, Count, JSON
Protected NewMap Posts.s()
If ContentLength > 0
OffsetMemory = Memory + (MemorSize - ContentLength)
ContentString = PeekS(OffsetMemory, ContentLength, #PB_UTF8)
;Zerlegen &
;Mapname = Content
If Len(ContentString) > 0
CountParams = CountString(ContentString,"&")
If CountParams = 0
If CountString(ContentString, "=")
Posts(StringField(ContentString, 1, "=")) = StringField(ContentString,2, "=")
Else
ProcedureReturn ""
EndIf
ElseIf CountParams > 0
Count = 0
Repeat
Posts(StringField(StringField(ContentString, Count + 1, "&"),1,"=")) = StringField(StringField(ContentString, Count + 1, "&"),2,"=")
;Debug "Worked Count:"+Str(Count)+" of: "+Str(CountParams)+":"+StringField(StringField(ContentString, Count + 1, "&"),1,"=")+" = "+StringField(StringField(ContentString, Count + 1, "&"),2,"=")
Count + 1
Until Count > CountParams
Else
ProcedureReturn ""
EndIf
JSON = CreateJSON(#PB_Any)
If JSON
InsertJSONMap(JSONValue(JSON), Posts())
JSONString = ComposeJSON(JSON)
FreeMap(Posts())
FreeJSON(JSON)
ProcedureReturn JSONString.s
Else
ProcedureReturn #error_string
EndIf
Else
ProcedureReturn ""
EndIf
Else
ProcedureReturn ""
EndIf
EndProcedure
Procedure.s register_client_handler(Route.s, Callback.i, AppPrototype.i = #handler_proto_get, RouteType.i = #handler_sub)
m_request(Route)\type = AppPrototype
m_request(Route)\call = Callback
m_request(Route)\routetype = RouteType
Debug "Handler Registriert:"+Route
EndProcedure
;Buggy FileCache Routines ... Wiso auch immer das noch nicht richtig Funktioniert.
Procedure FileCacheCleaner(Information.i)
Protected.i Selected
Protected.i Counter
Protected.i MaxSize = Information
Repeat
Delay(1000) ;Nur Alle Sekunden Prüfen
Counter + 1
LockMutex(file_cache_mutex)
ResetMap(m_file_cache_map())
;Debug "FileCacheCleaner" + Str(Counter) + " Map Size:" + Str(MapSize(m_file_cache_map()))
If NextMapElement(m_file_cache_map())
Repeat
m_file_cache(MapKey(m_file_cache_map()))\Timer - 1
If m_file_cache(MapKey(m_file_cache_map()))\Timer <= 0
If m_file_cache(MapKey(m_file_cache_map()))\Buffer > 0
conf_cache_current - m_file_cache(MapKey(m_file_cache_map()))\Size
FreeMemory(m_file_cache(MapKey(m_file_cache_map()))\Buffer)
DeleteMapElement(m_file_cache(), MapKey(m_file_cache_map()))
Debug "Info:["+Str(innercount)+"] Killed:["+MapKey(m_file_cache_map())+"]"
Selected = DeleteMapElement(m_file_cache_map())
Else
Debug "Info:["+Str(innercount)+"] Could Not kill:["+MapKey(m_file_cache_map())+"]"
EndIf
Else
Selected = NextMapElement(m_file_cache_map())
EndIf
Until Selected = 0
EndIf
UnlockMutex(file_cache_mutex)
ForEver
EndProcedure
Procedure FileCache(Information.i)
;http://purearea.net/pb/english/manual/reference/ug_memory.html
Protected FileCacheCleanerThread.i
Protected Tempbuffer.i, MaxSize.i, Current.i
MaxSize = conf_cache_maxsize * 1024 * 1024
FileCacheCleanerThread = CreateThread(@FileCacheCleaner(), MaxSize)
Repeat
WaitSemaphore(file_cache_semaphore)
Debug "Adresse:"+m_file_cache()\Buffer
If (m_file_cache()\Size + conf_cache_current) <= MaxSize
conf_cache_current + m_file_cache()\Size
Tempbuffer = AllocateMemory(m_file_cache()\Size)
CopyMemory(m_file_cache()\Buffer, Tempbuffer, MemorySize(m_file_cache()\Buffer))
m_file_cache()\Buffer = Tempbuffer
m_file_cache()\Timer = conf_cache_time
m_file_cache()\Is = #True
m_file_cache_map(MapKey(m_file_cache())) = #True
SignalSemaphore(file_cache_semaphore_thread)
Else
Debug "Cache Full"
SignalSemaphore(file_cache_semaphore_thread)
EndIf
ForEver
EndProcedure
Procedure AddFileToCache(MemoryID.i, FileName.s, Size.i)
LockMutex(file_cache_mutex)
Debug "Cache MaxSize:"+Str(conf_cache_maxsize*1024*1024)+" Actual Size:"+Str(conf_cache_current)
m_file_cache(FileName)\Buffer = MemoryID
m_file_cache(FileName)\Size = Size
SignalSemaphore(file_cache_semaphore)
WaitSemaphore(file_cache_semaphore_thread)
If m_file_cache(FileName)\Is
Debug FileName+" Size:"+Str(m_file_cache(FileName)\Size)+" Timer:"+Str(m_file_cache(FileName)\Timer)+ " new Memory ID:"+Str(m_file_cache(FileName)\Buffer)
Else
Debug "File not in cache was to full:"+FileName+ " MaxSize:"+Str(conf_cache_maxsize)+" Actual Size:"+Str(conf_cache_current/1024/1024)
EndIf
UnlockMutex(file_cache_mutex)
EndProcedure
Procedure.s GetFileFromCache(FileName.s, MemoryID.i)
Protected String.s
If TryLockMutex(file_cache_mutex)
If m_file_cache(FileName)\Is
MemoryID = ReAllocateMemory(MemoryID, m_file_cache(FileName)\Size)
CopyMemory(m_file_cache(FileName)\Buffer, MemoryID, m_file_cache(FileName)\Size)
String.s = Str(m_file_cache(FileName)\Size) + ":" + Str(MemoryID)
Else
String.s = #error_string
EndIf
UnlockMutex(file_cache_mutex)
Debug "Get from cache: "+FileName+">"+String+"-------------------------------------------------------------<"
ProcedureReturn String.s
Else
ProcedureReturn #error_string
EndIf
2020-11-03 19:09:17 +01:00
EndProcedure
EndModule
