1316 lines
52 KiB
Plaintext
1316 lines
52 KiB
Plaintext
;********************************
|
|
;*
|
|
;* lweb-srv.pbi V0.9
|
|
;*
|
|
;* LiHaSo Webserver Main module.
|
|
;*
|
|
;* It is usable as standalone Webserver, look at lwebd.pb
|
|
;*
|
|
|
|
|
|
XIncludeFile "ltls.pbi"
|
|
|
|
Module lhs_web
|
|
;********************************
|
|
;*
|
|
;* WebServer Variabeln / Parameter
|
|
;*
|
|
;{
|
|
|
|
;*
|
|
;* Identifikation des Servers.
|
|
;*
|
|
|
|
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_HTTP_clients = 10 ; Max sametime HTTP connections.
|
|
Global.i conf_max_HTTPS_clients = 100 ; Max sametime HTTPS connections.
|
|
Global.i conf_server_type = 0
|
|
Global.i conf_HTTP_port = 8080
|
|
Global.s conf_HTTP_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
|
|
Global.i conf_cache_enable = 0
|
|
Global.i conf_HTTPS_Port = 8443
|
|
Global.s conf_HTTPS_binding = "127.0.0.1"
|
|
Global.i conf_HTTPS_enable = 0 ;SSL Server
|
|
Global.s conf_HTTPS_CA = ""
|
|
Global.s conf_HTTPS_Cert = ""
|
|
Global.s conf_HTTPS_Key = ""
|
|
Global.s conf_HTTPS_Key_Pass = ""
|
|
|
|
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
|
|
EndEnumeration
|
|
|
|
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.
|
|
EndEnumeration
|
|
|
|
Enumeration e_type_client 1
|
|
#client_HTTP
|
|
#client_HTTPS
|
|
EndEnumeration
|
|
|
|
#client_add = 1
|
|
#client_remove = -1
|
|
|
|
#http_method_get = "GET"
|
|
#http_method_post = "POST"
|
|
#http_method_put = "PUT"
|
|
|
|
;***********************
|
|
;* 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
|
|
*Buffer
|
|
Initialized.b
|
|
Size.i
|
|
EndStructure
|
|
|
|
Structure s_file_cache
|
|
*Buffer
|
|
Size.i
|
|
Timer.i
|
|
Is.i
|
|
EndStructure
|
|
|
|
Structure s_clients
|
|
client_id.i
|
|
client_do_cli.i
|
|
client_do_srv.i
|
|
client_type.i ;What type of Client.
|
|
client_mutex.i
|
|
client_thread.i
|
|
List datenbuffer.s_client_memory()
|
|
client_test_cli.i
|
|
client_test_srv.i
|
|
client_cctx.i
|
|
EndStructure
|
|
|
|
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
|
|
|
|
Global.i count_HTTP_client
|
|
Global.i count_HTTPS_client
|
|
Global.i server_HTTP_id
|
|
Global.i server_HTTPS_id
|
|
Global.i server_mutex = CreateMutex() ;Dieser Mutex dient zu der Sicherheit der Element Liste.
|
|
Global.i count_HTTP_mutex = CreateMutex()
|
|
Global.i count_HTTPS_mutex = CreateMutex()
|
|
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_HTTP_clients+conf_max_HTTPS_clients)
|
|
Global NewMap m_request.s_request_handler()
|
|
|
|
;}
|
|
|
|
;********************************
|
|
;*
|
|
;* 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)
|
|
|
|
;********************************
|
|
;*
|
|
;* Proceduren Deklarierung
|
|
;*
|
|
|
|
Declare server_HTTP(network_server_id.i)
|
|
Declare server_HTTPS(network_server_id.i)
|
|
Declare client(network_client_id.i)
|
|
Declare AddFileToCache(MemoryID.i, FileName.s, Size.i)
|
|
Declare FileCache(Information.i)
|
|
Declare call_request(RequestString.s, Info.i=#get_handler_procedure)
|
|
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)
|
|
Declare.s Work_Post_ToJSON_x_www_form_urlencoded(ContentLength.i, MemorSize.i, Memory.i)
|
|
Declare.s GetFileFromCache(FileName.s, MemoryID.i)
|
|
Declare count_client(Type.i, Countchange.i)
|
|
|
|
Procedure set_config(parameter.i=#conf_defaultfile, setting.s="index.html")
|
|
Select parameter
|
|
Case #conf_HTTP_port
|
|
conf_HTTP_port = Val(setting)
|
|
Case #conf_HTTPS_Port
|
|
conf_HTTPS_Port = Val(setting)
|
|
Case #conf_HTTP_binding
|
|
If IsIPStringValid(setting)
|
|
conf_HTTP_binding = setting
|
|
Else
|
|
conf_HTTP_binding = "127.0.0.1"
|
|
ProcedureReturn #False
|
|
EndIf
|
|
Case #conf_HTTPS_Binding
|
|
If IsIPStringValid(setting)
|
|
conf_HTTP_binding = setting
|
|
Else
|
|
conf_HTTP_binding = "127.0.0.1"
|
|
ProcedureReturn #False
|
|
EndIf
|
|
Case #conf_HTTPS_CA
|
|
conf_HTTPS_CA = setting
|
|
Case #conf_HTTPS_Cert
|
|
conf_HTTPS_Cert = setting
|
|
Case #conf_HTTPS_Key
|
|
conf_HTTPS_Key = setting
|
|
Case #conf_HTTPS_Key_Pass
|
|
conf_HTTPS_Key_Pass = setting
|
|
Case #conf_HTTPS_Enable
|
|
conf_HTTPS_enable = Val(setting)
|
|
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_HTTP_clients
|
|
If MemoryStatus(#PB_System_FreePhysical) > (Val(setting)*(1024*384))
|
|
conf_max_HTTP_clients = Val(setting)
|
|
Else
|
|
conf_max_HTTP_clients = 10
|
|
ProcedureReturn #False
|
|
EndIf
|
|
Case #conf_max_HTTPS_clients
|
|
If MemoryStatus(#PB_System_FreePhysical) > (Val(setting)*(1024*384))
|
|
conf_max_HTTPS_clients = Val(setting)
|
|
Else
|
|
conf_max_HTTPS_clients = 10
|
|
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_HTTP_clients
|
|
ProcedureReturn Str(conf_max_HTTP_clients)
|
|
Case #conf_server_type
|
|
ProcedureReturn Str(conf_server_type)
|
|
Case #conf_HTTP_port
|
|
ProcedureReturn Str(conf_HTTP_port)
|
|
Case #conf_HTTPS_Port
|
|
ProcedureReturn Str(conf_HTTPS_Port)
|
|
Default
|
|
ProcedureReturn ""
|
|
EndSelect
|
|
EndProcedure
|
|
|
|
Procedure start_server()
|
|
Global NewMap m_clients.s_clients(conf_max_HTTP_clients+conf_max_HTTPS_clients)
|
|
Protected tlsresponse.i
|
|
|
|
;Init HTTP Socket
|
|
server_HTTP_id = lsocket::CreateSocket(conf_HTTP_port, conf_max_clients, lsocket::#SOCK_STREAM, lsocket::#AF_INET, conf_HTTP_binding)
|
|
If conf_HTTPS_enable = 1
|
|
server_HTTPS_id = lsocket::CreateSocket(conf_HTTPS_Port, conf_max_clients, lsocket::#SOCK_STREAM, lsocket::#AF_INET, conf_HTTPS_binding)
|
|
If server_HTTPS_id
|
|
tlsresponse = ltls::InitSimpleTLS(conf_HTTPS_CA, conf_HTTPS_Cert, conf_HTTPS_Key, conf_HTTPS_Key_Pass)
|
|
If tlsresponse > 0
|
|
CreateThread(@server_HTTPS(), server_HTTPS_id)
|
|
Else
|
|
Debug "TLS Fehler:"+Str(tlsresponse)
|
|
ProcedureReturn #False
|
|
EndIf
|
|
|
|
Else
|
|
ProcedureReturn #False
|
|
EndIf
|
|
EndIf
|
|
If server_HTTP_id
|
|
CreateThread(@server_HTTP(), server_HTTP_id)
|
|
ProcedureReturn #True
|
|
Else
|
|
ProcedureReturn #False
|
|
EndIf
|
|
|
|
EndProcedure
|
|
|
|
Procedure server_HTTPS(network_server_id.i)
|
|
;**************************
|
|
;*
|
|
;* Main thread for HTTPS networksocket management. Create the Client Threads.
|
|
;*
|
|
Protected.i client_id
|
|
|
|
thread_alive = #True
|
|
|
|
Debug "HTTPS Server Started."
|
|
Repeat
|
|
client_id = ltls::WaitTLSSocket(network_server_id)
|
|
Debug "New HTTPS Client:"+Str(client_id)
|
|
If client_id > 0
|
|
If count_HTTPS_client < conf_max_HTTPS_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_type = #client_HTTPS
|
|
;Thread erstellen
|
|
m_clients(Str(client_id))\client_thread = CreateThread(@client(), client_id)
|
|
count_client(#client_HTTPS, #client_add)
|
|
Else
|
|
Debug "Max HTTPS Clients reached..."
|
|
ltls::CloseTLSSocket(client_id)
|
|
EndIf
|
|
Else
|
|
Break
|
|
EndIf
|
|
ForEver
|
|
ltls::CloseTLS(network_server_id)
|
|
EndProcedure
|
|
|
|
Procedure server_HTTP(network_server_id.i)
|
|
;**************************
|
|
;*
|
|
;* Main thread for HTTP networksocket management. Create the Client Threads.
|
|
;*
|
|
Protected.i client_id
|
|
|
|
thread_alive = #True
|
|
|
|
Debug "HTTP Server Started."
|
|
Repeat
|
|
client_id = lsocket::WaitSocket(network_server_id)
|
|
Debug "New HTTP Client:"+Str(client_id)
|
|
If client_id > 0
|
|
If count_HTTP_client < conf_max_HTTP_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_type = #client_HTTP
|
|
;Thread erstellen
|
|
m_clients(Str(client_id))\client_thread = CreateThread(@client(), client_id)
|
|
count_client(#client_HTTP, #client_add)
|
|
Else
|
|
Debug "Max HTTP Clients reached..."
|
|
lsocket::CloseSocket(client_id)
|
|
EndIf
|
|
Else
|
|
Break
|
|
EndIf
|
|
ForEver
|
|
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)
|
|
Protected thread_cli_id = network_client_id, sent
|
|
Protected MyThreadJSON, ToCall, ToCallType
|
|
Protected thread_temp_cache.s, thread_temp_cache_memory, temp_receivelength, thread_temp_decode_memory
|
|
Protected thread_reasign
|
|
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
|
|
Protected thread_buffer, thread_buffer_offset, thread_buffer_length, buffer_sent
|
|
Protected sent_length, sent_buffer_address, sent_total
|
|
Protected.b thread_alive = #True, error_message = #False
|
|
Define NewMap Header.s()
|
|
Define NewMap Response.s()
|
|
Define NewMap Post.s()
|
|
|
|
|
|
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
|
|
If m_clients(Str(thread_cli_id))\client_type = #client_HTTPS
|
|
temp_receivelength = ltls::ReadTLSSocket(thread_cli_id, m_clients(Str(thread_cli_id))\datenbuffer()\Buffer, 65536)
|
|
Else
|
|
temp_receivelength = lsocket::ReadSocket(thread_cli_id, m_clients(Str(thread_cli_id))\datenbuffer()\Buffer, 65536)
|
|
EndIf
|
|
|
|
If temp_receivelength = -1
|
|
Debug "Empfangsfehler."
|
|
Break
|
|
ElseIf temp_receivelength = 65536
|
|
m_clients(Str(thread_cli_id))\datenbuffer()\Size = temp_receivelength
|
|
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
|
|
If m_clients(Str(thread_cli_id))\client_type = #client_HTTPS
|
|
temp_receivelength = ltls::ReadTLSSocket(thread_cli_id, m_clients(Str(thread_cli_id))\datenbuffer()\Buffer, 65536)
|
|
Else
|
|
temp_receivelength = lsocket::ReadSocket(thread_cli_id, m_clients(Str(thread_cli_id))\datenbuffer()\Buffer, 65536)
|
|
EndIf
|
|
|
|
m_clients(Str(thread_cli_id))\datenbuffer()\Size = temp_receivelength
|
|
counter_mem_buffers + 1
|
|
If temp_receivelength = -1
|
|
Break 2
|
|
EndIf
|
|
Until temp_receivelength < 65536
|
|
Else
|
|
m_clients(Str(thread_cli_id))\datenbuffer()\Size = temp_receivelength
|
|
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
|
|
;Thread in Bearbeitungsmodus Setzen.
|
|
;TODO: Was ist mit zusammenhängenden Datenbuffern grosse Post/Put z.B.
|
|
|
|
;{
|
|
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())
|
|
|
|
thread_work = PeekS(m_clients(Str(thread_cli_id))\datenbuffer()\Buffer, m_clients(Str(thread_cli_id))\datenbuffer()\Size, #PB_Ascii)
|
|
;Header to Map
|
|
;Debug "Datenbuffer:"+ Mid(thread_work,1,256)
|
|
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 ???
|
|
Break 2 ; Thread abschiessen
|
|
EndIf
|
|
Else
|
|
error_message = #True
|
|
EndIf
|
|
|
|
|
|
|
|
;Debug "JSONString:"+ JSONStringToMap
|
|
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
|
|
|
|
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)
|
|
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 sems to be stable tested up to 200 clients and 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
|
|
;}
|
|
Case #http_method_post
|
|
|
|
;********************************
|
|
;*
|
|
;* 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
|
|
;Should not be possible.
|
|
Debug "Error in thread, JSON Convert didn't Work"
|
|
Break 2 ; Kill Thread
|
|
EndIf
|
|
EndIf
|
|
|
|
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
|
|
|
|
If ToCall > 0 ;A dynamic webhandler is available, call.
|
|
;{ Dynamic 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 sems to be stable tested up to 200 clients and 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
|
|
|
|
|
|
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
|
|
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
|
|
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
|
|
|
|
; EndIf
|
|
|
|
Debug "HTTP File Buffer Cleaned."
|
|
;Löschen des eingang Speichers.
|
|
If m_clients(Str(thread_cli_id))\datenbuffer()\Buffer > 0
|
|
FreeMemory(m_clients(Str(thread_cli_id))\datenbuffer()\Buffer)
|
|
EndIf
|
|
DeleteElement(m_clients(Str(thread_cli_id))\datenbuffer())
|
|
|
|
;Send the data in memory to client.
|
|
sent_total = thread_data_size+(thread_buffer_offset-thread_buffer)
|
|
If m_clients(Str(thread_cli_id))\client_type = #client_HTTPS
|
|
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 "HTTPS Sent:"+Str(sent)+" bytes"
|
|
sent_length - sent
|
|
sent_buffer_address + sent
|
|
sent_total + sent
|
|
Else
|
|
Debug "HTTPS Sent error:"+ltls::ErrorTLSCli(thread_cli_id)
|
|
EndIf
|
|
|
|
Until sent_length <= 0
|
|
sent = sent_total
|
|
|
|
Else
|
|
sent_length = sent_total
|
|
sent_buffer_address = thread_buffer
|
|
sent_total = 0
|
|
Repeat
|
|
sent = lsocket::WriteSocket(thread_cli_id, thread_buffer , sent_length)
|
|
If sent <> -1
|
|
Debug "HTTP Sent:"+Str(sent)+" bytes"
|
|
sent_length - sent
|
|
sent_buffer_address + sent
|
|
sent_total + sent
|
|
Else
|
|
Debug "HTTP Sent error:"+Str(sent)
|
|
EndIf
|
|
|
|
Until sent_length <= 0
|
|
sent = sent_total
|
|
EndIf
|
|
|
|
If sent = thread_data_size+(thread_buffer_offset-thread_buffer)
|
|
;Ok
|
|
;Debug "Gesendet:" + PeekS(thread_buffer,thread_buffer_length, #PB_Ascii)
|
|
If thread_buffer > 0
|
|
FreeMemory(thread_buffer)
|
|
EndIf
|
|
|
|
m_clients(Str(thread_cli_id))\client_do_cli = #CLI_DO_WaitDataReceive
|
|
m_clients(Str(thread_cli_id))\client_do_srv = #SRV_DO_DataReceive
|
|
Else
|
|
;Fehler beim Senden ... Thread beenden.
|
|
Debug "Fehler:" + Str(Sent)
|
|
thread_alive = #False
|
|
|
|
EndIf
|
|
;
|
|
Wend
|
|
;}
|
|
|
|
|
|
m_clients(Str(thread_cli_id))\client_do_cli = #CLI_DO_WaitDataReceive
|
|
|
|
EndSelect
|
|
EndIf
|
|
;}
|
|
|
|
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
|
|
If m_clients(Str(thread_cli_id))\client_type = #client_HTTPS
|
|
ltls::CloseTLSSocket(thread_cli_id)
|
|
count_client(#client_HTTPS, #client_remove)
|
|
Else
|
|
lsocket::CloseSocket(thread_cli_id)
|
|
count_client(#client_HTTP, #client_remove)
|
|
EndIf
|
|
|
|
DeleteMapElement(m_clients(), Str(thread_cli_id))
|
|
Debug "Thread Beendet."
|
|
|
|
EndProcedure
|
|
|
|
|
|
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
|
|
|
|
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$
|
|
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)
|
|
v_http_header + v_current + " " + Header(v_current) + #CRLF$
|
|
EndIf
|
|
Wend
|
|
EndIf
|
|
v_http_header + #CRLF$
|
|
|
|
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
|
|
If CountString(String,#CRLF$+#CRLF$)
|
|
Working = StringField(String,1,#CRLF$+#CRLF$)
|
|
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
|
|
|
|
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
|
|
|
|
Procedure.s MapToJSONString(Map ConvertMap.s())
|
|
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
|
|
|
|
EndProcedure
|
|
|
|
Procedure count_client(Type.i, Countchange.i)
|
|
Select Type
|
|
Case #client_HTTP
|
|
LockMutex(count_HTTP_mutex)
|
|
count_HTTP_client + Countchange
|
|
UnlockMutex(count_HTTP_mutex)
|
|
Case #client_HTTPS
|
|
LockMutex(count_HTTPS_mutex)
|
|
count_HTTPS_client + Countchange
|
|
UnlockMutex(count_HTTPS_mutex)
|
|
EndSelect
|
|
EndProcedure
|
|
|
|
EndModule
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|