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