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