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