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) 2008-2014, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(http_path, 37 [ http_absolute_uri/2, % +Spec, -URI 38 http_absolute_location/3, % +Spec, -Path, +Options 39 http_clean_location_cache/0 40 ]). 41:- use_module(library(lists)). 42:- use_module(library(error)). 43:- use_module(library(apply)). 44:- use_module(library(debug)). 45:- use_module(library(option)). 46:- use_module(library(settings)). 47:- use_module(library(broadcast)). 48:- use_module(library(uri)). 49:- use_module(library(http/http_host)). 50:- use_module(library(http/http_wrapper)). 51 52 53:- predicate_options(http_absolute_location/3, 3, [relative_to(atom)]). 54 55/** <module> Abstract specification of HTTP server locations 56 57This module provides an abstract specification of HTTP server locations 58that is inspired on absolute_file_name/3. The specification is done by 59adding rules to the dynamic multifile predicate http:location/3. The 60speficiation is very similar to user:file_search_path/2, but takes an 61additional argument with options. Currently only one option is defined: 62 63 * priority(+Integer) 64 If two rules match, take the one with highest priority. Using 65 priorities is needed because we want to be able to overrule 66 paths, but we do not want to become dependent on clause ordering. 67 68 The default priority is 0. Note however that notably libraries may 69 decide to provide a fall-back using a negative priority. We suggest 70 -100 for such cases. 71 72This library predefines a single location at priority -100: 73 74 * root 75 The root of the server. Default is /, but this may be overruled 76 using the setting (see setting/2) =|http:prefix|= 77 78To serve additional resource files such as CSS, JavaScript and icons, 79see `library(http/http_server_files)`. 80 81Here is an example that binds =|/login|= to login/1. The user can reuse 82this application while moving all locations using a new rule for the 83admin location with the option =|[priority(10)]|=. 84 85 == 86 :- multifile http:location/3. 87 :- dynamic http:location/3. 88 89 http:location(admin, /, []). 90 91 :- http_handler(admin(login), login, []). 92 93 login(Request) :- 94 ... 95 == 96*/ 97 98:- setting(http:prefix, atom, '', 99 'Prefix for all locations of this server'). 100 101%! http:location(+Alias, -Expansion, -Options) is nondet. 102% 103% Multifile hook used to specify new HTTP locations. Alias is the 104% name of the abstract path. Expansion is either a term 105% Alias2(Relative), telling http_absolute_location/3 to translate 106% Alias by first translating Alias2 and then applying the relative 107% path Relative or, Expansion is an absolute location, i.e., one 108% that starts with a =|/|=. Options currently only supports the 109% priority of the path. If http:location/3 returns multiple 110% solutions the one with the highest priority is selected. The 111% default priority is 0. 112% 113% This library provides a default for the abstract location 114% =root=. This defaults to the setting http:prefix or, when not 115% available to the path =|/|=. It is adviced to define all 116% locations (ultimately) relative to =root=. For example, use 117% root('home.html') rather than =|'/home.html'|=. 118 119:- multifile 120 http:location/3. % Alias, Expansion, Options 121:- dynamic 122 http:location/3. % Alias, Expansion, Options 123 124http:location(root, Root, [priority(-100)]) :- 125 ( setting(http:prefix, Prefix), 126 Prefix \== '' 127 -> Root = Prefix 128 ; Root = (/) 129 ). 130 131 132%! http_absolute_uri(+Spec, -URI) is det. 133% 134% URI is the absolute (i.e., starting with =|http://|=) URI for 135% the abstract specification Spec. Use http_absolute_location/3 to 136% create references to locations on the same server. 137% 138% @tbd Distinguish =http= from =https= 139 140http_absolute_uri(Spec, URI) :- 141 http_current_host(_Request, Host, Port, 142 [ global(true) 143 ]), 144 http_absolute_location(Spec, Path, []), 145 uri_authority_data(host, AuthC, Host), 146 ( Port == 80 % HTTP scheme 147 -> true 148 ; uri_authority_data(port, AuthC, Port) 149 ), 150 uri_authority_components(Authority, AuthC), 151 uri_data(path, Components, Path), 152 uri_data(scheme, Components, http), 153 uri_data(authority, Components, Authority), 154 uri_components(URI, Components). 155 156 157%! http_absolute_location(+Spec, -Path, +Options) is det. 158% 159% Path is the HTTP location for the abstract specification Spec. 160% Options: 161% 162% * relative_to(Base) 163% Path is made relative to Base. Default is to generate 164% absolute URLs. 165% 166% @see http_absolute_uri/2 to create a reference that can be 167% used on another server. 168 169:- dynamic 170 location_cache/3. 171 172http_absolute_location(Spec, Path, Options) :- 173 must_be(ground, Spec), 174 option(relative_to(Base), Options, /), 175 absolute_location(Spec, Base, Path, Options), 176 debug(http_path, '~q (~q) --> ~q', [Spec, Base, Path]). 177 178absolute_location(Spec, Base, Path, _Options) :- 179 location_cache(Spec, Base, Cache), 180 !, 181 Path = Cache. 182absolute_location(Spec, Base, Path, Options) :- 183 expand_location(Spec, Base, L, Options), 184 assert(location_cache(Spec, Base, L)), 185 Path = L. 186 187expand_location(Spec, Base, Path, _Options) :- 188 atomic(Spec), 189 !, 190 ( uri_components(Spec, Components), 191 uri_data(scheme, Components, Scheme), 192 atom(Scheme) 193 -> Path = Spec 194 ; relative_to(Base, Spec, Path) 195 ). 196expand_location(Spec, _Base, Path, Options) :- 197 Spec =.. [Alias, Sub], 198 http_location_path(Alias, Parent), 199 absolute_location(Parent, /, ParentLocation, Options), 200 phrase(path_list(Sub), List), 201 atomic_list_concat(List, /, SubAtom), 202 ( ParentLocation == '' 203 -> Path = SubAtom 204 ; sub_atom(ParentLocation, _, _, 0, /) 205 -> atom_concat(ParentLocation, SubAtom, Path) 206 ; atomic_list_concat([ParentLocation, SubAtom], /, Path) 207 ). 208 209 210%! http_location_path(+Alias, -Expansion) is det. 211% 212% Expansion is the expanded HTTP location for Alias. As we have no 213% condition search, we demand a single expansion for an alias. An 214% ambiguous alias results in a printed warning. A lacking alias 215% results in an exception. 216% 217% @error existence_error(http_alias, Alias) 218 219http_location_path(Alias, Path) :- 220 findall(P-L, http_location_path(Alias, L, P), Pairs), 221 sort(Pairs, Sorted0), 222 reverse(Sorted0, Result), 223 ( Result = [_-One] 224 -> Path = One 225 ; Result == [] 226 -> existence_error(http_alias, Alias) 227 ; Result = [P-Best,P2-_|_], 228 P \== P2 229 -> Path = Best 230 ; Result = [_-First|_], 231 pairs_values(Result, Paths), 232 print_message(warning, http(ambiguous_location(Alias, Paths))), 233 Path = First 234 ). 235 236 237%! http_location_path(+Alias, -Path, -Priority) is nondet. 238% 239% @tbd prefix(Path) is discouraged; use root(Path) 240 241http_location_path(Alias, Path, Priority) :- 242 http:location(Alias, Path, Options), 243 option(priority(Priority), Options, 0). 244http_location_path(prefix, Path, 0) :- 245 ( catch(setting(http:prefix, Prefix), _, fail), 246 Prefix \== '' 247 -> ( sub_atom(Prefix, 0, _, _, /) 248 -> Path = Prefix 249 ; atom_concat(/, Prefix, Path) 250 ) 251 ; Path = / 252 ). 253 254 255%! relative_to(+Base, +Path, -AbsPath) is det. 256% 257% AbsPath is an absolute URL location created from Base and Path. 258% The result is cleaned 259 260relative_to(/, Path, Path) :- !. 261relative_to(_Base, Path, Path) :- 262 sub_atom(Path, 0, _, _, /), 263 !. 264relative_to(Base, Local, Path) :- 265 sub_atom(Base, 0, _, _, /), % file version 266 !, 267 path_segments(Base, BaseSegments), 268 append(BaseDir, [_], BaseSegments) -> 269 path_segments(Local, LocalSegments), 270 append(BaseDir, LocalSegments, Segments0), 271 clean_segments(Segments0, Segments), 272 path_segments(Path, Segments). 273relative_to(Base, Local, Global) :- 274 uri_normalized(Local, Base, Global). 275 276path_segments(Path, Segments) :- 277 atomic_list_concat(Segments, /, Path). 278 279%! clean_segments(+SegmentsIn, -SegmentsOut) is det. 280% 281% Clean a path represented as a segment list, removing empty 282% segments and resolving .. based on syntax. 283 284clean_segments([''|T0], [''|T]) :- 285 !, 286 exclude(empty_segment, T0, T1), 287 clean_parent_segments(T1, T). 288clean_segments(T0, T) :- 289 exclude(empty_segment, T0, T1), 290 clean_parent_segments(T1, T). 291 292clean_parent_segments([], []). 293clean_parent_segments([..|T0], T) :- 294 !, 295 clean_parent_segments(T0, T). 296clean_parent_segments([_,..|T0], T) :- 297 !, 298 clean_parent_segments(T0, T). 299clean_parent_segments([H|T0], [H|T]) :- 300 clean_parent_segments(T0, T). 301 302empty_segment(''). 303empty_segment('.'). 304 305 306%! path_list(+Spec, -List) is det. 307% 308% Translate seg1/seg2/... into [seg1,seg2,...]. 309% 310% @error instantiation_error 311% @error type_error(atomic, X) 312 313path_list(Var) --> 314 { var(Var), 315 !, 316 instantiation_error(Var) 317 }. 318path_list(A/B) --> 319 !, 320 path_list(A), 321 path_list(B). 322path_list(.) --> 323 !, 324 []. 325path_list(A) --> 326 { must_be(atomic, A) }, 327 [A]. 328 329 330 /******************************* 331 * MESSAGES * 332 *******************************/ 333 334:- multifile 335 prolog:message/3. 336 337prologmessage(http(ambiguous_location(Spec, Paths))) --> 338 [ 'http_absolute_location/2: ambiguous specification: ~q: ~p'- 339 [Spec, Paths] 340 ]. 341 342 343 /******************************* 344 * CACHE CLEANUP * 345 *******************************/ 346 347%! http_clean_location_cache 348% 349% HTTP locations resolved through http_absolute_location/3 are 350% cached. This predicate wipes the cache. The cache is 351% automatically wiped by make/0 and if the setting http:prefix is 352% changed. 353 354http_clean_location_cache :- 355 retractall(location_cache(_,_,_)). 356 357:- listen(settings(changed(http:prefix, _, _)), 358 http_clean_location_cache). 359 360:- multifile 361 user:message_hook/3. 362:- dynamic 363 user:message_hook/3. 364 365user:message_hook(make(done(Reload)), _Level, _Lines) :- 366 Reload \== [], 367 http_clean_location_cache, 368 fail.