View source with raw comments or as raw
    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)]).

HTTP Session management

This library defines session management based on HTTP cookies. Session management is enabled simply by loading this module. Details can be modified using http_set_session_options/1. By default, this module creates a session whenever a request is processes that is inside the hierarchy defined for session handling (see path option in http_set_session_options/1). Automatic creation of a session can be stopped using the option create(noauto). The predicate http_open_session/2 must be used to create a session if noauto is enabled. Sessions can be closed using http_close_session/1.

If a session is active, http_in_session/1 returns the current session and http_session_assert/1 and friends maintain data about the session. If the session is reclaimed, all associated data is reclaimed too.

Begin and end of sessions can be monitored using library(broadcast). The broadcasted messages are:

http_session(begin(SessionID, Peer))
Broadcasted if a session is started
http_session(end(SessionId, Peer))
Broadcasted if a session is ended. See http_close_session/1.

For example, the following calls end_session(SessionId) whenever a session terminates. Please note that sessions ends are not scheduled to happen at the actual timeout moment of the session. Instead, creating a new session scans the active list for timed-out sessions. This may change in future versions of this library.

:- listen(http_session(end(SessionId, Peer)),
          end_session(SessionId)).

*/

  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])).
 http_set_session_options(+Options) is det
Set options for the session library. Provided options are:
timeout(+Seconds)
Session timeout in seconds. Default is 600 (10 min). A timeout of 0 (zero) disables timeout.
cookie(+Cookiekname)
Name to use for the cookie to identify the session. Default swipl_session.
path(+Path)
Path to which the cookie is associated. Default is /. Cookies are only sent if the HTTP request path is a refinement of Path.
route(+Route)
Set the route name. Default is the unqualified hostname. To cancel adding a route, use the empty atom. See route/1.
enabled(+Boolean)
Enable/disable session management. Sesion management is enabled by default after loading this file.
create(+Atom)
Defines when a session is created. This is one of auto (default), which creates a session if there is a request whose path matches the defined session path or noauto, in which cases sessions are only created by calling http_open_session/2 explicitely.
proxy_enabled(+Boolean)
Enable/disable proxy session management. Proxy session management associates the originating IP address of the client to the session rather than the proxy IP address. Default is false.
gc(+When)
When is one of active, which starts a thread that performs session cleanup at close to the moment of the timeout or passive, which runs session GC when a new session is created.
  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    ).
 http_session_option(?Option) is nondet
True if Option is a current option of the session system.
  204http_session_option(Option) :-
  205    session_setting(Option).
 session_setting(+SessionID, ?Setting) is semidet
Find setting for SessionID. It is possible to overrule some session settings using http_session_set(Setting).
  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?
 http_set_session(Setting) is det
 http_set_session(SessionId, Setting) is det
Overrule a setting for the current or specified session. Currently, the only setting that can be overruled is timeout.
Errors
- permission_error(set, http_session, Setting) if setting a setting that is not supported on per-session basis.
  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)).
 http_session_id(-SessionId) is det
True if SessionId is an identifier for the current session.
Arguments:
SessionId- is an atom.
Errors
- existence_error(http_session, _)
See also
- http_in_session/1 for a version that fails if there is no session.
  266http_session_id(SessionID) :-
  267    (   http_in_session(ID)
  268    ->  SessionID = ID
  269    ;   throw(error(existence_error(http_session, _), _))
  270    ).
 http_in_session(-SessionId) is semidet
True if SessionId is an identifier for the current session. The current session is extracted from session(ID) from the current HTTP request (see http_current_request/1). The value is cached in a backtrackable global variable http_session_id. Using a backtrackable global variable is safe because continuous worker threads use a failure driven loop and spawned threads start without any global variables. This variable can be set from the commandline to fake running a goal from the commandline in the context of a session.
See also
- http_session_id/1
  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.
 http_session(+RequestIn, -RequestOut, -SessionID) is semidet
Maintain the notion of a session using a client-side cookie. This must be called first when handling a request that wishes to do session management, after which the possibly modified request must be used for further processing.

This predicate creates a session if the setting create is auto. If create is noauto, the application must call http_open_session/1 to create a session.

  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).
 http_open_session(-SessionID, +Options) is det
Establish a new session. This is normally used if the create option is set to noauto. Options:
renew(+Boolean)
If true (default false) and the current request is part of a session, generate a new session-id. By default, this predicate returns the current session as obtained with http_in_session/1.
Errors
- permission_error(open, http_session, CGI) if this call is used after closing the CGI header.
See also
- http_set_session_options/1 to control the create option.
- http_close_session/1 for closing the session.
  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).
 peer(+Request, -Peer) is det
