/* Part of SWI-Prolog Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org Copyright (c) 2008-2014, University of Amsterdam VU University Amsterdam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ :- module(http_path, [ http_absolute_uri/2, % +Spec, -URI http_absolute_location/3, % +Spec, -Path, +Options http_clean_location_cache/0 ]). :- use_module(library(lists)). :- use_module(library(error)). :- use_module(library(apply)). :- use_module(library(debug)). :- use_module(library(option)). :- use_module(library(settings)). :- use_module(library(broadcast)). :- use_module(library(uri)). :- use_module(library(http/http_host)). :- use_module(library(http/http_wrapper)). :- predicate_options(http_absolute_location/3, 3, [relative_to(atom)]). /** Abstract specification of HTTP server locations This module provides an abstract specification of HTTP server locations that is inspired on absolute_file_name/3. The specification is done by adding rules to the dynamic multifile predicate http:location/3. The speficiation is very similar to user:file_search_path/2, but takes an additional argument with options. Currently only one option is defined: * priority(+Integer) If two rules match, take the one with highest priority. Using priorities is needed because we want to be able to overrule paths, but we do not want to become dependent on clause ordering. The default priority is 0. Note however that notably libraries may decide to provide a fall-back using a negative priority. We suggest -100 for such cases. This library predefines a single location at priority -100: * root The root of the server. Default is /, but this may be overruled using the setting (see setting/2) =|http:prefix|= To serve additional resource files such as CSS, JavaScript and icons, see `library(http/http_server_files)`. Here is an example that binds =|/login|= to login/1. The user can reuse this application while moving all locations using a new rule for the admin location with the option =|[priority(10)]|=. == :- multifile http:location/3. :- dynamic http:location/3. http:location(admin, /, []). :- http_handler(admin(login), login, []). login(Request) :- ... == */ :- setting(http:prefix, atom, '', 'Prefix for all locations of this server'). %! http:location(+Alias, -Expansion, -Options) is nondet. % % Multifile hook used to specify new HTTP locations. Alias is the % name of the abstract path. Expansion is either a term % Alias2(Relative), telling http_absolute_location/3 to translate % Alias by first translating Alias2 and then applying the relative % path Relative or, Expansion is an absolute location, i.e., one % that starts with a =|/|=. Options currently only supports the % priority of the path. If http:location/3 returns multiple % solutions the one with the highest priority is selected. The % default priority is 0. % % This library provides a default for the abstract location % =root=. This defaults to the setting http:prefix or, when not % available to the path =|/|=. It is adviced to define all % locations (ultimately) relative to =root=. For example, use % root('home.html') rather than =|'/home.html'|=. :- multifile http:location/3. % Alias, Expansion, Options :- dynamic http:location/3. % Alias, Expansion, Options http:location(root, Root, [priority(-100)]) :- ( setting(http:prefix, Prefix), Prefix \== '' -> Root = Prefix ; Root = (/) ). %! http_absolute_uri(+Spec, -URI) is det. % % URI is the absolute (i.e., starting with =|http://|=) URI for % the abstract specification Spec. Use http_absolute_location/3 to % create references to locations on the same server. % % @tbd Distinguish =http= from =https= http_absolute_uri(Spec, URI) :- http_current_host(_Request, Host, Port, [ global(true) ]), http_absolute_location(Spec, Path, []), uri_authority_data(host, AuthC, Host), ( Port == 80 % HTTP scheme -> true ; uri_authority_data(port, AuthC, Port) ), uri_authority_components(Authority, AuthC), uri_data(path, Components, Path), uri_data(scheme, Components, http), uri_data(authority, Components, Authority), uri_components(URI, Components). %! http_absolute_location(+Spec, -Path, +Options) is det. % % Path is the HTTP location for the abstract specification Spec. % Options: % % * relative_to(Base) % Path is made relative to Base. Default is to generate % absolute URLs. % % @see http_absolute_uri/2 to create a reference that can be % used on another server. :- dynamic location_cache/3. http_absolute_location(Spec, Path, Options) :- must_be(ground, Spec), option(relative_to(Base), Options, /), absolute_location(Spec, Base, Path, Options), debug(http_path, '~q (~q) --> ~q', [Spec, Base, Path]). absolute_location(Spec, Base, Path, _Options) :- location_cache(Spec, Base, Cache), !, Path = Cache. absolute_location(Spec, Base, Path, Options) :- expand_location(Spec, Base, L, Options), assert(location_cache(Spec, Base, L)), Path = L. expand_location(Spec, Base, Path, _Options) :- atomic(Spec), !, ( uri_components(Spec, Components), uri_data(scheme, Components, Scheme), atom(Scheme) -> Path = Spec ; relative_to(Base, Spec, Path) ). expand_location(Spec, _Base, Path, Options) :- Spec =.. [Alias, Sub], http_location_path(Alias, Parent), absolute_location(Parent, /, ParentLocation, Options), phrase(path_list(Sub), List), atomic_list_concat(List, /, SubAtom), ( ParentLocation == '' -> Path = SubAtom ; sub_atom(ParentLocation, _, _, 0, /) -> atom_concat(ParentLocation, SubAtom, Path) ; atomic_list_concat([ParentLocation, SubAtom], /, Path) ). %! http_location_path(+Alias, -Expansion) is det. % % Expansion is the expanded HTTP location for Alias. As we have no % condition search, we demand a single expansion for an alias. An % ambiguous alias results in a printed warning. A lacking alias % results in an exception. % % @error existence_error(http_alias, Alias) http_location_path(Alias, Path) :- findall(P-L, http_location_path(Alias, L, P), Pairs), sort(Pairs, Sorted0), reverse(Sorted0, Result), ( Result = [_-One] -> Path = One ; Result == [] -> existence_error(http_alias, Alias) ; Result = [P-Best,P2-_|_], P \== P2 -> Path = Best ; Result = [_-First|_], pairs_values(Result, Paths), print_message(warning, http(ambiguous_location(Alias, Paths))), Path = First ). %! http_location_path(+Alias, -Path, -Priority) is nondet. % % @tbd prefix(Path) is discouraged; use root(Path) http_location_path(Alias, Path, Priority) :- http:location(Alias, Path, Options), option(priority(Priority), Options, 0). http_location_path(prefix, Path, 0) :- ( catch(setting(http:prefix, Prefix), _, fail), Prefix \== '' -> ( sub_atom(Prefix, 0, _, _, /) -> Path = Prefix ; atom_concat(/, Prefix, Path) ) ; Path = / ). %! relative_to(+Base, +Path, -AbsPath) is det. % % AbsPath is an absolute URL location created from Base and Path. % The result is cleaned relative_to(/, Path, Path) :- !. relative_to(_Base, Path, Path) :- sub_atom(Path, 0, _, _, /), !. relative_to(Base, Local, Path) :- sub_atom(Base, 0, _, _, /), % file version !, path_segments(Base, BaseSegments), append(BaseDir, [_], BaseSegments) -> path_segments(Local, LocalSegments), append(BaseDir, LocalSegments, Segments0), clean_segments(Segments0, Segments), path_segments(Path, Segments). relative_to(Base, Local, Global) :- uri_normalized(Local, Base, Global). path_segments(Path, Segments) :- atomic_list_concat(Segments, /, Path). %! clean_segments(+SegmentsIn, -SegmentsOut) is det. % % Clean a path represented as a segment list, removing empty % segments and resolving .. based on syntax. clean_segments([''|T0], [''|T]) :- !, exclude(empty_segment, T0, T1), clean_parent_segments(T1, T). clean_segments(T0, T) :- exclude(empty_segment, T0, T1), clean_parent_segments(T1, T). clean_parent_segments([], []). clean_parent_segments([..|T0], T) :- !, clean_parent_segments(T0, T). clean_parent_segments([_,..|T0], T) :- !, clean_parent_segments(T0, T). clean_parent_segments([H|T0], [H|T]) :- clean_parent_segments(T0, T). empty_segment(''). empty_segment('.'). %! path_list(+Spec, -List) is det. % % Translate seg1/seg2/... into [seg1,seg2,...]. % % @error instantiation_error % @error type_error(atomic, X) path_list(Var) --> { var(Var), !, instantiation_error(Var) }. path_list(A/B) --> !, path_list(A), path_list(B). path_list(.) --> !, []. path_list(A) --> { must_be(atomic, A) }, [A]. /******************************* * MESSAGES * *******************************/ :- multifile prolog:message/3. prolog:message(http(ambiguous_location(Spec, Paths))) --> [ 'http_absolute_location/2: ambiguous specification: ~q: ~p'- [Spec, Paths] ]. /******************************* * CACHE CLEANUP * *******************************/ %! http_clean_location_cache % % HTTP locations resolved through http_absolute_location/3 are % cached. This predicate wipes the cache. The cache is % automatically wiped by make/0 and if the setting http:prefix is % changed. http_clean_location_cache :- retractall(location_cache(_,_,_)). :- listen(settings(changed(http:prefix, _, _)), http_clean_location_cache). :- multifile user:message_hook/3. :- dynamic user:message_hook/3. user:message_hook(make(done(Reload)), _Level, _Lines) :- Reload \== [], http_clean_location_cache, fail.