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                     ]).

 pwp_handler(+Options, +Request)

Handle PWP files. This predicate is defined to create a simple HTTP server from a hierarchy of PWP, HTML and other files. The interface is kept compatible with the library(http/http_dispatch). In the typical usage scenario, one needs to define an http location and a file-search path that is used as the root of the server. E.g., the following declarations create a self-contained web-server for files in /web/pwp/.

user:file_search_path(pwp, '/web/pwp').

:- http_handler(root(.), pwp_handler([path_alias(pwp)]), [prefix]).

Options include:

path_alias(+Alias)

Search for PWP files as Alias(Path). See absolute_file_name/3.

index(+Index)

Name of the directory index (pwp) file. This option may appear multiple times. If no such option is provided, pwp_handler/2 looks for index.pwp.

view(+Boolean)

If true (default is false), allow for ?view=source to serve PWP file as source.

index_hook(:Hook)

If a directory has no index-file, pwp_handler/2 calls Hook(PhysicalDir, Options, Request). If this semidet predicate succeeds, the request is considered handled.

hide_extensions(+List)

Hide files of the given extensions. The default is to hide .pl files.

dtd(?DTD)

DTD to parse the input file with. If unbound, the generated DTD is returned

Errors

- permission_error(index, http_location, Location) is raised if the handler resolves to a directory that has no index.

See also

- reply_pwp_page/3

  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    ).

 reply_pwp_page(:File, +Options, +Request)

Reply a PWP file. This interface is provided to server individual locations from PWP files. Using a PWP file rather than generating the page from Prolog may be desirable because the page contains a lot of text (which is cumbersome to generate from Prolog) or because the maintainer is not familiar with Prolog.

Options supported are:

mime_type(+Type)

Serve the file using the given mime-type. Default is text/html.

unsafe(+Boolean)

Passed to http_safe_file/2 to check for unsafe paths.

pwp_module(+Boolean)

If true, (default false), process the PWP file in a module constructed from its canonical absolute path. Otherwise, the PWP file is processed in the calling module.

Initial context:

SCRIPT_NAME

Virtual path of the script.

SCRIPT_DIRECTORY

Physical directory where the script lives

QUERY

Var=Value list representing the query-parameters

REMOTE_USER

If access has been authenticated, this is the authenticated user.

REQUEST_METHOD

One of get, post, put or head

CONTENT_TYPE

Content-type provided with HTTP POST and PUT requests

CONTENT_LENGTH

Content-length provided with HTTP POST and PUT requests

While processing the script, the file-search-path pwp includes the current location of the script. I.e., the following will find myprolog in the same directory as where the PWP file resides.

pwp:ask="ensure_loaded(pwp(myprolog))"

See also

- pwp_handler/2.

To be done

- complete the initial context, as far as possible from CGI variables. See http://hoohoo.ncsa.illinois.edu/docs/cgi/env.html

  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    ).

 copy_http_equiv(+XMLDOM) is det

Copy http-equiv elements from the document to the CGI header.

  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).

 default_mime_type(+Request, +DefType) is det

Extract the preferred content-type from the Request. This is part of the PWP reply-format negotiation.

See http://www.w3.org/TR/xhtml-media-types/#media-types

  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).

 pwp_context(+Request, -Context) is nondet

Provide some environment variables similar to CGI scripts.

  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)