[WIP] FastCGI

Partagez votre expérience de PureBasic avec les autres utilisateurs.
poshu
Messages : 1138
Inscription : sam. 31/juil./2004 22:32

[WIP] FastCGI

Message par poshu »

L'implémentation du Fast CGI dans PB est très limitée, elle est en fait plus proche du SCGI que du FCGI. J'ai besoin d'écrire une application FCGI, je me suis donc demandé si je devais passer à du C ou si je pouvais réimplémenter le protocole en PB...
Il se trouve que c'était assez rapide à faire : le Fast CGI date de 1996 et est donc plutôt simple, et il ne m'a fallu que quelques heures de travail pour arriver à un POC.
Si quelqu'un d'autre en a besoin, je partage mon travail ici :

Avancement :
18/12/21 : Bug fixes, bug fixes everywhere!
18/12/19 : Ajouter du support des réponses plus grosses que 2^16 octets.
18/12/10 : Répondre autre chose que du texte.
Ajout de WriteResponseData().
18/12/09 : Moar cookies
Ajout de la fonction FastCGI::GetCookie(), pour ne pas avoir besoin de bidouiller avec les paramètres pour récupérer la valeur d'un cookie. /!\ Elle va déconner plein tube si il y a un espace dans le cookie, faudrait écrire une regex mais je suis pas habitué à PCRE et, en l'état, ça suffit pour mes besoins.
18/12/08 : Cookies & string format
Ajout du support des cookies, ajout d'une options d'encodage des strings (par défaut en UTF8)
18/12/07 : Padding size fix
Fix une erreur grossière avec le padding des packets : Il était calculé mais pas inclus dans les packets... Par un hasard malheureux, tous mes packets de tests avaient une taille multiple de 8, le bug était donc passé sous le radar.
18/12/04 : POC.
Seule une petite partie du protocole FCGI est implémentée et il y a pas mal de risque de memory leaks, mais les bases sont suffisantes pour qui veut étudier ou s'amuser avec le FCGI
Code :

Code : Tout sélectionner

