http package (only partially working)

2010-06-23 11:52:34 +01:00
parent 6e956b879a
commit 4694a50fa5
98 changed files with 20952 additions and 4 deletions
--- a/packages/http/examples/stress_server.pl
+++ b/packages/http/examples/stress_server.pl
@@ -0,0 +1,129 @@
+/*  $Id$
+
+    Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        wielemak@science.uva.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 1985-2007, University of Amsterdam
+
+    This program is free software; you can redistribute it and/or
+    modify it under the terms of the GNU General Public License
+    as published by the Free Software Foundation; either version 2
+    of the License, or (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+    As a special exception, if you link this library with other files,
+    compiled with a Free Software compiler, to produce an executable, this
+    library does not by itself cause the resulting executable to be covered
+    by the GNU General Public License. This exception does not however
+    invalidate any other reasons why the executable file might be covered by
+    the GNU General Public License.
+*/
+
+:- module(http_stress_server,
+	  [ server/1,			% +Port
+	    profile/0
+	  ]).
+:- load_files([ library(http/thread_httpd),
+		library(http/html_write),
+		library(http/http_session),
+		library(http/http_dispatch),
+		library(http/http_parameters),
+		library(http/http_error),
+		library(thread_pool)
+	      ],
+	      [ silent(true)
+	      ]).
+
+/** <module> Sample HTTP server to run some stress tests
+
+*/
+
+%%	server(+Port) is det.
+%
+%	Start the server at Port.
+
+server(Port) :-
+	create_pools,
+	server(Port,
+	       [ workers(1)
+	       ]).
+
+server(Port, Options) :-
+	http_server(http_dispatch,
+		    [ port(Port),
+		      timeout(20)
+		    | Options
+		    ]).
+
+%%	create_pools
+%
+%	Create our thread pools.
+
+create_pools :-
+	thread_pool_create(single, 1, [backlog(0)]).
+
+%%	profile
+%
+%	Run thread profiler on the one and only server.
+
+profile :-
+	findall(Id, http_current_worker(_, Id), Ids),
+	(   Ids = [Id]
+	->  tprofile(Id)
+	;   Ids == []
+	->  format(user_error, 'No HTTP server!~n', []),
+	    fail
+	;   format(user_error, 'Multiple HTPP workers: ~p~n', [Ids]),
+	    fail
+	).
+
+
+		 /*******************************
+		 *	     METHODS		*
+		 *******************************/
+
+:- http_handler('/ping', ping, []).
+:- http_handler('/wait', wait, [chunked]).
+:- http_handler(prefix('/spawn/'), spawn, [spawn(single)]).
+:- http_handler(prefix('/spawn2/'), spawn, [spawn(single)]).
+
+ping(_Request) :-
+	format('Content-type: text/plain~n~n'),
+	format('alife~n').
+
+wait(Request) :-
+	http_parameters(Request,
+			[ wait(Time, [default(1)]),
+			  count(N, [default(10)])
+			]),
+	wait(Time, N).
+
+wait(Time, N) :-
+	format('Content-type: text/plain~n~n'),
+	forall(between(1, N, I),
+	       (   sleep(Time),
+		   format('~D~n', [I]),
+		   flush_output
+	       )).
+
+%%	spawn(+Request)
+%
+%	Run requests under /spawn/ in their own thread.
+
+spawn(Request) :-
+	selectchk(path(Path), Request, Request1),
+	(   sub_atom(Path, Start, _, _, /), Start > 0
+	->  sub_atom(Path, Start, _, 0, NewPath)
+	),
+	http_dispatch([path(NewPath)|Request1]).
+