"Fossies" - the Fresh Open Source Software Archive

Member "fpcbuild-3.2.0/fpcsrc/packages/libmicrohttpd/examples/event_and_thread.pp" (30 Dec 2015, 6542 Bytes) of package /linux/misc/fpcbuild-3.2.0.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Ruby source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 (*
    2 
    3   @Example: `event_and_thread`.
    4   @Description: Use event-driven for usual requests and threads to slowly requests.
    5   @Authors: Silvio Clecio and Gilson Nunes
    6 
    7 *)
    8 
    9 program event_and_thread;
   10 
   11 // Shows `event_and_thread` details on Linux:
   12 //
   13 //   $ ps axo pid,ppid,rss,vsz,nlwp,cmd | grep 'event_and_thread'
   14 //
   15 // But if you prefer to see only the number of thread of `event_and_thread`:
   16 //
   17 //   $ ps axo nlwp,cmd | grep 'event_and_thread'
   18 
   19 {$mode objfpc}{$H+}
   20 {$MACRO ON}
   21 {$DEFINE DEBUG}
   22 {.$DEFINE WAIT_CLIENTS_DISCONNECT}
   23 {$DEFINE TIMEOUT := 10}
   24 {.$DEFINE CONTINGENCY_CONTROL}
   25 {$IF DEFINED(CONTINGENCY_CONTROL)}
   26   {$DEFINE MAX_THREAD_COUNT := 2}
   27 {$ENDIF}
   28 
   29 uses
   30 {$IFDEF UNIX}
   31   cthreads, BaseUnix,
   32 {$ELSE}
   33   Sockets,
   34 {$ENDIF}
   35   Classes, SysUtils, cutils, libmicrohttpd;
   36 
   37   procedure MHD_socket_close(fd: cint);
   38   begin
   39 {$IFDEF UNIX}
   40     FpClose(fd);
   41 {$ELSE}
   42     CloseSocket(fd);
   43 {$ENDIF}
   44   end;
   45 
   46 const
   47   PORT = 8888;
   48 
   49 var
   50   _threads: TFPList;
   51   _mutex: TRTLCriticalSection;
   52 
   53 type
   54 
   55   { TConnectionHandler }
   56 
   57   TConnectionHandler = packed record
   58     Connection: PMHD_Connection;
   59     Url: Pcchar;
   60   end;
   61 
   62   { TSlothThread }
   63 
   64   TSlothThread = class(TThread)
   65   private
   66     FHandler: TConnectionHandler;
   67   protected
   68     procedure Execute; override;
   69   public
   70     constructor Create(AHandler: TConnectionHandler);
   71     destructor Destroy; override;
   72   end;
   73 
   74   { TSlothThread }
   75 
   76   constructor TSlothThread.Create(AHandler: TConnectionHandler);
   77   begin
   78     inherited Create(True);
   79     FreeOnTerminate := True;
   80     FHandler := AHandler;
   81   end;
   82 
   83   destructor TSlothThread.Destroy;
   84   begin
   85     _threads.Remove(Self);
   86     inherited Destroy;
   87   end;
   88 
   89   procedure TSlothThread.Execute;
   90   const
   91     page: AnsiString =
   92       '<html><body>I''m a sloth, and my URL is "%s". T: %s</body></html>';
   93   var
   94     i: Byte;
   95     s: AnsiString;
   96     response: PMHD_Response;
   97   begin
   98     for i := 1 to TIMEOUT do
   99     begin
  100       if Terminated then
  101         Break;
  102       Sleep(1000);
  103     end;
  104     if not Terminated then
  105     begin
  106       s := Format(page, [FHandler.Url, DateTimeToStr(Now)]);
  107       response := MHD_create_response_from_buffer(Length(s), Pointer(s),
  108         MHD_RESPMEM_MUST_COPY);
  109       MHD_queue_response(FHandler.Connection, MHD_HTTP_OK, response);
  110       MHD_resume_connection(FHandler.Connection);
  111       MHD_destroy_response(response);
  112     end;
  113   end;
  114 
  115   { daemon }
  116 
  117   function RequestHandler(cls: Pointer; connection: PMHD_Connection;
  118     url: Pcchar; method: Pcchar; version: Pcchar; upload_data: Pcchar;
  119     upload_data_size: Psize_t; ptr: PPointer): cint; cdecl;
  120   const
  121     page = '<html><body>Hello world! T: %s</body></html>';
  122 {$IF DEFINED(CONTINGENCY_CONTROL)}
  123     busy_page: Pcchar = '<html><body>The server is busy. :-(</body></html>';
  124 {$ENDIF}
  125   var
  126     s: string;
  127     ret: cint;
  128     thr: TThread;
  129     response: PMHD_Response;
  130     handler: TConnectionHandler;
  131   begin
  132     if method <> 'GET' then
  133       Exit(MHD_NO);
  134 
  135     { By Gilson Nunes:
  136       "The connection state for first call is `MHD_CONNECTION_HEADERS_PROCESSED`
  137        and `MHD_CONNECTION_FOOTERS_RECEIVED` for the next, so the flag below
  138        ensures that the response will be delivered to the client after `MHD`
  139        finish all the request processing." }
  140     if not Assigned(ptr^) then
  141     begin
  142       ptr^ := Pointer(1);
  143       Exit(MHD_YES);
  144     end;
  145     ptr^ := nil;
  146 
  147     if (strcomp(url, '/sloth1') = 0) or (strcomp(url, '/sloth2') = 0) then
  148     begin
  149 {$IF DEFINED(CONTINGENCY_CONTROL)}
  150       if _threads.Count = MAX_THREAD_COUNT then
  151       begin
  152         response := MHD_create_response_from_buffer(Length(busy_page),
  153           busy_page, MHD_RESPMEM_PERSISTENT);
  154         ret := MHD_queue_response(connection, MHD_HTTP_OK, response);
  155         MHD_destroy_response(response);
  156         Exit(ret);
  157       end;
  158 {$ENDIF}
  159       MHD_suspend_connection(connection);
  160       handler.Connection := connection;
  161       handler.Url := url;
  162       thr := TSlothThread.Create(handler);
  163       EnterCriticalsection(_mutex);
  164       try
  165         _threads.Add(thr);
  166       finally
  167         LeaveCriticalsection(_mutex);
  168       end;
  169       thr.Start;
  170       Result := MHD_YES;
  171     end
  172     else
  173     begin
  174       s := Format(page, [DateTimeToStr(Now)]);
  175       response := MHD_create_response_from_buffer(Length(s), Pointer(s),
  176         MHD_RESPMEM_MUST_COPY);
  177       ret := MHD_queue_response(connection, MHD_HTTP_OK, response);
  178       MHD_destroy_response(response);
  179       Result := ret;
  180     end;
  181   end;
  182 
  183 var
  184   _daemon: PMHD_Daemon;
  185 
  186   procedure StopServer;
  187   var
  188     i: Integer;
  189     thr: TThread;
  190     sckt: MHD_socket;
  191     connections: PMHD_DaemonInfo;
  192   begin
  193     sckt := MHD_quiesce_daemon(_daemon);
  194 {$IFDEF MSWINDOWS}
  195     if LongWord(sckt) <> MHD_INVALID_SOCKET then
  196 {$ELSE}
  197     if sckt <> MHD_INVALID_SOCKET then
  198 {$ENDIF}
  199       MHD_socket_close(sckt);
  200     EnterCriticalsection(_mutex);
  201     try
  202       WriteLn('Threads: ', _threads.Count);
  203       for i := Pred(_threads.Count) downto 0 do
  204       begin
  205         thr := TThread(_threads[i]);
  206         WriteLn('Finishing thread $', HexStr(thr), ' ...');
  207         if Assigned(thr) then
  208           thr.Terminate;
  209       end;
  210       while _threads.Count > 0 do
  211         Sleep(500);
  212     finally
  213       LeaveCriticalsection(_mutex);
  214     end;
  215     connections := MHD_get_daemon_info(_daemon, MHD_DAEMON_INFO_CURRENT_CONNECTIONS);
  216     if Assigned(connections) then
  217     begin
  218       WriteLn('Connections: ', connections^.num_connections);
  219 {$IFDEF WAIT_CLIENTS_DISCONNECT}
  220       while True do
  221       begin
  222         if connections^.num_connections = 0 then
  223           Break;
  224         Sleep(500);
  225       end;
  226 {$ENDIF}
  227     end;
  228     MHD_stop_daemon(_daemon);
  229     WriteLn('Bye!');
  230   end;
  231 
  232   procedure SigProc(sig: cint); cdecl;
  233   begin
  234     WriteLn;
  235     StopServer;
  236     FreeAndNil(_threads);
  237     Halt;
  238   end;
  239 
  240 begin
  241   InitCriticalSection(_mutex);
  242   _threads := TFPList.Create;
  243   try
  244     _daemon := MHD_start_daemon(MHD_USE_SELECT_INTERNALLY or
  245       MHD_USE_SUSPEND_RESUME or MHD_USE_DEBUG,
  246       PORT, nil, nil, @RequestHandler, nil,
  247 {$IF DEFINED(CONTINGENCY_CONTROL)}
  248       MHD_OPTION_THREAD_POOL_SIZE, cuint(MAX_THREAD_COUNT),
  249 {$ENDIF}
  250       MHD_OPTION_CONNECTION_TIMEOUT, cuint(TIMEOUT + 1),
  251       MHD_OPTION_END);
  252     if not Assigned(_daemon) then
  253       Halt(1);
  254     signal(SIGINT, @SigProc);
  255 {$IFDEF MSWINDOWS}
  256     signal(SIGBREAK, @SigProc);
  257 {$ELSE}
  258     signal(SIGTERM, @SigProc);
  259 {$ENDIF}
  260     WriteLn('HTTP server running. Press [Ctrl+C] to stop the server ...');
  261     while Assigned(_daemon) do
  262       Sleep(100);
  263   finally
  264     FreeAndNil(_threads);
  265     DoneCriticalsection(_mutex);
  266   end;
  267 end.