; ============================================================
; 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