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, []).
126:- setting(http:time_limit, nonneg, 300,
127 '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.
234:- dynamic handler/4. % Path, Action, IsPrefix, Options 235:- multifile handler/4. 236:- dynamic generation/1. 237 238:- meta_predicate 239 http_handler( , , ), 240 http_current_handler( , ), 241 http_current_handler( , , ), 242 http_request_expansion( , ), 243 http_switch_protocol( , ). 244 245http_handler(Path, Pred, Options) :- 246 compile_handler(Path, Pred, Options, Clause), 247 next_generation, 248 assert(Clause). 249 250:- multifile 251 system:term_expansion/2. 252 253systemterm_expansion((:- http_handler(Path, Pred, Options)), Clause) :- 254 \+ current_prolog_flag(xref, true), 255 prolog_load_context(module, M), 256 compile_handler(Path, M:Pred, Options, Clause), 257 next_generation.
272http_delete_handler(id(Id)) :- 273 !, 274 clause(handler(_Path, _:Pred, _, Options), true, Ref), 275 functor(Pred, DefID, _), 276 option(id(Id0), Options, DefID), 277 Id == Id0, 278 erase(Ref), 279 next_generation. 280http_delete_handler(path(Path)) :- 281 !, 282 retractall(handler(Path, _Pred, _, _Options)), 283 next_generation. 284http_delete_handler(Path) :- 285 http_delete_handler(path(Path)).
293next_generation :- 294 retractall(id_location_cache(_,_,_,_)), 295 with_mutex(http_dispatch, next_generation_unlocked). 296 297next_generation_unlocked :- 298 retract(generation(G0)), 299 !, 300 G is G0 + 1, 301 assert(generation(G)). 302next_generation_unlocked :- 303 assert(generation(1)). 304 305current_generation(G) :- 306 with_mutex(http_dispatch, generation(G)), 307 !. 308current_generation(0).
315compile_handler(Path, Pred, Options0, 316 http_dispatch:handler(Path1, Pred, IsPrefix, Options)) :- 317 check_path(Path, Path1, PathOptions), 318 check_id(Options0), 319 ( memberchk(segment_pattern(_), PathOptions) 320 -> IsPrefix = true, 321 Options1 = Options0 322 ; select(prefix, Options0, Options1) 323 -> IsPrefix = true 324 ; IsPrefix = false, 325 Options1 = Options0 326 ), 327 partition(ground, Options1, Options2, QueryOptions), 328 Pred = M:_, 329 maplist(qualify_option(M), Options2, Options3), 330 combine_methods(Options3, Options4), 331 ( QueryOptions == [] 332 -> append(PathOptions, Options4, Options) 333 ; append(PathOptions, ['$extract'(QueryOptions)|Options4], Options) 334 ). 335 336qualify_option(M, condition(Pred), condition(M:Pred)) :- 337 Pred \= _:_, !. 338qualify_option(_, Option, Option).
method(M)
and methods(MList)
options into a single
methods(MList)
option.345combine_methods(Options0, Options) :- 346 collect_methods(Options0, Options1, Methods), 347 ( Methods == [] 348 -> Options = Options0 349 ; append(Methods, Flat), 350 sort(Flat, Unique), 351 ( memberchk('*', Unique) 352 -> Final = '*' 353 ; Final = Unique 354 ), 355 Options = [methods(Final)|Options1] 356 ). 357 358collect_methods([], [], []). 359collect_methods([method(M)|T0], T, [[M]|TM]) :- 360 !, 361 ( M == '*' 362 -> true 363 ; must_be_method(M) 364 ), 365 collect_methods(T0, T, TM). 366collect_methods([methods(M)|T0], T, [M|TM]) :- 367 !, 368 must_be(list, M), 369 maplist(must_be_method, M), 370 collect_methods(T0, T, TM). 371collect_methods([H|T0], [H|T], TM) :- 372 !, 373 collect_methods(T0, T, TM). 374 375must_be_method(M) :- 376 must_be(atom, M), 377 ( method(M) 378 -> true 379 ; domain_error(http_method, M) 380 ). 381 382method(get). 383method(put). 384method(head). 385method(post). 386method(delete). 387method(patch). 388method(options). 389method(trace).
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)]
.
409check_path(Path, Path, []) :- 410 atom(Path), 411 !, 412 ( sub_atom(Path, 0, _, _, /) 413 -> true 414 ; domain_error(absolute_http_location, Path) 415 ). 416check_path(Alias, AliasOut, Options) :- 417 compound(Alias), 418 Alias =.. [Name, Relative], 419 !, 420 local_path(Relative, Local, Options), 421 ( sub_atom(Local, 0, _, _, /) 422 -> domain_error(relative_location, Relative) 423 ; AliasOut =.. [Name, Local] 424 ). 425check_path(PathSpec, _, _) :- 426 type_error(path_or_alias, PathSpec). 427 428local_path(Atom, Atom, []) :- 429 atom(Atom), 430 !. 431local_path(Path, Atom, Options) :- 432 phrase(path_to_list(Path), Components), 433 !, 434 ( maplist(atom, Components) 435 -> atomic_list_concat(Components, '/', Atom), 436 Options = [] 437 ; append(Pre, [Var|Rest], Components), 438 var(Var) 439 -> append(Pre, [''], PreSep), 440 atomic_list_concat(PreSep, '/', Atom), 441 Options = [segment_pattern([Var|Rest])] 442 ). 443local_path(Path, _, _) :- 444 ground(Path), 445 !, 446 type_error(relative_location, Path). 447local_path(Path, _, _) :- 448 instantiation_error(Path). 449 450path_to_list(Var) --> 451 { var(Var) }, 452 !, 453 [Var]. 454path_to_list(A/B) --> 455 !, 456 path_to_list(A), 457 path_to_list(B). 458path_to_list(Atom) --> 459 { atom(Atom) }, 460 !, 461 [Atom]. 462path_to_list(Value) --> 463 { must_be(atom, Value) }. 464 465check_id(Options) :- 466 memberchk(id(Id), Options), 467 !, 468 must_be(atom, Id). 469check_id(_).
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.495http_dispatch(Request) :- 496 memberchk(path(Path), Request), 497 find_handler(Path, Closure, Options), 498 supports_method(Request, Options), 499 expand_request(Request, Request1, Options), 500 extract_from_request(Request1, Options), 501 action(Closure, Request1, Options). 502 503extract_from_request(Request, Options) :- 504 memberchk('$extract'(Fields), Options), 505 !, 506 extract_fields(Fields, Request). 507extract_from_request(_, _). 508 509extract_fields([], _). 510extract_fields([H|T], Request) :- 511 memberchk(H, Request), 512 extract_fields(T, Request).
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.
534http_request_expansion(Goal, Rank) :- 535 throw(error(context_error(nodirective, http_request_expansion(Goal, Rank)), _)). 536 537:- multifile 538 request_expansion/2. 539 540systemterm_expansion((:- http_request_expansion(Goal, Rank)), 541 http_dispatch:request_expansion(M:Callable, Rank)) :- 542 must_be(number, Rank), 543 prolog_load_context(module, M0), 544 strip_module(M0:Goal, M, Callable), 545 must_be(callable, Callable). 546 547request_expanders(Closures) :- 548 findall(Rank-Closure, request_expansion(Closure, Rank), Pairs), 549 keysort(Pairs, Sorted), 550 pairs_values(Sorted, Closures).
557expand_request(Request0, Request, Options) :- 558 request_expanders(Closures), 559 expand_request(Closures, Request0, Request, Options). 560 561expand_request([], Request, Request, _). 562expand_request([H|T], Request0, Request, Options) :- 563 expand_request1(H, Request0, Request1, Options), 564 expand_request(T, Request1, Request, Options). 565 566expand_request1(Closure, Request0, Request, Options) :- 567 call(Closure, Request0, Request, Options), 568 !. 569expand_request1(_, Request, Request, _).
577http_current_handler(Path, Closure) :- 578 atom(Path), 579 !, 580 path_tree(Tree), 581 find_handler(Tree, Path, Closure, _). 582http_current_handler(Path, M:C) :- 583 handler(Spec, M:C, _, _), 584 http_absolute_location(Spec, Path, []).
591http_current_handler(Path, Closure, Options) :- 592 atom(Path), 593 !, 594 path_tree(Tree), 595 find_handler(Tree, Path, Closure, Options). 596http_current_handler(Path, M:C, Options) :- 597 handler(Spec, M:C, _, _), 598 http_absolute_location(Spec, Path, []), 599 path_tree(Tree), 600 find_handler(Tree, Path, _, Options).
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.
633:- dynamic 634 id_location_cache/4. % Id, Argv, Location, Segments 635 636http_location_by_id(ID, _) :- 637 \+ ground(ID), 638 !, 639 instantiation_error(ID). 640http_location_by_id(M:ID, Location) :- 641 compound(ID), 642 !, 643 compound_name_arguments(ID, Name, Argv), 644 http_location_by_id(M:Name, Argv, Location). 645http_location_by_id(M:ID, Location) :- 646 atom(ID), 647 must_be(atom, M), 648 !, 649 http_location_by_id(M:ID, -, Location). 650http_location_by_id(ID, Location) :- 651 compound(ID), 652 !, 653 compound_name_arguments(ID, Name, Argv), 654 http_location_by_id(Name, Argv, Location). 655http_location_by_id(ID, Location) :- 656 atom(ID), 657 !, 658 http_location_by_id(ID, -, Location). 659http_location_by_id(ID, _) :- 660 type_error(location_id, ID). 661 662http_location_by_id(ID, Argv, Location) :- 663 id_location_cache(ID, Argv, Segments, Path), 664 !, 665 add_segments(Path, Segments, Location). 666http_location_by_id(ID, Argv, Location) :- 667 findall(t(Priority, ArgvP, Segments, Prefix), 668 location_by_id(ID, Argv, ArgvP, Segments, Prefix, Priority), 669 List), 670 sort(1, >=, List, Sorted), 671 ( Sorted = [t(_,ArgvP,Segments,Path)] 672 -> assert(id_location_cache(ID,ArgvP,Segments,Path)), 673 Argv = ArgvP 674 ; List == [] 675 -> existence_error(http_handler_id, ID) 676 ; List = [t(P0,ArgvP,Segments,Path),t(P1,_,_,_)|_] 677 -> ( P0 =:= P1 678 -> print_message(warning, 679 http_dispatch(ambiguous_id(ID, Sorted, Path))) 680 ; true 681 ), 682 assert(id_location_cache(ID,Argv,Segments,Path)), 683 Argv = ArgvP 684 ), 685 add_segments(Path, Segments, Location). 686 687add_segments(Path0, [], Path) :- 688 !, 689 Path = Path0. 690add_segments(Path0, Segments, Path) :- 691 maplist(uri_encoded(path), Segments, Encoded), 692 atomic_list_concat(Encoded, '/', Rest), 693 atom_concat(Path0, Rest, Path). 694 695location_by_id(ID, -, _, [], Location, Priority) :- 696 !, 697 location_by_id_raw(ID, L0, _Segments, Priority), 698 to_path(L0, Location). 699location_by_id(ID, Argv, ArgvP, Segments, Location, Priority) :- 700 location_by_id_raw(ID, L0, Segments, Priority), 701 include(var, Segments, ArgvP), 702 same_length(Argv, ArgvP), 703 to_path(L0, Location). 704 705to_path(prefix(Path0), Path) :- % old style prefix notation 706 !, 707 add_prefix(Path0, Path). 708to_path(Path0, Path) :- 709 atomic(Path0), % old style notation 710 !, 711 add_prefix(Path0, Path). 712to_path(Spec, Path) :- % new style notation 713 http_absolute_location(Spec, Path, []). 714 715add_prefix(P0, P) :- 716 ( catch(setting(http:prefix, Prefix), _, fail), 717 Prefix \== '' 718 -> atom_concat(Prefix, P0, P) 719 ; P = P0 720 ). 721 722location_by_id_raw(ID, Location, Pattern, Priority) :- 723 handler(Location, _, _, Options), 724 option(id(ID), Options), 725 option(priority(P0), Options, 0), 726 option(segment_pattern(Pattern), Options, []), 727 Priority is P0+1000. % id(ID) takes preference over predicate 728location_by_id_raw(ID, Location, Pattern, Priority) :- 729 handler(Location, M:C, _, Options), 730 option(priority(Priority), Options, 0), 731 functor(C, PN, _), 732 ( ID = M:PN 733 -> true 734 ; ID = PN 735 ), 736 option(segment_pattern(Pattern), Options, []).
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)).
786http_link_to_id(HandleID, path_postfix(File), HREF) :- 787 !, 788 http_location_by_id(HandleID, HandlerLocation), 789 uri_encoded(path, File, EncFile), 790 directory_file_path(HandlerLocation, EncFile, Location), 791 uri_data(path, Components, Location), 792 uri_components(HREF, Components). 793http_link_to_id(HandleID, Parameters, HREF) :- 794 must_be(list, Parameters), 795 http_location_by_id(HandleID, Location), 796 ( Parameters == [] 797 -> HREF = Location 798 ; uri_data(path, Components, Location), 799 uri_query_components(String, Parameters), 800 uri_data(search, Components, String), 801 uri_components(HREF, Components) 802 ).
809http_reload_with_parameters(Request, NewParams, HREF) :- 810 memberchk(path(Path), Request), 811 ( memberchk(search(Params), Request) 812 -> true 813 ; Params = [] 814 ), 815 merge_options(NewParams, Params, AllParams), 816 uri_query_components(Search, AllParams), 817 uri_data(path, Data, Path), 818 uri_data(search, Data, Search), 819 uri_components(HREF, Data). 820 821 822% hook into html_write:attribute_value//1. 823 824:- multifile 825 html_write:expand_attribute_value//1. 826 827html_writeexpand_attribute_value(location_by_id(ID)) --> 828 { http_location_by_id(ID, Location) }, 829 html_write:html_quoted_attribute(Location). 830html_writeexpand_attribute_value(#(ID)) --> 831 { http_location_by_id(ID, Location) }, 832 html_write:html_quoted_attribute(Location).
http_authenticate.pl
provides an implementation thereof.
847:- multifile 848 http:authenticate/3. 849 850authentication([], _, []). 851authentication([authentication(Type)|Options], Request, Fields) :- 852 !, 853 ( http:authenticate(Type, Request, XFields) 854 -> append(XFields, More, Fields), 855 authentication(Options, Request, More) 856 ; memberchk(path(Path), Request), 857 permission_error(access, http_location, Path) 858 ). 859authentication([_|Options], Request, Fields) :- 860 authentication(Options, Request, Fields). 861 862:- http_request_expansion(auth_expansion, 100).
871auth_expansion(Request0, Request, Options) :-
872 authentication(Options, Request0, Extra),
873 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.
891find_handler(Path, Action, Options) :- 892 path_tree(Tree), 893 ( find_handler(Tree, Path, Action, Options), 894 eval_condition(Options) 895 -> true 896 ; \+ sub_atom(Path, _, _, 0, /), 897 atom_concat(Path, /, Dir), 898 find_handler(Tree, Dir, Action, Options), 899 \+ memberchk(segment_pattern(_), Options) % Variables in pattern 900 -> throw(http_reply(moved(Dir))) 901 ; throw(error(existence_error(http_location, Path), _)) 902 ). 903 904 905find_handler([node(prefix(Prefix), PAction, POptions, Children)|_], 906 Path, Action, Options) :- 907 sub_atom(Path, 0, _, After, Prefix), 908 !, 909 ( option(hide_children(false), POptions, false), 910 find_handler(Children, Path, Action, Options) 911 -> true 912 ; member(segment_pattern(Pattern, PatAction, PatOptions), POptions), 913 copy_term(t(Pattern,PatAction,PatOptions), t(Pattern2,Action,Options)), 914 match_segments(After, Path, Pattern2) 915 -> true 916 ; PAction \== nop 917 -> Action = PAction, 918 path_info(After, Path, POptions, Options) 919 ). 920find_handler([node(Path, Action, Options, _)|_], Path, Action, Options) :- !. 921find_handler([_|Tree], Path, Action, Options) :- 922 find_handler(Tree, Path, Action, Options). 923 924path_info(0, _, Options, 925 [prefix(true)|Options]) :- !. 926path_info(After, Path, Options, 927 [path_info(PathInfo),prefix(true)|Options]) :- 928 sub_atom(Path, _, After, 0, PathInfo). 929 930match_segments(After, Path, [Var]) :- 931 !, 932 sub_atom(Path, _, After, 0, Var). 933match_segments(After, Path, Pattern) :- 934 sub_atom(Path, _, After, 0, PathInfo), 935 split_string(PathInfo, "/", "", Segments), 936 match_segment_pattern(Pattern, Segments). 937 938match_segment_pattern([], []). 939match_segment_pattern([Var], Segments) :- 940 !, 941 atomic_list_concat(Segments, '/', Var). 942match_segment_pattern([H0|T0], [H|T]) :- 943 atom_string(H0, H), 944 match_segment_pattern(T0, T). 945 946 947eval_condition(Options) :- 948 ( memberchk(condition(Cond), Options) 949 -> catch(Cond, E, (print_message(warning, E), fail)) 950 ; true 951 ).
962supports_method(Request, Options) :- 963 ( option(methods(Methods), Options) 964 -> ( Methods == '*' 965 -> true 966 ; memberchk(method(Method), Request), 967 memberchk(Method, Methods) 968 ) 969 ; true 970 ), 971 !. 972supports_method(Request, _Options) :- 973 memberchk(path(Location), Request), 974 memberchk(method(Method), Request), 975 permission_error(http_method, Method, Location).
time_limit
, chunked
and spawn
.
985action(Action, Request, Options) :- 986 memberchk(chunked, Options), 987 !, 988 format('Transfer-encoding: chunked~n'), 989 spawn_action(Action, Request, Options). 990action(Action, Request, Options) :- 991 spawn_action(Action, Request, Options). 992 993:- if(current_predicate(http_spawn/2)). 994spawn_action(Action, Request, Options) :- 995 option(spawn(Spawn), Options), 996 !, 997 spawn_options(Spawn, SpawnOption), 998 http_spawn(time_limit_action(Action, Request, Options), SpawnOption). 999:- endif. 1000spawn_action(Action, Request, Options) :- 1001 time_limit_action(Action, Request, Options). 1002 1003spawn_options([], []) :- !. 1004spawn_options(Pool, Options) :- 1005 atom(Pool), 1006 !, 1007 Options = [pool(Pool)]. 1008spawn_options(List, List). 1009 1010:- if(current_predicate(call_with_time_limit/2)). 1011time_limit_action(Action, Request, Options) :- 1012 ( option(time_limit(TimeLimit), Options), 1013 TimeLimit \== default 1014 -> true 1015 ; setting(http:time_limit, TimeLimit) 1016 ), 1017 number(TimeLimit), 1018 TimeLimit > 0, 1019 !, 1020 call_with_time_limit(TimeLimit, call_action(Action, Request, Options)). 1021:- endif. 1022time_limit_action(Action, Request, Options) :- 1023 call_action(Action, Request, Options).
1030call_action(reply_file(File, FileOptions), Request, _Options) :- 1031 !, 1032 http_reply_file(File, FileOptions, Request). 1033call_action(Pred, Request, Options) :- 1034 memberchk(path_info(PathInfo), Options), 1035 !, 1036 call_action(Pred, [path_info(PathInfo)|Request]). 1037call_action(Pred, Request, _Options) :- 1038 call_action(Pred, Request). 1039 1040call_action(Pred, Request) :- 1041 ( call(Pred, Request) 1042 -> true 1043 ; extend(Pred, [Request], Goal), 1044 throw(error(goal_failed(Goal), _)) 1045 ). 1046 1047extend(Var, _, Var) :- 1048 var(Var), 1049 !. 1050extend(M:G0, Extra, M:G) :- 1051 extend(G0, Extra, G). 1052extend(G0, Extra, G) :- 1053 G0 =.. List, 1054 append(List, Extra, List2), 1055 G =.. List2.
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
.
1099http_reply_file(File, Options, Request) :- 1100 http_safe_file(File, Options), 1101 absolute_file_name(File, Path, 1102 [ access(read) 1103 ]), 1104 ( option(cache(true), Options, true) 1105 -> ( memberchk(if_modified_since(Since), Request), 1106 time_file(Path, Time), 1107 catch(http_timestamp(Time, Since), _, fail) 1108 -> throw(http_reply(not_modified)) 1109 ; true 1110 ), 1111 ( memberchk(range(Range), Request) 1112 -> Reply = file(Type, Path, Range) 1113 ; option(static_gzip(true), Options), 1114 accepts_encoding(Request, gzip), 1115 file_name_extension(Path, gz, PathGZ), 1116 access_file(PathGZ, read), 1117 time_file(PathGZ, TimeGZ), 1118 time_file(Path, Time), 1119 TimeGZ >= Time 1120 -> Reply = gzip_file(Type, PathGZ) 1121 ; option(cached_gzip(true), Options), 1122 accepts_encoding(Request, gzip), 1123 gzip_cached(Path, PathGZ) 1124 -> Reply = gzip_file(Type, PathGZ) 1125 ; Reply = file(Type, Path) 1126 ) 1127 ; Reply = tmp_file(Type, Path) 1128 ), 1129 ( option(mime_type(MediaType), Options) 1130 -> file_content_type(Path, MediaType, Type) 1131 ; file_content_type(Path, Type) 1132 -> true 1133 ; Type = text/plain % fallback type 1134 ), 1135 option(headers(Headers), Options, []), 1136 throw(http_reply(Reply, Headers)). 1137 1138accepts_encoding(Request, Enc) :- 1139 memberchk(accept_encoding(Accept), Request), 1140 split_string(Accept, ",", " ", Parts), 1141 member(Part, Parts), 1142 split_string(Part, ";", " ", [EncS|_]), 1143 atom_string(Enc, EncS). 1144 1145gzip_cached(Path, PathGZ) :- 1146 with_mutex(http_reply_file, gzip_cached_sync(Path, PathGZ)). 1147 1148gzip_cached_sync(Path, PathGZ) :- 1149 time_file(Path, Time), 1150 variant_sha1(Path, SHA1), 1151 ( absolute_file_name(http_gzip_cache(SHA1), 1152 PathGZ, 1153 [ access(read), 1154 file_errors(fail) 1155 ]), 1156 time_file(PathGZ, TimeGZ), 1157 TimeGZ >= Time 1158 -> true 1159 ; absolute_file_name(http_gzip_cache(SHA1), 1160 PathGZ, 1161 [ access(write), 1162 file_errors(fail) 1163 ]) 1164 -> setup_call_cleanup( 1165 gzopen(PathGZ, write, Out, [type(binary)]), 1166 setup_call_cleanup( 1167 open(Path, read, In, [type(binary)]), 1168 copy_stream_data(In, Out), 1169 close(In)), 1170 close(Out)) 1171 ).
alias(Sub)
, than Sub cannot
have references to parent directories.
1183http_safe_file(File, _) :- 1184 var(File), 1185 !, 1186 instantiation_error(File). 1187http_safe_file(_, Options) :- 1188 option(unsafe(true), Options, false), 1189 !. 1190http_safe_file(File, _) :- 1191 http_safe_file(File). 1192 1193http_safe_file(File) :- 1194 compound(File), 1195 functor(File, _, 1), 1196 !, 1197 arg(1, File, Name), 1198 safe_name(Name, File). 1199http_safe_file(Name) :- 1200 ( is_absolute_file_name(Name) 1201 -> permission_error(read, file, Name) 1202 ; true 1203 ), 1204 safe_name(Name, Name). 1205 1206safe_name(Name, _) :- 1207 must_be(atom, Name), 1208 prolog_to_os_filename(FileName, Name), 1209 \+ unsafe_name(FileName), 1210 !. 1211safe_name(_, Spec) :- 1212 permission_error(read, file, Spec). 1213 1214unsafe_name(Name) :- Name == '..'. 1215unsafe_name(Name) :- sub_atom(Name, 0, _, _, '../'). 1216unsafe_name(Name) :- sub_atom(Name, _, _, _, '/../'). 1217unsafe_name(Name) :- sub_atom(Name, _, _, 0, '/..').
:- http_handler(root(.), http_redirect(moved, myapp('index.html')), []).
1238http_redirect(How, To, Request) :- 1239 must_be(oneof([moved, moved_temporary, see_other]), How), 1240 must_be(ground, To), 1241 ( id_location(To, URL) 1242 -> true 1243 ; memberchk(path(Base), Request), 1244 http_absolute_location(To, URL, [relative_to(Base)]) 1245 ), 1246 Term =.. [How,URL], 1247 throw(http_reply(Term)). 1248 1249id_location(location_by_id(Id), URL) :- 1250 http_location_by_id(Id, URL). 1251id_location(#(Id), URL) :- 1252 http_location_by_id(Id, URL). 1253id_location(#(Id)+Parameters, URL) :- 1254 http_link_to_id(Id, Parameters, URL).
1269http_404(Options, Request) :- 1270 option(index(Index), Options), 1271 \+ ( option(path_info(PathInfo), Request), 1272 PathInfo \== '' 1273 ), 1274 !, 1275 http_redirect(moved, Index, Request). 1276http_404(_Options, Request) :- 1277 option(path(Path), Request), 1278 !, 1279 throw(http_reply(not_found(Path))). 1280http_404(_Options, Request) :- 1281 domain_error(http_request, Request).
"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)
.1315% @throws http_reply(switch_protocol(Goal, Options)) 1316 1317http_switch_protocol(Goal, Options) :- 1318 throw(http_reply(switching_protocols(Goal, Options))). 1319 1320 1321 /******************************* 1322 * PATH COMPILATION * 1323 *******************************/
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.
1339path_tree(Tree) :- 1340 current_generation(G), 1341 nb_current(http_dispatch_tree, G-Tree), 1342 !. % Avoid existence error 1343path_tree(Tree) :- 1344 path_tree_nocache(Tree), 1345 current_generation(G), 1346 nb_setval(http_dispatch_tree, G-Tree). 1347 1348path_tree_nocache(Tree) :- 1349 findall(Prefix, prefix_handler(Prefix, _, _, _), Prefixes0), 1350 sort(Prefixes0, Prefixes), 1351 prefix_tree(Prefixes, [], PTree), 1352 prefix_options(PTree, [], OPTree), 1353 add_paths_tree(OPTree, Tree). 1354 1355prefix_handler(Prefix, Action, Options, Priority-PLen) :- 1356 handler(Spec, Action, true, Options), 1357 ( memberchk(priority(Priority), Options) 1358 -> true 1359 ; Priority = 0 1360 ), 1361 ( memberchk(segment_pattern(Pattern), Options) 1362 -> length(Pattern, PLen) 1363 ; PLen = 0 1364 ), 1365 Error = error(existence_error(http_alias,_),_), 1366 catch(http_absolute_location(Spec, Prefix, []), Error, 1367 ( print_message(warning, Error), 1368 fail 1369 )).
1375prefix_tree([], Tree, Tree). 1376prefix_tree([H|T], Tree0, Tree) :- 1377 insert_prefix(H, Tree0, Tree1), 1378 prefix_tree(T, Tree1, Tree). 1379 1380insert_prefix(Prefix, Tree0, Tree) :- 1381 select(P-T, Tree0, Tree1), 1382 sub_atom(Prefix, 0, _, _, P), 1383 !, 1384 insert_prefix(Prefix, T, T1), 1385 Tree = [P-T1|Tree1]. 1386insert_prefix(Prefix, Tree, [Prefix-[]|Tree]).
1395prefix_options([], _, []). 1396prefix_options([Prefix-C|T0], DefOptions, 1397 [node(prefix(Prefix), Action, PrefixOptions, Children)|T]) :- 1398 findall(h(A,O,P), prefix_handler(Prefix,A,O,P), Handlers), 1399 sort(3, >=, Handlers, Handlers1), 1400 Handlers1 = [h(_,_,P0)|_], 1401 same_priority_handlers(Handlers1, P0, Same), 1402 option_patterns(Same, SegmentPatterns, Action), 1403 last(Same, h(_, Options0, _-_)), 1404 merge_options(Options0, DefOptions, Options), 1405 append(SegmentPatterns, Options, PrefixOptions), 1406 exclude(no_inherit, Options, InheritOpts), 1407 prefix_options(C, InheritOpts, Children), 1408 prefix_options(T0, DefOptions, T). 1409 1410no_inherit(id(_)). 1411no_inherit('$extract'(_)). 1412 1413same_priority_handlers([H|T0], P, [H|T]) :- 1414 H = h(_,_,P0-_), 1415 P = P0-_, 1416 !, 1417 same_priority_handlers(T0, P, T). 1418same_priority_handlers(_, _, []). 1419 1420option_patterns([], [], nop). 1421option_patterns([h(A,_,_-0)|_], [], A) :- 1422 !. 1423option_patterns([h(A,O,_)|T0], [segment_pattern(P,A,O)|T], AF) :- 1424 memberchk(segment_pattern(P), O), 1425 option_patterns(T0, T, AF).
1432add_paths_tree(OPTree, Tree) :- 1433 findall(path(Path, Action, Options), 1434 plain_path(Path, Action, Options), 1435 Triples), 1436 add_paths_tree(Triples, OPTree, Tree). 1437 1438add_paths_tree([], Tree, Tree). 1439add_paths_tree([path(Path, Action, Options)|T], Tree0, Tree) :- 1440 add_path_tree(Path, Action, Options, [], Tree0, Tree1), 1441 add_paths_tree(T, Tree1, Tree).
1449plain_path(Path, Action, Options) :-
1450 handler(Spec, Action, false, Options),
1451 catch(http_absolute_location(Spec, Path, []), E,
1452 (print_message(error, E), fail)).
1461add_path_tree(Path, Action, Options0, DefOptions, [], 1462 [node(Path, Action, Options, [])]) :- 1463 !, 1464 merge_options(Options0, DefOptions, Options). 1465add_path_tree(Path, Action, Options, _, 1466 [node(prefix(Prefix), PA, DefOptions, Children0)|RestTree], 1467 [node(prefix(Prefix), PA, DefOptions, Children)|RestTree]) :- 1468 sub_atom(Path, 0, _, _, Prefix), 1469 !, 1470 delete(DefOptions, id(_), InheritOpts), 1471 add_path_tree(Path, Action, Options, InheritOpts, Children0, Children). 1472add_path_tree(Path, Action, Options1, DefOptions, [H0|T], [H|T]) :- 1473 H0 = node(Path, _, Options2, _), 1474 option(priority(P1), Options1, 0), 1475 option(priority(P2), Options2, 0), 1476 P1 >= P2, 1477 !, 1478 merge_options(Options1, DefOptions, Options), 1479 H = node(Path, Action, Options, []). 1480add_path_tree(Path, Action, Options, DefOptions, [H|T0], [H|T]) :- 1481 add_path_tree(Path, Action, Options, DefOptions, T0, T). 1482 1483 1484 /******************************* 1485 * MESSAGES * 1486 *******************************/ 1487 1488:- multifile 1489 prolog:message/3. 1490 1491prologmessage(http_dispatch(ambiguous_id(ID, _List, Selected))) --> 1492 [ 'HTTP dispatch: ambiguous handler ID ~q (selected ~q)'-[ID, Selected] 1493 ]. 1494 1495 1496 /******************************* 1497 * XREF * 1498 *******************************/ 1499 1500:- multifile 1501 prolog:meta_goal/2. 1502:- dynamic 1503 prolog:meta_goal/2. 1504 1505prologmeta_goal(http_handler(_, G, _), [G+1]). 1506prologmeta_goal(http_current_handler(_, G), [G+1]). 1507 1508 1509 /******************************* 1510 * EDIT * 1511 *******************************/ 1512 1513% Allow edit(Location) to edit the implementation for an HTTP location. 1514 1515:- multifile 1516 prolog_edit:locate/3. 1517 1518prolog_edit:locate(Path, Spec, Location) :- 1519 atom(Path), 1520 sub_atom(Path, 0, _, _, /), 1521 Pred = _M:_H, 1522 catch(http_current_handler(Path, Pred), _, fail), 1523 closure_name_arity(Pred, 1, PI), 1524 prolog_edit:locate(PI, Spec, Location). 1525 1526closure_name_arity(M:Term, Extra, M:Name/Arity) :- 1527 !, 1528 callable(Term), 1529 functor(Term, Name, Arity0), 1530 Arity is Arity0 + Extra. 1531closure_name_arity(Term, Extra, Name/Arity) :- 1532 callable(Term), 1533 functor(Term, Name, Arity0), 1534 Arity is Arity0 + Extra. 1535 1536 1537 /******************************* 1538 * CACHE CLEANUP * 1539 *******************************/ 1540 1541:- listen(settings(changed(http:prefix, _, _)), 1542 next_generation). 1543 1544:- multifile 1545 user:message_hook/3. 1546:- dynamic 1547 user:message_hook/3. 1548 1549user:message_hook(make(done(Reload)), _Level, _Lines) :- 1550 Reload \== [], 1551 next_generation, 1552 fail
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:*/