; ============================================================ ; 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.s Ext, Type 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", "abw", "application/x-abiword", "apng", "image/apng", "avi", "video/x-msvideo", "bin", "application/octet-stream", "bmp", "image/bmp" Data.s "css", "text/css", "csv", "text/csv", "doc", "application/msword", "gif", "image/gif", "htm", "text/html", "html", "text/html", "ico", "image/x-icon" Data.s "jpeg", "image/jpeg", "jpg", "image/jpeg", "js", "text/javascript", "json", "application/json", "mp3", "audio/mpeg", "mp4", "video/mp4", "mpeg", "video/mpeg" Data.s "otf", "font/otf", "png", "image/png", "pdf", "application/pdf", "php", "application/x-httpd-php", "svg", "image/svg+xml", "txt", "text/plain" Data.s "wav", "audio/wav", "webm", "video/webm", "webp", "image/webp", "woff", "font/woff", "woff2", "font/woff2", "xml", "application/xml", "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 = "

" + Str(Code) + " " + Reason + "

" 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 ; IDE Options = PureBasic 6.30 (Windows - x64) ; CursorPosition = 17 ; Folding = jAAA9 ; EnableXP ; DPIAware