Chris@0
|
1 /* This file is part of ClioPatria.
|
Chris@0
|
2
|
Chris@0
|
3 Author: Jan Wielemaker
|
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_host,
|
Chris@0
|
25 [ http_current_host/4 % +Request, -Host, -Port, +Options
|
Chris@0
|
26 ]).
|
Chris@0
|
27 :- use_module(library('http/thread_httpd')).
|
Chris@0
|
28 :- use_module(library(socket)).
|
Chris@0
|
29 :- use_module(library(option)).
|
Chris@0
|
30 :- use_module(library(settings)).
|
Chris@0
|
31
|
Chris@0
|
32 :- setting(http:public_host, atom, '',
|
Chris@0
|
33 'Name the outside world can use to contact me').
|
Chris@0
|
34
|
Chris@0
|
35 %% http_current_host(+Request, -Hostname, -Port, Options) is det.
|
Chris@0
|
36 %
|
Chris@0
|
37 % Current global host and port of the HTTP server. This is the
|
Chris@0
|
38 % basis to form absolute address, which we need for redirection
|
Chris@0
|
39 % based interaction such as the OpenID protocol. Options are:
|
Chris@0
|
40 %
|
Chris@0
|
41 % * global(+Bool)
|
Chris@0
|
42 % If =true= (default =false=), try to replace a local hostname
|
Chris@0
|
43 % by a world-wide accessible name.
|
Chris@0
|
44
|
Chris@0
|
45 http_current_host(Request, Host, Port, Options) :-
|
Chris@0
|
46 ( memberchk(x_forwarded_host(Forwarded), Request)
|
Chris@0
|
47 -> Port = 80,
|
Chris@0
|
48 primary_forwarded_host(Forwarded, Host)
|
Chris@0
|
49 ; memberchk(host(Host0), Request),
|
Chris@0
|
50 ( option(global(true), Options, false)
|
Chris@0
|
51 -> global_host(Host0, Host)
|
Chris@0
|
52 ; Host = Host0
|
Chris@0
|
53 ),
|
Chris@0
|
54 option(port(Port), Request, 80)
|
Chris@0
|
55 -> true
|
Chris@0
|
56 ; gethostname(Host),
|
Chris@0
|
57 http_current_server(_Pred, Port) % TBD: May be more
|
Chris@0
|
58 ).
|
Chris@0
|
59
|
Chris@0
|
60
|
Chris@0
|
61 %% primary_forwarded_host(+Spec, -Host) is det.
|
Chris@0
|
62 %
|
Chris@0
|
63 % x_forwarded host contains multiple hosts seperated by ', ' if
|
Chris@0
|
64 % there are multiple proxy servers in between. The first one is
|
Chris@0
|
65 % the one the user's browser knows about.
|
Chris@0
|
66
|
Chris@0
|
67 primary_forwarded_host(Spec, Host) :-
|
Chris@0
|
68 sub_atom(Spec, B, _, _, ','), !,
|
Chris@0
|
69 sub_atom(Spec, 0, B, _, Host).
|
Chris@0
|
70 primary_forwarded_host(Host, Host).
|
Chris@0
|
71
|
Chris@0
|
72
|
Chris@0
|
73 %% global_host(+HostIn, -Host)
|
Chris@0
|
74 %
|
Chris@0
|
75 % Globalize a hostname. Used if we need to pass our hostname to a
|
Chris@0
|
76 % client and expect the client to be able to contact us. In this
|
Chris@0
|
77 % case we cannot use a name such as `localhost' or the plain
|
Chris@0
|
78 % hostname of the machine. We assume (possibly wrongly) that if
|
Chris@0
|
79 % the host contains a '.', it is globally accessible.
|
Chris@0
|
80 %
|
Chris@0
|
81 % If the heuristics used by this predicate do not suffice, the
|
Chris@0
|
82 % setting http:public_host can be used to override.
|
Chris@0
|
83
|
Chris@0
|
84 global_host(_, Host) :-
|
Chris@0
|
85 setting(http:public_host, PublicHost), PublicHost \== '', !,
|
Chris@0
|
86 Host = PublicHost.
|
Chris@0
|
87 global_host(localhost, Host) :- !,
|
Chris@0
|
88 gethostname(Host).
|
Chris@0
|
89 global_host(Local, Host) :-
|
Chris@0
|
90 sub_atom(Local, _, _, _, '.'), !,
|
Chris@0
|
91 Host = Local.
|
Chris@0
|
92 global_host(Local, Host) :-
|
Chris@0
|
93 tcp_host_to_address(Local, IP),
|
Chris@0
|
94 tcp_host_to_address(Host, IP).
|
Chris@0
|
95
|
Chris@0
|
96
|