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