View source with raw 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-2015, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(http_dispatch,
   37          [ http_dispatch/1,            % +Request
   38            http_handler/3,             % +Path, +Predicate, +Options
   39            http_delete_handler/1,      % +Path
   40            http_reply_file/3,          % +File, +Options, +Request
   41            http_redirect/3,            % +How, +Path, +Request
   42            http_404/2,                 % +Options, +Request
   43            http_switch_protocol/2,     % :Goal, +Options
   44            http_current_handler/2,     % ?Path, ?Pred
   45            http_current_handler/3,     % ?Path, ?Pred, -Options
   46            http_location_by_id/2,      % +ID, -Location
   47            http_link_to_id/3,          % +ID, +Parameters, -HREF
   48            http_reload_with_parameters/3, % +Request, +Parameters, -HREF
   49            http_safe_file/2            % +Spec, +Options
   50          ]).   51:- use_module(library(option)).   52:- use_module(library(lists)).   53:- use_module(library(time)).   54:- use_module(library(error)).   55:- use_module(library(settings)).   56:- use_module(library(uri)).   57:- use_module(library(apply)).   58:- use_module(library(http/mimetype)).   59:- use_module(library(http/http_path)).   60:- use_module(library(http/http_header)).   61:- use_module(library(http/thread_httpd)).   62
   63:- predicate_options(http_404/2, 1, [index(any)]).   64:- predicate_options(http_reply_file/3, 2,
   65                     [ cache(boolean),
   66                       mime_type(any),
   67                       static_gzip(boolean),
   68                       pass_to(http_safe_file/2, 2),
   69                       headers(list)
   70                     ]).   71:- predicate_options(http_safe_file/2, 2, [unsafe(boolean)]).   72:- predicate_options(http_switch_protocol/2, 2, []).

Dispatch requests in the HTTP server

This module can be placed between http_wrapper.pl and the application code to associate HTTP locations to predicates that serve the pages. In addition, it associates parameters with locations that deal with timeout handling and user authentication. The typical setup is:

server(Port, Options) :-
        http_server(http_dispatch,
                    [ port(Port)
                    | Options
                    ]).

:- http_handler('/index.html', write_index, []).

write_index(Request) :-
        ...

*/

   95:- setting(http:time_limit, nonneg, 300,
   96           'Time limit handling a single query (0=infinite)').
 http_handler(+Path, :Closure, +Options) is det
Register Closure as a handler for HTTP requests. Path is a specification as provided by http_path.pl. If an HTTP request arrives at the server that matches Path, Closure is called with one extra argument: the parsed HTTP request. Options is a list containing the following options:
authentication(+Type)
Demand authentication. Authentication methods are pluggable. The library http_authenticate.pl provides a plugin for user/password based Basic HTTP authentication.
chunked
Use Transfer-encoding: chunked if the client allows for it.
content_type(+Term)
Specifies the content-type of the reply. This value is currently not used by this library. It enhances the reflexive capabilities of this library through http_current_handler/3.
id(+Term)
Identifier of the handler. The default identifier is the predicate name. Used by http_location_by_id/2.
hide_children(+Bool)
If true on a prefix-handler (see prefix), possible children are masked. This can be used to (temporary) overrule part of the tree.
method(+Method)
Declare that the handler processes Method. This is equivalent to methods([Method]). Using method(*) allows for all methods.
methods(+ListOfMethods)
Declare that the handler processes all of the given methods. If this option appears multiple times, the methods are combined.
prefix
Call Pred on any location that is a specialisation of Path. If multiple handlers match, the one with the longest path is used. Options defined with a prefix handler are the default options for paths that start with this prefix. Note that the handler acts as a fallback handler for the tree below it:
:- http_handler(/, http_404([index('index.html')]),
                [spawn(my_pool),prefix]).
priority(+Integer)
If two handlers handle the same path, the one with the highest priority is used. If equal, the last registered is used. Please be aware that the order of clauses in multifile predicates can change due to reloading files. The default priority is 0 (zero).
spawn(+SpawnOptions)
Run the handler in a seperate thread. If SpawnOptions is an atom, it is interpreted as a thread pool name (see create_thread_pool/3). Otherwise the options are passed to http_spawn/2 and from there to thread_create/3. These options are typically used to set the stack limits.
time_limit(+Spec)
One of infinite, default or a positive number (seconds). If default, the value from the setting http:time_limit is taken. The default of this setting is 300 (5 minutes). See setting/2.

Note that http_handler/3 is normally invoked as a directive and processed using term-expansion. Using term-expansion ensures proper update through make/0 when the specification is modified. We do not expand when the cross-referencer is running to ensure proper handling of the meta-call.

