Simple Web Server ++ (Unicode)

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Simple Web Server ++ (Unicode)

Message par falsam »

Djes (Extrait du sujet Atomic Web Server a écrit :Je me doutais que tu n'allais pas en rester là :) J'ai hâte de voir ce que tu vas nous pondre.
■ Démonstration de Simple Web Server ++
http://109.13.115.206:6835

On prend la Simple Web Server et on sort Simple Web Server ++ qui permet de monter un serveur de page HTML dynamiques.

Dynamiques parce que chacune de vos pages peut contenir une ou plusieurs variables sous la forme {{mavariable}} pouvant être mise à jour par votre serveur.

Dynamiques parce que chacune de vos pages peut contenir un formulaire de saisie qui sera réceptionné par votre serveur avec la méthode POST.

Voici le code HTML de la page index.html de démonstration contenant des variables ainsi qu'un formulaire de saisie de commentaires.

Code : Tout sélectionner

<!DOCTYPE html>
<html>
<head>
<title>Simple Web Server ++</title>
</head>
<body>
	<h1 style='text-align:center';>Simple Web Server ++</h1>

	<p style='text-align:center'>
		Ceci est la première page de votre site web. / This is the first page of your website.</br>
		Les pages sont encodées UTF8. / Pages are UTF8 encoded.</br></br>
		<img src="assets/image/html5.png" alt="HTML5 Logo"></br></br>
		IP : <strong>{{userip}}</strong>
	</p>
	
	<!-- Formulaire envoi commentaire -->
	<h4 style='text-align:center';>Vous pouvez laisser un commentaire / You can leave a comment.</h4>
	<form style='margin:0 auto; width:500px' method="POST">
		<p>
		<input type="text" name="user" placeholder="Username" maxlength="20" size="10">
		<input type="text" name="comment" placeholder="Write your comment." maxlength="240" size="40">
		<input type="submit" value = "Send"></p>	
	</form>
	<!-- Message d'erreur -->
	<p style='text-align:center'>{{information}}</p>
	
	<!-- Liste des commentaires -->
	<p style='margin:0 auto; width:500px'>{{comments}}</p>
</body>
</html>
Cette page est lu par le serveur et stockée dans un string que j'ai nommé FileContent.s

Mise à jour des variables de page HTML.
Nous avons une ligne qui contient la variable {{userip}}
L'adresse IP est calculé par le serveur et la variable {{userip}} sera remplacé avec la fonction native ReplaceString()

Exemples
-ReplaceString(FileContent, "{{userip}}", IPString(GetClientIP(ClientID)))
-ReplaceString(FileContent, "{{information}}", "Username or comment missing ...")

Réception d'un formulaire POST.
Un formulaire HTML est reçu par le serveur avec la méthode POST
Exemples : index/html?user=falsam&comment=test de commentaire

Chacune des données est récupérée avec la fonction native de PureBasic GetURLPart()
Exemple : GetURLPart(URL, "user") donnera falsam comme résultat.

Et maintenant le code.
Cette démonstration affiche l'ip du visiteur et lui permet de laisser un commentaire.

Code : Tout sélectionner

;Simple Web Server ++ 
;
;PureBasic 5.43 (unicode) minimum
;

EnableExplicit

Global Title.s = "Simple Web Server ++"

;Network Setup
Global Port = 6835
Global ClientID
Global BufferSize = 1024, *Buffer = AllocateMemory(BufferSize), Buffer.s

;WWW Setup
Global WWWDirectory.s = "www/"
Global WWWIndex.s = "index.html"
Global WWWError.s = "error.html"

;Comments Setup
Structure newComment
  user.s
  comment.s
EndStructure
Global NewList Comments.newComment()

Declare Start()                                                 
Declare ProcessRequest()                      
Declare BuildRequestHeader(*Buffer, FileExtension.s, FileLength)
Declare ClearLog()
Declare Resize()
Declare Exit()                                                  

Start()

;Affichage / Show application
Procedure Start()
  Protected ServerEvent, Result
  
  If Not InitNetwork() 
    MessageRequester(Title, "Can't initialize the network !", 0)
  Else     
    
    
    ;Chargement config server / load server setup
    If LoadJSON(0, "comments.json")
      ExtractJSONList(JSONValue(0), Comments())        
    EndIf
    
    ;Remove JavaScripts, Stylesheets and HTML Tags
    CreateRegularExpression(0, "(?iU)<(script|style)>.*</\1>")  ;Remove script and style
    CreateRegularExpression(1, "(?iU)<.*>")                     ;Remove HTML-Tags
    
    ;Création du serveur / Create server 
    If CreateNetworkServer(0, Port)      
      OpenWindow(0, 0, 0, 800, 600, Title, #PB_Window_SystemMenu | #PB_Window_SizeGadget)
      WindowBounds(0, 200, 100, #PB_Ignore, #PB_Ignore) 
      
      EditorGadget(0, 0, 0, 800, 560, #PB_Editor_ReadOnly)
      AddGadgetItem(0, -1, FormatDate("%hh:%mm", Date()) + " | Server listening on port " + Port)
      
      CheckBoxGadget(1, 10, 570, 200, 22, "Show Log") 
      SetGadgetState(1, #PB_Checkbox_Checked)
      
      ButtonGadget(2, 700, 570, 80, 22, "Clear Log")
      
      ;Déclencheur / Trigger
      BindGadgetEvent(2, @ClearLog())
      BindEvent(#PB_Event_SizeWindow, @Resize())
      BindEvent(#PB_Event_CloseWindow, @Exit())
      
      Repeat    
        Repeat : Until WindowEvent() = 0
        
        ServerEvent = NetworkServerEvent()
        If ServerEvent
          ClientID = EventClient()
          Buffer = ""
          Select ServerEvent              
            Case #PB_NetworkEvent_Data 
              Repeat
                FreeMemory(*Buffer)
                *Buffer = AllocateMemory(BufferSize)
                Result = ReceiveNetworkData(ClientID, *Buffer, BufferSize)
                Buffer + PeekS(*Buffer, -1, #PB_UTF8)
              Until Result <> BufferSize
              
              ProcessRequest()
          EndSelect
        Else
          Delay(10)  ; Ne pas saturer le CPU / Don't stole the whole CPU !
        EndIf
      ForEver     
    Else
      MessageRequester(Title, "Error: can't create the server (port " + port + " in use ?)")
    EndIf
  EndIf
EndProcedure

;Demande de traitement / Process Request
Procedure ProcessRequest()
  Protected RequestedFile.s, FileLength
  Protected FileContent.s, *FileContent, *Buffer, HeaderLength = 1024
  Protected Method.s = Trim(StringField(Buffer, 1, "/"))
  Protected URL.s, Comments.s
  
  If Method = "GET" Or Method = "POST"   
    ;Extract page html from "GET /yourpage.html HTTP/1.1"
    RequestedFile = Trim(Mid(StringField(Buffer, 1, "HTTP"), Len(Method)+3))    
    
    If RequestedFile = ""
      RequestedFile = WWWIndex      
    EndIf
    
    ;-Extract parameters if exist
    If Method = "POST"
      URL = RequestedFile + "?" + URLDecoder(StringField(Buffer, CountString(Buffer, #CRLF$) + 1, #CRLF$))
      URL = ReplaceRegularExpression(0, URL, "") ;Remove script and style
      URL = ReplaceRegularExpression(1, URL, "") ;Remove HTML tags
    EndIf
    
    Debug URL
    
    ;Mise à jour du log / UPdated log
    If GetGadgetState(1) = #PB_Checkbox_Checked
      AddGadgetItem(0, -1, FormatDate("%hh:%mm", Date()) + " | Client IP " + IPString(GetClientIP(ClientID)) + " load " + RequestedFile) 
    EndIf   
    
    ;Lecture fichier demandé / Read Requested file
    If ReadFile(0, WWWDirectory + RequestedFile)
    Else
      ReadFile(0, WWWDirectory + WWWError)     
    EndIf
    FileLength = Lof(0)
    
    If GetExtensionPart(RequestedFile) = "html"
      
      ;1 - Préparation des données / Preparation of data     
      *FileContent = AllocateMemory(FileLength)
      ReadData(0, *FileContent, FileLength)
      CloseFile(0)
      
      ;2 - *Memory -> HTML String 
      FileContent = PeekS(*FileContent, -1, #PB_UTF8)
      
      ;3 - Mise à jour des variables / Updating variables
      Select LCase(RequestedFile)
        Case "index.html"
          ;Display User IP
          FileContent = ReplaceString(FileContent, "{{userip}}", IPString(GetClientIP(ClientID)))      
          
          ;New comment ?
          If URL <> ""
            If GetURLPart(URL, "comment") <> "" And GetURLPart(URL, "user") <> "" 
              AddElement(Comments())
              With Comments()
                \user    = GetURLPart(URL, "user")
                \comment = GetURLPart(URL, "comment")              
              EndWith            
              FileContent = ReplaceString(FileContent, "{{information}}", "")
            Else
              FileContent = ReplaceString(FileContent, "{{information}}", "Username or comment missing ....")               
            EndIf
          Else
            FileContent = ReplaceString(FileContent, "{{information}}", "")              
          EndIf
          
          ;Display comments
          ForEach Comments()
            With Comments()
              Comments + "<strong>" + \user + "</strong> -  " + \comment + "</br></br>" 
            EndWith
          Next
          FileContent = ReplaceString(FileContent, "{{comments}}", Comments)
      EndSelect
      
      ;4 - Ajustement de la taille mémoire / Memory Size adjustment
      FileLength = StringByteLength(FileContent, #PB_UTF8)
      
      FreeMemory(*FileContent)
      *FileContent = AllocateMemory(HeaderLength + FileLength)
      
      ;5 - Initialisation Header HTTP / Init Header HTTP
      *Buffer = BuildRequestHeader(*FileContent, GetExtensionPart(RequestedFile), FileLength)
      
      ;6 - HTML String -> *Memory 
      ; |-------------|-----------------------------------|
      ; | HTTP Header | HTML Content                      | 
      ; |-------------|-----------------------------------|
      HeaderLength = Len(PeekS(*FileContent, -1, #PB_UTF8))
      
      *FileContent + HeaderLength ;Position end header
      PokeS(*FileContent, FileContent, -1, #PB_UTF8) ;Add content
      *FileContent - HeaderLength                    ;Position start header
      
    Else
      
      ;Ce n'est pas un fichier html / This is not a HTML File
      
      ;Initialisation Header HTTP / Init Header HTTP
      *FileContent  = AllocateMemory(HeaderLength + FileLength)
      *Buffer = BuildRequestHeader(*FileContent, GetExtensionPart(RequestedFile), FileLength)
      
      ;Ajout contenu fichier / Add file content
      ReadData(0, *Buffer, FileLength)
      CloseFile(0)        
    EndIf
    
    ;Envoyer la page HTML au client / Send the HTML page to the client
    SendNetworkData(ClientID, *FileContent, *Buffer - *FileContent + FileLength)  
    FreeMemory(*FileContent)
  EndIf
EndProcedure

;Creation entete HTTP / Create HTTP header
Procedure BuildRequestHeader(*Buffer, FileExtension.s, FileLength)
  Protected Week.s = "Sun, Mon,Tue,Wed,Thu,Fri,Sat"
  Protected MonthsOfYear.s = "Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec" 
  
  Protected DayOfWeek.s = StringField("Sun, Mon,Tue,Wed,Thu,Fri,Sat", DayOfWeek(Date()) + 1, ",")
  Protected Day = Day(Date())
  Protected Month.s = StringField("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec", Month(Date()), ",")
  Protected Year.s = Str(Year(Date()))
  Protected Time.s = FormatDate("%hh:%ii:%ss GMT", Date())
  Protected ContentType.s
  Protected Length
  
  ;Definition du content-type / Setup content-type
  ;Ref : https://fr.wikipedia.org/wiki/Type_MIME
  Select LCase(FileExtension)
    Case "html", "", "test" : ContentType = "text/html"
    Case "css"      : ContentType = "text/css"
    Case "js"       : ContentType = "application/javascript" 
    Case "gif"      : ContentType = "image/gif"
    Case "jpg"      : ContentType = "image/jpeg"
    Case "png"      : ContentType = "image/png"
    Case "txt"      : ContentType = "text/plain"
    Case "zip"      : ContentType = "application/zip"
    Case "pdf"      : ContentType = "application/pdf"
    Default         : ContentType = "application/octet-stream" 
  EndSelect  
  
  ;Création entete / Create header
  Length = PokeS(*Buffer, "HTTP/1.1 200 OK" + #CRLF$, -1, #PB_UTF8)                                                             : *Buffer + Length
  Length = PokeS(*Buffer, "Date: " + DayOfWeek + ", " + Day + " " + Month + " " + Year + " " + Time  + #CRLF$, -1, #PB_UTF8)    : *Buffer + Length
  Length = PokeS(*Buffer, "Server: "+ Title + #CRLF$, -1, #PB_UTF8)                                                             : *Buffer + Length
  Length = PokeS(*Buffer, "Content-Length: " + Str(FileLength) + #CRLF$, -1, #PB_UTF8)                                          : *Buffer + Length
  Length = PokeS(*Buffer, "Content-Type: " + ContentType + #CRLF$ + #CRLF$, -1, #PB_UTF8)                                       : *Buffer + Length 
  
  ProcedureReturn *Buffer
EndProcedure

Procedure ClearLog()
  ClearGadgetItems(0)  
EndProcedure

Procedure Resize()
  Protected Width = WindowWidth(0)
  Protected Height = WindowHeight(0)
  
  ResizeGadget(0, #PB_Ignore, #PB_Ignore, Width, Height-40)
  ResizeGadget(1, #PB_Ignore, Height - 30, #PB_Ignore, #PB_Ignore)
  ResizeGadget(2, Width - 100, Height - 30, #PB_Ignore, #PB_Ignore)
EndProcedure

;Sortie  / Exit 
Procedure Exit()
  CloseNetworkServer(0) 
  
  ;Sauvegarde commentaires / Save comments
  CreateJSON(0)
  InsertJSONList(JSONValue(0), Comments())
  SaveJSON(0, "comments.json")
  
  End
EndProcedure
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: Simple Web Server ++

Message par djes »

C'est gentil, merci d'avoir posté cette petite avant première! Ça a l'air déjà fonctionnel, en plus, pour un codeur, se passer d'Apache, c'est gratifiant! C'est du même acabit que faire son propre langage...

Dans mon code, il y a deux trois bricoles sur lesquelles j'avais déjà bossé, si ça peut t'aider. Il y a le multi thread, bien sûr, ça tombe sous le sens, il y a aussi la gestion des requêtes en plusieurs passes (Le header d'abord, le contenu ensuite), ça permet de rendre le serveur un peu plus réactif, il y a aussi des petites astuces par rapport à windows, suite à des bugs lors d'essais intensifs. C'est ce qui nous manque souvent ici, la mise en production...
Avatar de l’utilisateur
JohnJohnsonSHERMAN
Messages : 648
Inscription : dim. 13/déc./2015 11:05
Localisation : Allez, cherche...
Contact :

Re: Simple Web Server ++

Message par JohnJohnsonSHERMAN »

Il ne me reste plus qu'à poster le mien :) Même s'il n'est pas fini et codé avec les pieds ^^

En tout cas c'est vraiement pas mal du tout falsam :)
"Le bug se situe entre la chaise et le clavier"
Votre expert national en bogage et segfaults.

CPU : AMD A8 Quad core - RAM 8Gb - HDD 2To
  • Windows 10 x64 - PB 5.61 x64
  • Linux Ubuntu 16.04 LTS x64 (dual boot) - PB pas encore réinstallé
kwandjeen
Messages : 204
Inscription : dim. 16/juil./2006 21:44

Re: Simple Web Server ++

Message par kwandjeen »

Encore une fois bravo Falsam ;)
Avatar de l’utilisateur
Ar-S
Messages : 9478
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Simple Web Server ++

Message par Ar-S »

ça a l'air de bien tourner 8)
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Simple Web Server ++

Message par Kwai chang caine »

Ouaihhh !!! marche nickel
Je comprends pas tout, mais c'est super bandant ton truc 8O
J'attends la suite pour mieux comprendre 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Simple Web Server ++

Message par falsam »

Le code est enfin publié dans le premier message avec une démo plus simple que la précédente pour la compréhension du sujet.
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Répondre