PureBasic

Code : Tout sélectionner

; ============================================================
; WebServer.pbi: Simple HTTP / FastCGI gateway for services
;				 development.
;
; Routing:
;   - Path matching a registered FCGI prefix -> forward to FCGI
;   - Otherwise: try local file, fall back to FCGI on miss
; ============================================================

DeclareModule WebServer
	Declare Open(Port, WebRoot.s, FcgiHost.s = "127.0.0.1", FcgiPort = 5600)
	Declare Close(*Server)
	Declare AddFcgiPrefix(*Server, Prefix.s)
EndDeclareModule

Module WebServer
	EnableExplicit
	
	;{ Structures
	Structure Server
		ServerID.i
		Thread.i
		Stop.i
		Port.i
		WebRoot.s
		FcgiHost.s
		FcgiPort.l
		List Prefixes.s()
	EndStructure
	
	Structure HttpConn
		*Buffer
		AllocSize.i
		Received.i
		HeadersEnd.i      ; byte AFTER \r\n\r\n; 0 means not yet found
		ContentLength.i   ; -1 = not yet parsed
	EndStructure
	
	Structure FCGI_Header
		version.a
		type.a
		requestIdB1.a
		requestIdB0.a
		contentLengthB1.a
		contentLengthB0.a
		paddingLength.a
		reserved.a
	EndStructure
	
	Structure FCGI_BeginRequestBody
		roleB1.a
		roleB0.a
		flags.a
		reserved.a[5]
	EndStructure
	;}
	
	;{ Constants
	#FCGI_VERSION       = 1
	#FCGI_BEGIN_REQUEST = 1
	#FCGI_END_REQUEST   = 3
	#FCGI_PARAMS        = 4
	#FCGI_STDIN         = 5
	#FCGI_STDOUT        = 6
	#FCGI_RESPONDER     = 1
	#FCGI_HEADER_SIZE   = 8
	#FCGI_MAX_RECORD    = 65528
	;}
	
	;{ MIME types
	Global NewMap MimeTypes.s()
	
	Procedure LoadMimeTypes()
		Protected Ext.s, Type.s
		Restore MimeData
		Read.s Ext
		While Ext <> "END"
			Read.s Type
			MimeTypes(Ext) = Type
			Read.s Ext
		Wend
	EndProcedure
	LoadMimeTypes()
	
	DataSection
		MimeData:
		Data.s "aac","audio/aac","apng","image/apng","avi","video/x-msvideo"
		Data.s "bin","application/octet-stream","bmp","image/bmp"
		Data.s "css","text/css","csv","text/csv","gif","image/gif"
		Data.s "htm","text/html","html","text/html","ico","image/x-icon"
		Data.s "jpeg","image/jpeg","jpg","image/jpeg","js","text/javascript"
		Data.s "json","application/json","map","application/json"
		Data.s "mp3","audio/mpeg","mp4","video/mp4"
		Data.s "otf","font/otf","png","image/png","pdf","application/pdf"
		Data.s "svg","image/svg+xml","txt","text/plain","wasm","application/wasm"
		Data.s "wav","audio/wav","webm","video/webm","webp","image/webp"
		Data.s "woff","font/woff","woff2","font/woff2","xml","application/xml"
		Data.s "zip","application/zip"
		Data.s "END"
	EndDataSection
	;}
	
	;- Private declarations
	Declare ServerThread(*Server.Server)
	Declare HandleRequest(*Server.Server, ClientID, *Data, DataLen)
	Declare ForwardToFcgi(*Server.Server, ClientID, Method.s, FullURI.s, Path.s, QueryString.s, Map ReqHdrs.s(), *Body, BodyLen)
	Declare FcgiBuildAndSendParams(FcgiConn, *Server.Server, ReqID.u, Method.s, FullURI.s, Path.s, QueryString.s, Map ReqHdrs.s(), BodyLen)
	Declare FcgiSendBody(FcgiConn, ReqID.u, *Body, BodyLen)
	Declare FcgiReadResponse(FcgiConn, *OutLen)
	Declare FcgiSendHttpResponse(ClientID, *RespBuf, RespLen)
	Declare ServeStaticFile(ClientID, FilePath.s)
	Declare SendErrorResponse(ClientID, Code, Reason.s)
	Declare SendRawHttpResponse(ClientID, StatusLine.s, Headers.s, *Body, BodyLen)
	Declare ReceiveAll(ConnID, *Buffer, Length)
	Declare SendAll(ConnID, *Buffer, Length)
	Declare SendFcgiRecord(ConnID, Type.a, RequestID.u, *Content, ContentLen)
	Declare AppendNVP(*Buffer, Offset, Name.s, Value.s)
	Declare.s GetMime(FilePath.s)
	Declare.s GetHeaderCI(Map H.s(), Name.s)
	
	;- Public API
	Procedure Open(Port, WebRoot.s, FcgiHost.s = "127.0.0.1", FcgiPort = 5600)
		Protected ServerID = CreateNetworkServer(#PB_Any, Port, #PB_Network_TCP, "")
		Protected *Server.Server
		If Not ServerID : ProcedureReturn #Null : EndIf
		
		*Server = AllocateMemory(SizeOf(Server))
		If *Server
			InitializeStructure(*Server, Server)
			*Server\ServerID = ServerID
			*Server\Port     = Port
			*Server\WebRoot  = WebRoot
			*Server\FcgiHost = FcgiHost
			*Server\FcgiPort = FcgiPort
			*Server\Thread   = CreateThread(@ServerThread(), *Server)
			If Not *Server\Thread
				CloseNetworkServer(ServerID)
				FreeStructure(*Server)
				*Server = #Null
			EndIf
		Else
			CloseNetworkServer(ServerID)
		EndIf
		ProcedureReturn *Server
	EndProcedure
	
	Procedure Close(*Server.Server)
		If *Server
			*Server\Stop = #True
			If IsThread(*Server\Thread)
				WaitThread(*Server\Thread, 5000)
				If IsThread(*Server\Thread) : KillThread(*Server\Thread) : EndIf
			EndIf
			FreeMemory(*Server)
		EndIf
	EndProcedure
	
	Procedure AddFcgiPrefix(*Server.Server, Prefix.s)
		If *Server
			AddElement(*Server\Prefixes())
			*Server\Prefixes() = Prefix
		EndIf
	EndProcedure
	
	;- Private procedures
	; Helpers
	Procedure.s GetHeaderCI(Map H.s(), Name.s)
		; Case-insensitive header lookup so we don't depend on which capitalisation
		; the browser used (Chrome and Firefox usually send "Content-Type:" but
		; HTTP/2 frontends and some proxies will lowercase headers).
		Protected Lower.s = LCase(Name)
		ForEach H()
			If LCase(MapKey(H())) = Lower
				ProcedureReturn H()
			EndIf
		Next
		ProcedureReturn ""
	EndProcedure
	
	Procedure.s GetMime(FilePath.s)
		If FindMapElement(MimeTypes(), LCase(GetExtensionPart(FilePath)))
			ProcedureReturn MimeTypes()
		EndIf
		ProcedureReturn "application/octet-stream"
	EndProcedure
	
	; Network helpers
	Procedure ReceiveAll(ConnID, *Buffer, Length)
		Protected Received = 0, Got
		While Received < Length
			Got = ReceiveNetworkData(ConnID, *Buffer + Received, Length - Received)
			If Got <= 0
				Received =  -1
				Break
			EndIf
			Received + Got
		Wend
		ProcedureReturn Received
	EndProcedure
	
	Procedure SendAll(ConnID, *Buffer, Length)
		Protected Sent = 0, Chunk
		While Sent < Length
			Chunk = SendNetworkData(ConnID, *Buffer + Sent, Length - Sent)
			If Chunk <= 0
				Sent =  -1
				Break
			EndIf
			Sent + Chunk
		Wend
		ProcedureReturn Sent
	EndProcedure
	
	; FCGI helpers
	Procedure SendFcgiRecord(ConnID, Type.a, RequestID.u, *Content, ContentLen)
		Protected Result = #False
		Protected Padding = (8 - (ContentLen % 8)) % 8
		Protected PktSize = #FCGI_HEADER_SIZE + ContentLen + Padding
		Protected *Pkt = AllocateMemory(PktSize, #PB_Memory_NoClear)
		
		If *Pkt
			PokeA(*Pkt,     #FCGI_VERSION)
			PokeA(*Pkt + 1, Type)
			PokeA(*Pkt + 2, (RequestID  >> 8) & $FF)
			PokeA(*Pkt + 3,  RequestID        & $FF)
			PokeA(*Pkt + 4, (ContentLen >> 8) & $FF)
			PokeA(*Pkt + 5,  ContentLen       & $FF)
			PokeA(*Pkt + 6,  Padding)
			PokeA(*Pkt + 7,  0)
			
			If *Content And ContentLen > 0
				CopyMemory(*Content, *Pkt + #FCGI_HEADER_SIZE, ContentLen)
			EndIf
			If Padding > 0
				FillMemory(*Pkt + #FCGI_HEADER_SIZE + ContentLen, Padding, 0)
			EndIf
			
			Result = Bool(SendAll(ConnID, *Pkt, PktSize) > 0)
			FreeMemory(*Pkt)
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	
	Procedure AppendNVP(*Buffer, Offset, Name.s, Value.s)
		Protected NameLen  = StringByteLength(Name,  #PB_Ascii)
		Protected ValueLen = StringByteLength(Value, #PB_UTF8)
		
		If NameLen < 128
			PokeA(*Buffer + Offset, NameLen) : Offset + 1
		Else
			PokeA(*Buffer + Offset,     ((NameLen >> 24) & $7F) | $80)
			PokeA(*Buffer + Offset + 1,  (NameLen >> 16) & $FF)
			PokeA(*Buffer + Offset + 2,  (NameLen >> 8)  & $FF)
			PokeA(*Buffer + Offset + 3,   NameLen        & $FF)
			Offset + 4
		EndIf
		
		If ValueLen < 128
			PokeA(*Buffer + Offset, ValueLen) : Offset + 1
		Else
			PokeA(*Buffer + Offset,     ((ValueLen >> 24) & $7F) | $80)
			PokeA(*Buffer + Offset + 1,  (ValueLen >> 16) & $FF)
			PokeA(*Buffer + Offset + 2,  (ValueLen >> 8)  & $FF)
			PokeA(*Buffer + Offset + 3,   ValueLen        & $FF)
			Offset + 4
		EndIf
		
		If NameLen > 0
			PokeS(*Buffer + Offset, Name,  -1, #PB_Ascii | #PB_String_NoZero)
			Offset + NameLen
		EndIf
		If ValueLen > 0
			PokeS(*Buffer + Offset, Value, -1, #PB_UTF8  | #PB_String_NoZero)
			Offset + ValueLen
		EndIf
		
		ProcedureReturn Offset
	EndProcedure
	
	; HTTP response helpers
	Procedure SendRawHttpResponse(ClientID, StatusLine.s, Headers.s, *Body, BodyLen)
		; FIX: ensure Headers ends with CRLF so the appended CRLF below produces
		; the CRLFCRLF that terminates the header block. Without this, FCGI-forwarded
		; responses (whose CgiHdrs has no trailing CRLF after PeekS) produced output
		; with only one CRLF between headers and body - some browsers (notably Chrome
		; on POST) refused to display the result.
		If Headers <> "" And Right(Headers, 2) <> #CRLF$
			Headers + #CRLF$
		EndIf
		
		Protected Hdr.s = StatusLine + #CRLF$ + "Connection: close" + #CRLF$ + Headers + #CRLF$
		Protected HdrLen = StringByteLength(Hdr, #PB_Ascii)
		Protected *HdrBuf = AllocateMemory(HdrLen, #PB_Memory_NoClear)
		If *HdrBuf
			PokeS(*HdrBuf, Hdr, -1, #PB_Ascii | #PB_String_NoZero)
			SendAll(ClientID, *HdrBuf, HdrLen)
			FreeMemory(*HdrBuf)
		EndIf
		
		If *Body And BodyLen > 0
			SendAll(ClientID, *Body, BodyLen)
		EndIf
		CloseNetworkConnection(ClientID)
	EndProcedure
	
	Procedure SendErrorResponse(ClientID, Code, Reason.s)
		Protected Body.s = "<h1>" + Str(Code) + " " + Reason + "</h1>"
		Protected BodyLen = StringByteLength(Body, #PB_Ascii)
		Protected *B = AllocateMemory(BodyLen, #PB_Memory_NoClear)
		If *B
			PokeS(*B, Body, -1, #PB_Ascii | #PB_String_NoZero)
			SendRawHttpResponse(ClientID, "HTTP/1.1 " + Str(Code) + " " + Reason,
			                    "Content-Type: text/html" + #CRLF$ + "Content-Length: " + Str(BodyLen) + #CRLF$,
			                    *B, BodyLen)
			FreeMemory(*B)
		EndIf
	EndProcedure
	
	Procedure ServeStaticFile(ClientID, FilePath.s)
		Protected Result, FileSize, FileID = ReadFile(#PB_Any, FilePath, #PB_File_SharedRead)
		Protected *FileData
		
		If FileID
			FileSize = Lof(FileID)
			*FileData = AllocateMemory(FileSize, #PB_Memory_NoClear)
			If *FileData
				ReadData(FileID, *FileData, FileSize)
				SendRawHttpResponse(ClientID, "HTTP/1.1 200 OK",
				                    "Content-Type: " + GetMime(FilePath) + #CRLF$ + "Content-Length: " + Str(FileSize) + #CRLF$,
				                    *FileData, FileSize)
				FreeMemory(*FileData)
			EndIf
			Result = #True
			CloseFile(FileID)
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	
	; FCGI gateway
	Procedure FcgiBuildAndSendParams(FcgiConn, *Server.Server, ReqID.u, Method.s, FullURI.s, Path.s, QueryString.s, Map ReqHdrs.s(), BodyLen)
		Protected *Params, PO, PSent, PChunk, Result
		Protected HName.s, HLower.s, CType.s
		
		*Params = AllocateMemory(65536)
		If Not *Params : ProcedureReturn #False : EndIf
		
		PO = AppendNVP(*Params, PO, "GATEWAY_INTERFACE", "CGI/1.1")
		PO = AppendNVP(*Params, PO, "SERVER_PROTOCOL",   "HTTP/1.1")
		PO = AppendNVP(*Params, PO, "SERVER_SOFTWARE",   "KUMO.S/1.0")
		PO = AppendNVP(*Params, PO, "SERVER_NAME",       "localhost")
		PO = AppendNVP(*Params, PO, "SERVER_PORT",       Str(*Server\Port))
		PO = AppendNVP(*Params, PO, "REQUEST_METHOD",    Method)
		PO = AppendNVP(*Params, PO, "REQUEST_URI",       FullURI)
		PO = AppendNVP(*Params, PO, "SCRIPT_NAME",       Path)
		PO = AppendNVP(*Params, PO, "PATH_INFO",         Path)
		PO = AppendNVP(*Params, PO, "QUERY_STRING",      QueryString)
		PO = AppendNVP(*Params, PO, "DOCUMENT_ROOT",     *Server\WebRoot)
		PO = AppendNVP(*Params, PO, "SCRIPT_FILENAME",   *Server\WebRoot + Path)
		PO = AppendNVP(*Params, PO, "CONTENT_LENGTH",    Str(BodyLen))
		PO = AppendNVP(*Params, PO, "REMOTE_ADDR",       "127.0.0.1")
		PO = AppendNVP(*Params, PO, "REMOTE_PORT",       "0")
		
		; FIX: case-insensitive lookup
		CType = GetHeaderCI(ReqHdrs(), "Content-Type")
		If CType <> ""
			PO = AppendNVP(*Params, PO, "CONTENT_TYPE", CType)
		EndIf
		
		ForEach ReqHdrs()
			HName  = MapKey(ReqHdrs())
			HLower = LCase(HName)
			If HLower <> "content-type" And HLower <> "content-length"
				PO = AppendNVP(*Params, PO, "HTTP_" + UCase(ReplaceString(HName, "-", "_")), ReqHdrs())
			EndIf
		Next
		
		While PSent < PO
			PChunk = PO - PSent
			If PChunk > #FCGI_MAX_RECORD : PChunk = #FCGI_MAX_RECORD : EndIf
			If Not SendFcgiRecord(FcgiConn, #FCGI_PARAMS, ReqID, *Params + PSent, PChunk) : Break : EndIf
			PSent + PChunk
		Wend
		FreeMemory(*Params)
		
		Result = Bool(Bool(PSent >= PO) And SendFcgiRecord(FcgiConn, #FCGI_PARAMS, ReqID, #Null, 0))
		ProcedureReturn Result
	EndProcedure
	
	Procedure FcgiSendBody(FcgiConn, ReqID.u, *Body, BodyLen)
		Protected SSent, SChunk, Result = #True
		
		If *Body And BodyLen > 0
			While SSent < BodyLen And Result
				SChunk = BodyLen - SSent
				If SChunk > #FCGI_MAX_RECORD : SChunk = #FCGI_MAX_RECORD : EndIf
				Result = SendFcgiRecord(FcgiConn, #FCGI_STDIN, ReqID, *Body + SSent, SChunk)
				SSent + SChunk
			Wend
		EndIf
		If Result
			Result = SendFcgiRecord(FcgiConn, #FCGI_STDIN, ReqID, #Null, 0)
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	
	Procedure FcgiReadResponse(FcgiConn, *OutLen)
		Protected FcgiHdr.FCGI_Header, PadBuf.q
		Protected *RecBuf, *RespBuf, *Grown
		Protected RecLen, RecPad, RespLen, RespAlloced = 65536
		
		*RespBuf = AllocateMemory(RespAlloced)
		*RecBuf  = AllocateMemory(65536)
		If Not *RespBuf Or Not *RecBuf
			If *RespBuf : FreeMemory(*RespBuf) : EndIf
			If *RecBuf  : FreeMemory(*RecBuf)  : EndIf
			ProcedureReturn 0
		EndIf
		
		Repeat
			If ReceiveAll(FcgiConn, @FcgiHdr, #FCGI_HEADER_SIZE) <> #FCGI_HEADER_SIZE : Break : EndIf
			RecLen = (FcgiHdr\contentLengthB1 << 8) | FcgiHdr\contentLengthB0
			RecPad = FcgiHdr\paddingLength
			
			If RecLen > 0 And ReceiveAll(FcgiConn, *RecBuf, RecLen) <> RecLen : Break : EndIf
			If RecPad > 0 : ReceiveAll(FcgiConn, @PadBuf, RecPad) : EndIf
			
			Select FcgiHdr\type
				Case #FCGI_STDOUT
					If RecLen > 0
						While RespLen + RecLen > RespAlloced
							RespAlloced * 2
							*Grown = ReAllocateMemory(*RespBuf, RespAlloced)
							If Not *Grown : FreeMemory(*RespBuf) : FreeMemory(*RecBuf) : ProcedureReturn 0 : EndIf
							*RespBuf = *Grown
						Wend
						CopyMemory(*RecBuf, *RespBuf + RespLen, RecLen)
						RespLen + RecLen
					EndIf
					
				Case #FCGI_END_REQUEST
					FreeMemory(*RecBuf)
					PokeI(*OutLen, RespLen)
					ProcedureReturn *RespBuf
			EndSelect
		ForEver
		
		FreeMemory(*RecBuf)
		FreeMemory(*RespBuf)
		ProcedureReturn 0
	EndProcedure
	
	Procedure FcgiSendHttpResponse(ClientID, *RespBuf, RespLen)
		Protected k, SepPos = -1, BodyOff, CgiBodyLen, StatusCode = 200, StatusPos, SEnd, SpPos
		Protected.s CgiHdrs, ExtraHdrs, StatusText = "OK", SVal
		
		For k = 0 To RespLen - 4
			If PeekA(*RespBuf + k)     = $0D And PeekA(*RespBuf + k + 1) = $0A And
			   PeekA(*RespBuf + k + 2) = $0D And PeekA(*RespBuf + k + 3) = $0A
				SepPos = k : Break
			EndIf
		Next
		
		If SepPos >= 0
			CgiHdrs    = PeekS(*RespBuf, SepPos, #PB_Ascii)
			BodyOff    = SepPos + 4
			CgiBodyLen = RespLen - BodyOff
		Else
			BodyOff = 0 : CgiBodyLen = RespLen
		EndIf
		
		StatusPos = FindString(CgiHdrs, "Status:", 1, #PB_String_NoCase)
		If StatusPos
			SEnd = FindString(CgiHdrs, #CRLF$, StatusPos)
			If SEnd = 0 : SEnd = Len(CgiHdrs) + 1 : EndIf
			SVal = Trim(Mid(CgiHdrs, StatusPos + 7, SEnd - StatusPos - 7))
			StatusCode = Val(SVal)
			SpPos = FindString(SVal, " ")
			If SpPos : StatusText = Trim(Mid(SVal, SpPos + 1)) : EndIf
			CgiHdrs = Left(CgiHdrs, StatusPos - 1) + Mid(CgiHdrs, SEnd + 2)
		EndIf
		
		If FindString(CgiHdrs, "Content-Length:", 1, #PB_String_NoCase) = 0
			ExtraHdrs = "Content-Length: " + Str(CgiBodyLen) + #CRLF$
		EndIf
		
		; CgiHdrs from PeekS does NOT end with CRLF; SendRawHttpResponse normalises that.
		SendRawHttpResponse(ClientID, "HTTP/1.1 " + Str(StatusCode) + " " + StatusText,
		                    ExtraHdrs + CgiHdrs, *RespBuf + BodyOff, CgiBodyLen)
	EndProcedure
	
	Procedure ForwardToFcgi(*Server.Server, ClientID, Method.s, FullURI.s, Path.s, QueryString.s, Map ReqHdrs.s(), *Body, BodyLen)
		Protected FcgiConn, ReqID.u = 1, RespLen, *RespBuf
		Protected BeginBody.FCGI_BeginRequestBody
		
		FcgiConn = OpenNetworkConnection(*Server\FcgiHost, *Server\FcgiPort)
		If Not FcgiConn
			SendErrorResponse(ClientID, 502, "Bad Gateway") : ProcedureReturn
		EndIf
		
		FillMemory(@BeginBody, SizeOf(FCGI_BeginRequestBody), 0)
		BeginBody\roleB0 = #FCGI_RESPONDER
		
		; FIX: actually check that BEGIN_REQUEST went through
		If Not SendFcgiRecord(FcgiConn, #FCGI_BEGIN_REQUEST, ReqID, @BeginBody, SizeOf(FCGI_BeginRequestBody))
			CloseNetworkConnection(FcgiConn)
			SendErrorResponse(ClientID, 502, "Bad Gateway") : ProcedureReturn
		EndIf
		
		If Not FcgiBuildAndSendParams(FcgiConn, *Server, ReqID, Method, FullURI, Path, QueryString, ReqHdrs(), BodyLen) Or
		   Not FcgiSendBody(FcgiConn, ReqID, *Body, BodyLen)
			CloseNetworkConnection(FcgiConn)
			SendErrorResponse(ClientID, 502, "Bad Gateway") : ProcedureReturn
		EndIf
		
		*RespBuf = FcgiReadResponse(FcgiConn, @RespLen)
		CloseNetworkConnection(FcgiConn)
		
		If *RespBuf
			FcgiSendHttpResponse(ClientID, *RespBuf, RespLen)
			FreeMemory(*RespBuf)
		Else
			SendErrorResponse(ClientID, 502, "Bad Gateway")
		EndIf
	EndProcedure
	
	Procedure HandleRequest(*Server.Server, ClientID, *Data, DataLen)
		Protected LineEnd = -1, i, Sp1, Sp2, QPos, HdrStart, HdrEnd, NLines, j, ColPos, BodyStart, BodyLen, GoFcgi
		Protected *Body
		Protected.s ReqLine, Method, FullURI, Path, QueryStr, HdrStr, Line, FilePath
		Protected NewMap ReqHdrs.s()
		
		For i = 0 To DataLen - 2
			If PeekA(*Data + i) = $0D And PeekA(*Data + i + 1) = $0A
				LineEnd = i : Break
			EndIf
		Next
		If LineEnd < 0 : SendErrorResponse(ClientID, 400, "Bad Request") : ProcedureReturn : EndIf
		
		ReqLine = PeekS(*Data, LineEnd, #PB_Ascii)
		Sp1 = FindString(ReqLine, " ")
		Sp2 = FindString(ReqLine, " ", Sp1 + 1)
		If Sp1 = 0 Or Sp2 = 0 : SendErrorResponse(ClientID, 400, "Bad Request") : ProcedureReturn : EndIf
		
		Method  = Left(ReqLine, Sp1 - 1)
		FullURI = Mid(ReqLine, Sp1 + 1, Sp2 - Sp1 - 1)
		
		If Method <> "GET" And Method <> "POST"
			SendErrorResponse(ClientID, 405, "Method Not Allowed") : ProcedureReturn
		EndIf
		
		QPos = FindString(FullURI, "?")
		If QPos
			Path = URLDecoder(Left(FullURI, QPos - 1))
			QueryStr = Mid(FullURI, QPos + 1)
		Else
			Path = URLDecoder(FullURI)
			QueryStr = ""
		EndIf
		
		If FindString(Path, "..") : Path = "/" : EndIf
		
		HdrStart = LineEnd + 2
		For i = HdrStart To DataLen - 4
			If PeekA(*Data + i)     = $0D And PeekA(*Data + i + 1) = $0A And
			   PeekA(*Data + i + 2) = $0D And PeekA(*Data + i + 3) = $0A
				HdrEnd = i : Break
			EndIf
		Next
		If HdrEnd = 0 : HdrEnd = DataLen : EndIf
		
		HdrStr = PeekS(*Data + HdrStart, HdrEnd - HdrStart, #PB_Ascii)
		NLines = CountString(HdrStr, #CRLF$) + 1
		For j = 1 To NLines
			Line.s = StringField(HdrStr, j, #CRLF$)
			ColPos = FindString(Line, ":")
			If ColPos > 1
				ReqHdrs(Trim(Left(Line, ColPos - 1))) = Trim(Mid(Line, ColPos + 1))
			EndIf
		Next
		
		BodyStart = HdrEnd + 4
		If BodyStart < DataLen
			*Body   = *Data + BodyStart
			BodyLen = DataLen - BodyStart
		EndIf
		
		ForEach *Server\Prefixes()
			If Left(Path, Len(*Server\Prefixes())) = *Server\Prefixes()
				GoFcgi = #True : Break
			EndIf
		Next
		
		If GoFcgi
			ForwardToFcgi(*Server, ClientID, Method, FullURI, Path, QueryStr, ReqHdrs(), *Body, BodyLen)
			ProcedureReturn
		EndIf
		
		FilePath.s = *Server\WebRoot + Path
		If Right(FilePath, 1) = "/" : FilePath + "index.html" : EndIf
		
		If FileSize(FilePath) >= 0
			If Not ServeStaticFile(ClientID, FilePath)
				SendErrorResponse(ClientID, 500, "Internal Server Error")
			EndIf
		Else
			ForwardToFcgi(*Server, ClientID, Method, FullURI, Path, QueryStr, ReqHdrs(), *Body, BodyLen)
		EndIf
	EndProcedure
	
	Procedure ServerThread(*Server.Server)
		Protected NewMap Conns.HttpConn()
		Protected Got, si, CLPos, CLEnd, ReallocFailed, Event, SearchFrom, ClientID, Key.s, HBlock.s, *Grown, *Conn.HttpConn, *ChunkBuf
		
		*ChunkBuf = AllocateMemory(8192)
		If Not *ChunkBuf : ProcedureReturn : EndIf
		
		Repeat
			Event = NetworkServerEvent(*Server\ServerID)
			If Event = #PB_NetworkEvent_None
				Delay(1)
			Else
				ClientID = EventClient()
				Key = Str(ClientID)
				Select Event
					Case #PB_NetworkEvent_Connect
						*Conn = AddMapElement(Conns(), Key)
						*Conn\AllocSize     = 8192
						*Conn\Buffer        = AllocateMemory(*Conn\AllocSize)
						*Conn\ContentLength = -1
						If Not *Conn\Buffer
							DeleteMapElement(Conns(), Key)
							CloseNetworkConnection(ClientID)
						EndIf
						
					Case #PB_NetworkEvent_Data
						*Conn = FindMapElement(Conns(), Key)
						If Not *Conn : Continue : EndIf
						
						Got = ReceiveNetworkData(ClientID, *ChunkBuf, 8192)
						If Got <= 0 : Continue : EndIf
						
						ReallocFailed = #False
						While *Conn\Received + Got > *Conn\AllocSize
							*Conn\AllocSize * 2
							*Grown = ReAllocateMemory(*Conn\Buffer, *Conn\AllocSize)
							If *Grown
								*Conn\Buffer = *Grown
							Else
								FreeMemory(*Conn\Buffer)
								DeleteMapElement(Conns(), Key)
								CloseNetworkConnection(ClientID)
								ReallocFailed = #True : Break
							EndIf
						Wend
						If ReallocFailed : Continue : EndIf
						
						CopyMemory(*ChunkBuf, *Conn\Buffer + *Conn\Received, Got)
						*Conn\Received + Got
						
						If *Conn\HeadersEnd = 0 And *Conn\Received >= 4
							SearchFrom = *Conn\Received - Got - 3
							If SearchFrom < 0 : SearchFrom = 0 : EndIf
							For si = SearchFrom To *Conn\Received - 4
								If PeekA(*Conn\Buffer + si)     = $0D And PeekA(*Conn\Buffer + si + 1) = $0A And
								   PeekA(*Conn\Buffer + si + 2) = $0D And PeekA(*Conn\Buffer + si + 3) = $0A
									*Conn\HeadersEnd = si + 4 : Break
								EndIf
							Next
						EndIf
						
						If *Conn\HeadersEnd > 0 And *Conn\ContentLength < 0
							; FIX: removed duplicate PeekS call from your version
							HBlock = PeekS(*Conn\Buffer, *Conn\HeadersEnd - 4, #PB_Ascii)
							CLPos = FindString(HBlock, "Content-Length:", 1, #PB_String_NoCase)
							If CLPos
								CLEnd = FindString(HBlock, #CRLF$, CLPos)
								If CLEnd = 0 : CLEnd = Len(HBlock) + 1 : EndIf
								*Conn\ContentLength = Val(Trim(Mid(HBlock, CLPos + 15, CLEnd - CLPos - 15)))
							Else
								*Conn\ContentLength = 0
							EndIf
						EndIf
						
						If *Conn\HeadersEnd > 0 And *Conn\ContentLength >= 0
							If *Conn\Received >= *Conn\HeadersEnd + *Conn\ContentLength
								HandleRequest(*Server, ClientID, *Conn\Buffer, *Conn\Received)
								FreeMemory(*Conn\Buffer)
								DeleteMapElement(Conns(), Key)
							EndIf
						EndIf
						
					Case #PB_NetworkEvent_Disconnect
						*Conn = FindMapElement(Conns(), Key)
						If *Conn
							If *Conn\Buffer : FreeMemory(*Conn\Buffer) : EndIf
							DeleteMapElement(Conns(), Key)
						EndIf
				EndSelect
			EndIf
		Until *Server\Stop
		
		FreeMemory(*ChunkBuf)
		ForEach Conns()
			If Conns()\Buffer : FreeMemory(Conns()\Buffer) : EndIf
		Next
		CloseNetworkServer(*Server\ServerID)
	EndProcedure
	
EndModule

CompilerIf #PB_Compiler_IsMainFile
	OpenConsole("KUMO.S WebServer")
	
	Define Port      = 8080
	Define WebRoot.s = "C:\KUMOS\www"
	
	Define *Srv = WebServer::Open(Port, WebRoot)
	If *Srv
		WebServer::AddFcgiPrefix(*Srv, "/api/")
		PrintN("WebServer running on :" + Str(Port))
		PrintN("  Static root : " + WebRoot)
		PrintN("  FCGI backend: 127.0.0.1:5600  (prefix: /api/)")
		PrintN("Press Enter to stop.")
		Input()
		WebServer::Close(*Srv)
		PrintN("Server stopped.")
	Else
		PrintN("ERROR: could not bind to port " + Str(Port))
	EndIf
	Input()
CompilerEndIf