Errors
- existence_error(http_location, Location)
See also
- http_reply_file/3 and http_redirect/3 are generic handlers to serve files and achieve redirects.
  185:- dynamic handler/4.                   % Path, Action, IsPrefix, Options
  186:- multifile handler/4.  187:- dynamic generation/1.  188
  189:- meta_predicate
  190    http_handler(+, :, +),
  191    http_current_handler(?, :),
  192    http_current_handler(?, :, ?),
  193    http_switch_protocol(2, +).  194
  195http_handler(Path, Pred, Options) :-
  196    strip_module(Pred, M, P),
  197    compile_handler(Path, M:P, Options, Clause),
  198    next_generation,
  199    assert(Clause).
  200
  201:- multifile
  202    system:term_expansion/2.  203
  204system:term_expansion((:- http_handler(Path, Pred, Options)), Clause) :-
  205    \+ current_prolog_flag(xref, true),
  206    prolog_load_context(module, M),
  207    compile_handler(Path, M:Pred, Options, Clause),
  208    next_generation.
 http_delete_handler(+Spec) is det
Delete handler for Spec. Typically, this should only be used for handlers that are registered dynamically. Spec is one of:
id(Id)
Delete a handler with the given id. The default id is the handler-predicate-name.
path(Path)
Delete handler that serves the given path.
  223http_delete_handler(id(Id)) :-
  224    !,
  225    clause(handler(_Path, _:Pred, _, Options), true, Ref),
  226    functor(Pred, DefID, _),
  227    option(id(Id0), Options, DefID),
  228    Id == Id0,
  229    erase(Ref),
  230    next_generation.
  231http_delete_handler(path(Path)) :-
  232    !,
  233    retractall(handler(Path, _Pred, _, _Options)),
  234    next_generation.
  235http_delete_handler(Path) :-
  236    http_delete_handler(path(Path)).
 next_generation is det
 current_generation(-G) is det
Increment the generation count.
  244next_generation :-
  245    retractall(id_location_cache(_,_)),
  246    with_mutex(http_dispatch, next_generation_unlocked).
  247
  248next_generation_unlocked :-
  249    retract(generation(G0)),
  250    !,
  251    G is G0 + 1,
  252    assert(generation(G)).
  253next_generation_unlocked :-
  254    assert(generation(1)).
  255
  256current_generation(G) :-
  257    with_mutex(http_dispatch, generation(G)),
  258    !.
  259current_generation(0).
 compile_handler(+Path, :Pred, +Options) is det
Compile a handler specification. For now we this is a no-op, but in the feature can make this more efficiently, especially in the presence of one or multiple prefix declarations. We can also use this to detect conflicts.
  269compile_handler(prefix(Path), Pred, Options,
  270                http_dispatch:handler(Path, Pred, true, Options)) :-
  271    !,
  272    check_path(Path, Path1),
  273    print_message(warning, http_dispatch(prefix(Path1))).
  274compile_handler(Path, Pred, Options0,
  275                http_dispatch:handler(Path1, Pred, IsPrefix, Options)) :-
  276    check_path(Path, Path1),
  277    (   select(prefix, Options0, Options1)
  278    ->  IsPrefix = true
  279    ;   IsPrefix = false,
  280        Options1 = Options0
  281    ),
  282    combine_methods(Options1, Options).
 combine_methods(+OptionsIn, -Options) is det
Combine method(M) and methods(MList) options into a single methods(MList) option.
  289combine_methods(Options0, Options) :-
  290    collect_methods(Options0, Options1, Methods),
  291    (   Methods == []
  292    ->  Options = Options0
  293    ;   append(Methods, Flat),
  294        sort(Flat, Unique),
  295        (   memberchk('*', Unique)
  296        ->  Final = '*'
  297        ;   Final = Unique
  298        ),
  299        Options = [methods(Final)|Options1]
  300    ).
  301
  302collect_methods([], [], []).
  303collect_methods([method(M)|T0], T, [[M]|TM]) :-
  304    !,
  305    (   M == '*'
  306    ->  true
  307    ;   must_be_method(M)
  308    ),
  309    collect_methods(T0, T, TM).
  310collect_methods([methods(M)|T0], T, [M|TM]) :-
  311    !,
  312    must_be(list, M),
  313    maplist(must_be_method, M),
  314    collect_methods(T0, T, TM).
  315collect_methods([H|T0], [H|T], TM) :-
  316    !,
  317    collect_methods(T0, T, TM).
  318
  319must_be_method(M) :-
  320    must_be(atom, M),
  321    (   method(M)
  322    ->  true
  323    ;   domain_error(http_method, M)
  324    ).
  325
  326method(get).
  327method(put).
  328method(head).
  329method(post).
  330method(delete).
  331method(patch).
  332method(options).
  333method(trace).
 check_path(+PathSpecIn, -PathSpecOut) is det
Validate the given path specification. We want one of

Similar to absolute_file_name/3, Relative can be a term Component/Component/...

