Chris@0: /*  This file is part of ClioPatria.
Chris@0: 
Chris@0:     Author:	Jan Wielemaker
Chris@0:     HTTP:	http://e-culture.multimedian.nl/
Chris@0:     GITWEB:	http://gollem.science.uva.nl/git/ClioPatria.git
Chris@0:     GIT:	git://gollem.science.uva.nl/home/git/ClioPatria.git
Chris@0:     GIT:	http://gollem.science.uva.nl/home/git/ClioPatria.git
Chris@0:     Copyright:  2007, E-Culture/MultimediaN
Chris@0: 
Chris@0:     ClioPatria is free software: you can redistribute it and/or modify
Chris@0:     it under the terms of the GNU General Public License as published by
Chris@0:     the Free Software Foundation, either version 2 of the License, or
Chris@0:     (at your option) any later version.
Chris@0: 
Chris@0:     ClioPatria is distributed in the hope that it will be useful,
Chris@0:     but WITHOUT ANY WARRANTY; without even the implied warranty of
Chris@0:     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Chris@0:     GNU General Public License for more details.
Chris@0: 
Chris@0:     You should have received a copy of the GNU General Public License
Chris@0:     along with ClioPatria.  If not, see <http://www.gnu.org/licenses/>.
Chris@0: */
Chris@0: 
Chris@0: :- module(http_host,
Chris@0: 	  [ http_current_host/4		% +Request, -Host, -Port, +Options
Chris@0: 	  ]).
Chris@0: :- use_module(library('http/thread_httpd')).
Chris@0: :- use_module(library(socket)).
Chris@0: :- use_module(library(option)).
Chris@0: :- use_module(library(settings)).
Chris@0: 
Chris@0: :- setting(http:public_host, atom, '',
Chris@0: 	   'Name the outside world can use to contact me').
Chris@0: 
Chris@0: %%	http_current_host(+Request, -Hostname, -Port, Options) is det.
Chris@0: %
Chris@0: %	Current global host and port of the HTTP server.  This is the
Chris@0: %	basis to form absolute address, which we need for redirection
Chris@0: %	based interaction such as the OpenID protocol.  Options are:
Chris@0: %	
Chris@0: %	    * global(+Bool)
Chris@0: %	    If =true= (default =false=), try to replace a local hostname
Chris@0: %	    by a world-wide accessible name.
Chris@0: 
Chris@0: http_current_host(Request, Host, Port, Options) :-
Chris@0: 	(   memberchk(x_forwarded_host(Forwarded), Request)
Chris@0: 	->  Port = 80,
Chris@0: 	    primary_forwarded_host(Forwarded, Host)
Chris@0: 	;   memberchk(host(Host0), Request),
Chris@0: 	    (	option(global(true), Options, false)
Chris@0: 	    ->	global_host(Host0, Host)
Chris@0: 	    ;	Host = Host0
Chris@0: 	    ),
Chris@0: 	    option(port(Port), Request, 80)
Chris@0: 	->  true
Chris@0: 	;   gethostname(Host),
Chris@0: 	    http_current_server(_Pred, Port)		% TBD: May be more
Chris@0: 	).
Chris@0: 
Chris@0: 
Chris@0: %%	primary_forwarded_host(+Spec, -Host) is det.
Chris@0: %
Chris@0: %	x_forwarded host contains multiple hosts seperated   by  ', ' if
Chris@0: %	there are multiple proxy servers in   between.  The first one is
Chris@0: %	the one the user's browser knows about.
Chris@0: 
Chris@0: primary_forwarded_host(Spec, Host) :-
Chris@0: 	sub_atom(Spec, B, _, _, ','), !,
Chris@0: 	sub_atom(Spec, 0, B, _, Host).
Chris@0: primary_forwarded_host(Host, Host).
Chris@0: 
Chris@0: 
Chris@0: %%	global_host(+HostIn, -Host)
Chris@0: %
Chris@0: %	Globalize a hostname. Used if we need  to pass our hostname to a
Chris@0: %	client and expect the client to be   able to contact us. In this
Chris@0: %	case we cannot use a  name  such   as  `localhost'  or the plain
Chris@0: %	hostname of the machine. We assume   (possibly  wrongly) that if
Chris@0: %	the host contains a '.', it is globally accessible.
Chris@0: %	
Chris@0: %	If the heuristics used by  this   predicate  do not suffice, the
Chris@0: %	setting http:public_host can be used to override.
Chris@0: 
Chris@0: global_host(_, Host) :-
Chris@0: 	setting(http:public_host, PublicHost), PublicHost \== '', !,
Chris@0: 	Host = PublicHost.
Chris@0: global_host(localhost, Host) :- !,
Chris@0: 	gethostname(Host).
Chris@0: global_host(Local, Host) :-
Chris@0: 	sub_atom(Local, _, _, _, '.'), !,
Chris@0: 	Host = Local.
Chris@0: global_host(Local, Host) :-
Chris@0: 	tcp_host_to_address(Local, IP),
Chris@0: 	tcp_host_to_address(Host, IP).
Chris@0: 
Chris@0: