Splittet source up to some includes.
Every Include should now have some procedure who are standalone usable. lweb_http Has a lot of changes todo (Full HTTP 1.1 Compliance) lweb_file_cache, is realy buggy. A lot of todo's lweb_IP is Only IsIPStringValid in lweb_helper, there is only some help procedures. To Do: lweb_http_post (Everything Post Specific) lweb_http_get (Everything Get Specific) lweb_http_put (Complete todo nothing done until now) lweb_server_http (Specific http only Server) lweb_server_https (Specific https only Server) lweb_server (Common Server Things) Maybe everything more generic to use standalone...
This commit is contained in:
parent
905f7ca677
commit
2cbfdceaac
10 changed files with 373 additions and 317 deletions
40
inc/lweb_IP.pbi
Normal file
40
inc/lweb_IP.pbi
Normal file
|
|
@ -0,0 +1,40 @@
|
|||
;********************************
|
||||
;*
|
||||
;* lweb_IP.pbi
|
||||
;*
|
||||
|
||||
|
||||
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
|
||||
6
inc/lweb_IP_header.pbi
Normal file
6
inc/lweb_IP_header.pbi
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
;********************************
|
||||
;*
|
||||
;* lweb_IP_header.pbi
|
||||
;*
|
||||
|
||||
Declare IsIPStringValid(Adress.s)
|
||||
101
inc/lweb_file_cache.pbi
Normal file
101
inc/lweb_file_cache.pbi
Normal file
|
|
@ -0,0 +1,101 @@
|
|||
|
||||
;Buggy FileCache Routines ... Wiso auch immer das noch nicht richtig Funktioniert.
|
||||
|
||||
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
|
||||
10
inc/lweb_file_cache_header.pbi
Normal file
10
inc/lweb_file_cache_header.pbi
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
;********************************
|
||||
;*
|
||||
;* lweb_file_cache_header.pbi
|
||||
;*
|
||||
|
||||
|
||||
Declare AddFileToCache(MemoryID.i, FileName.s, Size.i)
|
||||
Declare FileCache(Information.i)
|
||||
Declare.s GetFileFromCache(FileName.s, MemoryID.i) ;Ass named
|
||||
Declare FileCacheCleaner(Information.i) ;Thread to cleanup Filecache
|
||||
45
inc/lweb_helper.pbi
Normal file
45
inc/lweb_helper.pbi
Normal file
|
|
@ -0,0 +1,45 @@
|
|||
;********************************
|
||||
;*
|
||||
;* lweb_helper.pbi
|
||||
;*
|
||||
|
||||
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 MapToJSONString(Map ConvertMap.s())
|
||||
Protected MyJSON
|
||||
Protected.s Response
|
||||
MyJSON = CreateJSON(#PB_Any)
|
||||
If MyJSON
|
||||
InsertJSONMap(JSONValue(MyJSON), ConvertMap())
|
||||
Response = ComposeJSON(MyJSON)
|
||||
FreeJSON(MyJSON)
|
||||
ProcedureReturn Response
|
||||
EndIf
|
||||
ProcedureReturn #error_string
|
||||
EndProcedure
|
||||
8
inc/lweb_helper_header.pbi
Normal file
8
inc/lweb_helper_header.pbi
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
;********************************
|
||||
;*
|
||||
;* lweb_helper_header.pbi
|
||||
;*
|
||||
|
||||
|
||||
Declare.s mimetype(file.s)
|
||||
Declare.s MapToJSONString(Map ConvertMap.s())
|
||||
133
inc/lweb_http.pbi
Normal file
133
inc/lweb_http.pbi
Normal file
|
|
@ -0,0 +1,133 @@
|
|||
;********************************
|
||||
;*
|
||||
;* lweb_http.pbi
|
||||
;*
|
||||
|
||||
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) + #CRLF$ +
|
||||
#http_head_date + " " + Header(#http_head_date) + #CRLF$ +
|
||||
#http_head_server + " " + Header(#http_head_server) + #CRLF$ +
|
||||
#http_head_content_length + " " + Header(#http_head_content_length) + #CRLF$ +
|
||||
#http_head_content_type + " " + Header(#http_head_content_type) + #CRLF$
|
||||
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) + #CRLF$
|
||||
EndIf
|
||||
Wend
|
||||
EndIf
|
||||
v_http_header + #CRLF$
|
||||
|
||||
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,#CRLF$+#CRLF$)
|
||||
Working = StringField(String,1,#CRLF$+#CRLF$)
|
||||
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
|
||||
9
inc/lweb_http_header.pbi
Normal file
9
inc/lweb_http_header.pbi
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
;********************************
|
||||
;*
|
||||
;* lweb_http_header.pbi
|
||||
;*
|
||||
|
||||
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)
|
||||
332
lweb.pbi
332
lweb.pbi
|
|
@ -1,6 +1,6 @@
|
|||
;********************************
|
||||
;*
|
||||
;* lweb-srv.pbi V0.9
|
||||
;* lweb.pbi
|
||||
;*
|
||||
;* LiHaSo Webserver Main module.
|
||||
;*
|
||||
|
|
@ -9,6 +9,7 @@
|
|||
|
||||
|
||||
XIncludeFile "ltls.pbi"
|
||||
XIncludeFile "lsocket.pbi"
|
||||
|
||||
Module lhs_web
|
||||
;********************************
|
||||
|
|
@ -156,6 +157,15 @@ Module lhs_web
|
|||
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
|
||||
|
|
@ -164,17 +174,17 @@ Module lhs_web
|
|||
Declare server_HTTP(network_server_id.i)
|
||||
Declare server_HTTPS(network_server_id.i)
|
||||
Declare client(network_client_id.i)
|
||||
Declare AddFileToCache(MemoryID.i, FileName.s, Size.i)
|
||||
Declare FileCache(Information.i)
|
||||
|
||||
Declare call_request(RequestString.s, Info.i=#get_handler_procedure)
|
||||
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 Work_Post_ToJSON_x_www_form_urlencoded(ContentLength.i, MemorSize.i, Memory.i)
|
||||
Declare.s GetFileFromCache(FileName.s, MemoryID.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_HTTP_port
|
||||
|
|
@ -351,41 +361,6 @@ Module lhs_web
|
|||
ForEver
|
||||
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, sent
|
||||
Protected MyThreadJSON, ToCall, ToCallType
|
||||
|
|
@ -908,163 +883,6 @@ Module lhs_web
|
|||
|
||||
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) + #CRLF$ +
|
||||
#http_head_date + " " + Header(#http_head_date) + #CRLF$ +
|
||||
#http_head_server + " " + Header(#http_head_server) + #CRLF$ +
|
||||
#http_head_content_length + " " + Header(#http_head_content_length) + #CRLF$ +
|
||||
#http_head_content_type + " " + Header(#http_head_content_type) + #CRLF$
|
||||
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) + #CRLF$
|
||||
EndIf
|
||||
Wend
|
||||
EndIf
|
||||
v_http_header + #CRLF$
|
||||
|
||||
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,#CRLF$+#CRLF$)
|
||||
Working = StringField(String,1,#CRLF$+#CRLF$)
|
||||
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 call_request(RequestString.s, Info.i = #get_handler_procedure)
|
||||
Protected CurrPos, Count, Counter, PartString.s
|
||||
If m_request(GetExtensionPart(RequestString))\routetype = #handler_type
|
||||
|
|
@ -1120,19 +938,6 @@ Module lhs_web
|
|||
|
||||
ProcedureReturn 0
|
||||
EndProcedure
|
||||
|
||||
Procedure.s MapToJSONString(Map ConvertMap.s())
|
||||
Protected MyJSON
|
||||
Protected.s Response
|
||||
MyJSON = CreateJSON(#PB_Any)
|
||||
If MyJSON
|
||||
InsertJSONMap(JSONValue(MyJSON), ConvertMap())
|
||||
Response = ComposeJSON(MyJSON)
|
||||
FreeJSON(MyJSON)
|
||||
ProcedureReturn Response
|
||||
EndIf
|
||||
ProcedureReturn #error_string
|
||||
EndProcedure
|
||||
|
||||
Procedure.s Work_Post_ToJSON_x_www_form_urlencoded(ContentLength.i, MemorSize.i, Memory.i)
|
||||
Define.s JSONString, Working, ContentString
|
||||
|
|
@ -1188,107 +993,6 @@ Module lhs_web
|
|||
Debug "Handler Registriert:"+Route
|
||||
EndProcedure
|
||||
|
||||
;Buggy FileCache Routines ... Wiso auch immer das noch nicht richtig Funktioniert.
|
||||
|
||||
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 count_client(Type.i, Countchange.i)
|
||||
Select Type
|
||||
Case #client_HTTP
|
||||
|
|
|
|||
|
|
@ -90,8 +90,8 @@ DeclareModule lhs_web
|
|||
Declare.s get_config(parameter.i=#conf_defaultfile)
|
||||
Declare start_server()
|
||||
Declare.s register_client_handler(Route.s, Callback.i, AppPrototype.i = #handler_proto_get, RouteType.i = #handler_sub)
|
||||
Declare.s mimetype(file.s)
|
||||
Declare.s MapToJSONString(Map ConvertMap.s())
|
||||
Declare IsIPStringValid(Adress.s)
|
||||
|
||||
XIncludeFile "inc/lweb_IP_header.pbi"
|
||||
XIncludeFile "inc/lweb_helper_header.pbi"
|
||||
|
||||
EndDeclareModule
|
||||
Loading…
Reference in a new issue