Errors
- domain_error, type_error
See also
- http_absolute_location/3
  349check_path(Path, Path) :-
  350    atom(Path),
  351    !,
  352    (   sub_atom(Path, 0, _, _, /)
  353    ->  true
  354    ;   domain_error(absolute_http_location, Path)
  355    ).
  356check_path(Alias, AliasOut) :-
  357    compound(Alias),
  358    Alias =.. [Name, Relative],
  359    !,
  360    to_atom(Relative, Local),
  361    (   sub_atom(Local, 0, _, _, /)
  362    ->  domain_error(relative_location, Relative)
  363    ;   AliasOut =.. [Name, Local]
  364    ).
  365check_path(PathSpec, _) :-
  366    type_error(path_or_alias, PathSpec).
  367
  368to_atom(Atom, Atom) :-
  369    atom(Atom),
  370    !.
  371to_atom(Path, Atom) :-
  372    phrase(path_to_list(Path), Components),
  373    !,
  374    atomic_list_concat(Components, '/', Atom).
  375to_atom(Path, _) :-
  376    ground(Path),
  377    !,
  378    type_error(relative_location, Path).
  379to_atom(Path, _) :-
  380    instantiation_error(Path).
  381
  382path_to_list(Var) -->
  383    { var(Var),
  384      !,
  385      fail
  386    }.
  387path_to_list(A/B) -->
  388    path_to_list(A),
  389    path_to_list(B).
  390path_to_list(Atom) -->
  391    { atom(Atom) },
  392    [Atom].
 http_dispatch(Request) is det
Dispatch a Request using http_handler/3 registrations.
  400http_dispatch(Request) :-
  401    memberchk(path(Path), Request),
  402    find_handler(Path, Pred, Options),
  403    supports_method(Request, Options),
  404    authentication(Options, Request, Fields),
  405    append(Fields, Request, AuthRequest),
  406    action(Pred, AuthRequest, Options).
 http_current_handler(+Location, :Closure) is semidet
http_current_handler(-Location, :Closure) is nondet
True if Location is handled by Closure.
  414http_current_handler(Path, Closure) :-
  415    atom(Path),
  416    !,
  417    path_tree(Tree),
  418    find_handler(Tree, Path, Closure, _).
  419http_current_handler(Path, M:C) :-
  420    handler(Spec, M:C, _, _),
  421    http_absolute_location(Spec, Path, []).
 http_current_handler(+Location, :Closure, -Options) is semidet
http_current_handler(?Location, :Closure, ?Options) is nondet
Resolve the current handler and options to execute it.
  428http_current_handler(Path, Closure, Options) :-
  429    atom(Path),
  430    !,
  431    path_tree(Tree),
  432    find_handler(Tree, Path, Closure, Options).
  433http_current_handler(Path, M:C, Options) :-
  434    handler(Spec, M:C, _, _),
  435    http_absolute_location(Spec, Path, []),
  436    path_tree(Tree),
  437    find_handler(Tree, Path, _, Options).
 http_location_by_id(+ID, -Location) is det
Find the HTTP Location of handler with ID. If the setting (see setting/2) http:prefix is active, Location is the handler location prefixed with the prefix setting. Handler IDs can be specified in two ways:
id(ID)
If this appears in the option list of the handler, this it is used and takes preference over using the predicate.
M:PredName
The module-qualified name of the predicate.
PredName
The unqualified name of the predicate.
Errors
- existence_error(http_handler_id, Id).
deprecated
- The predicate http_link_to_id/3 provides the same functionality with the option to add query parameters or a path parameter.
  460:- dynamic
  461    id_location_cache/2.  462
  463http_location_by_id(ID, Location) :-
  464    must_be(ground, ID),
  465    id_location_cache(ID, L0),
  466    !,
  467    Location = L0.
  468http_location_by_id(ID, Location) :-
  469    findall(P-L, location_by_id(ID, L, P), List),
  470    keysort(List, RevSorted),
  471    reverse(RevSorted, Sorted),
  472    (   Sorted = [_-One]
  473    ->  assert(id_location_cache(ID, One)),
  474        Location = One
  475    ;   List == []
  476    ->  existence_error(http_handler_id, ID)
  477    ;   List = [P0-Best,P1-_|_]
  478    ->  (   P0 == P1
  479        ->  print_message(warning,
  480                          http_dispatch(ambiguous_id(ID, Sorted, Best)))
  481        ;   true
  482        ),
  483        assert(id_location_cache(ID, Best)),
  484        Location = Best
  485    ).
  486
  487location_by_id(ID, Location, Priority) :-
  488    location_by_id_raw(ID, L0, Priority),
  489    to_path(L0, Location).
  490
  491to_path(prefix(Path0), Path) :-        % old style prefix notation
  492    !,
  493    add_prefix(Path0, Path).
  494to_path(Path0, Path) :-
  495    atomic(Path0),                 % old style notation
  496    !,
  497    add_prefix(Path0, Path).
  498to_path(Spec, Path) :-                  % new style notation
  499    http_absolute_location(Spec, Path, []).
  500
  501add_prefix(P0, P) :-
  502    (   catch(setting(http:prefix, Prefix), _, fail),
  503        Prefix \== ''
  504    ->  atom_concat(Prefix, P0, P)
  505    ;   P = P0
  506    ).
  507
  508location_by_id_raw(ID, Location, Priority) :-
  509    handler(Location, _, _, Options),
  510    option(id(ID), Options),
  511    option(priority(P0), Options, 0),
  512    Priority is P0+1000.            % id(ID) takes preference over predicate
  513location_by_id_raw(ID, Location, Priority) :-
  514    handler(Location, M:C, _, Options),
  515    option(priority(Priority), Options, 0),
  516    functor(C, PN, _),
  517    (   ID = M:PN
  518    ;   ID = PN
  519    ),
  520    !.
 http_link_to_id(+HandleID, +Parameters, -HREF)
