1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2007-2020, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(http_dispatch, 38 [ http_dispatch/1, % +Request 39 http_handler/3, % +Path, +Predicate, +Options 40 http_delete_handler/1, % +Path 41 http_request_expansion/2, % :Goal, +Rank 42 http_reply_file/3, % +File, +Options, +Request 43 http_redirect/3, % +How, +Path, +Request 44 http_404/2, % +Options, +Request 45 http_switch_protocol/2, % :Goal, +Options 46 http_current_handler/2, % ?Path, ?Pred 47 http_current_handler/3, % ?Path, ?Pred, -Options 48 http_location_by_id/2, % +ID, -Location 49 http_link_to_id/3, % +ID, +Parameters, -HREF 50 http_reload_with_parameters/3, % +Request, +Parameters, -HREF 51 http_safe_file/2 % +Spec, +Options 52 ]). 53:- use_module(library(lists), 54 [ select/3, append/3, append/2, same_length/2, member/2, 55 last/2, delete/3 56 ]). 57:- autoload(library(apply), 58 [partition/4,maplist/3,maplist/2,include/3,exclude/3]). 59:- autoload(library(broadcast),[listen/2]). 60:- autoload(library(error), 61 [ must_be/2, 62 domain_error/2, 63 type_error/2, 64 instantiation_error/1, 65 existence_error/2, 66 permission_error/3 67 ]). 68:- autoload(library(filesex),[directory_file_path/3]). 69:- autoload(library(option),[option/3,option/2,merge_options/3]). 70:- autoload(library(pairs),[pairs_values/2]). 71:- if(exists_source(library(time))). 72:- autoload(library(time),[call_with_time_limit/2]). 73:- endif. 74:- autoload(library(uri), 75 [ uri_encoded/3, 76 uri_data/3, 77 uri_components/2, 78 uri_query_components/2 79 ]). 80:- autoload(library(http/http_header),[http_timestamp/2]). 81:- autoload(library(http/http_path),[http_absolute_location/3]). 82:- autoload(library(http/mimetype), 83 [file_content_type/2,file_content_type/3]). 84:- if(exists_source(library(http/thread_httpd))). 85:- autoload(library(http/thread_httpd),[http_spawn/2]). 86:- endif. 87:- use_module(library(settings),[setting/4,setting/2]). 88 89:- predicate_options(http_404/2, 1, [index(any)]). 90:- predicate_options(http_reply_file/3, 2, 91 [ cache(boolean), 92 mime_type(any), 93 static_gzip(boolean), 94 cached_gzip(boolean), 95 pass_to(http_safe_file/2, 2), 96 headers(list) 97 ]). 98:- predicate_options(http_safe_file/2, 2, [unsafe(boolean)]). 99:- predicate_options(http_switch_protocol/2, 2, 100 [ headers(list) 101 ]).
128:- setting(http:time_limit, nonneg, 300,
129 'Time limit handling a single query (0=infinite)').
'/home.html'
or a term Alias(Relative).
Where Alias is associated with a concrete path using http:location/3
and resolved using http_absolute_location/3. Relative can be a
single atom or a term `Segment1/Segment2/...`, where each element is
either an atom or a variable. If a segment is a variable it matches
any segment and the binding may be passed to the closure. If the
last segment is a variable it may match multiple segments. This
allows registering REST paths, for example:
:- http_handler(root(user/User), user(Method, User), [ method(Method), methods([get,post,put]) ]). user(get, User, Request) :- ... user(post, User, Request) :- ...
If an HTTP request arrives at the server that matches Path, Closure is called as below, where Request is the parsed HTTP request.
call(Closure, Request)
Options is a list containing the following options:
http_authenticate.pl
provides a plugin for user/password
based Basic
HTTP authentication.Transfer-encoding: chunked
if the client allows for it.true
on a prefix-handler (see prefix), possible children
are masked. This can be used to (temporary) overrule part of the
tree.methods([Method])
. Using method(*)
allows for all methods.:- http_handler(/, http_404([index('index.html')]), [spawn(my_pool),prefix]).
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.
236:- dynamic handler/4. % Path, Action, IsPrefix, Options 237:- multifile handler/4. 238:- dynamic generation/1. 239 240:- meta_predicate 241 http_handler( , , ), 242 http_current_handler( , ), 243 http_current_handler( , , ), 244 http_request_expansion( , ), 245 http_switch_protocol( , ). 246 247http_handler(Path, Pred, Options) :- 248 compile_handler(Path, Pred, Options, Clause), 249 next_generation, 250 assert(Clause). 251 252:- multifile 253 system:term_expansion/2. 254 255systemterm_expansion((:- http_handler(Path, Pred, Options)), Clause) :- 256 \+ current_prolog_flag(xref, true), 257 prolog_load_context(module, M), 258 compile_handler(Path, M:Pred, Options, Clause), 259 next_generation.
274http_delete_handler(id(Id)) :- 275 !, 276 clause(handler(_Path, _:Pred, _, Options), true, Ref), 277 functor(Pred, DefID, _), 278 option(id(Id0), Options, DefID), 279 Id == Id0, 280 erase(Ref), 281 next_generation. 282http_delete_handler(path(Path)) :- 283 !, 284 retractall(handler(Path, _Pred, _, _Options)), 285 next_generation. 286http_delete_handler(Path) :- 287 http_delete_handler(path(Path)).
295next_generation :- 296 retractall(id_location_cache(_,_,_,_)), 297 with_mutex(http_dispatch, next_generation_unlocked). 298 299next_generation_unlocked :- 300 retract(generation(G0)), 301 !, 302 G is G0 + 1, 303 assert(generation(G)). 304next_generation_unlocked :- 305 assert(generation(1)). 306 307current_generation(G) :- 308 with_mutex(http_dispatch, generation(G)), 309 !. 310current_generation(0).
317compile_handler(Path, Pred, Options0, 318 http_dispatch:handler(Path1, Pred, IsPrefix, Options)) :- 319 check_path(Path, Path1, PathOptions), 320 check_id(Options0), 321 ( memberchk(segment_pattern(_), PathOptions) 322 -> IsPrefix = true, 323 Options1 = Options0 324 ; select(prefix, Options0, Options1) 325 -> IsPrefix = true 326 ; IsPrefix = false, 327 Options1 = Options0 328 ), 329 partition(ground, Options1, Options2, QueryOptions), 330 Pred = M:_, 331 maplist(qualify_option(M), Options2, Options3), 332 combine_methods(Options3, Options4), 333 ( QueryOptions == [] 334 -> append(PathOptions, Options4, Options) 335 ; append(PathOptions, ['$extract'(QueryOptions)|Options4], Options) 336 ). 337 338qualify_option(M, condition(Pred), condition(M:Pred)) :- 339 Pred \= _:_, !. 340qualify_option(_, Option, Option).
method(M)
and methods(MList)
options into a single
methods(MList)
option.347combine_methods(Options0, Options) :- 348 collect_methods(Options0, Options1, Methods), 349 ( Methods == [] 350 -> Options = Options0 351 ; append(Methods, Flat), 352 sort(Flat, Unique), 353 ( memberchk('*', Unique) 354 -> Final = '*' 355 ; Final = Unique 356 ), 357 Options = [methods(Final)|Options1] 358 ). 359 360collect_methods([], [], []). 361collect_methods([method(M)|T0], T, [[M]|TM]) :- 362 !, 363 ( M == '*' 364 -> true 365 ; must_be_method(M) 366 ), 367 collect_methods(T0, T, TM). 368collect_methods([methods(M)|T0], T, [M|TM]) :- 369 !, 370 must_be(list, M), 371 maplist(must_be_method, M), 372 collect_methods(T0, T, TM). 373collect_methods([H|T0], [H|T], TM) :- 374 !, 375 collect_methods(T0, T, TM). 376 377must_be_method(M) :- 378 must_be(atom, M), 379 ( method(M) 380 -> true 381 ; domain_error(http_method, M) 382 ). 383 384method(get). 385method(put). 386method(head). 387method(post). 388method(delete). 389method(patch). 390method(options). 391method(trace).
Similar to absolute_file_name/3, Relative can be a term
Component/Component/...
. Relative may be a /
separated list of
path segments, some of which may be variables. A variable patches
any segment and its binding can be passed to the handler. If such a
pattern is found Options is unified with
[segment_pattern(SegmentList)]
.
411check_path(Path, Path, []) :- 412 atom(Path), 413 !, 414 ( sub_atom(Path, 0, _, _, /) 415 -> true 416 ; domain_error(absolute_http_location, Path) 417 ). 418check_path(Alias, AliasOut, Options) :- 419 compound(Alias), 420 Alias =.. [Name, Relative], 421 !, 422 local_path(Relative, Local, Options), 423 ( sub_atom(Local, 0, _, _, /) 424 -> domain_error(relative_location, Relative) 425 ; AliasOut =.. [Name, Local] 426 ). 427check_path(PathSpec, _, _) :- 428 type_error(path_or_alias, PathSpec). 429 430local_path(Atom, Atom, []) :- 431 atom(Atom), 432 !. 433local_path(Path, Atom, Options) :- 434 phrase(path_to_list(Path), Components), 435 !, 436 ( maplist(atom, Components) 437 -> atomic_list_concat(Components, '/', Atom), 438 Options = [] 439 ; append(Pre, [Var|Rest], Components), 440 var(Var) 441 -> append(Pre, [''], PreSep), 442 atomic_list_concat(PreSep, '/', Atom), 443 Options = [segment_pattern([Var|Rest])] 444 ). 445local_path(Path, _, _) :- 446 ground(Path), 447 !, 448 type_error(relative_location, Path). 449local_path(Path, _, _) :- 450 instantiation_error(Path). 451 452path_to_list(Var) --> 453 { var(Var) }, 454 !, 455 [Var]. 456path_to_list(A/B) --> 457 !, 458 path_to_list(A), 459 path_to_list(B). 460path_to_list(Atom) --> 461 { atom(Atom) }, 462 !, 463 [Atom]. 464path_to_list(Value) --> 465 { must_be(atom, Value) }. 466 467check_id(Options) :- 468 memberchk(id(Id), Options), 469 !, 470 must_be(atom, Id). 471check_id(_).
path
member of Request.
If multiple handlers match due to the prefix
option or
variables in path segments (see http_handler/3), the longest
specification is used. If multiple specifications of equal
length match the one with the highest priority is used.method
member of the
Request or throw permission_error(http_method, Method, Location)
http_reply(Term, ExtraHeader, Context)
exceptions.method(Method)
as one of the options.497http_dispatch(Request) :- 498 memberchk(path(Path), Request), 499 find_handler(Path, Closure, Options), 500 supports_method(Request, Options), 501 expand_request(Request, Request1, Options), 502 extract_from_request(Request1, Options), 503 action(Closure, Request1, Options). 504 505extract_from_request(Request, Options) :- 506 memberchk('$extract'(Fields), Options), 507 !, 508 extract_fields(Fields, Request). 509extract_from_request(_, _). 510 511extract_fields([], _). 512extract_fields([H|T], Request) :- 513 memberchk(H, Request), 514 extract_fields(T, Request).
call(Goal, Request0, Request, Options)
If multiple goals are registered they expand the request in a pipeline starting with the expansion hook with the lowest rank.
Besides rewriting the request, for example by validating the user identity based on HTTP authentication or cookies and adding this to the request, the hook may raise HTTP exceptions to indicate a bad request, permission error, etc. See http_status_reply/4.
Initially, auth_expansion/3 is registered with rank 100
to deal
with the older http:authenticate/3 hook.
536http_request_expansion(Goal, Rank) :- 537 throw(error(context_error(nodirective, http_request_expansion(Goal, Rank)), _)). 538 539:- multifile 540 request_expansion/2. 541 542systemterm_expansion((:- http_request_expansion(Goal, Rank)), 543 http_dispatch:request_expansion(M:Callable, Rank)) :- 544 must_be(number, Rank), 545 prolog_load_context(module, M0), 546 strip_module(M0:Goal, M, Callable), 547 must_be(callable, Callable). 548 549request_expanders(Closures) :- 550 findall(Rank-Closure, request_expansion(Closure, Rank), Pairs), 551 keysort(Pairs, Sorted), 552 pairs_values(Sorted, Closures).
559expand_request(Request0, Request, Options) :- 560 request_expanders(Closures), 561 expand_request(Closures, Request0, Request, Options). 562 563expand_request([], Request, Request, _). 564expand_request([H|T], Request0, Request, Options) :- 565 expand_request1(H, Request0, Request1, Options), 566 expand_request(T, Request1, Request, Options). 567 568expand_request1(Closure, Request0, Request, Options) :- 569 call(Closure, Request0, Request, Options), 570 !. 571expand_request1(_, Request, Request, _).
579http_current_handler(Path, Closure) :- 580 atom(Path), 581 !, 582 path_tree(Tree), 583 find_handler(Tree, Path, Closure, _). 584http_current_handler(Path, M:C) :- 585 handler(Spec, M:C, _, _), 586 http_absolute_location(Spec, Path, []).
593http_current_handler(Path, Closure, Options) :- 594 atom(Path), 595 !, 596 path_tree(Tree), 597 find_handler(Tree, Path, Closure, Options). 598http_current_handler(Path, M:C, Options) :- 599 handler(Spec, M:C, _, _), 600 http_absolute_location(Spec, Path, []), 601 path_tree(Tree), 602 find_handler(Tree, Path, _, Options).
id(ID)
appears in the option list of the handler, ID
it is used and takes preference over using the predicate.Module:Pred
If the handler is declared with a pattern, e.g., root(user/User)
,
the location to access a particular user may be accessed using
e.g., user('Bob')
. The number of arguments to the compound term must
match the number of variables in the path pattern.
A plain atom ID can be used to find a handler with a pattern. The
returned location is the path up to the first variable, e.g.,
/user/
in the example above.
User code is adviced to use http_link_to_id/3 which can also add query parameters to the URL. This predicate is a helper for http_link_to_id/3.
635:- dynamic 636 id_location_cache/4. % Id, Argv, Location, Segments 637 638http_location_by_id(ID, _) :- 639 \+ ground(ID), 640 !, 641 instantiation_error(ID). 642http_location_by_id(M:ID, Location) :- 643 compound(ID), 644 !, 645 compound_name_arguments(ID, Name, Argv), 646 http_location_by_id(M:Name, Argv, Location). 647http_location_by_id(M:ID, Location) :- 648 atom(ID), 649 must_be(atom, M), 650 !, 651 http_location_by_id(M:ID, -, Location). 652http_location_by_id(ID, Location) :- 653 compound(ID), 654 !, 655 compound_name_arguments(ID, Name, Argv), 656 http_location_by_id(Name, Argv, Location). 657http_location_by_id(ID, Location) :- 658 atom(ID), 659 !, 660 http_location_by_id(ID, -, Location). 661http_location_by_id(ID, _) :- 662 type_error(location_id, ID). 663 664http_location_by_id(ID, Argv, Location) :- 665 id_location_cache(ID, Argv, Segments, Path), 666 !, 667 add_segments(Path, Segments, Location). 668http_location_by_id(ID, Argv, Location) :- 669 findall(t(Priority, ArgvP, Segments, Prefix), 670 location_by_id(ID, Argv, ArgvP, Segments, Prefix, Priority), 671 List), 672 sort(1, >=, List, Sorted), 673 ( Sorted = [t(_,ArgvP,Segments,Path)] 674 -> assert(id_location_cache(ID,ArgvP,Segments,Path)), 675 Argv = ArgvP 676 ; List == [] 677 -> existence_error(http_handler_id, ID) 678 ; List = [t(P0,ArgvP,Segments,Path),t(P1,_,_,_)|_] 679 -> ( P0 =:= P1 680 -> print_message(warning, 681 http_dispatch(ambiguous_id(ID, Sorted, Path))) 682 ; true 683 ), 684 assert(id_location_cache(ID,Argv,Segments,Path)), 685 Argv = ArgvP 686 ), 687 add_segments(Path, Segments, Location). 688 689add_segments(Path0, [], Path) :- 690 !, 691 Path = Path0. 692add_segments(Path0, Segments, Path) :- 693 maplist(uri_encoded(path), Segments, Encoded), 694 atomic_list_concat(Encoded, '/', Rest), 695 atom_concat(Path0, Rest, Path). 696 697location_by_id(ID, -, _, [], Location, Priority) :- 698 !, 699 location_by_id_raw(ID, L0, _Segments, Priority), 700 to_path(L0, Location). 701location_by_id(ID, Argv, ArgvP, Segments, Location, Priority) :- 702 location_by_id_raw(ID, L0, Segments, Priority), 703 include(var, Segments, ArgvP), 704 same_length(Argv, ArgvP), 705 to_path(L0, Location). 706 707to_path(prefix(Path0), Path) :- % old style prefix notation 708 !, 709 add_prefix(Path0, Path). 710to_path(Path0, Path) :- 711 atomic(Path0), % old style notation 712 !, 713 add_prefix(Path0, Path). 714to_path(Spec, Path) :- % new style notation 715 http_absolute_location(Spec, Path, []). 716 717add_prefix(P0, P) :- 718 ( catch(setting(http:prefix, Prefix), _, fail), 719 Prefix \== '' 720 -> atom_concat(Prefix, P0, P) 721 ; P = P0 722 ). 723 724location_by_id_raw(ID, Location, Pattern, Priority) :- 725 handler(Location, _, _, Options), 726 option(id(ID), Options), 727 option(priority(P0), Options, 0), 728 option(segment_pattern(Pattern), Options, []), 729 Priority is P0+1000. % id(ID) takes preference over predicate 730location_by_id_raw(ID, Location, Pattern, Priority) :- 731 handler(Location, M:C, _, Options), 732 option(priority(Priority), Options, 0), 733 functor(C, PN, _), 734 ( ID = M:PN 735 -> true 736 ; ID = PN 737 ), 738 option(segment_pattern(Pattern), Options, []).
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)).
788http_link_to_id(HandleID, path_postfix(File), HREF) :- 789 !, 790 http_location_by_id(HandleID, HandlerLocation), 791 uri_encoded(path, File, EncFile), 792 directory_file_path(HandlerLocation, EncFile, Location), 793 uri_data(path, Components, Location), 794 uri_components(HREF, Components). 795http_link_to_id(HandleID, Parameters, HREF) :- 796 must_be(list, Parameters), 797 http_location_by_id(HandleID, Location), 798 ( Parameters == [] 799 -> HREF = Location 800 ; uri_data(path, Components, Location), 801 uri_query_components(String, Parameters), 802 uri_data(search, Components, String), 803 uri_components(HREF, Components) 804 ).
811http_reload_with_parameters(Request, NewParams, HREF) :- 812 memberchk(path(Path), Request), 813 ( memberchk(search(Params), Request) 814 -> true 815 ; Params = [] 816 ), 817 merge_options(NewParams, Params, AllParams), 818 uri_query_components(Search, AllParams), 819 uri_data(path, Data, Path), 820 uri_data(search, Data, Search), 821 uri_components(HREF, Data). 822 823 824% hook into html_write:attribute_value//1. 825 826:- multifile 827 html_write:expand_attribute_value//1. 828 829html_writeexpand_attribute_value(location_by_id(ID)) --> 830 { http_location_by_id(ID, Location) }, 831 html_write:html_quoted_attribute(Location). 832html_writeexpand_attribute_value(#(ID)) --> 833 { http_location_by_id(ID, Location) }, 834 html_write:html_quoted_attribute(Location).
http_authenticate.pl
provides an implementation thereof.
849:- multifile 850 http:authenticate/3. 851 852authentication([], _, []). 853authentication([authentication(Type)|Options], Request, Fields) :- 854 !, 855 ( http:authenticate(Type, Request, XFields) 856 -> append(XFields, More, Fields), 857 authentication(Options, Request, More) 858 ; memberchk(path(Path), Request), 859 permission_error(access, http_location, Path) 860 ). 861authentication([_|Options], Request, Fields) :- 862 authentication(Options, Request, Fields). 863 864:- http_request_expansion(auth_expansion, 100).
873auth_expansion(Request0, Request, Options) :-
874 authentication(Options, Request0, Extra),
875 append(Extra, Request0, Request).
prefix(Path)
handlers, use the
longest.
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.
893find_handler(Path, Action, Options) :- 894 path_tree(Tree), 895 ( find_handler(Tree, Path, Action, Options), 896 eval_condition(Options) 897 -> true 898 ; \+ sub_atom(Path, _, _, 0, /), 899 atom_concat(Path, /, Dir), 900 find_handler(Tree, Dir, Action, Options), 901 \+ memberchk(segment_pattern(_), Options) % Variables in pattern 902 -> throw(http_reply(moved(Dir))) 903 ; throw(error(existence_error(http_location, Path), _)) 904 ). 905 906 907find_handler([node(prefix(Prefix), PAction, POptions, Children)|_], 908 Path, Action, Options) :- 909 sub_atom(Path, 0, _, After, Prefix), 910 !, 911 ( option(hide_children(false), POptions, false), 912 find_handler(Children, Path, Action, Options) 913 -> true 914 ; member(segment_pattern(Pattern, PatAction, PatOptions), POptions), 915 copy_term(t(Pattern,PatAction,PatOptions), t(Pattern2,Action,Options)), 916 match_segments(After, Path, Pattern2) 917 -> true 918 ; PAction \== nop 919 -> Action = PAction, 920 path_info(After, Path, POptions, Options) 921 ). 922find_handler([node(Path, Action, Options, _)|_], Path, Action, Options) :- !. 923find_handler([_|Tree], Path, Action, Options) :- 924 find_handler(Tree, Path, Action, Options). 925 926path_info(0, _, Options, 927 [prefix(true)|Options]) :- !. 928path_info(After, Path, Options, 929 [path_info(PathInfo),prefix(true)|Options]) :- 930 sub_atom(Path, _, After, 0, PathInfo). 931 932match_segments(After, Path, [Var]) :- 933 !, 934 sub_atom(Path, _, After, 0, Var). 935match_segments(After, Path, Pattern) :- 936 sub_atom(Path, _, After, 0, PathInfo), 937 split_string(PathInfo, "/", "", Segments), 938 match_segment_pattern(Pattern, Segments). 939 940match_segment_pattern([], []). 941match_segment_pattern([Var], Segments) :- 942 !, 943 atomic_list_concat(Segments, '/', Var). 944match_segment_pattern([H0|T0], [H|T]) :- 945 atom_string(H0, H), 946 match_segment_pattern(T0, T). 947 948 949eval_condition(Options) :- 950 ( memberchk(condition(Cond), Options) 951 -> catch(Cond, E, (print_message(warning, E), fail)) 952 ; true 953 ).
964supports_method(Request, Options) :- 965 ( option(methods(Methods), Options) 966 -> ( Methods == '*' 967 -> true 968 ; memberchk(method(Method), Request), 969 memberchk(Method, Methods) 970 ) 971 ; true 972 ), 973 !. 974supports_method(Request, _Options) :- 975 memberchk(path(Location), Request), 976 memberchk(method(Method), Request), 977 permission_error(http_method, Method, Location).
time_limit
, chunked
and spawn
.
987action(Action, Request, Options) :- 988 memberchk(chunked, Options), 989 !, 990 format('Transfer-encoding: chunked~n'), 991 spawn_action(Action, Request, Options). 992action(Action, Request, Options) :- 993 spawn_action(Action, Request, Options). 994 995:- if(current_predicate(http_spawn/2)). 996spawn_action(Action, Request, Options) :- 997 option(spawn(Spawn), Options), 998 !, 999 spawn_options(Spawn, SpawnOption), 1000 http_spawn(time_limit_action(Action, Request, Options), SpawnOption). 1001:- endif. 1002spawn_action(Action, Request, Options) :- 1003 time_limit_action(Action, Request, Options). 1004 1005spawn_options([], []) :- !. 1006spawn_options(Pool, Options) :- 1007 atom(Pool), 1008 !, 1009 Options = [pool(Pool)]. 1010spawn_options(List, List). 1011 1012:- if(current_predicate(call_with_time_limit/2)). 1013time_limit_action(Action, Request, Options) :- 1014 ( option(time_limit(TimeLimit), Options), 1015 TimeLimit \== default 1016 -> true 1017 ; setting(http:time_limit, TimeLimit) 1018 ), 1019 number(TimeLimit), 1020 TimeLimit > 0, 1021 !, 1022 call_with_time_limit(TimeLimit, call_action(Action, Request, Options)). 1023:- endif. 1024time_limit_action(Action, Request, Options) :- 1025 call_action(Action, Request, Options).
1032call_action(reply_file(File, FileOptions), Request, _Options) :- 1033 !, 1034 http_reply_file(File, FileOptions, Request). 1035call_action(Pred, Request, Options) :- 1036 memberchk(path_info(PathInfo), Options), 1037 !, 1038 call_action(Pred, [path_info(PathInfo)|Request]). 1039call_action(Pred, Request, _Options) :- 1040 call_action(Pred, Request). 1041 1042call_action(Pred, Request) :- 1043 ( call(Pred, Request) 1044 -> true 1045 ; extend(Pred, [Request], Goal), 1046 throw(error(goal_failed(Goal), _)) 1047 ). 1048 1049extend(Var, _, Var) :- 1050 var(Var), 1051 !. 1052extend(M:G0, Extra, M:G) :- 1053 extend(G0, Extra, G). 1054extend(G0, Extra, G) :- 1055 G0 =.. List, 1056 append(List, Extra, List2), 1057 G =.. List2.
true
(default), handle If-modified-since and send
modification time.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
.true
(default false
) the system maintains cached
gzipped files in a directory accessible using the file
search path http_gzip_cache
and serves these similar
to the static_gzip(true)
option. If the gzip file
does not exist or is older than the input the file is
recreated.false
(default), validate that FileSpec does not
contain references to parent directories. E.g.,
specifications such as www('../../etc/passwd')
are
not allowed.
If caching is not disabled, it processes the request headers
If-modified-since
and Range
.
1101http_reply_file(File, Options, Request) :- 1102 http_safe_file(File, Options), 1103 absolute_file_name(File, Path, 1104 [ access(read) 1105 ]), 1106 ( option(cache(true), Options, true) 1107 -> ( memberchk(if_modified_since(Since), Request), 1108 time_file(Path, Time), 1109 catch(http_timestamp(Time2, Since), _, fail), 1110 abs(Time-Time2) < 1 % allow for loss of second fraction 1111 -> throw(http_reply(not_modified)) 1112 ; true 1113 ), 1114 ( memberchk(range(Range), Request) 1115 -> Reply = file(Type, Path, Range) 1116 ; option(static_gzip(true), Options), 1117 accepts_encoding(Request, gzip), 1118 file_name_extension(Path, gz, PathGZ), 1119 access_file(PathGZ, read), 1120 time_file(PathGZ, TimeGZ), 1121 time_file(Path, Time), 1122 TimeGZ >= Time 1123 -> Reply = gzip_file(Type, PathGZ) 1124 ; option(cached_gzip(true), Options), 1125 accepts_encoding(Request, gzip), 1126 gzip_cached(Path, PathGZ) 1127 -> Reply = gzip_file(Type, PathGZ) 1128 ; Reply = file(Type, Path) 1129 ) 1130 ; Reply = tmp_file(Type, Path) 1131 ), 1132 ( option(mime_type(MediaType), Options) 1133 -> file_content_type(Path, MediaType, Type) 1134 ; file_content_type(Path, Type) 1135 -> true 1136 ; Type = text/plain % fallback type 1137 ), 1138 option(headers(Headers), Options, []), 1139 throw(http_reply(Reply, Headers)). 1140 1141accepts_encoding(Request, Enc) :- 1142 memberchk(accept_encoding(Accept), Request), 1143 split_string(Accept, ",", " ", Parts), 1144 member(Part, Parts), 1145 split_string(Part, ";", " ", [EncS|_]), 1146 atom_string(Enc, EncS). 1147 1148gzip_cached(Path, PathGZ) :- 1149 with_mutex(http_reply_file, gzip_cached_sync(Path, PathGZ)). 1150 1151gzip_cached_sync(Path, PathGZ) :- 1152 time_file(Path, Time), 1153 variant_sha1(Path, SHA1), 1154 ( absolute_file_name(http_gzip_cache(SHA1), 1155 PathGZ, 1156 [ access(read), 1157 file_errors(fail) 1158 ]), 1159 time_file(PathGZ, TimeGZ), 1160 TimeGZ >= Time 1161 -> true 1162 ; absolute_file_name(http_gzip_cache(SHA1), 1163 PathGZ, 1164 [ access(write), 1165 file_errors(fail) 1166 ]) 1167 -> setup_call_cleanup( 1168 gzopen(PathGZ, write, Out, [type(binary)]), 1169 setup_call_cleanup( 1170 open(Path, read, In, [type(binary)]), 1171 copy_stream_data(In, Out), 1172 close(In)), 1173 close(Out)) 1174 ).
alias(Sub)
, than Sub cannot
have references to parent directories.
1186http_safe_file(File, _) :- 1187 var(File), 1188 !, 1189 instantiation_error(File). 1190http_safe_file(_, Options) :- 1191 option(unsafe(true), Options, false), 1192 !. 1193http_safe_file(File, _) :- 1194 http_safe_file(File). 1195 1196http_safe_file(File) :- 1197 compound(File), 1198 functor(File, _, 1), 1199 !, 1200 arg(1, File, Name), 1201 safe_name(Name, File). 1202http_safe_file(Name) :- 1203 ( is_absolute_file_name(Name) 1204 -> permission_error(read, file, Name) 1205 ; true 1206 ), 1207 safe_name(Name, Name). 1208 1209safe_name(Name, _) :- 1210 must_be(atom, Name), 1211 prolog_to_os_filename(FileName, Name), 1212 \+ unsafe_name(FileName), 1213 !. 1214safe_name(_, Spec) :- 1215 permission_error(read, file, Spec). 1216 1217unsafe_name(Name) :- Name == '..'. 1218unsafe_name(Name) :- sub_atom(Name, 0, _, _, '../'). 1219unsafe_name(Name) :- sub_atom(Name, _, _, _, '/../'). 1220unsafe_name(Name) :- sub_atom(Name, _, _, 0, '/..').
:- http_handler(root(.), http_redirect(moved, myapp('index.html')), []).
1241http_redirect(How, To, Request) :- 1242 must_be(oneof([moved, moved_temporary, see_other]), How), 1243 must_be(ground, To), 1244 ( id_location(To, URL) 1245 -> true 1246 ; memberchk(path(Base), Request), 1247 http_absolute_location(To, URL, [relative_to(Base)]) 1248 ), 1249 Term =.. [How,URL], 1250 throw(http_reply(Term)). 1251 1252id_location(location_by_id(Id), URL) :- 1253 http_location_by_id(Id, URL). 1254id_location(#(Id), URL) :- 1255 http_location_by_id(Id, URL). 1256id_location(#(Id)+Parameters, URL) :- 1257 http_link_to_id(Id, Parameters, URL).
1272http_404(Options, Request) :- 1273 option(index(Index), Options), 1274 \+ ( option(path_info(PathInfo), Request), 1275 PathInfo \== '' 1276 ), 1277 !, 1278 http_redirect(moved, Index, Request). 1279http_404(_Options, Request) :- 1280 option(path(Path), Request), 1281 !, 1282 throw(http_reply(not_found(Path))). 1283http_404(_Options, Request) :- 1284 domain_error(http_request, Request).
"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:
headers(+Headers)
.1318% @throws http_reply(switch_protocol(Goal, Options)) 1319 1320http_switch_protocol(Goal, Options) :- 1321 throw(http_reply(switching_protocols(Goal, Options))). 1322 1323 1324 /******************************* 1325 * PATH COMPILATION * 1326 *******************************/
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.
1342path_tree(Tree) :- 1343 current_generation(G), 1344 nb_current(http_dispatch_tree, G-Tree), 1345 !. % Avoid existence error 1346path_tree(Tree) :- 1347 path_tree_nocache(Tree), 1348 current_generation(G), 1349 nb_setval(http_dispatch_tree, G-Tree). 1350 1351path_tree_nocache(Tree) :- 1352 findall(Prefix, prefix_handler(Prefix, _, _, _), Prefixes0), 1353 sort(Prefixes0, Prefixes), 1354 prefix_tree(Prefixes, [], PTree), 1355 prefix_options(PTree, [], OPTree), 1356 add_paths_tree(OPTree, Tree). 1357 1358prefix_handler(Prefix, Action, Options, Priority-PLen) :- 1359 handler(Spec, Action, true, Options), 1360 ( memberchk(priority(Priority), Options) 1361 -> true 1362 ; Priority = 0 1363 ), 1364 ( memberchk(segment_pattern(Pattern), Options) 1365 -> length(Pattern, PLen) 1366 ; PLen = 0 1367 ), 1368 Error = error(existence_error(http_alias,_),_), 1369 catch(http_absolute_location(Spec, Prefix, []), Error, 1370 ( print_message(warning, Error), 1371 fail 1372 )).
1378prefix_tree([], Tree, Tree). 1379prefix_tree([H|T], Tree0, Tree) :- 1380 insert_prefix(H, Tree0, Tree1), 1381 prefix_tree(T, Tree1, Tree). 1382 1383insert_prefix(Prefix, Tree0, Tree) :- 1384 select(P-T, Tree0, Tree1), 1385 sub_atom(Prefix, 0, _, _, P), 1386 !, 1387 insert_prefix(Prefix, T, T1), 1388 Tree = [P-T1|Tree1]. 1389insert_prefix(Prefix, Tree, [Prefix-[]|Tree]).
1398prefix_options([], _, []). 1399prefix_options([Prefix-C|T0], DefOptions, 1400 [node(prefix(Prefix), Action, PrefixOptions, Children)|T]) :- 1401 findall(h(A,O,P), prefix_handler(Prefix,A,O,P), Handlers), 1402 sort(3, >=, Handlers, Handlers1), 1403 Handlers1 = [h(_,_,P0)|_], 1404 same_priority_handlers(Handlers1, P0, Same), 1405 option_patterns(Same, SegmentPatterns, Action), 1406 last(Same, h(_, Options0, _-_)), 1407 merge_options(Options0, DefOptions, Options), 1408 append(SegmentPatterns, Options, PrefixOptions), 1409 exclude(no_inherit, Options, InheritOpts), 1410 prefix_options(C, InheritOpts, Children), 1411 prefix_options(T0, DefOptions, T). 1412 1413no_inherit(id(_)). 1414no_inherit('$extract'(_)). 1415 1416same_priority_handlers([H|T0], P, [H|T]) :- 1417 H = h(_,_,P0-_), 1418 P = P0-_, 1419 !, 1420 same_priority_handlers(T0, P, T). 1421same_priority_handlers(_, _, []). 1422 1423option_patterns([], [], nop). 1424option_patterns([h(A,_,_-0)|_], [], A) :- 1425 !. 1426option_patterns([h(A,O,_)|T0], [segment_pattern(P,A,O)|T], AF) :- 1427 memberchk(segment_pattern(P), O), 1428 option_patterns(T0, T, AF).
1435add_paths_tree(OPTree, Tree) :- 1436 findall(path(Path, Action, Options), 1437 plain_path(Path, Action, Options), 1438 Triples), 1439 add_paths_tree(Triples, OPTree, Tree). 1440 1441add_paths_tree([], Tree, Tree). 1442add_paths_tree([path(Path, Action, Options)|T], Tree0, Tree) :- 1443 add_path_tree(Path, Action, Options, [], Tree0, Tree1), 1444 add_paths_tree(T, Tree1, Tree).
1452plain_path(Path, Action, Options) :-
1453 handler(Spec, Action, false, Options),
1454 catch(http_absolute_location(Spec, Path, []), E,
1455 (print_message(error, E), fail)).
1464add_path_tree(Path, Action, Options0, DefOptions, [], 1465 [node(Path, Action, Options, [])]) :- 1466 !, 1467 merge_options(Options0, DefOptions, Options). 1468add_path_tree(Path, Action, Options, _, 1469 [node(prefix(Prefix), PA, DefOptions, Children0)|RestTree], 1470 [node(prefix(Prefix), PA, DefOptions, Children)|RestTree]) :- 1471 sub_atom(Path, 0, _, _, Prefix), 1472 !, 1473 delete(DefOptions, id(_), InheritOpts), 1474 add_path_tree(Path, Action, Options, InheritOpts, Children0, Children). 1475add_path_tree(Path, Action, Options1, DefOptions, [H0|T], [H|T]) :- 1476 H0 = node(Path, _, Options2, _), 1477 option(priority(P1), Options1, 0), 1478 option(priority(P2), Options2, 0), 1479 P1 >= P2, 1480 !, 1481 merge_options(Options1, DefOptions, Options), 1482 H = node(Path, Action, Options, []). 1483add_path_tree(Path, Action, Options, DefOptions, [H|T0], [H|T]) :- 1484 add_path_tree(Path, Action, Options, DefOptions, T0, T). 1485 1486 1487 /******************************* 1488 * MESSAGES * 1489 *******************************/ 1490 1491:- multifile 1492 prolog:message/3. 1493 1494prologmessage(http_dispatch(ambiguous_id(ID, _List, Selected))) --> 1495 [ 'HTTP dispatch: ambiguous handler ID ~q (selected ~q)'-[ID, Selected] 1496 ]. 1497 1498 1499 /******************************* 1500 * XREF * 1501 *******************************/ 1502 1503:- multifile 1504 prolog:meta_goal/2. 1505:- dynamic 1506 prolog:meta_goal/2. 1507 1508prologmeta_goal(http_handler(_, G, _), [G+1]). 1509prologmeta_goal(http_current_handler(_, G), [G+1]). 1510 1511 1512 /******************************* 1513 * EDIT * 1514 *******************************/ 1515 1516% Allow edit(Location) to edit the implementation for an HTTP location. 1517 1518:- multifile 1519 prolog_edit:locate/3. 1520 1521prolog_edit:locate(Path, Spec, Location) :- 1522 atom(Path), 1523 sub_atom(Path, 0, _, _, /), 1524 Pred = _M:_H, 1525 catch(http_current_handler(Path, Pred), _, fail), 1526 closure_name_arity(Pred, 1, PI), 1527 prolog_edit:locate(PI, Spec, Location). 1528 1529closure_name_arity(M:Term, Extra, M:Name/Arity) :- 1530 !, 1531 callable(Term), 1532 functor(Term, Name, Arity0), 1533 Arity is Arity0 + Extra. 1534closure_name_arity(Term, Extra, Name/Arity) :- 1535 callable(Term), 1536 functor(Term, Name, Arity0), 1537 Arity is Arity0 + Extra. 1538 1539 1540 /******************************* 1541 * CACHE CLEANUP * 1542 *******************************/ 1543 1544:- listen(settings(changed(http:prefix, _, _)), 1545 next_generation). 1546 1547:- multifile 1548 user:message_hook/3. 1549:- dynamic 1550 user:message_hook/3. 1551 1552user:message_hook(make(done(Reload)), _Level, _Lines) :- 1553 Reload \== [], 1554 next_generation, 1555 fail
Dispatch requests in the HTTP server
Most code doesn't need to use this directly; instead use library(http/http_server), which combines this library with the typical HTTP libraries that most servers need.
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:*/