lweb/inc/lweb_server_cfg.pbi

306 lines
No EOL
11 KiB
Text

;********************************
;*
;* 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