HREF is a link on the local server to a handler with given ID, passing the given Parameters. This predicate is typically used to formulate a HREF that resolves to a handler implementing a particular predicate. The code below provides a typical example. The predicate user_details/1 returns a page with details about a user from a given id. This predicate is registered as a handler. The DCG user_link//1 renders a link to a user, displaying the name and calling user_details/1 when clicked. Note that the location (root(user_details)) is irrelevant in this equation and HTTP locations can thus be moved freely without breaking this code fragment.
:- http_handler(root(user_details), user_details, []).

user_details(Request) :-
    http_parameters(Request,
                    [ user_id(ID)
                    ]),
    ...

user_link(ID) -->
    { user_name(ID, Name),
      http_link_to_id(user_details, [id(ID)], HREF)
    },
    html(a([class(user), href(HREF)], Name)).
Arguments:
Parameters- is one of
  • path_postfix(File) to pass a single value as the last segment of the HTTP location (path). This way of passing a parameter is commonly used in REST APIs.
  • A list of search parameters for a GET request.
See also
- http_location_by_id/2 and http_handler/3 for defining and specifying handler IDs.
  563http_link_to_id(HandleID, path_postfix(File), HREF) :-
  564    !,
  565    http_location_by_id(HandleID, HandlerLocation),
  566    uri_encoded(path, File, EncFile),
  567    directory_file_path(HandlerLocation, EncFile, Location),
  568    uri_data(path, Components, Location),
  569    uri_components(HREF, Components).
  570http_link_to_id(HandleID, Parameters, HREF) :-
  571    must_be(list, Parameters),
  572    http_location_by_id(HandleID, Location),
  573    uri_data(path, Components, Location),
  574    uri_query_components(String, Parameters),
  575    uri_data(search, Components, String),
  576    uri_components(HREF, Components).
 http_reload_with_parameters(+Request, +Parameters, -HREF) is det
Create a request on the current handler with replaced search parameters.
  583http_reload_with_parameters(Request, NewParams, HREF) :-
  584    memberchk(path(Path), Request),
  585    (   memberchk(search(Params), Request)
  586    ->  true
  587    ;   Params = []
  588    ),
  589    merge_options(NewParams, Params, AllParams),
  590    uri_query_components(Search, AllParams),
  591    uri_data(path, Data, Path),
  592    uri_data(search, Data, Search),
  593    uri_components(HREF, Data).
  594
  595
  596%       hook into html_write:attribute_value//1.
  597
  598:- multifile
  599    html_write:expand_attribute_value//1.  600
  601html_write:expand_attribute_value(location_by_id(ID)) -->
  602    { http_location_by_id(ID, Location) },
  603    html_write:html_quoted_attribute(Location).
 authentication(+Options, +Request, -Fields) is det
Verify authentication information. If authentication is requested through Options, demand it. The actual verification is done by the multifile predicate http:authenticate/3. The library http_authenticate.pl provides an implementation thereof.
Errors
- permission_error(access, http_location, Location)
  615:- multifile
  616    http:authenticate/3.  617
  618authentication([], _, []).
  619authentication([authentication(Type)|Options], Request, Fields) :-
  620    !,
  621    (   http:authenticate(Type, Request, XFields)
  622    ->  append(XFields, More, Fields),
  623        authentication(Options, Request, More)
  624    ;   memberchk(path(Path), Request),
  625        permission_error(access, http_location, Path)
  626    ).
  627authentication([_|Options], Request, Fields) :-
  628    authentication(Options, Request, Fields).
 find_handler(+Path, -Action, -Options) is det
Find the handler to call from Path. Rules:

If there is a handler for /dir/ and the requested path is /dir, find_handler/3 throws a http_reply exception, causing the wrapper to generate a 301 (Moved Permanently) reply.

