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/3.
  204%     - redis_ro(+DB)
  205%       Alias name of the redis database for read-only access. See
  206%       redis_server/3.
  207%     - redis_prefix(+Atom)
  208%       Prefix to use for all HTTP session related keys.  Default is
  209%       `'swipl:http:session'`
  210
  211http_set_session_options([]) => true.
  212http_set_session_options([H|T]) =>
  213    http_set_session_option(H),
  214    http_set_session_options(T).
  215
  216http_set_session_option(Option), Option =.. [Name,Value] =>
  217    (   session_option(Name, Type)
  218    ->  must_be(Type, Value)
  219    ;   domain_error(http_session_option, Option)
  220    ),
  221    functor(Free, Name, 1),
  222    (   clause(session_setting(Free), _, Ref)
  223    ->  (   Free \== Value
  224        ->  asserta(session_setting(Option)),
  225            erase(Ref),
  226            updated_session_setting(Name, Free, Value)
  227        ;   true
  228        )
  229    ;   asserta(session_setting(Option))
  230    ).
  231
  232%!  http_session_option(?Option) is nondet.
  233%
  234%   True if Option is a current option of the session system.
  235
  236http_session_option(Option) :-
  237    session_setting(Option).
  238
  239%!  session_setting(+SessionID, ?Setting) is semidet.
  240%
  241%   Find setting for SessionID. It  is   possible  to  overrule some
  242%   session settings using http_session_set(Setting).
  243
  244:- public session_setting/2.  245
  246session_setting(SessionID, Setting) :-
  247    nonvar(Setting),
  248    get_session_option(SessionID, Setting),
  249    !.
  250session_setting(_, Setting) :-
  251    session_setting(Setting).
  252
  253get_session_option(SessionID, Setting) :-
  254    hooked,
  255    !,
  256    hook(get_session_option(SessionID, Setting)).
  257get_session_option(SessionID, Setting) :-
  258    functor(Setting, Name, 1),
  259    local_option(Name, Value, Term),
  260    session_data(SessionID, '$setting'(Term)),
  261    !,
  262    arg(1, Setting, Value).
  263
  264
  265updated_session_setting(gc, _, passive) :-
  266    stop_session_gc_thread, !.
  267updated_session_setting(_, _, _).               % broadcast?
  268
  269
  270%!  http_set_session(Setting) is det.
  271%!  http_set_session(SessionId, Setting) is det.
  272%
  273%   Overrule  a  setting  for  the  current  or  specified  session.
  274%   Currently, the only setting that can be overruled is =timeout=.
  275%
  276%   @error  permission_error(set, http_session, Setting) if setting
  277%           a setting that is not supported on per-session basis.
  278
  279http_set_session(Setting) :-
  280    http_session_id(SessionId),
  281    http_set_session(SessionId, Setting).
  282
  283http_set_session(SessionId, Setting) :-
  284    functor(Setting, Name, _),
  285    (   local_option(Name, _, _)
  286    ->  true
  287    ;   permission_error(set, http_session, Setting)
  288    ),
  289    arg(1, Setting, Value),
  290    (   session_option(Name, Type)
  291    ->  must_be(Type, Value)
  292    ;   domain_error(http_session_option, Setting)
  293    ),
  294    set_session_option(SessionId, Setting).
  295
  296set_session_option(SessionId, Setting) :-
  297    hooked,
  298    !,
  299    hook(set_session_option(SessionId, Setting)).
  300set_session_option(SessionId, Setting) :-
  301    functor(Setting, Name, Arity),
  302    functor(Free, Name, Arity),
  303    retractall(session_data(SessionId, '$setting'(Free))),
  304    assert(session_data(SessionId, '$setting'(Setting))).
  305
  306local_option(timeout, X, timeout(X)).
  307
  308%!  http_session_id(-SessionId) is det.
  309%
  310%   True if SessionId is an identifier for the current session.
  311%
  312%   @arg   SessionId is an atom.
  313%   @error existence_error(http_session, _)
  314%   @see   http_in_session/1 for a version that fails if there is
  315%          no session.
  316
  317http_session_id(SessionID) :-
  318    (   http_in_session(ID)
  319    ->  SessionID = ID
  320    ;   throw(error(existence_error(http_session, _), _))
  321    ).
  322
  323%!  http_in_session(-SessionId) is semidet.
  324%
  325%   True if SessionId is an identifier  for the current session. The
  326%   current session is extracted from   session(ID) from the current
  327%   HTTP request (see http_current_request/1). The   value is cached
  328%   in a backtrackable global variable   =http_session_id=.  Using a
  329%   backtrackable global variable is safe  because continuous worker
  330%   threads use a failure driven  loop   and  spawned  threads start
  331%   without any global variables. This variable  can be set from the
  332%   commandline to fake running a goal   from the commandline in the
  333%   context of a session.
  334%
  335%   @see http_session_id/1
  336
  337http_in_session(SessionID) :-
  338    nb_current(http_session_id, ID),
  339    ID \== [],
  340    !,
  341    debug(http_session, 'Session id from global variable: ~q', [ID]),
  342    ID \== no_session,
  343    SessionID = ID.
  344http_in_session(SessionID) :-
  345    http_current_request(Request),
  346    http_in_session(Request, SessionID).
  347
  348http_in_session(Request, SessionID) :-
  349    memberchk(session(ID), Request),
  350    !,
  351    debug(http_session, 'Session id from request: ~q', [ID]),
  352    b_setval(http_session_id, ID),
  353    SessionID = ID.
  354http_in_session(Request, SessionID) :-
  355    memberchk(cookie(Cookies), Request),
  356    session_setting(cookie(Cookie)),
  357    member(Cookie=SessionID0, Cookies),
  358    debug(http_session, 'Session id from cookie: ~q', [SessionID0]),
  359    peer(Request, Peer),
  360    valid_session_id(SessionID0, Peer),
  361    !,
  362    b_setval(http_session_id, SessionID0),
  363    SessionID = SessionID0.
  364
  365
  366%!  http_session(+RequestIn, -RequestOut, -SessionID) is semidet.
  367%
  368%   Maintain the notion of a  session   using  a client-side cookie.
  369%   This must be called first when handling a request that wishes to
  370%   do session management, after which the possibly modified request
  371%   must be used for further processing.
  372%
  373%   This predicate creates a  session  if   the  setting  create  is
  374%   =auto=.  If  create  is  =noauto=,  the  application  must  call
  375%   http_open_session/1 to create a session.
  376
  377http_session(Request, Request, SessionID) :-
  378    memberchk(session(SessionID0), Request),
  379    !,
  380    SessionID = SessionID0.
  381http_session(Request0, Request, SessionID) :-
  382    memberchk(cookie(Cookies), Request0),
  383    session_setting(cookie(Cookie)),
  384    member(Cookie=SessionID0, Cookies),
  385    peer(Request0, Peer),
  386    valid_session_id(SessionID0, Peer),
  387    !,
  388    SessionID = SessionID0,
  389    Request = [session(SessionID)|Request0],
  390    b_setval(http_session_id, SessionID).
  391http_session(Request0, Request, SessionID) :-
  392    session_setting(create(auto)),
  393    session_setting(path(Path)),
  394    memberchk(path(ReqPath), Request0),
  395    sub_atom(ReqPath, 0, _, _, Path),
  396    !,
  397    create_session(Request0, Request, SessionID).
  398
  399create_session(Request0, Request, SessionID) :-
  400    http_gc_sessions,
  401    http_session_cookie(SessionID),
  402    session_setting(cookie(Cookie)),
  403    session_setting(path(Path)),
  404    session_setting(samesite(SameSite)),
  405    debug(http_session, 'Created session ~q at path=~q', [SessionID, Path]),
  406    (   SameSite == none
  407    ->  format('Set-Cookie: ~w=~w; Path=~w; Version=1\r\n',
  408               [Cookie, SessionID, Path])
  409    ;   format('Set-Cookie: ~w=~w; Path=~w; Version=1; SameSite=~w\r\n',
  410               [Cookie, SessionID, Path, SameSite])
  411    ),
  412    Request = [session(SessionID)|Request0],
  413    peer(Request0, Peer),
  414    open_session(SessionID, Peer).
  415
  416
  417%!  http_open_session(-SessionID, +Options) is det.
  418%
  419%   Establish a new session.  This is normally used if the create
  420%   option is set to =noauto=.  Options:
  421%
  422%     * renew(+Boolean)
  423%     If =true= (default =false=) and the current request is part
  424%     of a session, generate a new session-id.  By default, this
  425%     predicate returns the current session as obtained with
  426%     http_in_session/1.
  427%
  428%   @see    http_set_session_options/1 to control the =create= option.
  429%   @see    http_close_session/1 for closing the session.
  430%   @error  permission_error(open, http_session, CGI) if this call
  431%           is used after closing the CGI header.
  432
  433http_open_session(SessionID, Options) :-
  434    http_in_session(SessionID0),
  435    \+ option(renew(true), Options, false),
  436    !,
  437    SessionID = SessionID0.
  438http_open_session(SessionID, _Options) :-
  439    (   in_header_state
  440    ->  true
  441    ;   current_output(CGI),
  442        permission_error(open, http_session, CGI)
  443    ),
  444    (   http_in_session(ActiveSession)
  445    ->  http_close_session(ActiveSession, false)
  446    ;   true
  447    ),
  448    http_current_request(Request),
  449    create_session(Request, _, SessionID).
  450
  451
  452:- multifile
  453    http:request_expansion/2.  454
  455http:request_expansion(Request0, Request) :-
  456    session_setting(enabled(true)),
  457    http_session(Request0, Request, _SessionID).
  458
  459%!  peer(+Request, -Peer) is det.
  460%
  461%   Find peer for current request. If   unknown we leave it unbound.
  462%   Alternatively we should treat this as an error.
  463
  464peer(Request, Peer) :-
  465    (   session_setting(proxy_enabled(true)),
  466        http_peer(Request, Peer)
  467    ->  true
  468    ;   memberchk(peer(Peer), Request)
  469    ->  true
  470    ;   true
  471    ).
  472
  473%!  open_session(+SessionID, +Peer)
  474%
  475%   Open a new session.  Uses broadcast/1 with the term
  476%   http_session(begin(SessionID, Peer)).
  477
  478open_session(SessionID, Peer) :-
  479    assert_session(SessionID, Peer),
  480    b_setval(http_session_id, SessionID),
  481    broadcast(http_session(begin(SessionID, Peer))).
  482
  483assert_session(SessionID, Peer) :-
  484    hooked,
  485    !,
  486    hook(assert_session(SessionID, Peer)).
  487assert_session(SessionID, Peer) :-
  488    get_time(Now),
  489    assert(current_session(SessionID, Peer)),
  490    assert(last_used(SessionID, Now)).
  491
  492%!  valid_session_id(+SessionID, +Peer) is semidet.
  493%
  494%   Check if this sessionID is known. If so, check the idle time and
  495%   update the last_used for this session.
  496
  497valid_session_id(SessionID, Peer) :-
  498    active_session(SessionID, SessionPeer, LastUsed),
  499    get_time(Now),
  500    (   session_setting(SessionID, timeout(Timeout)),
  501        Timeout > 0
  502    ->  Idle is Now - LastUsed,
  503        (   Idle =< Timeout
  504        ->  true
  505        ;   http_close_session(SessionID),
  506            fail
  507        )
  508    ;   Peer \== SessionPeer
  509    ->  http_close_session(SessionID),
  510        fail
  511    ;   true
  512    ),
  513    set_last_used(SessionID, Now, Timeout).
  514
  515active_session(SessionID, Peer, LastUsed) :-
  516    hooked,
  517    !,
  518    hook(active_session(SessionID, Peer, LastUsed)).
  519active_session(SessionID, Peer, LastUsed) :-
  520    current_session(SessionID, Peer),
  521    get_last_used(SessionID, LastUsed).
  522
  523get_last_used(SessionID, Last) :-
  524    atom(SessionID),
  525    !,
  526    once(last_used(SessionID, Last)).
  527get_last_used(SessionID, Last) :-
  528    last_used(SessionID, Last).
  529
  530%!  set_last_used(+SessionID, +Now, +TimeOut)
  531%
  532%   Set the last-used notion for SessionID  from the current time stamp.
  533%   The time is rounded down  to  10   second  intervals  to  avoid many
  534%   updates and simplify the scheduling of session GC.
  535
  536set_last_used(SessionID, Now, TimeOut) :-
  537    hooked,
  538    !,
  539    hook(set_last_used(SessionID, Now, TimeOut)).
  540set_last_used(SessionID, Now, TimeOut) :-
  541    LastUsed is floor(Now/10)*10,
  542    (   clause(last_used(SessionID, CurrentLast), _, Ref)
  543    ->  (   CurrentLast == LastUsed
  544        ->  true
  545        ;   asserta(last_used(SessionID, LastUsed)),
  546            erase(Ref),
  547            schedule_gc(LastUsed, TimeOut)
  548        )
  549    ;   asserta(last_used(SessionID, LastUsed)),
  550        schedule_gc(LastUsed, TimeOut)
  551    ).
  552
  553
  554                 /*******************************
  555                 *         SESSION DATA         *
  556                 *******************************/
  557
  558%!  http_session_asserta(+Data) is det.
  559%!  http_session_assert(+Data) is det.
  560%!  http_session_retract(?Data) is nondet.
  561%!  http_session_retractall(?Data) is det.
  562%
  563%   Versions of assert/1, retract/1 and retractall/1 that associate
  564%   data with the current HTTP session.
  565
  566http_session_asserta(Data) :-
  567    http_session_id(SessionId),
  568    (   hooked
  569    ->  hook(asserta(session_data(SessionId, Data)))
  570    ;   asserta(session_data(SessionId, Data))
  571    ).
  572
  573http_session_assert(Data) :-
  574    http_session_id(SessionId),
  575    (   hooked
  576    ->  hook(assertz(session_data(SessionId, Data)))
  577    ;   assertz(session_data(SessionId, Data))
  578    ).
  579
  580http_session_retract(Data) :-
  581    http_session_id(SessionId),
  582    (   hooked
  583    ->  hook(retract(session_data(SessionId, Data)))
  584    ;   retract(session_data(SessionId, Data))
  585    ).
  586
  587http_session_retractall(Data) :-
  588    http_session_id(SessionId),
  589    (   hooked
  590    ->  hook(retractall(session_data(SessionId, Data)))
  591    ;   retractall(session_data(SessionId, Data))
  592    ).
  593
  594%!  http_session_data(?Data) is nondet.
  595%
  596%   True if Data is associated using http_session_assert/1 to the
  597%   current HTTP session.
  598%
  599%   @error  existence_error(http_session,_)
  600
  601http_session_data(Data) :-
  602    http_session_id(SessionId),
  603    (   hooked
  604    ->  hook(session_data(SessionId, Data))
  605    ;   session_data(SessionId, Data)
  606    ).
  607
  608%!  http_session_asserta(+Data, +SessionID) is det.
  609%!  http_session_assert(+Data, +SessionID) is det.
  610%!  http_session_retract(?Data, +SessionID) is nondet.
  611%!  http_session_retractall(@Data, +SessionID) is det.
  612%!  http_session_data(?Data, +SessionID) is det.
  613%
  614%   Versions of assert/1, retract/1 and retractall/1 that associate data
  615%   with an explicit HTTP session.
  616%
  617%   @see http_current_session/2.
  618
  619http_session_asserta(Data, SessionId) :-
  620    must_be(atom, SessionId),
  621    (   hooked
  622    ->  hook(asserta(session_data(SessionId, Data)))
  623    ;   asserta(session_data(SessionId, Data))
  624    ).
  625
  626http_session_assert(Data, SessionId) :-
  627    must_be(atom, SessionId),
  628    (   hooked
  629    ->  hook(assertz(session_data(SessionId, Data)))
  630    ;   assertz(session_data(SessionId, Data))
  631    ).
  632
  633http_session_retract(Data, SessionId) :-
  634    must_be(atom, SessionId),
  635    (   hooked
  636    ->  hook(retract(session_data(SessionId, Data)))
  637    ;   retract(session_data(SessionId, Data))
  638    ).
  639
  640http_session_retractall(Data, SessionId) :-
  641    must_be(atom, SessionId),
  642    (   hooked
  643    ->  hook(retractall(session_data(SessionId, Data)))
  644    ;   retractall(session_data(SessionId, Data))
  645    ).
  646
  647http_session_data(Data, SessionId) :-
  648    must_be(atom, SessionId),
  649    (   hooked
  650    ->  hook(session_data(SessionId, Data))
  651    ;   session_data(SessionId, Data)
  652    ).
  653
  654
  655                 /*******************************
  656                 *           ENUMERATE          *
  657                 *******************************/
  658
  659%!  http_current_session(?SessionID, ?Data) is nondet.
  660%
  661%   Enumerate the current sessions and   associated data.  There are
  662%   two _pseudo_ data elements:
  663%
  664%           * idle(Seconds)
  665%           Session has been idle for Seconds.
  666%
  667%           * peer(Peer)
  668%           Peer of the connection.
  669
  670http_current_session(SessionID, Data) :-
  671    hooked,
  672    !,
  673    hook(current_session(SessionID, Data)).
  674http_current_session(SessionID, Data) :-
  675    get_time(Now),
  676    get_last_used(SessionID, Last), % binds SessionID
  677    Idle is Now - Last,
  678    (   session_setting(SessionID, timeout(Timeout)),
  679        Timeout > 0
  680    ->  Idle =< Timeout
  681    ;   true
  682    ),
  683    (   Data = idle(Idle)
  684    ;   Data = peer(Peer),
  685        current_session(SessionID, Peer)
  686    ;   session_data(SessionID, Data)
  687    ).
  688
  689
  690                 /*******************************
  691                 *          GC SESSIONS         *
  692                 *******************************/
  693
  694%!  http_close_session(+SessionID) is det.
  695%
  696%   Closes an HTTP session. This predicate   can  be called from any
  697%   thread to terminate a session.  It uses the broadcast/1 service
  698%   with the message below.
  699%
  700%           http_session(end(SessionId, Peer))
  701%
  702%   The broadcast is done *before* the session data is destroyed and
  703%   the listen-handlers are executed in context  of the session that
  704%   is being closed. Here  is  an   example  that  destroys a Prolog
  705%   thread that is associated to a thread:
  706%
  707%   ==
  708%   :- listen(http_session(end(SessionId, _Peer)),
  709%             kill_session_thread(SessionID)).
  710%
  711%   kill_session_thread(SessionID) :-
  712%           http_session_data(thread(ThreadID)),
  713%           thread_signal(ThreadID, throw(session_closed)).
  714%   ==
  715%
  716%   Succeed without any effect if  SessionID   does  not refer to an
  717%   active session.
  718%
  719%   If http_close_session/1 is called from   a  handler operating in
  720%   the current session  and  the  CGI   stream  is  still  in state
  721%   =header=, this predicate emits a   =|Set-Cookie|=  to expire the
  722%   cookie.
  723%
  724%   @error  type_error(atom, SessionID)
  725%   @see    listen/2 for acting upon closed sessions
  726
  727http_close_session(SessionId) :-
  728    http_close_session(SessionId, true).
  729
  730http_close_session(SessionId, Expire) :-
  731    hooked,
  732    !,
  733    forall(hook(close_session(SessionId)),
  734           expire_session_cookie(Expire)).
  735http_close_session(SessionId, Expire) :-
  736    must_be(atom, SessionId),
  737    (   current_session(SessionId, Peer),
  738        (   b_setval(http_session_id, SessionId),
  739            broadcast(http_session(end(SessionId, Peer))),
  740            fail
  741        ;   true
  742        ),
  743        expire_session_cookie(Expire),
  744        retractall(current_session(SessionId, _)),
  745        retractall(last_used(SessionId, _)),
  746        retractall(session_data(SessionId, _)),
  747        fail
  748    ;   true
  749    ).
  750
  751
  752%!  expire_session_cookie(+Expire) is det.
  753%
  754%   Emit a request to delete a session  cookie. This is only done if
  755%   http_close_session/1 is still in `header mode'.
  756
  757expire_session_cookie(true) :-
  758    !,
  759    expire_session_cookie.
  760expire_session_cookie(_).
  761
  762expire_session_cookie :-
  763    in_header_state,
  764    session_setting(cookie(Cookie)),
  765    session_setting(path(Path)),
  766    !,
  767    format('Set-Cookie: ~w=; \c
  768                expires=Tue, 01-Jan-1970 00:00:00 GMT; \c
  769                path=~w\r\n',
  770           [Cookie, Path]).
  771expire_session_cookie.
  772
  773in_header_state :-
  774    current_output(CGI),
  775    is_cgi_stream(CGI),
  776    cgi_property(CGI, state(header)),
  777    !.
  778
  779
  780%!  http_gc_sessions is det.
  781%!  http_gc_sessions(+TimeOut) is det.
  782%
  783%   Delete dead sessions. Currently runs session GC if a new session
  784%   is opened and the last session GC was more than a TimeOut ago.
  785
  786:- dynamic
  787    last_gc/1.  788
  789http_gc_sessions :-
  790    start_session_gc_thread,
  791    http_gc_sessions(60).
  792http_gc_sessions(TimeOut) :-
  793    (   with_mutex(http_session_gc, need_sesion_gc(TimeOut))
  794    ->  do_http_gc_sessions
  795    ;   true
  796    ).
  797
  798need_sesion_gc(TimeOut) :-
  799    get_time(Now),
  800    (   last_gc(LastGC),
  801        Now-LastGC < TimeOut
  802    ->  true
  803    ;   retractall(last_gc(_)),
  804        asserta(last_gc(Now)),
  805        do_http_gc_sessions
  806    ).
  807
  808do_http_gc_sessions :-
  809    hooked,
  810    !,
  811    hook(gc_sessions).
  812do_http_gc_sessions :-
  813    debug(http_session(gc), 'Running HTTP session GC', []),
  814    get_time(Now),
  815    (   session_setting(SessionID, timeout(Timeout)),
  816        last_used(SessionID, Last),
  817        Timeout > 0,
  818        Idle is Now - Last,
  819        Idle > Timeout,
  820        http_close_session(SessionID, false),
  821        fail
  822    ;   true
  823    ).
  824
  825%!  start_session_gc_thread is det.
  826%!  stop_session_gc_thread is det.
  827%
  828%   Create/stop a thread that listens for timeout-at timing and wakes up
  829%   to run http_gc_sessions/1 shortly after a   session  is scheduled to
  830%   timeout.
  831
  832:- dynamic
  833    session_gc_queue/1.  834
  835start_session_gc_thread :-
  836    session_gc_queue(_),
  837    !.
  838start_session_gc_thread :-
  839    session_setting(gc(active)),
  840    !,
  841    catch(thread_create(session_gc_loop, _,
  842                        [ alias('__http_session_gc'),
  843                          at_exit(retractall(session_gc_queue(_)))
  844                        ]),
  845          error(permission_error(create, thread, _),_),
  846          true).
  847start_session_gc_thread.
  848
  849stop_session_gc_thread :-
  850    retract(session_gc_queue(Id)),
  851    !,
  852    thread_send_message(Id, done),
  853    thread_join(Id, _).
  854stop_session_gc_thread.
  855
  856session_gc_loop :-
  857    thread_self(GcQueue),
  858    asserta(session_gc_queue(GcQueue)),
  859    repeat,
  860    thread_get_message(Message),
  861    (   Message == done
  862    ->  !
  863    ;   schedule(Message),
  864        fail
  865    ).
  866
  867schedule(at(Time)) :-
  868    current_alarm(At, _, _, _),
  869    Time == At,
  870    !.
  871schedule(at(Time)) :-
  872    debug(http_session(gc), 'Schedule GC at ~p', [Time]),
  873    alarm_at(Time, http_gc_sessions(10), _,
  874             [ remove(true)
  875             ]).
  876
  877schedule_gc(LastUsed, TimeOut) :-
  878    nonvar(TimeOut),                            % var(TimeOut) means none
  879    session_gc_queue(Queue),
  880    !,
  881    At is LastUsed+TimeOut+5,                   % give some slack
  882    thread_send_message(Queue, at(At)).
  883schedule_gc(_, _).
  884
  885
  886                 /*******************************
  887                 *             UTIL             *
  888                 *******************************/
  889
  890%!  http_session_cookie(-Cookie) is det.
  891%
  892%   Generate a random cookie that  can  be   used  by  a  browser to
  893%   identify  the  current  session.  The   cookie  has  the  format
  894%   XXXX-XXXX-XXXX-XXXX[.<route>], where XXXX are random hexadecimal
  895%   numbers  and  [.<route>]  is  the    optionally   added  routing
  896%   information.
  897
  898http_session_cookie(Cookie) :-
  899    route(Route),
  900    !,
  901    random_4(R1,R2,R3,R4),
  902    format(atom(Cookie),
  903            '~`0t~16r~4|-~`0t~16r~9|-~`0t~16r~14|-~`0t~16r~19|.~w',
  904            [R1,R2,R3,R4,Route]).
  905http_session_cookie(Cookie) :-
  906    random_4(R1,R2,R3,R4),
  907    format(atom(Cookie),
  908            '~`0t~16r~4|-~`0t~16r~9|-~`0t~16r~14|-~`0t~16r~19|',
  909            [R1,R2,R3,R4]).
  910
  911:- thread_local
  912    route_cache/1.  913
  914%!  route(-RouteID) is semidet.
  915%
  916%   Fetch the route identifier. This value   is added as .<route> to
  917%   the session cookie and used  by   -for  example- the apache load
  918%   balanching module. The default route is   the  local name of the
  919%   host.     Alternatives     may      be       provided      using
  920%   http_set_session_options/1.
  921
  922route(Route) :-
  923    route_cache(Route),
  924    !,
  925    Route \== ''.
  926route(Route) :-
  927    route_no_cache(Route),
  928    assert(route_cache(Route)),
  929    Route \== ''.
  930
  931route_no_cache(Route) :-
  932    session_setting(route(Route)),
  933    !.
  934route_no_cache(Route) :-
  935    gethostname(Host),
  936    (   sub_atom(Host, Before, _, _, '.')
  937    ->  sub_atom(Host, 0, Before, _, Route)
  938    ;   Route = Host
  939    ).
  940
  941:- if(\+current_prolog_flag(windows, true)).  942%!  urandom(-Handle) is semidet.
  943%
  944%   Handle is a stream-handle  for   /dev/urandom.  Originally, this
  945%   simply tried to open /dev/urandom, failing   if this device does
  946%   not exist. It turns out  that   trying  to open /dev/urandom can
  947%   block indefinitely on  some  Windows   installations,  so  we no
  948%   longer try this on Windows.
  949
  950:- dynamic
  951    urandom_handle/1.  952
  953urandom(Handle) :-
  954    urandom_handle(Handle),
  955    !,
  956    Handle \== [].
  957urandom(Handle) :-
  958    catch(open('/dev/urandom', read, In, [type(binary)]), _, fail),
  959    !,
  960    assert(urandom_handle(In)),
  961    Handle = In.
  962urandom(_) :-
  963    assert(urandom_handle([])),
  964    fail.
  965
  966get_pair(In, Value) :-
  967    get_byte(In, B1),
  968    get_byte(In, B2),
  969    Value is B1<<8+B2.
  970:- endif.  971
  972%!  random_4(-R1,-R2,-R3,-R4) is det.
  973%
  974%   Generate 4 2-byte random  numbers.   Uses  =|/dev/urandom|= when
  975%   available to make prediction of the session IDs hard.
  976
  977:- if(current_predicate(urandom/1)).  978random_4(R1,R2,R3,R4) :-
  979    urandom(In),
  980    !,
  981    get_pair(In, R1),
  982    get_pair(In, R2),
  983    get_pair(In, R3),
  984    get_pair(In, R4).
  985:- endif.  986random_4(R1,R2,R3,R4) :-
  987    R1 is random(65536),
  988    R2 is random(65536),
  989    R3 is random(65536),
  990    R4 is random(65536).
  991
  992%!  hooked is semidet.
  993%!  hook(+Goal).
  994%
  995%   These multifile predicates may be used to   hook the data storage of
  996%   this     library.     An     example       is     implemented     by
  997%   library(http/http_redis_plugin), storing all session data in a redis
  998%   database.