/*  Part of SWI-Prolog

    Author:        Jan Wielemaker, Matt Lilley
    E-mail:        J.Wielemaker@cs.vu.nl
    WWW:           http://www.swi-prolog.org
    Copyright (c)  2006-2020, University of Amsterdam
                              VU University Amsterdam
                              CWI, Amsterdam
                              SWI-Prolog Solutions b.v.
    All rights reserved.

    Redistribution and use in source and binary forms, with or without
    modification, are permitted provided that the following conditions
    are met:

    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.

    2. Redistributions in binary form must reproduce the above copyright
       notice, this list of conditions and the following disclaimer in
       the documentation and/or other materials provided with the
       distribution.

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
    POSSIBILITY OF SUCH DAMAGE.
*/

:- module(http_session,
          [ http_set_session_options/1, % +Options
            http_set_session/1,         % +Option
            http_set_session/2,         % +SessionId, +Option
            http_session_option/1,      % ?Option

            http_session_id/1,          % -SessionId
            http_in_session/1,          % -SessionId
            http_current_session/2,     % ?SessionId, ?Data
            http_close_session/1,       % +SessionId
            http_open_session/2,        % -SessionId, +Options

            http_session_cookie/1,      % -Cookie

            http_session_asserta/1,     % +Data
            http_session_assert/1,      % +Data
            http_session_retract/1,     % ?Data
            http_session_retractall/1,  % +Data
            http_session_data/1,        % ?Data

            http_session_asserta/2,     % +Data, +SessionId
            http_session_assert/2,      % +Data, +SessionId
            http_session_retract/2,     % ?Data, +SessionId
            http_session_retractall/2,  % +Data, +SessionId
            http_session_data/2         % ?Data, +SessionId
          ]).
:- use_module(http_wrapper).
:- use_module(http_stream).
:- use_module(library(error)).
:- use_module(library(debug)).
:- use_module(library(socket)).
:- use_module(library(broadcast)).
:- use_module(library(lists)).
:- use_module(library(time)).
:- use_module(library(option)).

:- predicate_options(http_open_session/2, 2, [renew(boolean)]).

/** <module> 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)).
    ==
*/

:- dynamic
    session_setting/1,              % Name(Value)
    current_session/2,              % SessionId, Peer
    last_used/2,                    % SessionId, Time
    session_data/2.                 % SessionId, Data

:- multifile
    hooked/0,
    hook/1,                         % +Term
    session_option/2.

session_setting(timeout(600)).      % timeout in seconds
session_setting(cookie('swipl_session')).
session_setting(path(/)).
session_setting(enabled(true)).
session_setting(create(auto)).
session_setting(proxy_enabled(false)).
session_setting(gc(passive)).
session_setting(samesite(lax)).

session_option(timeout, integer).
session_option(cookie, atom).
session_option(path, atom).
session_option(create, oneof([auto,noauto])).
session_option(route, atom).
session_option(enabled, boolean).
session_option(proxy_enabled, boolean).
session_option(gc, oneof([active,passive])).
session_option(samesite, oneof([none,lax,strict])).

%!  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.
%
%           * samesite(+Restriction)
%           One of `none`, `lax` (default), or `strict` - The
%           SameSite attribute prevents the CSRF vulnerability.
%           strict has best security, but prevents links from
%           external sites from operating properly. lax stops most
%           CSRF attacks against REST endpoints but rarely interferes
%           with legitimage operations. `none` removes the samesite
%           attribute entirely. __Caution: The value `none` exposes the
%           entire site to CSRF attacks.__
%
%   In addition, extension libraries can define session_option/2 to make
%   this   predicate   support    more     options.    In    particular,
%   library(http/http_redis_plugin)  defines  the  following  additional
%   options:
%
%     - redis_db(+DB)
%       Alias name of the redis database to access.  See redis_server/3.
%     - redis_prefix(+Atom)
%       Prefix to use for all HTTP session related keys.  Default is
%       `'swipl:http:session'`

http_set_session_options([]).
http_set_session_options([H|T]) :-
    http_set_session_option(H),
    http_set_session_options(T).

http_set_session_option(Option) :-
    functor(Option, Name, Arity),
    arg(1, Option, Value),
    (   session_option(Name, Type)
    ->  must_be(Type, Value)
    ;   domain_error(http_session_option, Option)
    ),
    functor(Free, Name, Arity),
    (   clause(session_setting(Free), _, Ref)
    ->  (   Free \== Value
        ->  asserta(session_setting(Option)),
            erase(Ref),
            updated_session_setting(Name, Free, Value)
        ;   true
        )
    ;   asserta(session_setting(Option))
    ).

