kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/ext/http/http/hub.pl

@@ -0,0 +1,600 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2014-2020, VU University Amsterdam
+                              CWI Amsterdam
+    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(hub,
+          [ hub_create/3,               % +HubName, -Hub, +Options
+            hub_add/3,                  % +HubName, +Websocket, ?Id
+            hub_member/2,               % +HubName, ?Id
+            hub_send/2,                 % +ClientId, +Message
+            hub_broadcast/2,            % +HubName, +Message
+            hub_broadcast/3,            % +HubName, +Message, +Condition
+            current_hub/2               % ?HubName, ?Hub
+          ]).
+:- use_module(library(debug)).
+:- use_module(library(error)).
+:- use_module(library(apply)).
+:- use_module(library(gensym)).
+:- if(exists_source(library(uuid))).
+:- use_module(library(uuid)).
+:- endif.
+:- use_module(library(ordsets)).
+:- use_module(library(http/websocket)).
+
+:- meta_predicate
+    hub_broadcast(+,+,1).
+
+/** <module> Manage a hub for websockets
+
+This library manages a hub that consists   of clients that are connected
+using a websocket. Messages arriving at any   of the websockets are sent
+to the _event_ queue  of  the  hub.   In  addition,  the  hub provides a
+_broadcast_ interface. A typical usage scenario  for   a  hub is a _chat
+server_ A scenario for realizing an chat server is:
+
+  1. Create a new hub using hub_create/3.
+  2. Create one or more threads that listen to Hub.queues.event from
+     the created hub.  These threads can update the shared view of the
+     world. A message is a dict as returned by ws_receive/2 or a
+     hub control message. Currently, the following control messages
+     are defined:
+
+       - hub{left:ClientId, reason:Reason, error:Error}
+       A client left us because of an I/O error.  Reason is =read=
+       or =write= and Error is the Prolog I/O exception.
+
+       - hub{joined:ClientId}
+       A new client has joined the chatroom.
+
+     The thread(s) can talk to clients using two predicates:
+
+       - hub_send/2 sends a message to a specific client
+       - hub_broadcast/2 sends a message to all clients of the
+         hub.
+
+A hub consists of (currently) four message  queues  and a simple dynamic
+fact. Threads that are needed for the communication tasks are created on
+demand and die if no more work needs to be done.
+
+@tbd    The current design does not use threads to perform tasks for
+        multiple hubs.  This implies that the design scales rather
+        poorly for hosting many hubs with few users.
+*/
+
+:- dynamic
+    hub/2,                          % Hub, Queues ...
+    websocket/5.                    % Hub, Socket, Queue, Lock, Id
+
+:- volatile hub/2, websocket/5.
+
+%!  hub_create(+Name, -Hub, +Options) is det.
+%
+%   Create a new hub. Hub is a  dict containing the following public
+%   information:
+%
+%     - Hub.name
+%       The name of the hub (the Name argument)
+%     - queues.event
+%       Message queue to which the hub thread(s) can listen.
+%
+%   After creating a hub, the application  normally creates a thread
+%   that listens to Hub.queues.event and  exposes some mechanisms to
+%   establish websockets and add them to the hub using hub_add/3.
+%
+%   @see    http_upgrade_to_websocket/3 establishes a websocket from
+%           the SWI-Prolog webserver.
+
+hub_create(HubName, Hub, _Options) :-
+    must_be(atom, HubName),
+    message_queue_create(WaitQueue),
+    message_queue_create(ReadyQueue),
+    message_queue_create(EventQueue),
+    message_queue_create(BroadcastQueue),
+    Hub = hub{name:HubName,
+              queues:_{wait:WaitQueue,
+                       ready:ReadyQueue,
+                       event:EventQueue,
+                       broadcast:BroadcastQueue
+                      }},
+    assertz(hub(HubName, Hub)).
+
+
+%!  current_hub(?Name, ?Hub) is nondet.
+%
+%   True when there exists a hub Hub with Name.
+
+current_hub(HubName, Hub) :-
+    hub(HubName, Hub).
+
+
+                 /*******************************
+                 *            WAITERS           *
+                 *******************************/
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+The task of this layer is to wait   for  (a potentially large number of)
+websockets. Whenever there is data on one   of these sockets, the socket
+is handed to Hub.queues.ready. This is realised using wait_for_input/3,
+which allows a single thread  to  wait   for  many  sockets.  But ... on
+Windows it allows to wait for at most  64 sockets. In addition, there is
+no way to add an additional input   for control messages because Windows
+select() can only wait for sockets. On Unix   we could use pipe/2 to add
+the control channel. On Windows  we   would  need  an additional network
+service, giving rise its own  problems   with  allocation, firewalls and
+security.
+
+So, instead we keep a queue of websockets   that  need to be waited for.
+Whenever we add a  websocket,  we  create   a  waiter  thread  that will
+typically start waiting for this socket.   In  addition, we schedule any
+waiting thread that has less  than  the   maximum  number  of sockets to
+timeout at as good as we can the same   time.  All of them will hunt for
+the same set of queues,  but  they  have   to  wait  for  each other and
+therefore most of the time one thread will walk away with all websockets
+and the others commit suicide because there is nothing to wait for.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- meta_predicate
+    hub_thread(0, +, +).
+
+%!  hub_add(+Hub, +WebSocket, ?Id) is det.
+%
+%   Add a WebSocket to the hub. Id is used to identify this user. It may
+%   be provided (as a ground term) or is generated as a UUID.
+
+hub_add(HubName, WebSocket, Id) :-
+    must_be(atom, HubName),
+    hub(HubName, Hub),
+    (   var(Id)
+    ->  uuid(Id)
+    ;   true
+    ),
+    message_queue_create(OutputQueue),
+    mutex_create(Lock),
+                                         % asserta/1 allows for reuse of Id
+    asserta(websocket(HubName, WebSocket, OutputQueue, Lock, Id)),
+    thread_send_message(Hub.queues.wait, WebSocket),
+    thread_send_message(Hub.queues.event,
+                        hub{joined:Id}),
+    debug(hub(gate), 'Joined ~w: ~w', [HubName, Id]),
+    create_wait_thread(Hub).
+
+%!  hub_member(?HubName, ?Id) is nondet.
+%
+%   True when Id is a member of the hub HubName.
+
+hub_member(HubName, Id) :-
+    websocket(HubName, _WebSocket, _OutputQueue, _Lock, Id).
+
+:- if(\+current_predicate(uuid/1)).
+% FIXME: Proper pure Prolog random UUID implementation
+uuid(UUID) :-
+    A is random(1<<63),
+    format(atom(UUID), '~d', [A]).
+:- endif.
+
+create_wait_thread(Hub) :-
+    hub_thread(wait_for_sockets(Hub), Hub, hub_wait_).
+
+wait_for_sockets(Hub) :-
+    wait_for_sockets(Hub, 64).
+
+wait_for_sockets(Hub, Max) :-
+    Queues = Hub.queues,
+    repeat,
+      get_messages(Queues.wait, Max, List),
+      (   List \== []
+      ->  create_new_waiter_if_needed(Hub),
+          sort(List, Set),
+          (   debugging(hub(wait))
+          ->  length(Set, Len),
+              debug(hub(wait), 'Waiting for ~d queues', [Len])
+          ;   true
+          ),
+          wait_for_set(Set, Left, ReadySet, Max),
+          (   ReadySet \== []
+          ->  debug(hub(ready), 'Data on ~p', [ReadySet]),
+              Ready = Queues.ready,
+              maplist(thread_send_message(Ready), ReadySet),
+              create_reader_threads(Hub),
+              ord_subtract(Set, ReadySet, NotReadySet)
+          ;   NotReadySet = Left             % timeout
+          ),
+          (   NotReadySet \== []
+          ->  debug(hub(wait), 'Re-scheduling: ~p', [NotReadySet]),
+              Wait = Queues.wait,
+              maplist(thread_send_message(Wait), NotReadySet),
+              fail
+          ;   true
+          )
+      ;   !
+      ).
+
+create_new_waiter_if_needed(Hub) :-
+    message_queue_property(Hub.queues.wait, size(0)),
+    !.
+create_new_waiter_if_needed(Hub) :-
+    create_wait_thread(Hub).
+
+%!  wait_for_set(+Set0, -Left, -Ready, +Max) is det.
+%
+%   Wait for input from Set0.  Note that Set0 may contain closed
+%   websockets.
+
+wait_for_set([], [], [], _) :-
+    !.
+wait_for_set(Set0, Set, ReadySet, Max) :-
+    wait_timeout(Set0, Max, Timeout),
+    catch(wait_for_input(Set0, ReadySet, Timeout),
+          error(existence_error(stream, S), _), true),
+    (   var(S)
+    ->  Set = Set0
+    ;   delete(Set0, S, Set1),
+        wait_for_set(Set1, Set, ReadySet, Max)
+    ).
+
+
+%!  wait_timeout(+WaitForList, +Max, -TimeOut) is det.
+%
+%   Determine the timeout, such that   multiple  threads waiting for
+%   less than the maximum number of  sockets   time  out at the same
+%   moment and we can combine them on a single thread.
+
+:- dynamic
+    scheduled_timeout/1.
+
+wait_timeout(List, Max, Timeout) :-
+    length(List, Max),
+    !,
+    Timeout = infinite.
+wait_timeout(_, _, Timeout) :-
+    get_time(Now),
+    (   scheduled_timeout(SchedAt)
+    ->  (   SchedAt > Now
+        ->  At = SchedAt
+        ;   retractall(scheduled_timeout(_)),
+            At is ceiling(Now) + 1,
+            asserta(scheduled_timeout(At))
+        )
+    ;   At is ceiling(Now) + 1,
+        asserta(scheduled_timeout(At))
+    ),
+    Timeout is At - Now.
+
+
+%!  get_messages(+Queue, +Max, -List) is det.
+%
+%   Get the next Max messages from  Queue   or  as many as there are
+%   available without blocking very long.   This routine is designed
+%   such that if multiple threads are running for messages, one gets
+%   all of them and the others nothing.
+
+get_messages(Q, N, List) :-
+    with_mutex(hub_wait,
+               get_messages_sync(Q, N, List)).
+
+get_messages_sync(Q, N, [H|T]) :-
+    succ(N2, N),
+    thread_get_message(Q, H, [timeout(0.01)]),
+    !,
+    get_messages_sync(Q, N2, T).
+get_messages_sync(_, _, []).
+
+
+                 /*******************************
+                 *            READERS           *
+                 *******************************/
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+The next layer consists of `readers'.   Whenever  one or more websockets
+have   data,   the   socket   is    added   to   Hub.queues.ready   and
+create_reader_threads/1 is called. This  examines   the  number of ready
+sockets and fires a number  of  threads   to  handle  the read requests.
+Multiple threads are mainly needed for the case that a client signals to
+be  ready,  but  only  provides  an   incomplete  message,  causing  the
+ws_receive/2 to block.
+
+Each  of  the  threads  reads  the  next   message  and  sends  this  to
+Hub.queues.event. The websocket is then rescheduled   to listen for new
+events. This read either fires a thread   to  listen for the new waiting
+socket using create_wait_thread/1 or, if there   are no more websockets,
+does this job itself. This  deals  with   the  common  scenario that one
+client wakes up, starts a thread to  read   its  event and waits for new
+messages on the same websockets.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+create_reader_threads(Hub) :-
+    message_queue_property(Hub.queues.ready, size(Ready)),
+    Threads is ceiling(sqrt(Ready)),
+    forall(between(1, Threads, _),
+           create_reader_thread(Hub)).
+
+create_reader_thread(Hub) :-
+    hub_thread(read_message(Hub), Hub, hub_read_ws_).
+
+read_message(Hub) :-
+    Queues = Hub.queues,
+    thread_get_message(Queues.ready, WS, [timeout(0)]),
+    !,
+    catch(ws_receive(WS, Message), Error, true),
+    (   var(Error),
+        websocket(HubName, WS, _, _, Id)
+    ->  (   Message.get(opcode) == close
+        ->  close_client(WS, Message)
+        ;   Event = Message.put(_{client:Id, hub:HubName}),
+            debug(hub(event), 'Event: ~p', [Event]),
+            thread_send_message(Queues.event, Event),
+            (   Message.get(opcode) == close
+            ->  CloseError = error(_,_),
+                catch(ws_close(WS, 1000, ""), CloseError,
+                      ws_warning(CloseError))
+            ;   thread_send_message(Queues.wait, WS)
+            ),
+            (   message_queue_property(Queues.ready, size(0))
+            ->  !,
+                wait_for_sockets(Hub)
+            ;   create_wait_thread(Hub),
+                read_message(Hub)
+            )
+        )
+    ;   websocket(_, WS, _, _, _)
+    ->  io_read_error(WS, Error),
+        read_message(Hub)
+    ;   read_message(Hub)                   % already destroyed
+    ).
+read_message(_).
+
+ws_warning(error(Formal, _)) :-
+    silent(Formal),
+    !.
+ws_warning(Error) :-
+    print_message(warning, Error).
+
+silent(socket_error(epipe, _)).
+
+%!  io_read_error(+WebSocket, +Error)
+%
+%   Called on a read error from WebSocket.   We  close the websocket and
+%   send the hub an event that we   lost the connection to the specified
+%   client. Note that we leave  destruction   of  the  anonymous message
+%   queue and mutex to the Prolog garbage collector.
+
+io_read_error(WebSocket, Error) :-
+    debug(hub(gate), 'Got read error on ~w: ~p',
+          [WebSocket, Error]),
+    retract(websocket(HubName, WebSocket, _Queue, _Lock, Id)),
+    !,
+    E = error(_,_),
+    catch(ws_close(WebSocket, 1011, Error), E,
+          ws_warning(E)),
+    hub(HubName, Hub),
+    thread_send_message(Hub.queues.event,
+                        hub{left:Id,
+                            hub:HubName,
+                            reason:read,
+                            error:Error}).
+io_read_error(_, _).                      % already considered gone
+
+close_client(WebSocket, Message) :-
+    Message.get(data) == end_of_file,
+    !,
+    io_read_error(WebSocket, end_of_file).
+close_client(WebSocket, Message) :-
+    retract(websocket(HubName, WebSocket, _Queue, _Lock, Id)),
+    !,
+    E = error(_,_),
+    catch(ws_close(WebSocket, 1000, "Bye"), E,
+          ws_warning(E)),
+    hub(HubName, Hub),
+    thread_send_message(Hub.queues.event,
+                        hub{left:Id,
+                            hub:HubName,
+                            reason:close,
+                            data:Message.data
+                           }).
+
+%!  io_write_error(+WebSocket, +Message, +Error)
+%
+%   Failed to write Message to WebSocket due   to  Error. Note that this
+%   may be a pending but closed WebSocket.  We first check whether there
+%   is a new one and if not  send   a  `left` message and pass the error
+%   such that the client can re-send it when appropriate.
+
+io_write_error(WebSocket, Message, Error) :-
+    debug(hub(gate), 'Got write error on ~w: ~p',
+          [WebSocket, Error]),
+    retract(websocket(HubName, WebSocket, _Queue, _Lock, Id)),
+    !,
+    catch(ws_close(WebSocket, 1011, Error), _, true),
+    (   websocket(_, _, _, _, Id)
+    ->  true
+    ;   hub(HubName, Hub),
+        thread_send_message(Hub.queues.event,
+                            hub{left:Id,
+                                hub:HubName,
+                                reason:write(Message),
+                                error:Error})
+    ).
+io_write_error(_, _, _).                      % already considered gone
+
+
+                 /*******************************
+                 *        SENDING MESSAGES      *
+                 *******************************/
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+My  initial  thought  about  sending  messages    was  to  add  a  tuple
+WebSocket-Message to an output  queue  and   have  a  dynamic  number of
+threads sending these messages to the   websockets. But, it is desirable
+that, if multiple messages are sent to  a particular client, they arrive
+in this order. As multiple threads are performing this task, this is not
+easy to guarantee. Therefore, we create an  output queue and a mutex for
+each client. An output thread will   walk  along the websockets, looking
+for one that has pending messages.  It   then  grabs the lock associated
+with the client and sends all waiting output messages.
+
+The price is that we might peek   a significant number of message queues
+before we find one that  contains  messages.   If  this  proves  to be a
+significant problem, we  could  maintain  a   queue  of  queues  holding
+messages.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+%!  hub_send(+ClientId, +Message) is semidet.
+%
+%   Send message to the indicated ClientId.   Fails silently if ClientId
+%   does not exist.
+%
+%   @arg    Message is either a single message (as accepted by
+%           ws_send/2) or a list of such messages.
+
+hub_send(ClientId, Message) :-
+    websocket(HubName, _WS, ClientQueue, _Lock, ClientId),
+    hub(HubName, Hub),
+    (   is_list(Message)
+    ->  maplist(queue_output(ClientQueue), Message)
+    ;   queue_output(ClientQueue, Message)
+    ),
+    create_output_thread(Hub, ClientQueue).
+
+create_output_thread(Hub, Queue) :-
+    hub_thread(broadcast_from_queue(Queue, [timeout(0)]),
+               Hub, hub_out_q_).
+
+%!  hub_broadcast(+Hub, +Message) is det.
+%!  hub_broadcast(+Hub, +Message, :Condition) is det.
+%
+%   Send Message to all websockets  associated   with  Hub for which
+%   call(Condition,  Id)  succeeds.  Note  that    this  process  is
+%   _asynchronous_: this predicate returns immediately after putting
+%   all requests in a  broadcast  queue.   If  a  message  cannot be
+%   delivered due to a network error,   the  hub is informed through
+%   io_error/3.
+
+hub_broadcast(HubName, Message) :-
+    hub_broadcast(HubName, Message, all).
+
+all(_).
+
+hub_broadcast(HubName, Message, Condition) :-
+    must_be(atom, HubName),
+    hub(HubName, Hub),
+    State = count(0),
+    forall(( websocket(HubName, _WS, ClientQueue, _Lock, Id),
+             call(Condition, Id)
+           ),
+           ( queue_output(ClientQueue, Message),
+             inc_count(State)
+           )),
+    State = count(Count),
+    create_broadcast_threads(Hub, Count).
+
+queue_output(Queue, Message) :-
+    thread_send_message(Queue, Message).
+
+inc_count(State) :-
+    arg(1, State, C0),
+    C1 is C0+1,
+    nb_setarg(1, State, C1).
+
+create_broadcast_threads(Hub, Count) :-
+    Threads is ceiling(sqrt(Count)),
+    forall(between(1, Threads, _),
+           create_broadcast_thread(Hub)).
+
+create_broadcast_thread(Hub) :-
+    current_prolog_flag(threads, true),
+    !,
+    hub_thread(broadcast_from_queues(Hub, [timeout(0)]),
+                    Hub, hub_out_all_).
+create_broadcast_thread(_).                   % we are shutting down
+
+%!  broadcast_from_queues(+Hub, +Options) is det.
+%
+%   Broadcast from over all known queues.
+
+broadcast_from_queues(Hub, Options) :-
+    forall(websocket(Hub.name, _WebSocket, Queue, _Lock, _Id),
+           broadcast_from_queue(Queue, Options)).
+
+
+%!  broadcast_from_queue(+Queue, +Options) is det.
+%
+%   Send all messages pending for Queue.   Note  that this predicate
+%   locks the mutex associated  with  the   Queue,  such  that other
+%   workers cannot start sending messages to this client. Concurrent
+%   sending  would  lead  to  out-of-order    arrival  of  broadcast
+%   messages.  If  the  mutex  is  already  held,  someone  else  is
+%   processing this message queue, so we don't have to worry.
+
+broadcast_from_queue(Queue, _Options) :-
+    message_queue_property(Queue, size(0)),
+    !.
+broadcast_from_queue(Queue, Options) :-
+    websocket(_Hub, _WebSocket, Queue, Lock, _Id),
+    !,
+    (   setup_call_cleanup(
+            mutex_trylock(Lock),
+            broadcast_from_queue_sync(Queue, Options),
+            mutex_unlock(Lock))
+    ->  true
+    ;   true
+    ).
+broadcast_from_queue(_, _).
+
+% Note that we re-fetch websocket/5, such that we terminate if something
+% closed the websocket.
+
+broadcast_from_queue_sync(Queue, Options) :-
+    repeat,
+      (   websocket(_Hub, WebSocket, Queue, _Lock, _Id),
+          thread_get_message(Queue, Message, Options)
+      ->  debug(hub(broadcast),
+                'To: ~p messages: ~p', [WebSocket, Message]),
+          catch(ws_send(WebSocket, Message), E,
+                io_write_error(WebSocket, Message, E)),
+          fail
+      ;   !
+      ).
+
+%!  hub_thread(:Goal, +Hub, +Task) is det.
+%
+%   Create a (temporary) thread for the hub to perform Task. We
+%   created named threads if debugging hub(thread) is enabled.
+
+hub_thread(Goal, _, Task) :-
+    debugging(hub(thread)),
+    !,
+    gensym(Task, Alias),
+    thread_create(Goal, _, [detached(true), alias(Alias)]).
+hub_thread(Goal, _, _) :-
+    thread_create(Goal, _, [detached(true)]).