;******************************** ;* ;* lweb-srv.pbi V0.9 ;* ;* LiHaSo Webserver Hauptmodule ;* ;* Dieser Webserver ist auch Alleine Nutzbar muss allerdings in einem Hauptprogramm Korrekt zusammengesetzt werden. ;* Module lhs_web ;******************************** ;* ;* WebServer Variabeln / Parameter ;* ;{ ;* ;* Grund Variabeln ;* Define temp_clientid, temp_receivelength Define counter_test, counter_test_extra ;* ;* Identifikation des Servers. ;* #OLF = Chr(13)+Chr(10) Global.s conf_version = "V0.9" Global.s conf_titel = "LiHaSo Webserver " + conf_version ;* ;* Diese Parameter müssen entsprechend angepasst sein. ;* Später ausgelagert in ein nicht synchronisiertes lweb-cfg.pbi ;* Folgende Parameter müssen im Hauptprogramm definiert sein. Global.s conf_defaultfile = "index.html" Global.s conf_basedir = "/srv/lweb-srv/" Global.s conf_error400 = "integrated" ; Kann "integrated" sein wass die integrierte Standard Fehlermeldung hervorruft. Global.i conf_max_clients = 100 ; Max gleichzeitige HTTP Verbindungen. Dieser Wert ist anzupassen an das jeweilige System ; Pro Thread werden mindestens 384KBytes benötigt (3 * (64 KByte Standard Buffer + 64 KByte Overhead Buffer)) Global.i conf_server_type = 0 Global.i conf_port = 8080 Global.s conf_binding = "127.0.0.1" Global.i conf_cache_time = 120 ;120Sekunden Global.i conf_cache_maxsize = 1 ;1 Mbyte Global.i conf_cache_current = 0 Global.i conf_cache_enable = 1 Enumeration s_client_do ;client_do_cli #CLI_DO_NOP ;0 Keine Arbeit #CLI_DO_DataWorking ;10 Datenverarbeitung #CLI_DO_DataToSend ;20 Daten zum Senden vorhanden #CLI_DO_WaitDataReceive ;30 Wartet auf Datenempfang #CLI_DO_WaitDataSend ;40 Wartet auf gesendete Daten EndEnumeration Enumeration s_server_do ;client_do_srv #SRV_DO_NOP ;0 Keine Arbeit #SRV_DO_NewDatainBuffer ;10 Neue Daten im incoming Buffer zur bearbeitung. #SRV_DO_MoreDatainBuffer ;11 Weitere Daten im incoming Buffer #SRV_DO_DataReceive ;12 Datem Empfangen Client Thread muss sich darum Kümmern #SRV_DO_DataReceiveCompleted ;18 Empfang der Daten Abgeschlossen #SRV_DO_DataReceiveFailes ;19 Beim Empfangen der Daten ist ein fehler passiert. #SRV_DO_DataSendOK ;20 Daten erfolgreich gesendet, Thread kann weiterarbeiten. #SRV_DO_DataSendNOK ;29 Daten nicht erfolgreich gesendet. #SRV_DO_ClientDisconnect ;99 Beenden des Threads Client hat verbindung getrennt. EndEnumeration #http_method_get = "GET" #http_method_post = "POST" ;*********************** ;* 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.i Initialized.b EndStructure Structure s_file_cache Buffer.i Size.i Timer.i Is.i EndStructure Structure s_clients client_id.i client_do_cli.i client_do_srv.i client_mutex.i client_thread.i List datenbuffer.s_client_memory() client_test_cli.i client_test_srv.i EndStructure Global.i server_id Global.i server_mutex = CreateMutex() ;Dieser Mutex dient zu der Sicherheit der Element Liste. Global.i file_cache_mutex = CreateMutex() Global.i file_cache_semaphore = CreateSemaphore() Global.i file_cache_semaphore_thread = CreateSemaphore() Global NewMap m_file_cache_map.i() Global NewMap m_file_cache.s_file_cache() Global NewMap m_clients.s_clients(conf_max_clients) ;} ;******************************** ;* ;* Proceduren Deklarierung ;* Declare server(network_server_id.i) Declare client(network_client_id.i) Declare AddFileToCache(MemoryID.i, FileName.s, Size.i) Declare FileCache(Information.i) Declare.s mimetype(file.s) 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 GetFileFromCache(FileName.s, MemoryID.i) Procedure set_config(parameter.i=#conf_defaultfile, setting.s="index.html") Select parameter Case #conf_port conf_port = Val(setting) Case #conf_binding If IsIPStringValid(setting) conf_binding = setting Else conf_binding = "127.0.0.1" ProcedureReturn #False EndIf Case #conf_defaultfile conf_defaultfile = setting Case #conf_basedir conf_basedir = setting Case #conf_error400 conf_error400 = setting ; Kann "integrated" sein wass die integrierte Standard Fehlermeldung hervorruft. Case #conf_max_clients If MemoryStatus(#PB_System_FreePhysical) > (Val(setting)*(1024*384)) conf_max_clients = Val(setting) Else conf_max_clients = 100 ProcedureReturn #False EndIf Case #conf_server_type conf_server_type = Val(setting) Case #conf_cache_enable conf_cache_enable = Val(Setting) Default ProcedureReturn #False EndSelect ProcedureReturn #True EndProcedure Procedure.s get_config(parameter.i=#conf_defaultfile) Select parameter Case #conf_defaultfile ProcedureReturn conf_defaultfile Case #conf_basedir ProcedureReturn conf_basedir Case #conf_error400 ProcedureReturn conf_error400 Case #conf_max_clients ProcedureReturn Str(conf_max_clients) Case #conf_server_type ProcedureReturn Str(conf_server_type) Default ProcedureReturn "" EndSelect EndProcedure Procedure start_server() Global NewMap m_clients.s_clients(conf_max_clients) server_id = CreateNetworkServer(#PB_Any, conf_port, #PB_Network_TCP, conf_binding) If server_id CreateThread(@server(), server_id) ProcedureReturn #True Else ProcedureReturn #False EndIf EndProcedure Procedure server(network_server_id.i) ;************************** ;* ;* Hauptthread welcher den Netzwerkport verwaltet und den Datenfluss. ;* Erstellt die Subthreads für Clients ;* Protected.i network_event , client_id, thread_alive, file_cache_thread Protected.i count_client Protected.i t_live , counter_test Protected client, datathread, temp_receivelength, counter_mem_buffers If conf_cache_enable = 1 : file_cache_thread = CreateThread(@FileCache(), 1) : EndIf thread_alive = #True Debug "AllOk" Repeat ;Daten Sendeauftrag vorhanden? network_event = NetworkServerEvent(network_server_id) Select network_event Case #PB_NetworkEvent_None ;Kein Event kleine bedenkzeit und CPU entlastung für den Thread einlegen. Delay(1) Case #PB_NetworkEvent_Connect client_id = EventClient() Debug "***** Client Connected:" + Str(client_id) If count_client <= conf_max_clients m_clients(Str(client_id))\client_id = client_id m_clients(Str(client_id))\client_do_cli = #CLI_DO_WaitDataReceive ;Thread erstellen m_clients(Str(client_id))\client_thread = CreateThread(@client(), client_id) count_client + 1 Else Debug "Max Clients reached..." CloseNetworkConnection(client_id) EndIf Case #PB_NetworkEvent_Data ;Auslesen und in thread speicher geben. Debug "Client Sent Data:" + Str(client_id) client_id = EventClient() If m_clients(Str(client_id))\client_do_cli = #CLI_DO_WaitDataReceive ;Es ist kein Speicher vorhanden... hinzufügen: m_clients(Str(client_id))\client_do_srv = #SRV_DO_DataReceive ElseIf m_clients(Str(client_id))\client_do_cli = #CLI_DO_DataWorking ;Clientthread ist noch am Datenverarbeiten. ;Signalisieren das Datenbereitstehen und der Netzwerkthread Blockiert ist... ;10msec Warten bis Thread wieder Arbeiten darf. m_clients(Str(client_id))\client_do_srv = #SRV_DO_NewDatainBuffer ;Delay() Else ;* Thread nicht existent? If IsThread(m_clients(Str(client_id))\client_thread) ;Thread ist existent... funktioniert jedoch was nicht mer... CloseNetworkConnection(client_id) m_clients(Str(client_id))\client_do_srv = #SRV_DO_ClientDisconnect Else Debug "Systemabsturz ^.^" CloseNetworkConnection(client_id) End EndIf EndIf Case #PB_NetworkEvent_Disconnect ;Nur für Debugzweck Debug "***** Client Disconnected:" + Str(client_id) client_id = EventClient() m_clients(Str(client_id))\client_do_srv = #SRV_DO_ClientDisconnect count_client - 1 EndSelect Until thread_alive = #False KillThread(file_cache_thread) Debug "HTTP Server gestoppt" EndProcedure Procedure IsIPStringValid(Adress.s) Static My_Regex_v4 Static My_Regex_v6_nocompress Static My_Regex_v6_compress Static Valid = 0 My_Regex_v4 = CreateRegularExpression(#PB_Any, "^((25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)$") My_Regex_v6_nocompress = CreateRegularExpression(#PB_Any, "^[0-9a-fA-F]{1,4}(:[0-9a-fA-F]{1,4}){7}$") My_Regex_v6_compress = CreateRegularExpression(#PB_Any, "^(([0-9A-Fa-f]{1,4}(:[0-9A-Fa-f]{1,4}){0,5})?)::(([0-9A-Fa-f]{1,4}(:[0-9A-Fa-f]{1,4}){0,5})?)$") If MatchRegularExpression(My_Regex_v4, Adress) And Valid = 0 Debug "My_Regex_v4" Valid = 1 EndIf If MatchRegularExpression(My_Regex_v6_nocompress, Adress) And Valid = 0 Debug "My_Regex_v6_nocompress" Valid = 1 EndIf If MatchRegularExpression(My_Regex_v6_compress, Adress) And Valid = 0 Debug "My_Regex_v6_compress" Valid = 1 EndIf FreeRegularExpression(My_Regex_v4) FreeRegularExpression(My_Regex_v6_nocompress) FreeRegularExpression(My_Regex_v6_compress) If Valid = 1 ProcedureReturn #True Else ProcedureReturn #False EndIf EndProcedure Procedure client(network_client_id.i) Protected thread_cli_id = network_client_id Protected cli_stop, MyThreadJSON Protected thread_temp_string.s, thread_temp_cache.s, thread_temp_cache_memory, temp_receivelength Protected thread_command_length, thread_max_pos, thread_pos, thread_reasign Protected thread_file_size, thread_file_handle Protected.s thread_requested, thread_type, thread_date, thread_header, thread_work, JSONStringToMap Protected thread_buffer, thread_buffer_offset, thread_buffer_length, buffer_sent Protected.b thread_alive = #True, error_message = #False Define NewMap Header.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 temp_receivelength = ReceiveNetworkData(thread_cli_id, m_clients(Str(thread_cli_id))\datenbuffer()\Buffer, 65536) If temp_receivelength = -1 Break ElseIf temp_receivelength = 65536 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 temp_receivelength = ReceiveNetworkData(thread_cli_id, m_clients(Str(thread_cli_id))\datenbuffer()\Buffer, 65536) counter_mem_buffers + 1 If temp_receivelength = -1 Break 2 EndIf Until temp_receivelength < 65536 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. ;{ 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, 16384, #PB_Ascii) ;Header solte wohl nicht grösser als 16KB sein ;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 ;WTF ??? Break ; Thread abschiessen EndIf Else error_message = #True EndIf Debug Mid(thread_work,1,256) Debug JSONStringToMap If Header(#http_head_method) = #http_method_get thread_command_length = 3 ;******************************** ;* ;* Default GET ;* Debug #http_method_get If Header(#http_head_request) = "/" thread_requested = conf_defaultfile Else thread_requested = Header(#http_head_request) EndIf If conf_cache_enable = 1 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 conf_basedir + conf_defaultfile If Not thread_file_handle thread_file_handle = ReadFile(#PB_Any, "error.html") EndIf EndIf thread_file_size = Lof(thread_file_handle) thread_temp_cache_memory = ReAllocateMemory(thread_temp_cache_memory, thread_file_size) ReadData(thread_file_handle, thread_temp_cache_memory, thread_file_size) CloseFile(thread_file_handle) AddFileToCache(thread_temp_cache_memory, thread_requested, thread_file_size) Else thread_file_size = Val(StringField(thread_temp_cache, 1, ":")) thread_temp_cache_memory = Val(StringField(thread_temp_cache, 2, ":")) EndIf Else 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 conf_basedir + conf_defaultfile If Not thread_file_handle thread_file_handle = ReadFile(#PB_Any, "error.html") EndIf EndIf thread_file_size = Lof(thread_file_handle) thread_temp_cache_memory = AllocateMemory(thread_file_size) ReadData(thread_file_handle, thread_temp_cache_memory, thread_file_size) CloseFile(thread_file_handle) EndIf If thread_file_size thread_type = mimetype(GetExtensionPart(thread_requested)) thread_date = http_day(DayOfWeek(Date())) + Str(Day(Date())) + http_month(Month(Date())) + Str(Year(Date())) + " " + FormatDate("%hh:%ii:%ss GMT+1", Date()) ;lweb_srv_mod_mss() ClearMap(Header()) Header(#http_head_status) = "200 OK" Header(#http_head_content_length) = Str(thread_file_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_file_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 ElseIf Header(#http_head_method) = #http_method_post ;******************************** ;* ;* POST ;* Debug #http_method_post ;PrintN("POST") 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 conf_basedir + thread_requested If Not thread_file_handle thread_file_handle = ReadFile(#PB_Any, "error.html") EndIf EndIf If thread_file_handle thread_file_size = Lof(thread_file_handle) thread_type = mimetype(GetExtensionPart(thread_requested)) thread_date = http_day(DayOfWeek(Date())) + Str(Day(Date())) + http_month(Month(Date())) + Str(Year(Date())) + " " + FormatDate("%hh:%ii:%ss GMT+1", Date()) thread_buffer = AllocateMemory(thread_file_size+500) thread_buffer_offset = thread_buffer ;HEADER and Strings: ; POST /login.mss HTTP/1.1 ; Host: localhost:61000 ; User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:37.0) Gecko/20100101 Firefox/37.0 ; Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 ; Accept-Language: de,en-US;q=0.7,en;q=0.3 ; Accept-Encoding: gzip, deflate ; Referer: http://localhost:61000/index.html ; Connection: keep-alive ; Content-Type: application/x-www-form-urlencoded ; Content-Length: 27 ; ; username=test&passwort=test ;********************************3 ;* Script öffnen ;* ;* Akzeptierte Parameter: ;* ;* username ;* passwort ;* sid ;* ;* Identifikation und übergabe des paramters an script ... ;Fixe Loginfunktion mit user und pasd ; Position_String = FindString(Temp_String, "Content-Length:") ; ; If Position_String > 0 ; ;Länge Content identifizieren. ; ; ; EndIf ; ; While NextElement(HTTP_List()) ; If HTTP_List()\ID = Event_Network_Client ; HTTP_List()\Login = 1 ; Break ; Else ; ;Do Nothing ; ; EndIf ; Wend ;lweb_srv_mod_mss() ClearMap(Header()) Header(#http_head_status) = "200 OK" Header(#http_head_content_length) = Str(thread_file_size) Header(#http_head_content_type) = thread_type thread_header = http_header_generate(Header()) 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 Else ;************************************ ;* ;* 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. ;* EndIf CopyMemory(thread_temp_cache_memory, thread_buffer_offset, thread_file_size) FreeMemory(thread_temp_cache_memory) ; EndIf Debug "HTTP File Buffer Cleaned." ;Löschen des eingang Speichers. FreeMemory(m_clients(Str(thread_cli_id))\datenbuffer()\Buffer) DeleteElement(m_clients(Str(thread_cli_id))\datenbuffer()) ;Daten Senden... If SendNetworkData(thread_cli_id, thread_buffer , thread_file_size+(thread_buffer_offset-thread_buffer)) = thread_file_size+(thread_buffer_offset-thread_buffer) ;Ok ;Debug "Gesendet:" + PeekS(thread_buffer,thread_buffer_length, #PB_Ascii) FreeMemory(thread_buffer) m_clients(Str(thread_cli_id))\client_do_cli = #CLI_DO_WaitDataReceive m_clients(Str(thread_cli_id))\client_do_srv = #SRV_DO_NOP Else ;Fehler beim Senden ... Thread beenden. Debug "Fehler" 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 DeleteMapElement(m_clients(), Str(thread_cli_id)) Debug "Thread Beendet." ;} EndProcedure 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.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) + #OLF + #http_head_date + " " + Header(#http_head_date) + #OLF + #http_head_server + " " + Header(#http_head_server) + #OLF + #http_head_content_length + " " + Header(#http_head_content_length) + #OLF + #http_head_content_type + " " + Header(#http_head_content_type) + #OLF 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) + #OLF EndIf Wend EndIf v_http_header + #OLF 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,#OLF+#OLF) Working = StringField(String,1,#OLF+#OLF) 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.s Work_Post_Header(InMemory.i) EndProcedure Procedure.s Work_Get_Header(InMemory.i) EndProcedure EndModule