|
Chris@0
|
1 /* This file is part of ClioPatria.
|
|
Chris@0
|
2
|
|
Chris@0
|
3 Author:
|
|
Chris@0
|
4 HTTP: http://e-culture.multimedian.nl/
|
|
Chris@0
|
5 GITWEB: http://gollem.science.uva.nl/git/ClioPatria.git
|
|
Chris@0
|
6 GIT: git://gollem.science.uva.nl/home/git/ClioPatria.git
|
|
Chris@0
|
7 GIT: http://gollem.science.uva.nl/home/git/ClioPatria.git
|
|
Chris@0
|
8 Copyright: 2007, E-Culture/MultimediaN
|
|
Chris@0
|
9
|
|
Chris@0
|
10 ClioPatria is free software: you can redistribute it and/or modify
|
|
Chris@0
|
11 it under the terms of the GNU General Public License as published by
|
|
Chris@0
|
12 the Free Software Foundation, either version 2 of the License, or
|
|
Chris@0
|
13 (at your option) any later version.
|
|
Chris@0
|
14
|
|
Chris@0
|
15 ClioPatria is distributed in the hope that it will be useful,
|
|
Chris@0
|
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
Chris@0
|
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
Chris@0
|
18 GNU General Public License for more details.
|
|
Chris@0
|
19
|
|
Chris@0
|
20 You should have received a copy of the GNU General Public License
|
|
Chris@0
|
21 along with ClioPatria. If not, see <http://www.gnu.org/licenses/>.
|
|
Chris@0
|
22 */
|
|
Chris@0
|
23
|
|
Chris@0
|
24 :- module(http_prefix,
|
|
Chris@0
|
25 [ http_setup_prefix_redirect/0,
|
|
Chris@0
|
26 http_current_path/2 % +Request, -Path
|
|
Chris@0
|
27 ]).
|
|
Chris@0
|
28 :- use_module(library('http/http_dispatch')).
|
|
Chris@0
|
29 :- use_module(library(settings)).
|
|
Chris@0
|
30 :- use_module(library(lists)).
|
|
Chris@0
|
31 :- use_module(library(debug)).
|
|
Chris@0
|
32 :- use_module(library(broadcast)).
|
|
Chris@0
|
33
|
|
Chris@0
|
34 /** <module> Set common prefix for all URLs
|
|
Chris@0
|
35
|
|
Chris@0
|
36 This module manages the setting http:prefix to redirect all requests
|
|
Chris@0
|
37 below prefix to the root. It can be used to relocate an entire server
|
|
Chris@0
|
38 under a new root.
|
|
Chris@0
|
39
|
|
Chris@0
|
40 @author Jan Wielemaker
|
|
Chris@0
|
41 */
|
|
Chris@0
|
42
|
|
Chris@0
|
43 :- setting(http:prefix, atom, env('SERQL_PREFIX', ''),
|
|
Chris@0
|
44 'Root of all URLs').
|
|
Chris@0
|
45
|
|
Chris@0
|
46
|
|
Chris@0
|
47 %% http_setup_prefix_redirect is det.
|
|
Chris@0
|
48 %
|
|
Chris@0
|
49 % If setting http:prefix is active, setup an HTTP handler to
|
|
Chris@0
|
50 % remove the prefix.
|
|
Chris@0
|
51
|
|
Chris@0
|
52 http_setup_prefix_redirect :-
|
|
Chris@0
|
53 remove_prefix_handler,
|
|
Chris@0
|
54 setting(http:prefix, Prefix),
|
|
Chris@0
|
55 Prefix \== '', !,
|
|
Chris@0
|
56 ( sub_atom(Prefix, _, _, 0, /)
|
|
Chris@0
|
57 -> ThePrefix = Prefix
|
|
Chris@0
|
58 ; atom_concat(Prefix, /, ThePrefix)
|
|
Chris@0
|
59 ),
|
|
Chris@0
|
60 http_handler(prefix(ThePrefix), redirect_prefix(ThePrefix), []).
|
|
Chris@0
|
61 http_setup_prefix_redirect.
|
|
Chris@0
|
62
|
|
Chris@0
|
63 remove_prefix_handler :-
|
|
Chris@0
|
64 ( http_current_handler(Path, redirect_prefix(_)),
|
|
Chris@0
|
65 http_delete_handler(Path),
|
|
Chris@0
|
66 fail ; true
|
|
Chris@0
|
67 ).
|
|
Chris@0
|
68
|
|
Chris@0
|
69 %% redirect_prefix(+Prefix, +Request).
|
|
Chris@0
|
70 %
|
|
Chris@0
|
71 % Handle paths below Prefix by removing Prefix and call http_dispatch/1
|
|
Chris@0
|
72 % on the result.
|
|
Chris@0
|
73
|
|
Chris@0
|
74 redirect_prefix(Prefix, Request) :-
|
|
Chris@0
|
75 select(path(Path0), Request, Request1),
|
|
Chris@0
|
76 atom_concat(Prefix, Path1, Path0),
|
|
Chris@0
|
77 atom_concat('/', Path1, Path),
|
|
Chris@0
|
78 debug(http_prefix, 'Redirected ~q --> ~q', [Path0, Path]),
|
|
Chris@0
|
79 http_dispatch([path(Path),x_redirected_path(Path0)|Request1]).
|
|
Chris@0
|
80
|
|
Chris@0
|
81 :- initialization
|
|
Chris@0
|
82 http_setup_prefix_redirect.
|
|
Chris@0
|
83
|
|
Chris@0
|
84 % allow for dynamic changes of the setting
|
|
Chris@0
|
85
|
|
Chris@0
|
86 :- listen(settings(changed(http:prefix, _, _)),
|
|
Chris@0
|
87 http_setup_prefix_redirect).
|
|
Chris@0
|
88
|
|
Chris@0
|
89 %% http_current_path(+Request, -Path) is det.
|
|
Chris@0
|
90 %
|
|
Chris@0
|
91 % Get the current location (path), even if the prefix was
|
|
Chris@0
|
92 % redirected,
|
|
Chris@0
|
93 %
|
|
Chris@0
|
94 % @see redirect_prefix/2.
|
|
Chris@0
|
95
|
|
Chris@0
|
96 http_current_path(Request, Path) :-
|
|
Chris@0
|
97 ( memberchk(x_redirected_path(Path0), Request)
|
|
Chris@0
|
98 -> Path = Path0
|
|
Chris@0
|
99 ; memberchk(path(Path), Request)
|
|
Chris@0
|
100 ).
|
