lweb/inc/lweb_server_cfg.pbi

240 lines
8.4 KiB
Plaintext

;********************************
;*
;* 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
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
Default
ProcedureReturn ""
EndSelect
EndProcedure