SelfHost/Server/includes/fcgi.pbi
2025-12-15 19:46:13 +01:00

317 lines
10 KiB
Plaintext

; ============================================================================
; FCGI Module - FastCGI Request Handler
; ============================================================================
Module FCGI
EnableExplicit
; Session UUID regenerates on each suspicious request to prevent brute-force
Global SessionUUID.s = DataModel::MakeUUID()
; -- Private Procedure Declarations --
Declare Handler_Contact(JSONString.s)
Declare Handler_AdminRequest(Path.s, BufferSize)
Declare GetLanguage()
Declare SendTextResponse(Content.s)
Declare SendBinaryResponse(*Data, Size, Mime.s)
Declare Send404()
; ========================================================================
; Public Procedures
; ========================================================================
Procedure Init()
PrintN("[FCGI] Initializing network...")
If Not InitCGI()
ProcedureReturn #False
EndIf
If Not InitFastCGI(General::#FCGIPort)
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
Procedure MainLoop()
Protected BufferSize, Language
Protected Path.s, Field.s
While WaitFastCGIRequest()
BufferSize = ReadCGI()
Path = CGIVariable(#PB_CGI_ScriptName)
Field = LCase(StringField(Path, 2, "/"))
; --- Route Request ---
Select Field
Case "admin"
Handler_AdminRequest(Path, BufferSize)
Continue
Case "preview"
If CGIParameterValue("UUID") = DataModel::PreviewUUID
SendBinaryResponse(DataModel::*PreviewData, DataModel::PreviewSize, "text/html")
Continue
EndIf
Case "article"
If FindMapElement(DataModel::Articles(), CGIParameterName(0))
If Not DataModel::Articles()\Draft
Language = GetLanguage()
SendBinaryResponse(DataModel::Articles()\language[Language]\data, DataModel::Articles()\language[Language]\size, "text/html")
Continue
EndIf
EndIf
Case "tag"
If FindMapElement(DataModel::StructurePages(), "tag?"+CGIParameterName(0))
Language = GetLanguage()
SendBinaryResponse(DataModel::StructurePages()\language[Language]\data, DataModel::StructurePages()\language[Language]\size, "text/html")
Continue
EndIf
Case "rss", "feed"
; UNTESTED! I only read some RSS specification...
If FindMapElement(DataModel::StructurePages(), "rss")
If CGIParameterName(0) = "fr"
Language = 1
Else
Language = 0
EndIf
SendBinaryResponse(DataModel::StructurePages()\language[Language]\data, DataModel::StructurePages()\language[Language]\size, "application/rss+xml")
Continue
EndIf
Case "browse"
; TODO: Implement history browsing
Case "" ; Index page
If FindMapElement(DataModel::StructurePages(), "index")
Language = GetLanguage()
SendBinaryResponse(DataModel::StructurePages()\language[Language]\data, DataModel::StructurePages()\language[Language]\size, "text/html")
Continue
EndIf
Case "setlanguage"
Protected NewLang = Val(CGIParameterName(0))
If NewLang >= 1 And NewLang <= General::#LanguageCount
WriteCGIHeader(#PB_CGI_HeaderSetCookie, "LNG=" + Str(NewLang))
WriteCGIHeader(#PB_CGI_HeaderContentType, "text/plain", #PB_CGI_LastHeader)
WriteCGIString("OK")
Continue
EndIf
Case "contact"
If Handler_Contact(PeekS(CGIBuffer(), BufferSize, #PB_UTF8))
WriteCGIHeader(#PB_CGI_HeaderContentType, "application/json", #PB_CGI_LastHeader)
WriteCGIString("{" + Chr(34) + "success" + Chr(34) + ": true}")
Else
WriteCGIHeader(#PB_CGI_HeaderContentType, "application/json")
WriteCGIHeader(#PB_CGI_HeaderStatus, "400 Bad Request", #PB_CGI_LastHeader)
WriteCGIString("{" + Chr(34) + "success" + Chr(34) + ": false, " + Chr(34) + "error" + Chr(34) + ": " + Chr(34) + "Invalid request" + Chr(34) + "}")
EndIf
Continue
Default
; Serve public binaries (images, etc.)
If FindString(Path, ".")
If FindMapElement(DataModel::Binaries(), Path)
SendBinaryResponse(DataModel::Binaries()\data, DataModel::Binaries()\size, DataModel::Binaries()\mime)
Continue
EndIf
EndIf
EndSelect
Send404()
Wend
EndProcedure
; ========================================================================
; Admin Request Handler
; ========================================================================
Procedure Handler_AdminRequest(Path.s, BufferSize)
; Verify authentication
If CGICookieValue("ADMIN") <> General::#SecretKey
Debug "Invalid admin cookie: " + CGICookieValue("ADMIN")
Delay(500) ; Rate limit failed auth attempts
Send404()
ProcedureReturn
EndIf
; Session validation (prevents brute force)
If CGICookieValue("SESSION") <> SessionUUID
Delay(500)
SessionUUID = DataModel::MakeUUID()
WriteCGIHeader(#PB_CGI_HeaderSetCookie, "SESSION=" + SessionUUID)
EndIf
; Route admin API requests
Select CGIParameterName(0)
Case "newarticle"
SendTextResponse("NA:" + DataModel::CreateArticle())
ProcedureReturn
Case "listarticles"
SendTextResponse("LA:" + DataModel::ListArticles())
ProcedureReturn
Case "getarticle"
SendTextResponse("AC:" + DataModel::GetArticle(Val(CGIParameterValue("getarticle"))))
ProcedureReturn
Case "updatearticle"
; Can't use CGIParameterValue() - it gets tricked by '=' in base64
Protected RawData.s = PeekS(CGIBuffer(), BufferSize, #PB_Ascii)
DataModel::UpdateArticle(RemoveString(RawData, "updatearticle=", #PB_String_CaseSensitive, 0, 1))
SendTextResponse("UA:OK")
ProcedureReturn
Case "previewarticle"
Protected PreviewData.s = StringField(PeekS(CGIBuffer(), BufferSize, #PB_Ascii), 2, "previewarticle=")
SendTextResponse("PA:" + DataModel::PreviewArticle(PreviewData))
ProcedureReturn
Case "deletearticle"
SendTextResponse("DA:" + DataModel::DeleteArticle(Val(CGIParameterValue("deletearticle"))))
ProcedureReturn
Case "listfiles"
SendTextResponse("LF:" + DataModel::ListFiles())
ProcedureReturn
Case "newfile"
Protected FileData.s = StringField(PeekS(CGIBuffer(), BufferSize, #PB_Ascii), 2, "filedata=")
SendTextResponse("NF:" + DataModel::NewFile(CGIParameterValue("newfile"), FileData))
ProcedureReturn
Case "deletefile"
SendTextResponse("DF:" + DataModel::DeleteAFile(Val(CGIParameterValue("deletefile"))))
ProcedureReturn
Case "listtags"
SendTextResponse("LT:" + DataModel::ListTags())
ProcedureReturn
Case "newtag"
SendTextResponse("NT:" + DataModel::CreateTag())
ProcedureReturn
Case "gettag"
SendTextResponse("TC:" + DataModel::GetTag(Val(CGIParameterValue("gettag"))))
ProcedureReturn
Case "updatetag"
Protected TagData.s = PeekS(CGIBuffer(), BufferSize, #PB_Ascii)
DataModel::UpdateTag(RemoveString(TagData, "updatetag=", #PB_String_CaseSensitive, 0, 1))
SendTextResponse("UT:OK")
ProcedureReturn
Case "listlanguages"
SendTextResponse("LL:" + DataModel::ListLanguages())
ProcedureReturn
Default
; Add index.html if path has no file
If StringField(Path, 3, "/") = ""
Path + "index.html"
EndIf
EndSelect
; Serve static admin files
If FindMapElement(DataModel::AdminBinaries(), Path)
SendBinaryResponse(DataModel::AdminBinaries()\data, DataModel::AdminBinaries()\size, DataModel::AdminBinaries()\mime)
Else
Send404()
EndIf
EndProcedure
Procedure Handler_Contact(JSONString.s)
Protected JSON = ParseJSON(#PB_Any, JSONString), JSONValue
Protected Email.s, Message.s, Name.s
If JSON
JSONValue = JSONValue(JSON)
If ExamineJSONMembers(JSONValue)
While NextJSONMember(JSONValue)
Select JSONMemberKey(JSONValue)
Case "email"
Email = GetJSONString(JSONMemberValue(JSONValue))
Case "message"
Message = GetJSONString(JSONMemberValue(JSONValue))
Case "name"
Name = GetJSONString(JSONMemberValue(JSONValue))
EndSelect
Wend
EndIf
If Email And Message And Name
If CreateMail(0, General::#Email, "Message from the blog")
AddMailRecipient(0, General::#Email, #PB_Mail_To)
SetMailBody(0, "Author : " + Name + "( " + email + " )" + #CRLF$ + "Message" + #CRLF$ + Message)
SendMail(0, "smtp.gmail.com", 465, #PB_Mail_UseSSL | #PB_Mail_UseSMTPS, General::#Email, General::#PassWord)
EndIf
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
; ========================================================================
; Helper Functions
; ========================================================================
Procedure GetLanguageFromBrowser(HTTP_ACCEPT_LANGUAGE.s)
Protected Loop, Entry.s, Result = 1
Protected Count = CountString(HTTP_ACCEPT_LANGUAGE, ",") + 1
For Loop = 1 To Count
; Parse "en-US,fr;q=0.9" format
Entry = LCase(StringField(StringField(StringField(HTTP_ACCEPT_LANGUAGE, Loop, ","), 1, ";"), 1, "-"))
If FindMapElement(DataModel::Language(), Entry)
Result = DataModel::Language()
Break
EndIf
Next
ProcedureReturn Result
EndProcedure
Procedure GetLanguage()
Protected Language
Language = Val(CGICookieValue("LNG"))
If Language = 0 Or Language > General::#LanguageCount
Language = GetLanguageFromBrowser(CGIVariable(#PB_CGI_HttpAcceptLanguage))
WriteCGIHeader(#PB_CGI_HeaderSetCookie, "LNG=" + Str(Language))
EndIf
Language - 1 ; Convert to 0-index
ProcedureReturn Language
EndProcedure
Procedure SendTextResponse(Content.s)
WriteCGIHeader(#PB_CGI_HeaderContentType, "text/html", #PB_CGI_LastHeader)
WriteCGIString(Content)
EndProcedure
Procedure SendBinaryResponse(*Data, Size, Mime.s)
WriteCGIHeader(#PB_CGI_HeaderContentType, Mime, #PB_CGI_LastHeader)
WriteCGIData(*Data, Size)
EndProcedure
Procedure Send404()
WriteCGIHeader(#PB_CGI_HeaderContentType, "text/html", #PB_CGI_LastHeader)
WriteCGIString("<html><title>Not Found</title><body>404 - Not Found</body></html>")
EndProcedure
EndModule
; IDE Options = PureBasic 6.30 beta 5 (Linux - x64)
; CursorPosition = 93
; FirstLine = 67
; Folding = Hw
; EnableXP
; DPIAware