1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2020, SWI-Prolog Solutions b.v.
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(http_redis_plugin, []).   36:- use_module(library(http/http_session)).   37:- autoload(library(apply), [maplist/3]).   38:- autoload(library(error), [must_be/2]).   39:- autoload(library(lists), [member/2]).   40:- autoload(library(redis), [redis/3]).   41:- autoload(library(broadcast), [broadcast/1]).   42:- use_module(library(debug), [debug/3]).   43
   44/** <module> Hook session management to use Redis
   45
   46This module acts as  a   plugin  for library(http/http_session), storing
   47session information on a Redis server. This has several consequences:
   48
   49  - The Prolog server may be restarted without loosing session data.
   50    This is notably useful when long session timeouts are used.
   51  - Multiple Prolog servers can act as a cluster while session
   52    management is used.
   53  - Associating Prolog data with sessions is relatively slow.  The
   54    assert/retract is replaced by managing a Redis list.  Data in
   55    this list is matched sequentially, where each term needs to be
   56    parsed before it can be matched.
   57  - Associated data is currently limited to __ground terms__.
   58
   59The   library   is   activated   by   loading    it   in   addition   to
   60library(http/http_session)  and  using    http_set_session_options/1  to
   61configure the Redis database as below. The redis_server/2 predicate from
   62library(redis) can be used  to  specify   the  parameters  for the redis
   63server  such as host, port or authentication.
   64
   65```
   66:- http_set_session_options(
   67       [ redis_db(default),
   68         redis_prefix('swipl:http:session')
   69       ]).
   70```
   71
   72## Redis key usage
   73
   74All  Redis  keys  reside  under  a    prefix  specified  by  the  option
   75redis_prefix(Prefix), which defaults to  `'swipl:http:session'`. Here we
   76find:
   77
   78  - An ordered set at <prefix>:expire that contains the session ids,
   79    ordered by the time the session expires.  Session enumeration and
   80    garbage collection is based on this set.
   81  - A hash at <prefix>:session:<id> which contains the _peer_ address,
   82    the _last used_ time and optionally session specific settings.
   83  - If there is session _data_, a list at <prefix>:data:<id> of Prolog
   84    terms, represented as strings that contain the session data.
   85*/
   86
   87:- multifile
   88    http_session:hooked/0,
   89    http_session:hook/1,
   90    http_session:session_option/2.   91
   92http_session:session_option(redis_db, atom).
   93http_session:session_option(redis_prefix, atom).
   94
   95http_session:hooked :-
   96    http_session:session_setting(redis_db(_)).
   97
   98%http_session:hook(assert_session(SessionID, Peer)).
   99%http_session:hook(set_session_option(SessionId, Setting)).
  100%http_session:hook(get_session_option(SessionId, Setting)).
  101%http_session:hook(active_session(SessionID, Peer, LastUsed)).
  102%http_session:hook(set_last_used(SessionID, Now, TimeOut)).
  103%http_session:hook(asserta(session_data(SessionId, Data))).
  104%http_session:hook(assertz(session_data(SessionId, Data))).
  105%http_session:hook(retract(session_data(SessionId, Data))).
  106%http_session:hook(retractall(session_data(SessionId, Data))).
  107%http_session:hook(session_data(SessionId, Data)).
  108%http_session:hook(current_session(SessionID, Data)).
  109%http_session:hook(close_session(?SessionID)).
  110%http_session:hook(gc_sessions).
  111
  112:- dynamic
  113    peer/2,                             % SessionID, Peer
  114    last_used/2.                        % SessionID, Time
  115
  116
  117http_session:hook(assert_session(SessionID, Peer)) :-
  118    session_db(SessionID, DB, Key),
  119    http_session:session_setting(timeout(Timeout)),
  120    asserta(peer(SessionID, Peer)),
  121    peer_string(Peer, PeerS),
  122    get_time(Now),
  123    redis(DB, hset(Key,
  124                   peer, PeerS,
  125                   last_used, Now)),
  126    expire(SessionID, Timeout).
  127http_session:hook(set_session_option(SessionID, Setting)) :-
  128    session_db(SessionID, DB, Key),
  129    Setting =.. [Name,Value],
  130    redis(DB, hset(Key, Name, Value as prolog)),
  131    (   Setting = timeout(Timeout)
  132    ->  expire(SessionID, Timeout)
  133    ;   true
  134    ).
  135http_session:hook(get_session_option(SessionID, Setting)) :-
  136    session_db(SessionID, DB, Key),
  137    Setting =.. [Name,Value],
  138    redis(DB, hget(Key, Name), Value).
  139http_session:hook(active_session(SessionID, Peer, LastUsed)) :-
  140    (   last_used(SessionID, LastUsed0),
  141        peer(SessionID, Peer0)
  142    ->  LastUsed = LastUsed0,
  143        Peer = Peer0
  144    ;   session_db(SessionID, DB, Key),
  145        redis(DB, hget(Key, peer), PeerS),
  146        peer_string(Peer, PeerS),
  147        redis(DB, hget(Key, last_used), LastUsed as number),
  148        update_session(SessionID, LastUsed, _, Peer)
  149    ).
  150http_session:hook(set_last_used(SessionID, Now, Timeout)) :-
  151    LastUsed is floor(Now/10)*10,
  152    update_session(SessionID, LastUsed, Updated, _Peer),
  153    (   Updated == true
  154    ->  session_db(SessionID, DB, Key),
  155        redis(DB, hset(Key, last_used, Now)),
  156        Expire is Now+Timeout,
  157        expire(SessionID, Expire)
  158    ;   true
  159    ).
  160http_session:hook(asserta(session_data(SessionID, Data))) :-
  161    must_be(ground, Data),
  162    session_data_db(SessionID, DB, Key),
  163    redis(DB, lpush(Key, Data as prolog)).
  164http_session:hook(assertz(session_data(SessionID, Data))) :-
  165    must_be(ground, Data),
  166    session_data_db(SessionID, DB, Key),
  167    redis(DB, rpush(Key, Data as prolog)).
  168http_session:hook(retract(session_data(SessionID, Data))) :-
  169    session_data_db(SessionID, DB, Key),
  170    redis_get_list(DB, Key, 10, List),
  171    member(Data, List),
  172    redis(DB, lrem(Key, 1, Data as prolog)).
  173http_session:hook(retractall(session_data(SessionID, Data))) :-
  174    forall(http_session:hook(retract(session_data(SessionID, Data))),
  175           true).
  176http_session:hook(session_data(SessionID, Data)) :-
  177    session_data_db(SessionID, DB, Key),
  178    redis_get_list(DB, Key, 10, List),
  179    member(Data, List).
  180http_session:hook(current_session(SessionID, Data)) :-
  181    session_db(SessionID, DB, Key),
  182    redis(DB, hget(Key, last_used), Time as number),
  183    number(Time),
  184    get_time(Now),
  185    Idle is Now - Time,
  186    (   Data = peer(Peer),
  187        redis(DB, hget(Key, peer), PeerS),
  188        peer_string(Peer, PeerS)
  189    ;   Data = idle(Idle)
  190    ;   non_reserved_property(Data),
  191        http_session:hook(session_data(SessionID, Data))
  192    ).
  193http_session:hook(close_session(SessionID)) :-
  194    gc_session(SessionID).
  195http_session:hook(gc_sessions) :-
  196    gc_sessions.
  197
  198non_reserved_property(P) :-
  199    var(P),
  200    !.
  201non_reserved_property(peer(_)) :- !, fail.
  202non_reserved_property(idle(_)) :- !, fail.
  203non_reserved_property(_).
  204
  205
  206%!  update_session(+SessionID, ?LastUsed, -Updated, ?Peer) is det.
  207%
  208%   Update cached last_used and peer notions.
  209
  210update_session(SessionID, LastUsed, Updated, Peer) :-
  211    transaction(update_session_(SessionID, LastUsed, Updated, Peer)).
  212
  213update_session_(SessionID, LastUsed, Updated, Peer) :-
  214    update_last_used(SessionID, Updated, LastUsed),
  215    update_peer(SessionID, Peer).
  216
  217update_last_used(SessionID, Updated, LastUsed), nonvar(LastUsed) =>
  218    (   last_used(SessionID, LastUsed)
  219    ->  true
  220    ;   retractall(last_used(SessionID, _)),
  221        asserta(last_used(SessionID, LastUsed)),
  222        Updated = true
  223    ).
  224update_last_used(_, _, _) =>
  225    true.
  226
  227update_peer(SessionID, Peer), nonvar(Peer) =>
  228    (   peer(SessionID, Peer)
  229    ->  true
  230    ;   retractall(peer(SessionID, _)),
  231        asserta(peer(SessionID, Peer))
  232    ).
  233update_peer(_, _) =>
  234    true.
  235
  236
  237		 /*******************************
  238		 *      SCHEDULE TIMEOUT	*
  239		 *******************************/
  240
  241expire(SessionID, Timeout) :-
  242    get_time(Now),
  243    Time is Now+Timeout,
  244    session_expire_db(DB, Key),
  245    redis(DB, zadd(Key, Time, SessionID)).
  246
  247gc_sessions :-
  248    session_expire_db(DB, Key),
  249    get_time(Now),
  250    redis(DB, zrangebyscore(Key, "-inf", Now), TimedOut as atom),
  251    forall(member(SessionID, TimedOut),
  252           gc_session(SessionID)).
  253
  254gc_session(_) :-
  255    prolog_current_frame(Frame),
  256    prolog_frame_attribute(Frame, parent, PFrame),
  257    prolog_frame_attribute(PFrame, parent_goal, gc_session(_)),
  258    !.
  259gc_session(SessionID) :-
  260    debug(http_session(gc), 'GC session ~p', [SessionID]),
  261    session_db(SessionID, DB, SessionKey),
  262    session_expire_db(DB, TMOKey),
  263    redis(DB, zrem(TMOKey, SessionID)),
  264    redis(DB, hget(SessionKey, peer), PeerS),
  265    peer_string(Peer, PeerS),
  266    broadcast(http_session(end(SessionID, Peer))),
  267    redis(DB, del(SessionKey)),
  268    session_data_db(SessionID, DB, DataKey),
  269    redis(DB, del(DataKey)),
  270    retractall(peer(SessionID, _)),
  271    retractall(last_used(SessionID, _)).
  272
  273
  274		 /*******************************
  275		 *             UTIL		*
  276		 *******************************/
  277
  278peer_string(ip(A,B,C,D), String) :-
  279    nonvar(String),
  280    !,
  281    split_string(String, ".", "", List),
  282    maplist(number_string, [A,B,C,D], List).
  283peer_string(ip(A,B,C,D), String) :-
  284    atomics_to_string([A,B,C,D], ".", String).
  285
  286session_db(SessionID, DB, Key) :-
  287    nonvar(SessionID),
  288    !,
  289    http_session:session_setting(redis_db(DB)),
  290    key_prefix(Prefix),
  291    atomics_to_string([Prefix,session,SessionID], :, Key).
  292session_db(SessionID, DB, Key) :-
  293    session_expire_db(DB, TMOKey),
  294    redis_zscan(DB, TMOKey, Pairs, []),
  295    member(SessionIDS-_Timeout, Pairs),
  296    atom_string(SessionID, SessionIDS),
  297    key_prefix(Prefix),
  298    atomics_to_string([Prefix,session,SessionID], :, Key).
  299
  300session_expire_db(DB, Key) :-
  301    http_session:session_setting(redis_db(DB)),
  302    key_prefix(Prefix),
  303    atomics_to_string([Prefix,expire], :, Key).
  304
  305session_data_db(SessionID, DB, Key) :-
  306    http_session:session_setting(redis_db(DB)),
  307    key_prefix(Prefix),
  308    atomics_to_string([Prefix,data,SessionID], :, Key).
  309
  310key_prefix(Prefix) :-
  311    http_session:session_setting(redis_prefix(Prefix)),
  312    !.
  313key_prefix('swipl:http:sessions')