http_dispatch.pl

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