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