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