Errors
- existence_error(http_location, Location) @throw http_reply(moved(Dir))
To be done
- Introduce automatic redirection to indexes here?
  647find_handler(Path, Action, Options) :-
  648    path_tree(Tree),
  649    (   find_handler(Tree, Path, Action, Options)
  650    ->  true
  651    ;   \+ sub_atom(Path, _, _, 0, /),
  652        atom_concat(Path, /, Dir),
  653        find_handler(Tree, Dir, Action, Options)
  654    ->  throw(http_reply(moved(Dir)))
  655    ;   throw(error(existence_error(http_location, Path), _))
  656    ).
  657
  658
  659find_handler([node(prefix(Prefix), PAction, POptions, Children)|_],
  660             Path, Action, Options) :-
  661    sub_atom(Path, 0, _, After, Prefix),
  662    !,
  663    (   option(hide_children(false), POptions, false),
  664        find_handler(Children, Path, Action, Options)
  665    ->  true
  666    ;   Action = PAction,
  667        path_info(After, Path, POptions, Options)
  668    ).
  669find_handler([node(Path, Action, Options, _)|_], Path, Action, Options) :- !.
  670find_handler([_|Tree], Path, Action, Options) :-
  671    find_handler(Tree, Path, Action, Options).
  672
  673path_info(0, _, Options,
  674          [prefix(true)|Options]) :- !.
  675path_info(After, Path, Options,
  676          [path_info(PathInfo),prefix(true)|Options]) :-
  677    sub_atom(Path, _, After, 0, PathInfo).
 supports_method(+Request, +Options) is det
Verify that the asked http method is supported by the handler. If not, raise an error that will be mapped to a 405 page by the http wrapper.
Errors
- permission_error(http_method, Method, Location).
  688supports_method(Request, Options) :-
  689    (   option(methods(Methods), Options)
  690    ->  (   Methods == '*'
  691        ->  true
  692        ;   memberchk(method(Method), Request),
  693            memberchk(Method, Methods)
  694        )
  695    ;   true
  696    ),
  697    !.
  698supports_method(Request, _Options) :-
  699    memberchk(path(Location), Request),
  700    memberchk(method(Method), Request),
  701    permission_error(http_method, Method, Location).
 action(+Action, +Request, +Options) is det
Execute the action found. Here we take care of the options time_limit, chunked and spawn.
Errors
- goal_failed(Goal)
  711action(Action, Request, Options) :-
  712    memberchk(chunked, Options),
  713    !,
  714    format('Transfer-encoding: chunked~n'),
  715    spawn_action(Action, Request, Options).
  716action(Action, Request, Options) :-
  717    spawn_action(Action, Request, Options).
  718
  719spawn_action(Action, Request, Options) :-
  720    option(spawn(Spawn), Options),
  721    !,
  722    spawn_options(Spawn, SpawnOption),
  723    http_spawn(time_limit_action(Action, Request, Options), SpawnOption).
  724spawn_action(Action, Request, Options) :-
  725    time_limit_action(Action, Request, Options).
  726
  727spawn_options([], []) :- !.
  728spawn_options(Pool, Options) :-
  729    atom(Pool),
  730    !,
  731    Options = [pool(Pool)].
  732spawn_options(List, List).
  733
  734time_limit_action(Action, Request, Options) :-
  735    (   option(time_limit(TimeLimit), Options),
  736        TimeLimit \== default
  737    ->  true
  738    ;   setting(http:time_limit, TimeLimit)
  739    ),
  740    number(TimeLimit),
  741    TimeLimit > 0,
  742    !,
  743    call_with_time_limit(TimeLimit, call_action(Action, Request, Options)).
  744time_limit_action(Action, Request, Options) :-
  745    call_action(Action, Request, Options).
 call_action(+Action, +Request, +Options)
To be done
- reply_file is normal call?
  752call_action(reply_file(File, FileOptions), Request, _Options) :-
  753    !,
  754    http_reply_file(File, FileOptions, Request).
  755call_action(Pred, Request, Options) :-
  756    memberchk(path_info(PathInfo), Options),
  757    !,
  758    call_action(Pred, [path_info(PathInfo)|Request]).
  759call_action(Pred, Request, _Options) :-
  760    call_action(Pred, Request).
  761
  762call_action(Pred, Request) :-
  763    (   call(Pred, Request)
  764    ->  true
  765    ;   extend(Pred, [Request], Goal),
  766        throw(error(goal_failed(Goal), _))
  767    ).
  768
  769extend(Var, _, Var) :-
  770    var(Var),
  771    !.
  772extend(M:G0, Extra, M:G) :-
  773    extend(G0, Extra, G).
  774extend(G0, Extra, G) :-
  775    G0 =.. List,
  776    append(List, Extra, List2),
  777    G =.. List2.
 http_reply_file(+FileSpec, +Options, +Request) is det