DeclareModule FastCGI
   ; Server
   Declare Open(Port, *Callback, BindedIP.s = "")                                          ;Create a FCGI Application on the given port. Return a Server object if succeed or 0 otherwise. Callback format : Callback(Request)
   Declare Close(*Server)                                                                              ;Close the given Server.
   
   ; Request
   Declare FinishReponse(*Request)                                                                  ;Send the response
   Declare.s GetCookie(*Request, Cookie.s)                                                      ;Return the value of the given
   Declare.s GetParameter(*Request, Parameter.s)                                             ;Return the value of the give parameter if it exists.
   Declare WriteResponseHeader(*Request, Header.s, Value.s)                           ;Write a header to the response
   Declare WriteResponseData(*Request,*Buffer, Lenght)                                    ;Add data to the response
   Declare WriteResponseString(*Request, String.s, Format = #PB_UTF8)            ;Add a string to the response
EndDeclareModule

Module FastCGI
   EnableExplicit
   
   ;{ private variables declaration
   #__VERSION = 1
   
   #__ROLE_RESPONDER = 1
   #__ROLE_AUTHORIZER = 2
   #__ROLE_FILTER = 3
   
   #__TYPE_BEGIN = 1
   #__TYPE_ABORT = 2
   #__TYPE_END = 3
   #__TYPE_PARAMS = 4
   #__TYPE_STDIN = 5
   #__TYPE_STDOUT = 6
   #__TYPE_STDERR = 7
   #__TYPE_DATA = 8
   #__TYPE_GETVALUES = 9
   #__TYPE_GETVALUES_RESULT = 10
   #__TYPE_UNKOWNTYPE = 11
      
   Structure Server
      ServerID.i
      Thread.i
      Stop.i
      *Callback
   EndStructure
   
   Structure Record
      Version.a
      Type.a
      RequestIdB1.a
      RequestIdB0.a
      ContentLengthB1.a
      ContentLengthB0.a
      PaddingLength.a
      Reserved.a
   EndStructure
   
   Structure Request
      ClientID.i
      RequestIdB1.a
      RequestIdB0.a
      Alive.a
      Responded.a
      Map Variable.s()
      Map Response.s()
      List Cookie.s()
      List ResponseData.i()
   EndStructure
   
   #__HEADER_SIZE = SizeOf(Record)
   #__MULTIRECORDSIZE = 65512
   ;}
   
   ;{ Private procedures declaration
   Declare ServerThread(Server)
   Declare ProcessPairs(*Data, *Request.Request   ,Lenght)
   
   ;}
   
   ;{ Public procedures
   ;- Server
   Procedure Close(*Server.Server)
      ; Wow, no mutex? Well... I feel like living dangerously! (Also, I need to test : I don't think it can be a problem...)
      *Server\Stop = #True
   EndProcedure
   
   Procedure Open(Port, *Callback, BindedIP.s = "")
      Protected Server, *ServerData.Server
      
      Server = CreateNetworkServer(#PB_Any,Port,#PB_Network_TCP,BindedIP)
      
      If Server
         *ServerData.Server = AllocateMemory(SizeOf(Server))
         *ServerData\ServerID = Server
         *ServerData\Thread = CreateThread(@ServerThread(),*ServerData)
         *ServerData\Callback = *Callback
      EndIf
      
      ProcedureReturn *ServerData
   EndProcedure
   
   ;- Request
   Procedure FinishReponse(*Request.Request)
      Protected Size, PaddingSize, Position, DataPosition, RecordCount = 1,LastPackage = 0, RecordProgress , MultipleRecordSize = #__MULTIRECORDSIZE,SentData, Progress
      Protected *Record.Record
      Protected *Data, *Packet
      ; 1- Calculate the packet size
      ForEach *Request\Response()
         Size + StringByteLength(MapKey(*Request\Response())+*Request\Response(),#PB_Ascii)   + 3 ; 3 byte as : 1 byte for LF and 2 bytes for ": "
      Next
      
      ForEach *Request\ResponseData()
         Size + MemorySize(*Request\ResponseData())
      Next
      
      ForEach *Request\Cookie()
         Size + StringByteLength(*Request\Cookie(),#PB_Ascii) + 13 ; 12 is for "Set-Cookie: ", 1 = LF
      Next
      
      Size +1 ; le dernier LF
      
      If Size > #__MULTIRECORDSIZE ; Ok so, if we are trying to send more than the maximum size of a fcgi record/packet, we'll split them into several records. (Size of said records can be changed with #__MULTIRECORDSIZE. Default size is (2 ^16 - #__HEADER_SIZE - #__HEADER_SIZE - 8)  bytes and it is the absolute maximum!)
         RecordCount = Round(Size/#__MULTIRECORDSIZE,#PB_Round_Up)
         LastPackage = Size % #__MULTIRECORDSIZE
         If LastPackage = 0
            LastPackage = #__MULTIRECORDSIZE
            RecordCount -1
            PaddingSize = 0
         Else
            PaddingSize = Bool(LastPackage % 8 > 0) * (8 -LastPackage % 8)
         EndIf
      Else
         LastPackage = Size
         PaddingSize = Bool(Size % 8 > 0) * (8 -Size % 8)
      EndIf
      
      ; 2- Allocate memory and fill it with datathe needed records
      *Data = AllocateMemory(Size,#PB_Memory_NoClear)
      ForEach *Request\Response() ; TBH, I expect it to fail miserably if we have more than 64k worth of response/cookies... But it probably should not happen, so I hope I'm on the safe side.
         Position + PokeS(*Data + Position,MapKey(*Request\Response())+": "+*Request\Response()+#LF$,-1,#PB_Ascii|#PB_String_NoZero)
      Next
      
      ForEach *Request\Cookie()
         Position + PokeS(*Data + Position,"Set-Cookie: " + *Request\Cookie()+#LF$,-1,#PB_Ascii)
      Next
      
      Position + PokeS(*Data + Position,#LF$,-1,#PB_Ascii|#PB_String_NoZero)
      
      ForEach *Request\ResponseData()
         CopyMemory(*Request\ResponseData(),*Data + Position,MemorySize(*Request\ResponseData()))
         Position + MemorySize(*Request\ResponseData())
         FreeMemory(*Request\ResponseData())
         DeleteElement(*Request\ResponseData())
      Next
      
      
      *Packet = AllocateMemory(RecordCount * #__HEADER_SIZE + Size + PaddingSize + #__HEADER_SIZE + 8)
      Position = 0
      
      ; 3 - Let's create one big packet containing all the records.
      For RecordProgress = 1 To RecordCount
      	*Record = *Packet + Position
      	*Record\RequestIdB0 = *Request\RequestIdB0
      	*Record\RequestIdB1 = *Request\RequestIdB1
            *Record\Type = #__TYPE_STDOUT
            *Record\Version = #__VERSION
         If RecordProgress = RecordCount
            *Record\ContentLengthB0 = LastPackage
            *Record\ContentLengthB1 = LastPackage >> 8
            *Record\PaddingLength = PaddingSize
            
            CopyMemory(*Data+DataPosition,*Packet + Position+#__HEADER_SIZE,LastPackage)
         Else
            *Record\ContentLengthB0 = MultipleRecordSize
            *Record\ContentLengthB1 = MultipleRecordSize >> 8
            *Record\PaddingLength = 0
                        
            CopyMemory(*Data+DataPosition,*Packet + Position+#__HEADER_SIZE,#__MULTIRECORDSIZE)
            
            DataPosition + #__MULTIRECORDSIZE
            SentData = 0
            Repeat
            	Progress = SendNetworkData(*Request\ClientID,*Packet + Position + SentData,#__MULTIRECORDSIZE + #__HEADER_SIZE - SentData)
            	If Progress > 0
            		SentData + Progress
            	EndIf
            Until SentData = #__MULTIRECORDSIZE + #__HEADER_SIZE
            Position + #__MULTIRECORDSIZE + #__HEADER_SIZE
         EndIf
      Next
      
      FreeMemory(*Data)
      
      ; 4 - write the END record
      *Record = *Packet + Position + #__HEADER_SIZE + LastPackage + PaddingSize
      *Record\ContentLengthB0 = 8
      *Record\ContentLengthB1 = 0
      *Record\RequestIdB0 = *Request\RequestIdB0
      *Record\RequestIdB1 = *Request\RequestIdB1
      *Record\Type = #__TYPE_END
      *Record\Version = #__VERSION
      *Record\PaddingLength = 0
      
      *Request\Responded = #True
      
      SendNetworkData(*Request\ClientID,*Packet+ Position,#__HEADER_SIZE + LastPackage + PaddingSize + #__HEADER_SIZE + 8)
      FreeMemory(*Packet)
   EndProcedure
   
   Procedure.s GetCookie(*Request, Cookie.s)
      Protected.s Parameter = FastCGI::GetParameter(*Request,"HTTP_COOKIE"), Result
      Protected Position1,Position2
      
      Cookie + "="
      Position1 = FindString(Parameter, Cookie)
      
      If Position1
         Position1 + Len(Cookie)
         Position2 = FindString(Parameter, " ",Position1)
         
         If Position2 = 0
            Position2 = Len(Parameter)
         EndIf
         
         Result = Mid(Parameter,Position1,Position2-Position1+1)
         
      EndIf
      
      ProcedureReturn Result
   EndProcedure
   
   Procedure.s GetParameter(*Request.Request, Parameter.s)
      ProcedureReturn *Request\Variable(Parameter)
   EndProcedure
   
   Procedure WriteResponseHeader(*Request.Request, Header.s, Value.s)
      If Header = #PB_CGI_HeaderSetCookie
         AddElement(*Request\Cookie())
         *Request\Cookie() = Value
      Else
         *Request\Response(Header) = Value
      EndIf
   EndProcedure
   
   Procedure WriteResponseString(*Request.Request, String.s, Format = #PB_UTF8)
      AddElement(*Request\ResponseData())
      *Request\ResponseData() = AllocateMemory(StringByteLength(String,Format),#PB_Memory_NoClear)
      PokeS(*Request\ResponseData(),String,-1,Format|#PB_String_NoZero) ; // Temp
   EndProcedure
   
   Procedure WriteResponseData(*Request.Request,*Buffer, Lenght)
      AddElement(*Request\ResponseData())
      *Request\ResponseData() = AllocateMemory(Lenght,#PB_Memory_NoClear)
      CopyMemory(*Buffer,*Request\ResponseData(),Lenght)
   EndProcedure
   ;}
   
   ;{ Private procedures
   Procedure ServerThread(*ServerData.Server)
      Protected Lenght, ContentLenght
      Protected NewMap ClientMap.Request(), *Request.Request, *Record.Record = AllocateMemory(#__HEADER_SIZE,#PB_Memory_NoClear), *Data = AllocateMemory(65535,#PB_Memory_NoClear)
      
      Repeat
         Select NetworkServerEvent(*ServerData\ServerID)
            Case #PB_NetworkEvent_None
               Delay(1)
            Case #PB_NetworkEvent_Connect
               *Request = AddMapElement(ClientMap(), Str(EventClient()),#PB_Map_NoElementCheck)
               *Request\ClientID = EventClient()
               *Request\Alive = #True
            Case #PB_NetworkEvent_Data
               *Request = FindMapElement(ClientMap(), Str(EventClient()))
               While ReceiveNetworkData(*Request\ClientID,*Record,#__HEADER_SIZE) > 0
                  ContentLenght = (*Record\contentLengthB1 <<8 + *Record\contentLengthB0)
                  
                  Select *Record\type
                     Case #__TYPE_BEGIN
                        *Request\RequestIdB0 = *Record\RequestIdB0
                        *Request\RequestIdB1 = *Record\RequestIdB1
                        If ContentLenght
                           Lenght = ReceiveNetworkData(*Request\ClientID,*Data,ContentLenght)
                           ProcessPairs(*Data, *Request,Lenght)
                        EndIf
                     Case #__TYPE_ABORT
                        
                     Case #__TYPE_END
                        
                     Case #__TYPE_PARAMS
                        If ContentLenght
                           Lenght = ReceiveNetworkData(*Request\ClientID,*Data,ContentLenght)
                           ProcessPairs(*Data, *Request,Lenght)
                        EndIf
                     Case #__TYPE_STDIN
                        If ContentLenght
                           Lenght = ReceiveNetworkData(*Request\ClientID,*Data,ContentLenght)
                           ProcessPairs(*Data, *Request,Lenght)
                        EndIf
                        
                        CreateThread(*ServerData\Callback,*Request)
                        
                     Case #__TYPE_STDOUT
                        
                     Case #__TYPE_STDERR
                        
                     Case #__TYPE_DATA
                        
                     Case #__TYPE_GETVALUES
                        
                     Case #__TYPE_GETVALUES_RESULT
                        
                     Case #__TYPE_UNKOWNTYPE
                        
                  EndSelect
                  
                  If *Record\PaddingLength
                     ReceiveNetworkData(*Request\ClientID,*Data,*Record\PaddingLength)
                  EndIf
                  
               Wend
            Case #PB_NetworkEvent_Disconnect
               *Request = FindMapElement(ClientMap(), Str(EventClient()))
               If *Request\Responded
                  DeleteMapElement(ClientMap(),Str(EventClient()))
               Else
                  *Request\Alive = #False
               EndIf
         EndSelect
         
         If *ServerData\Stop
            Break
         EndIf
      ForEver
      
      CloseNetworkServer(*ServerData\ServerID)
      
      ProcedureReturn #Null
   EndProcedure
   
   Procedure ProcessPairs(*Data, *Request.Request   ,Lenght)
      EnableExplicit
      Protected Progress, namelenght, valuelenght,Name.s, Value.s
      
      While Progress < lenght
         namelenght = PeekA(*data + Progress)
         If namelenght = 128
            namelenght = ((PeekA(*data + Progress) & $7f) << 24) + (PeekA(*data + Progress + 1) << 16) + (PeekA(*data + Progress + 2) << 8) + PeekA(*data + Progress + 3);
            Progress + 3
         EndIf
         Progress + 1
         
         valuelenght = PeekA(*data + Progress)
         If valuelenght = 128
            valuelenght = ((PeekA(*data + Progress) & $7f) << 24) + (PeekA(*data + Progress + 1) << 16) + (PeekA(*data + Progress + 2) << 8) + PeekA(*data + Progress + 3);
            Progress + 3
         EndIf
         Progress + 1
         
         Name = PeekS(*data + Progress,namelenght,#PB_Ascii)
         If Len(Name)
            AddMapElement(*Request\Variable(),PeekS(*data + Progress,namelenght,#PB_Ascii),#PB_Map_NoElementCheck)
            Progress + namelenght
            
            *Request\Variable() = PeekS(*data + Progress,valuelenght,#PB_Ascii)
            Progress +valuelenght
            ;Debug MapKey(*Request\Variable()) + " : "+ *Request\Variable()
         EndIf
      Wend
      DisableExplicit
   EndProcedure
   ;}
EndModule

CompilerIf #PB_Compiler_IsMainFile
	
	ReadFile(0,"C:\Users\poshu\Desktop\image.bmp") ;<- replace this path by an existing one.
	Global *imagedata = AllocateMemory(Lof(0))
	ReadData(0,*imagedata,Lof(0))
	CloseFile(0)
	
   ; Demo   
   Procedure Handler_FCGIRequest(Request)
   	Debug FastCGI::GetCookie(Request,"acookie")
   	
   	;To send an image
   	FastCGI::WriteResponseHeader(Request,#PB_CGI_HeaderContentType,"image/bmp")
   	FastCGI::WriteResponseData(Request,*imagedata,MemorySize(*imagedata))
      
   	;To send some good old html
;    	FastCGI::WriteResponseHeader(Request,#PB_CGI_HeaderContentType,"text/html")
;    	FastCGI::WriteResponseString(Request,~"<head><meta charset=\"UTF-8\"></head>" +
;    	                                     "<html><title>PureBasic - FastCGI</title><body>" +
;    	                                     "Hello from PureBasic Re-FCGI くも!<br>" +
;    	                                     "Actual time: <b>"+FormatDate("%hh:%ii", Date()) + "</b>" +
;    	                                     "</body></html>")
;    	FastCGI::WriteResponseHeader(Request,#PB_CGI_HeaderSetCookie,"acookie=avalue")
   	
   	FastCGI::FinishReponse(Request)
   EndProcedure
   
   OpenConsole("fastCGI Demo")
   
   InitNetwork()
   Server = FastCGI::Open(5600,@Handler_FCGIRequest())
   
   Input()
   FastCGI::Close(Server)
   PrintN("Server closed")
   
   Input()
   End
CompilerEndIf
Dernière modification par poshu le ven. 21/déc./2018 16:50, modifié 13 fois.
boby
Messages : 261
Inscription : jeu. 07/juin/2007 22:54

Re: [WIP] FastCGI

Message par boby »

Merci pour le partage, il va falloir faire des essais avec cette lib ;)

Euh entre ton EndDeclareModule et ton Module FastCGI y'a un "WriteCGIString(" qui traine pas sur qu'il ai grand chose à foutre ici :p
poshu
Messages : 1138
Inscription : sam. 31/juil./2004 22:32

Re: [WIP] FastCGI

Message par poshu »

boby a écrit :Merci pour le partage, il va falloir faire des essais avec cette lib ;)

Euh entre ton EndDeclareModule et ton Module FastCGI y'a un "WriteCGIString(" qui traine pas sur qu'il ai grand chose à foutre ici :p
... En effet. L’incompétence, ça ne se soigne pas é___è;

J'en profite pour fixe un petit bug aussi... Qui était lui aussi une belle gamelle de ma part (⁄ ⁄•⁄ω⁄•⁄ ⁄)
poshu
Messages : 1138
Inscription : sam. 31/juil./2004 22:32

Re: [WIP] FastCGI

Message par poshu »

Petite maj, avec les cookies et le support des characters internationaux.
poshu
Messages : 1138
Inscription : sam. 31/juil./2004 22:32

Re: [WIP] FastCGI

Message par poshu »

J'ai ajouté un support expérimental des records dépassant les 64ko...
La doc ne précise pas comment on est censé les gérer mais après quelques essais, j'ai trouvé qu'envoyer plusieurs packets contenant chacun un record de 2^14 octets fonctionne avec XAMPP v7.2.12, mais je ne suis vraiment pas convaincu de la viabilité de la chose. Je testerai sous Nginx et avec d'autres fichiers plus tard.
poshu
Messages : 1138
Inscription : sam. 31/juil./2004 22:32

Re: [WIP] FastCGI

Message par poshu »

L'envoie de gros fichiers fonctionne correctement... Mais extrêmement lentement, parce que je ne comprends pas comment fonctionne SendNetworkData().
Avatar de l’utilisateur
❤x1
Messages : 10
Inscription : jeu. 10/janv./2019 17:26
Contact :

Re: [WIP] FastCGI

Message par ❤x1 »

Nécromancie !
Je déterre ce topic puisque je me suis servi de ce module (merci du partage !) et que j'y ai ajouté deux fonctions :
  • une fonction pour envoyer un fichier sans avoir besoin de construire la réponse manuellement.

Code : Tout sélectionner

DeclareModule FastCGI
	; Server
	Declare Open(Port, *Callback, BindedIP.s = "")                                          ;Create a FCGI Application on the given port. Return a Server object if succeed or 0 otherwise. Callback format : Callback(Request)
	Declare Close(*Server)																	;Close the given Server.
	
	; Request
	Declare FinishReponse(*Request)                                                         ;Send the response
	Declare.s GetCookie(*Request, Cookie.s)													;Return the value of the given
	Declare.s GetParameter(*Request, Parameter.s)											;Return the value of the give parameter if it exists.
	Declare WriteResponseHeader(*Request, Header.s, Value.s)								;Write a header to the response
	Declare WriteResponseData(*Request,*Buffer, Lenght)										;Add data to the response
	Declare WriteResponseString(*Request, String.s, Format = #PB_UTF8)						;Add a string to the response
	Declare WriteResponseContentType(*Request, File.s)										;Write the MIME type based on this list : https://developer.mozilla.org/en-US/docs/Web/HTTP/MIME_types/Common_types
	Declare RespondFile(*Request, File.s)													;Automatically send a file as a response, no need to manually write the response.
EndDeclareModule

Module FastCGI
	EnableExplicit
	
	;{ private variables declaration
	#__VERSION = 1
	
	#__ROLE_RESPONDER = 1
	#__ROLE_AUTHORIZER = 2
	#__ROLE_FILTER = 3
	
	#__TYPE_BEGIN = 1
	#__TYPE_ABORT = 2
	#__TYPE_END = 3
	#__TYPE_PARAMS = 4
	#__TYPE_STDIN = 5
	#__TYPE_STDOUT = 6
	#__TYPE_STDERR = 7
	#__TYPE_DATA = 8
	#__TYPE_GETVALUES = 9
	#__TYPE_GETVALUES_RESULT = 10
	#__TYPE_UNKOWNTYPE = 11
	
	Structure Server
		ServerID.i
		Thread.i
		Stop.i
		*Callback
	EndStructure
	
	Structure Record
		Version.a
		Type.a
		RequestIdB1.a
		RequestIdB0.a
		ContentLengthB1.a
		ContentLengthB0.a
		PaddingLength.a
		Reserved.a
	EndStructure
	
	Structure Request
		ClientID.i
		RequestIdB1.a
		RequestIdB0.a
		Alive.a
		Responded.a
		Map Variable.s()
		Map Response.s()
		List Cookie.s()
		List ResponseData.i()
	EndStructure
	
	#__HEADER_SIZE = SizeOf(Record)
	#__MULTIRECORDSIZE = 65512
	
	Global NewMap MIMETypes.s()
	
	MIMETypes("aacMimeType") = "audio/aac"
	MIMETypes("abw") = "application/x-abiword"
	MIMETypes("apng") = "image/apng"
	MIMETypes("arc") = "application/x-freearc"
	MIMETypes("avif") = "image/avif"
	MIMETypes("avi") = "video/x-msvideo"
	MIMETypes("azw") = "application/vnd.amazon.ebook"
	MIMETypes("bin") = "application/octet-stream"
	MIMETypes("bmp") = "image/bmp"
	MIMETypes("bz") = "application/x-bzip"
	MIMETypes("bz2") = "application/x-bzip2"
	MIMETypes("cda") = "application/x-cdf"
	MIMETypes("csh") = "application/x-csh"
	MIMETypes("css") = "text/css"
	MIMETypes("csv") = "text/csv"
	MIMETypes("doc") = "application/msword"
	MIMETypes("docx") = "application/vnd.openxmlformats-officedocument.wordprocessingml.document"
	MIMETypes("eot") = "application/vnd.ms-fontobject"
	MIMETypes("epub") = "application/epub+zip"
	MIMETypes("gz") = "application/gzip"
	MIMETypes("gif") = "image/gif"
	MIMETypes("htm") = "text/html"
	MIMETypes("html") = "text/html"
	MIMETypes("ico") = "image/vnd.microsoft.icon"
	MIMETypes("ics") = "text/calendar"
	MIMETypes("jar") = "application/java-archive"
	MIMETypes("jpeg") = "image/jpeg"
	MIMETypes("jpg") = "image/jpeg"
	MIMETypes("js") = "text/javascript"
	MIMETypes("json") = "application/json"
	MIMETypes("jsonld") = "application/ld+json"
	MIMETypes("mid") = "audio/midi,audio/x-midi"
	MIMETypes("midi") = "audio/midi,audio/x-midi"
	MIMETypes("mjs") = "text/javascript"
	MIMETypes("mp3") = "audio/mpeg"
	MIMETypes("mp4") = "video/mp4"
	MIMETypes("mpeg") = "video/mpeg"
	MIMETypes("mpkg") = "application/vnd.apple.installer+xml"
	MIMETypes("odp") = "application/vnd.oasis.opendocument.presentation"
	MIMETypes("ods") = "application/vnd.oasis.opendocument.spreadsheet"
	MIMETypes("odt") = "application/vnd.oasis.opendocument.text"
	MIMETypes("oga") = "audio/ogg"
	MIMETypes("ogv") = "video/ogg"
	MIMETypes("ogx") = "application/ogg"
	MIMETypes("opus") = "audio/ogg"
	MIMETypes("otf") = "font/otf"
	MIMETypes("pb") = "text/plain"
	MIMETypes("pbi") = "text/plain"
	MIMETypes("pbp") = "text/plain"
	MIMETypes("png") = "image/png"
	MIMETypes("pdf") = "application/pdf"
	MIMETypes("php") = "application/x-httpd-php"
	MIMETypes("ppt") = "application/vnd.ms-powerpoint"
	MIMETypes("pptx") = "application/vnd.openxmlformats-officedocument.presentationml.presentation"
	MIMETypes("rar") = "application/vnd.rar"
	MIMETypes("rtf") = "application/rtf"
	MIMETypes("sb") = "text/plain"
	MIMETypes("sbi") = "text/plain"
	MIMETypes("sbp") = "text/plain"
	MIMETypes("sh") = "application/x-sh"
	MIMETypes("svg") = "image/svg+xml"
	MIMETypes("tar") = "application/x-tar"
	MIMETypes("tif") = "image/tiff"
	MIMETypes("tiff") = "image/tiff"
	MIMETypes("ts") = "video/mp2t"
	MIMETypes("ttf") = "font/ttf"
	MIMETypes("txt") = "text/plain"
	MIMETypes("vsd") = "application/vnd.visio"
	MIMETypes("wav") = "audio/wav"
	MIMETypes("weba") = "audio/webm"
	MIMETypes("webm") = "video/webm"
	MIMETypes("webp") = "image/webp"
	MIMETypes("woff") = "font/woff"
	MIMETypes("woff2") = "font/woff2"
	MIMETypes("xhtml") = "application/xhtml+xml"
	MIMETypes("xls") = "application/vnd.ms-excel"
	MIMETypes("xlsx") = "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
	MIMETypes("xml") = "application/xml"
	MIMETypes("xul") = "application/vnd.mozilla.xul+xml"
	MIMETypes("zip") = "application/zip"
	MIMETypes("3gp") = "video/3gpp"
	MIMETypes("3g2") = "video/3gpp2"
	MIMETypes("7z") = "application/x-7z-compressed"
	;}
	
	;{ Private procedures declaration
	Declare ServerThread(Server)
	Declare ProcessPairs(*Data, *Request.Request   ,Lenght)
	
	;}
	
	;{ Public procedures
	;- Server
	Procedure Close(*Server.Server)
		; Wow, no mutex? Well... I feel like living dangerously! (Also, I need to test : I don't think it can be a problem...)
		*Server\Stop = #True
	EndProcedure
	
	Procedure Open(Port, *Callback, BindedIP.s = "")
		Protected Server, *ServerData.Server
		
		Server = CreateNetworkServer(#PB_Any,Port,#PB_Network_TCP,BindedIP)
		
		If Server
			*ServerData.Server = AllocateMemory(SizeOf(Server))
			*ServerData\ServerID = Server
			*ServerData\Thread = CreateThread(@ServerThread(),*ServerData)
			*ServerData\Callback = *Callback
		EndIf
		
		ProcedureReturn *ServerData
	EndProcedure
	
	;- Request
	Procedure FinishReponse(*Request.Request)
		Protected Size, PaddingSize, Position, DataPosition, RecordCount = 1,LastPackage = 0, RecordProgress , MultipleRecordSize = #__MULTIRECORDSIZE,SentData, Progress
		Protected *Record.Record
		Protected *Data, *Packet
		; 1- Calculate the packet size
		ForEach *Request\Response()
			Size + StringByteLength(MapKey(*Request\Response())+*Request\Response(),#PB_Ascii)   + 3 ; 3 byte as : 1 byte for LF and 2 bytes for ": "
		Next
		
		ForEach *Request\ResponseData()
			Size + MemorySize(*Request\ResponseData())
		Next
		
		ForEach *Request\Cookie()
			Size + StringByteLength(*Request\Cookie(),#PB_Ascii) + 13 ; 12 is for "Set-Cookie: ", 1 = LF
		Next
		
		Size +1 ; le dernier LF
		
		If Size > #__MULTIRECORDSIZE ; Ok so, if we are trying to send more than the maximum size of a fcgi record/packet, we'll split them into several records. (Size of said records can be changed with #__MULTIRECORDSIZE. Default size is (2 ^16 - #__HEADER_SIZE - #__HEADER_SIZE - 8)  bytes and it is the absolute maximum!)
			RecordCount = Round(Size/#__MULTIRECORDSIZE,#PB_Round_Up)
			LastPackage = Size % #__MULTIRECORDSIZE
			If LastPackage = 0
				LastPackage = #__MULTIRECORDSIZE
				RecordCount -1
				PaddingSize = 0
			Else
				PaddingSize = Bool(LastPackage % 8 > 0) * (8 -LastPackage % 8)
			EndIf
		Else
			LastPackage = Size
			PaddingSize = Bool(Size % 8 > 0) * (8 -Size % 8)
		EndIf
		
		; 2- Allocate memory and fill it with datathe needed records
		*Data = AllocateMemory(Size,#PB_Memory_NoClear)
		ForEach *Request\Response() ; TBH, I expect it to fail miserably if we have more than 64k worth of response/cookies... But it probably should not happen, so I hope I'm on the safe side.
			Position + PokeS(*Data + Position,MapKey(*Request\Response())+": "+*Request\Response()+#LF$,-1,#PB_Ascii|#PB_String_NoZero)
		Next
		
		ForEach *Request\Cookie()
			Position + PokeS(*Data + Position,"Set-Cookie: " + *Request\Cookie()+#LF$,-1,#PB_Ascii)
		Next
		
		Position + PokeS(*Data + Position,#LF$,-1,#PB_Ascii|#PB_String_NoZero)
		
		ForEach *Request\ResponseData()
			CopyMemory(*Request\ResponseData(),*Data + Position,MemorySize(*Request\ResponseData()))
			Position + MemorySize(*Request\ResponseData())
			FreeMemory(*Request\ResponseData())
			DeleteElement(*Request\ResponseData())
		Next
		
		
		*Packet = AllocateMemory(RecordCount * #__HEADER_SIZE + Size + PaddingSize + #__HEADER_SIZE + 8)
		Position = 0
		
		; 3 - Let's create one big packet containing all the records.
		For RecordProgress = 1 To RecordCount
			*Record = *Packet + Position
			*Record\RequestIdB0 = *Request\RequestIdB0
			*Record\RequestIdB1 = *Request\RequestIdB1
			*Record\Type = #__TYPE_STDOUT
			*Record\Version = #__VERSION
			If RecordProgress = RecordCount
				*Record\ContentLengthB0 = LastPackage
				*Record\ContentLengthB1 = LastPackage >> 8
				*Record\PaddingLength = PaddingSize
				
				CopyMemory(*Data+DataPosition,*Packet + Position+#__HEADER_SIZE,LastPackage)
			Else
				*Record\ContentLengthB0 = MultipleRecordSize
				*Record\ContentLengthB1 = MultipleRecordSize >> 8
				*Record\PaddingLength = 0
				
				CopyMemory(*Data+DataPosition,*Packet + Position+#__HEADER_SIZE,#__MULTIRECORDSIZE)
				
				DataPosition + #__MULTIRECORDSIZE
				SentData = 0
				Repeat
					Progress = SendNetworkData(*Request\ClientID,*Packet + Position + SentData,#__MULTIRECORDSIZE + #__HEADER_SIZE - SentData)
					If Progress > 0
						SentData + Progress
					EndIf
				Until SentData = #__MULTIRECORDSIZE + #__HEADER_SIZE
				Position + #__MULTIRECORDSIZE + #__HEADER_SIZE
			EndIf
		Next
		
		FreeMemory(*Data)
		
		; 4 - write the END record
		*Record = *Packet + Position + #__HEADER_SIZE + LastPackage + PaddingSize
		*Record\ContentLengthB0 = 8
		*Record\ContentLengthB1 = 0
		*Record\RequestIdB0 = *Request\RequestIdB0
		*Record\RequestIdB1 = *Request\RequestIdB1
		*Record\Type = #__TYPE_END
		*Record\Version = #__VERSION
		*Record\PaddingLength = 0
		
		*Request\Responded = #True
		
		SendNetworkData(*Request\ClientID,*Packet+ Position,#__HEADER_SIZE + LastPackage + PaddingSize + #__HEADER_SIZE + 8)
		FreeMemory(*Packet)
	EndProcedure
	
	Procedure.s GetCookie(*Request, Cookie.s)
		Protected.s Parameter = FastCGI::GetParameter(*Request,"HTTP_COOKIE"), Result
		Protected Position1,Position2
		
		Cookie + "="
		Position1 = FindString(Parameter, Cookie)
		
		If Position1
			Position1 + Len(Cookie)
			Position2 = FindString(Parameter, " ",Position1)
			
			If Position2 = 0
				Position2 = Len(Parameter)
			EndIf
			
			Result = Mid(Parameter,Position1,Position2-Position1+1)
			
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	
	Procedure.s GetParameter(*Request.Request, Parameter.s)
		ProcedureReturn *Request\Variable(Parameter)
	EndProcedure
	
	Procedure WriteResponseHeader(*Request.Request, Header.s, Value.s)
		If Header = #PB_CGI_HeaderSetCookie
			AddElement(*Request\Cookie())
			*Request\Cookie() = Value
		Else
			*Request\Response(Header) = Value
		EndIf
	EndProcedure
	
	Procedure WriteResponseString(*Request.Request, String.s, Format = #PB_UTF8)
		AddElement(*Request\ResponseData())
		*Request\ResponseData() = AllocateMemory(StringByteLength(String,Format),#PB_Memory_NoClear)
		PokeS(*Request\ResponseData(),String,-1,Format|#PB_String_NoZero) ; // Temp
	EndProcedure
	
	Procedure WriteResponseData(*Request.Request,*Buffer, Lenght)
		AddElement(*Request\ResponseData())
		*Request\ResponseData() = AllocateMemory(Lenght,#PB_Memory_NoClear)
		CopyMemory(*Buffer,*Request\ResponseData(),Lenght)
	EndProcedure
	
	Procedure WriteResponseContentType(*Request.Request, File.s)
		Protected MIMEType.s
		
		File = GetExtensionPart(File)
		If FindMapElement(MIMETypes(), File)
			MIMEType = MIMETypes()
		Else
			MIMEType = "application/octet-stream"
		EndIf
		
		*Request\Response(#PB_CGI_HeaderContentType) = MIMEType
	EndProcedure
	
	Procedure RespondFile(*Request.Request, File.s)
		Protected Result = #False, Lof, FileIndex = ReadFile(#PB_Any, File, #PB_File_SharedRead)
		
		If FileIndex
			Lof = Lof(FileIndex)
			WriteResponseContentType(*Request, File)
			AddElement(*Request\ResponseData())
			*Request\ResponseData() = AllocateMemory(Lof, #PB_Memory_NoClear)
			ReadData(FileIndex, *Request\ResponseData(), Lof)
			CloseFile(FileIndex)
			FinishReponse(*Request)
			Result = #True
		EndIf
		
		ProcedureReturn Result
	EndProcedure
	;}
	
	;{ Private procedures
	Procedure ServerThread(*ServerData.Server)
		Protected Lenght, ContentLenght
		Protected NewMap ClientMap.Request(), *Request.Request, *Record.Record = AllocateMemory(#__HEADER_SIZE,#PB_Memory_NoClear), *Data = AllocateMemory(65535,#PB_Memory_NoClear)
		
		Repeat
			Select NetworkServerEvent(*ServerData\ServerID)
				Case #PB_NetworkEvent_None
					Delay(1)
				Case #PB_NetworkEvent_Connect
					*Request = AddMapElement(ClientMap(), Str(EventClient()),#PB_Map_NoElementCheck)
					*Request\ClientID = EventClient()
					*Request\Alive = #True
				Case #PB_NetworkEvent_Data
					*Request = FindMapElement(ClientMap(), Str(EventClient()))
					While ReceiveNetworkData(*Request\ClientID,*Record,#__HEADER_SIZE) > 0
						ContentLenght = (*Record\contentLengthB1 <<8 + *Record\contentLengthB0)
						
						Select *Record\type
							Case #__TYPE_BEGIN
								*Request\RequestIdB0 = *Record\RequestIdB0
								*Request\RequestIdB1 = *Record\RequestIdB1
								If ContentLenght
									Lenght = ReceiveNetworkData(*Request\ClientID,*Data,ContentLenght)
									ProcessPairs(*Data, *Request,Lenght)
								EndIf
							Case #__TYPE_ABORT
								
							Case #__TYPE_END
								
							Case #__TYPE_PARAMS
								If ContentLenght
									Lenght = ReceiveNetworkData(*Request\ClientID,*Data,ContentLenght)
									ProcessPairs(*Data, *Request,Lenght)
								EndIf
							Case #__TYPE_STDIN
								If ContentLenght
									Lenght = ReceiveNetworkData(*Request\ClientID,*Data,ContentLenght)
									ProcessPairs(*Data, *Request,Lenght)
								EndIf
								
								CreateThread(*ServerData\Callback,*Request)
								
							Case #__TYPE_STDOUT
								
							Case #__TYPE_STDERR
								
							Case #__TYPE_DATA
								
							Case #__TYPE_GETVALUES
								
							Case #__TYPE_GETVALUES_RESULT
								
							Case #__TYPE_UNKOWNTYPE
								
						EndSelect
						
						If *Record\PaddingLength
							ReceiveNetworkData(*Request\ClientID,*Data,*Record\PaddingLength)
						EndIf
						
					Wend
				Case #PB_NetworkEvent_Disconnect
					*Request = FindMapElement(ClientMap(), Str(EventClient()))
					If *Request\Responded
						DeleteMapElement(ClientMap(),Str(EventClient()))
					Else
						*Request\Alive = #False
					EndIf
			EndSelect
			
			If *ServerData\Stop
				Break
			EndIf
		ForEver
		
		CloseNetworkServer(*ServerData\ServerID)
		
		ProcedureReturn #Null
	EndProcedure
	
	Procedure ProcessPairs(*Data, *Request.Request   ,Lenght)
		EnableExplicit
		Protected Progress, namelenght, valuelenght,Name.s, Value.s
		
		While Progress < lenght
			namelenght = PeekA(*data + Progress)
			If namelenght = 128
				namelenght = ((PeekA(*data + Progress) & $7f) << 24) + (PeekA(*data + Progress + 1) << 16) + (PeekA(*data + Progress + 2) << 8) + PeekA(*data + Progress + 3);
				Progress + 3
			EndIf
			Progress + 1
			
			valuelenght = PeekA(*data + Progress)
			If valuelenght = 128
				valuelenght = ((PeekA(*data + Progress) & $7f) << 24) + (PeekA(*data + Progress + 1) << 16) + (PeekA(*data + Progress + 2) << 8) + PeekA(*data + Progress + 3);
				Progress + 3
			EndIf
			Progress + 1
			
			Name = PeekS(*data + Progress,namelenght,#PB_Ascii)
			If Len(Name)
				AddMapElement(*Request\Variable(),PeekS(*data + Progress,namelenght,#PB_Ascii),#PB_Map_NoElementCheck)
				Progress + namelenght
				
				*Request\Variable() = PeekS(*data + Progress,valuelenght,#PB_Ascii)
				Progress +valuelenght
				;Debug MapKey(*Request\Variable()) + " : "+ *Request\Variable()
			EndIf
		Wend
		DisableExplicit
	EndProcedure
	;}
EndModule

CompilerIf #PB_Compiler_IsMainFile
	ReadFile(0,"D:\test.bmp") ;<- replace this path by an existing one.
	Global *imagedata = AllocateMemory(Lof(0))
	ReadData(0,*imagedata,Lof(0))
	CloseFile(0)
	
	; Demo   
	Procedure Handler_FCGIRequest(Request)
		FastCGI::WriteResponseContentType(Request, "D:\test.bmp")
		FastCGI::WriteResponseData(Request,*imagedata,MemorySize(*imagedata))
		FastCGI::FinishReponse(Request)
	EndProcedure
	
	OpenConsole("fastCGI Demo")
	
	Server = FastCGI::Open(5600,@Handler_FCGIRequest())
	
	Input()
	FastCGI::Close(Server)
	PrintN("Server closed")
	
	Input()
	End
CompilerEndIf
Open Source Stuff : Inputify, UITK
Répondre