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, []).
  73
  74/** <module> Dispatch requests in the HTTP server
  75
  76This module can be placed between   http_wrapper.pl  and the application
  77code to associate HTTP _locations_ to   predicates that serve the pages.
  78In addition, it associates parameters  with   locations  that  deal with
  79timeout handling and user authentication.  The typical setup is:
  80
  81==
  82server(Port, Options) :-
  83        http_server(http_dispatch,
  84                    [ port(Port)
  85                    | Options
  86                    ]).
  87
  88:- http_handler('/index.html', write_index, []).
  89
  90write_index(Request) :-
  91        ...
  92==
  93*/
  94
  95:- setting(http:time_limit, nonneg, 300,
  96           'Time limit handling a single query (0=infinite)').
  97
  98%!  http_handler(+Path, :Closure, +Options) is det.
  99%
 100%   Register Closure as a handler for HTTP requests. Path is a
 101%   specification as provided by http_path.pl.  If an HTTP
 102%   request arrives at the server that matches Path, Closure
 103%   is called with one extra argument: the parsed HTTP request.
 104%   Options is a list containing the following options:
 105%
 106%           * authentication(+Type)
 107%           Demand authentication.  Authentication methods are
 108%           pluggable.  The library http_authenticate.pl provides
 109%           a plugin for user/password based =Basic= HTTP
 110%           authentication.
 111%
 112%           * chunked
 113%           Use =|Transfer-encoding: chunked|= if the client
 114%           allows for it.
 115%
 116%           * content_type(+Term)
 117%           Specifies the content-type of the reply.  This value is
 118%           currently not used by this library.  It enhances the
 119%           reflexive capabilities of this library through
 120%           http_current_handler/3.
 121%
 122%           * id(+Term)
 123%           Identifier of the handler.  The default identifier is
 124%           the predicate name.  Used by http_location_by_id/2.
 125%
 126%           * hide_children(+Bool)
 127%           If =true= on a prefix-handler (see prefix), possible
 128%           children are masked.  This can be used to (temporary)
 129%           overrule part of the tree.
 130%
 131%           * method(+Method)
 132%           Declare that the handler processes Method.  This is
 133%           equivalent to methods([Method]).  Using method(*)
 134%           allows for all methods.
 135%
 136%           * methods(+ListOfMethods)
 137%           Declare that the handler processes all of the given
 138%           methods.  If this option appears multiple times, the
 139%           methods are combined.
 140%
 141%           * prefix
 142%           Call Pred on any location that is a specialisation of
 143%           Path.  If multiple handlers match, the one with the
 144%           longest path is used.  Options defined with a prefix
 145%           handler are the default options for paths that start
 146%           with this prefix.  Note that the handler acts as a
 147%           fallback handler for the tree below it:
 148%
 149%             ==
 150%             :- http_handler(/, http_404([index('index.html')]),
 151%                             [spawn(my_pool),prefix]).
 152%             ==
 153%
 154%           * priority(+Integer)
 155%           If two handlers handle the same path, the one with the
 156%           highest priority is used.  If equal, the last registered
 157%           is used.  Please be aware that the order of clauses in
 158%           multifile predicates can change due to reloading files.
 159%           The default priority is 0 (zero).
 160%
 161%           * spawn(+SpawnOptions)
 162%           Run the handler in a seperate thread.  If SpawnOptions
 163%           is an atom, it is interpreted as a thread pool name
 164%           (see create_thread_pool/3).  Otherwise the options
 165%           are passed to http_spawn/2 and from there to
 166%           thread_create/3.  These options are typically used to
 167%           set the stack limits.
 168%
 169%           * time_limit(+Spec)
 170%           One of =infinite=, =default= or a positive number
 171%           (seconds).  If =default=, the value from the setting
 172%           =http:time_limit= is taken. The default of this
 173%           setting is 300 (5 minutes).  See setting/2.
 174%
 175%   Note that http_handler/3 is normally invoked  as a directive and
 176%   processed using term-expansion.  Using   term-expansion  ensures
 177%   proper update through make/0 when the specification is modified.
 178%   We do not expand when the  cross-referencer is running to ensure
 179%   proper handling of the meta-call.
 180%
 181%   @error  existence_error(http_location, Location)
 182%   @see    http_reply_file/3 and http_redirect/3 are generic
 183%           handlers to serve files and achieve redirects.
 184
 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.
 209
 210
 211%!  http_delete_handler(+Spec) is det.
 212%
 213%   Delete handler for Spec. Typically, this should only be used for
 214%   handlers that are registered dynamically. Spec is one of:
 215%
 216%       * id(Id)
 217%       Delete a handler with the given id.  The default id is the
 218%       handler-predicate-name.
 219%
 220%       * path(Path)
 221%       Delete handler that serves the given path.
 222
 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)).
 237
 238
 239%!  next_generation is det.
 240%!  current_generation(-G) is det.
 241%
 242%   Increment the generation count.
 243
 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).
 260
 261
 262%!  compile_handler(+Path, :Pred, +Options) is det.
 263%
 264%   Compile a handler specification. For now we this is a no-op, but
 265%   in the feature can make this more efficiently, especially in the
 266%   presence of one or multiple prefix declarations. We can also use
 267%   this to detect conflicts.
 268
 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).
 283
 284%!  combine_methods(+OptionsIn, -Options) is det.
 285%
 286%   Combine method(M) and  methods(MList)  options   into  a  single
 287%   methods(MList) option.
 288
 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).
 334
 335
 336%!  check_path(+PathSpecIn, -PathSpecOut) is det.
 337%
 338%   Validate the given path specification.  We want one of
 339%
 340%           * AbsoluteLocation
 341%           * Alias(Relative)
 342%
 343%   Similar  to  absolute_file_name/3,  Relative  can    be  a  term
 344%   _|Component/Component/...|_
 345%
 346%   @error  domain_error, type_error
 347%   @see    http_absolute_location/3
 348
 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].
 393
 394
 395
 396%!  http_dispatch(Request) is det.
 397%
 398%   Dispatch a Request using http_handler/3 registrations.
 399
 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).
 407
 408
 409%!  http_current_handler(+Location, :Closure) is semidet.
 410%!  http_current_handler(-Location, :Closure) is nondet.
 411%
 412%   True if Location is handled by Closure.
 413
 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, []).
 422
 423%!  http_current_handler(+Location, :Closure, -Options) is semidet.
 424%!  http_current_handler(?Location, :Closure, ?Options) is nondet.
 425%
 426%   Resolve the current handler and options to execute it.
 427
 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).
 438
 439
 440%!  http_location_by_id(+ID, -Location) is det.
 441%
 442%   Find the HTTP Location of handler with   ID. If the setting (see
 443%   setting/2)  http:prefix  is  active,  Location  is  the  handler
 444%   location prefixed with the prefix setting.   Handler  IDs can be
 445%   specified in two ways:
 446%
 447%       * id(ID)
 448%       If this appears in the option list of the handler, this
 449%       it is used and takes preference over using the predicate.
 450%       * M:PredName
 451%       The module-qualified name of the predicate.
 452%       * PredName
 453%       The unqualified name of the predicate.
 454%
 455%   @error existence_error(http_handler_id, Id).
 456%   @deprecated The predicate http_link_to_id/3 provides the same
 457%   functionality with the option to add query parameters or a
 458%   path parameter.
 459
 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    !.
 521
 522
 523%!  http_link_to_id(+HandleID, +Parameters, -HREF)
 524%
 525%   HREF is a link on the local server   to a handler with given ID,
 526%   passing the given Parameters. This   predicate is typically used
 527%   to formulate a HREF that resolves   to  a handler implementing a
 528%   particular predicate. The code below provides a typical example.
 529%   The predicate user_details/1 returns a page with details about a
 530%   user from a given id. This predicate is registered as a handler.
 531%   The DCG user_link//1 renders a link   to  a user, displaying the
 532%   name and calling user_details/1  when   clicked.  Note  that the
 533%   location (root(user_details)) is irrelevant in this equation and
 534%   HTTP locations can thus be moved   freely  without breaking this
 535%   code fragment.
 536%
 537%     ==
 538%     :- http_handler(root(user_details), user_details, []).
 539%
 540%     user_details(Request) :-
 541%         http_parameters(Request,
 542%                         [ user_id(ID)
 543%                         ]),
 544%         ...
 545%
 546%     user_link(ID) -->
 547%         { user_name(ID, Name),
 548%           http_link_to_id(user_details, [id(ID)], HREF)
 549%         },
 550%         html(a([class(user), href(HREF)], Name)).
 551%     ==
 552%
 553%   @arg Parameters is one of
 554%
 555%           - path_postfix(File) to pass a single value as the last
 556%             segment of the HTTP location (path). This way of
 557%             passing a parameter is commonly used in REST APIs.
 558%           - A list of search parameters for a =GET= request.
 559%
 560%   @see    http_location_by_id/2 and http_handler/3 for defining and
 561%           specifying handler IDs.
 562
 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).
 577
 578%!  http_reload_with_parameters(+Request, +Parameters, -HREF) is det.
 579%
 580%   Create a request on the current handler with replaced search
 581%   parameters.
 582
 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).
 604
 605
 606%!  authentication(+Options, +Request, -Fields) is det.
 607%
 608%   Verify  authentication  information.   If    authentication   is
 609%   requested through Options, demand it. The actual verification is
 610%   done by the multifile predicate http:authenticate/3. The library
 611%   http_authenticate.pl provides an implementation thereof.
 612%
 613%   @error  permission_error(access, http_location, Location)
 614
 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).
 629
 630
 631%!  find_handler(+Path, -Action, -Options) is det.
 632%
 633%   Find the handler to call from Path.  Rules:
 634%
 635%           * If there is a matching handler, use this.
 636%           * If there are multiple prefix(Path) handlers, use the
 637%             longest.
 638%
 639%   If there is a handler for =|/dir/|=   and  the requested path is
 640%   =|/dir|=, find_handler/3 throws a  http_reply exception, causing
 641%   the wrapper to generate a 301 (Moved Permanently) reply.
 642%
 643%   @error  existence_error(http_location, Location)
 644%   @throw  http_reply(moved(Dir))
 645%   @tbd    Introduce automatic redirection to indexes here?
 646
 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).
 678
 679
 680%!  supports_method(+Request, +Options) is det.
 681%
 682%   Verify that the asked http method   is supported by the handler.
 683%   If not, raise an error that will be  mapped to a 405 page by the
 684%   http wrapper.
 685%
 686%   @error permission_error(http_method, Method, Location).
 687
 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).
 702
 703
 704%!  action(+Action, +Request, +Options) is det.
 705%
 706%   Execute the action found.  Here we take care of the options
 707%   =time_limit=, =chunked= and =spawn=.
 708%
 709%   @error  goal_failed(Goal)
 710
 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).
 746
 747
 748%!  call_action(+Action, +Request, +Options)
 749%
 750%   @tbd    reply_file is normal call?
 751
 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.
 778
 779%!  http_reply_file(+FileSpec, +Options, +Request) is det.
 780%
 781%   Options is a list of
 782%
 783%           * cache(+Boolean)
 784%           If =true= (default), handle If-modified-since and send
 785%           modification time.
 786%
 787%           * mime_type(+Type)
 788%           Overrule mime-type guessing from the filename as
 789%           provided by file_mime_type/2.
 790%
 791%           * static_gzip(+Boolean)
 792%           If true (default =false=) and, in addition to the plain
 793%           file, there is a =|.gz|= file that is not older than the
 794%           plain file and the client acceps =gzip= encoding, send
 795%           the compressed file with =|Transfer-encoding: gzip|=.
 796%
 797%           * unsafe(+Boolean)
 798%           If =false= (default), validate that FileSpec does not
 799%           contain references to parent directories.  E.g.,
 800%           specifications such as =|www('../../etc/passwd')|= are
 801%           not allowed.
 802%
 803%           * headers(+List)
 804%           Provides additional reply-header fields, encoded as a
 805%           list of _|Field(Value)|_.
 806%
 807%   If caching is not disabled,  it   processes  the request headers
 808%   =|If-modified-since|= and =Range=.
 809%
 810%   @throws http_reply(not_modified)
 811%   @throws http_reply(file(MimeType, Path))
 812
 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).
 854
 855
 856%!  http_safe_file(+FileSpec, +Options) is det.
 857%
 858%   True if FileSpec is considered _safe_.  If   it  is  an atom, it
 859%   cannot  be  absolute  and  cannot   have  references  to  parent
 860%   directories. If it is of the   form  alias(Sub), than Sub cannot
 861%   have references to parent directories.
 862%
 863%   @error instantiation_error
 864%   @error permission_error(read, file, FileSpec)
 865
 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, '/..').
 901
 902
 903%!  http_redirect(+How, +To, +Request) is det.
 904%
 905%   Redirect to a new  location.  The   argument  order,  using  the
 906%   Request as last argument, allows for  calling this directly from
 907%   the handler declaration:
 908%
 909%       ==
 910%       :- http_handler(root(.),
 911%                       http_redirect(moved, myapp('index.html')),
 912%                       []).
 913%       ==
 914%
 915%   @param How is one of =moved=, =moved_temporary= or =see_other=
 916%   @param To is an atom, a aliased path as defined by
 917%   http_absolute_location/3. or a term location_by_id(Id). If To is
 918%   not absolute, it is resolved relative to the current location.
 919
 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)).
 929
 930
 931%!  http_404(+Options, +Request) is det.
 932%
 933%   Reply using an "HTTP  404  not   found"  page.  This  handler is
 934%   intended as fallback handler  for   _prefix_  handlers.  Options
 935%   processed are:
 936%
 937%       * index(Location)
 938%       If there is no path-info, redirect the request to
 939%       Location using http_redirect/3.
 940%
 941%   @error http_reply(not_found(Path))
 942
 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).
 956
 957
 958%!  http_switch_protocol(:Goal, +Options)
 959%
 960%   Send an =|"HTTP 101 Switching  Protocols"|= reply. After sending
 961%   the  reply,  the  HTTP  library    calls   call(Goal,  InStream,
 962%   OutStream), where InStream and OutStream are  the raw streams to
 963%   the HTTP client. This allows the communication to continue using
 964%   an an alternative protocol.
 965%
 966%   If Goal fails or throws an exception,  the streams are closed by
 967%   the server. Otherwise  Goal  is   responsible  for  closing  the
 968%   streams. Note that  Goal  runs  in   the  HTTP  handler  thread.
 969%   Typically, the handler should be   registered  using the =spawn=
 970%   option if http_handler/3 or Goal   must  call thread_create/3 to
 971%   allow the HTTP worker to return to the worker pool.
 972%
 973%   The streams use binary  (octet)  encoding   and  have  their I/O
 974%   timeout set to the server  timeout   (default  60  seconds). The
 975%   predicate set_stream/2 can  be  used   to  change  the encoding,
 976%   change or cancel the timeout.
 977%
 978%   This predicate interacts with the server  library by throwing an
 979%   exception.
 980%
 981%   The following options are supported:
 982%
 983%     - header(+Headers)
 984%     Backward compatible.  Use headers(+Headers).
 985%     - headers(+Headers)
 986%     Additional headers send with the reply. Each header takes the
 987%     form Name(Value).
 988
 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                 *******************************/
 998
 999%!  path_tree(-Tree) is det.
