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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2002-2003 --
-- ACT-Europe --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or (at --
-- your option) any later version. --
-- --
-- This library 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 --
-- along with this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
------------------------------------------------------------------------------
with Ada.Strings.Unbounded;
with AWS.Containers.Key_Value;
with AWS.Net;
with AWS.Utils;
package AWS.Jabber is
type Server is limited private;
-- This is the Jabber server connection. This object is initialized by
-- Connect below and is used with all services.
Default_Port : constant := 5222;
-- Standard Jabber Server default port is 5222. The SSL based connection
-- port is 5223 but this is not supported by this API.
Server_Error : exception;
-- Raised by any routine below when an server or protocol error occurs. A
-- message is attached to the exception, this correspond to the <error>
-- XML protocol tag if present.
procedure Connect
(Server : in out Jabber.Server;
Host : in String;
User : in String;
Password : in String;
Port : in Positive := Default_Port);
-- Connect to a Jabber server Host:Port using User/Password account. It
-- returns the Server object which can be used with services below.
procedure Close (Server : in out Jabber.Server);
-- Close the connection with the Jabber server.
procedure Send_Message
(Server : in Jabber.Server;
JID : in String;
Subject : in String;
Content : in String);
-- Send a message to user JID (Jabber ID) via the specified Server. The
-- message is composed of Subject and a body (Content).
type Presence_Status
is (Offline, Available, Chat, Away, Extended_Away, Do_Not_Disturb);
procedure Check_Presence
(Server : in Jabber.Server;
JID : in String;
Status : out Presence_Status);
-- Returns the presence status for JID.
private
-- Jabber Client and Server open a stream and both communicate with each
-- others via this channel. All messages exchanged are XML encoded. Both
-- streams (client -> server and server -> client) have a common
-- structure:
--
-- <?xml version=""1.0"" encoding=""UTF-8"" ?>"
-- <stream:stream>
-- <message> ... </message>
-- <presence> ... </presence>
-- </stream:stream>
--
-- As both streams are sent asynchronously, we use a Task to read the
-- incoming stream. This task is responsible to accept incoming XML
-- message, to parse them, create a Message object and add it into the
-- Mailbox. The client services provided by this package just send the
-- right XML stream and retrieve server's answer from the Mailbox.
use Ada.Strings.Unbounded;
subtype Message is AWS.Containers.Key_Value.Set;
-- A message, this is just a set of key/value pair. Each key represent a
-- tag and the associated value is the tag's value. Tag's attributes are
-- encoded with a key which is the tag element name catenated with a '.'
-- and the attribute name. For example with :
--
-- <presence from="toto"/>
--
-- We have : Key Value
-- ------------- ------
-- presence ""
-- presence.from "toto"
type Message_Access is access all Message;
package Message_Mailbox is new Utils.Mailbox_G (Message_Access);
---------------------
-- Incoming_Stream --
---------------------
-- Read incoming XML messages, parse them and add them to the
-- Mailbox. This task will terminate with the connection socket will be
-- closed by the client.
task type Incoming_Stream (Server : access Jabber.Server) is
pragma Storage_Size (16#1E8_000#);
-- This value must be below 2 Mb as this is the GNU/Linux thread
-- stack size limit.
end Incoming_Stream;
type Incoming_Stream_Access is access Incoming_Stream;
------------
-- Server --
------------
type Server_Access is access all Server;
type Server is record
Self : Server_Access := Server'Unchecked_Access;
Host : Unbounded_String;
Port : Positive;
Sock : Net.Socket_Access;
User : Unbounded_String;
Started : Boolean := False;
SID : Unbounded_String;
MB : Message_Mailbox.Mailbox (25); -- 25 messages maximum
Stream : Incoming_Stream_Access;
end record;
end AWS.Jabber;
|
