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-2019, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(http_dispatch,
   38          [ http_dispatch/1,            % +Request
   39            http_handler/3,             % +Path, +Predicate, +Options
   40            http_delete_handler/1,      % +Path
   41            http_request_expansion/2,   % :Goal, +Rank
   42            http_reply_file/3,          % +File, +Options, +Request
   43            http_redirect/3,            % +How, +Path, +Request
   44            http_404/2,                 % +Options, +Request
   45            http_switch_protocol/2,     % :Goal, +Options
   46            http_current_handler/2,     % ?Path, ?Pred
   47            http_current_handler/3,     % ?Path, ?Pred, -Options
   48            http_location_by_id/2,      % +ID, -Location
   49            http_link_to_id/3,          % +ID, +Parameters, -HREF
   50            http_reload_with_parameters/3, % +Request, +Parameters, -HREF
   51            http_safe_file/2            % +Spec, +Options
   52          ]).   53:- use_module(library(option)).   54:- use_module(library(lists)).   55:- use_module(library(pairs)).   56:- use_module(library(time)).   57:- use_module(library(error)).   58:- use_module(library(settings)).   59:- use_module(library(uri)).   60:- use_module(library(apply)).   61:- use_module(library(http/mimetype)).   62:- use_module(library(http/http_path)).   63:- use_module(library(http/http_header)).   64:- use_module(library(http/thread_httpd)).   65
   66:- predicate_options(http_404/2, 1, [index(any)]).   67:- predicate_options(http_reply_file/3, 2,
   68                     [ cache(boolean),
   69                       mime_type(any),
   70                       static_gzip(boolean),
   71                       pass_to(http_safe_file/2, 2),
   72                       headers(list)
   73                     ]).   74:- predicate_options(http_safe_file/2, 2, [unsafe(boolean)]).   75:- predicate_options(http_switch_protocol/2, 2, []).   76
   77/** <module> Dispatch requests in the HTTP server
   78
   79This module can be placed between   http_wrapper.pl  and the application
   80code to associate HTTP _locations_ to   predicates that serve the pages.
   81In addition, it associates parameters  with   locations  that  deal with
   82timeout handling and user authentication.  The typical setup is:
   83
   84==
   85server(Port, Options) :-
   86        http_server(http_dispatch,
   87                    [ port(Port)
   88                    | Options
   89                    ]).
   90
   91:- http_handler('/index.html', write_index, []).
   92
   93write_index(Request) :-
   94        ...
   95==
   96*/
   97
   98:- setting(http:time_limit, nonneg, 300,
   99           'Time limit handling a single query (0=infinite)').  100
  101%!  http_handler(+Path, :Closure, +Options) is det.
  102%
  103%   Register Closure as a handler for HTTP   requests. Path is either an
  104%   absolute path such as =|'/home.html'|=   or  a term Alias(Relative).
  105%   Where Alias is associated with a concrete path using http:location/3
  106%   and resolved using http_absolute_location/3.  `Relative`   can  be a
  107%   single atom or a term `Segment1/Segment2/...`, where each element is
  108%   either an atom or a variable. If a  segment is a variable it matches
  109%   any segment and the binding may  be   passed  to the closure. If the
  110%   last segment is a variable  it   may  match  multiple segments. This
  111%   allows registering REST paths, for example:
  112%
  113%      ```
  114%      :- http_handler(root(user/User), user(Method, User),
  115%                      [ method(Method),
  116%                        methods([get,port,put])
  117%                      ]).
  118%
  119%      user(get, User, Request) :-
  120%          ...
  121%      user(post, User, Request) :-
  122%          ...
  123%      ```
  124%
  125%   If an HTTP request arrives at the  server that matches Path, Closure
  126%   is called as below, where `Request` is the parsed HTTP request.
  127%
  128%       call(Closure, Request)
  129%
  130%   Options  is  a  list containing the following options:
  131%
  132%     - authentication(+Type)
  133%       Demand authentication. Authentication methods are pluggable. The
  134%       library http_authenticate.pl provides a plugin for user/password
  135%       based =Basic= HTTP authentication.
  136%
  137%     - chunked
  138%       Use =|Transfer-encoding: chunked|= if the client allows for it.
  139%
  140%     - condition(:Goal)
  141%       If present, the handler is ignored if Goal does not succeed.
  142%
  143%     - content_type(+Term)
  144%       Specifies the content-type of the reply. This value is currently
  145%       not used by this library. It enhances the reflexive capabilities
  146%       of this library through http_current_handler/3.
  147%
  148%     - id(+Atom)
  149%       Identifier of the handler. The default identifier is the
  150%       predicate name. Used by http_location_by_id/2 and
  151%       http_link_to_id/3.
  152%
  153%     - hide_children(+Bool)
  154%       If =true= on a prefix-handler (see prefix), possible children
  155%       are masked. This can be used to (temporary) overrule part of the
  156%       tree.
  157%
  158%     - method(+Method)
  159%       Declare that the handler processes Method. This is equivalent to
  160%       methods([Method]). Using method(*) allows for all methods.
  161%
  162%     - methods(+ListOfMethods)
  163%       Declare that the handler processes all of the given methods. If
  164%       this option appears multiple times, the methods are combined.
  165%
  166%     - prefix
  167%       Call Pred on any location that is a specialisation of Path. If
  168%       multiple handlers match, the one with the longest path is used.
  169%       Options defined with a prefix handler are the default options
  170%       for paths that start with this prefix. Note that the handler
  171%       acts as a fallback handler for the tree below it:
  172%
  173%       ==
  174%       :- http_handler(/, http_404([index('index.html')]),
  175%                       [spawn(my_pool),prefix]).
  176%       ==
  177%
  178%     - priority(+Integer)
  179%       If two handlers handle the same path, the one with the highest
  180%       priority is used. If equal, the last registered is used. Please
  181%       be aware that the order of clauses in multifile predicates can
  182%       change due to reloading files. The default priority is 0 (zero).
  183%
  184%     - spawn(+SpawnOptions)
  185%       Run the handler in a seperate thread. If SpawnOptions is an
  186%       atom, it is interpreted as a thread pool name (see
  187%       create_thread_pool/3). Otherwise the options are passed to
  188%       http_spawn/2 and from there to thread_create/3. These options
  189%       are typically used to set the stack limits.
  190%
  191%     - time_limit(+Spec)
  192%       One of =infinite=, =default= or a positive number (seconds). If
  193%       =default=, the value from the setting =http:time_limit= is
  194%       taken. The default of this setting is 300 (5 minutes). See
  195%       setting/2.
  196%
  197%   Note that http_handler/3 is normally  invoked   as  a  directive and
  198%   processed using term-expansion. Using  term-expansion ensures proper
  199%   update through make/0 when the specification is modified.
  200%
  201%   @error  existence_error(http_location, Location)
  202%   @error  permission_error(http_method, Method, Location)
  203%   @see    http_reply_file/3 and http_redirect/3 are generic
  204%           handlers to serve files and achieve redirects.
  205
  206:- dynamic handler/4.                   % Path, Action, IsPrefix, Options
  207:- multifile handler/4.  208:- dynamic generation/1.  209
  210:- meta_predicate
  211    http_handler(+, :, +),
  212    http_current_handler(?, :),
  213    http_current_handler(?, :, ?),
  214    http_request_expansion(3, +),
  215    http_switch_protocol(2, +).  216
  217http_handler(Path, Pred, Options) :-
  218    compile_handler(Path, Pred, Options, Clause),
  219    next_generation,
  220    assert(Clause).
  221
  222:- multifile
  223    system:term_expansion/2.  224
  225system:term_expansion((:- http_handler(Path, Pred, Options)), Clause) :-
  226    \+ current_prolog_flag(xref, true),
  227    prolog_load_context(module, M),
  228    compile_handler(Path, M:Pred, Options, Clause),
  229    next_generation.
  230
  231
  232%!  http_delete_handler(+Spec) is det.
  233%
  234%   Delete handler for Spec. Typically, this should only be used for
  235%   handlers that are registered dynamically. Spec is one of:
  236%
  237%       * id(Id)
  238%       Delete a handler with the given id.  The default id is the
  239%       handler-predicate-name.
  240%
  241%       * path(Path)
  242%       Delete handler that serves the given path.
  243
  244http_delete_handler(id(Id)) :-
  245    !,
  246    clause(handler(_Path, _:Pred, _, Options), true, Ref),
  247    functor(Pred, DefID, _),
  248    option(id(Id0), Options, DefID),
  249    Id == Id0,
  250    erase(Ref),
  251    next_generation.
  252http_delete_handler(path(Path)) :-
  253    !,
  254    retractall(handler(Path, _Pred, _, _Options)),
  255    next_generation.
  256http_delete_handler(Path) :-
  257    http_delete_handler(path(Path)).
  258
  259
  260%!  next_generation is det.
  261%!  current_generation(-G) is det.
  262%
  263%   Increment the generation count.
  264
  265next_generation :-
  266    retractall(id_location_cache(_,_,_,_)),
  267    with_mutex(http_dispatch, next_generation_unlocked).
  268
  269next_generation_unlocked :-
  270    retract(generation(G0)),
  271    !,
  272    G is G0 + 1,
  273    assert(generation(G)).
  274next_generation_unlocked :-
  275    assert(generation(1)).
  276
  277current_generation(G) :-
  278    with_mutex(http_dispatch, generation(G)),
  279    !.
  280current_generation(0).
  281
  282
  283%!  compile_handler(+Path, :Pred, +Options, -Clause) is det.
  284%
  285%   Compile a handler specification.
  286
  287compile_handler(Path, Pred, Options0,
  288                http_dispatch:handler(Path1, Pred, IsPrefix, Options)) :-
  289    check_path(Path, Path1, PathOptions),
  290    check_id(Options0),
  291    (   memberchk(segment_pattern(_), PathOptions)
  292    ->  IsPrefix = true,
  293        Options1 = Options0
  294    ;   select(prefix, Options0, Options1)
  295    ->  IsPrefix = true
  296    ;   IsPrefix = false,
  297        Options1 = Options0
  298    ),
  299    partition(ground, Options1, Options2, QueryOptions),
  300    Pred = M:_,
  301    maplist(qualify_option(M), Options2, Options3),
  302    combine_methods(Options3, Options4),
  303    (   QueryOptions == []
  304    ->  append(PathOptions, Options4, Options)
  305    ;   append(PathOptions, ['$extract'(QueryOptions)|Options4], Options)
  306    ).
  307
  308qualify_option(M, condition(Pred), condition(M:Pred)) :-
  309    Pred \= _:_, !.
  310qualify_option(_, Option, Option).
  311
  312%!  combine_methods(+OptionsIn, -Options) is det.
  313%
  314%   Combine method(M) and  methods(MList)  options   into  a  single
  315%   methods(MList) option.
  316
  317combine_methods(Options0, Options) :-
  318    collect_methods(Options0, Options1, Methods),
  319    (   Methods == []
  320    ->  Options = Options0
  321    ;   append(Methods, Flat),
  322        sort(Flat, Unique),
  323        (   memberchk('*', Unique)
  324        ->  Final = '*'
  325        ;   Final = Unique
  326        ),
  327        Options = [methods(Final)|Options1]
  328    ).
  329
  330collect_methods([], [], []).
  331collect_methods([method(M)|T0], T, [[M]|TM]) :-
  332    !,
  333    (   M == '*'
  334    ->  true
  335    ;   must_be_method(M)
  336    ),
  337    collect_methods(T0, T, TM).
  338collect_methods([methods(M)|T0], T, [M|TM]) :-
  339    !,
  340    must_be(list, M),
  341    maplist(must_be_method, M),
  342    collect_methods(T0, T, TM).
  343collect_methods([H|T0], [H|T], TM) :-
  344    !,
  345    collect_methods(T0, T, TM).
  346
  347must_be_method(M) :-
  348    must_be(atom, M),
  349    (   method(M)
  350    ->  true
  351    ;   domain_error(http_method, M)
  352    ).
  353
  354method(get).
  355method(put).
  356method(head).
  357method(post).
  358method(delete).
  359method(patch).
  360method(options).
  361method(trace).
  362
  363
  364%!  check_path(+PathSpecIn, -PathSpecOut, -Options) is det.
  365%
  366%   Validate the given path specification.  We want one of
  367%
  368%     - AbsoluteLocation
  369%     - Alias(Relative)
  370%
  371%   Similar  to  absolute_file_name/3,   Relative   can    be   a   term
  372%   ``Component/Component/...``. Relative may be a `/` separated list of
  373%   path segments, some of which may   be  variables. A variable patches
  374%   any segment and its binding can be passed  to the handler. If such a
  375%   pattern     is     found      Options       is      unified     with
  376%   `[segment_pattern(SegmentList)]`.
  377%
  378%   @error  domain_error, type_error
  379%   @see    http_absolute_location/3
  380
  381check_path(Path, Path, []) :-
  382    atom(Path),
  383    !,
  384    (   sub_atom(Path, 0, _, _, /)
  385    ->  true
  386    ;   domain_error(absolute_http_location, Path)
  387    ).
  388check_path(Alias, AliasOut, Options) :-
  389    compound(Alias),
  390    Alias =.. [Name, Relative],
  391    !,
  392    local_path(Relative, Local, Options),
  393    (   sub_atom(Local, 0, _, _, /)
  394    ->  domain_error(relative_location, Relative)
  395    ;   AliasOut =.. [Name, Local]
  396    ).
  397check_path(PathSpec, _, _) :-
  398    type_error(path_or_alias, PathSpec).
  399
  400local_path(Atom, Atom, []) :-
  401    atom(Atom),
  402    !.
  403local_path(Path, Atom, Options) :-
  404    phrase(path_to_list(Path), Components),
  405    !,
  406    (   maplist(atom, Components)
  407    ->  atomic_list_concat(Components, '/', Atom),
  408        Options = []
  409    ;   append(Pre, [Var|Rest], Components),
  410        var(Var)
  411    ->  append(Pre, [''], PreSep),
  412        atomic_list_concat(PreSep, '/', Atom),
  413        Options = [segment_pattern([Var|Rest])]
  414    ).
  415local_path(Path, _, _) :-
  416    ground(Path),
  417    !,
  418    type_error(relative_location, Path).
  419local_path(Path, _, _) :-
  420    instantiation_error(Path).
  421
  422path_to_list(Var) -->
  423    { var(Var) },
  424    !,
  425    [Var].
  426path_to_list(A/B) -->
  427    !,
  428    path_to_list(A),
  429    path_to_list(B).
  430path_to_list(Atom) -->
  431    { atom(Atom) },
  432    !,
  433    [Atom].
  434path_to_list(Value) -->
  435    { must_be(atom, Value) }.
  436
  437check_id(Options) :-
  438    memberchk(id(Id), Options),
  439    !,
  440    must_be(atom, Id).
  441check_id(_).
  442
  443
  444%!  http_dispatch(Request) is det.
  445%
  446%   Dispatch a Request using http_handler/3   registrations. It performs
  447%   the following steps:
  448%
  449%     1. Find a matching handler based on the `path` member of Request.
  450%        If multiple handlers match due to the `prefix` option or
  451%        variables in path segments (see http_handler/3), the longest
  452%        specification is used.  If multiple specifications of equal
  453%        length match the one with the highest priority is used.
  454%     2. Check that the handler matches the `method` member of the
  455%        Request or throw permission_error(http_method, Method, Location)
  456%     3. Expand the request using expansion hooks registered by
  457%        http_request_expansion/3.  This may add fields to the request,
  458%        such the authenticated user, parsed parameters, etc.  The
  459%        hooks may also throw exceptions, notably using http_redirect/3
  460%        or by throwing `http_reply(Term, ExtraHeader, Context)`
  461%        exceptions.
  462%     4. Extract possible fields from the Request using e.g.
  463%        method(Method) as one of the options.
  464%     5. Call the registered _closure_, optionally spawning the
  465%        request to a new thread or enforcing a time limit.
  466
  467http_dispatch(Request) :-
  468    memberchk(path(Path), Request),
  469    find_handler(Path, Closure, Options),
  470    supports_method(Request, Options),
  471    expand_request(Request, Request1, Options),
  472    extract_from_request(Request1, Options),
  473    action(Closure, Request1, Options).
  474
  475extract_from_request(Request, Options) :-
  476    memberchk('$extract'(Fields), Options),
  477    !,
  478    extract_fields(Fields, Request).
  479extract_from_request(_, _).
  480
  481extract_fields([], _).
  482extract_fields([H|T], Request) :-
  483    memberchk(H, Request),
  484    extract_fields(T, Request).
  485
  486
  487%!  http_request_expansion(:Goal, +Rank:number)
  488%
  489%   Register Goal for expanding the HTTP request handler. Goal is called
  490%   as below. If Goal fail the request   is passed to the next expansion
  491%   unmodified.
  492%
  493%       call(Goal, Request0, Request, Options)
  494%
  495%   If multiple goals are  registered  they   expand  the  request  in a
  496%   pipeline starting with the expansion hook with the lowest rank.
  497%
  498%   Besides rewriting the request, for example   by  validating the user
  499%   identity based on HTTP authentication or  cookies and adding this to
  500%   the request, the hook may raise HTTP exceptions to indicate a bad
  501%   request, permission error, etc.  See http_status_reply/4.
  502%
  503%   Initially, auth_expansion/3 is registered with   rank  `100` to deal
  504%   with the older http:authenticate/3 hook.
  505
  506http_request_expansion(Goal, Rank) :-
  507    throw(error(context_error(nodirective, http_request_expansion(Goal, Rank)), _)).
  508
  509:- multifile
  510    request_expansion/2.  511
  512system:term_expansion((:- http_request_expansion(Goal, Rank)),
  513                      http_dispatch:request_expansion(M:Callable, Rank)) :-
  514    must_be(number, Rank),
  515    prolog_load_context(module, M0),
  516    strip_module(M0:Goal, M, Callable),
  517    must_be(callable, Callable).
  518
  519request_expanders(Closures) :-
  520    findall(Rank-Closure, request_expansion(Closure, Rank), Pairs),
  521    keysort(Pairs, Sorted),
  522    pairs_values(Sorted, Closures).
  523
  524%!  expand_request(+Request0, -Request, +Options)
  525%
  526%   Expand an HTTP request.  Options  is   a  list  of  combined options
  527%   provided with the handler registration (see http_handler/3).
  528
  529expand_request(Request0, Request, Options) :-
  530    request_expanders(Closures),
  531    expand_request(Closures, Request0, Request, Options).
  532
  533expand_request([], Request, Request, _).
  534expand_request([H|T], Request0, Request, Options) :-
  535    expand_request1(H, Request0, Request1, Options),
  536    expand_request(T, Request1, Request, Options).
  537
  538expand_request1(Closure, Request0, Request, Options) :-
  539    call(Closure, Request0, Request, Options),
  540    !.
  541expand_request1(_, Request, Request, _).
  542
  543
  544%!  http_current_handler(+Location, :Closure) is semidet.
  545%!  http_current_handler(-Location, :Closure) is nondet.
  546%
  547%   True if Location is handled by Closure.
  548
  549http_current_handler(Path, Closure) :-
  550    atom(Path),
  551    !,
  552    path_tree(Tree),
  553    find_handler(Tree, Path, Closure, _).
  554http_current_handler(Path, M:C) :-
  555    handler(Spec, M:C, _, _),
  556    http_absolute_location(Spec, Path, []).
  557
  558%!  http_current_handler(+Location, :Closure, -Options) is semidet.
  559%!  http_current_handler(?Location, :Closure, ?Options) is nondet.
  560%
  561%   Resolve the current handler and options to execute it.
  562
  563http_current_handler(Path, Closure, Options) :-
  564    atom(Path),
  565    !,
  566    path_tree(Tree),
  567    find_handler(Tree, Path, Closure, Options).
  568http_current_handler(Path, M:C, Options) :-
  569    handler(Spec, M:C, _, _),
  570    http_absolute_location(Spec, Path, []),
  571    path_tree(Tree),
  572    find_handler(Tree, Path, _, Options).
  573
  574
  575%!  http_location_by_id(+ID, -Location) is det.
  576%
  577%   True when Location represents the  HTTP   path  to which the handler
  578%   with identifier ID is bound. Handler   identifiers  are deduced from
  579%   the http_handler/3 declaration as follows:
  580%
  581%       $ Explicit id :
  582%       If a term id(ID) appears in the option list of the handler, ID
  583%       it is used and takes preference over using the predicate.
  584%       $ Using the handler predicate :
  585%       ID matches a handler if the predicate name matches ID.  The
  586%       ID may have a module qualification, e.g., `Module:Pred`
  587%
  588%   If the handler is declared with   a  pattern, e.g., root(user/User),
  589%   the location to access a  particular   _user_  may be accessed using
  590%   e.g., user('Bob'). The number of arguments to the compound term must
  591%   match the number of variables in the path pattern.
  592%
  593%   A plain atom ID can be used to   find  a handler with a pattern. The
  594%   returned location is the  path  up   to  the  first  variable, e.g.,
  595%   =|/user/|= in the example above.
  596%
  597%   User code is adviced to  use   http_link_to_id/3  which can also add
  598%   query parameters to  the  URL.  This   predicate  is  a  helper  for
  599%   http_link_to_id/3.
  600%
  601%   @error existence_error(http_handler_id, Id).
  602%   @see http_link_to_id/3 and the library(http/html_write) construct
  603%   location_by_id(ID) or its abbreviation `#(ID)`
  604
  605:- dynamic
  606    id_location_cache/4.                        % Id, Argv, Location, Segments
  607
  608http_location_by_id(ID, _) :-
  609    \+ ground(ID),
  610    !,
  611    instantiation_error(ID).
  612http_location_by_id(M:ID, Location) :-
  613    compound(ID),
  614    !,
  615    compound_name_arguments(ID, Name, Argv),
  616    http_location_by_id(M:Name, Argv, Location).
  617http_location_by_id(M:ID, Location) :-
  618    atom(ID),
  619    must_be(atom, M),
  620    !,
  621    http_location_by_id(M:ID, -, Location).
  622http_location_by_id(ID, Location) :-
  623    compound(ID),
  624    !,
  625    compound_name_arguments(ID, Name, Argv),
  626    http_location_by_id(Name, Argv, Location).
  627http_location_by_id(ID, Location) :-
  628    atom(ID),
  629    !,
  630    http_location_by_id(ID, -, Location).
  631http_location_by_id(ID, _) :-
  632    type_error(location_id, ID).
  633
  634http_location_by_id(ID, Argv, Location) :-
  635    id_location_cache(ID, Argv, Segments, Path),
  636    !,
  637    add_segments(Path, Segments, Location).
  638http_location_by_id(ID, Argv, Location) :-
  639    findall(t(Priority, ArgvP, Segments, Prefix),
  640            location_by_id(ID, Argv, ArgvP, Segments, Prefix, Priority),
  641            List),
  642    sort(1, >=, List, Sorted),
  643    (   Sorted = [t(_,ArgvP,Segments,Path)]
  644    ->  assert(id_location_cache(ID,ArgvP,Segments,Path)),
  645        Argv = ArgvP
  646    ;   List == []
  647    ->  existence_error(http_handler_id, ID)
  648    ;   List = [t(P0,ArgvP,Segments,Path),t(P1,_,_,_)|_]
  649    ->  (   P0 =:= P1
  650        ->  print_message(warning,
  651                          http_dispatch(ambiguous_id(ID, Sorted, Path)))
  652        ;   true
  653        ),
  654        assert(id_location_cache(ID,Argv,Segments,Path)),
  655        Argv = ArgvP
  656    ),
  657    add_segments(Path, Segments, Location).
  658
  659add_segments(Path0, [], Path) :-
  660    !,
  661    Path = Path0.
  662add_segments(Path0, Segments, Path) :-
  663    maplist(uri_encoded(path), Segments, Encoded),
  664    atomic_list_concat(Encoded, '/', Rest),
  665    atom_concat(Path0, Rest, Path).
  666
  667location_by_id(ID, -, _, [], Location, Priority) :-
  668    !,
  669    location_by_id_raw(ID, L0, _Segments, Priority),
  670    to_path(L0, Location).
  671location_by_id(ID, Argv, ArgvP, Segments, Location, Priority) :-
  672    location_by_id_raw(ID, L0, Segments, Priority),
  673    include(var, Segments, ArgvP),
  674    same_length(Argv, ArgvP),
  675    to_path(L0, Location).
  676
  677to_path(prefix(Path0), Path) :-         % old style prefix notation
  678    !,
  679    add_prefix(Path0, Path).
  680to_path(Path0, Path) :-
  681    atomic(Path0),                      % old style notation
  682    !,
  683    add_prefix(Path0, Path).
  684to_path(Spec, Path) :-                  % new style notation
  685    http_absolute_location(Spec, Path, []).
  686
  687add_prefix(P0, P) :-
  688    (   catch(setting(http:prefix, Prefix), _, fail),
  689        Prefix \== ''
  690    ->  atom_concat(Prefix, P0, P)
  691    ;   P = P0
  692    ).
  693
  694location_by_id_raw(ID, Location, Pattern, Priority) :-
  695    handler(Location, _, _, Options),
  696    option(id(ID), Options),
  697    option(priority(P0), Options, 0),
  698    option(segment_pattern(Pattern), Options, []),
  699    Priority is P0+1000.            % id(ID) takes preference over predicate
  700location_by_id_raw(ID, Location, Pattern, Priority) :-
  701    handler(Location, M:C, _, Options),
  702    option(priority(Priority), Options, 0),
  703    functor(C, PN, _),
  704    (   ID = M:PN
  705    ->  true
  706    ;   ID = PN
  707    ),
  708    option(segment_pattern(Pattern), Options, []).
  709
  710%!  http_link_to_id(+HandleID, +Parameters, -HREF)
  711%
  712%   HREF is a link on the local server   to a handler with given ID,
  713%   passing the given Parameters. This   predicate is typically used
  714%   to formulate a HREF that resolves   to  a handler implementing a
  715%   particular predicate. The code below provides a typical example.
  716%   The predicate user_details/1 returns a page with details about a
  717%   user from a given id. This predicate is registered as a handler.
  718%   The DCG user_link//1 renders a link   to  a user, displaying the
  719%   name and calling user_details/1  when   clicked.  Note  that the
  720%   location (root(user_details)) is irrelevant in this equation and
  721%   HTTP locations can thus be moved   freely  without breaking this
  722%   code fragment.
  723%
  724%     ```
  725%     :- http_handler(root(user_details), user_details, []).
  726%
  727%     user_details(Request) :-
  728%         http_parameters(Request,
  729%                         [ user_id(ID)
  730%                         ]),
  731%         ...
  732%
  733%     user_link(ID) -->
  734%         { user_name(ID, Name),
  735%           http_link_to_id(user_details, [id(ID)], HREF)
  736%         },
  737%         html(a([class(user), href(HREF)], Name)).
  738%     ```
  739%
  740%   @arg HandleID is either an atom, possibly module qualified
  741%   predicate or a compound term if the hander is defined using
  742%   a pattern.  See http_handler/3 and http_location_by_id/2.
  743%
  744%   @arg Parameters is one of
  745%
  746%     - path_postfix(File) to pass a single value as the last
  747%       segment of the HTTP location (path). This way of
  748%       passing a parameter is commonly used in REST APIs.
  749%
  750%       New code should use a path pattern in the handler declaration
  751%       and a term `HandleID(Arg, ...)`
  752%
  753%     - A list of search parameters for a =GET= request.
  754%
  755%   @see    http_location_by_id/2 and http_handler/3 for defining and
  756%           specifying handler IDs.
  757
  758http_link_to_id(HandleID, path_postfix(File), HREF) :-
  759    !,
  760    http_location_by_id(HandleID, HandlerLocation),
  761    uri_encoded(path, File, EncFile),
  762    directory_file_path(HandlerLocation, EncFile, Location),
  763    uri_data(path, Components, Location),
  764    uri_components(HREF, Components).
  765http_link_to_id(HandleID, Parameters, HREF) :-
  766    must_be(list, Parameters),
  767    http_location_by_id(HandleID, Location),
  768    (   Parameters == []
  769    ->  HREF = Location
  770    ;   uri_data(path, Components, Location),
  771        uri_query_components(String, Parameters),
  772        uri_data(search, Components, String),
  773        uri_components(HREF, Components)
  774    ).
  775
  776%!  http_reload_with_parameters(+Request, +Parameters, -HREF) is det.
  777%
  778%   Create a request on the current handler with replaced search
  779%   parameters.
  780
  781http_reload_with_parameters(Request, NewParams, HREF) :-
  782    memberchk(path(Path), Request),
  783    (   memberchk(search(Params), Request)
  784    ->  true
  785    ;   Params = []
  786    ),
  787    merge_options(NewParams, Params, AllParams),
  788    uri_query_components(Search, AllParams),
  789    uri_data(path, Data, Path),
  790    uri_data(search, Data, Search),
  791    uri_components(HREF, Data).
  792
  793
  794%       hook into html_write:attribute_value//1.
  795
  796:- multifile
  797    html_write:expand_attribute_value//1.  798
  799html_write:expand_attribute_value(location_by_id(ID)) -->
  800    { http_location_by_id(ID, Location) },
  801    html_write:html_quoted_attribute(Location).
  802html_write:expand_attribute_value(#(ID)) -->
  803    { http_location_by_id(ID, Location) },
  804    html_write:html_quoted_attribute(Location).
  805
  806
  807%!  authentication(+Options, +Request, -Fields) is det.
  808%
  809%   Verify  authentication  information.   If    authentication   is
  810%   requested through Options, demand it. The actual verification is
  811%   done by the multifile predicate http:authenticate/3. The library
  812%   http_authenticate.pl provides an implementation thereof.
  813%
  814%   @error  permission_error(access, http_location, Location)
  815%   @deprecated This hook predates the extensible request
  816%   expansion provided by http_request_expansion/2. New hooks should use
  817%   http_request_expansion/2 instead of http:authenticate/3.
  818
  819:- multifile
  820    http:authenticate/3.  821
  822authentication([], _, []).
  823authentication([authentication(Type)|Options], Request, Fields) :-
  824    !,
  825    (   http:authenticate(Type, Request, XFields)
  826    ->  append(XFields, More, Fields),
  827        authentication(Options, Request, More)
  828    ;   memberchk(path(Path), Request),
  829        permission_error(access, http_location, Path)
  830    ).
  831authentication([_|Options], Request, Fields) :-
  832    authentication(Options, Request, Fields).
  833
  834:- http_request_expansion(auth_expansion, 100).  835
  836%!  auth_expansion(+Request0, -Request, +Options) is semidet.
  837%
  838%   Connect  the  HTTP  authentication  infrastructure    by   means  of
  839%   http_request_expansion/2.
  840%
  841%   @see http:authenticate/3, http_digest.pl and http_authenticate.pl
  842
  843auth_expansion(Request0, Request, Options) :-
  844    authentication(Options, Request0, Extra),
  845    append(Extra, Request, Request0).
  846
  847%!  find_handler(+Path, -Action, -Options) is det.
  848%
  849%   Find the handler to call from Path.  Rules:
  850%
  851%           * If there is a matching handler, use this.
  852%           * If there are multiple prefix(Path) handlers, use the
  853%             longest.
  854%
  855%   If there is a handler for =|/dir/|=   and  the requested path is
  856%   =|/dir|=, find_handler/3 throws a  http_reply exception, causing
  857%   the wrapper to generate a 301 (Moved Permanently) reply.
  858%
  859%   @error  existence_error(http_location, Location)
  860%   @throw  http_reply(moved(Dir))
  861%   @tbd    Introduce automatic redirection to indexes here?
  862
  863find_handler(Path, Action, Options) :-
  864    path_tree(Tree),
  865    (   find_handler(Tree, Path, Action, Options),
  866        eval_condition(Options)
  867    ->  true
  868    ;   \+ sub_atom(Path, _, _, 0, /),
  869        atom_concat(Path, /, Dir),
  870        find_handler(Tree, Dir, Action, Options)
  871    ->  throw(http_reply(moved(Dir)))
  872    ;   throw(error(existence_error(http_location, Path), _))
  873    ).
  874
  875
  876find_handler([node(prefix(Prefix), PAction, POptions, Children)|_],
  877             Path, Action, Options) :-
  878    sub_atom(Path, 0, _, After, Prefix),
  879    !,
  880    (   option(hide_children(false), POptions, false),
  881        find_handler(Children, Path, Action, Options)
  882    ->  true
  883    ;   member(segment_pattern(Pattern, PatAction, PatOptions), POptions),
  884        copy_term(t(Pattern,PatAction,PatOptions), t(Pattern2,Action,Options)),
  885        match_segments(After, Path, Pattern2)
  886    ->  true
  887    ;   PAction \== nop
  888    ->  Action = PAction,
  889        path_info(After, Path, POptions, Options)
  890    ).
  891find_handler([node(Path, Action, Options, _)|_], Path, Action, Options) :- !.
  892find_handler([_|Tree], Path, Action, Options) :-
  893    find_handler(Tree, Path, Action, Options).
  894
  895path_info(0, _, Options,
  896          [prefix(true)|Options]) :- !.
  897path_info(After, Path, Options,
  898          [path_info(PathInfo),prefix(true)|Options]) :-
  899    sub_atom(Path, _, After, 0, PathInfo).
  900
  901match_segments(After, Path, [Var]) :-
  902    !,
  903    sub_atom(Path, _, After, 0, Var).
  904match_segments(After, Path, Pattern) :-
  905    sub_atom(Path, _, After, 0, PathInfo),
  906    split_string(PathInfo, "/", "", Segments),
  907    match_segment_pattern(Pattern, Segments).
  908
  909match_segment_pattern([], []).
  910match_segment_pattern([Var], Segments) :-
  911    !,
  912    atomic_list_concat(Segments, '/', Var).
  913match_segment_pattern([H0|T0], [H|T]) :-
  914    atom_string(H0, H),
  915    match_segment_pattern(T0, T).
  916
  917
  918eval_condition(Options) :-
  919    (   memberchk(condition(Cond), Options)
  920    ->  catch(Cond, E, (print_message(warning, E), fail))
  921    ;   true
  922    ).
  923
  924
  925%!  supports_method(+Request, +Options) is det.
  926%
  927%   Verify that the asked http method   is supported by the handler.
  928%   If not, raise an error that will be  mapped to a 405 page by the
  929%   http wrapper.
  930%
  931%   @error permission_error(http_method, Method, Location).
  932
  933supports_method(Request, Options) :-
  934    (   option(methods(Methods), Options)
  935    ->  (   Methods == '*'
  936        ->  true
  937        ;   memberchk(method(Method), Request),
  938            memberchk(Method, Methods)
  939        )
  940    ;   true
  941    ),
  942    !.
  943supports_method(Request, _Options) :-
  944    memberchk(path(Location), Request),
  945    memberchk(method(Method), Request),
  946    permission_error(http_method, Method, Location).
  947
  948
  949%!  action(+Action, +Request, +Options) is det.
  950%
  951%   Execute the action found.  Here we take care of the options
  952%   =time_limit=, =chunked= and =spawn=.
  953%
  954%   @error  goal_failed(Goal)
  955
  956action(Action, Request, Options) :-
  957    memberchk(chunked, Options),
  958    !,
  959    format('Transfer-encoding: chunked~n'),
  960    spawn_action(Action, Request, Options).
  961action(Action, Request, Options) :-
  962    spawn_action(Action, Request, Options).
  963
  964spawn_action(Action, Request, Options) :-
  965    option(spawn(Spawn), Options),
  966    !,
  967    spawn_options(Spawn, SpawnOption),
  968    http_spawn(time_limit_action(Action, Request, Options), SpawnOption).
  969spawn_action(Action, Request, Options) :-
  970    time_limit_action(Action, Request, Options).
  971
  972spawn_options([], []) :- !.
  973spawn_options(Pool, Options) :-
  974    atom(Pool),
  975    !,
  976    Options = [pool(Pool)].
  977spawn_options(List, List).
  978
  979time_limit_action(Action, Request, Options) :-
  980    (   option(time_limit(TimeLimit), Options),
  981        TimeLimit \== default
  982    ->  true
  983    ;   setting(http:time_limit, TimeLimit)
  984    ),
  985    number(TimeLimit),
  986    TimeLimit > 0,
  987    !,
  988    call_with_time_limit(TimeLimit, call_action(Action, Request, Options)).
  989time_limit_action(Action, Request, Options) :-
  990    call_action(Action, Request, Options).
  991
  992
  993%!  call_action(+Action, +Request, +Options)
  994%
  995%   @tbd    reply_file is normal call?
  996
  997call_action(reply_file(File, FileOptions), Request, _Options) :-
  998    !,
  999    http_reply_file(File, FileOptions, Request).
 1000call_action(Pred, Request, Options) :-
 1001    memberchk(path_info(PathInfo), Options),
 1002    !,
 1003    call_action(Pred, [path_info(PathInfo)|Request]).
 1004call_action(Pred, Request, _Options) :-
 1005    call_action(Pred, Request).
 1006
 1007call_action(Pred, Request) :-
 1008    (   call(Pred, Request)
 1009    ->  true
 1010    ;   extend(Pred, [Request], Goal),
 1011        throw(error(goal_failed(Goal), _))
 1012    ).
 1013
 1014extend(Var, _, Var) :-
 1015    var(Var),
 1016    !.
 1017extend(M:G0, Extra, M:G) :-
 1018    extend(G0, Extra, G).
 1019extend(G0, Extra, G) :-
 1020    G0 =.. List,
 1021    append(List, Extra, List2),
 1022    G =.. List2.
 1023
 1024%!  http_reply_file(+FileSpec, +Options, +Request) is det.
 1025%
 1026%   Options is a list of
 1027%
 1028%           * cache(+Boolean)
 1029%           If =true= (default), handle If-modified-since and send
 1030%           modification time.
 1031%
 1032%           * mime_type(+Type)
 1033%           Overrule mime-type guessing from the filename as
 1034%           provided by file_mime_type/2.
 1035%
 1036%           * static_gzip(+Boolean)
 1037%           If true (default =false=) and, in addition to the plain
 1038%           file, there is a =|.gz|= file that is not older than the
 1039%           plain file and the client acceps =gzip= encoding, send
 1040%           the compressed file with =|Transfer-encoding: gzip|=.
 1041%
 1042%           * unsafe(+Boolean)
 1043%           If =false= (default), validate that FileSpec does not
 1044%           contain references to parent directories.  E.g.,
 1045%           specifications such as =|www('../../etc/passwd')|= are
 1046%           not allowed.
 1047%
 1048%           * headers(+List)
 1049%           Provides additional reply-header fields, encoded as a
 1050%           list of _|Field(Value)|_.
 1051%
 1052%   If caching is not disabled,  it   processes  the request headers
 1053%   =|If-modified-since|= and =Range=.
 1054%
 1055%   @throws http_reply(not_modified)
 1056%   @throws http_reply(file(MimeType, Path))
 1057
 1058http_reply_file(File, Options, Request) :-
 1059    http_safe_file(File, Options),
 1060    absolute_file_name(File, Path,
 1061                       [ access(read)
 1062                       ]),
 1063    (   option(cache(true), Options, true)
 1064    ->  (   memberchk(if_modified_since(Since), Request),
 1065            time_file(Path, Time),
 1066            catch(http_timestamp(Time, Since), _, fail)
 1067        ->  throw(http_reply(not_modified))
 1068        ;   true
 1069        ),
 1070        (   memberchk(range(Range), Request)
 1071        ->  Reply = file(Type, Path, Range)
 1072        ;   option(static_gzip(true), Options),
 1073            accepts_encoding(Request, gzip),
 1074            file_name_extension(Path, gz, PathGZ),
 1075            access_file(PathGZ, read),
 1076            time_file(PathGZ, TimeGZ),
 1077            time_file(Path, Time),
 1078            TimeGZ >= Time
 1079        ->  Reply = gzip_file(Type, PathGZ)
 1080        ;   Reply = file(Type, Path)
 1081        )
 1082    ;   Reply = tmp_file(Type, Path)
 1083    ),
 1084    (   option(mime_type(MediaType), Options)
 1085    ->  file_content_type(Path, MediaType, Type)
 1086    ;   file_content_type(Path, Type)
 1087    ->  true
 1088    ;   Type = text/plain           % fallback type
 1089    ),
 1090    option(headers(Headers), Options, []),
 1091    throw(http_reply(Reply, Headers)).
 1092
 1093accepts_encoding(Request, Enc) :-
 1094    memberchk(accept_encoding(Accept), Request),
 1095    split_string(Accept, ",", " ", Parts),
 1096    member(Part, Parts),
 1097    split_string(Part, ";", " ", [EncS|_]),
 1098    atom_string(Enc, EncS).
 1099
 1100
 1101%!  http_safe_file(+FileSpec, +Options) is det.
 1102%
 1103%   True if FileSpec is considered _safe_.  If   it  is  an atom, it
 1104%   cannot  be  absolute  and  cannot   have  references  to  parent
 1105%   directories. If it is of the   form  alias(Sub), than Sub cannot
 1106%   have references to parent directories.
 1107%
 1108%   @error instantiation_error
 1109%   @error permission_error(read, file, FileSpec)
 1110
 1111http_safe_file(File, _) :-
 1112    var(File),
 1113    !,
 1114    instantiation_error(File).
 1115http_safe_file(_, Options) :-
 1116    option(unsafe(true), Options, false),
 1117    !.
 1118http_safe_file(File, _) :-
 1119    http_safe_file(File).
 1120
 1121http_safe_file(File) :-
 1122    compound(File),
 1123    functor(File, _, 1),
 1124    !,
 1125    arg(1, File, Name),
 1126    safe_name(Name, File).
 1127http_safe_file(Name) :-
 1128    (   is_absolute_file_name(Name)
 1129    ->  permission_error(read, file, Name)
 1130    ;   true
 1131    ),
 1132    safe_name(Name, Name).
 1133
 1134safe_name(Name, _) :-
 1135    must_be(atom, Name),
 1136    prolog_to_os_filename(FileName, Name),
 1137    \+ unsafe_name(FileName),
 1138    !.
 1139safe_name(_, Spec) :-
 1140    permission_error(read, file, Spec).
 1141
 1142unsafe_name(Name) :- Name == '..'.
 1143unsafe_name(Name) :- sub_atom(Name, 0, _, _, '../').
 1144unsafe_name(Name) :- sub_atom(Name, _, _, _, '/../').
 1145unsafe_name(Name) :- sub_atom(Name, _, _, 0, '/..').
 1146
 1147
 1148%!  http_redirect(+How, +To, +Request) is det.
 1149%
 1150%   Redirect to a new  location.  The   argument  order,  using  the
 1151%   Request as last argument, allows for  calling this directly from
 1152%   the handler declaration:
 1153%
 1154%       ```
 1155%       :- http_handler(root(.),
 1156%                       http_redirect(moved, myapp('index.html')),
 1157%                       []).
 1158%       ```
 1159%
 1160%   @param How is one of `moved`, `moved_temporary` or `see_other`
 1161%   @param To is an atom, a aliased path as defined by
 1162%   http_absolute_location/3. or a term location_by_id(Id) or its
 1163%   abbreviations `#(Id)` or `#(Id)+Parameters`. If To is not absolute,
 1164%   it is resolved relative to the current location.
 1165
 1166http_redirect(How, To, Request) :-
 1167    must_be(oneof([moved, moved_temporary, see_other]), How),
 1168    must_be(ground, To),
 1169    (   id_location(To, URL)
 1170    ->  true
 1171    ;   memberchk(path(Base), Request),
 1172        http_absolute_location(To, URL, [relative_to(Base)])
 1173    ),
 1174    Term =.. [How,URL],
 1175    throw(http_reply(Term)).
 1176
 1177id_location(location_by_id(Id), URL) :-
 1178    http_location_by_id(Id, URL).
 1179id_location(#(Id), URL) :-
 1180    http_location_by_id(Id, URL).
 1181id_location(#(Id)+Parameters, URL) :-
 1182    http_link_to_id(Id, Parameters, URL).
 1183
 1184
 1185%!  http_404(+Options, +Request) is det.
 1186%
 1187%   Reply using an "HTTP  404  not   found"  page.  This  handler is
 1188%   intended as fallback handler  for   _prefix_  handlers.  Options
 1189%   processed are:
 1190%
 1191%       * index(Location)
 1192%       If there is no path-info, redirect the request to
 1193%       Location using http_redirect/3.
 1194%
 1195%   @error http_reply(not_found(Path))
 1196
 1197http_404(Options, Request) :-
 1198    option(index(Index), Options),
 1199    \+ ( option(path_info(PathInfo), Request),
 1200         PathInfo \== ''
 1201       ),
 1202    !,
 1203    http_redirect(moved, Index, Request).
 1204http_404(_Options, Request) :-
 1205    option(path(Path), Request),
 1206    !,
 1207    throw(http_reply(not_found(Path))).
 1208http_404(_Options, Request) :-
 1209    domain_error(http_request, Request).
 1210
 1211
 1212%!  http_switch_protocol(:Goal, +Options)
 1213%
 1214%   Send an =|"HTTP 101 Switching  Protocols"|= reply. After sending
 1215%   the  reply,  the  HTTP  library    calls   call(Goal,  InStream,
 1216%   OutStream), where InStream and OutStream are  the raw streams to
 1217%   the HTTP client. This allows the communication to continue using
 1218%   an an alternative protocol.
 1219%
 1220%   If Goal fails or throws an exception,  the streams are closed by
 1221%   the server. Otherwise  Goal  is   responsible  for  closing  the
 1222%   streams. Note that  Goal  runs  in   the  HTTP  handler  thread.
 1223%   Typically, the handler should be   registered  using the =spawn=
 1224%   option if http_handler/3 or Goal   must  call thread_create/3 to
 1225%   allow the HTTP worker to return to the worker pool.
 1226%
 1227%   The streams use binary  (octet)  encoding   and  have  their I/O
 1228%   timeout set to the server  timeout   (default  60  seconds). The
 1229%   predicate set_stream/2 can  be  used   to  change  the encoding,
 1230%   change or cancel the timeout.
 1231%
 1232%   This predicate interacts with the server  library by throwing an
 1233%   exception.
 1234%
 1235%   The following options are supported:
 1236%
 1237%     - header(+Headers)
 1238%     Backward compatible.  Use headers(+Headers).
 1239%     - headers(+Headers)
 1240%     Additional headers send with the reply. Each header takes the
 1241%     form Name(Value).
 1242
 1243%       @throws http_reply(switch_protocol(Goal, Options))
 1244
 1245http_switch_protocol(Goal, Options) :-
 1246    throw(http_reply(switching_protocols(Goal, Options))).
 1247
 1248
 1249                 /*******************************
 1250                 *        PATH COMPILATION      *
 1251                 *******************************/
 1252
 1253%!  path_tree(-Tree) is det.
 1254%
 1255%   Compile paths into  a  tree.  The   treee  is  multi-rooted  and
 1256%   represented as a list of nodes, where each node has the form:
 1257%
 1258%           node(PathOrPrefix, Action, Options, Children)
 1259%
 1260%   The tree is a potentially complicated structure. It is cached in
 1261%   a global variable. Note that this   cache is per-thread, so each
 1262%   worker thread holds a copy of  the   tree.  If handler facts are
 1263%   changed the _generation_ is  incremented using next_generation/0
 1264%   and each worker thread will  re-compute   the  tree  on the next
 1265%   ocasion.
 1266
 1267path_tree(Tree) :-
 1268    current_generation(G),
 1269    nb_current(http_dispatch_tree, G-Tree),
 1270    !. % Avoid existence error
 1271path_tree(Tree) :-
 1272    path_tree_nocache(Tree),
 1273    current_generation(G),
 1274    nb_setval(http_dispatch_tree, G-Tree).
 1275
 1276path_tree_nocache(Tree) :-
 1277    findall(Prefix, prefix_handler(Prefix, _, _, _), Prefixes0),
 1278    sort(Prefixes0, Prefixes),
 1279    prefix_tree(Prefixes, [], PTree),
 1280    prefix_options(PTree, [], OPTree),
 1281    add_paths_tree(OPTree, Tree).
 1282
 1283prefix_handler(Prefix, Action, Options, Priority-PLen) :-
 1284    handler(Spec, Action, true, Options),
 1285    (   memberchk(priority(Priority), Options)
 1286    ->  true
 1287    ;   Priority = 0
 1288    ),
 1289    (   memberchk(segment_pattern(Pattern), Options)
 1290    ->  length(Pattern, PLen)
 1291    ;   PLen = 0
 1292    ),
 1293    Error = error(existence_error(http_alias,_),_),
 1294    catch(http_absolute_location(Spec, Prefix, []), Error,
 1295          (   print_message(warning, Error),
 1296              fail
 1297          )).
 1298
 1299%!  prefix_tree(PrefixList, +Tree0, -Tree)
 1300%
 1301%   @param Tree     list(Prefix-list(Children))
 1302
 1303prefix_tree([], Tree, Tree).
 1304prefix_tree([H|T], Tree0, Tree) :-
 1305    insert_prefix(H, Tree0, Tree1),
 1306    prefix_tree(T, Tree1, Tree).
 1307
 1308insert_prefix(Prefix, Tree0, Tree) :-
 1309    select(P-T, Tree0, Tree1),
 1310    sub_atom(Prefix, 0, _, _, P),
 1311    !,
 1312    insert_prefix(Prefix, T, T1),
 1313    Tree = [P-T1|Tree1].
 1314insert_prefix(Prefix, Tree, [Prefix-[]|Tree]).
 1315
 1316
 1317%!  prefix_options(+PrefixTree, +DefOptions, -OptionTree)
 1318%
 1319%   Generate the option-tree for all prefix declarations.
 1320%
 1321%   @tbd    What to do if there are more?
 1322
 1323prefix_options([], _, []).
 1324prefix_options([Prefix-C|T0], DefOptions,
 1325               [node(prefix(Prefix), Action, PrefixOptions, Children)|T]) :-
 1326    findall(h(A,O,P), prefix_handler(Prefix,A,O,P), Handlers),
 1327    sort(3, >=, Handlers, Handlers1),
 1328    Handlers1 = [h(_,_,P0)|_],
 1329    same_priority_handlers(Handlers1, P0, Same),
 1330    option_patterns(Same, SegmentPatterns, Action),
 1331    last(Same, h(_, Options0, _-_)),
 1332    merge_options(Options0, DefOptions, Options),
 1333    append(SegmentPatterns, Options, PrefixOptions),
 1334    exclude(no_inherit, Options, InheritOpts),
 1335    prefix_options(C, InheritOpts, Children),
 1336    prefix_options(T0, DefOptions, T).
 1337
 1338no_inherit(id(_)).
 1339no_inherit('$extract'(_)).
 1340
 1341same_priority_handlers([H|T0], P, [H|T]) :-
 1342    H = h(_,_,P0-_),
 1343    P = P0-_,
 1344    !,
 1345    same_priority_handlers(T0, P, T).
 1346same_priority_handlers(_, _, []).
 1347
 1348option_patterns([], [], nop).
 1349option_patterns([h(A,_,_-0)|_], [], A) :-
 1350    !.
 1351option_patterns([h(A,O,_)|T0], [segment_pattern(P,A,O)|T], AF) :-
 1352    memberchk(segment_pattern(P), O),
 1353    option_patterns(T0, T, AF).
 1354
 1355
 1356%!  add_paths_tree(+OPTree, -Tree) is det.
 1357%
 1358%   Add the plain paths.
 1359
 1360add_paths_tree(OPTree, Tree) :-
 1361    findall(path(Path, Action, Options),
 1362            plain_path(Path, Action, Options),
 1363            Triples),
 1364    add_paths_tree(Triples, OPTree, Tree).
 1365
 1366add_paths_tree([], Tree, Tree).
 1367add_paths_tree([path(Path, Action, Options)|T], Tree0, Tree) :-
 1368    add_path_tree(Path, Action, Options, [], Tree0, Tree1),
 1369    add_paths_tree(T, Tree1, Tree).
 1370
 1371
 1372%!  plain_path(-Path, -Action, -Options) is nondet.
 1373%
 1374%   True if {Path,Action,Options} is registered and  Path is a plain
 1375%   (i.e. not _prefix_) location.
 1376
 1377plain_path(Path, Action, Options) :-
 1378    handler(Spec, Action, false, Options),
 1379    catch(http_absolute_location(Spec, Path, []), E,
 1380          (print_message(error, E), fail)).
 1381
 1382
 1383%!  add_path_tree(+Path, +Action, +Options, +Tree0, -Tree) is det.
 1384%
 1385%   Add a path to a tree. If a  handler for the same path is already
 1386%   defined, the one with the highest   priority or the latest takes
 1387%   precedence.
 1388
 1389add_path_tree(Path, Action, Options0, DefOptions, [],
 1390              [node(Path, Action, Options, [])]) :-
 1391    !,
 1392    merge_options(Options0, DefOptions, Options).
 1393add_path_tree(Path, Action, Options, _,
 1394              [node(prefix(Prefix), PA, DefOptions, Children0)|RestTree],
 1395              [node(prefix(Prefix), PA, DefOptions, Children)|RestTree]) :-
 1396    sub_atom(Path, 0, _, _, Prefix),
 1397    !,
 1398    delete(DefOptions, id(_), InheritOpts),
 1399    add_path_tree(Path, Action, Options, InheritOpts, Children0, Children).
 1400add_path_tree(Path, Action, Options1, DefOptions, [H0|T], [H|T]) :-
 1401    H0 = node(Path, _, Options2, _),
 1402    option(priority(P1), Options1, 0),
 1403    option(priority(P2), Options2, 0),
 1404    P1 >= P2,
 1405    !,
 1406    merge_options(Options1, DefOptions, Options),
 1407    H = node(Path, Action, Options, []).
 1408add_path_tree(Path, Action, Options, DefOptions, [H|T0], [H|T]) :-
 1409    add_path_tree(Path, Action, Options, DefOptions, T0, T).
 1410
 1411
 1412                 /*******************************
 1413                 *            MESSAGES          *
 1414                 *******************************/
 1415
 1416:- multifile
 1417    prolog:message/3. 1418
 1419prolog:message(http_dispatch(ambiguous_id(ID, _List, Selected))) -->
 1420    [ 'HTTP dispatch: ambiguous handler ID ~q (selected ~q)'-[ID, Selected]
 1421    ].
 1422
 1423
 1424                 /*******************************
 1425                 *            XREF              *
 1426                 *******************************/
 1427
 1428:- multifile
 1429    prolog:meta_goal/2. 1430:- dynamic
 1431    prolog:meta_goal/2. 1432
 1433prolog:meta_goal(http_handler(_, G, _), [G+1]).
 1434prolog:meta_goal(http_current_handler(_, G), [G+1]).
 1435
 1436
 1437                 /*******************************
 1438                 *             EDIT             *
 1439                 *******************************/
 1440
 1441% Allow edit(Location) to edit the implementation for an HTTP location.
 1442
 1443:- multifile
 1444    prolog_edit:locate/3. 1445
 1446prolog_edit:locate(Path, Spec, Location) :-
 1447    atom(Path),
 1448    sub_atom(Path, 0, _, _, /),
 1449    Pred = _M:_H,
 1450    catch(http_current_handler(Path, Pred), _, fail),
 1451    closure_name_arity(Pred, 1, PI),
 1452    prolog_edit:locate(PI, Spec, Location).
 1453
 1454closure_name_arity(M:Term, Extra, M:Name/Arity) :-
 1455    !,
 1456    callable(Term),
 1457    functor(Term, Name, Arity0),
 1458    Arity is Arity0 + Extra.
 1459closure_name_arity(Term, Extra, Name/Arity) :-
 1460    callable(Term),
 1461    functor(Term, Name, Arity0),
 1462    Arity is Arity0 + Extra.
 1463
 1464
 1465                 /*******************************
 1466                 *        CACHE CLEANUP         *
 1467                 *******************************/
 1468
 1469:- listen(settings(changed(http:prefix, _, _)),
 1470          next_generation). 1471
 1472:- multifile
 1473    user:message_hook/3. 1474:- dynamic
 1475    user:message_hook/3. 1476
 1477user:message_hook(make(done(Reload)), _Level, _Lines) :-
 1478    Reload \== [],
 1479    next_generation,
 1480    fail