1000%
1001%   Compile paths into  a  tree.  The   treee  is  multi-rooted  and
1002%   represented as a list of nodes, where each node has the form:
1003%
1004%           node(PathOrPrefix, Action, Options, Children)
1005%
1006%   The tree is a potentially complicated structure. It is cached in
1007%   a global variable. Note that this   cache is per-thread, so each
1008%   worker thread holds a copy of  the   tree.  If handler facts are
1009%   changed the _generation_ is  incremented using next_generation/0
1010%   and each worker thread will  re-compute   the  tree  on the next
1011%   ocasion.
1012
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, []).
1032
1033%!  prefix_tree(PrefixList, +Tree0, -Tree)
1034%
1035%   @param Tree     list(Prefix-list(Children))
1036
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]).
1049
1050
1051%!  prefix_options(+PrefixTree, +DefOptions, -OptionTree)
1052%
1053%   Generate the option-tree for all prefix declarations.
1054%
1055%   @tbd    What to do if there are more?
1056
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).
1065
1066
1067%!  add_paths_tree(+OPTree, -Tree) is det.
1068%
1069%   Add the plain paths.
1070
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).
1081
1082
1083%!  plain_path(-Path, -Action, -Options) is nondet.
1084%
1085%   True if {Path,Action,Options} is registered and  Path is a plain
1086%   (i.e. not _prefix_) location.
1087
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)).
1092
1093
1094%!  add_path_tree(+Path, +Action, +Options, +Tree0, -Tree) is det.
1095%
1096%   Add a path to a tree. If a  handler for the same path is already
1097%   defined, the one with the highest   priority or the latest takes
1098%   precedence.
1099
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.