/usr/share/doc/libaws-doc/examples/ws_candy/notification_center.adb is in libaws-doc 3.3.2-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | ------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2013, AdaCore --
-- --
-- This is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This software is distributed in the hope that it will --
-- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty --
-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public License --
-- distributed with this software; see file COPYING3. If not, go --
-- to http://www.gnu.org/licenses for a complete copy of the license. --
------------------------------------------------------------------------------
with Ada.Text_IO;
with AWS.Net.WebSocket.Registry;
package body Notification_Center is
Padding : String (1 .. 64_000) := (others => 'a');
-- Padding to encourage threading issues
protected body Protected_Center is
---------------
-- Subscribe --
---------------
procedure Subscribe (Socket : WebSock_CB.Object; Key : String) is
S : constant Subscription :=
(Socket => Socket, Key => To_Unbounded_String (Key));
begin
Subscriptions.Append (S);
end Subscribe;
-----------------
-- Unsubscribe --
-----------------
procedure Unsubscribe (Socket : WebSock_CB.Object; Key : String) is
use type WebSock_CB.Object;
New_Subscriptions : Subscription_Vectors.Vector;
begin
for S of Subscriptions loop
if S.Socket /= Socket
or else S.Key /= To_Unbounded_String (Key)
then
New_Subscriptions.Append (S);
end if;
end loop;
Subscriptions := New_Subscriptions;
end Unsubscribe;
procedure Unsubscribe (Socket : WebSock_CB.Object) is
use type WebSock_CB.Object;
New_Subscriptions : Subscription_Vectors.Vector;
begin
for S of Subscriptions loop
if S.Socket /= Socket then
New_Subscriptions.Append (S);
end if;
end loop;
Subscriptions := New_Subscriptions;
end Unsubscribe;
------------
-- Notify --
------------
procedure Notify (Key : String) is
Message : constant String := Key & "," & Padding;
begin
for S of Subscriptions loop
if To_String (S.Key) = Key then
AWS.Net.WebSocket.Registry.Send (S.Socket, Message);
end if;
end loop;
end Notify;
-------------------------------
-- Get_Subscriptions_For_Key --
-------------------------------
function Get_Subscriptions_For_Key
(Key : String) return Subscription_Vectors.Vector
is
New_Subscriptions : Subscription_Vectors.Vector;
begin
for S of Subscriptions loop
if To_String (S.Key) = Key then
New_Subscriptions.Append (S);
end if;
end loop;
return New_Subscriptions;
end Get_Subscriptions_For_Key;
end Protected_Center;
------------------------
-- Unprotected_Notify --
------------------------
-- Occurs outside of the protected block, so we could be executing Send
-- at the same time as other tasks.
procedure Unprotected_Notify (Key : String) is
Message : constant String := Key & "," & Padding;
Subscriptions : Subscription_Vectors.Vector :=
Protected_Center.Get_Subscriptions_For_Key (Key);
begin
for S of Subscriptions loop
AWS.Net.WebSocket.Registry.Send (S.Socket, Message);
end loop;
end Unprotected_Notify;
end Notification_Center;
|