Options is a list of
cache(+Boolean)
If true (default), handle If-modified-since and send modification time.
mime_type(+Type)
Overrule mime-type guessing from the filename as provided by file_mime_type/2.
static_gzip(+Boolean)
If true (default false) and, in addition to the plain file, there is a .gz file that is not older than the plain file and the client acceps gzip encoding, send the compressed file with Transfer-encoding: gzip.
unsafe(+Boolean)
If false (default), validate that FileSpec does not contain references to parent directories. E.g., specifications such as www('../../etc/passwd') are not allowed.
headers(+List)
Provides additional reply-header fields, encoded as a list of Field(Value).

If caching is not disabled, it processes the request headers If-modified-since and Range.

throws
- http_reply(not_modified)
- http_reply(file(MimeType, Path))
  813http_reply_file(File, Options, Request) :-
  814    http_safe_file(File, Options),
  815    absolute_file_name(File, Path,
  816                       [ access(read)
  817                       ]),
  818    (   option(cache(true), Options, true)
  819    ->  (   memberchk(if_modified_since(Since), Request),
  820            time_file(Path, Time),
  821            catch(http_timestamp(Time, Since), _, fail)
  822        ->  throw(http_reply(not_modified))
  823        ;   true
  824        ),
  825        (   memberchk(range(Range), Request)
  826        ->  Reply = file(Type, Path, Range)
  827        ;   option(static_gzip(true), Options),
  828            accepts_encoding(Request, gzip),
  829            file_name_extension(Path, gz, PathGZ),
  830            access_file(PathGZ, read),
  831            time_file(PathGZ, TimeGZ),
  832            time_file(Path, Time),
  833            TimeGZ >= Time
  834        ->  Reply = gzip_file(Type, PathGZ)
  835        ;   Reply = file(Type, Path)
  836        )
  837    ;   Reply = tmp_file(Type, Path)
  838    ),
  839    (   option(mime_type(Type), Options)
  840    ->  true
  841    ;   file_mime_type(Path, Type)
  842    ->  true
  843    ;   Type = text/plain           % fallback type
  844    ),
  845    option(headers(Headers), Options, []),
  846    throw(http_reply(Reply, Headers)).
  847
  848accepts_encoding(Request, Enc) :-
  849    memberchk(accept_encoding(Accept), Request),
  850    split_string(Accept, ",", " ", Parts),
  851    member(Part, Parts),
  852    split_string(Part, ";", " ", [EncS|_]),
  853    atom_string(Enc, EncS).
 http_safe_file(+FileSpec, +Options) is det
True if FileSpec is considered safe. If it is an atom, it cannot be absolute and cannot have references to parent directories. If it is of the form alias(Sub), than Sub cannot have references to parent directories.
Errors
- instantiation_error
- permission_error(read, file, FileSpec)
  866http_safe_file(File, _) :-
  867    var(File),
  868    !,
  869    instantiation_error(File).
  870http_safe_file(_, Options) :-
  871    option(unsafe(true), Options, false),
  872    !.
  873http_safe_file(File, _) :-
  874    http_safe_file(File).
  875
  876http_safe_file(File) :-
  877    compound(File),
  878    functor(File, _, 1),
  879    !,
  880    arg(1, File, Name),
  881    safe_name(Name, File).
  882http_safe_file(Name) :-
  883    (   is_absolute_file_name(Name)
  884    ->  permission_error(read, file, Name)
  885    ;   true
  886    ),
  887    safe_name(Name, Name).
  888
  889safe_name(Name, _) :-
  890    must_be(atom, Name),
  891    prolog_to_os_filename(FileName, Name),
  892    \+ unsafe_name(FileName),
  893    !.
  894safe_name(_, Spec) :-
  895    permission_error(read, file, Spec).
  896
  897unsafe_name(Name) :- Name == '..'.
  898unsafe_name(Name) :- sub_atom(Name, 0, _, _, '../').
  899unsafe_name(Name) :- sub_atom(Name, _, _, _, '/../').
  900unsafe_name(Name) :- sub_atom(Name, _, _, 0, '/..').
 http_redirect(+How, +To, +Request) is det
Redirect to a new location. The argument order, using the Request as last argument, allows for calling this directly from the handler declaration:
:- http_handler(root(.),
                http_redirect(moved, myapp('index.html')),
                []).
Arguments:
How- is one of moved, moved_temporary or see_other
To- is an atom, a aliased path as defined by http_absolute_location/3. or a term location_by_id(Id). If To is not absolute, it is resolved relative to the current location.
  920http_redirect(How, To, Request) :-
  921    (   To = location_by_id(Id)
  922    ->  http_location_by_id(Id, URL)
  923    ;   memberchk(path(Base), Request),
  924        http_absolute_location(To, URL, [relative_to(Base)])
  925    ),
  926    must_be(oneof([moved, moved_temporary, see_other]), How),
  927    Term =.. [How,URL],
  928    throw(http_reply(Term)).
 http_404(+Options, +Request) is det
