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