1/*  Part of SWI-Prolog
   2
   3    Author:        Jan Wielemaker
   4    E-mail:        J.Wielemaker@cs.vu.nl
   5    WWW:           http://www.swi-prolog.org
   6    Copyright (C): 2009-2011, VU University Amsterdam
   7
   8    This program is free software; you can redistribute it and/or
   9    modify it under the terms of the GNU General Public License
  10    as published by the Free Software Foundation; either version 2
  11    of the License, or (at your option) any later version.
  12
  13    This program is distributed in the hope that it will be useful,
  14    but WITHOUT ANY WARRANTY; without even the implied warranty of
  15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16    GNU General Public License for more details.
  17
  18    You should have received a copy of the GNU General Public
  19    License along with this library; if not, write to the Free Software
  20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  21
  22    As a special exception, if you link this library with other files,
  23    compiled with a Free Software compiler, to produce an executable, this
  24    library does not by itself cause the resulting executable to be covered
  25    by the GNU General Public License. This exception does not however
  26    invalidate any other reasons why the executable file might be covered by
  27    the GNU General Public License.
  28*/
  29
  30:- module(http_cgi,
  31	  [ http_run_cgi/3,		% +Script, +Options, +Request
  32	    http_cgi_handler/2		% +Alias, +Request
  33	  ]).  34:- use_module(library(process)).  35:- use_module(library(socket)).  36:- use_module(library(url)).  37:- use_module(library(debug)).  38:- use_module(library(lists)).  39:- use_module(library(http/http_dispatch)).  40:- use_module(library(http/http_stream)).  41
  42:- predicate_options(http_run_cgi/3, 2,
  43		     [ argv(list),
  44		       transfer_encoding(atom),
  45		       buffer(oneof([full,line,none]))
  46		     ]).  47
  48/** <module> Run CGI scripts from the SWI-Prolog web-server
  49
  50Run CGI scripts.  This module provides two interfaces:
  51
  52	* http_run_cgi/2 can be used to call a CGI script
  53	located exernally.  This is typically used for an
  54	individual script used to extend the server functionality.
  55
  56	* Setup a path =cgi_bin= for absolute_file_name/3.  If
  57	this path is present, calls to /cgi-bin/... are translated into
  58	calling the script.
  59
  60@tbd complete environment translation.  See env/3.
  61@tbd testing.  Notably for POST and PUT commands.
  62@see http://hoohoo.ncsa.uiuc.edu/cgi/env.html
  63*/
  64
  65:- multifile
  66	environment/2.  67
  68:- meta_predicate
  69	copy_post_data(+, -, 0).  70
  71:- http_handler(root('cgi-bin'), http_cgi_handler(cgi_bin),
  72		[prefix, spawn([])]).  73
  74%%	http_cgi_handler(+Alias, +Request)
  75%
  76%	Locate a CGI script  in  the   file-search-path  Alias  from the
  77%	=path_info=  in  Request   and   execute    the   script   using
  78%	http_run_cgi/2. This library installs one handler using:
  79%
  80%	  ==
  81%	  :- http_handler(root('cgi-bin'), http_run_cgi(cgi_bin),
  82%			  [prefix, spawn([])]).
  83%	  ==
  84
  85http_cgi_handler(Alias, Request) :-
  86	select(path_info(PathInfo), Request, Request1),
  87	ensure_no_leading_slash(PathInfo, Relative),
  88	path_info(Relative, Script, Request1, Request2),
  89	Spec =.. [Alias, Script],
  90	absolute_file_name(Spec, ScriptFileName,
  91			   [ access(execute)
  92			   ]),
  93	http_run_cgi(ScriptFileName, [], Request2).
  94
  95
  96ensure_no_leading_slash(Abs, Rel) :-
  97	atom_concat(/, Rel, Abs), !.
  98ensure_no_leading_slash(Rel, Rel).
  99
 100ensure_leading_slash(PathInfo, Abs) :-
 101	(   sub_atom(PathInfo, 0, _, _, /)
 102	->  Abs = PathInfo
 103	;   atom_concat(/, PathInfo, Abs)
 104	).
 105
 106path_info(RelPath, Script, Req, [path_info(Info)|Req]) :-
 107	sub_atom(RelPath, Before, _, After, /), !,
 108	sub_atom(RelPath, 0, Before, _, Script),
 109	sub_atom(RelPath, _, After, 0, Info).
 110path_info(Script, Script, Request, Request).
 111
 112
 113%%	http_run_cgi(+Script, +Options, +Request) is det.
 114%
 115%	Execute the given CGI script.  Options processed:
 116%
 117%	  * argv(+List)
 118%	  Argument vector to give to the CGI script.  Defaults to
 119%	  no arguments.
 120%	  * transfer_encoding(Encoding)
 121%	  Emit a =|Transfer-encoding|= header
 122%	  * buffer(+Buffer)
 123%	  Set buffering of the CGI output stream.  Typically used
 124%	  together with transfer_encoding(chunked).
 125%
 126%	@param	Script specifies the location of the script as a
 127%		specification for absolute_file_name/3.
 128%	@param	Request holds the current HTTP request passed from
 129%		the HTTP handler.
 130
 131http_run_cgi(ScriptSpec, Options, Request) :-
 132	option(argv(Argv), Options, []),
 133	absolute_file_name(ScriptSpec, Script,
 134			   [ access(execute)
 135			   ]),
 136	input_handle(Request, ScriptInput),
 137	findall(Name=Value,
 138		env(Name,
 139		    [ script_file_name(Script)
 140		    | Request
 141		    ], Value),
 142		Env),
 143	debug(http(cgi), 'Environment: ~w', [Env]),
 144	process_create(Script, Argv,
 145		       [ stdin(ScriptInput),
 146			 stdout(pipe(CGI)),
 147			 stderr(std),
 148			 env(Env),
 149			 process(PID)
 150		       ]),
 151	setup_input(ScriptInput, Request),
 152	set_stream(CGI, encoding(octet)),
 153	debug(http(cgi), 'Waiting for CGI data ...', []),
 154	maplist(header_option, Options),
 155	call_cleanup(copy_cgi_data(CGI, current_output, Options),
 156		     cgi_cleanup(Script, CGI, PID)), !.
 157
 158%%	header_option(+Option) is det.
 159%
 160%	Write additional HTTP headers.
 161
 162header_option(transfer_encoding(Encoding)) :- !,
 163	format('Transfer-encoding: ~w\r\n', [Encoding]).
 164header_option(_).
 165
 166%%	cgi_cleanup(+Script, +ScriptStream, +PID) is det.
 167%
 168%	Cleanup the CGI process and close  the   stream  use to read the
 169%	output of the CGI process. Note that  we close the output first.
 170%	This deals with the  possibility  that   the  client  reset  the
 171%	connection, copy_cgi_data/3 returns and exception   and  we wait
 172%	for the process that never  ends.   By  closing  our stream, the
 173%	process will receive a sigpipe if it continues writing.
 174
 175cgi_cleanup(Script, ScriptStream, PID) :-
 176	close(ScriptStream),
 177	process_wait(PID, Status),
 178	debug(http(cgi), '~w ended with status ~w',
 179	      [Script, Status]).
 180
 181%%	input_handle(+Request, -Handle) is det.
 182%
 183%	Decide what to do with the input   stream of the CGI process. If
 184%	this is a PUT/POST request, we must   send data. Otherwise we do
 185%	not redirect the script's input.
 186
 187input_handle(Request, pipe(_)) :-
 188	memberchk(method(Method), Request),
 189	method_has_data(Method), !.
 190input_handle(_, std).
 191
 192method_has_data(post).
 193method_has_data(put).
 194
 195%%	setup_input(+ScriptInput, +Request) is det.
 196%
 197%	Setup passing of the POST/PUT data to the script.
 198
 199setup_input(std, _).
 200setup_input(pipe(Stream), Request) :-
 201	memberchk(input(HTTPIn), Request),
 202	set_stream(Stream, encoding(octet)),
 203	setup_input_filters(HTTPIn, In, Request, Close),
 204	thread_create(copy_post_data(In, Stream, Close), _,
 205		      [ detached(true)
 206		      ]).
 207
 208setup_input_filters(RawIn, In, Request, (Close2,Close1)) :-
 209	setup_length_filter(RawIn, In2, Request, Close1),
 210	setup_encoding_filter(In2, In, Request, Close2).
 211
 212setup_length_filter(In0, In, Request, close(In)) :-
 213	memberchk(content_length(Len), Request), !,
 214	debug(http(cgi), 'Setting input length to ~D', [Len]),
 215	stream_range_open(In0, In, [size(Len)]).
 216setup_length_filter(In, In, _, true).
 217
 218setup_encoding_filter(In0, In, Request, close(In)) :-
 219	memberchk(content_encoding(Enc), Request),
 220	z_format(Enc), !,
 221	debug(http(cgi), 'Adding ~w input filter', [Enc]),
 222	zopen(In0, In, [format(Enc), close_parent(false)]).
 223setup_encoding_filter(In, In, _, true).
 224
 225z_format(gzip).
 226z_format(deflate).
 227
 228
 229%%	copy_post_data(+DataIn, -ScriptIn, :Close) is det.
 230%
 231%	Copy data from the CGI script to the client.
 232
 233copy_post_data(In, Script, Close) :-
 234	debugging(http(cgi)), !,
 235	setup_call_cleanup(open('post.data', write, Debug, [type(binary)]),
 236			   catch(debug_post_data(In, Script, Debug),
 237				 E,
 238				 print_message(error, E)),
 239			   close(Debug)),
 240	catch(Close, E, print_message(error, E)),
 241	close(Script, [force(true)]).
 242copy_post_data(In, Script, Close) :-
 243	catch(copy_stream_data(In, Script), _, true),
 244	catch(Close, E, print_message(error, E)),
 245	close(Script, [force(true)]).
 246
 247
 248debug_post_data(In, Script, Debug) :-
 249	get_code(In, Byte),
 250	(   Byte == -1
 251	->  true
 252	;   put_code(Script, Byte),
 253	    put_code(Debug, Byte),
 254	    debug_post_data(In, Script, Debug)
 255	).
 256
 257
 258%%	copy_cgi_data(+CGI, -Out, +Options) is det.
 259
 260copy_cgi_data(CGI, Out, Options) :-
 261	debugging(http(cgi)), !,
 262	maplist(set_cgi_stream(Out), Options),
 263	setup_call_cleanup(open('cgi.out', write, Debug, [type(binary)]),
 264			   debug_cgi_data(CGI, Out, Debug),
 265			   close(Debug)).
 266copy_cgi_data(CGI, Out, Options) :-
 267	maplist(set_cgi_stream(Out), Options),
 268	copy_stream_data(CGI, Out).
 269
 270set_cgi_stream(Out, buffer(Buffer)) :- !,
 271	set_stream(Out, buffer(Buffer)).
 272set_cgi_stream(_, _).
 273
 274debug_cgi_data(CGI, Out, Debug) :-
 275	get_code(CGI, Byte),
 276	(   Byte == -1
 277	->  true
 278	;   put_code(Out, Byte),
 279	    put_code(Debug, Byte),
 280	    debug_cgi_data(CGI, Out, Debug)
 281	).
 282
 283
 284%%	env(?Name, +Request, -Value) is nondet.
 285%
 286%	Enumerate the environment variables to be   passed  to the child
 287%	process.
 288
 289env('SERVER_SOFTWARE', _, Version) :-
 290	current_prolog_flag(version_data, swi(Major, Minor, Patch, _)),
 291	format(atom(Version), 'SWI-Prolog/~w.~w.~w', [Major, Minor, Patch]).
 292env('SERVER_NAME', Request, Server) :-
 293	(   memberchk(x_forwarded_host(Server), Request)
 294	->  true
 295	;   memberchk(host(Server), Request)
 296	->  true
 297	;   gethostname(Server)
 298	).
 299env('GATEWAY_INTERFACE', _, 'CGI/1.1').
 300env('SERVER_PROTOCOL', Request, Protocol) :-
 301	memberchk(http(Major-Minor), Request),
 302	format(atom(Protocol), 'HTTP/~w.~w', [Major, Minor]).
 303env('SERVER_PORT', Request, Port) :-
 304	(   memberchk(port(Port), Request),
 305	    \+ memberchk(x_forwarded_host(_), Request)
 306	->  true
 307	;   Port = 80
 308	).
 309env('REQUEST_METHOD', Request, Method) :-
 310	memberchk(method(LwrCase), Request),
 311	upcase_atom(LwrCase, Method).
 312env('PATH_INFO', Request, PathInfo) :-
 313	memberchk(path_info(PathInfo0), Request),
 314	ensure_leading_slash(PathInfo0, PathInfo).
 315env('PATH_TRANSLATED', _, _) :- fail.
 316env('SCRIPT_NAME', _, _) :- fail.
 317env('SCRIPT_FILENAME', Request, ScriptFilename) :-
 318	memberchk(script_file_name(ScriptFilename), Request).
 319env('QUERY_STRING', Request, QString) :-
 320	memberchk(search(Search), Request),
 321	parse_url_search(QList, Search),
 322	string_to_list(QString, QList).
 323env('REMOTE_HOST', _, _) :- fail.
 324env('REMOTE_ADDR', _, _) :- fail.
 325env('AUTH_TYPE', _, _) :- fail.
 326env('REMOTE_USER', Request, User) :-
 327	memberchk(user(User), Request).
 328env('REMOTE_IDENT', _, _) :- fail.
 329env('CONTENT_TYPE', Request, ContentType) :-
 330	memberchk(content_type(ContentType), Request).
 331env('CONTENT_LENGTH', Request, ContentLength) :-
 332	memberchk(content_length(ContentLength), Request).
 333env('HTTP_ACCEPT', _, _) :- fail.
 334env('HTTP_USER_AGENT', Request, Agent) :-
 335	memberchk(user_agent(Agent), Request).
 336env(Name, _, Value) :-
 337	environment(Name, Value)