Reply using an "HTTP 404 not found" page. This handler is intended as fallback handler for prefix handlers. Options processed are:
index(Location)
If there is no path-info, redirect the request to Location using http_redirect/3.
Errors
- http_reply(not_found(Path))
  943http_404(Options, Request) :-
  944    option(index(Index), Options),
  945    \+ ( option(path_info(PathInfo), Request),
  946         PathInfo \== ''
  947       ),
  948    !,
  949    http_redirect(moved, Index, Request).
  950http_404(_Options, Request) :-
  951    option(path(Path), Request),
  952    !,
  953    throw(http_reply(not_found(Path))).
  954http_404(_Options, Request) :-
  955    domain_error(http_request, Request).
 http_switch_protocol(:Goal, +Options)
Send an "HTTP 101 Switching Protocols" reply. After sending the reply, the HTTP library calls call(Goal, InStream, OutStream), where InStream and OutStream are the raw streams to the HTTP client. This allows the communication to continue using an an alternative protocol.

If Goal fails or throws an exception, the streams are closed by the server. Otherwise Goal is responsible for closing the streams. Note that Goal runs in the HTTP handler thread. Typically, the handler should be registered using the spawn option if http_handler/3 or Goal must call thread_create/3 to allow the HTTP worker to return to the worker pool.

The streams use binary (octet) encoding and have their I/O timeout set to the server timeout (default 60 seconds). The predicate set_stream/2 can be used to change the encoding, change or cancel the timeout.

This predicate interacts with the server library by throwing an exception.

The following options are supported:

header(+Headers)
Backward compatible. Use headers(+Headers).
headers(+Headers)
Additional headers send with the reply. Each header takes the form Name(Value).
  989%       @throws http_reply(switch_protocol(Goal, Options))
  990
  991http_switch_protocol(Goal, Options) :-
  992    throw(http_reply(switching_protocols(Goal, Options))).
  993
  994
  995                 /*******************************
  996                 *        PATH COMPILATION      *
  997                 *******************************/
 path_tree(-Tree) is det
Compile paths into a tree. The treee is multi-rooted and represented as a list of nodes, where each node has the form:
node(PathOrPrefix, Action, Options, Children)

The tree is a potentially complicated structure. It is cached in a global variable. Note that this cache is per-thread, so each worker thread holds a copy of the tree. If handler facts are changed the generation is incremented using next_generation/0 and each worker thread will re-compute the tree on the next ocasion.

 1013path_tree(Tree) :-
 1014    current_generation(G),
 1015    nb_current(http_dispatch_tree, G-Tree),
 1016    !. % Avoid existence error
 1017path_tree(Tree) :-
 1018    path_tree_nocache(Tree),
 1019    current_generation(G),
 1020    nb_setval(http_dispatch_tree, G-Tree).
 1021
 1022path_tree_nocache(Tree) :-
 1023    findall(Prefix, prefix_handler(Prefix, _, _), Prefixes0),
 1024    sort(Prefixes0, Prefixes),
 1025    prefix_tree(Prefixes, [], PTree),
 1026    prefix_options(PTree, [], OPTree),
 1027    add_paths_tree(OPTree, Tree).
 1028
 1029prefix_handler(Prefix, Action, Options) :-
 1030    handler(Spec, Action, true, Options),
 1031    http_absolute_location(Spec, Prefix, []).
 prefix_tree(PrefixList, +Tree0, -Tree)
Arguments:
Tree- list(Prefix-list(Children))
 1037prefix_tree([], Tree, Tree).
 1038prefix_tree([H|T], Tree0, Tree) :-
 1039    insert_prefix(H, Tree0, Tree1),
 1040    prefix_tree(T, Tree1, Tree).
 1041
 1042insert_prefix(Prefix, Tree0, Tree) :-
 1043    select(P-T, Tree0, Tree1),
 1044    sub_atom(Prefix, 0, _, _, P),
 1045    !,
 1046    insert_prefix(Prefix, T, T1),
 1047    Tree = [P-T1|Tree1].
 1048insert_prefix(Prefix, Tree, [Prefix-[]|Tree]).
 prefix_options(+PrefixTree, +DefOptions, -OptionTree)
Generate the option-tree for all prefix declarations.
To be done
- What to do if there are more?
 1057prefix_options([], _, []).
 1058prefix_options([P-C|T0], DefOptions,
 1059               [node(prefix(P), Action, Options, Children)|T]) :-
 1060    once(prefix_handler(P, Action, Options0)),
 1061    merge_options(Options0, DefOptions, Options),
 1062    delete(Options, id(_), InheritOpts),
 1063    prefix_options(C, InheritOpts, Children),
 1064    prefix_options(T0, DefOptions, T).
 add_paths_tree(+OPTree, -Tree) is det
