;******************************** ;* ;* inc/lweb_server_cfg.pbi ;* ;* LiHaSo Webserver Server Configuration module. ;* ;* Configuration functions. ;* Procedure server_load_host(XMLString.s) ;Load the Configuration to the Memory Structure. Protected XMLHandle.i Protected ImportHost.host XMLHandle = ParseXML(#PB_Any, XMLString) If XMLStatus(XMLHandle) = #PB_XML_Success ExtractXMLStructure(MainXMLNode(XMLHandle), @ImportHost, host, #PB_XML_NoCase) configuration\hosts(ImportHost\description)\description = ImportHost\description CopyStructure(@ImportHost, @configuration\hosts(ImportHost\description), host) FreeXML(XMLHandle) ProcedureReturn #True Else ldl::Logging(xml_error_debug(XMLHandle)) FreeXML(XMLHandle) ProcedureReturn #False EndIf EndProcedure Procedure server_load_status(XMLString.s) ;Load the Status Codes to the Memory Map Structure. Protected XMLHandle.i Protected NewMap ImportStatus.http_status_codes() XMLHandle = ParseXML(#PB_Any, XMLString) If XMLStatus(XMLHandle) = #PB_XML_Success ExtractXMLMap(MainXMLNode(XMLHandle), ImportStatus(), #PB_XML_NoCase) If Not CopyMap(ImportStatus(), configuration\status()) ldl::Logging("Map Structure failed.") FreeXML(XMLHandle) FreeMap(ImportStatus()) ProcedureReturn #False EndIf FreeXML(XMLHandle) FreeMap(ImportStatus()) ProcedureReturn #True Else ldl::Logging(xml_error_debug(XMLHandle)) FreeXML(XMLHandle) FreeMap(ImportStatus()) ProcedureReturn #False EndIf EndProcedure Procedure server_initial(ConfigOptions.s) ;Initialize Webserver from the Config File(s) Protected FileHandle.i, XMLHandle.i, DirectoryHandle.i Protected XMLReaded.s, ConfigFile.s If Left(ConfigOptions, 5) = "file:" ConfigFile = RemoveString(ConfigOptions, "file:") FileHandle = ReadFile(#PB_Any, ConfigFile) If IsFile(FileHandle) XMLReaded = ReadString(FileHandle, #PB_File_IgnoreEOL) CloseFile(FileHandle) EndIf Else XMLReaded = ConfigOptions EndIf If Len(XMLReaded) > 0 XMLHandle = ParseXML(#PB_Any, XMLReaded) If XMLStatus(XMLHandle) = #PB_XML_Success ExtractXMLStructure(MainXMLNode(XMLHandle), @configuration, server, #PB_XML_NoCase) FreeXML(XMLHandle) ;Now we need to load additional Config Files ResetMap(configuration\config_file()) While NextMapElement(configuration\config_file()) Debug configuration\config_file()\configtype Select LCase(configuration\config_file()\configtype) Case "hosts_dir" ldl::Logging("Hosts Directory:"+configuration\config_file()\name) DirectoryHandle = ExamineDirectory(#PB_Any, configuration\config_file()\name, "*.xml") If IsDirectory(DirectoryHandle) While NextDirectoryEntry(DirectoryHandle) If DirectoryEntryType(DirectoryHandle) = #PB_DirectoryEntry_File FileHandle = ReadFile(#PB_Any, configuration\config_file()\name+DirectoryEntryName(DirectoryHandle)) If IsFile(FileHandle) ldl::Logging("Found supported File:"+configuration\config_file()\name+DirectoryEntryName(DirectoryHandle)) XMLReaded = ReadString(FileHandle, #PB_File_IgnoreEOL) CloseFile(FileHandle) If server_load_host(XMLReaded) ldl::Logging("succesful") Else ldl::Logging("failed") EndIf Else ldl::Logging("Could not open File:"+configuration\config_file()\name+DirectoryEntryName(DirectoryHandle)) EndIf EndIf Wend Else ldl::Logging("Could not open the Directory for Analyzing:"+configuration\config_file()\name) EndIf Case "host_file" ldl::Logging("Host File:"+configuration\config_file()\name) FileHandle = ReadFile(#PB_Any, configuration\config_file()\name) If IsFile(FileHandle) XMLReaded = ReadString(FileHandle, #PB_File_IgnoreEOL) CloseFile(FileHandle) If server_load_host(XMLReaded) ldl::Logging("succesful") Else ldl::Logging("failed") EndIf Else ldl::Logging("Could not open File:"+configuration\config_file()\name) EndIf Case "status_xml" ldl::Logging("Status XML File:"+configuration\config_file()\name) FileHandle = ReadFile(#PB_Any, configuration\config_file()\name) If IsFile(FileHandle) XMLReaded = ReadString(FileHandle, #PB_File_IgnoreEOL) CloseFile(FileHandle) If server_load_status(XMLReaded) ldl::Logging("succesful") Else ldl::Logging("failed") EndIf Else ldl::Logging("Could not open File:"+configuration\config_file()\name) EndIf Default ldl::Logging("Unsupported configtype:["+configuration\config_file()\configtype + "] Ignored.") EndSelect Wend ldl::Logging("Config File Imported.") ProcedureReturn #True Else ldl::Logging(xml_error_debug(XMLHandle)) FreeXML(XMLHandle) ProcedureReturn #False EndIf Else ldl::Logging("Could not open File:"+ConfigFile) ProcedureReturn #False EndIf EndProcedure Procedure.s server_get_config(Type.s, UUID.s = "") Define Report.s Define NewMap MapEntrys.s() Select LCase(Type) Case "ports_http" ForEach configuration\hosts() MapEntrys(Str(configuration\hosts()\http\port)) = "Used" Next ForEach MapEntrys() If Len(Report)>0 Report = Report + ", "+ MapKey(MapEntrys()) Else Report = MapKey(MapEntrys()) EndIf Next Case "ports_https" ForEach configuration\hosts() MapEntrys(Str(configuration\hosts()\https\port)) = "Used" Next ForEach MapEntrys() If Len(Report)>0 Report = Report + ", "+ MapKey(MapEntrys()) Else Report = MapKey(MapEntrys()) EndIf Next Default Report = "Uknown Type" EndSelect FreeMap(MapEntrys()) ProcedureReturn Report EndProcedure Procedure server_config(UUID.s, XMLStructure.s) ProcedureReturn #True EndProcedure 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_logUUID configuration\log\AccesslogUUID = setting Case #conf_Error_logUUID configuration\log\ErrorlogUUID = setting Case #conf_Cache_logUUID configuration\log\CachelogUUID = setting Case #conf_Debug_logUUID configuration\log\DebuglogUUID = 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_logUUID ProcedureReturn configuration\log\AccesslogUUID Case #conf_Error_logUUID ProcedureReturn configuration\log\ErrorlogUUID Case #conf_Debug_logUUID ProcedureReturn configuration\log\DebuglogUUID 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