;******************************** ;* ;* lweb.pbi ;* ;* LiHaSo Webserver Main module. ;* ;* It is usable as standalone Webserver, look at lwebd.pb ;* XIncludeFile "ltls.pbi" XIncludeFile "lsocket.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) ;******************************** ;* ;* Used Librarys ;* XIncludeFile "inc/lweb_http_header.pbi" XIncludeFile "inc/lweb_file_cache_header.pbi" ;******************************** ;* ;* Proceduren Deklarierung ;* Declare server_HTTP(network_server_id.i) Declare server_HTTPS(network_server_id.i) Declare client(network_client_id.i) Declare call_request(RequestString.s, Info.i=#get_handler_procedure) Declare.s Work_Post_ToJSON_x_www_form_urlencoded(ContentLength.i, MemorSize.i, Memory.i) Declare count_client(Type.i, Countchange.i) XIncludeFile "inc/lweb_IP.pbi" XIncludeFile "inc/lweb_http.pbi" XIncludeFile "inc/lweb_helper.pbi" XIncludeFile "inc/lweb_file_cache.pbi" 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 m_clients(Str(client_id))\client_id = client_id Debug "Client Thread for socket already exist :"+Str(client_id) Else 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 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 m_clients(Str(client_id))\client_id = client_id Debug "Client Thread for socket already exist :"+Str(client_id) Else 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 EndIf Else Break EndIf ForEver 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 ;Receive done. ;Do Buffer work ;Change Thread to Work mode. ;{ Debug "Date received, working..." m_clients(Str(thread_cli_id))\client_do_cli = #CLI_DO_DataWorking ;Work on Answer. ResetList(m_clients(Str(thread_cli_id))\datenbuffer()) ;TODO: Only first Buffer have a Header. 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) ;Move Header to Map 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 ;Should not be a case. Break 2 ; Kill Thread. 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 Debug "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 Debug "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 If Response(#http_head_set_cookie) <> "" Header(#http_head_set_cookie) = Response(#http_head_set_cookie) 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) Debug thread_temp_cache_memory FreeMemory(thread_temp_cache_memory) thread_temp_cache_memory=0 Else Debug "File Buffer Troubles." If thread_temp_cache_memory = 0 : Debug "thread_temp_cache_memory = 0" : EndIf If thread_buffer_offset = 0 : Debug "thread_buffer_offset = 0" : EndIf If thread_data_size = 0 : Debug "thread_data_size = 0" : EndIf thread_alive = #False Break 2 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) thread_alive = #False Break 2 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) thread_alive = #False Break 2 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 Debug "Thread should now die..." ResetList(m_clients(Str(thread_cli_id))\datenbuffer()) Debug "Thread kill all Initialized Memory buffers:" While NextElement(m_clients(Str(thread_cli_id))\datenbuffer()) If m_clients(Str(thread_cli_id))\datenbuffer()\Initialized Debug "Kill:"+Str(m_clients(Str(thread_cli_id))\datenbuffer()\Buffer)+ " ..." FreeMemory(m_clients(Str(thread_cli_id))\datenbuffer()\Buffer) DeleteElement(m_clients(Str(thread_cli_id))\datenbuffer()) Debug "Freed and removed" Else Debug "Remove element from List with uninitialized Memory ID: "+Str(m_clients(Str(thread_cli_id))\datenbuffer()\Buffer) DeleteElement(m_clients(Str(thread_cli_id))\datenbuffer()) Debug "Removed" EndIf Wend If m_clients(Str(thread_cli_id))\client_type = #client_HTTPS Debug "Kill HTTPS Socket:" + Str(thread_cli_id) ;ltls::CloseTLSSocket(thread_cli_id) count_client(#client_HTTPS, #client_remove) Debug "Killed." Else Debug "Kill HTTP Socket:" + Str(thread_cli_id) lsocket::CloseSocket(thread_cli_id) count_client(#client_HTTP, #client_remove) Debug "Killed." EndIf Debug "Remove Client from map..." DeleteMapElement(m_clients(), Str(thread_cli_id)) Debug "Removed and thread now died." 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 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 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