1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2009-2011, VU University, Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(http_pwp, 36 [ reply_pwp_page/3, % :File, +Options, +Request 37 pwp_handler/2 % +Options, +Request 38 ]). 39:- use_module(library(http/http_dispatch)). 40:- use_module(library(sgml)). 41:- use_module(library(sgml_write)). 42:- use_module(library(option)). 43:- use_module(library(error)). 44:- use_module(library(lists)). 45:- use_module(library(pwp)). 46 47:- predicate_options(pwp_handler/2, 1, 48 [ cache(boolean), 49 hide_extensions(list(atom)), 50 index_hook(callable), 51 mime_type(any), 52 path_alias(atom), 53 unsafe(boolean), 54 view(boolean) 55 ]). 56:- predicate_options(reply_pwp_page/3, 2, 57 [ dtd(any), 58 mime_type(any), 59 pwp_module(boolean), 60 unsafe(boolean) 61 ]). 62 63/** <module> Serve PWP pages through the HTTP server 64 65This module provides convience predicates to include PWP (Prolog 66Well-formed Pages) in a Prolog web-server. It provides the following 67predicates: 68 69 * pwp_handler/2 70 This is a complete web-server aimed at serving static pages, some 71 of which include PWP. This API is intended to allow for programming 72 the web-server from a hierarchy of pwp files, prolog files and static 73 web-pages. 74 75 * reply_pwp_page/3 76 Return a single PWP page that is executed in the context of the calling 77 module. This API is intended for individual pages that include so much 78 text that generating from Prolog is undesirable. 79 80@tbd Support elements in the HTML header that allow controlling the 81 page, such as setting the CGI-header, authorization, etc. 82@tbd Allow external styling. Pass through reply_html_page/2? Allow 83 filtering the DOM before/after PWP? 84*/ 85 86%! pwp_handler(+Options, +Request) 87% 88% Handle PWP files. This predicate is defined to create a simple 89% HTTP server from a hierarchy of PWP, HTML and other files. The 90% interface is kept compatible with the 91% library(http/http_dispatch). In the typical usage scenario, one 92% needs to define an http location and a file-search path that is 93% used as the root of the server. E.g., the following declarations 94% create a self-contained web-server for files in =|/web/pwp/|=. 95% 96% == 97% user:file_search_path(pwp, '/web/pwp'). 98% 99% :- http_handler(root(.), pwp_handler([path_alias(pwp)]), [prefix]). 100% == 101% 102% Options include: 103% 104% * path_alias(+Alias) 105% Search for PWP files as Alias(Path). See absolute_file_name/3. 106% * index(+Index) 107% Name of the directory index (pwp) file. This option may 108% appear multiple times. If no such option is provided, 109% pwp_handler/2 looks for =|index.pwp|=. 110% * view(+Boolean) 111% If =true= (default is =false=), allow for ?view=source to serve 112% PWP file as source. 113% * index_hook(:Hook) 114% If a directory has no index-file, pwp_handler/2 calls 115% Hook(PhysicalDir, Options, Request). If this semidet 116% predicate succeeds, the request is considered handled. 117% * hide_extensions(+List) 118% Hide files of the given extensions. The default is to 119% hide .pl files. 120% * dtd(?DTD) 121% DTD to parse the input file with. If unbound, the generated 122% DTD is returned 123% 124% @see reply_pwp_page/3 125% @error permission_error(index, http_location, Location) is 126% raised if the handler resolves to a directory that has no 127% index. 128 129:- meta_predicate 130 pwp_handler( , ). 131 132pwp_handler(QOptions, Request) :- 133 meta_options(is_meta, QOptions, Options), 134 ( memberchk(path_info(Spec), Request) 135 -> true 136 ; Spec = '.' 137 ), 138 ( option(path_alias(Alias), Options) 139 -> Term =.. [Alias,Spec] 140 ; Term = Spec 141 ), 142 http_safe_file(Term, Options), 143 ( absolute_file_name(Term, Path, 144 [ file_type(directory), 145 access(read), 146 file_errors(fail) 147 ]) 148 -> ensure_slash(Path, Dir), 149 ( ( member(index(Index), Options) 150 *-> true 151 ; Index = 'index.pwp' 152 ), 153 atom_concat(Dir, Index, File), 154 access_file(File, read) 155 -> true 156 ; option(index_hook(Hook), Options), 157 call(Hook, Path, Options, Request) 158 -> true 159 ; memberchk(path(Location), Request), 160 permission_error(index, http_location, Location) 161 ) 162 ; absolute_file_name(Term, File, 163 [ access(read) 164 ]) 165 ), 166 server_file(File, Request, Options). 167 168is_meta(index_hook). 169 170server_file(File, _, _) :- % index-hook did the work 171 var(File), 172 !. 173server_file(File, Request, Options) :- 174 file_name_extension(_, pwp, File), 175 !, 176 ( option(view(true), Options), 177 memberchk(search(Query), Request), 178 memberchk(view=source, Query) 179 -> http_reply_file(File, [ mime_type(text/plain), 180 unsafe(true) 181 ], Request) 182 ; merge_options(Options, 183 [ pwp_module(true) 184 ], Opts), 185 reply_pwp_page(File, [unsafe(true)|Opts], Request) 186 ). 187server_file(File, Request, Options) :- 188 option(hide_extensions(Exts), Options, [pl]), 189 file_name_extension(_, Ext, File), 190 ( memberchk(Ext, Exts) 191 -> memberchk(path(Location), Request), 192 permission_error(read, http_location, Location) 193 ; http_reply_file(File, [unsafe(true)|Options], Request) 194 ). 195 196 197ensure_slash(Path, Dir) :- 198 ( sub_atom(Path, _, _, 0, /) 199 -> Dir = Path 200 ; atom_concat(Path, /, Dir) 201 ). 202 203 204%! reply_pwp_page(:File, +Options, +Request) 205% 206% Reply a PWP file. This interface is provided to server 207% individual locations from PWP files. Using a PWP file rather 208% than generating the page from Prolog may be desirable because 209% the page contains a lot of text (which is cumbersome to generate 210% from Prolog) or because the maintainer is not familiar with 211% Prolog. 212% 213% Options supported are: 214% 215% * mime_type(+Type) 216% Serve the file using the given mime-type. Default is 217% text/html. 218% * unsafe(+Boolean) 219% Passed to http_safe_file/2 to check for unsafe paths. 220% * pwp_module(+Boolean) 221% If =true=, (default =false=), process the PWP file in 222% a module constructed from its canonical absolute path. 223% Otherwise, the PWP file is processed in the calling 224% module. 225% 226% Initial context: 227% 228% * SCRIPT_NAME 229% Virtual path of the script. 230% * SCRIPT_DIRECTORY 231% Physical directory where the script lives 232% * QUERY 233% Var=Value list representing the query-parameters 234% * REMOTE_USER 235% If access has been authenticated, this is the authenticated 236% user. 237% * REQUEST_METHOD 238% One of =get=, =post=, =put= or =head= 239% * CONTENT_TYPE 240% Content-type provided with HTTP POST and PUT requests 241% * CONTENT_LENGTH 242% Content-length provided with HTTP POST and PUT requests 243% 244% While processing the script, the file-search-path pwp includes 245% the current location of the script. I.e., the following will 246% find myprolog in the same directory as where the PWP file 247% resides. 248% 249% == 250% pwp:ask="ensure_loaded(pwp(myprolog))" 251% == 252% 253% @tbd complete the initial context, as far as possible from CGI 254% variables. See http://hoohoo.ncsa.illinois.edu/docs/cgi/env.html 255% @see pwp_handler/2. 256 257:- meta_predicate 258 reply_pwp_page( , , ). 259 260reply_pwp_page(M:File, Options, Request) :- 261 http_safe_file(File, Options), 262 absolute_file_name(File, Path, 263 [ access(read) 264 ]), 265 memberchk(method(Method), Request), 266 file_directory_name(Path, Dir), 267 ( option(dtd(DTD), Options) 268 -> SGMLOptions = [dtd(DTD)] 269 ; SGMLOptions = [] 270 ), 271 load_structure(Path, Contents, [dialect(xml)|SGMLOptions]), 272 findall(C, pwp_context(Request, C), Context), 273 ( option(pwp_module(true), Options) 274 -> PWP_M = Path 275 ; PWP_M = M 276 ), 277 setup_call_cleanup(asserta(script_dir(Dir), Ref), 278 pwp_xml(PWP_M:Contents, Transformed, 279 [ 'REQUEST_METHOD' = Method, 280 'SCRIPT_DIRECTORY' = Dir 281 | Context 282 ]), 283 erase(Ref)), 284 copy_http_equiv(Transformed), 285 default_mime_type(Request, DefType), 286 option(mime_type(Type), Options, DefType), 287 format('Content-type: ~w\r\n\r\n', [Type]), 288 ( Type = text/html 289 -> html_write(current_output, Transformed, []) 290 ; xml_write(current_output, Transformed, []) 291 ). 292 293 294%! copy_http_equiv(+XMLDOM) is det. 295% 296% Copy =|http-equiv|= elements from the document to the CGI 297% header. 298 299copy_http_equiv(Contents) :- 300 memberchk(element(html, _, HtmlElement), Contents), 301 memberchk(element(head, _, HeadElement), HtmlElement), 302 !, 303 forall(http_equiv(HeadElement, HttpEquiv, HttpEquivValue), 304 format('~w: ~w\r\n', [HttpEquiv, HttpEquivValue])). 305copy_http_equiv(_). 306 307http_equiv(Head, Name, Value) :- 308 member(element(meta, MetaAttributes, []), Head), 309 memberchk('http-equiv'=Name, MetaAttributes), 310 memberchk(content=Value, MetaAttributes). 311 312 313%! default_mime_type(+Request, +DefType) is det. 314% 315% Extract the preferred content-type from the Request. This is 316% part of the PWP reply-format negotiation. 317% 318% See http://www.w3.org/TR/xhtml-media-types/#media-types 319 320default_mime_type(Request, DefType) :- 321 XHTML = application/'xhml+xml', 322 memberchk(accept(Accept), Request), 323 memberchk(media(Type, _, _, _), Accept), 324 Type == XHTML, 325 !, 326 DefType = XHTML. 327default_mime_type(_, text/html). 328 329%! pwp_context(+Request, -Context) is nondet. 330% 331% Provide some environment variables similar to CGI scripts. 332 333pwp_context(Request, 'REMOTE_USER' = User) :- 334 memberchk(user(User), Request). 335pwp_context(Request, 'QUERY' = Query) :- 336 memberchk(search(Query), Request). 337pwp_context(Request, 'SCRIPT_NAME' = Path) :- 338 memberchk(path(Path), Request). 339pwp_context(Request, 'CONTENT_TYPE' = ContentType) :- 340 memberchk(content_type(ContentType), Request). 341pwp_context(Request, 'CONTENT_LENGTH' = Length) :- 342 memberchk(content_length(Length), Request). 343 344:- multifile user:file_search_path/2. 345:- dynamic user:file_search_path/2. 346:- thread_local script_dir/1. 347 348user:file_search_path(pwp, ScriptDir) :- 349 script_dir(ScriptDir)