1/*  Part of SWI-Prolog
2
3    Author:        Jan Wielemaker
4    E-mail:        J.Wielemaker@uva.nl
5    WWW:           http://www.swi-prolog.org
6    Copyright (C): 2008, University of Amsterdam
7
8    This program is free software; you can redistribute it and/or
9    modify it under the terms of the GNU General Public License
10    as published by the Free Software Foundation; either version 2
11    of the License, or (at your option) any later version.
12
13    This program is distributed in the hope that it will be useful,
14    but WITHOUT ANY WARRANTY; without even the implied warranty of
15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16    GNU General Public License for more details.
17
18    You should have received a copy of the GNU General Public
19    License along with this library; if not, write to the Free Software
20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
21
22    As a special exception, if you link this library with other files,
23    compiled with a Free Software compiler, to produce an executable, this
24    library does not by itself cause the resulting executable to be covered
25    by the GNU General Public License. This exception does not however
26    invalidate any other reasons why the executable file might be covered by
27    the GNU General Public License.
28*/
29
30:- module(http_path,
31	  [ http_absolute_location/3	% +Spec, -Path, +Options
32	  ]).
33:- use_module(library(lists)).
34:- use_module(library(error)).
35:- use_module(library(apply)).
36:- use_module(library(debug)).
37:- use_module(library(option)).
38:- use_module(library(settings)).
39:- use_module(library(broadcast)).
40:- use_module(library(url)).
41
42
43/** <module> Abstract specification of HTTP server locations
44
45This module provides an abstract specification  of HTTP server locations
46that is inspired on absolute_file_name/3. The   specification is done by
47adding rules to the  dynamic   multifile  predicate http:location/3. The
48speficiation is very similar to   user:file_search_path/2,  but takes an
49additional argument with options. Currently only one option is defined:
50
51    * priority(+Integer)
52    If two rules match, take the one with highest priority.  Using
53    priorities is needed because we want to be able to overrule
54    paths, but we do not want to become dependent on clause ordering.
55
56    The default priority is 0. Note however that notably libraries may
57    decide to provide a fall-back using a negative priority.  We suggest
58    -100 for such cases.
59
60This library predefines three locations at   priority  -100: The =icons=
61and =css= aliases are intended for images   and css files and are backed
62up by file a file-search-path that  allows   finding  the  icons and css
63files that belong to the server infrastructure (e.g., http_dirindex/2).
64
65    * root
66    The root of the server.  Default is /, but this may be overruled
67    the the setting (see setting/2) =|http:prefix|=
68
69Here is an example that binds =|/login|=  to login/1. The user can reuse
70this application while moving all locations  using   a  new rule for the
71admin location with the option =|[priority(10)]|=.
72
73==
74:- multifile http:location/3.
75:- dynamic   http:location/3.
76
77http:location(admin, /, []).
78
79:- http_handler(admin(login), login, []).
80
81login(Request) :-
82	...
83==
84
85@tbd	Make this module replace the http:prefix option.
86@tbd	Remove hard-wired support for prefix().
87*/
88
89:- multifile
90	http:location/3.		% Alias, Expansion, Options
91:- dynamic
92	http:location/3.		% Alias, Expansion, Options
93
94http:location(root, Root, [priority(-100)]) :-
95	(   catch(setting(http:prefix, Prefix), _, fail),
96	    Prefix \== ''
97	->  Root = Prefix
98	;   Root = (/)
99	).
100
101
102%%	http_absolute_location(+Spec, -Path, +Options) is det.
103%
104%	Path is the HTTP location for the abstract specification Spec.
105%	Options:
106%
107%	    * relative_to(Base)
108%	    Path is made relative to Base.  Default is to generate
109%	    absolute URLs.
110
111:- dynamic
112	location_cache/3.
113
114http_absolute_location(Spec, Path, Options) :-
115	must_be(ground, Spec),
116	option(relative_to(Base), Options, /),
117	absolute_location(Spec, Base, Path, Options),
118	debug(http_path, '~q (~q) --> ~q', [Spec, Base, Path]).
119
120absolute_location(Spec, Base, Path, _Options) :-
121	location_cache(Spec, Base, Cache), !,
122	Path = Cache.
123absolute_location(Spec, Base, Path, Options) :-
124	expand_location(Spec, Base, L, Options),
125	assert(location_cache(Spec, Base, L)),
126	Path = L.
127
128expand_location(Spec, Base, Path, _Options) :-
129	atomic(Spec), !,
130	relative_to(Base, Spec, Path).
131expand_location(Spec, _Base, Path, Options) :-
132	Spec =.. [Alias, Sub],
133	http_location_path(Alias, Parent),
134	absolute_location(Parent, /, ParentLocation, Options),
135	phrase(path_list(Sub), List),
136	atomic_list_concat(List, /, SubAtom),
137	(   ParentLocation == ''
138	->  Path = SubAtom
139	;   sub_atom(ParentLocation, _, _, 0, /)
140	->  atom_concat(ParentLocation, SubAtom, Path)
141	;   atomic_list_concat([ParentLocation, SubAtom], /, Path)
142	).
143
144
145%%	http_location_path(+Alias, -Expansion) is det.
146%
147%	Expansion is the expanded HTTP location for Alias. As we have no
148%	condition search, we demand a single  expansion for an alias. An
149%	ambiguous alias results in a printed   warning.  A lacking alias
150%	results in an exception.
151%
152%	@error	existence_error(http_alias, Alias)
153
154http_location_path(Alias, Path) :-
155	findall(P-L, http_location_path(Alias, L, P), Pairs),
156	keysort(Pairs, Sorted0),
157	reverse(Sorted0, Result),
158	(   Result = [_-One]
159	->  Path = One
160	;   Result == []
161	->  existence_error(http_location, Spec)
162	;   Result = [P-Best,P2-_|_],
163	    P \== P2
164	->  Path = Best
165	;   Result = [_-First|_],
166	    pairs_values(Result, Paths),
167	    print_message(warning, http(ambiguous_location(Spec, Paths))),
168	    Path = First
169	).
170
171
172%%	http_location_path(+Alias, -Path, -Priority) is nondet.
173%
174%	@tbd	prefix(Path) is discouraged; use root(Path)
175
176http_location_path(Alias, Path, Priority) :-
177	http:location(Alias, Path, Options),
178	option(priority(Priority), Options, 0).
179http_location_path(prefix, Path, 0) :-
180	(   catch(setting(http:prefix, Prefix), _, fail),
181	    Prefix \== ''
182	->  (	sub_atom(Prefix, 0, _, _, /)
183	    ->  Path = Prefix
184	    ;	atom_concat(/, Prefix, Path)
185	    )
186	;   Path = /
187	).
188
189
190%%	relative_to(+Base, +Path, -AbsPath) is det.
191%
192%	AbsPath is an absolute URL location created from Base and Path.
193%	The result is cleaned
194
195relative_to(/, Path, Path) :- !.
196relative_to(_Base, Path, Path) :-
197	sub_atom(Path, 0, _, _, /), !.
198relative_to(Base, Local, Path) :-
199	sub_atom(Base, 0, _, _, /), !,	% file version
200	path_segments(Base, BaseSegments),
201	append(BaseDir, [_], BaseSegments) ->
202	path_segments(Local, LocalSegments),
203	append(BaseDir, LocalSegments, Segments0),
204	clean_segments(Segments0, Segments),
205	path_segments(Path, Segments).
206relative_to(Base, Local, Global) :-
207	global_url(Local, Base, Global).
208
209path_segments(Path, Segments) :-
210	atomic_list_concat(Segments, /, Path).
211
212%%	clean_segments(+SegmentsIn, -SegmentsOut) is det.
213%
214%	Clean a path represented  as  a   segment  list,  removing empty
215%	segments and resolving .. based on syntax.
216
217clean_segments([''|T0], [''|T]) :- !,
218	exclude(empty_segment, T0, T1),
219	clean_parent_segments(T1, T).
220clean_segments(T0, T) :-
221	exclude(empty_segment, T0, T1),
222	clean_parent_segments(T1, T).
223
224clean_parent_segments([], []).
225clean_parent_segments([..|T0], T) :- !,
226	clean_parent_segments(T0, T).
227clean_parent_segments([_,..|T0], T) :- !,
228	clean_parent_segments(T0, T).
229clean_parent_segments([H|T0], [H|T]) :-
230	clean_parent_segments(T0, T).
231
232empty_segment('').
233empty_segment('.').
234
235
236%%	path_list(+Spec, -List) is det.
237%
238%	Translate seg1/seg2/... into [seg1,seg2,...].
239%
240%	@error	instantiation_error
241%	@error	type_error(atomic, X)
242
243path_list(Var) -->
244	{ var(Var), !,
245	  instantiation_error(Var)
246	}.
247path_list(A/B) --> !,
248	path_list(A),
249	path_list(B).
250path_list(.) --> !,
251	[].
252path_list(A) -->
253	{ must_be(atomic, A) },
254	[A].
255
256
257		 /*******************************
258		 *	      MESSAGES		*
259		 *******************************/
260
261:- multifile
262	prolog:message/3.
263
264prolog:message(http(ambiguous_location(Spec, Paths))) -->
265	[ 'http_absolute_location/2: ambiguous specification: ~q: ~p'-[Spec, Paths]
266	].
267
268
269		 /*******************************
270		 *	  CACHE CLEANUP		*
271		 *******************************/
272
273clean_location_cache :-
274	retractall(location_cache(_,_,_)).
275
276:- listen(settings(changed(http:prefix, _, _)),
277	  clean_location_cache).
278
279:- multifile
280	user:message_hook/3.
281:- dynamic
282	user:message_hook/3.
283
284user:message_hook(make(done(Reload)), _Level, _Lines) :-
285	Reload \== [],
286	clean_location_cache,
287	fail.
288