%!  http_session_option(?Option) is nondet.
%
%   True if Option is a current option of the session system.

http_session_option(Option) :-
    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).

:- public session_setting/2.

session_setting(SessionID, Setting) :-
    nonvar(Setting),
    get_session_option(SessionID, Setting),
    !.
session_setting(_, Setting) :-
    session_setting(Setting).

get_session_option(SessionID, Setting) :-
    hooked,
    !,
    hook(get_session_option(SessionID, Setting)).
get_session_option(SessionID, Setting) :-
    functor(Setting, Name, 1),
    local_option(Name, Value, Term),
    session_data(SessionID, '$setting'(Term)),
    !,
    arg(1, Setting, Value).


updated_session_setting(gc, _, passive) :-
    stop_session_gc_thread, !.
updated_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=.
%
%   @error  permission_error(set, http_session, Setting) if setting
%           a setting that is not supported on per-session basis.

http_set_session(Setting) :-
    http_session_id(SessionId),
    http_set_session(SessionId, Setting).

http_set_session(SessionId, Setting) :-
    functor(Setting, Name, _),
    (   local_option(Name, _, _)
    ->  true
    ;   permission_error(set, http_session, Setting)
    ),
    arg(1, Setting, Value),
    (   session_option(Name, Type)
    ->  must_be(Type, Value)
    ;   domain_error(http_session_option, Setting)
    ),
    set_session_option(SessionId, Setting).

set_session_option(SessionId, Setting) :-
    hooked,
    !,
    hook(set_session_option(SessionId, Setting)).
set_session_option(SessionId, Setting) :-
    functor(Setting, Name, Arity),
    functor(Free, Name, Arity),
    retractall(session_data(SessionId, '$setting'(Free))),
    assert(session_data(SessionId, '$setting'(Setting))).

local_option(timeout, X, timeout(X)).

%!  http_session_id(-SessionId) is det.
%
%   True if SessionId is an identifier for the current session.
%
%   @arg   SessionId is an atom.
%   @error existence_error(http_session, _)
%   @see   http_in_session/1 for a version that fails if there is
%          no session.

http_session_id(SessionID) :-
    (   http_in_session(ID)
    ->  SessionID = ID
    ;   throw(error(existence_error(http_session, _), _))
    ).

%!  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 http_session_id/1

http_in_session(SessionID) :-
    nb_current(http_session_id, ID),
    ID \== [],
    !,
    debug(http_session, 'Session id from global variable: ~q', [ID]),
    ID \== no_session,
    SessionID = ID.
http_in_session(SessionID) :-
    http_current_request(Request),
    http_in_session(Request, SessionID).

http_in_session(Request, SessionID) :-
    memberchk(session(ID), Request),
    !,
    debug(http_session, 'Session id from request: ~q', [ID]),
    b_setval(http_session_id, ID),
    SessionID = ID.
http_in_session(Request, SessionID) :-
    memberchk(cookie(Cookies), Request),
    session_setting(cookie(Cookie)),
    member(Cookie=SessionID0, Cookies),
    debug(http_session, 'Session id from cookie: ~q', [SessionID0]),
    peer(Request, Peer),
    valid_session_id(SessionID0, Peer),
    !,
    b_setval(http_session_id, SessionID0),
    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.

http_session(Request, Request, SessionID) :-
    memberchk(session(SessionID0), Request),
    !,
    SessionID = SessionID0.
http_session(Request0, Request, SessionID) :-
    memberchk(cookie(Cookies), Request0),
    session_setting(cookie(Cookie)),
    member(Cookie=SessionID0, Cookies),
    peer(Request0, Peer),
    valid_session_id(SessionID0, Peer),
    !,
    SessionID = SessionID0,
    Request = [session(SessionID)|Request0],
    b_setval(http_session_id, SessionID).
http_session(Request0, Request, SessionID) :-
    session_setting(create(auto)),
    session_setting(path(Path)),
    memberchk(path(ReqPath), Request0),
    sub_atom(ReqPath, 0, _, _, Path),
    !,
    create_session(Request0, Request, SessionID).

