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

Hook session management to use Redis

This module acts as a plugin for library(http/http_session), storing session information on a Redis server. This has several consequences:

The library is activated by loading it in addition to library(http/http_session) and using http_set_session_options/1 to configure the Redis database as below. The redis_server/2 predicate from library(redis) can be used to specify the parameters for the redis server such as host, port or authentication.

:- http_set_session_options(
       [ redis_db(default),
         redis_prefix('swipl:http:session')
       ]).

Redis key usage

All Redis keys reside under a prefix specified by the option redis_prefix(Prefix), which defaults to 'swipl:http:session'. Here we find:

   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    get_time(Now),
  184    Idle is Now - Time,
  185    (   Data = peer(Peer),
  186        redis(DB, hget(Key, peer), PeerS),
  187        peer_string(Peer, PeerS)
  188    ;   Data = idle(Idle)
  189    ;   non_reserved_property(Data),
  190        http_session:hook(session_data(SessionID, Data))
  191    ).
  192http_session:hook(close_session(SessionID)) :-
  193    gc_session(SessionID).
  194http_session:hook(gc_sessions) :-
  195    gc_sessions.
  196
  197non_reserved_property(P) :-
  198    var(P),
  199    !.
  200non_reserved_property(peer(_)) :- !, fail.
  201non_reserved_property(idle(_)) :- !, fail.
  202non_reserved_property(_).
 update_session(+SessionID, ?LastUsed, -Updated, ?Peer) is det
Update cached last_used and peer notions.
  209update_session(SessionID, LastUsed, Updated, Peer) :-
  210    transaction(update_session_(SessionID, LastUsed, Updated, Peer)).
  211
  212update_session_(SessionID, LastUsed, Updated, Peer) :-
  213    update_last_used(SessionID, Updated, LastUsed),
  214    update_peer(SessionID, Peer).
  215
  216update_last_used(SessionID, Updated, LastUsed), nonvar(LastUsed) =>
  217    (   last_used(SessionID, LastUsed)
  218    ->  true
  219    ;   retractall(last_used(SessionID, _)),
  220        asserta(last_used(SessionID, LastUsed)),
  221        Updated = true
  222    ).
  223update_last_used(_, _, _) =>
  224    true.
  225
  226update_peer(SessionID, Peer), nonvar(Peer) =>
  227    (   peer(SessionID, Peer)
  228    ->  true
  229    ;   retractall(peer(SessionID, _)),
  230        asserta(peer(SessionID, Peer))
  231    ).
  232update_peer(_, _) =>
  233    true.
  234
  235
  236		 /*******************************
  237		 *      SCHEDULE TIMEOUT	*
  238		 *******************************/
  239
  240expire(SessionID, Timeout) :-
  241    get_time(Now),
  242    Time is Now+Timeout,
  243    session_expire_db(DB, Key),
  244    redis(DB, zadd(Key, Time, SessionID)).
  245
  246gc_sessions :-
  247    session_expire_db(DB, Key),
  248    get_time(Now),
  249    redis(DB, zrangebyscore(Key, "-inf", Now), TimedOut as atom),
  250    forall(member(SessionID, TimedOut),
  251           gc_session(SessionID)).
  252
  253gc_session(_) :-
  254    prolog_current_frame(Frame),
  255    prolog_frame_attribute(Frame, parent, PFrame),
  256    prolog_frame_attribute(PFrame, parent_goal, gc_session(_)),
  257    !.
  258gc_session(SessionID) :-
  259    debug(http_session(gc), 'GC session ~p', [SessionID]),
  260    session_db(SessionID, DB, SessionKey),
  261    session_expire_db(DB, TMOKey),
  262    redis(DB, zrem(TMOKey, SessionID)),
  263    redis(DB, hget(SessionKey, peer), PeerS),
  264    peer_string(Peer, PeerS),
  265    broadcast(http_session(end(SessionID, Peer))),
  266    redis(DB, del(SessionKey)),
  267    session_data_db(SessionID, DB, DataKey),
  268    redis(DB, del(DataKey)),
  269    retractall(peer(SessionID, _)),
  270    retractall(last_used(SessionID, _)).
  271
  272
  273		 /*******************************
  274		 *             UTIL		*
  275		 *******************************/
  276
  277peer_string(ip(A,B,C,D), String) :-
  278    nonvar(String),
  279    !,
  280    split_string(String, ".", "", List),
  281    maplist(number_string, [A,B,C,D], List).
  282peer_string(ip(A,B,C,D), String) :-
  283    atomics_to_string([A,B,C,D], ".", String).
  284
  285session_db(SessionID, DB, Key) :-
  286    nonvar(SessionID),
  287    !,
  288    http_session:session_setting(redis_db(DB)),
  289    key_prefix(Prefix),
  290    atomics_to_string([Prefix,session,SessionID], :, Key).
  291session_db(SessionID, DB, Key) :-
  292    session_expire_db(DB, TMOKey),
  293    redis_zscan(DB, TMOKey, Pairs, []),
  294    member(SessionIDS-_Timeout, Pairs),
  295    atom_string(SessionID, SessionIDS),
  296    key_prefix(Prefix),
  297    atomics_to_string([Prefix,session,SessionID], :, Key).
  298
  299session_expire_db(DB, Key) :-
  300    http_session:session_setting(redis_db(DB)),
  301    key_prefix(Prefix),
  302    atomics_to_string([Prefix,expire], :, Key).
  303
  304session_data_db(SessionID, DB, Key) :-
  305    http_session:session_setting(redis_db(DB)),
  306    key_prefix(Prefix),
  307    atomics_to_string([Prefix,data,SessionID], :, Key).
  308
  309key_prefix(Prefix) :-
  310    http_session:session_setting(redis_prefix(Prefix)),
  311    !.
  312key_prefix('swipl:http:sessions')