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