/usr/share/ada/adainclude/alog/alog-facilities-xmpp.adb is in libalog0.4.1-full-dev 0.4.1-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 122 123 | --
-- Copyright (c) 2008-2009,
-- Reto Buerki, Adrian-Ken Rueegsegger
--
-- This file is part of Alog.
--
-- Alog is free software; you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as published
-- by the Free Software Foundation; either version 2.1 of the License, or
-- (at your option) any later version.
--
-- Alog 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 Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public License
-- along with Alog; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
-- MA 02110-1301 USA
with Ada.Exceptions;
with AWS.Jabber.Client;
package body Alog.Facilities.XMPP is
-------------------------------------------------------------------------
procedure Set_Recipient
(Facility : in out Instance;
JID : String)
is
begin
Facility.Recipient := To_Unbounded_String (JID);
Facility.Is_Recipient := True;
end Set_Recipient;
-------------------------------------------------------------------------
procedure Set_Sender
(Facility : in out Instance;
JID : String;
Password : String)
is
begin
Facility.Sender := (JID => To_Unbounded_String (JID),
Password => To_Unbounded_String (Password));
Facility.Is_Sender := True;
end Set_Sender;
-------------------------------------------------------------------------
procedure Set_Server
(Facility : in out Instance;
Name : String)
is
begin
Facility.Server := To_Unbounded_String (Name);
Facility.Is_Server := True;
end Set_Server;
-------------------------------------------------------------------------
procedure Write
(Facility : Instance;
Level : Log_Level := Info;
Msg : String)
is
pragma Unreferenced (Level);
use AWS.Jabber;
begin
-- Raise exception if no sender has been set.
if not Facility.Is_Sender then
raise No_Sender;
end if;
-- Raise exception if no recipient has been set.
if not Facility.Is_Recipient then
raise No_Recipient;
end if;
-- Raise exception if no server has been set.
if not Facility.Is_Server then
raise No_Server;
end if;
declare
Client : AWS.Jabber.Client.Account;
Recipient : constant AWS.Jabber.Client.Jabber_ID :=
AWS.Jabber.Client.To_Jabber_ID
(Username => "ken",
Server => "swissjabber.org");
begin
AWS.Jabber.Client.Set_Host
(Account => Client,
Host => To_String (Facility.Server));
AWS.Jabber.Client.Set_Login_Information
(Account => Client,
User => To_String (Facility.Sender.JID),
Password => To_String (Facility.Sender.Password));
AWS.Jabber.Client.Connect (Account => Client);
AWS.Jabber.Client.Send
(Account => Client,
JID => Recipient,
Content => Msg,
Subject => To_String (Facility.Subject));
AWS.Jabber.Client.Close (Account => Client);
exception
when Error : AWS.Jabber.Client.Server_Error =>
-- Make sure that connecion to server is closed.
AWS.Jabber.Client.Close (Account => Client);
-- Raise Delivery_Failure exception, something went wrong.
raise Delivery_Failed
with Ada.Exceptions.Exception_Message (Error);
end;
end Write;
end Alog.Facilities.XMPP;
|