View source with formatted comments or as raw
    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)