create_session(Request0, Request, SessionID) :-
    http_gc_sessions,
    http_session_cookie(SessionID),
    session_setting(cookie(Cookie)),
    session_setting(path(Path)),
    session_setting(samesite(SameSite)),
    debug(http_session, 'Created session ~q at path=~q', [SessionID, Path]),
    (   SameSite == none
    ->  format('Set-Cookie: ~w=~w; Path=~w; Version=1\r\n',
               [Cookie, SessionID, Path])
    ;   format('Set-Cookie: ~w=~w; Path=~w; Version=1; SameSite=~w\r\n',
               [Cookie, SessionID, Path, SameSite])
    ),
    Request = [session(SessionID)|Request0],
    peer(Request0, Peer),
    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.
%
%   @see    http_set_session_options/1 to control the =create= option.
%   @see    http_close_session/1 for closing the session.
%   @error  permission_error(open, http_session, CGI) if this call
%           is used after closing the CGI header.

http_open_session(SessionID, Options) :-
    http_in_session(SessionID0),
    \+ option(renew(true), Options, false),
    !,
    SessionID = SessionID0.
http_open_session(SessionID, _Options) :-
    (   in_header_state
    ->  true
    ;   current_output(CGI),
        permission_error(open, http_session, CGI)
    ),
    (   http_in_session(ActiveSession)
    ->  http_close_session(ActiveSession, false)
    ;   true
    ),
    http_current_request(Request),
    create_session(Request, _, SessionID).


:- multifile
    http:request_expansion/2.

http:request_expansion(Request0, Request) :-
    session_setting(enabled(true)),
    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.

peer(Request, Peer) :-
    (   session_setting(proxy_enabled(true)),
        http_peer(Request, Peer)
    ->  true
    ;   memberchk(peer(Peer), Request)
    ->  true
    ;   true
    ).

%!  open_session(+SessionID, +Peer)
%
%   Open a new session.  Uses broadcast/1 with the term
%   http_session(begin(SessionID, Peer)).

open_session(SessionID, Peer) :-
    assert_session(SessionID, Peer),
    b_setval(http_session_id, SessionID),
    broadcast(http_session(begin(SessionID, Peer))).

assert_session(SessionID, Peer) :-
    hooked,
    !,
    hook(assert_session(SessionID, Peer)).
assert_session(SessionID, Peer) :-
    get_time(Now),
    assert(current_session(SessionID, Peer)),
    assert(last_used(SessionID, Now)).

%!  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.

valid_session_id(SessionID, Peer) :-
    active_session(SessionID, SessionPeer, LastUsed),
    get_time(Now),
    (   session_setting(SessionID, timeout(Timeout)),
        Timeout > 0
    ->  Idle is Now - LastUsed,
        (   Idle =< Timeout
        ->  true
        ;   http_close_session(SessionID),
            fail
        )
    ;   Peer \== SessionPeer
    ->  http_close_session(SessionID),
        fail
    ;   true
    ),
    set_last_used(SessionID, Now, Timeout).

active_session(SessionID, Peer, LastUsed) :-
    hooked,
    !,
    hook(active_session(SessionID, Peer, LastUsed)).
active_session(SessionID, Peer, LastUsed) :-
    current_session(SessionID, Peer),
    get_last_used(SessionID, LastUsed).

get_last_used(SessionID, Last) :-
    atom(SessionID),
    !,
    once(last_used(SessionID, Last)).
get_last_used(SessionID, Last) :-
    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.

set_last_used(SessionID, Now, TimeOut) :-
    hooked,
    !,
    hook(set_last_used(SessionID, Now, TimeOut)).
set_last_used(SessionID, Now, TimeOut) :-
    LastUsed is floor(Now/10)*10,
    (   clause(last_used(SessionID, CurrentLast), _, Ref)
    ->  (   CurrentLast == LastUsed
        ->  true
        ;   asserta(last_used(SessionID, LastUsed)),
            erase(Ref),
            schedule_gc(LastUsed, TimeOut)
        )
    ;   asserta(last_used(SessionID, LastUsed)),
        schedule_gc(LastUsed, TimeOut)
    ).


                 /*******************************
                 *         SESSION DATA         *
                 *******************************/

%!  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.

http_session_asserta(Data) :-
    http_session_id(SessionId),
    (   hooked
    ->  hook(asserta(session_data(SessionId, Data)))
    ;   asserta(session_data(SessionId, Data))
    ).

http_session_assert(Data) :-
    http_session_id(SessionId),
    (   hooked
    ->  hook(assertz(session_data(SessionId, Data)))
    ;   assertz(session_data(SessionId, Data))
    ).

