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