513 lines
14 KiB
Perl
513 lines
14 KiB
Perl
|
/* $Id$
|
||
|
|
|
||
|
|
Part of SWI-Prolog
|
||
|
|
|
||
|
|
Author: Jan Wielemaker
|
||
|
|
E-mail: wielemak@science.uva.nl
|
||
|
|
WWW: http://www.swi-prolog.org
|
||
|
|
Copyright (C): 2006, University of Amsterdam
|
||
|
|
|
||
|
|
This program is free software; you can redistribute it and/or
|
||
|
|
modify it under the terms of the GNU General Public License
|
||
|
|
as published by the Free Software Foundation; either version 2
|
||
|
|
of the License, or (at your option) any later version.
|
||
|
|
|
||
|
|
This program is distributed in the hope that it will be useful,
|
||
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
GNU General Public License for more details.
|
||
|
|
|
||
|
|
You should have received a copy of the GNU Lesser General Public
|
||
|
|
License along with this library; if not, write to the Free Software
|
||
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||
|
|
|
||
|
|
As a special exception, if you link this library with other files,
|
||
|
|
compiled with a Free Software compiler, to produce an executable, this
|
||
|
|
library does not by itself cause the resulting executable to be covered
|
||
|
|
by the GNU General Public License. This exception does not however
|
||
|
|
invalidate any other reasons why the executable file might be covered by
|
||
|
|
the GNU General Public License.
|
||
|
|
*/
|
||
|
|
|
||
|
|
|
||
|
|
:- module(http_session,
|
||
|
|
[ http_set_session_options/1, % +Options
|
||
|
|
|
||
|
|
http_session_id/1, % -SessionId
|
||
|
|
http_in_session/1, % -SessionId
|
||
|
|
http_current_session/2, % ?SessionId, ?Data
|
||
|
|
http_close_session/1, % +SessionId
|
||
|
|
|
||
|
|
http_session_asserta/1, % +Data
|
||
|
|
http_session_assert/1, % +Data
|
||
|
|
http_session_retract/1, % ?Data
|
||
|
|
http_session_retractall/1, % +Data
|
||
|
|
http_session_data/1 % ?Data
|
||
|
|
]).
|
||
|
|
:- use_module(http_wrapper).
|
||
|
|
:- use_module(library(error)).
|
||
|
|
:- use_module(library(debug)).
|
||
|
|
:- use_module(library(socket)).
|
||
|
|
:- use_module(library(broadcast)).
|
||
|
|
:- use_module(library(lists)).
|
||
|
|
|
||
|
|
/** <module> HTTP Session management
|
||
|
|
|
||
|
|
This library defines session management based on HTTP cookies. Session
|
||
|
|
management is enabled simply by loading this module. Details can be
|
||
|
|
modified using http_set_session_options/1. If sessions are enabled,
|
||
|
|
http_session_id/1 produces the current session and http_session_assert/1
|
||
|
|
and friends maintain data about the session. If the session is
|
||
|
|
reclaimed, all associated data is reclaimed too.
|
||
|
|
|
||
|
|
Begin and end of sessions can be monitored using library(broadcast). The
|
||
|
|
broadcasted messages are:
|
||
|
|
|
||
|
|
* http_session(begin(SessionID, Peer))
|
||
|
|
Broadcasted if a session is started
|
||
|
|
* http_session(end(SessionId, Peer))
|
||
|
|
Broadcasted if a session is ended. See http_close_session/1.
|
||
|
|
|
||
|
|
For example, the following calls end_session(SessionId) whenever a
|
||
|
|
session terminates. Please note that sessions ends are not scheduled to
|
||
|
|
happen at the actual timeout moment of the session. Instead, creating a
|
||
|
|
new session scans the active list for timed-out sessions. This may
|
||
|
|
change in future versions of this library.
|
||
|
|
|
||
|
|
==
|
||
|
|
:- listen(http_session(end(SessionId, Peer)),
|
||
|
|
end_session(SessionId)).
|
||
|
|
==
|
||
|
|
*/
|
||
|
|
|
||
|
|
:- dynamic
|
||
|
|
session_setting/1, % Name(Value)
|
||
|
|
current_session/2, % SessionId, Peer
|
||
|
|
last_used/2, % SessionId, Time
|
||
|
|
session_data/2. % SessionId, Data
|
||
|
|
|
||
|
|
session_setting(timeout(600)). % timeout in seconds
|
||
|
|
session_setting(cookie('swipl_session')).
|
||
|
|
session_setting(path(/)).
|
||
|
|
session_setting(enabled(true)).
|
||
|
|
|
||
|
|
session_option(timeout, integer).
|
||
|
|
session_option(cookie, atom).
|
||
|
|
session_option(path, atom).
|
||
|
|
session_option(route, atom).
|
||
|
|
session_option(enabled, boolean).
|
||
|
|
|
||
|
|
%% http_set_session_options(+Options) is det.
|
||
|
|
%
|
||
|
|
% Set options for the session library. Provided options are:
|
||
|
|
%
|
||
|
|
% * timeout(+Seconds)
|
||
|
|
% Session timeout in seconds. Default is 600 (10 min).
|
||
|
|
%
|
||
|
|
% * cookie(+Cookiekname)
|
||
|
|
% Name to use for the cookie to identify the session.
|
||
|
|
% Default =swipl_session=.
|
||
|
|
%
|
||
|
|
% * path(+Path)
|
||
|
|
% Path to which the cookie is associated. Default is
|
||
|
|
% =|/|=. Cookies are only sent if the HTTP request path
|
||
|
|
% is a refinement of Path.
|
||
|
|
%
|
||
|
|
% * route(+Route)
|
||
|
|
% Set the route name. Default is the unqualified
|
||
|
|
% hostname. To cancel adding a route, use the empty
|
||
|
|
% atom. See route/1.
|
||
|
|
%
|
||
|
|
% * enabled(+Boolean)
|
||
|
|
% Enable/disable session management. Sesion management
|
||
|
|
% is enabled by default after loading this file.
|
||
|
|
|
||
|
|
http_set_session_options([]).
|
||
|
|
http_set_session_options([H|T]) :-
|
||
|
|
http_session_option(H),
|
||
|
|
http_set_session_options(T).
|
||
|
|
|
||
|
|
http_session_option(Option) :-
|
||
|
|
functor(Option, Name, Arity),
|
||
|
|
arg(1, Option, Value),
|
||
|
|
( session_option(Name, Type)
|
||
|
|
-> must_be(Type, Value)
|
||
|
|
; domain_error(http_session_option, Option)
|
||
|
|
),
|
||
|
|
functor(Free, Name, Arity),
|
||
|
|
retractall(session_setting(Free)),
|
||
|
|
assert(session_setting(Option)).
|
||
|
|
|
||
|
|
%% http_session_id(-SessionId) is det.
|
||
|
|
%
|
||
|
|
% True if SessionId is an identifier for the current session.
|
||
|
|
%
|
||
|
|
% @param SessionId is an atom.
|
||
|
|
% @error existence_error(http_session, _)
|
||
|
|
% @see http_in_session/1 for a version that fails if there is
|
||
|
|
% no session.
|
||
|
|
|
||
|
|
http_session_id(SessionID) :-
|
||
|
|
( http_in_session(ID)
|
||
|
|
-> SessionID = ID
|
||
|
|
; throw(error(existence_error(http_session, _), _))
|
||
|
|
).
|
||
|
|
|
||
|
|
%% http_in_session(-SessionId) is semidet.
|
||
|
|
%
|
||
|
|
% True if SessionId is an identifier for the current session. The
|
||
|
|
% current session is extracted from session(ID) from the current
|
||
|
|
% HTTP request (see http_current_request/1). The value is cached
|
||
|
|
% in a backtrackable global variable =http_session_id=. Using a
|
||
|
|
% backtrackable global variable is safe because continuous worker
|
||
|
|
% threads use a failure driven look and spawned threads start
|
||
|
|
% without any global variables. This variable can be set from the
|
||
|
|
% commandline to fake running a goal from the commandline in the
|
||
|
|
% context of a session.
|
||
|
|
%
|
||
|
|
% @see http_session_id/1
|
||
|
|
|
||
|
|
http_in_session(SessionID) :-
|
||
|
|
( nb_current(http_session_id, ID),
|
||
|
|
ID \== []
|
||
|
|
-> true
|
||
|
|
; http_current_request(Request),
|
||
|
|
memberchk(session(ID), Request),
|
||
|
|
b_setval(http_session_id, ID)
|
||
|
|
; b_setval(http_session_id, no_session),
|
||
|
|
fail
|
||
|
|
),
|
||
|
|
ID \== no_session,
|
||
|
|
SessionID = ID.
|
||
|
|
|
||
|
|
%% http_session(+RequestIn, -RequestOut, -SessionID) is semidet.
|
||
|
|
%
|
||
|
|
% Maintain the notion of a session using a client-side cookie.
|
||
|
|
% This must be called first when handling a request that wishes to
|
||
|
|
% do session management, after which the possibly modified request
|
||
|
|
% must be used for further processing.
|
||
|
|
|
||
|
|
http_session(Request, Request, SessionID) :-
|
||
|
|
memberchk(session(SessionID0), Request), !,
|
||
|
|
SessionID = SessionID0.
|
||
|
|
http_session(Request0, Request, SessionID) :-
|
||
|
|
memberchk(cookie(Cookies), Request0),
|
||
|
|
session_setting(cookie(Cookie)),
|
||
|
|
memberchk(Cookie=SessionID0, Cookies),
|
||
|
|
peer(Request0, Peer),
|
||
|
|
valid_session_id(SessionID0, Peer), !,
|
||
|
|
SessionID = SessionID0,
|
||
|
|
Request = [session(SessionID)|Request0],
|
||
|
|
b_setval(http_session_id, SessionID).
|
||
|
|
http_session(Request0, Request, SessionID) :-
|
||
|
|
session_setting(path(Path)),
|
||
|
|
memberchk(path(ReqPath), Request0),
|
||
|
|
sub_atom(ReqPath, 0, _, _, Path), !,
|
||
|
|
http_gc_sessions, % GC dead sessions
|
||
|
|
gen_cookie(SessionID),
|
||
|
|
session_setting(cookie(Cookie)),
|
||
|
|
format('Set-Cookie: ~w=~w; path=~w~n', [Cookie, SessionID, Path]),
|
||
|
|
Request = [session(SessionID)|Request0],
|
||
|
|
peer(Request0, Peer),
|
||
|
|
open_session(SessionID, Peer),
|
||
|
|
b_setval(http_session_id, SessionID).
|
||
|
|
|
||
|
|
:- multifile
|
||
|
|
http:request_expansion/2.
|
||
|
|
|
||
|
|
http:request_expansion(Request0, Request) :-
|
||
|
|
session_setting(enabled(true)),
|
||
|
|
http_session(Request0, Request, _SessionID).
|
||
|
|
|
||
|
|
%% peer(+Request, -Peer)
|
||
|
|
%
|
||
|
|
% Find peer for current request. If unknown we leave it unbound.
|
||
|
|
% Alternatively we should treat this as an error.
|
||
|
|
|
||
|
|
peer(Request, Peer) :-
|
||
|
|
( memberchk(peer(Peer), Request)
|
||
|
|
-> true
|
||
|
|
; true
|
||
|
|
).
|
||
|
|
|
||
|
|
%% open_session(+SessionID, +Peer)
|
||
|
|
%
|
||
|
|
% Open a new session. Uses broadcast/1 with the term
|
||
|
|
% http_session(begin(SessionID, Peer)).
|
||
|
|
|
||
|
|
open_session(SessionID, Peer) :-
|
||
|
|
get_time(Now),
|
||
|
|
assert(current_session(SessionID, Peer)),
|
||
|
|
assert(last_used(SessionID, Now)),
|
||
|
|
broadcast(http_session(begin(SessionID, Peer))).
|
||
|
|
|
||
|
|
|
||
|
|
%% valid_session_id(+SessionID, +Peer)
|
||
|
|
%
|
||
|
|
% Check if this sessionID is known. If so, check the idle time and
|
||
|
|
% update the last_used for this session.
|
||
|
|
|
||
|
|
valid_session_id(SessionID, Peer) :-
|
||
|
|
current_session(SessionID, SessionPeer),
|
||
|
|
get_time(Now),
|
||
|
|
( session_setting(timeout(Timeout)),
|
||
|
|
Timeout > 0
|
||
|
|
-> get_last_used(SessionID, Last),
|
||
|
|
Idle is Now - Last,
|
||
|
|
( Idle =< Timeout
|
||
|
|
-> true
|
||
|
|
; http_close_session(SessionID),
|
||
|
|
fail
|
||
|
|
)
|
||
|
|
; Peer \== SessionPeer
|
||
|
|
-> http_close_session(SessionID),
|
||
|
|
fail
|
||
|
|
; true
|
||
|
|
),
|
||
|
|
set_last_used(SessionID, Now).
|
||
|
|
|
||
|
|
get_last_used(SessionID, Last) :-
|
||
|
|
atom(SessionID), !,
|
||
|
|
with_mutex(http_session, last_used(SessionID, Last)).
|
||
|
|
get_last_used(SessionID, Last) :-
|
||
|
|
with_mutex(http_session,
|
||
|
|
findall(SessionID-Last,
|
||
|
|
last_used(SessionID, Last),
|
||
|
|
Pairs)),
|
||
|
|
member(SessionID-Last, Pairs).
|
||
|
|
|
||
|
|
set_last_used(SessionID, Now) :-
|
||
|
|
with_mutex(http_session,
|
||
|
|
( retractall(last_used(SessionID, _)),
|
||
|
|
assert(last_used(SessionID, Now)))).
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
/*******************************
|
||
|
|
* SESSION DATA *
|
||
|
|
*******************************/
|
||
|
|
|
||
|
|
%% http_session_asserta(+Data) is det.
|
||
|
|
%% http_session_assert(+Data) is det.
|
||
|
|
%% http_session_retract(?Data) is nondet.
|
||
|
|
%% http_session_retractall(?Data) is det.
|
||
|
|
%
|
||
|
|
% Versions of assert/1, retract/1 and retractall/1 that associate
|
||
|
|
% data with the current HTTP session.
|
||
|
|
|
||
|
|
http_session_asserta(Data) :-
|
||
|
|
http_session_id(SessionId),
|
||
|
|
asserta(session_data(SessionId, Data)).
|
||
|
|
|
||
|
|
http_session_assert(Data) :-
|
||
|
|
http_session_id(SessionId),
|
||
|
|
assert(session_data(SessionId, Data)).
|
||
|
|
|
||
|
|
http_session_retract(Data) :-
|
||
|
|
http_session_id(SessionId),
|
||
|
|
retract(session_data(SessionId, Data)).
|
||
|
|
|
||
|
|
http_session_retractall(Data) :-
|
||
|
|
http_session_id(SessionId),
|
||
|
|
retractall(session_data(SessionId, Data)).
|
||
|
|
|
||
|
|
% http_session_data(?Data) is nondet.
|
||
|
|
%
|
||
|
|
% True if Data is associated using http_session_assert/1 to the
|
||
|
|
% current HTTP session.
|
||
|
|
|
||
|
|
http_session_data(Data) :-
|
||
|
|
http_session_id(SessionId),
|
||
|
|
session_data(SessionId, Data).
|
||
|
|
|
||
|
|
|
||
|
|
/*******************************
|
||
|
|
* ENUMERATE *
|
||
|
|
*******************************/
|
||
|
|
|
||
|
|
%% http_current_session(?SessionID, ?Data) is nondet.
|
||
|
|
%
|
||
|
|
% Enumerate the current sessions and associated data. There are
|
||
|
|
% two _Pseudo_ data elements:
|
||
|
|
%
|
||
|
|
% * idle(Seconds)
|
||
|
|
% Session has been idle for Seconds.
|
||
|
|
%
|
||
|
|
% * peer(Peer)
|
||
|
|
% Peer of the connection.
|
||
|
|
|
||
|
|
http_current_session(SessionID, Data) :-
|
||
|
|
get_time(Now),
|
||
|
|
get_last_used(SessionID, Last),
|
||
|
|
Idle is Now - Last,
|
||
|
|
( session_setting(timeout(Timeout)),
|
||
|
|
Timeout > 0
|
||
|
|
-> Idle =< Timeout
|
||
|
|
; true
|
||
|
|
),
|
||
|
|
( Data = idle(Idle)
|
||
|
|
; Data = peer(Peer),
|
||
|
|
current_session(SessionID, Peer)
|
||
|
|
; session_data(SessionID, Data)
|
||
|
|
).
|
||
|
|
|
||
|
|
|
||
|
|
/*******************************
|
||
|
|
* GC SESSIONS *
|
||
|
|
*******************************/
|
||
|
|
|
||
|
|
%% http_close_session(+SessionID) is det.
|
||
|
|
%
|
||
|
|
% Closes an HTTP session. This predicate can be called from any
|
||
|
|
% thread to terminate a session. It uses the broadcast/1 service
|
||
|
|
% with the message below.
|
||
|
|
%
|
||
|
|
% http_session(end(SessionId, Peer))
|
||
|
|
%
|
||
|
|
% The broadcast is done *before* the session data is destroyed and
|
||
|
|
% the listen-handlers are executed in context of the session that
|
||
|
|
% is being closed. Here is an example that destroys a Prolog
|
||
|
|
% thread that is associated to a thread:
|
||
|
|
%
|
||
|
|
% ==
|
||
|
|
% :- listen(http_session(end(SessionId, _Peer)),
|
||
|
|
% kill_session_thread(SessionID)).
|
||
|
|
%
|
||
|
|
% kill_session_thread(SessionID) :-
|
||
|
|
% http_session_data(thread(ThreadID)),
|
||
|
|
% thread_signal(ThreadID, throw(session_closed)).
|
||
|
|
% ==
|
||
|
|
%
|
||
|
|
% Succeed without any effect if SessionID does not refer to an
|
||
|
|
% active session.
|
||
|
|
%
|
||
|
|
% @error type_error(atom, SessionID)
|
||
|
|
% @see listen/2 for acting upon closed sessions
|
||
|
|
|
||
|
|
http_close_session(SessionId) :-
|
||
|
|
must_be(atom, SessionId),
|
||
|
|
( current_session(SessionId, Peer),
|
||
|
|
( b_setval(http_session_id, SessionId),
|
||
|
|
broadcast(http_session(end(SessionId, Peer))),
|
||
|
|
fail
|
||
|
|
; true
|
||
|
|
),
|
||
|
|
retractall(current_session(SessionId, _)),
|
||
|
|
retractall(last_used(SessionId, _)),
|
||
|
|
retractall(session_data(SessionId, _)),
|
||
|
|
fail
|
||
|
|
; true
|
||
|
|
).
|
||
|
|
|
||
|
|
% http_gc_sessions/0
|
||
|
|
%
|
||
|
|
% Delete dead sessions. When should we be calling this? This
|
||
|
|
% assumes that updated sessions are at the end of the clause list,
|
||
|
|
% so we can break as soon as we encounter a no-yet-timedout
|
||
|
|
% session.
|
||
|
|
|
||
|
|
http_gc_sessions :-
|
||
|
|
session_setting(timeout(Timeout)),
|
||
|
|
Timeout > 0, !,
|
||
|
|
get_time(Now),
|
||
|
|
( last_used(SessionID, Last),
|
||
|
|
Idle is Now - Last,
|
||
|
|
( Idle > Timeout
|
||
|
|
-> http_close_session(SessionID),
|
||
|
|
fail
|
||
|
|
; !
|
||
|
|
)
|
||
|
|
; true
|
||
|
|
).
|
||
|
|
http_gc_sessions.
|
||
|
|
|
||
|
|
|
||
|
|
/*******************************
|
||
|
|
* UTIL *
|
||
|
|
*******************************/
|
||
|
|
|
||
|
|
%% gen_cookie(-Cookie) is det.
|
||
|
|
%
|
||
|
|
% Generate a random cookie that can be used by a browser to
|
||
|
|
% identify the current session. The cookie has the format
|
||
|
|
% XXXX-XXXX-XXXX-XXXX[.<route>], where XXXX are random hexadecimal
|
||
|
|
% numbers and [.<route>] is the optionally added routing
|
||
|
|
% information.
|
||
|
|
|
||
|
|
gen_cookie(Cookie) :-
|
||
|
|
route(Route), !,
|
||
|
|
random_4(R1,R2,R3,R4),
|
||
|
|
format(atom(Cookie),
|
||
|
|
'~`0t~16r~4|-~`0t~16r~9|-~`0t~16r~14|-~`0t~16r~19|.~w',
|
||
|
|
[R1,R2,R3,R4,Route]).
|
||
|
|
gen_cookie(Cookie) :-
|
||
|
|
random_4(R1,R2,R3,R4),
|
||
|
|
format(atom(Cookie),
|
||
|
|
'~`0t~16r~4|-~`0t~16r~9|-~`0t~16r~14|-~`0t~16r~19|',
|
||
|
|
[R1,R2,R3,R4]).
|
||
|
|
|
||
|
|
:- thread_local
|
||
|
|
route_cache/1.
|
||
|
|
|
||
|
|
%% route(-RouteID) is semidet.
|
||
|
|
%
|
||
|
|
% Fetch the route identifier. This value is added as .<route> to
|
||
|
|
% the session cookie and used by -for example- the apache load
|
||
|
|
% balanching module. The default route is the local name of the
|
||
|
|
% host. Alternatives may be provided using
|
||
|
|
% http_set_session_options/1.
|
||
|
|
|
||
|
|
route(Route) :-
|
||
|
|
route_cache(Route), !,
|
||
|
|
Route \== ''.
|
||
|
|
route(Route) :-
|
||
|
|
route_no_cache(Route),
|
||
|
|
assert(route_cache(Route)),
|
||
|
|
Route \== ''.
|
||
|
|
|
||
|
|
route_no_cache(Route) :-
|
||
|
|
session_setting(route(Route)), !.
|
||
|
|
route_no_cache(Route) :-
|
||
|
|
gethostname(Host),
|
||
|
|
( sub_atom(Host, Before, _, _, '.')
|
||
|
|
-> sub_atom(Host, 0, Before, _, Route)
|
||
|
|
; Route = Host
|
||
|
|
).
|
||
|
|
|
||
|
|
|
||
|
|
%% random_4(-R1,-R2,-R3,-R4) is det.
|
||
|
|
%
|
||
|
|
% Generate 4 2-byte random numbers. Uses =|/dev/urandom|= when
|
||
|
|
% available to make prediction of the session IDs hard.
|
||
|
|
|
||
|
|
random_4(R1,R2,R3,R4) :-
|
||
|
|
urandom(In), !,
|
||
|
|
get_pair(In, R1),
|
||
|
|
get_pair(In, R2),
|
||
|
|
get_pair(In, R3),
|
||
|
|
get_pair(In, R4).
|
||
|
|
random_4(R1,R2,R3,R4) :-
|
||
|
|
R1 is random(65536),
|
||
|
|
R2 is random(65536),
|
||
|
|
R3 is random(65536),
|
||
|
|
R4 is random(65536).
|
||
|
|
|
||
|
|
:- dynamic
|
||
|
|
urandom_handle/1.
|
||
|
|
|
||
|
|
urandom(Handle) :-
|
||
|
|
urandom_handle(Handle), !,
|
||
|
|
Handle \== [].
|
||
|
|
urandom(Handle) :-
|
||
|
|
catch(open('/dev/urandom', read, In, [type(binary)]), _, fail), !,
|
||
|
|
assert(urandom_handle(In)),
|
||
|
|
Handle = In.
|
||
|
|
urandom(_) :-
|
||
|
|
assert(urandom_handle([])),
|
||
|
|
fail.
|
||
|
|
|
||
|
|
get_pair(In, Value) :-
|
||
|
|
get_byte(In, B1),
|
||
|
|
get_byte(In, B2),
|
||
|
|
Value is B1<<8+B2.
|