Find peer for current request. If unknown we leave it unbound. Alternatively we should treat this as an error.
  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    ).
 open_session(+SessionID, +Peer)
Open a new session. Uses broadcast/1 with the term http_session(begin(SessionID, Peer)).
  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))).
 valid_session_id(+SessionID, +Peer) is semidet
Check if this sessionID is known. If so, check the idle time and update the last_used for this session.
  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).
 set_last_used(+SessionID, +Now, +TimeOut)
Set the last-used notion for SessionID from the current time stamp. The time is rounded down to 10 second intervals to avoid many updates and simplify the scheduling of session GC.
  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                 *******************************/
 http_session_asserta(+Data) is det
 http_session_assert(+Data) is det
 http_session_retract(?Data) is nondet
 http_session_retractall(?Data) is det
Versions of assert/1, retract/1 and retractall/1 that associate data with the current HTTP session.
  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)).
 http_session_data(?Data) is nondet
True if Data is associated using http_session_assert/1 to the current HTTP session.
Errors
- existence_error(http_session,_)
  516http_session_data(Data) :-
  517    http_session_id(SessionId),
  518    session_data(SessionId, Data).
 http_session_asserta(+Data, +SessionID) is det
 http_session_assert(+Data, +SessionID) is det
 http_session_retract(?Data, +SessionID) is nondet
 http_session_retractall(@Data, +SessionID) is det
 http_session_data(?Data, +SessionID) is det
Versions of assert/1, retract/1 and retractall/1 that associate data with an explicit HTTP session.
See also
- http_current_session/2.
  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                 *******************************/
 http_current_session(?SessionID, ?Data) is nondet
Enumerate the current sessions and associated data. There are two Pseudo data elements:
idle(Seconds)
Session has been idle for Seconds.
peer(Peer)
Peer of the connection.
  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                 *******************************/
 http_close_session(+SessionID) is det
Closes an HTTP session. This predicate can be called from any thread to terminate a session. It uses the broadcast/1 service with the message below.
http_session(end(SessionId, Peer))

The broadcast is done before the session data is destroyed and the listen-handlers are executed in context of the session that is being closed. Here is an example that destroys a Prolog thread that is associated to a thread:

:- listen(http_session(end(SessionId, _Peer)),
          kill_session_thread(SessionID)).

kill_session_thread(SessionID) :-
        http_session_data(thread(ThreadID)),
        thread_signal(ThreadID, throw(session_closed)).

Succeed without any effect if SessionID does not refer to an active session.

If http_close_session/1 is called from a handler operating in the current session and the CGI stream is still in state header, this predicate emits a Set-Cookie to expire the cookie.

Errors
- type_error(atom, SessionID)
See also
- listen/2 for acting upon closed sessions
  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    ).
 expire_session_cookie(+SessionId) is det
Emit a request to delete a session cookie. This is only done if http_close_session/1 is still in `header mode'.
  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    !.
 http_gc_sessions is det
 http_gc_sessions(+TimeOut) is det
Delete dead sessions. Currently runs session GC if a new session is opened and the last session GC was more than a TimeOut ago.
  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    ).
 start_session_gc_thread is det
 stop_session_gc_thread is det
Create/stop a thread that listens for timeout-at timing and wakes up to run http_gc_sessions/1 shortly after a session is scheduled to timeout.
  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                 *******************************/
 http_session_cookie(-Cookie) is det
Generate a random cookie that can be used by a browser to identify the current session. The cookie has the format XXXX-XXXX-XXXX-XXXX[.<route>], where XXXX are random hexadecimal numbers and [.<route>] is the optionally added routing information.
  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.
 route(-RouteID) is semidet
Fetch the route identifier. This value is added as .<route> to the session cookie and used by -for example- the apache load balanching module. The default route is the local name of the host. Alternatives may be provided using http_set_session_options/1.
  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)).
 urandom(-Handle) is semidet
Handle is a stream-handle for /dev/urandom. Originally, this simply tried to open /dev/urandom, failing if this device does not exist. It turns out that trying to open /dev/urandom can block indefinitely on some Windows installations, so we no longer try this on Windows.
  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.
 random_4(-R1, -R2, -R3, -R4) is det
Generate 4 2-byte random numbers. Uses /dev/urandom when available to make prediction of the session IDs hard.
  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)