lweb/lweb.pbi

1318 lines
54 KiB
Text

;********************************
;*
;* 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
;*
;{
;*
;* Configuration Structures
;*
;{
Structure server_http
enabled.i
port.i
binding.s
max_clients.i
EndStructure
Structure server_https
enabled.i
port.i
binding.s
max_clients.i
CA.s
Certs.s
key.s
key_pass.s
EndStructure
Structure server_cache
time.i
maxsize.i
current.i
enable.i
EndStructure
Structure memory
MaxFileSize.i
DefaultBlockSize.i
EndStructure
Structure log_config
Debuglog.s
Debugdisable.i
Accesslog.s
AccesslogUUID.s
Errorlog.s
ErrorlogUUID.s
Cachelog.s
CachelogUUID.s
EndStructure
Structure server
http.server_http
https.server_https
cache.server_cache
log.log_config
mem.memory
version.s
identifikation.s
defaultfile.s
basedir.s
error400.s
errorfile404.s
type.i
EndStructure
;}
;*
;*
;* Identifikation des Servers.
;*
Global configuration.server
configuration\version = "V0.9"
configuration\identifikation = "LiHaSo Webserver " + configuration\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.
configuration\defaultfile = "index.html"
configuration\basedir = "/srv/lweb-srv/"
configuration\error400 = "integrated" ; Kann "integrated" sein wass die integrierte Standard Fehlermeldung hervorruft.
configuration\errorfile404 = "error.html"
configuration\type = 0
configuration\http\max_clients = 10 ; Max sametime HTTP connections.
configuration\http\port = 8080
configuration\http\binding = "127.0.0.1"
configuration\https\max_clients = 100
configuration\https\port = 8443
configuration\https\binding = "127.0.0.1"
configuration\https\enabled = 0
configuration\https\CA = ""
configuration\https\Certs = ""
configuration\https\key = ""
configuration\https\key_pass = ""
configuration\cache\enable = 0 ; Enable / Disable Cached Server
configuration\cache\time = 120 ; TTL of cached files
configuration\cache\maxsize = 1 ; Max Cache
configuration\cache\current = 0 ;
configuration\mem\MaxFileSize = 524288 ; Default 512 KiB
configuration\mem\DefaultBlockSize = 65536 ; Default Blocksize 64 KiB
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(configuration\http\max_clients+configuration\https\max_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.s file_check(thread_requested.s)
Declare call_request(RequestString.s, Info.i=#get_handler_procedure)
Declare.s Work_Post_ToJSON_multipart_form_data(ContentLength.i, MemorSize.i, Memory.i)
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_File_BlockSize
configuration\mem\DefaultBlockSize = Val(setting)
Case #conf_File_max_in_Memory
configuration\mem\MaxFileSize = Val(setting)
Case #conf_Access_logfile
configuration\log\Accesslog = setting
Case #conf_Error_logfile
configuration\log\Errorlog = setting
Case #conf_Access_logUUID
configuration\log\AccesslogUUID = setting
Case #conf_Error_logUUID
configuration\log\ErrorlogUUID = setting
Case #conf_Cache_logUUID
configuration\log\CachelogUUID = setting
Case #conf_debug_logfile
configuration\log\Debuglog = setting
Case #conf_debug_disable
If setting = "true"
configuration\log\Debugdisable = #True
Else
configuration\log\Debugdisable = #False
EndIf
Case #conf_runfile
Case #conf_HTTP_port
configuration\http\port = Val(setting)
Case #conf_HTTPS_Port
configuration\https\port = Val(setting)
Case #conf_HTTP_binding
If IsIPStringValid(setting)
configuration\http\binding = setting
Else
configuration\http\binding = "127.0.0.1"
ProcedureReturn #False
EndIf
Case #conf_HTTPS_Binding
If IsIPStringValid(setting)
configuration\https\binding = setting
Else
configuration\https\binding = "127.0.0.1"
ProcedureReturn #False
EndIf
Case #conf_HTTPS_CA
configuration\https\CA = setting
Case #conf_HTTPS_Cert
configuration\https\Certs = setting
Case #conf_HTTPS_Key
configuration\https\Key = setting
Case #conf_HTTPS_Key_Pass
configuration\https\key_pass = setting
Case #conf_HTTPS_Enable
configuration\https\enabled = Val(setting)
Case #conf_defaultfile
configuration\defaultfile = setting
Case #conf_basedir
configuration\basedir = setting
Case #conf_error400
configuration\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))
configuration\http\max_clients = Val(setting)
Else
configuration\http\max_clients = 10
ProcedureReturn #False
EndIf
Case #conf_max_HTTPS_clients
If MemoryStatus(#PB_System_FreePhysical) > (Val(setting)*(1024*384))
configuration\https\max_clients = Val(setting)
Else
configuration\https\max_clients = 10
ProcedureReturn #False
EndIf
Case #conf_server_type
configuration\type = Val(setting)
Case #conf_cache_enable
configuration\cache\enable = Val(Setting)
Default
ProcedureReturn #False
EndSelect
ProcedureReturn #True
EndProcedure
Procedure.s get_config(parameter.i=#conf_defaultfile)
Select parameter
Case #conf_File_BlockSize
ProcedureReturn Str(configuration\mem\DefaultBlockSize)
Case #conf_File_max_in_Memory
ProcedureReturn Str(configuration\mem\MaxFileSize)
Case #conf_Access_logfile
ProcedureReturn configuration\log\Accesslog
Case #conf_Error_logfile
ProcedureReturn configuration\log\Errorlog
Case #conf_Access_logUUID
ProcedureReturn configuration\log\AccesslogUUID
Case #conf_Error_logUUID
ProcedureReturn configuration\log\ErrorlogUUID
Case #conf_debug_logfile
ProcedureReturn configuration\log\Debuglog
Case #conf_debug_disable
If configuration\log\Debugdisable = #True
ProcedureReturn "true"
Else
ProcedureReturn "false"
EndIf
Case #conf_defaultfile
ProcedureReturn configuration\defaultfile
Case #conf_basedir
ProcedureReturn configuration\basedir
Case #conf_error400
ProcedureReturn configuration\error400
Case #conf_max_HTTP_clients
ProcedureReturn Str(configuration\http\max_clients)
Case #conf_server_type
ProcedureReturn Str(configuration\type)
Case #conf_HTTP_port
ProcedureReturn Str(configuration\http\port)
Case #conf_HTTPS_Port
ProcedureReturn Str(configuration\https\port)
Default
ProcedureReturn ""
EndSelect
EndProcedure
Procedure start_server()
Global NewMap m_clients.s_clients(configuration\http\max_clients+configuration\https\max_clients)
Protected tlsresponse.i
If configuration\log\Debugdisable
lhs_log::Disable()
EndIf
;Init HTTP Socket
server_HTTP_id = lsocket::CreateSocket(configuration\http\port, configuration\http\max_clients, lsocket::#SOCK_STREAM, lsocket::#AF_INET, configuration\http\binding)
If configuration\https\enabled = 1
server_HTTPS_id = lsocket::CreateSocket(configuration\https\port, configuration\https\max_clients, lsocket::#SOCK_STREAM, lsocket::#AF_INET, configuration\https\binding)
If server_HTTPS_id
tlsresponse = ltls::InitSimpleTLS(configuration\https\CA, configuration\https\Certs, configuration\https\key, configuration\https\key_pass)
If tlsresponse > 0
CreateThread(@server_HTTPS(), server_HTTPS_id)
Else
lhs_log::Out("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
lhs_log::Out("HTTPS Server Started.")
Repeat
client_id = ltls::WaitTLSSocket(network_server_id)
lhs_log::Out("New HTTPS Client:"+Str(client_id))
If client_id > 0
If m_clients(Str(client_id))\client_id = client_id
lhs_log::Out("Client Thread for socket already exist :"+Str(client_id))
Else
If count_HTTPS_client < configuration\https\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_type = #client_HTTPS
;Thread erstellen
m_clients(Str(client_id))\client_thread = CreateThread(@client(), client_id)
count_client(#client_HTTPS, #client_add)
Else
lhs_log::Out("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
lhs_log::Out("HTTP Server Started.")
Repeat
client_id = lsocket::WaitSocket(network_server_id)
lhs_log::Out("New HTTP Client:"+Str(client_id))
If client_id > 0
If m_clients(Str(client_id))\client_id = client_id
lhs_log::Out("Client Thread for socket already exist :"+Str(client_id))
Else
If count_HTTP_client < configuration\http\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_type = #client_HTTP
;Thread erstellen
m_clients(Str(client_id))\client_thread = CreateThread(@client(), client_id)
count_client(#client_HTTP, #client_add)
Else
lhs_log::Out("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, thread_oversized_file.b, thread_data_to_read.i, thread_data_readed.i
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, thread_redirect = #False
Define NewMap Header.s()
Define NewMap Response.s()
Define NewMap Post.s()
lhs_log::Out("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
lhs_log::Out("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
lhs_log::Out("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
lhs_log::Out("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.
lhs_log::Out("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
lhs_log::Out("#SRV_DO_ClientDisconnect")
thread_alive = #False
;* Alles IO
Default
;Ressourcen freigeben und Threadzeit reduzieren
Delay(1)
lhs_log::Out("--------------------------------------------------------- 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.
;{
lhs_log::Out("Data 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
;lhs_log::Out("JSONString:"+ JSONStringToMap)
thread_type = ""
If configuration\log\AccesslogUUID <> ""
If m_clients(Str(thread_cli_id))\client_type = #client_HTTPS
lhs_log_ext::Out(configuration\log\AccesslogUUID, lsocket::GetSocketIP(ltls::GetSocket(thread_cli_id)) + " " + Header(#http_head_method) + " " + Header(#http_head_request))
Else
lhs_log_ext::Out(configuration\log\AccesslogUUID, lsocket::GetSocketIP(thread_cli_id) + " " + Header(#http_head_method) + " " + Header(#http_head_request))
EndIf
EndIf
Select Header(#http_head_method)
Case #http_method_get
;********************************
;*
;* Default GET
;*
;{
lhs_log::Out(#http_method_get)
If Header(#http_head_request) = "/"
thread_requested = configuration\defaultfile
Else
thread_requested = Header(#http_head_request)
EndIf
lhs_log::Out("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
If Right(thread_requested,1) = "/"
thread_requested = thread_requested+configuration\defaultfile
Else
thread_requested = thread_requested
EndIf
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 ToCallProcedureGet = ToCall
Handler_Response = ToCallProcedureGet(Header())
EndSelect
lhs_log::Out("Main Client Response :"+Handler_Response)
MyThreadJSON = ParseJSON(#PB_Any, Handler_Response)
If MyThreadJSON
ClearMap(Response())
ExtractJSONMap(JSONValue(MyThreadJSON), Response())
FreeJSON(MyThreadJSON)
Else
;WTF ???
lhs_log::Out("Fehler Absturz")
Break 2 ; Thread abschiessen
EndIf
lhs_log::Out("Response Content:"+Response(#cha_R_ResponseContentType))
Select Response(#cha_R_ResponseContentType)
Case #response_Memory
lhs_log::Out("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
lhs_log::Out("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
lhs_log::Out("Content Finished")
;}
ElseIf configuration\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, configuration\basedir + thread_requested,#PB_File_SharedRead)
If thread_file_handle
;Alles Ok
Else
thread_file_handle = ReadFile(#PB_Any, configuration\basedir + configuration\defaultfile,#PB_File_SharedRead)
lhs_log::Out("FileDir:" + configuration\basedir + configuration\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.
If file_check(thread_requested) = thread_requested
thread_file_handle = ReadFile(#PB_Any, configuration\basedir + thread_requested,#PB_File_SharedRead)
If Not thread_file_handle
thread_file_handle = ReadFile(#PB_Any, configuration\basedir + configuration\defaultfile,#PB_File_SharedRead)
lhs_log::Out("FileDir:" + configuration\basedir + configuration\defaultfile)
If Not thread_file_handle
lhs_log::Out("Error file set")
thread_file_handle = ReadFile(#PB_Any, "error.html")
EndIf
EndIf
thread_data_size = Lof(thread_file_handle)
; Is File bigger than MaxFileSize in Memory allowed ?
If thread_data_size >= configuration\mem\MaxFileSize
;Do Handle the File another way.
thread_temp_cache_memory = AllocateMemory(configuration\mem\MaxFileSize)
thread_temp_file_readed = configuration\mem\DefaultBlockSize
thread_data_readed = ReadData(thread_file_handle, thread_temp_cache_memory, thread_temp_file_readed)
thread_data_to_read = thread_data_size - thread_data_readed
thread_oversized_file = #True
Else
thread_temp_cache_memory = AllocateMemory(thread_data_size)
ReadData(thread_file_handle, thread_temp_cache_memory, thread_data_size)
CloseFile(thread_file_handle)
thread_oversized_file = #False
EndIf
Else
thread_redirect = #True
EndIf
;}
EndIf
;}
Case #http_method_post
;********************************
;*
;* POST
;*
;* Current Finaly Implementet is only application/x-www-form-urlencoded
;* Error Handling must be Optimized.
;*
lhs_log::Out(#http_method_post)
;{ POST Content Type Decoder
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.
lhs_log::Out("Error in thread, JSON Convert didn't Work")
Break 2 ; Kill Thread
EndIf
ElseIf Left(LCase(Header(#http_head_content_type)), Len(#http_content_type_multipart_form_data)) = #http_content_type_multipart_form_data
PostMapString = Work_Post_ToJSON_multipart_form_data(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
;Someting wrong in the POST
lhs_log::Out("Error with Content. JSON Convert didn't Work")
Break 2; Kill Thread
EndIf
EndIf
;}
If Header(#http_head_request) = "/"
thread_requested = configuration\defaultfile
Else
thread_requested = Header(#http_head_request)
EndIf
lhs_log::Out("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
lhs_log::Out("Main Client Response :"+Handler_Response)
MyThreadJSON = ParseJSON(#PB_Any, Handler_Response)
If MyThreadJSON
ClearMap(Response())
ExtractJSONMap(JSONValue(MyThreadJSON), Response())
FreeJSON(MyThreadJSON)
Else
;WTF ???
lhs_log::Out("Fehler Absturz")
Break 2 ; Thread abschiessen
EndIf
lhs_log::Out("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
lhs_log::Out("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, configuration\basedir + thread_requested,#PB_File_SharedRead)
If thread_file_handle
;Alles Ok
Else
thread_file_handle = ReadFile(#PB_Any, configuration\basedir + configuration\defaultfile,#PB_File_SharedRead)
lhs_log::Out("FileDir:" + configuration\basedir + configuration\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.
If file_check(thread_requested) = thread_requested
thread_file_handle = ReadFile(#PB_Any, configuration\basedir + thread_requested,#PB_File_SharedRead)
If Not thread_file_handle
thread_file_handle = ReadFile(#PB_Any, configuration\basedir + configuration\defaultfile,#PB_File_SharedRead)
lhs_log::Out("FileDir:" + configuration\basedir + configuration\defaultfile)
If Not thread_file_handle
lhs_log::Out("Error file set")
thread_file_handle = ReadFile(#PB_Any, "error.html")
EndIf
EndIf
thread_data_size = Lof(thread_file_handle)
; Is File bigger than MaxFileSize in Memory allowed ?
If thread_data_size >= configuration\mem\MaxFileSize
;Do Handle the File another way.
thread_temp_cache_memory = AllocateMemory(configuration\mem\MaxFileSize)
thread_temp_file_readed = configuration\mem\DefaultBlockSize
thread_data_readed = ReadData(thread_file_handle, thread_temp_cache_memory, thread_temp_file_readed)
thread_data_to_read = thread_data_size - thread_data_readed
thread_oversized_file = #True
Else
thread_temp_cache_memory = AllocateMemory(thread_data_size)
ReadData(thread_file_handle, thread_temp_cache_memory, thread_data_size)
CloseFile(thread_file_handle)
thread_oversized_file = 0
EndIf
Else
;Send Redirect:
thread_redirect = #True
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 Or thread_redirect = #True
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
If thread_redirect = #True
Header(#http_head_redirect) = file_check(thread_requested)
Header(#http_head_status) = "303 See Other"
Else
Header(#http_head_content_length) = Str(thread_data_size)
Header(#http_head_content_type) = thread_type
EndIf
Header(#http_head_connection) = "Keep-Alive"
Header(#http_head_keep_alive) = "timeout=15, max=1000"
thread_header = http_header_generate(Header())
;large File Handling
If thread_redirect = #True
thread_buffer = AllocateMemory(StringByteLength(thread_header)+12)
ElseIf thread_oversized_file = #False
thread_buffer = AllocateMemory(thread_data_size+StringByteLength(thread_header)+12)
Else
thread_buffer = AllocateMemory(thread_temp_file_readed+StringByteLength(thread_header)+12)
EndIf
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
lhs_log::Out("Header Finished")
EndIf
;Copy temporary File Buffer to normal Buffer.
If thread_temp_cache_memory <> 0 And thread_buffer_offset <> 0 And thread_data_size <> 0 And thread_oversized_file = #False And thread_redirect = #False
CopyMemory(thread_temp_cache_memory, thread_buffer_offset, thread_data_size)
lhs_log::Out("Cache Address Memory:"+Str(thread_temp_cache_memory))
FreeMemory(thread_temp_cache_memory)
thread_temp_cache_memory = 0
ElseIf thread_temp_cache_memory <> 0 And thread_buffer_offset <> 0 And thread_data_size <> 0 And thread_temp_file_readed <> 0 And thread_oversized_file = #True And thread_redirect = #False
CopyMemory(thread_temp_cache_memory, thread_buffer_offset, thread_temp_file_readed)
lhs_log::Out("Cache Address Memory:"+Str(thread_temp_cache_memory))
FreeMemory(thread_temp_cache_memory)
thread_temp_cache_memory = 0
ElseIf thread_redirect = #True
thread_redirect = #False
Else
lhs_log::Out("File Buffer Troubles.")
If thread_temp_cache_memory = 0 : lhs_log::Out("thread_temp_cache_memory = 0") : EndIf
If thread_buffer_offset = 0 : lhs_log::Out("thread_buffer_offset = 0") : EndIf
If thread_data_size = 0 : lhs_log::Out("thread_data_size = 0") : EndIf
thread_alive = #False
Break 2
EndIf
; EndIf
lhs_log::Out("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.
If thread_redirect = #True
sent_total = thread_buffer_offset - thread_buffer
ElseIf thread_oversized_file = #False
sent_total = thread_data_size+(thread_buffer_offset-thread_buffer)
Else
sent_total = thread_temp_file_readed+(thread_buffer_offset-thread_buffer)
EndIf
;TODO: Stoped download kill server...
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
;lhs_log::Out("ClientID:" + Str(thread_cli_id) + " HTTPS Sent:"+Str(sent)+" bytes")
sent_length - sent
If thread_oversized_file = #False
sent_buffer_address + sent
Else
;Read next Block to Memory
If sent_length <= 0 And IsFile(thread_file_handle)
sent_readed = ReadData(thread_file_handle, thread_buffer, thread_temp_file_readed)
;lhs_log::Out("ClientID:" + Str(thread_cli_id) + " HTTPS Large File -> Read Next:"+Str(sent_readed)+" bytes")
If sent_readed < thread_temp_file_readed
CloseFile(thread_file_handle)
EndIf
sent_buffer_address = thread_buffer
sent_length = sent_readed
Else
;lhs_log::Out("ClientID:" + Str(thread_cli_id) + " HTTPS Large File -> to Send:"+Str(sent_length)+" bytes")
sent_buffer_address + sent
EndIf
EndIf
sent_total + sent
Else
If IsFile(thread_file_handle)
CloseFile(thread_file_handle)
EndIf
lhs_log::Out("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
lhs_log::Out("HTTP Sent:"+Str(sent)+" bytes")
sent_length - sent
If thread_oversized_file = 0
sent_buffer_address + sent
Else
;Read next Block to Memory
If sent_length <= 0 And IsFile(thread_file_handle)
sent_readed = ReadData(thread_file_handle, thread_buffer, thread_temp_file_readed)
If sent_readed < thread_temp_file_readed
CloseFile(thread_file_handle)
EndIf
sent_buffer_address = thread_buffer
sent_length = sent_readed
Else
sent_buffer_address + sent
EndIf
EndIf
sent_total + sent
Else
If IsFile(thread_file_handle)
CloseFile(thread_file_handle)
EndIf
lhs_log::Out("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
;lhs_log::Out("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.
lhs_log::Out("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
lhs_log::Out("Thread should now die...")
ResetList(m_clients(Str(thread_cli_id))\datenbuffer())
lhs_log::Out("Thread kill all Initialized Memory buffers:")
While NextElement(m_clients(Str(thread_cli_id))\datenbuffer())
If m_clients(Str(thread_cli_id))\datenbuffer()\Initialized
lhs_log::Out("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())
lhs_log::Out("Freed and removed")
Else
lhs_log::Out("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())
lhs_log::Out("Removed")
EndIf
Wend
If m_clients(Str(thread_cli_id))\client_type = #client_HTTPS
lhs_log::Out("Kill HTTPS Socket:" + Str(thread_cli_id))
;ltls::CloseTLSSocket(thread_cli_id)
count_client(#client_HTTPS, #client_remove)
lhs_log::Out("Killed.")
Else
lhs_log::Out("Kill HTTP Socket:" + Str(thread_cli_id))
lsocket::CloseSocket(thread_cli_id)
count_client(#client_HTTP, #client_remove)
lhs_log::Out("Killed.")
EndIf
lhs_log::Out("Remove Client from map...")
DeleteMapElement(m_clients(), Str(thread_cli_id))
lhs_log::Out("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,"=")
;lhs_log::Out("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 Work_Post_ToJSON_multipart_form_data(ContentLength.i, MemorySize.i, Memory.i)
ProcedureReturn "NA"
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
lhs_log::Out("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
Procedure.s file_check(thread_requested.s)
Protected file_type.i
file_type = FileSize(configuration\basedir + thread_requested)
If file_type = -1
thread_requested = configuration\errorfile404
ElseIf file_type = -2
;Is a Directory
If Right(thread_requested,1) = "/"
thread_requested = thread_requested + configuration\defaultfile
Else
thread_requested = thread_requested + "/" + configuration\defaultfile
EndIf
EndIf
ProcedureReturn thread_requested.s
EndProcedure
EndModule