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