kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/ext/http/http/http_session.pl

@@ -0,0 +1,1040 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker, Matt Lilley
+    E-mail:        J.Wielemaker@cs.vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2006-2025, University of Amsterdam
+                              VU University Amsterdam
+                              CWI, Amsterdam
+                              SWI-Prolog Solutions b.v.
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(http_session,
+          [ http_set_session_options/1, % +Options
+            http_set_session/1,         % +Option
+            http_set_session/2,         % +SessionId, +Option
+            http_session_option/1,      % ?Option
+
+            http_session_id/1,          % -SessionId
+            http_in_session/1,          % -SessionId
+            http_current_session/2,     % ?SessionId, ?Data
+            http_close_session/1,       % +SessionId
+            http_open_session/2,        % -SessionId, +Options
+
+            http_session_cookie/1,      % -Cookie
+
+            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
+
+            http_session_asserta/2,     % +Data, +SessionId
+            http_session_assert/2,      % +Data, +SessionId
+            http_session_retract/2,     % ?Data, +SessionId
+            http_session_retractall/2,  % +Data, +SessionId
+            http_session_data/2         % ?Data, +SessionId
+          ]).
+:- use_module(http_wrapper).
+:- use_module(http_stream).
+:- use_module(library(error)).
+:- use_module(library(debug)).
+:- use_module(library(socket)).
+:- use_module(library(broadcast)).
+:- use_module(library(lists)).
+:- use_module(library(option)).
+
+:- predicate_options(http_open_session/2, 2, [renew(boolean)]).
+
+/** <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.  By  default,  this  module
+creates a session whenever a request  is   processes  that is inside the
+hierarchy  defined  for   session   handling    (see   path   option  in
+http_set_session_options/1).  Automatic creation  of  a session  can  be
+stopped    using    the    option    create(noauto).    The    predicate
+http_open_session/2 must be used to  create   a  session  if =noauto= is
+enabled. Sessions can be closed using http_close_session/1.
+
+If a session is active, http_in_session/1   returns  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
+
+:- multifile
+    hooked/0,
+    hook/1,                         % +Term
+    session_setting/1,
+    session_option/2.
+
+session_setting(timeout(600)).      % timeout in seconds
+session_setting(granularity(60)).   % granularity for timeout
+session_setting(cookie('swipl_session')).
+session_setting(path(/)).
+session_setting(enabled(true)).
+session_setting(create(auto)).
+session_setting(proxy_enabled(false)).
+session_setting(gc(passive)).
+session_setting(samesite(lax)).
+session_setting(http_only(false)).
+session_setting(secure(false)).
+
+session_option(timeout, integer).
+session_option(granularity, integer).
+session_option(cookie, atom).
+session_option(path, atom).
+session_option(create, oneof([auto,noauto])).
+session_option(route, atom).
+session_option(enabled, boolean).
+session_option(proxy_enabled, boolean).
+session_option(gc, oneof([active,passive])).
+session_option(samesite, oneof([none,lax,strict])).
+session_option(http_only, boolean).
+session_option(secure, 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).
+%           A timeout of `0` (zero) disables timeout.
+%
+%           * 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. Session management
+%           is enabled by default after loading this file.
+%
+%           * create(+Atom)
+%           Defines when a session is created. This is one of =auto=
+%           (default), which creates a session if there is a request
+%           whose path matches the defined session path or =noauto=,
+%           in which cases sessions are only created by calling
+%           http_open_session/2 explicitly.
+%
+%           * proxy_enabled(+Boolean)
+%           Enable/disable proxy session management. Proxy session
+%           management associates the _originating_ IP address of
+%           the client to the session rather than the _proxy_ IP
+%           address. Default is false.
+%
+%           * gc(+When)
+%           When is one of `active`, which starts a thread that
+%           performs session cleanup at close to the moment of the
+%           timeout or `passive`, which runs session GC when a new
+%           session is created.
+%
+%           * samesite(+Restriction)
+%           One of `none`, `lax` (default), or `strict` - The
+%           SameSite attribute prevents the CSRF vulnerability.
+%           strict has best security, but prevents links from
+%           external sites from operating properly. lax stops most
+%           CSRF attacks against REST endpoints but rarely interferes
+%           with legit image operations. `none` removes the samesite
+%           attribute entirely. __Caution: The value `none` exposes the
+%           entire site to CSRF attacks__.
+%
+%           * http_only(+Boolean)
+%           If `true` (default `false`), add the ``HttpOnly`` property
+%           to the session cookie. This causes the browser to deny
+%           access from JavaScript.
+%
+%           * secure(+Boolean)
+%           If `true`, (default `false`), add the ``Secure`` property
+%           to the session cookie.   This causes the browser to report
+%           the cookie only over HTTPS connections.
+%
+%           * granularity(+Integer)
+%           Granularity for updating that the session is active. Default
+%           is 60 (seconds). Smaller values lead to more precise session
+%           timeout at the cost of more database updates.  This may
+%           notably a problem when using Redis.
+%
+%   In addition, extension libraries can define session_option/2 to make
+%   this   predicate   support    more     options.    In    particular,
+%   library(http/http_redis_plugin)  defines  the  following  additional
+%   options:
+%
+%     - redis_db(+DB)
+%       Alias name of the redis database to access.  See redis_server/3.
+%     - redis_ro(+DB)
+%       Alias name of the redis database for read-only access. See
+%       redis_server/3.
+%     - redis_prefix(+Atom)
+%       Prefix to use for all HTTP session related keys.  Default is
+%       `'swipl:http:session'`
+
+http_set_session_options([]) => true.
+http_set_session_options([H|T]) =>
+    http_set_session_option(H),
+    http_set_session_options(T).
+
+http_set_session_option(Option), Option =.. [Name,Value] =>
+    (   session_option(Name, Type)
+    ->  must_be(Type, Value)
+    ;   domain_error(http_session_option, Option)
+    ),
+    functor(Free, Name, 1),
+    (   clause(session_setting(Free), _, Ref)
+    ->  (   Free \== Value
+        ->  asserta(session_setting(Option)),
+            erase(Ref),
+            updated_session_setting(Name, Free, Value)
+        ;   true
+        )
+    ;   asserta(session_setting(Option))
+    ).
+
+%!  http_session_option(?Option) is nondet.
+%
+%   True if Option is a current option of the session system.
+
+http_session_option(Option) :-
+    session_setting(Option).
+
+%!  session_setting(+SessionID, ?Setting) is semidet.
+%
+%   Find setting for SessionID. It  is   possible  to  overrule some
+%   session settings using http_session_set(Setting).
+
+:- public session_setting/2.
+
+session_setting(SessionID, Setting) :-
+    nonvar(Setting),
+    get_session_option(SessionID, Setting),
+    !.
+session_setting(_, Setting) :-
+    session_setting(Setting).
+
+get_session_option(SessionID, Setting) :-
+    hooked,
+    !,
+    hook(get_session_option(SessionID, Setting)).
+get_session_option(SessionID, Setting) :-
+    functor(Setting, Name, 1),
+    local_option(Name, Value, Term),
+    session_data(SessionID, '$setting'(Term)),
+    !,
+    arg(1, Setting, Value).
+
+
+updated_session_setting(gc, _, passive) :-
+    stop_session_gc_thread, !.
+updated_session_setting(_, _, _).               % broadcast?
+
+
+%!  http_set_session(Setting) is det.
+%!  http_set_session(SessionId, Setting) is det.
+%
+%   Overrule  a  setting  for  the  current  or  specified  session.
+%   Currently, the only setting that can be overruled is =timeout=.
+%
+%   @error  permission_error(set, http_session, Setting) if setting
+%           a setting that is not supported on per-session basis.
+
+http_set_session(Setting) :-
+    http_session_id(SessionId),
+    http_set_session(SessionId, Setting).
+
+http_set_session(SessionId, Setting) :-
+    functor(Setting, Name, _),
+    (   local_option(Name, _, _)
+    ->  true
+    ;   permission_error(set, http_session, Setting)
+    ),
+    arg(1, Setting, Value),
+    (   session_option(Name, Type)
+    ->  must_be(Type, Value)
+    ;   domain_error(http_session_option, Setting)
+    ),
+    set_session_option(SessionId, Setting).
+
+set_session_option(SessionId, Setting) :-
+    hooked,
+    !,
+    hook(set_session_option(SessionId, Setting)).
+set_session_option(SessionId, Setting) :-
+    functor(Setting, Name, Arity),
+    functor(Free, Name, Arity),
+    retractall(session_data(SessionId, '$setting'(Free))),
+    assert(session_data(SessionId, '$setting'(Setting))).
+
+local_option(timeout, X, timeout(X)).
+
+%!  http_session_id(-SessionId) is det.
+%
+%   True if SessionId is an identifier for the current session.
+%
+%   @arg   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  loop   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 \== [],
+    !,
+    debug(http_session, 'Session id from global variable: ~q', [ID]),
+    ID \== no_session,
+    SessionID = ID.
+http_in_session(SessionID) :-
+    http_current_request(Request),
+    http_in_session(Request, SessionID).
+
+http_in_session(Request, SessionID) :-
+    memberchk(session(ID), Request),
+    !,
+    debug(http_session, 'Session id from request: ~q', [ID]),
+    b_setval(http_session_id, ID),
+    SessionID = ID.
+http_in_session(Request, SessionID) :-
+    memberchk(cookie(Cookies), Request),
+    session_setting(cookie(Cookie)),
+    member(Cookie=SessionID0, Cookies),
+    debug(http_session, 'Session id from cookie: ~q', [SessionID0]),
+    peer(Request, Peer),
+    valid_session_id(SessionID0, Peer),
+    !,
+    b_setval(http_session_id, SessionID0),
+    SessionID = SessionID0.
+
+
+%!  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.
+%
+%   This predicate creates a  session  if   the  setting  create  is
+%   =auto=.  If  create  is  =noauto=,  the  application  must  call
+%   http_open_session/1 to create a session.
+
+http_session(Request, Request, SessionID) :-
+    memberchk(session(SessionID0), Request),
+    !,
+    SessionID = SessionID0.
+http_session(Request0, Request, SessionID) :-
+    memberchk(cookie(Cookies), Request0),
+    session_setting(cookie(Cookie)),
+    member(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(create(auto)),
+    session_setting(path(Path)),
+    memberchk(path(ReqPath), Request0),
+    sub_atom(ReqPath, 0, _, _, Path),
+    !,
+    create_session(Request0, Request, SessionID).
+
+create_session(Request0, Request, SessionID) :-
+    http_gc_sessions,
+    http_session_cookie(SessionID),
+    session_setting(cookie(Cookie)),
+    session_setting(path(Path)),
+    cookie_attributes(Attrs),
+    atomics_to_string([''|Attrs], '; ', AttrString),
+    debug(http_session, 'Created session ~q at path=~q', [SessionID, Path]),
+    format('Set-Cookie: ~w=~w; Path=~w; Version=1~w\r\n',
+           [ Cookie, SessionID, Path, AttrString ]),
+    Request = [session(SessionID)|Request0],
+    peer(Request0, Peer),
+    open_session(SessionID, Peer).
+
+cookie_attributes([SameSite|Attrs]) :-
+    session_setting(samesite(Value)),
+    Value \== none,
+    !,
+    string_concat('SameSite=', Value, SameSite),
+    cookie_attributes1(Attrs).
+cookie_attributes(Attrs) :-
+    cookie_attributes1(Attrs).
+
+cookie_attributes1(['HttpOnly'|Attrs]) :-
+    session_setting(http_only(true)),
+    !,
+    cookie_attributes2(Attrs).
+cookie_attributes1(Attrs) :-
+    cookie_attributes2(Attrs).
+
+cookie_attributes2(['Secure']) :-
+    session_setting(secure(true)),
+    !.
+cookie_attributes2([]).
+
+
+%!  http_open_session(-SessionID, +Options) is det.
+%
+%   Establish a new session.  This is normally used if the create
+%   option is set to =noauto=.  Options:
+%
+%     * renew(+Boolean)
+%     If =true= (default =false=) and the current request is part
+%     of a session, generate a new session-id.  By default, this
+%     predicate returns the current session as obtained with
+%     http_in_session/1.
+%
+%   @see    http_set_session_options/1 to control the =create= option.
+%   @see    http_close_session/1 for closing the session.
+%   @error  permission_error(open, http_session, CGI) if this call
+%           is used after closing the CGI header.
+
+http_open_session(SessionID, Options) :-
+    http_in_session(SessionID0),
+    \+ option(renew(true), Options, false),
+    !,
+    SessionID = SessionID0.
+http_open_session(SessionID, _Options) :-
+    (   in_header_state
+    ->  true
+    ;   current_output(CGI),
+        permission_error(open, http_session, CGI)
+    ),
+    (   http_in_session(ActiveSession)
+    ->  http_close_session(ActiveSession, false)
+    ;   true
+    ),
+    http_current_request(Request),
+    create_session(Request, _, SessionID).
+
+
+:- multifile
+    http:request_expansion/2.
+
+http:request_expansion(Request0, Request) :-
+    session_setting(enabled(true)),
+    http_session(Request0, Request, _SessionID).
+
+%!  peer(+Request, -Peer) is det.
+%
+%   Find peer for current request. If   unknown we leave it unbound.
+%   Alternatively we should treat this as an error.
+
+peer(Request, Peer) :-
+    (   session_setting(proxy_enabled(true)),
+        http_peer(Request, Peer)
+    ->  true
+    ;   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) :-
+    assert_session(SessionID, Peer),
+    b_setval(http_session_id, SessionID),
+    broadcast(http_session(begin(SessionID, Peer))).
+
+assert_session(SessionID, Peer) :-
+    hooked,
+    !,
+    hook(assert_session(SessionID, Peer)).
+assert_session(SessionID, Peer) :-
+    get_time(Now),
+    assert(current_session(SessionID, Peer)),
+    assert(last_used(SessionID, Now)).
+
+%!  valid_session_id(+SessionID, +Peer) is semidet.
+%
+%   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) :-
+    active_session(SessionID, SessionPeer, LastUsed),
+    get_time(Now),
+    (   session_setting(SessionID, timeout(Timeout)),
+        Timeout > 0
+    ->  Idle is Now - LastUsed,
+        (   Idle =< Timeout
+        ->  true
+        ;   http_close_session(SessionID),
+            fail
+        )
+    ;   Peer \== SessionPeer
+    ->  http_close_session(SessionID),
+        fail
+    ;   true
+    ),
+    set_last_used(SessionID, Now, Timeout).
+
+active_session(SessionID, Peer, LastUsed) :-
+    hooked,
+    !,
+    hook(active_session(SessionID, Peer, LastUsed)).
+active_session(SessionID, Peer, LastUsed) :-
+    current_session(SessionID, Peer),
+    get_last_used(SessionID, LastUsed).
+
+get_last_used(SessionID, Last) :-
+    atom(SessionID),
+    !,
+    once(last_used(SessionID, Last)).
+get_last_used(SessionID, Last) :-
+    last_used(SessionID, Last).
+
+%!  set_last_used(+SessionID, +Now, +TimeOut)
+%
+%   Set the last-used notion for SessionID  from the current time stamp.
+%   The time is rounded down  to  10   second  intervals  to  avoid many
+%   updates and simplify the scheduling of session GC.
+
+set_last_used(SessionID, Now, TimeOut) :-
+    hooked,
+    !,
+    hook(set_last_used(SessionID, Now, TimeOut)).
+set_last_used(SessionID, Now, _TimeOut) :-
+    session_setting(granularity(TimeGranularity)),
+    LastUsed is floor(Now/TimeGranularity)*TimeGranularity,
+    (   clause(last_used(SessionID, CurrentLast), _, Ref)
+    ->  (   CurrentLast == LastUsed
+        ->  true
+        ;   asserta(last_used(SessionID, LastUsed)),
+            erase(Ref)
+        )
+    ;   asserta(last_used(SessionID, LastUsed))
+    ).
+
+
+                 /*******************************
+                 *         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),
+    (   hooked
+    ->  hook(asserta(session_data(SessionId, Data)))
+    ;   asserta(session_data(SessionId, Data))
+    ).
+
+http_session_assert(Data) :-
+    http_session_id(SessionId),
+    (   hooked
+    ->  hook(assertz(session_data(SessionId, Data)))
+    ;   assertz(session_data(SessionId, Data))
+    ).
+
+http_session_retract(Data) :-
+    http_session_id(SessionId),
+    (   hooked
+    ->  hook(retract(session_data(SessionId, Data)))
+    ;   retract(session_data(SessionId, Data))
+    ).
+
+http_session_retractall(Data) :-
+    http_session_id(SessionId),
+    (   hooked
+    ->  hook(retractall(session_data(SessionId, Data)))
+    ;   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.
+%
+%   @error  existence_error(http_session,_)
+
+http_session_data(Data) :-
+    http_session_id(SessionId),
+    (   hooked
+    ->  hook(session_data(SessionId, Data))
+    ;   session_data(SessionId, Data)
+    ).
+
+%!  http_session_asserta(+Data, +SessionID) is det.
+%!  http_session_assert(+Data, +SessionID) is det.
+%!  http_session_retract(?Data, +SessionID) is nondet.
+%!  http_session_retractall(@Data, +SessionID) is det.
+%!  http_session_data(?Data, +SessionID) is det.
+%
+%   Versions of assert/1, retract/1 and retractall/1 that associate data
+%   with an explicit HTTP session.
+%
+%   @see http_current_session/2.
+
+http_session_asserta(Data, SessionId) :-
+    must_be(atom, SessionId),
+    (   hooked
+    ->  hook(asserta(session_data(SessionId, Data)))
+    ;   asserta(session_data(SessionId, Data))
+    ).
+
+http_session_assert(Data, SessionId) :-
+    must_be(atom, SessionId),
+    (   hooked
+    ->  hook(assertz(session_data(SessionId, Data)))
+    ;   assertz(session_data(SessionId, Data))
+    ).
+
+http_session_retract(Data, SessionId) :-
+    must_be(atom, SessionId),
+    (   hooked
+    ->  hook(retract(session_data(SessionId, Data)))
+    ;   retract(session_data(SessionId, Data))
+    ).
+
+http_session_retractall(Data, SessionId) :-
+    must_be(atom, SessionId),
+    (   hooked
+    ->  hook(retractall(session_data(SessionId, Data)))
+    ;   retractall(session_data(SessionId, Data))
+    ).
+
+http_session_data(Data, SessionId) :-
+    must_be(atom, SessionId),
+    (   hooked
+    ->  hook(session_data(SessionId, Data))
+    ;   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) :-
+    hooked,
+    !,
+    hook(current_session(SessionID, Data)).
+http_current_session(SessionID, Data) :-
+    get_time(Now),
+    get_last_used(SessionID, Last), % binds SessionID
+    Idle is Now - Last,
+    (   session_setting(SessionID, 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.
+%
+%   If http_close_session/1 is called from   a  handler operating in
+%   the current session  and  the  CGI   stream  is  still  in state
+%   =header=, this predicate emits a   =|Set-Cookie|=  to expire the
+%   cookie.
+%
+%   @error  type_error(atom, SessionID)
+%   @see    listen/2 for acting upon closed sessions
+
+http_close_session(SessionId) :-
+    http_close_session(SessionId, true).
+
+http_close_session(SessionId, Expire) :-
+    hooked,
+    !,
+    forall(hook(close_session(SessionId)),
+           expire_session_cookie(Expire)).
+http_close_session(SessionId, Expire) :-
+    must_be(atom, SessionId),
+    (   current_session(SessionId, Peer),
+        (   b_setval(http_session_id, SessionId),
+            broadcast(http_session(end(SessionId, Peer))),
+            fail
+        ;   true
+        ),
+        expire_session_cookie(Expire),
+        retractall(current_session(SessionId, _)),
+        retractall(last_used(SessionId, _)),
+        retractall(session_data(SessionId, _)),
+        fail
+    ;   true
+    ).
+
+
+%!  expire_session_cookie(+Expire) is det.
+%
+%   Emit a request to delete a session  cookie. This is only done if
+%   http_close_session/1 is still in `header mode'.
+
+expire_session_cookie(true) :-
+    !,
+    expire_session_cookie.
+expire_session_cookie(_).
+
+expire_session_cookie :-
+    in_header_state,
+    session_setting(cookie(Cookie)),
+    session_setting(path(Path)),
+    !,
+    format('Set-Cookie: ~w=; \c
+                expires=Tue, 01-Jan-1970 00:00:00 GMT; \c
+                path=~w\r\n',
+           [Cookie, Path]).
+expire_session_cookie.
+
+in_header_state :-
+    current_output(CGI),
+    is_cgi_stream(CGI),
+    cgi_property(CGI, state(header)),
+    !.
+
+
+%!  http_gc_sessions is det.
+%!  http_gc_sessions(+TimeOut) is det.
+%
+%   Delete dead sessions. There are two  modes. if gc(passive) is active
+%   (default), session GC is executed if a new session is created and if
+%   the last GC was more than `granularity`  ago. If gc(active) is on, a
+%   thread is created that  runs  the   session  GC  every `granularity`
+%   seconds.
+%
+%   http_gc_sessions/0 is called each time when a session is created.
+
+:- dynamic
+    last_gc/1.
+
+http_gc_sessions :-
+    session_setting(gc(active)),
+    !,
+    start_session_gc_thread.
+http_gc_sessions :-
+    session_setting(granularity(TimeGranularity)),
+    http_gc_sessions(TimeGranularity).
+
+http_gc_sessions(TimeOut) :-
+    (   with_mutex(http_session_gc, need_sesion_gc(TimeOut))
+    ->  do_http_gc_sessions
+    ;   true
+    ).
+
+need_sesion_gc(TimeOut) :-
+    get_time(Now),
+    (   last_gc(LastGC),
+        Now-LastGC < TimeOut
+    ->  fail
+    ;   retractall(last_gc(_)),
+        asserta(last_gc(Now))
+    ).
+
+do_http_gc_sessions :-
+    hooked,
+    !,
+    hook(gc_sessions).
+do_http_gc_sessions :-
+    debug(http_session(gc), 'Running HTTP session GC', []),
+    get_time(Now),
+    (   session_setting(SessionID, timeout(Timeout)),
+        last_used(SessionID, Last),
+        Timeout > 0,
+        Idle is Now - Last,
+        Idle > Timeout,
+        http_close_session(SessionID, false),
+        fail
+    ;   true
+    ).
+
+%!  start_session_gc_thread is det.
+%!  stop_session_gc_thread is det.
+%
+%   Create/stop a thread that listens for timeout-at timing and wakes up
+%   to run http_gc_sessions/1 shortly after a   session  is scheduled to
+%   timeout.
+
+:- dynamic
+    session_gc_queue/1.
+
+start_session_gc_thread :-
+    session_gc_queue(_),
+    !.
+start_session_gc_thread :-
+    session_setting(gc(active)),
+    !,
+    catch(thread_create(session_gc_loop, _,
+                        [ alias('__http_session_gc'),
+                          at_exit(retractall(session_gc_queue(_))),
+                          inherit_from(main)
+                        ]),
+          error(permission_error(create, thread, _),_),
+          true).
+start_session_gc_thread.
+
+stop_session_gc_thread :-
+    retract(session_gc_queue(Id)),
+    !,
+    thread_send_message(Id, done),
+    thread_join(Id, _).
+stop_session_gc_thread.
+
+session_gc_loop :-
+    thread_self(GcQueue),
+    asserta(session_gc_queue(GcQueue)),
+    session_gc_loop_.
+
+session_gc_loop_ :-
+    session_setting(gc(active)),
+    session_setting(granularity(TimeGranularity)),
+    get_time(Now),
+    At is Now+TimeGranularity,
+    thread_self(GcQueue),
+    repeat,
+    (   thread_get_message(GcQueue, Message, [deadline(At)])
+    ->  (   Message == done
+        ->  !
+        ;   fail
+        )
+    ;   !,
+        http_gc_sessions(10),       % short time, so it runs
+        session_gc_loop_
+    ).
+
+
+                 /*******************************
+                 *             UTIL             *
+                 *******************************/
+
+%!  http_session_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.
+
+http_session_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]).
+http_session_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
+%   balancing  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
+    ).
+
+:- if(\+current_prolog_flag(windows, true)).
+%!  urandom(-Handle) is semidet.
+%
+%   Handle is a stream-handle  for   ``/dev/urandom``.  Originally, this
+%   simply tried to open ``/dev/urandom``, failing   if this device does
+%   not exist. It turns out  that   trying  to open ``/dev/urandom`` can
+%   block indefinitely on some Windows installations,   so  we no longer
+%   try this on Windows.
+
+:- 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.
+:- endif.
+
+%!  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.
+
+:- if(current_predicate(urandom/1)).
+random_4(R1,R2,R3,R4) :-
+    urandom(In),
+    !,
+    get_pair(In, R1),
+    get_pair(In, R2),
+    get_pair(In, R3),
+    get_pair(In, R4).
+:- endif.
+random_4(R1,R2,R3,R4) :-
+    R1 is random(65536),
+    R2 is random(65536),
+    R3 is random(65536),
+    R4 is random(65536).
+
+%!  hooked is semidet.
+%!  hook(+Goal).
+%
+%   These multifile predicates may be used to   hook the data storage of
+%   this     library.     An     example       is     implemented     by
+%   library(http/http_redis_plugin), storing all session data in a redis
+%   database.