Add the plain paths.
 1071add_paths_tree(OPTree, Tree) :-
 1072    findall(path(Path, Action, Options),
 1073            plain_path(Path, Action, Options),
 1074            Triples),
 1075    add_paths_tree(Triples, OPTree, Tree).
 1076
 1077add_paths_tree([], Tree, Tree).
 1078add_paths_tree([path(Path, Action, Options)|T], Tree0, Tree) :-
 1079    add_path_tree(Path, Action, Options, [], Tree0, Tree1),
 1080    add_paths_tree(T, Tree1, Tree).
 plain_path(-Path, -Action, -Options) is nondet
True if {Path,Action,Options} is registered and Path is a plain (i.e. not _prefix_) location.
 1088plain_path(Path, Action, Options) :-
 1089    handler(Spec, Action, false, Options),
 1090    catch(http_absolute_location(Spec, Path, []), E,
 1091          (print_message(error, E), fail)).
 add_path_tree(+Path, +Action, +Options, +Tree0, -Tree) is det
Add a path to a tree. If a handler for the same path is already defined, the one with the highest priority or the latest takes precedence.
 1100add_path_tree(Path, Action, Options0, DefOptions, [],
 1101              [node(Path, Action, Options, [])]) :-
 1102    !,
 1103    merge_options(Options0, DefOptions, Options).
 1104add_path_tree(Path, Action, Options, _,
 1105              [node(prefix(Prefix), PA, DefOptions, Children0)|RestTree],
 1106              [node(prefix(Prefix), PA, DefOptions, Children)|RestTree]) :-
 1107    sub_atom(Path, 0, _, _, Prefix),
 1108    !,
 1109    delete(DefOptions, id(_), InheritOpts),
 1110    add_path_tree(Path, Action, Options, InheritOpts, Children0, Children).
 1111add_path_tree(Path, Action, Options1, DefOptions, [H0|T], [H|T]) :-
 1112    H0 = node(Path, _, Options2, _),
 1113    option(priority(P1), Options1, 0),
 1114    option(priority(P2), Options2, 0),
 1115    P1 >= P2,
 1116    !,
 1117    merge_options(Options1, DefOptions, Options),
 1118    H = node(Path, Action, Options, []).
 1119add_path_tree(Path, Action, Options, DefOptions, [H|T0], [H|T]) :-
 1120    add_path_tree(Path, Action, Options, DefOptions, T0, T).
 1121
 1122
 1123                 /*******************************
 1124                 *            MESSAGES          *
 1125                 *******************************/
 1126
 1127:- multifile
 1128    prolog:message/3. 1129
 1130prolog:message(http_dispatch(ambiguous_id(ID, _List, Selected))) -->
 1131    [ 'HTTP dispatch: ambiguous handler ID ~q (selected ~q)'-[ID, Selected]
 1132    ].
 1133prolog:message(http_dispatch(prefix(_Path))) -->
 1134    [ 'HTTP dispatch: prefix(Path) is replaced by the option prefix'-[]
 1135    ].
 1136
 1137
 1138                 /*******************************
 1139                 *            XREF              *
 1140                 *******************************/
 1141
 1142:- multifile
 1143    prolog:meta_goal/2. 1144:- dynamic
 1145    prolog:meta_goal/2. 1146
 1147prolog:meta_goal(http_handler(_, G, _), [G+1]).
 1148prolog:meta_goal(http_current_handler(_, G), [G+1]).
 1149
 1150
 1151                 /*******************************
 1152                 *             EDIT             *
 1153                 *******************************/
 1154
 1155% Allow edit(Location) to edit the implementation for an HTTP location.
 1156
 1157:- multifile
 1158    prolog_edit:locate/3. 1159
 1160prolog_edit:locate(Path, Spec, Location) :-
 1161    atom(Path),
 1162    sub_atom(Path, 0, _, _, /),
 1163    Pred = _M:_H,
 1164    catch(http_current_handler(Path, Pred), _, fail),
 1165    closure_name_arity(Pred, 1, PI),
 1166    prolog_edit:locate(PI, Spec, Location).
 1167
 1168closure_name_arity(M:Term, Extra, M:Name/Arity) :-
 1169    !,
 1170    callable(Term),
 1171    functor(Term, Name, Arity0),
 1172    Arity is Arity0 + Extra.
 1173closure_name_arity(Term, Extra, Name/Arity) :-
 1174    callable(Term),
 1175    functor(Term, Name, Arity0),
 1176    Arity is Arity0 + Extra.
 1177
 1178
 1179                 /*******************************
 1180                 *        CACHE CLEANUP         *
 1181                 *******************************/
 1182
 1183:- listen(settings(changed(http:prefix, _, _)),
 1184          next_generation). 1185
 1186:- multifile
 1187    user:message_hook/3. 1188:- dynamic
 1189    user:message_hook/3. 1190
 1191user:message_hook(make(done(Reload)), _Level, _Lines) :-
 1192    Reload \== [],
 1193    next_generation,
 1194    fail