Advertisement
WarPie90

Internet server Simba 1.4 | Experimental async

Dec 8th, 2024 (edited)
268
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 4.86 KB | None | 0 0
  1. program new;
  2. {$I SRL/osr.simba}
  3.  
  4. type
  5.   TClientAcceptTimer = type TMMLTimer;
  6.  
  7.   TInternetClient = record
  8.     ID: Int32;
  9.     IP, Port: string;
  10.   end;
  11.  
  12.   PInternetServer = ^TInternetServer;
  13.   TInternetServer = record
  14.     ID: Int32;
  15.     IP, Port: string;
  16.     AcceptTimer: TClientAcceptTimer;
  17.     ClientQueue: array of TInternetClient;
  18.     Requests: Int32;
  19.   end;
  20.  
  21.  
  22. var
  23.   Server: TInternetServer;
  24.  
  25.  
  26. // GLOBAL SPINLOCK
  27. var
  28.   critical: Int32;
  29.  
  30.  
  31.  
  32. {$IFDEF LINUX}
  33. function CAS(x: ^Int32; y, z: Int32): Int32; static; external '__sync_val_compare_and_swap@libgcc_s.so.1 cdecl';
  34. {$ELSE}{$IFDEF WINDOWS}
  35. function CAS(x: ^Int32; y,z: Int32): Int32; static; external 'InterlockedCompareExchange@Kernel32.dll ' + {$IFDEF CPU386}'stdcall'{$ELSE}'win64'{$ENDIF};
  36. {$ENDIF}{$ENDIF}
  37.  
  38.  
  39. procedure AcquireLock(var Lock: Int32);
  40. begin
  41.   repeat
  42.     if CAS(@Lock, 1, 0) = 0 then Exit;
  43.   until False;
  44. end;
  45.  
  46. procedure ReleaseLock(var Lock: Int32);
  47. begin
  48.   Lock := 0;
  49. end;
  50.  
  51. // ------------------------------------
  52.  
  53.  
  54.  
  55. procedure TInternetClient.WriteString(s: string);
  56. begin
  57.   SendSocket(Self.ID, s);
  58. end;
  59.  
  60. function TInternetClient.ReadStr(): string;
  61. begin
  62.   Result := RecvSocketStr(Self.ID);
  63. end;
  64.  
  65. function TInternetClient.Read(bytes: Int32): string;
  66. begin
  67.   Result := RecvSocketEx(Self.ID, bytes);
  68. end;
  69.  
  70. procedure TInternetClient.SetTimeout(Time: Int32);
  71. begin
  72.   SetSocketTimeout(Self.ID, Time);
  73. end;
  74.  
  75. procedure TInternetClient.CloseAndFree();
  76. begin
  77.   try CloseSocket(Self.ID); except end;
  78.   FreeSocket(Self.ID);
  79.   Self.ID := -1;
  80. end;
  81.  
  82.  
  83. // -----------------------------------
  84.  
  85. procedure AsyncAcceptClient(Sender: TObject);
  86. var
  87.   client,i: Int32;
  88. begin
  89.   while True do
  90.     with Server do
  91.     begin
  92.       AcquireLock(critical);
  93.       begin
  94.         for i:=High(clientQueue) downto 0 do
  95.           if clientQueue[i].ID = -1 then
  96.             Delete(clientQueue, i, 1);
  97.       end;
  98.       ReleaseLock(critical);
  99.  
  100.       client := AcceptSocket(ID);
  101.  
  102.       AcquireLock(critical);
  103.       begin
  104.         clientQueue += [client,'',''];
  105.         SocketInfo(client, clientQueue[High(clientQueue)].IP, clientQueue[High(clientQueue)].Port);
  106.         Requests += 1;
  107.       end;
  108.       ReleaseLock(critical);
  109.  
  110.       Sleep(1);
  111.     end;
  112. end;
  113.  
  114. function TInternetServer.Create(IP: string; Port: string): TInternetServer; static;
  115. var f: Int32;
  116. begin
  117.   Result.ID   := CreateSocket();
  118.   Result.IP   := IP;
  119.   Result.Port := Port;
  120.   BindSocket(Result.ID, Result.IP, Result.Port);
  121.   ListenSocket(Result.ID);
  122. end;
  123.  
  124. function TInternetServer.AcceptClients(): TInternetClient;
  125. begin
  126.   Self.AcceptTimer.Init();
  127.   Self.AcceptTimer.SetInterval(1000); //not needed, we loop in the thread
  128.   Self.AcceptTimer.SetOnTimer(@AsyncAcceptClient);
  129.   Self.AcceptTimer.SetEnabled(True);
  130. end;
  131.  
  132. procedure TInternetServer.CloseAndFree();
  133. begin
  134.   CloseSocket(Self.ID);
  135.   FreeSocket(Self.ID);
  136. end;
  137.  
  138. procedure TInternetServer.HandleClient(var Client: TInternetClient);
  139. var
  140.   tmp, header: string;
  141.   content: string;
  142.   t: Double;
  143. begin
  144.   t := PerformanceTimer();
  145.  
  146.   if Client.ID <= 0 then Exit;
  147.   try
  148.     Client.SetTimeout(2000); // 2 sec before we release without ping | cant keep it open for no reason
  149.   except
  150.     Client.CloseAndFree();
  151.     Exit;
  152.   end;
  153.  
  154.   AcquireLock(critical);
  155.   Server.Requests -= 1;         // We are handling one of the requests, reduce
  156.   ReleaseLock(critical);
  157.  
  158.   Writeln('>>> Connection from: ', Client.IP, ':', Client.port);
  159.  
  160.   (* Get headers *)
  161.   repeat
  162.     try
  163.       tmp := Client.ReadStr();
  164.       header += tmp;
  165.     except
  166.       AcquireLock(critical);
  167.       Client.CloseAndFree();
  168.       ReleaseLock(critical);
  169.       Exit;
  170.     end;
  171.   until tmp = '';
  172.  
  173.   try
  174.     (* Reply with OK *)
  175.     Content := '<b>Welcome to my simba webserver</b><br \><br \> Result produced in '+ ToStr(Round(PerformanceTimer() - t,6))+ 'ms';
  176.     Client.WriteString('HTTP/1.1 200 OK'+#13#10);
  177.     Client.WriteString('Content-Type: text/html'+#13#10);
  178.     Client.WriteString('Connection: close'+#13#10);
  179.     Client.WriteString('Content-Length: ' + IntToStr(Length(Content))+#13#10#13#10);
  180.     Client.WriteString(Content);
  181.     WriteLn('>>> Content data sent!');
  182.   except
  183.     Client.CloseAndFree();
  184.     Exit; // client is DC'ed.
  185.   end;
  186.  
  187.   AcquireLock(critical);
  188.   try
  189.     Client.CloseAndFree();
  190.   except end;
  191.   ReleaseLock(critical);
  192. end;
  193.  
  194. procedure Main;
  195. var
  196.   client: TInternetClient;
  197. begin
  198.   Server := TInternetServer.Create('127.0.0.1', '27015'); // Example IP and Port
  199.   Server.AcceptClients();
  200.  
  201.   while True do
  202.   begin
  203.     client := [];
  204.  
  205.     AcquireLock(critical);
  206.     begin
  207.       if Server.Requests <> 0 then
  208.         client := Server.ClientQueue[High(Server.ClientQueue)];
  209.     end;
  210.     ReleaseLock(critical);
  211.  
  212.     if client <> [] then
  213.       Server.HandleClient(client);
  214.  
  215.     Sleep(1);
  216.   end;
  217.  
  218.   Server.CloseAndFree();
  219. end;
  220.  
  221. begin
  222.   Main;
  223. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement