1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker, Matt Lilley
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2006-2020, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(http_session,
   39          [ http_set_session_options/1, % +Options
   40            http_set_session/1,         % +Option
   41            http_set_session/2,         % +SessionId, +Option
   42            http_session_option/1,      % ?Option
   43
   44            http_session_id/1,          % -SessionId
   45            http_in_session/1,          % -SessionId
   46            http_current_session/2,     % ?SessionId, ?Data
   47            http_close_session/1,       % +SessionId
   48            http_open_session/2,        % -SessionId, +Options
   49
   50            http_session_cookie/1,      % -Cookie
   51
   52            http_session_asserta/1,     % +Data
   53            http_session_assert/1,      % +Data
   54            http_session_retract/1,     % ?Data
   55            http_session_retractall/1,  % +Data
   56            http_session_data/1,        % ?Data
   57
   58            http_session_asserta/2,     % +Data, +SessionId
   59            http_session_assert/2,      % +Data, +SessionId
   60            http_session_retract/2,     % ?Data, +SessionId
   61            http_session_retractall/2,  % +Data, +SessionId
   62            http_session_data/2         % ?Data, +SessionId
   63          ]).   64:- use_module(http_wrapper).   65:- use_module(http_stream).   66:- use_module(library(error)).   67:- use_module(library(debug)).   68:- use_module(library(socket)).   69:- use_module(library(broadcast)).   70:- use_module(library(lists)).   71:- use_module(library(time)).   72:- use_module(library(option)).   73
   74:- predicate_options(http_open_session/2, 2, [renew(boolean)]).   75
   76/** <module> HTTP Session management
   77
   78This library defines session management based   on HTTP cookies. Session
   79management is enabled simply by  loading   this  module.  Details can be
   80modified  using  http_set_session_options/1.  By  default,  this  module
   81creates a session whenever a request  is   processes  that is inside the
   82hierarchy  defined  for   session   handling    (see   path   option  in
   83http_set_session_options/1).  Automatic creation  of  a session  can  be
   84stopped    using    the    option    create(noauto).    The    predicate
   85http_open_session/2 must be used to  create   a  session  if =noauto= is
   86enabled. Sessions can be closed using http_close_session/1.
   87
   88If a session is active, http_in_session/1   returns  the current session
   89and http_session_assert/1 and friends maintain   data about the session.
   90If the session is reclaimed, all associated data is reclaimed too.
   91
   92Begin and end of sessions can be monitored using library(broadcast). The
   93broadcasted messages are:
   94
   95    * http_session(begin(SessionID, Peer))
   96    Broadcasted if a session is started
   97    * http_session(end(SessionId, Peer))
   98    Broadcasted if a session is ended. See http_close_session/1.
   99
  100For example, the  following  calls   end_session(SessionId)  whenever  a
  101session terminates. Please note that sessions  ends are not scheduled to
  102happen at the actual timeout moment of  the session. Instead, creating a
  103new session scans the  active  list   for  timed-out  sessions. This may
  104change in future versions of this library.
  105
  106    ==
  107    :- listen(http_session(end(SessionId, Peer)),
  108              end_session(SessionId)).
  109    ==
  110*/
  111
  112:- dynamic
  113    session_setting/1,              % Name(Value)
  114    current_session/2,              % SessionId, Peer
  115    last_used/2,                    % SessionId, Time
  116    session_data/2.                 % SessionId, Data
  117
  118:- multifile
  119    hooked/0,
  120    hook/1,                         % +Term
  121    session_option/2.  122
  123session_setting(timeout(600)).      % timeout in seconds
  124session_setting(cookie('swipl_session')).
  125session_setting(path(/)).
  126session_setting(enabled(true)).
  127session_setting(create(auto)).
  128session_setting(proxy_enabled(false)).
  129session_setting(gc(passive)).
  130session_setting(samesite(lax)).
  131
  132session_option(timeout, integer).
  133session_option(cookie, atom).
  134session_option(path, atom).
  135session_option(create, oneof([auto,noauto])).
  136session_option(route, atom).
  137session_option(enabled, boolean).
  138session_option(proxy_enabled, boolean).
  139session_option(gc, oneof([active,passive])).
  140session_option(samesite, oneof([none,lax,strict])).
  141
  142%!  http_set_session_options(+Options) is det.
  143%
  144%   Set options for the session library.  Provided options are:
  145%
  146%           * timeout(+Seconds)
  147%           Session timeout in seconds.  Default is 600 (10 min).
  148%           A timeout of `0` (zero) disables timeout.
  149%
  150%           * cookie(+Cookiekname)
  151%           Name to use for the cookie to identify the session.
  152%           Default =swipl_session=.
  153%
  154%           * path(+Path)
  155%           Path to which the cookie is associated.  Default is
  156%           =|/|=.  Cookies are only sent if the HTTP request path
  157%           is a refinement of Path.
  158%
  159%           * route(+Route)
  160%           Set the route name. Default is the unqualified
  161%           hostname. To cancel adding a route, use the empty
  162%           atom.  See route/1.
  163%
  164%           * enabled(+Boolean)
  165%           Enable/disable session management.  Sesion management
  166%           is enabled by default after loading this file.
  167%
  168%           * create(+Atom)
  169%           Defines when a session is created. This is one of =auto=
  170%           (default), which creates a session if there is a request
  171%           whose path matches the defined session path or =noauto=,
  172%           in which cases sessions are only created by calling
  173%           http_open_session/2 explicitely.
  174%
  175%           * proxy_enabled(+Boolean)
  176%           Enable/disable proxy session management. Proxy session
  177%           management associates the _originating_ IP address of
  178%           the client to the session rather than the _proxy_ IP
  179%           address. Default is false.
  180%
  181%           * gc(+When)
  182%           When is one of `active`, which starts a thread that
  183%           performs session cleanup at close to the moment of the
  184%           timeout or `passive`, which runs session GC when a new
  185%           session is created.
  186%
  187%           * samesite(+Restriction)
  188%           One of `none`, `lax` (default), or `strict` - The
  189%           SameSite attribute prevents the CSRF vulnerability.
  190%           strict has best security, but prevents links from
  191%           external sites from operating properly. lax stops most
  192%           CSRF attacks against REST endpoints but rarely interferes
  193%           with legitimage operations. `none` removes the samesite
  194%           attribute entirely. __Caution: The value `none` exposes the
  195%           entire site to CSRF attacks.__
  196%
  197%   In addition, extension libraries can define session_option/2 to make
  198%   this   predicate   support    more     options.    In    particular,
  199%   library(http/http_redis_plugin)  defines  the  following  additional
  200%   options:
  201%
  202%     - redis_db(+DB)
  203%       Alias name of the redis database to access.  See redis_server/2.
  204%     - redis_prefix(+Atom)
  205%       Prefix to use for all HTTP session related keys.  Default is
  206%       `'swipl:http:session'`
  207
  208http_set_session_options([]).
  209http_set_session_options([H|T]) :-
  210    http_set_session_option(H),
  211    http_set_session_options(T).
  212
  213http_set_session_option(Option) :-
  214    functor(Option, Name, Arity),
  215    arg(1, Option, Value),
  216    (   session_option(Name, Type)
  217    ->  must_be(Type, Value)
  218    ;   domain_error(http_session_option, Option)
  219    ),
  220    functor(Free, Name, Arity),
  221    (   clause(session_setting(Free), _, Ref)
  222    ->  (   Free \== Value
  223        ->  asserta(session_setting(Option)),
  224            erase(Ref),
  225            updated_session_setting(Name, Free, Value)
  226        ;   true
  227        )
  228    ;   asserta(session_setting(Option))
  229    ).
  230
  231%!  http_session_option(?Option) is nondet.
  232%
  233%   True if Option is a current option of the session system.
  234
  235http_session_option(Option) :-
  236    session_setting(Option).
  237
  238%!  session_setting(+SessionID, ?Setting) is semidet.
  239%
  240%   Find setting for SessionID. It  is   possible  to  overrule some
  241%   session settings using http_session_set(Setting).
  242
  243:- public session_setting/2.  244
  245session_setting(SessionID, Setting) :-
  246    nonvar(Setting),
  247    get_session_option(SessionID, Setting),
  248    !.
  249session_setting(_, Setting) :-
  250    session_setting(Setting).
  251
  252get_session_option(SessionID, Setting) :-
  253    hooked,
  254    !,
  255    hook(get_session_option(SessionID, Setting)).
  256get_session_option(SessionID, Setting) :-
  257    functor(Setting, Name, 1),
  258    local_option(Name, Value, Term),
  259    session_data(SessionID, '$setting'(Term)),
  260    !,
  261    arg(1, Setting, Value).
  262
  263
  264updated_session_setting(gc, _, passive) :-
  265    stop_session_gc_thread, !.
  266updated_session_setting(_, _, _).               % broadcast?
  267
  268
  269%!  http_set_session(Setting) is det.
  270%!  http_set_session(SessionId, Setting) is det.
  271%
  272%   Overrule  a  setting  for  the  current  or  specified  session.
  273%   Currently, the only setting that can be overruled is =timeout=.
  274%
  275%   @error  permission_error(set, http_session, Setting) if setting
  276%           a setting that is not supported on per-session basis.
  277
  278http_set_session(Setting) :-
  279    http_session_id(SessionId),
  280    http_set_session(SessionId, Setting).
  281
  282http_set_session(SessionId, Setting) :-
  283    functor(Setting, Name, _),
  284    (   local_option(Name, _, _)
  285    ->  true
  286    ;   permission_error(set, http_session, Setting)
  287    ),
  288    arg(1, Setting, Value),
  289    (   session_option(Name, Type)
  290    ->  must_be(Type, Value)
  291    ;   domain_error(http_session_option, Setting)
  292    ),
  293    set_session_option(SessionId, Setting).
  294
  295set_session_option(SessionId, Setting) :-
  296    hooked,
  297    !,
  298    hook(set_session_option(SessionId, Setting)).
  299set_session_option(SessionId, Setting) :-
  300    functor(Setting, Name, Arity),
  301    functor(Free, Name, Arity),
  302    retractall(session_data(SessionId, '$setting'(Free))),
  303    assert(session_data(SessionId, '$setting'(Setting))).
  304
  305local_option(timeout, X, timeout(X)).
  306
  307%!  http_session_id(-SessionId) is det.
  308%
  309%   True if SessionId is an identifier for the current session.
  310%
  311%   @arg   SessionId is an atom.
  312%   @error existence_error(http_session, _)
  313%   @see   http_in_session/1 for a version that fails if there is
  314%          no session.
  315
  316http_session_id(SessionID) :-
  317    (   http_in_session(ID)
  318    ->  SessionID = ID
  319    ;   throw(error(existence_error(http_session, _), _))
  320    ).
  321
  322%!  http_in_session(-SessionId) is semidet.
  323%
  324%   True if SessionId is an identifier  for the current session. The
  325%   current session is extracted from   session(ID) from the current
  326%   HTTP request (see http_current_request/1). The   value is cached
  327%   in a backtrackable global variable   =http_session_id=.  Using a
  328%   backtrackable global variable is safe  because continuous worker
  329%   threads use a failure driven  loop   and  spawned  threads start
  330%   without any global variables. This variable  can be set from the
  331%   commandline to fake running a goal   from the commandline in the
  332%   context of a session.
  333%
  334%   @see http_session_id/1
  335
  336http_in_session(SessionID) :-
  337    nb_current(http_session_id, ID),
  338    ID \== [],
  339    !,
  340    debug(http_session, 'Session id from global variable: ~q', [ID]),
  341    ID \== no_session,
  342    SessionID = ID.
  343http_in_session(SessionID) :-
  344    http_current_request(Request),
  345    http_in_session(Request, SessionID).
  346
  347http_in_session(Request, SessionID) :-
  348    memberchk(session(ID), Request),
  349    !,
  350    debug(http_session, 'Session id from request: ~q', [ID]),
  351    b_setval(http_session_id, ID),
  352    SessionID = ID.
  353http_in_session(Request, SessionID) :-
  354    memberchk(cookie(Cookies), Request),
  355    session_setting(cookie(Cookie)),
  356    member(Cookie=SessionID0, Cookies),
  357    debug(http_session, 'Session id from cookie: ~q', [SessionID0]),
  358    peer(Request, Peer),
  359    valid_session_id(SessionID0, Peer),
  360    !,
  361    b_setval(http_session_id, SessionID0),
  362    SessionID = SessionID0.
  363
  364
  365%!  http_session(+RequestIn, -RequestOut, -SessionID) is semidet.
  366%
  367%   Maintain the notion of a  session   using  a client-side cookie.
  368%   This must be called first when handling a request that wishes to
  369%   do session management, after which the possibly modified request
  370%   must be used for further processing.
  371%
  372%   This predicate creates a  session  if   the  setting  create  is
  373%   =auto=.  If  create  is  =noauto=,  the  application  must  call
  374%   http_open_session/1 to create a session.
  375
  376http_session(Request, Request, SessionID) :-
  377    memberchk(session(SessionID0), Request),
  378    !,
  379    SessionID = SessionID0.
  380http_session(Request0, Request, SessionID) :-
  381    memberchk(cookie(Cookies), Request0),
  382    session_setting(cookie(Cookie)),
  383    member(Cookie=SessionID0, Cookies),
  384    peer(Request0, Peer),
  385    valid_session_id(SessionID0, Peer),
  386    !,
  387    SessionID = SessionID0,
  388    Request = [session(SessionID)|Request0],
  389    b_setval(http_session_id, SessionID).
  390http_session(Request0, Request, SessionID) :-
  391    session_setting(create(auto)),
  392    session_setting(path(Path)),
  393    memberchk(path(ReqPath), Request0),
  394    sub_atom(ReqPath, 0, _, _, Path),
  395    !,
  396    create_session(Request0, Request, SessionID).
  397
  398create_session(Request0, Request, SessionID) :-
  399    http_gc_sessions,
  400    http_session_cookie(SessionID),
  401    session_setting(cookie(Cookie)),
  402    session_setting(path(Path)),
  403    session_setting(samesite(SameSite)),
  404    debug(http_session, 'Created session ~q at path=~q', [SessionID, Path]),
  405    (   SameSite == none
  406    ->  format('Set-Cookie: ~w=~w; Path=~w; Version=1\r\n',
  407               [Cookie, SessionID, Path])
  408    ;   format('Set-Cookie: ~w=~w; Path=~w; Version=1; SameSite=~w\r\n',
  409               [Cookie, SessionID, Path, SameSite])
  410    ),
  411    Request = [session(SessionID)|Request0],
  412    peer(Request0, Peer),
  413    open_session(SessionID, Peer).
  414
  415
  416%!  http_open_session(-SessionID, +Options) is det.
  417%
  418%   Establish a new session.  This is normally used if the create
  419%   option is set to =noauto=.  Options:
  420%
  421%     * renew(+Boolean)
  422%     If =true= (default =false=) and the current request is part
  423%     of a session, generate a new session-id.  By default, this
  424%     predicate returns the current session as obtained with
  425%     http_in_session/1.
  426%
  427%   @see    http_set_session_options/1 to control the =create= option.
  428%   @see    http_close_session/1 for closing the session.
  429%   @error  permission_error(open, http_session, CGI) if this call
  430%           is used after closing the CGI header.
  431
  432http_open_session(SessionID, Options) :-
  433    http_in_session(SessionID0),
  434    \+ option(renew(true), Options, false),
  435    !,
  436    SessionID = SessionID0.
  437http_open_session(SessionID, _Options) :-
  438    (   in_header_state
  439    ->  true
  440    ;   current_output(CGI),
  441        permission_error(open, http_session, CGI)
  442    ),
  443    (   http_in_session(ActiveSession)
  444    ->  http_close_session(ActiveSession, false)
  445    ;   true
  446    ),
  447    http_current_request(Request),
  448    create_session(Request, _, SessionID).
  449
  450
  451:- multifile
  452    http:request_expansion/2.  453
  454http:request_expansion(Request0, Request) :-
  455    session_setting(enabled(true)),
  456    http_session(Request0, Request, _SessionID).
  457
  458%!  peer(+Request, -Peer) is det.
  459%
  460%   Find peer for current request. If   unknown we leave it unbound.
  461%   Alternatively we should treat this as an error.
  462
  463peer(Request, Peer) :-
  464    (   session_setting(proxy_enabled(true)),
  465        http_peer(Request, Peer)
  466    ->  true
  467    ;   memberchk(peer(Peer), Request)
  468    ->  true
  469    ;   true
  470    ).
  471
  472%!  open_session(+SessionID, +Peer)
  473%
  474%   Open a new session.  Uses broadcast/1 with the term
  475%   http_session(begin(SessionID, Peer)).
  476
  477open_session(SessionID, Peer) :-
  478    assert_session(SessionID, Peer),
  479    b_setval(http_session_id, SessionID),
  480    broadcast(http_session(begin(SessionID, Peer))).
  481
  482assert_session(SessionID, Peer) :-
  483    hooked,
  484    !,
  485    hook(assert_session(SessionID, Peer)).
  486assert_session(SessionID, Peer) :-
  487    get_time(Now),
  488    assert(current_session(SessionID, Peer)),
  489    assert(last_used(SessionID, Now)).
  490
  491%!  valid_session_id(+SessionID, +Peer) is semidet.
  492%
  493%   Check if this sessionID is known. If so, check the idle time and
  494%   update the last_used for this session.
  495
  496valid_session_id(SessionID, Peer) :-
  497    active_session(SessionID, SessionPeer, LastUsed),
  498    get_time(Now),
  499    (   session_setting(SessionID, timeout(Timeout)),
  500        Timeout > 0
  501    ->  Idle is Now - LastUsed,
  502        (   Idle =< Timeout
  503        ->  true
  504        ;   http_close_session(SessionID),
  505            fail
  506        )
  507    ;   Peer \== SessionPeer
  508    ->  http_close_session(SessionID),
  509        fail
  510    ;   true
  511    ),
  512    set_last_used(SessionID, Now, Timeout).
  513
  514active_session(SessionID, Peer, LastUsed) :-
  515    hooked,
  516    !,
  517    hook(active_session(SessionID, Peer, LastUsed)).
  518active_session(SessionID, Peer, LastUsed) :-
  519    current_session(SessionID, Peer),
  520    get_last_used(SessionID, LastUsed).
  521
  522get_last_used(SessionID, Last) :-
  523    atom(SessionID),
  524    !,
  525    once(last_used(SessionID, Last)).
  526get_last_used(SessionID, Last) :-
  527    last_used(SessionID, Last).
  528
  529%!  set_last_used(+SessionID, +Now, +TimeOut)
  530%
  531%   Set the last-used notion for SessionID  from the current time stamp.
  532%   The time is rounded down  to  10   second  intervals  to  avoid many
  533%   updates and simplify the scheduling of session GC.
  534
  535set_last_used(SessionID, Now, TimeOut) :-
  536    hooked,
  537    !,
  538    hook(set_last_used(SessionID, Now, TimeOut)).
  539set_last_used(SessionID, Now, TimeOut) :-
  540    LastUsed is floor(Now/10)*10,
  541    (   clause(last_used(SessionID, CurrentLast), _, Ref)
  542    ->  (   CurrentLast == LastUsed
  543        ->  true
  544        ;   asserta(last_used(SessionID, LastUsed)),
  545            erase(Ref),
  546            schedule_gc(LastUsed, TimeOut)
  547        )
  548    ;   asserta(last_used(SessionID, LastUsed)),
  549        schedule_gc(LastUsed, TimeOut)
  550    ).
  551
  552
  553                 /*******************************
  554                 *         SESSION DATA         *
  555                 *******************************/
  556
  557%!  http_session_asserta(+Data) is det.
  558%!  http_session_assert(+Data) is det.
  559%!  http_session_retract(?Data) is nondet.
  560%!  http_session_retractall(?Data) is det.
  561%
  562%   Versions of assert/1, retract/1 and retractall/1 that associate
  563%   data with the current HTTP session.
  564
  565http_session_asserta(Data) :-
  566    http_session_id(SessionId),
  567    (   hooked
  568    ->  hook(asserta(session_data(SessionId, Data)))
  569    ;   asserta(session_data(SessionId, Data))
  570    ).
  571
  572http_session_assert(Data) :-
  573    http_session_id(SessionId),
  574    (   hooked
  575    ->  hook(assertz(session_data(SessionId, Data)))
  576    ;   assertz(session_data(SessionId, Data))
  577    ).
  578
  579http_session_retract(Data) :-
  580    http_session_id(SessionId),
  581    (   hooked
  582    ->  hook(retract(session_data(SessionId, Data)))
  583    ;   retract(session_data(SessionId, Data))
  584    ).
  585
  586http_session_retractall(Data) :-
  587    http_session_id(SessionId),
  588    (   hooked
  589    ->  hook(retractall(session_data(SessionId, Data)))
  590    ;   retractall(session_data(SessionId, Data))
  591    ).
  592
  593%!  http_session_data(?Data) is nondet.
  594%
  595%   True if Data is associated using http_session_assert/1 to the
  596%   current HTTP session.
  597%
  598%   @error  existence_error(http_session,_)
  599
  600http_session_data(Data) :-
  601    http_session_id(SessionId),
  602    (   hooked
  603    ->  hook(session_data(SessionId, Data))
  604    ;   session_data(SessionId, Data)
  605    ).
  606
  607%!  http_session_asserta(+Data, +SessionID) is det.
  608%!  http_session_assert(+Data, +SessionID) is det.
  609%!  http_session_retract(?Data, +SessionID) is nondet.
  610%!  http_session_retractall(@Data, +SessionID) is det.
  611%!  http_session_data(?Data, +SessionID) is det.
  612%
  613%   Versions of assert/1, retract/1 and retractall/1 that associate data
  614%   with an explicit HTTP session.
  615%
  616%   @see http_current_session/2.
  617
  618http_session_asserta(Data, SessionId) :-
  619    must_be(atom, SessionId),
  620    (   hooked
  621    ->  hook(asserta(session_data(SessionId, Data)))
  622    ;   asserta(session_data(SessionId, Data))
  623    ).
  624
  625http_session_assert(Data, SessionId) :-
  626    must_be(atom, SessionId),
  627    (   hooked
  628    ->  hook(assertz(session_data(SessionId, Data)))
  629    ;   assertz(session_data(SessionId, Data))
  630    ).
  631
  632http_session_retract(Data, SessionId) :-
  633    must_be(atom, SessionId),
  634    (   hooked
  635    ->  hook(retract(session_data(SessionId, Data)))
  636    ;   retract(session_data(SessionId, Data))
  637    ).
  638
  639http_session_retractall(Data, SessionId) :-
  640    must_be(atom, SessionId),
  641    (   hooked
  642    ->  hook(retractall(session_data(SessionId, Data)))
  643    ;   retractall(session_data(SessionId, Data))
  644    ).
  645
  646http_session_data(Data, SessionId) :-
  647    must_be(atom, SessionId),
  648    (   hooked
  649    ->  hook(session_data(SessionId, Data))
  650    ;   session_data(SessionId, Data)
  651    ).
  652
  653
  654                 /*******************************
  655                 *           ENUMERATE          *
  656                 *******************************/
  657
  658%!  http_current_session(?SessionID, ?Data) is nondet.
  659%
  660%   Enumerate the current sessions and   associated data.  There are
  661%   two _pseudo_ data elements:
  662%
  663%           * idle(Seconds)
  664%           Session has been idle for Seconds.
  665%
  666%           * peer(Peer)
  667%           Peer of the connection.
  668
  669http_current_session(SessionID, Data) :-
  670    hooked,
  671    !,
  672    hook(current_session(SessionID, Data)).
  673http_current_session(SessionID, Data) :-
  674    get_time(Now),
  675    get_last_used(SessionID, Last), % binds SessionID
  676    Idle is Now - Last,
  677    (   session_setting(SessionID, timeout(Timeout)),
  678        Timeout > 0
  679    ->  Idle =< Timeout
  680    ;   true
  681    ),
  682    (   Data = idle(Idle)
  683    ;   Data = peer(Peer),
  684        current_session(SessionID, Peer)
  685    ;   session_data(SessionID, Data)
  686    ).
  687
  688
  689                 /*******************************
  690                 *          GC SESSIONS         *
  691                 *******************************/
  692
  693%!  http_close_session(+SessionID) is det.
  694%
  695%   Closes an HTTP session. This predicate   can  be called from any
  696%   thread to terminate a session.  It uses the broadcast/1 service
  697%   with the message below.
  698%
  699%           http_session(end(SessionId, Peer))
  700%
  701%   The broadcast is done *before* the session data is destroyed and
  702%   the listen-handlers are executed in context  of the session that
  703%   is being closed. Here  is  an   example  that  destroys a Prolog
  704%   thread that is associated to a thread:
  705%
  706%   ==
  707%   :- listen(http_session(end(SessionId, _Peer)),
  708%             kill_session_thread(SessionID)).
  709%
  710%   kill_session_thread(SessionID) :-
  711%           http_session_data(thread(ThreadID)),
  712%           thread_signal(ThreadID, throw(session_closed)).
  713%   ==
  714%
  715%   Succeed without any effect if  SessionID   does  not refer to an
  716%   active session.
  717%
  718%   If http_close_session/1 is called from   a  handler operating in
  719%   the current session  and  the  CGI   stream  is  still  in state
  720%   =header=, this predicate emits a   =|Set-Cookie|=  to expire the
  721%   cookie.
  722%
  723%   @error  type_error(atom, SessionID)
  724%   @see    listen/2 for acting upon closed sessions
  725
  726http_close_session(SessionId) :-
  727    http_close_session(SessionId, true).
  728
  729http_close_session(SessionId, Expire) :-
  730    hooked,
  731    !,
  732    forall(hook(close_session(SessionId)),
  733           expire_session_cookie(Expire)).
  734http_close_session(SessionId, Expire) :-
  735    must_be(atom, SessionId),
  736    (   current_session(SessionId, Peer),
  737        (   b_setval(http_session_id, SessionId),
  738            broadcast(http_session(end(SessionId, Peer))),
  739            fail
  740        ;   true
  741        ),
  742        expire_session_cookie(Expire),
  743        retractall(current_session(SessionId, _)),
  744        retractall(last_used(SessionId, _)),
  745        retractall(session_data(SessionId, _)),
  746        fail
  747    ;   true
  748    ).
  749
  750
  751%!  expire_session_cookie(+Expire) is det.
  752%
  753%   Emit a request to delete a session  cookie. This is only done if
  754%   http_close_session/1 is still in `header mode'.
  755
  756expire_session_cookie(true) :-
  757    !,
  758    expire_session_cookie.
  759expire_session_cookie(_).
  760
  761expire_session_cookie :-
  762    in_header_state,
  763    session_setting(cookie(Cookie)),
  764    session_setting(path(Path)),
  765    !,
  766    format('Set-Cookie: ~w=; \c
  767                expires=Tue, 01-Jan-1970 00:00:00 GMT; \c
  768                path=~w\r\n',
  769           [Cookie, Path]).
  770expire_session_cookie.
  771
  772in_header_state :-
  773    current_output(CGI),
  774    is_cgi_stream(CGI),
  775    cgi_property(CGI, state(header)),
  776    !.
  777
  778
  779%!  http_gc_sessions is det.
  780%!  http_gc_sessions(+TimeOut) is det.
  781%
  782%   Delete dead sessions. Currently runs session GC if a new session
  783%   is opened and the last session GC was more than a TimeOut ago.
  784
  785:- dynamic
  786    last_gc/1.  787
  788http_gc_sessions :-
  789    start_session_gc_thread,
  790    http_gc_sessions(60).
  791http_gc_sessions(TimeOut) :-
  792    (   with_mutex(http_session_gc, need_sesion_gc(TimeOut))
  793    ->  do_http_gc_sessions
  794    ;   true
  795    ).
  796
  797need_sesion_gc(TimeOut) :-
  798    get_time(Now),
  799    (   last_gc(LastGC),
  800        Now-LastGC < TimeOut
  801    ->  true
  802    ;   retractall(last_gc(_)),
  803        asserta(last_gc(Now)),
  804        do_http_gc_sessions
  805    ).
  806
  807do_http_gc_sessions :-
  808    hooked,
  809    !,
  810    hook(gc_sessions).
  811do_http_gc_sessions :-
  812    debug(http_session(gc), 'Running HTTP session GC', []),
  813    get_time(Now),
  814    (   last_used(SessionID, Last),
  815        session_setting(SessionID, timeout(Timeout)),
  816        Timeout > 0,
  817        Idle is Now - Last,
  818        Idle > Timeout,
  819        http_close_session(SessionID, false),
  820        fail
  821    ;   true
  822    ).
  823
  824%!  start_session_gc_thread is det.
  825%!  stop_session_gc_thread is det.
  826%
  827%   Create/stop a thread that listens for timeout-at timing and wakes up
  828%   to run http_gc_sessions/1 shortly after a   session  is scheduled to
  829%   timeout.
  830
  831:- dynamic
  832    session_gc_queue/1.  833
  834start_session_gc_thread :-
  835    session_gc_queue(_),
  836    !.
  837start_session_gc_thread :-
  838    session_setting(gc(active)),
  839    !,
  840    catch(thread_create(session_gc_loop, _,
  841                        [ alias('__http_session_gc'),
  842                          at_exit(retractall(session_gc_queue(_)))
  843                        ]),
  844          error(permission_error(create, thread, _),_),
  845          true).
  846start_session_gc_thread.
  847
  848stop_session_gc_thread :-
  849    retract(session_gc_queue(Id)),
  850    !,
  851    thread_send_message(Id, done),
  852    thread_join(Id, _).
  853stop_session_gc_thread.
  854
  855session_gc_loop :-
  856    thread_self(GcQueue),
  857    asserta(session_gc_queue(GcQueue)),
  858    repeat,
  859    thread_get_message(Message),
  860    (   Message == done
  861    ->  !
  862    ;   schedule(Message),
  863        fail
  864    ).
  865
  866schedule(at(Time)) :-
  867    current_alarm(At, _, _, _),
  868    Time == At,
  869    !.
  870schedule(at(Time)) :-
  871    debug(http_session(gc), 'Schedule GC at ~p', [Time]),
  872    alarm_at(Time, http_gc_sessions(10), _,
  873             [ remove(true)
  874             ]).
  875
  876schedule_gc(LastUsed, TimeOut) :-
  877    nonvar(TimeOut),                            % var(TimeOut) means none
  878    session_gc_queue(Queue),
  879    !,
  880    At is LastUsed+TimeOut+5,                   % give some slack
  881    thread_send_message(Queue, at(At)).
  882schedule_gc(_, _).
  883
  884
  885                 /*******************************
  886                 *             UTIL             *
  887                 *******************************/
  888
  889%!  http_session_cookie(-Cookie) is det.
  890%
  891%   Generate a random cookie that  can  be   used  by  a  browser to
  892%   identify  the  current  session.  The   cookie  has  the  format
  893%   XXXX-XXXX-XXXX-XXXX[.<route>], where XXXX are random hexadecimal
  894%   numbers  and  [.<route>]  is  the    optionally   added  routing
  895%   information.
  896
  897http_session_cookie(Cookie) :-
  898    route(Route),
  899    !,
  900    random_4(R1,R2,R3,R4),
  901    format(atom(Cookie),
  902            '~`0t~16r~4|-~`0t~16r~9|-~`0t~16r~14|-~`0t~16r~19|.~w',
  903            [R1,R2,R3,R4,Route]).
  904http_session_cookie(Cookie) :-
  905    random_4(R1,R2,R3,R4),
  906    format(atom(Cookie),
  907            '~`0t~16r~4|-~`0t~16r~9|-~`0t~16r~14|-~`0t~16r~19|',
  908            [R1,R2,R3,R4]).
  909
  910:- thread_local
  911    route_cache/1.  912
  913%!  route(-RouteID) is semidet.
  914%
  915%   Fetch the route identifier. This value   is added as .<route> to
  916%   the session cookie and used  by   -for  example- the apache load
  917%   balanching module. The default route is   the  local name of the
  918%   host.     Alternatives     may      be       provided      using
  919%   http_set_session_options/1.
  920
  921route(Route) :-
  922    route_cache(Route),
  923    !,
  924    Route \== ''.
  925route(Route) :-
  926    route_no_cache(Route),
  927    assert(route_cache(Route)),
  928    Route \== ''.
  929
  930route_no_cache(Route) :-
  931    session_setting(route(Route)),
  932    !.
  933route_no_cache(Route) :-
  934    gethostname(Host),
  935    (   sub_atom(Host, Before, _, _, '.')
  936    ->  sub_atom(Host, 0, Before, _, Route)
  937    ;   Route = Host
  938    ).
  939
  940:- if(\+current_prolog_flag(windows, true)).  941%!  urandom(-Handle) is semidet.
  942%
  943%   Handle is a stream-handle  for   /dev/urandom.  Originally, this
  944%   simply tried to open /dev/urandom, failing   if this device does
  945%   not exist. It turns out  that   trying  to open /dev/urandom can
  946%   block indefinitely on  some  Windows   installations,  so  we no
  947%   longer try this on Windows.
  948
  949:- dynamic
  950    urandom_handle/1.  951
  952urandom(Handle) :-
  953    urandom_handle(Handle),
  954    !,
  955    Handle \== [].
  956urandom(Handle) :-
  957    catch(open('/dev/urandom', read, In, [type(binary)]), _, fail),
  958    !,
  959    assert(urandom_handle(In)),
  960    Handle = In.
  961urandom(_) :-
  962    assert(urandom_handle([])),
  963    fail.
  964
  965get_pair(In, Value) :-
  966    get_byte(In, B1),
  967    get_byte(In, B2),
  968    Value is B1<<8+B2.
  969:- endif.  970
  971%!  random_4(-R1,-R2,-R3,-R4) is det.
  972%
  973%   Generate 4 2-byte random  numbers.   Uses  =|/dev/urandom|= when
  974%   available to make prediction of the session IDs hard.
  975
  976:- if(current_predicate(urandom/1)).  977random_4(R1,R2,R3,R4) :-
  978    urandom(In),
  979    !,
  980    get_pair(In, R1),
  981    get_pair(In, R2),
  982    get_pair(In, R3),
  983    get_pair(In, R4).
  984:- endif.  985random_4(R1,R2,R3,R4) :-
  986    R1 is random(65536),
  987    R2 is random(65536),
  988    R3 is random(65536),
  989    R4 is random(65536).
  990
  991%!  hooked is semidet.
  992%!  hook(+Goal).
  993%
  994%   These multifile predicates may be used to   hook the data storage of
  995%   this     library.     An     example       is     implemented     by
  996%   library(http/http_redis_plugin), storing all session data in a redis
  997%   database.