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.
 | 
					;* LiHaSo Webserver Main module.
 | 
				
			||||||
;*
 | 
					;*
 | 
				
			||||||
| 
						 | 
					@ -9,6 +9,7 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
XIncludeFile "ltls.pbi"
 | 
					XIncludeFile "ltls.pbi"
 | 
				
			||||||
 | 
					XIncludeFile "lsocket.pbi"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
Module lhs_web
 | 
					Module lhs_web
 | 
				
			||||||
  ;********************************
 | 
					  ;********************************
 | 
				
			||||||
| 
						 | 
					@ -156,6 +157,15 @@ Module lhs_web
 | 
				
			||||||
  Prototype.s WebHandler_Post(Map handler_Map.s(), ContentString.s)
 | 
					  Prototype.s WebHandler_Post(Map handler_Map.s(), ContentString.s)
 | 
				
			||||||
  Prototype.s WebHandler_Universal(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
 | 
					  ;* Proceduren Deklarierung
 | 
				
			||||||
| 
						 | 
					@ -164,17 +174,17 @@ Module lhs_web
 | 
				
			||||||
  Declare server_HTTP(network_server_id.i)
 | 
					  Declare server_HTTP(network_server_id.i)
 | 
				
			||||||
  Declare server_HTTPS(network_server_id.i)
 | 
					  Declare server_HTTPS(network_server_id.i)
 | 
				
			||||||
  Declare client(network_client_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 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 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)
 | 
					  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")
 | 
					  Procedure set_config(parameter.i=#conf_defaultfile, setting.s="index.html")
 | 
				
			||||||
    Select parameter
 | 
					    Select parameter
 | 
				
			||||||
      Case #conf_HTTP_port
 | 
					      Case #conf_HTTP_port
 | 
				
			||||||
| 
						 | 
					@ -351,41 +361,6 @@ Module lhs_web
 | 
				
			||||||
    ForEver
 | 
					    ForEver
 | 
				
			||||||
  EndProcedure
 | 
					  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)
 | 
					  Procedure client(network_client_id.i)
 | 
				
			||||||
    Protected thread_cli_id = network_client_id, sent
 | 
					    Protected thread_cli_id = network_client_id, sent
 | 
				
			||||||
    Protected MyThreadJSON, ToCall, ToCallType
 | 
					    Protected MyThreadJSON, ToCall, ToCallType
 | 
				
			||||||
| 
						 | 
					@ -908,163 +883,6 @@ Module lhs_web
 | 
				
			||||||
    
 | 
					    
 | 
				
			||||||
  EndProcedure
 | 
					  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)
 | 
					  Procedure call_request(RequestString.s, Info.i = #get_handler_procedure)
 | 
				
			||||||
    Protected CurrPos, Count, Counter, PartString.s
 | 
					    Protected CurrPos, Count, Counter, PartString.s
 | 
				
			||||||
    If m_request(GetExtensionPart(RequestString))\routetype = #handler_type
 | 
					    If m_request(GetExtensionPart(RequestString))\routetype = #handler_type
 | 
				
			||||||
| 
						 | 
					@ -1121,19 +939,6 @@ Module lhs_web
 | 
				
			||||||
    ProcedureReturn 0  
 | 
					    ProcedureReturn 0  
 | 
				
			||||||
  EndProcedure
 | 
					  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)
 | 
					  Procedure.s Work_Post_ToJSON_x_www_form_urlencoded(ContentLength.i, MemorSize.i, Memory.i)
 | 
				
			||||||
    Define.s JSONString, Working, ContentString
 | 
					    Define.s JSONString, Working, ContentString
 | 
				
			||||||
    Define CountParams, Count, JSON
 | 
					    Define CountParams, Count, JSON
 | 
				
			||||||
| 
						 | 
					@ -1188,107 +993,6 @@ Module lhs_web
 | 
				
			||||||
    Debug "Handler Registriert:"+Route
 | 
					    Debug "Handler Registriert:"+Route
 | 
				
			||||||
  EndProcedure
 | 
					  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)
 | 
					  Procedure count_client(Type.i, Countchange.i)
 | 
				
			||||||
    Select Type
 | 
					    Select Type
 | 
				
			||||||
      Case #client_HTTP
 | 
					      Case #client_HTTP
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -90,8 +90,8 @@ DeclareModule lhs_web
 | 
				
			||||||
  Declare.s get_config(parameter.i=#conf_defaultfile)
 | 
					  Declare.s get_config(parameter.i=#conf_defaultfile)
 | 
				
			||||||
  Declare start_server()
 | 
					  Declare start_server()
 | 
				
			||||||
  Declare.s register_client_handler(Route.s, Callback.i, AppPrototype.i = #handler_proto_get, RouteType.i = #handler_sub)
 | 
					  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())
 | 
					  XIncludeFile "inc/lweb_IP_header.pbi"
 | 
				
			||||||
  Declare IsIPStringValid(Adress.s)
 | 
					  XIncludeFile "inc/lweb_helper_header.pbi"
 | 
				
			||||||
  
 | 
					  
 | 
				
			||||||
EndDeclareModule
 | 
					EndDeclareModule
 | 
				
			||||||
		Loading…
	
		Reference in a new issue