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)  2007-2017, University of Amsterdam
    7                              VU University Amsterdam
    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_dispatch,
   37          [ http_dispatch/1,            % +Request
   38            http_handler/3,             % +Path, +Predicate, +Options
   39            http_delete_handler/1,      % +Path
   40            http_reply_file/3,          % +File, +Options, +Request
   41            http_redirect/3,            % +How, +Path, +Request
   42            http_404/2,                 % +Options, +Request
   43            http_switch_protocol/2,     % :Goal, +Options
   44            http_current_handler/2,     % ?Path, ?Pred
   45            http_current_handler/3,     % ?Path, ?Pred, -Options
   46            http_location_by_id/2,      % +ID, -Location
   47            http_link_to_id/3,          % +ID, +Parameters, -HREF
   48            http_reload_with_parameters/3, % +Request, +Parameters, -HREF
   49            http_safe_file/2            % +Spec, +Options
   50          ]).   51:- use_module(library(option)).   52:- use_module(library(lists)).   53:- use_module(library(time)).   54:- use_module(library(error)).   55:- use_module(library(settings)).   56:- use_module(library(uri)).   57:- use_module(library(apply)).   58:- use_module(library(http/mimetype)).   59:- use_module(library(http/http_path)).   60:- use_module(library(http/http_header)).   61:- use_module(library(http/thread_httpd)).   62
   63:- predicate_options(http_404/2, 1, [index(any)]).   64:- predicate_options(http_reply_file/3, 2,
   65                     [ cache(boolean),
   66                       mime_type(any),
   67                       static_gzip(boolean),
   68                       pass_to(http_safe_file/2, 2),
   69                       headers(list)
   70                     ]).   71:- predicate_options(http_safe_file/2, 2, [unsafe(boolean)]).   72:- predicate_options(http_switch_protocol/2, 2, []).   73
   74/** <module> Dispatch requests in the HTTP server
   75
   76This module can be placed between   http_wrapper.pl  and the application
   77code to associate HTTP _locations_ to   predicates that serve the pages.
   78In addition, it associates parameters  with   locations  that  deal with
   79timeout handling and user authentication.  The typical setup is:
   80
   81==
   82server(Port, Options) :-
   83        http_server(http_dispatch,
   84                    [ port(Port)
   85                    | Options
   86                    ]).
   87
   88:- http_handler('/index.html', write_index, []).
   89
   90write_index(Request) :-
   91        ...
   92==
   93*/
   94
   95:- setting(http:time_limit, nonneg, 300,
   96           'Time limit handling a single query (0=infinite)').   97
   98%!  http_handler(+Path, :Closure, +Options) is det.
   99%
  100%   Register Closure as a handler for HTTP requests. Path is a
  101%   specification as provided by http_path.pl.  If an HTTP
  102%   request arrives at the server that matches Path, Closure
  103%   is called with one extra argument: the parsed HTTP request.
  104%   Options is a list containing the following options:
  105%
  106%           * authentication(+Type)
  107%           Demand authentication.  Authentication methods are
  108%           pluggable.  The library http_authenticate.pl provides
  109%           a plugin for user/password based =Basic= HTTP
  110%           authentication.
  111%
  112%           * chunked
  113%           Use =|Transfer-encoding: chunked|= if the client
  114%           allows for it.
  115%
  116%           * condition(:Goal)
  117%           If present, the handler is ignored if Goal does not succeed.
  118%
  119%           * content_type(+Term)
  120%           Specifies the content-type of the reply.  This value is
  121%           currently not used by this library.  It enhances the
  122%           reflexive capabilities of this library through
  123%           http_current_handler/3.
  124%
  125%           * id(+Term)
  126%           Identifier of the handler.  The default identifier is
  127%           the predicate name.  Used by http_location_by_id/2.
  128%
  129%           * hide_children(+Bool)
  130%           If =true= on a prefix-handler (see prefix), possible
  131%           children are masked.  This can be used to (temporary)
  132%           overrule part of the tree.
  133%
  134%           * method(+Method)
  135%           Declare that the handler processes Method.  This is
  136%           equivalent to methods([Method]).  Using method(*)
  137%           allows for all methods.
  138%
  139%           * methods(+ListOfMethods)
  140%           Declare that the handler processes all of the given
  141%           methods.  If this option appears multiple times, the
  142%           methods are combined.
  143%
  144%           * prefix
  145%           Call Pred on any location that is a specialisation of
  146%           Path.  If multiple handlers match, the one with the
  147%           longest path is used.  Options defined with a prefix
  148%           handler are the default options for paths that start
  149%           with this prefix.  Note that the handler acts as a
  150%           fallback handler for the tree below it:
  151%
  152%             ==
  153%             :- http_handler(/, http_404([index('index.html')]),
  154%                             [spawn(my_pool),prefix]).
  155%             ==
  156%
  157%           * priority(+Integer)
  158%           If two handlers handle the same path, the one with the
  159%           highest priority is used.  If equal, the last registered
  160%           is used.  Please be aware that the order of clauses in
  161%           multifile predicates can change due to reloading files.
  162%           The default priority is 0 (zero).
  163%
  164%           * spawn(+SpawnOptions)
  165%           Run the handler in a seperate thread.  If SpawnOptions
  166%           is an atom, it is interpreted as a thread pool name
  167%           (see create_thread_pool/3).  Otherwise the options
  168%           are passed to http_spawn/2 and from there to
  169%           thread_create/3.  These options are typically used to
  170%           set the stack limits.
  171%
  172%           * time_limit(+Spec)
  173%           One of =infinite=, =default= or a positive number
  174%           (seconds).  If =default=, the value from the setting
  175%           =http:time_limit= is taken. The default of this
  176%           setting is 300 (5 minutes).  See setting/2.
  177%
  178%   Note that http_handler/3 is normally invoked  as a directive and
  179%   processed using term-expansion.  Using   term-expansion  ensures
  180%   proper update through make/0 when the specification is modified.
  181%   We do not expand when the  cross-referencer is running to ensure
  182%   proper handling of the meta-call.
  183%
  184%   @error  existence_error(http_location, Location)
  185%   @see    http_reply_file/3 and http_redirect/3 are generic
  186%           handlers to serve files and achieve redirects.
  187
  188:- dynamic handler/4.                   % Path, Action, IsPrefix, Options
  189:- multifile handler/4.  190:- dynamic generation/1.  191
  192:- meta_predicate
  193    http_handler(+, :, +),
  194    http_current_handler(?, :),
  195    http_current_handler(?, :, ?),
  196    http_switch_protocol(2, +).  197
  198http_handler(Path, Pred, Options) :-
  199    compile_handler(Path, Pred, Options, Clause),
  200    next_generation,
  201    assert(Clause).
  202
  203:- multifile
  204    system:term_expansion/2.  205
  206system:term_expansion((:- http_handler(Path, Pred, Options)), Clause) :-
  207    \+ current_prolog_flag(xref, true),
  208    prolog_load_context(module, M),
  209    compile_handler(Path, M:Pred, Options, Clause),
  210    next_generation.
  211
  212
  213%!  http_delete_handler(+Spec) is det.
  214%
  215%   Delete handler for Spec. Typically, this should only be used for
  216%   handlers that are registered dynamically. Spec is one of:
  217%
  218%       * id(Id)
  219%       Delete a handler with the given id.  The default id is the
  220%       handler-predicate-name.
  221%
  222%       * path(Path)
  223%       Delete handler that serves the given path.
  224
  225http_delete_handler(id(Id)) :-
  226    !,
  227    clause(handler(_Path, _:Pred, _, Options), true, Ref),
  228    functor(Pred, DefID, _),
  229    option(id(Id0), Options, DefID),
  230    Id == Id0,
  231    erase(Ref),
  232    next_generation.
  233http_delete_handler(path(Path)) :-
  234    !,
  235    retractall(handler(Path, _Pred, _, _Options)),
  236    next_generation.
  237http_delete_handler(Path) :-
  238    http_delete_handler(path(Path)).
  239
  240
  241%!  next_generation is det.
  242%!  current_generation(-G) is det.
  243%
  244%   Increment the generation count.
  245
  246next_generation :-
  247    retractall(id_location_cache(_,_)),
  248    with_mutex(http_dispatch, next_generation_unlocked).
  249
  250next_generation_unlocked :-
  251    retract(generation(G0)),
  252    !,
  253    G is G0 + 1,
  254    assert(generation(G)).
  255next_generation_unlocked :-
  256    assert(generation(1)).
  257
  258current_generation(G) :-
  259    with_mutex(http_dispatch, generation(G)),
  260    !.
  261current_generation(0).
  262
  263
  264%!  compile_handler(+Path, :Pred, +Options) is det.
  265%
  266%   Compile a handler specification. For now we this is a no-op, but
  267%   in the feature can make this more efficiently, especially in the
  268%   presence of one or multiple prefix declarations. We can also use
  269%   this to detect conflicts.
  270
  271compile_handler(Path, Pred, Options0,
  272                http_dispatch:handler(Path1, Pred, IsPrefix, Options)) :-
  273    check_path(Path, Path1),
  274    (   select(prefix, Options0, Options1)
  275    ->  IsPrefix = true
  276    ;   IsPrefix = false,
  277        Options1 = Options0
  278    ),
  279    Pred = M:_,
  280    maplist(qualify_option(M), Options1, Options2),
  281    combine_methods(Options2, Options).
  282
  283qualify_option(M, condition(Pred), condition(M:Pred)) :-
  284    Pred \= _:_, !.
  285qualify_option(_, Option, Option).
  286
  287%!  combine_methods(+OptionsIn, -Options) is det.
  288%
  289%   Combine method(M) and  methods(MList)  options   into  a  single
  290%   methods(MList) option.
  291
  292combine_methods(Options0, Options) :-
  293    collect_methods(Options0, Options1, Methods),
  294    (   Methods == []
  295    ->  Options = Options0
  296    ;   append(Methods, Flat),
  297        sort(Flat, Unique),
  298        (   memberchk('*', Unique)
  299        ->  Final = '*'
  300        ;   Final = Unique
  301        ),
  302        Options = [methods(Final)|Options1]
  303    ).
  304
  305collect_methods([], [], []).
  306collect_methods([method(M)|T0], T, [[M]|TM]) :-
  307    !,
  308    (   M == '*'
  309    ->  true
  310    ;   must_be_method(M)
  311    ),
  312    collect_methods(T0, T, TM).
  313collect_methods([methods(M)|T0], T, [M|TM]) :-
  314    !,
  315    must_be(list, M),
  316    maplist(must_be_method, M),
  317    collect_methods(T0, T, TM).
  318collect_methods([H|T0], [H|T], TM) :-
  319    !,
  320    collect_methods(T0, T, TM).
  321
  322must_be_method(M) :-
  323    must_be(atom, M),
  324    (   method(M)
  325    ->  true
  326    ;   domain_error(http_method, M)
  327    ).
  328
  329method(get).
  330method(put).
  331method(head).
  332method(post).
  333method(delete).
  334method(patch).
  335method(options).
  336method(trace).
  337
  338
  339%!  check_path(+PathSpecIn, -PathSpecOut) is det.
  340%
  341%   Validate the given path specification.  We want one of
  342%
  343%           * AbsoluteLocation
  344%           * Alias(Relative)
  345%
  346%   Similar  to  absolute_file_name/3,  Relative  can    be  a  term
  347%   _|Component/Component/...|_
  348%
  349%   @error  domain_error, type_error
  350%   @see    http_absolute_location/3
  351
  352check_path(Path, Path) :-
  353    atom(Path),
  354    !,
  355    (   sub_atom(Path, 0, _, _, /)
  356    ->  true
  357    ;   domain_error(absolute_http_location, Path)
  358    ).
  359check_path(Alias, AliasOut) :-
  360    compound(Alias),
  361    Alias =.. [Name, Relative],
  362    !,
  363    to_atom(Relative, Local),
  364    (   sub_atom(Local, 0, _, _, /)
  365    ->  domain_error(relative_location, Relative)
  366    ;   AliasOut =.. [Name, Local]
  367    ).
  368check_path(PathSpec, _) :-
  369    type_error(path_or_alias, PathSpec).
  370
  371to_atom(Atom, Atom) :-
  372    atom(Atom),
  373    !.
  374to_atom(Path, Atom) :-
  375    phrase(path_to_list(Path), Components),
  376    !,
  377    atomic_list_concat(Components, '/', Atom).
  378to_atom(Path, _) :-
  379    ground(Path),
  380    !,
  381    type_error(relative_location, Path).
  382to_atom(Path, _) :-
  383    instantiation_error(Path).
  384
  385path_to_list(Var) -->
  386    { var(Var),
  387      !,
  388      fail
  389    }.
  390path_to_list(A/B) -->
  391    path_to_list(A),
  392    path_to_list(B).
  393path_to_list(Atom) -->
  394    { atom(Atom) },
  395    [Atom].
  396
  397
  398
  399%!  http_dispatch(Request) is det.
  400%
  401%   Dispatch a Request using http_handler/3 registrations.
  402
  403http_dispatch(Request) :-
  404    memberchk(path(Path), Request),
  405    find_handler(Path, Pred, Options),
  406    supports_method(Request, Options),
  407    authentication(Options, Request, Fields),
  408    append(Fields, Request, AuthRequest),
  409    action(Pred, AuthRequest, Options).
  410
  411
  412%!  http_current_handler(+Location, :Closure) is semidet.
  413%!  http_current_handler(-Location, :Closure) is nondet.
  414%
  415%   True if Location is handled by Closure.
  416
  417http_current_handler(Path, Closure) :-
  418    atom(Path),
  419    !,
  420    path_tree(Tree),
  421    find_handler(Tree, Path, Closure, _).
  422http_current_handler(Path, M:C) :-
  423    handler(Spec, M:C, _, _),
  424    http_absolute_location(Spec, Path, []).
  425
  426%!  http_current_handler(+Location, :Closure, -Options) is semidet.
  427%!  http_current_handler(?Location, :Closure, ?Options) is nondet.
  428%
  429%   Resolve the current handler and options to execute it.
  430
  431http_current_handler(Path, Closure, Options) :-
  432    atom(Path),
  433    !,
  434    path_tree(Tree),
  435    find_handler(Tree, Path, Closure, Options).
  436http_current_handler(Path, M:C, Options) :-
  437    handler(Spec, M:C, _, _),
  438    http_absolute_location(Spec, Path, []),
  439    path_tree(Tree),
  440    find_handler(Tree, Path, _, Options).
  441
  442
  443%!  http_location_by_id(+ID, -Location) is det.
  444%
  445%   Find the HTTP Location of handler with   ID. If the setting (see
  446%   setting/2)  http:prefix  is  active,  Location  is  the  handler
  447%   location prefixed with the prefix setting.   Handler  IDs can be
  448%   specified in two ways:
  449%
  450%       * id(ID)
  451%       If this appears in the option list of the handler, this
  452%       it is used and takes preference over using the predicate.
  453%       * M:PredName
  454%       The module-qualified name of the predicate.
  455%       * PredName
  456%       The unqualified name of the predicate.
  457%
  458%   @error existence_error(http_handler_id, Id).
  459%   @deprecated The predicate http_link_to_id/3 provides the same
  460%   functionality with the option to add query parameters or a
  461%   path parameter.
  462
  463:- dynamic
  464    id_location_cache/2.  465
  466http_location_by_id(ID, Location) :-
  467    must_be(ground, ID),
  468    id_location_cache(ID, L0),
  469    !,
  470    Location = L0.
  471http_location_by_id(ID, Location) :-
  472    findall(P-L, location_by_id(ID, L, P), List),
  473    keysort(List, RevSorted),
  474    reverse(RevSorted, Sorted),
  475    (   Sorted = [_-One]
  476    ->  assert(id_location_cache(ID, One)),
  477        Location = One
  478    ;   List == []
  479    ->  existence_error(http_handler_id, ID)
  480    ;   List = [P0-Best,P1-_|_]
  481    ->  (   P0 == P1
  482        ->  print_message(warning,
  483                          http_dispatch(ambiguous_id(ID, Sorted, Best)))
  484        ;   true
  485        ),
  486        assert(id_location_cache(ID, Best)),
  487        Location = Best
  488    ).
  489
  490location_by_id(ID, Location, Priority) :-
  491    location_by_id_raw(ID, L0, Priority),
  492    to_path(L0, Location).
  493
  494to_path(prefix(Path0), Path) :-        % old style prefix notation
  495    !,
  496    add_prefix(Path0, Path).
  497to_path(Path0, Path) :-
  498    atomic(Path0),                 % old style notation
  499    !,
  500    add_prefix(Path0, Path).
  501to_path(Spec, Path) :-                  % new style notation
  502    http_absolute_location(Spec, Path, []).
  503
  504add_prefix(P0, P) :-
  505    (   catch(setting(http:prefix, Prefix), _, fail),
  506        Prefix \== ''
  507    ->  atom_concat(Prefix, P0, P)
  508    ;   P = P0
  509    ).
  510
  511location_by_id_raw(ID, Location, Priority) :-
  512    handler(Location, _, _, Options),
  513    option(id(ID), Options),
  514    option(priority(P0), Options, 0),
  515    Priority is P0+1000.            % id(ID) takes preference over predicate
  516location_by_id_raw(ID, Location, Priority) :-
  517    handler(Location, M:C, _, Options),
  518    option(priority(Priority), Options, 0),
  519    functor(C, PN, _),
  520    (   ID = M:PN
  521    ;   ID = PN
  522    ),
  523    !.
  524
  525
  526%!  http_link_to_id(+HandleID, +Parameters, -HREF)
  527%
  528%   HREF is a link on the local server   to a handler with given ID,
  529%   passing the given Parameters. This   predicate is typically used
  530%   to formulate a HREF that resolves   to  a handler implementing a
  531%   particular predicate. The code below provides a typical example.
  532%   The predicate user_details/1 returns a page with details about a
  533%   user from a given id. This predicate is registered as a handler.
  534%   The DCG user_link//1 renders a link   to  a user, displaying the
  535%   name and calling user_details/1  when   clicked.  Note  that the
  536%   location (root(user_details)) is irrelevant in this equation and
  537%   HTTP locations can thus be moved   freely  without breaking this
  538%   code fragment.
  539%
  540%     ==
  541%     :- http_handler(root(user_details), user_details, []).
  542%
  543%     user_details(Request) :-
  544%         http_parameters(Request,
  545%                         [ user_id(ID)
  546%                         ]),
  547%         ...
  548%
  549%     user_link(ID) -->
  550%         { user_name(ID, Name),
  551%           http_link_to_id(user_details, [id(ID)], HREF)
  552%         },
  553%         html(a([class(user), href(HREF)], Name)).
  554%     ==
  555%
  556%   @arg Parameters is one of
  557%
  558%           - path_postfix(File) to pass a single value as the last
  559%             segment of the HTTP location (path). This way of
  560%             passing a parameter is commonly used in REST APIs.
  561%           - A list of search parameters for a =GET= request.
  562%
  563%   @see    http_location_by_id/2 and http_handler/3 for defining and
  564%           specifying handler IDs.
  565
  566http_link_to_id(HandleID, path_postfix(File), HREF) :-
  567    !,
  568    http_location_by_id(HandleID, HandlerLocation),
  569    uri_encoded(path, File, EncFile),
  570    directory_file_path(HandlerLocation, EncFile, Location),
  571    uri_data(path, Components, Location),
  572    uri_components(HREF, Components).
  573http_link_to_id(HandleID, Parameters, HREF) :-
  574    must_be(list, Parameters),
  575    http_location_by_id(HandleID, Location),
  576    uri_data(path, Components, Location),
  577    uri_query_components(String, Parameters),
  578    uri_data(search, Components, String),
  579    uri_components(HREF, Components).
  580
  581%!  http_reload_with_parameters(+Request, +Parameters, -HREF) is det.
  582%
  583%   Create a request on the current handler with replaced search
  584%   parameters.
  585
  586http_reload_with_parameters(Request, NewParams, HREF) :-
  587    memberchk(path(Path), Request),
  588    (   memberchk(search(Params), Request)
  589    ->  true
  590    ;   Params = []
  591    ),
  592    merge_options(NewParams, Params, AllParams),
  593    uri_query_components(Search, AllParams),
  594    uri_data(path, Data, Path),
  595    uri_data(search, Data, Search),
  596    uri_components(HREF, Data).
  597
  598
  599%       hook into html_write:attribute_value//1.
  600
  601:- multifile
  602    html_write:expand_attribute_value//1.  603
  604html_write:expand_attribute_value(location_by_id(ID)) -->
  605    { http_location_by_id(ID, Location) },
  606    html_write:html_quoted_attribute(Location).
  607
  608
  609%!  authentication(+Options, +Request, -Fields) is det.
  610%
  611%   Verify  authentication  information.   If    authentication   is
  612%   requested through Options, demand it. The actual verification is
  613%   done by the multifile predicate http:authenticate/3. The library
  614%   http_authenticate.pl provides an implementation thereof.
  615%
  616%   @error  permission_error(access, http_location, Location)
  617
  618:- multifile
  619    http:authenticate/3.  620
  621authentication([], _, []).
  622authentication([authentication(Type)|Options], Request, Fields) :-
  623    !,
  624    (   http:authenticate(Type, Request, XFields)
  625    ->  append(XFields, More, Fields),
  626        authentication(Options, Request, More)
  627    ;   memberchk(path(Path), Request),
  628        permission_error(access, http_location, Path)
  629    ).
  630authentication([_|Options], Request, Fields) :-
  631    authentication(Options, Request, Fields).
  632
  633
  634%!  find_handler(+Path, -Action, -Options) is det.
  635%
  636%   Find the handler to call from Path.  Rules:
  637%
  638%           * If there is a matching handler, use this.
  639%           * If there are multiple prefix(Path) handlers, use the
  640%             longest.
  641%
  642%   If there is a handler for =|/dir/|=   and  the requested path is
  643%   =|/dir|=, find_handler/3 throws a  http_reply exception, causing
  644%   the wrapper to generate a 301 (Moved Permanently) reply.
  645%
  646%   @error  existence_error(http_location, Location)
  647%   @throw  http_reply(moved(Dir))
  648%   @tbd    Introduce automatic redirection to indexes here?
  649
  650find_handler(Path, Action, Options) :-
  651    path_tree(Tree),
  652    (   find_handler(Tree, Path, Action, Options),
  653        eval_condition(Options)
  654    ->  true
  655    ;   \+ sub_atom(Path, _, _, 0, /),
  656        atom_concat(Path, /, Dir),
  657        find_handler(Tree, Dir, Action, Options)
  658    ->  throw(http_reply(moved(Dir)))
  659    ;   throw(error(existence_error(http_location, Path), _))
  660    ).
  661
  662
  663find_handler([node(prefix(Prefix), PAction, POptions, Children)|_],
  664             Path, Action, Options) :-
  665    sub_atom(Path, 0, _, After, Prefix),
  666    !,
  667    (   option(hide_children(false), POptions, false),
  668        find_handler(Children, Path, Action, Options)
  669    ->  true
  670    ;   Action = PAction,
  671        path_info(After, Path, POptions, Options)
  672    ).
  673find_handler([node(Path, Action, Options, _)|_], Path, Action, Options) :- !.
  674find_handler([_|Tree], Path, Action, Options) :-
  675    find_handler(Tree, Path, Action, Options).
  676
  677path_info(0, _, Options,
  678          [prefix(true)|Options]) :- !.
  679path_info(After, Path, Options,
  680          [path_info(PathInfo),prefix(true)|Options]) :-
  681    sub_atom(Path, _, After, 0, PathInfo).
  682
  683eval_condition(Options) :-
  684    (   memberchk(condition(Cond), Options)
  685    ->  catch(Cond, E, (print_message(warning, E), fail))
  686    ;   true
  687    ).
  688
  689
  690%!  supports_method(+Request, +Options) is det.
  691%
  692%   Verify that the asked http method   is supported by the handler.
  693%   If not, raise an error that will be  mapped to a 405 page by the
  694%   http wrapper.
  695%
  696%   @error permission_error(http_method, Method, Location).
  697
  698supports_method(Request, Options) :-
  699    (   option(methods(Methods), Options)
  700    ->  (   Methods == '*'
  701        ->  true
  702        ;   memberchk(method(Method), Request),
  703            memberchk(Method, Methods)
  704        )
  705    ;   true
  706    ),
  707    !.
  708supports_method(Request, _Options) :-
  709    memberchk(path(Location), Request),
  710    memberchk(method(Method), Request),
  711    permission_error(http_method, Method, Location).
  712
  713
  714%!  action(+Action, +Request, +Options) is det.
  715%
  716%   Execute the action found.  Here we take care of the options
  717%   =time_limit=, =chunked= and =spawn=.
  718%
  719%   @error  goal_failed(Goal)
  720
  721action(Action, Request, Options) :-
  722    memberchk(chunked, Options),
  723    !,
  724    format('Transfer-encoding: chunked~n'),
  725    spawn_action(Action, Request, Options).
  726action(Action, Request, Options) :-
  727    spawn_action(Action, Request, Options).
  728
  729spawn_action(Action, Request, Options) :-
  730    option(spawn(Spawn), Options),
  731    !,
  732    spawn_options(Spawn, SpawnOption),
  733    http_spawn(time_limit_action(Action, Request, Options), SpawnOption).
  734spawn_action(Action, Request, Options) :-
  735    time_limit_action(Action, Request, Options).
  736
  737spawn_options([], []) :- !.
  738spawn_options(Pool, Options) :-
  739    atom(Pool),
  740    !,
  741    Options = [pool(Pool)].
  742spawn_options(List, List).
  743
  744time_limit_action(Action, Request, Options) :-
  745    (   option(time_limit(TimeLimit), Options),
  746        TimeLimit \== default
  747    ->  true
  748    ;   setting(http:time_limit, TimeLimit)
  749    ),
  750    number(TimeLimit),
  751    TimeLimit > 0,
  752    !,
  753    call_with_time_limit(TimeLimit, call_action(Action, Request, Options)).
  754time_limit_action(Action, Request, Options) :-
  755    call_action(Action, Request, Options).
  756
  757
  758%!  call_action(+Action, +Request, +Options)
  759%
  760%   @tbd    reply_file is normal call?
  761
  762call_action(reply_file(File, FileOptions), Request, _Options) :-
  763    !,
  764    http_reply_file(File, FileOptions, Request).
  765call_action(Pred, Request, Options) :-
  766    memberchk(path_info(PathInfo), Options),
  767    !,
  768    call_action(Pred, [path_info(PathInfo)|Request]).
  769call_action(Pred, Request, _Options) :-
  770    call_action(Pred, Request).
  771
  772call_action(Pred, Request) :-
  773    (   call(Pred, Request)
  774    ->  true
  775    ;   extend(Pred, [Request], Goal),
  776        throw(error(goal_failed(Goal), _))
  777    ).
  778
  779extend(Var, _, Var) :-
  780    var(Var),
  781    !.
  782extend(M:G0, Extra, M:G) :-
  783    extend(G0, Extra, G).
  784extend(G0, Extra, G) :-
  785    G0 =.. List,
  786    append(List, Extra, List2),
  787    G =.. List2.
  788
  789%!  http_reply_file(+FileSpec, +Options, +Request) is det.
  790%
  791%   Options is a list of
  792%
  793%           * cache(+Boolean)
  794%           If =true= (default), handle If-modified-since and send
  795%           modification time.
  796%
  797%           * mime_type(+Type)
  798%           Overrule mime-type guessing from the filename as
  799%           provided by file_mime_type/2.
  800%
  801%           * static_gzip(+Boolean)
  802%           If true (default =false=) and, in addition to the plain
  803%           file, there is a =|.gz|= file that is not older than the
  804%           plain file and the client acceps =gzip= encoding, send
  805%           the compressed file with =|Transfer-encoding: gzip|=.
  806%
  807%           * unsafe(+Boolean)
  808%           If =false= (default), validate that FileSpec does not
  809%           contain references to parent directories.  E.g.,
  810%           specifications such as =|www('../../etc/passwd')|= are
  811%           not allowed.
  812%
  813%           * headers(+List)
  814%           Provides additional reply-header fields, encoded as a
  815%           list of _|Field(Value)|_.
  816%
  817%   If caching is not disabled,  it   processes  the request headers
  818%   =|If-modified-since|= and =Range=.
  819%
  820%   @throws http_reply(not_modified)
  821%   @throws http_reply(file(MimeType, Path))
  822
  823http_reply_file(File, Options, Request) :-
  824    http_safe_file(File, Options),
  825    absolute_file_name(File, Path,
  826                       [ access(read)
  827                       ]),
  828    (   option(cache(true), Options, true)
  829    ->  (   memberchk(if_modified_since(Since), Request),
  830            time_file(Path, Time),
  831            catch(http_timestamp(Time, Since), _, fail)
  832        ->  throw(http_reply(not_modified))
  833        ;   true
  834        ),
  835        (   memberchk(range(Range), Request)
  836        ->  Reply = file(Type, Path, Range)
  837        ;   option(static_gzip(true), Options),
  838            accepts_encoding(Request, gzip),
  839            file_name_extension(Path, gz, PathGZ),
  840            access_file(PathGZ, read),
  841            time_file(PathGZ, TimeGZ),
  842            time_file(Path, Time),
  843            TimeGZ >= Time
  844        ->  Reply = gzip_file(Type, PathGZ)
  845        ;   Reply = file(Type, Path)
  846        )
  847    ;   Reply = tmp_file(Type, Path)
  848    ),
  849    (   option(mime_type(Type), Options)
  850    ->  true
  851    ;   file_mime_type(Path, Type)
  852    ->  true
  853    ;   Type = text/plain           % fallback type
  854    ),
  855    option(headers(Headers), Options, []),
  856    throw(http_reply(Reply, Headers)).
  857
  858accepts_encoding(Request, Enc) :-
  859    memberchk(accept_encoding(Accept), Request),
  860    split_string(Accept, ",", " ", Parts),
  861    member(Part, Parts),
  862    split_string(Part, ";", " ", [EncS|_]),
  863    atom_string(Enc, EncS).
  864
  865
  866%!  http_safe_file(+FileSpec, +Options) is det.
  867%
  868%   True if FileSpec is considered _safe_.  If   it  is  an atom, it
  869%   cannot  be  absolute  and  cannot   have  references  to  parent
  870%   directories. If it is of the   form  alias(Sub), than Sub cannot
  871%   have references to parent directories.
  872%
  873%   @error instantiation_error
  874%   @error permission_error(read, file, FileSpec)
  875
  876http_safe_file(File, _) :-
  877    var(File),
  878    !,
  879    instantiation_error(File).
  880http_safe_file(_, Options) :-
  881    option(unsafe(true), Options, false),
  882    !.
  883http_safe_file(File, _) :-
  884    http_safe_file(File).
  885
  886http_safe_file(File) :-
  887    compound(File),
  888    functor(File, _, 1),
  889    !,
  890    arg(1, File, Name),
  891    safe_name(Name, File).
  892http_safe_file(Name) :-
  893    (   is_absolute_file_name(Name)
  894    ->  permission_error(read, file, Name)
  895    ;   true
  896    ),
  897    safe_name(Name, Name).
  898
  899safe_name(Name, _) :-
  900    must_be(atom, Name),
  901    prolog_to_os_filename(FileName, Name),
  902    \+ unsafe_name(FileName),
  903    !.
  904safe_name(_, Spec) :-
  905    permission_error(read, file, Spec).
  906
  907unsafe_name(Name) :- Name == '..'.
  908unsafe_name(Name) :- sub_atom(Name, 0, _, _, '../').
  909unsafe_name(Name) :- sub_atom(Name, _, _, _, '/../').
  910unsafe_name(Name) :- sub_atom(Name, _, _, 0, '/..').
  911
  912
  913%!  http_redirect(+How, +To, +Request) is det.
  914%
  915%   Redirect to a new  location.  The   argument  order,  using  the
  916%   Request as last argument, allows for  calling this directly from
  917%   the handler declaration:
  918%
  919%       ==
  920%       :- http_handler(root(.),
  921%                       http_redirect(moved, myapp('index.html')),
  922%                       []).
  923%       ==
  924%
  925%   @param How is one of =moved=, =moved_temporary= or =see_other=
  926%   @param To is an atom, a aliased path as defined by
  927%   http_absolute_location/3. or a term location_by_id(Id). If To is
  928%   not absolute, it is resolved relative to the current location.
  929
  930http_redirect(How, To, Request) :-
  931    (   To = location_by_id(Id)
  932    ->  http_location_by_id(Id, URL)
  933    ;   memberchk(path(Base), Request),
  934        http_absolute_location(To, URL, [relative_to(Base)])
  935    ),
  936    must_be(oneof([moved, moved_temporary, see_other]), How),
  937    Term =.. [How,URL],
  938    throw(http_reply(Term)).
  939
  940
  941%!  http_404(+Options, +Request) is det.
  942%
  943%   Reply using an "HTTP  404  not   found"  page.  This  handler is
  944%   intended as fallback handler  for   _prefix_  handlers.  Options
  945%   processed are:
  946%
  947%       * index(Location)
  948%       If there is no path-info, redirect the request to
  949%       Location using http_redirect/3.
  950%
  951%   @error http_reply(not_found(Path))
  952
  953http_404(Options, Request) :-
  954    option(index(Index), Options),
  955    \+ ( option(path_info(PathInfo), Request),
  956         PathInfo \== ''
  957       ),
  958    !,
  959    http_redirect(moved, Index, Request).
  960http_404(_Options, Request) :-
  961    option(path(Path), Request),
  962    !,
  963    throw(http_reply(not_found(Path))).
  964http_404(_Options, Request) :-
  965    domain_error(http_request, Request).
  966
  967
  968%!  http_switch_protocol(:Goal, +Options)
  969%
  970%   Send an =|"HTTP 101 Switching  Protocols"|= reply. After sending
  971%   the  reply,  the  HTTP  library    calls   call(Goal,  InStream,
  972%   OutStream), where InStream and OutStream are  the raw streams to
  973%   the HTTP client. This allows the communication to continue using
  974%   an an alternative protocol.
  975%
  976%   If Goal fails or throws an exception,  the streams are closed by
  977%   the server. Otherwise  Goal  is   responsible  for  closing  the
  978%   streams. Note that  Goal  runs  in   the  HTTP  handler  thread.
  979%   Typically, the handler should be   registered  using the =spawn=
  980%   option if http_handler/3 or Goal   must  call thread_create/3 to
  981%   allow the HTTP worker to return to the worker pool.
  982%
  983%   The streams use binary  (octet)  encoding   and  have  their I/O
  984%   timeout set to the server  timeout   (default  60  seconds). The
  985%   predicate set_stream/2 can  be  used   to  change  the encoding,
  986%   change or cancel the timeout.
  987%
  988%   This predicate interacts with the server  library by throwing an
  989%   exception.
  990%
  991%   The following options are supported:
  992%
  993%     - header(+Headers)
  994%     Backward compatible.  Use headers(+Headers).
  995%     - headers(+Headers)
  996%     Additional headers send with the reply. Each header takes the
  997%     form Name(Value).
  998
  999%       @throws http_reply(switch_protocol(Goal, Options))
 1000
 1001http_switch_protocol(Goal, Options) :-
 1002    throw(http_reply(switching_protocols(Goal, Options))).
 1003
 1004
 1005                 /*******************************
 1006                 *        PATH COMPILATION      *
 1007                 *******************************/
 1008
 1009%!  path_tree(-Tree) is det.
 1010%
 1011%   Compile paths into  a  tree.  The   treee  is  multi-rooted  and
 1012%   represented as a list of nodes, where each node has the form:
 1013%
 1014%           node(PathOrPrefix, Action, Options, Children)
 1015%
 1016%   The tree is a potentially complicated structure. It is cached in
 1017%   a global variable. Note that this   cache is per-thread, so each
 1018%   worker thread holds a copy of  the   tree.  If handler facts are
 1019%   changed the _generation_ is  incremented using next_generation/0
 1020%   and each worker thread will  re-compute   the  tree  on the next
 1021%   ocasion.
 1022
 1023path_tree(Tree) :-
 1024    current_generation(G),
 1025    nb_current(http_dispatch_tree, G-Tree),
 1026    !. % Avoid existence error
 1027path_tree(Tree) :-
 1028    path_tree_nocache(Tree),
 1029    current_generation(G),
 1030    nb_setval(http_dispatch_tree, G-Tree).
 1031
 1032path_tree_nocache(Tree) :-
 1033    findall(Prefix, prefix_handler(Prefix, _, _), Prefixes0),
 1034    sort(Prefixes0, Prefixes),
 1035    prefix_tree(Prefixes, [], PTree),
 1036    prefix_options(PTree, [], OPTree),
 1037    add_paths_tree(OPTree, Tree).
 1038
 1039prefix_handler(Prefix, Action, Options) :-
 1040    handler(Spec, Action, true, Options),
 1041    Error = error(existence_error(http_alias,_),_),
 1042    catch(http_absolute_location(Spec, Prefix, []), Error,
 1043          (   print_message(warning, Error),
 1044              fail
 1045          )).
 1046
 1047%!  prefix_tree(PrefixList, +Tree0, -Tree)
 1048%
 1049%   @param Tree     list(Prefix-list(Children))
 1050
 1051prefix_tree([], Tree, Tree).
 1052prefix_tree([H|T], Tree0, Tree) :-
 1053    insert_prefix(H, Tree0, Tree1),
 1054    prefix_tree(T, Tree1, Tree).
 1055
 1056insert_prefix(Prefix, Tree0, Tree) :-
 1057    select(P-T, Tree0, Tree1),
 1058    sub_atom(Prefix, 0, _, _, P),
 1059    !,
 1060    insert_prefix(Prefix, T, T1),
 1061    Tree = [P-T1|Tree1].
 1062insert_prefix(Prefix, Tree, [Prefix-[]|Tree]).
 1063
 1064
 1065%!  prefix_options(+PrefixTree, +DefOptions, -OptionTree)
 1066%
 1067%   Generate the option-tree for all prefix declarations.
 1068%
 1069%   @tbd    What to do if there are more?
 1070
 1071prefix_options([], _, []).
 1072prefix_options([P-C|T0], DefOptions,
 1073               [node(prefix(P), Action, Options, Children)|T]) :-
 1074    once(prefix_handler(P, Action, Options0)),
 1075    merge_options(Options0, DefOptions, Options),
 1076    delete(Options, id(_), InheritOpts),
 1077    prefix_options(C, InheritOpts, Children),
 1078    prefix_options(T0, DefOptions, T).
 1079
 1080
 1081%!  add_paths_tree(+OPTree, -Tree) is det.
 1082%
 1083%   Add the plain paths.
 1084
 1085add_paths_tree(OPTree, Tree) :-
 1086    findall(path(Path, Action, Options),
 1087            plain_path(Path, Action, Options),
 1088            Triples),
 1089    add_paths_tree(Triples, OPTree, Tree).
 1090
 1091add_paths_tree([], Tree, Tree).
 1092add_paths_tree([path(Path, Action, Options)|T], Tree0, Tree) :-
 1093    add_path_tree(Path, Action, Options, [], Tree0, Tree1),
 1094    add_paths_tree(T, Tree1, Tree).
 1095
 1096
 1097%!  plain_path(-Path, -Action, -Options) is nondet.
 1098%
 1099%   True if {Path,Action,Options} is registered and  Path is a plain
 1100%   (i.e. not _prefix_) location.
 1101
 1102plain_path(Path, Action, Options) :-
 1103    handler(Spec, Action, false, Options),
 1104    catch(http_absolute_location(Spec, Path, []), E,
 1105          (print_message(error, E), fail)).
 1106
 1107
 1108%!  add_path_tree(+Path, +Action, +Options, +Tree0, -Tree) is det.
 1109%
 1110%   Add a path to a tree. If a  handler for the same path is already
 1111%   defined, the one with the highest   priority or the latest takes
 1112%   precedence.
 1113
 1114add_path_tree(Path, Action, Options0, DefOptions, [],
 1115              [node(Path, Action, Options, [])]) :-
 1116    !,
 1117    merge_options(Options0, DefOptions, Options).
 1118add_path_tree(Path, Action, Options, _,
 1119              [node(prefix(Prefix), PA, DefOptions, Children0)|RestTree],
 1120              [node(prefix(Prefix), PA, DefOptions, Children)|RestTree]) :-
 1121    sub_atom(Path, 0, _, _, Prefix),
 1122    !,
 1123    delete(DefOptions, id(_), InheritOpts),
 1124    add_path_tree(Path, Action, Options, InheritOpts, Children0, Children).
 1125add_path_tree(Path, Action, Options1, DefOptions, [H0|T], [H|T]) :-
 1126    H0 = node(Path, _, Options2, _),
 1127    option(priority(P1), Options1, 0),
 1128    option(priority(P2), Options2, 0),
 1129    P1 >= P2,
 1130    !,
 1131    merge_options(Options1, DefOptions, Options),
 1132    H = node(Path, Action, Options, []).
 1133add_path_tree(Path, Action, Options, DefOptions, [H|T0], [H|T]) :-
 1134    add_path_tree(Path, Action, Options, DefOptions, T0, T).
 1135
 1136
 1137                 /*******************************
 1138                 *            MESSAGES          *
 1139                 *******************************/
 1140
 1141:- multifile
 1142    prolog:message/3. 1143
 1144prolog:message(http_dispatch(ambiguous_id(ID, _List, Selected))) -->
 1145    [ 'HTTP dispatch: ambiguous handler ID ~q (selected ~q)'-[ID, Selected]
 1146    ].
 1147
 1148
 1149                 /*******************************
 1150                 *            XREF              *
 1151                 *******************************/
 1152
 1153:- multifile
 1154    prolog:meta_goal/2. 1155:- dynamic
 1156    prolog:meta_goal/2. 1157
 1158prolog:meta_goal(http_handler(_, G, _), [G+1]).
 1159prolog:meta_goal(http_current_handler(_, G), [G+1]).
 1160
 1161
 1162                 /*******************************
 1163                 *             EDIT             *
 1164                 *******************************/
 1165
 1166% Allow edit(Location) to edit the implementation for an HTTP location.
 1167
 1168:- multifile
 1169    prolog_edit:locate/3. 1170
 1171prolog_edit:locate(Path, Spec, Location) :-
 1172    atom(Path),
 1173    sub_atom(Path, 0, _, _, /),
 1174    Pred = _M:_H,
 1175    catch(http_current_handler(Path, Pred), _, fail),
 1176    closure_name_arity(Pred, 1, PI),
 1177    prolog_edit:locate(PI, Spec, Location).
 1178
 1179closure_name_arity(M:Term, Extra, M:Name/Arity) :-
 1180    !,
 1181    callable(Term),
 1182    functor(Term, Name, Arity0),
 1183    Arity is Arity0 + Extra.
 1184closure_name_arity(Term, Extra, Name/Arity) :-
 1185    callable(Term),
 1186    functor(Term, Name, Arity0),
 1187    Arity is Arity0 + Extra.
 1188
 1189
 1190                 /*******************************
 1191                 *        CACHE CLEANUP         *
 1192                 *******************************/
 1193
 1194:- listen(settings(changed(http:prefix, _, _)),
 1195          next_generation). 1196
 1197:- multifile
 1198    user:message_hook/3. 1199:- dynamic
 1200    user:message_hook/3. 1201
 1202user:message_hook(make(done(Reload)), _Level, _Lines) :-
 1203    Reload \== [],
 1204    next_generation,
 1205    fail