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