http_session_retract(Data) :-
    http_session_id(SessionId),
    (   hooked
    ->  hook(retract(session_data(SessionId, Data)))
    ;   retract(session_data(SessionId, Data))
    ).

http_session_retractall(Data) :-
    http_session_id(SessionId),
    (   hooked
    ->  hook(retractall(session_data(SessionId, Data)))
    ;   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.
%
%   @error  existence_error(http_session,_)

http_session_data(Data) :-
    http_session_id(SessionId),
    (   hooked
    ->  hook(session_data(SessionId, Data))
    ;   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 http_current_session/2.

http_session_asserta(Data, SessionId) :-
    must_be(atom, SessionId),
    (   hooked
    ->  hook(asserta(session_data(SessionId, Data)))
    ;   asserta(session_data(SessionId, Data))
    ).

http_session_assert(Data, SessionId) :-
    must_be(atom, SessionId),
    (   hooked
    ->  hook(assertz(session_data(SessionId, Data)))
    ;   assertz(session_data(SessionId, Data))
    ).

http_session_retract(Data, SessionId) :-
    must_be(atom, SessionId),
    (   hooked
    ->  hook(retract(session_data(SessionId, Data)))
    ;   retract(session_data(SessionId, Data))
    ).

http_session_retractall(Data, SessionId) :-
    must_be(atom, SessionId),
    (   hooked
    ->  hook(retractall(session_data(SessionId, Data)))
    ;   retractall(session_data(SessionId, Data))
    ).

http_session_data(Data, SessionId) :-
    must_be(atom, SessionId),
    (   hooked
    ->  hook(session_data(SessionId, Data))
    ;   session_data(SessionId, Data)
    ).


                 /*******************************
                 *           ENUMERATE          *
                 *******************************/

%!  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.

http_current_session(SessionID, Data) :-
    hooked,
    !,
    hook(current_session(SessionID, Data)).
http_current_session(SessionID, Data) :-
    get_time(Now),
    get_last_used(SessionID, Last), % binds SessionID
    Idle is Now - Last,
    (   session_setting(SessionID, timeout(Timeout)),
        Timeout > 0
    ->  Idle =< Timeout
    ;   true
    ),
    (   Data = idle(Idle)
    ;   Data = peer(Peer),
        current_session(SessionID, Peer)
    ;   session_data(SessionID, Data)
    ).


                 /*******************************
                 *          GC SESSIONS         *
                 *******************************/

%!  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.
%
%   @error  type_error(atom, SessionID)
%   @see    listen/2 for acting upon closed sessions

http_close_session(SessionId) :-
    http_close_session(SessionId, true).

http_close_session(SessionId, Expire) :-
    hooked,
    !,
    forall(hook(close_session(SessionId)),
           expire_session_cookie(Expire)).
http_close_session(SessionId, Expire) :-
    must_be(atom, SessionId),
    (   current_session(SessionId, Peer),
        (   b_setval(http_session_id, SessionId),
            broadcast(http_session(end(SessionId, Peer))),
            fail
        ;   true
        ),
        expire_session_cookie(Expire),
        retractall(current_session(SessionId, _)),
        retractall(last_used(SessionId, _)),
        retractall(session_data(SessionId, _)),
        fail
    ;   true
    ).


%!  expire_session_cookie(+Expire) is det.
%
%   Emit a request to delete a session  cookie. This is only done if
%   http_close_session/1 is still in `header mode'.

expire_session_cookie(true) :-
    !,
    expire_session_cookie.
expire_session_cookie(_).

expire_session_cookie :-
    in_header_state,
    session_setting(cookie(Cookie)),
    session_setting(path(Path)),
    !,
    format('Set-Cookie: ~w=; \c
                expires=Tue, 01-Jan-1970 00:00:00 GMT; \c
                path=~w\r\n',
           [Cookie, Path]).
expire_session_cookie.

in_header_state :-
    current_output(CGI),
    is_cgi_stream(CGI),
    cgi_property(CGI, state(header)),
    !.


%!  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.

:- dynamic
    last_gc/1.

http_gc_sessions :-
    start_session_gc_thread,
    http_gc_sessions(60).
http_gc_sessions(TimeOut) :-
    (   with_mutex(http_session_gc, need_sesion_gc(TimeOut))
    ->  do_http_gc_sessions
    ;   true
    ).

need_sesion_gc(TimeOut) :-
    get_time(Now),
    (   last_gc(LastGC),
        Now-LastGC < TimeOut
    ->  true
    ;   retractall(last_gc(_)),
        asserta(last_gc(Now)),
        do_http_gc_sessions
    ).

do_http_gc_sessions :-
    hooked,
    !,
    hook(gc_sessions).
do_http_gc_sessions :-
    debug(http_session(gc), 'Running HTTP session GC', []),
    get_time(Now),
    (   session_setting(SessionID, timeout(Timeout)),
        last_used(SessionID, Last),
        Timeout > 0,
        Idle is Now - Last,
        Idle > Timeout,
        http_close_session(SessionID, false),
        fail
    ;   true
    ).

%!  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.

:- dynamic
    session_gc_queue/1.

start_session_gc_thread :-
    session_gc_queue(_),
    !.
start_session_gc_thread :-
    session_setting(gc(active)),
    !,
    catch(thread_create(session_gc_loop, _,
                        [ alias('__http_session_gc'),
                          at_exit(retractall(session_gc_queue(_)))
                        ]),
          error(permission_error(create, thread, _),_),
          true).
start_session_gc_thread.

stop_session_gc_thread :-
    retract(session_gc_queue(Id)),
    !,
    thread_send_message(Id, done),
    thread_join(Id, _).
stop_session_gc_thread.

session_gc_loop :-
    thread_self(GcQueue),
    asserta(session_gc_queue(GcQueue)),
    repeat,
    thread_get_message(Message),
    (   Message == done
    ->  !
    ;   schedule(Message),
        fail
    ).

schedule(at(Time)) :-
    current_alarm(At, _, _, _),
    Time == At,
    !.
schedule(at(Time)) :-
    debug(http_session(gc), 'Schedule GC at ~p', [Time]),
    alarm_at(Time, http_gc_sessions(10), _,
             [ remove(true)
             ]).

schedule_gc(LastUsed, TimeOut) :-
    nonvar(TimeOut),                            % var(TimeOut) means none
    session_gc_queue(Queue),
    !,
    At is LastUsed+TimeOut+5,                   % give some slack
    thread_send_message(Queue, at(At)).
schedule_gc(_, _).


                 /*******************************
                 *             UTIL             *
                 *******************************/

%!  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.

http_session_cookie(Cookie) :-
    route(Route),
    !,
    random_4(R1,R2,R3,R4),
    format(atom(Cookie),
            '~`0t~16r~4|-~`0t~16r~9|-~`0t~16r~14|-~`0t~16r~19|.~w',
            [R1,R2,R3,R4,Route]).
http_session_cookie(Cookie) :-
    random_4(R1,R2,R3,R4),
    format(atom(Cookie),
            '~`0t~16r~4|-~`0t~16r~9|-~`0t~16r~14|-~`0t~16r~19|',
            [R1,R2,R3,R4]).

:- thread_local
    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.

route(Route) :-
    route_cache(Route),
    !,
    Route \== ''.
route(Route) :-
    route_no_cache(Route),
    assert(route_cache(Route)),
    Route \== ''.

route_no_cache(Route) :-
    session_setting(route(Route)),
    !.
route_no_cache(Route) :-
    gethostname(Host),
    (   sub_atom(Host, Before, _, _, '.')
    ->  sub_atom(Host, 0, Before, _, Route)
    ;   Route = Host
    ).

:- 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.

:- dynamic
    urandom_handle/1.

urandom(Handle) :-
    urandom_handle(Handle),
    !,
    Handle \== [].
urandom(Handle) :-
    catch(open('/dev/urandom', read, In, [type(binary)]), _, fail),
    !,
    assert(urandom_handle(In)),
    Handle = In.
urandom(_) :-
    assert(urandom_handle([])),
    fail.

get_pair(In, Value) :-
    get_byte(In, B1),
    get_byte(In, B2),
    Value is B1<<8+B2.
:- 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.

:- if(current_predicate(urandom/1)).
random_4(R1,R2,R3,R4) :-
    urandom(In),
    !,
    get_pair(In, R1),
    get_pair(In, R2),
    get_pair(In, R3),
    get_pair(In, R4).
:- endif.
random_4(R1,R2,R3,R4) :-
    R1 is random(65536),
    R2 is random(65536),
    R3 is random(65536),
    R4 is random(65536).

%!  hooked is semidet.
%!  hook(+Goal).
%
%   These multifile predicates may be used to   hook the data storage of
%   this     library.     An     example       is     implemented     by
%   library(http/http_redis_plugin), storing all session data in a redis
%   database.