line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Asterisk::AMI - Perl module for interacting with the Asterisk Manager Interface |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 VERSION |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
0.2.5 |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 SYNOPSIS |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
use Asterisk::AMI; |
14
|
|
|
|
|
|
|
my $astman = Asterisk::AMI->new(PeerAddr => '127.0.0.1', |
15
|
|
|
|
|
|
|
PeerPort => '5038', |
16
|
|
|
|
|
|
|
Username => 'admin', |
17
|
|
|
|
|
|
|
Secret => 'supersecret' |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
die "Unable to connect to asterisk" unless ($astman); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $action = $astman->({ Action => 'Command', |
23
|
|
|
|
|
|
|
Command => 'sip show peers' |
24
|
|
|
|
|
|
|
}); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 DESCRIPTION |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
This module provides an interface to the Asterisk Manager Interface. It's goal is to provide a flexible, powerful, and |
29
|
|
|
|
|
|
|
reliable way to interact with Asterisk upon which other applications may be built. It utilizes AnyEvent and therefore |
30
|
|
|
|
|
|
|
can integrate very easily into event-based applications, but it still provides blocking functions for us with standard |
31
|
|
|
|
|
|
|
scripting. |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head2 SSL SUPPORT INFORMATION |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
For SSL support you will also need the module that AnyEvent::Handle uses for SSL support, which is not a required |
36
|
|
|
|
|
|
|
dependency. Currently that module is 'Net::SSLeay' (AnyEvent:Handle version 5.251) but it may change in the future. |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head3 CentOS/Redhat |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
If the version of Net:SSLeay included in CentOS/Redhat does not work try installing an updated version from CPAN. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head2 Constructor |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=head3 new([ARGS]) |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Creates a new AMI object which takes the arguments as key-value pairs. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
Key-Value Pairs accepted: |
49
|
|
|
|
|
|
|
PeerAddr Remote host address |
50
|
|
|
|
|
|
|
PeerPort Remote host port |
51
|
|
|
|
|
|
|
Events Enable/Disable Events 'on'|'off' |
52
|
|
|
|
|
|
|
Username Username to access the AMI |
53
|
|
|
|
|
|
|
Secret Secret used to connect to AMI |
54
|
|
|
|
|
|
|
AuthType Authentication type to use for login 'plaintext'|'MD5' |
55
|
|
|
|
|
|
|
UseSSL Enables/Disables SSL for the connection 0|1 |
56
|
|
|
|
|
|
|
BufferSize Maximum size of buffer, in number of actions |
57
|
|
|
|
|
|
|
Timeout Default timeout of all actions in seconds |
58
|
|
|
|
|
|
|
Handlers Hash reference of Handlers for events { 'EVENT' => \&somesub }; |
59
|
|
|
|
|
|
|
Keepalive Interval (in seconds) to periodically send 'Ping' actions to asterisk |
60
|
|
|
|
|
|
|
TCP_Keepalive Enables/Disables SO_KEEPALIVE option on the socket 0|1 |
61
|
|
|
|
|
|
|
Blocking Enable/Disable blocking connects 0|1 |
62
|
|
|
|
|
|
|
on_connect A subroutine to run after we connect |
63
|
|
|
|
|
|
|
on_connect_err A subroutine to call if we have an error while connecting |
64
|
|
|
|
|
|
|
on_error A subroutine to call when an error occurs on the socket |
65
|
|
|
|
|
|
|
on_disconnect A subroutine to call when the remote end disconnects |
66
|
|
|
|
|
|
|
on_timeout A subroutine to call if our Keepalive times out |
67
|
|
|
|
|
|
|
OriginateHack Changes settings to allow Async Originates to work 0|1 |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
'PeerAddr' defaults to 127.0.0.1. |
70
|
|
|
|
|
|
|
'PeerPort' defaults to 5038. |
71
|
|
|
|
|
|
|
'Events' default is 'off'. May be anything that the AMI will accept as a part of the 'Events' parameter for the |
72
|
|
|
|
|
|
|
login action. |
73
|
|
|
|
|
|
|
'Username' has no default and must be supplied. |
74
|
|
|
|
|
|
|
'Secret' has no default and must be supplied. |
75
|
|
|
|
|
|
|
'AuthType' sets the authentication type to use for login. Default is 'plaintext'. Use 'MD5' for MD5 challenge |
76
|
|
|
|
|
|
|
authentication. |
77
|
|
|
|
|
|
|
'UseSSL' defaults to 0 (no ssl). When SSL is enabled the default PeerPort changes to 5039. |
78
|
|
|
|
|
|
|
'BufferSize' has a default of 30000. It also acts as our max actionid before we reset the counter. |
79
|
|
|
|
|
|
|
'Timeout' has a default of 0, which means no timeout on blocking. |
80
|
|
|
|
|
|
|
'Handlers' accepts a hash reference setting a callback handler for the specified event. EVENT should match |
81
|
|
|
|
|
|
|
the contents of the {'Event'} key of the event object will be. The handler should be a subroutine reference that |
82
|
|
|
|
|
|
|
will be passed the a copy of the AMI object and the event object. The 'default' keyword can be used to set |
83
|
|
|
|
|
|
|
a default event handler. If handlers are installed we do not buffer events and instead immediately dispatch them. |
84
|
|
|
|
|
|
|
If no handler is specified for an event type and a 'default' was not set the event is discarded. |
85
|
|
|
|
|
|
|
'Keepalive' only works when running with an event loop. Used with on_timeout, this can be used to detect if |
86
|
|
|
|
|
|
|
asterisk has become un-responsive. |
87
|
|
|
|
|
|
|
'TCP_Keepalive' default is disabled. Activates the tcp keep-alive at the socket layer. This does not require |
88
|
|
|
|
|
|
|
an event-loop and is lightweight. Useful for applications that use long-lived connections to Asterisk but |
89
|
|
|
|
|
|
|
do not run an event loop. |
90
|
|
|
|
|
|
|
'Blocking' has a default of 1 (block on connecting). A value of 0 will cause us to queue our connection |
91
|
|
|
|
|
|
|
and login for when an event loop is started. If set to non blocking we will always return a valid object. |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
'on_connect' is a subroutine to call when we have successfully connected and logged into the asterisk manager. |
94
|
|
|
|
|
|
|
it will be passed our AMI object. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
'on_connect_err', 'on_error', 'on_disconnect' |
97
|
|
|
|
|
|
|
These three specify subroutines to call when errors occur. 'on_connect_err' is specifically for errors that |
98
|
|
|
|
|
|
|
occur while connecting, as well as failed logins. If 'on_connect_err' or 'on_disconnect' it is not set, |
99
|
|
|
|
|
|
|
but 'on_error' is, 'on_error' will be called. 'on_disconnect' is not reliable, as disconnects seem to get lumped |
100
|
|
|
|
|
|
|
under 'on_error' instead. When the subroutine specified for any of theses is called the first argument is a copy |
101
|
|
|
|
|
|
|
of our AMI object, and the second is a string containing a message/reason. All three of these are 'fatal', when |
102
|
|
|
|
|
|
|
they occur we destroy our buffers and our socket connections. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
'on_timeout' is called when a keep-alive has timed out, not when a normal action has. It is non-'fatal'. |
105
|
|
|
|
|
|
|
The subroutine will be called with a copy of our AMI object and a message. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
'OriginateHack' defaults to 0 (off). This essentially enables 'call' events and says 'discard all events |
108
|
|
|
|
|
|
|
unless the user has explicitly enabled events' (prevents a memory leak). It does its best not to mess up |
109
|
|
|
|
|
|
|
anything you have already set. Without this, if you use 'Async' with an 'Originate' the action will timeout |
110
|
|
|
|
|
|
|
or never callback. You don't need this if you are already doing work with events, simply add 'call' events |
111
|
|
|
|
|
|
|
to your eventmask. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head2 Disabling Warnings |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
If you have warnings enabled this module will emit a number of them on connection errors, deprecated features, etc. |
116
|
|
|
|
|
|
|
To disable this but still have all other warnings in perl enabled you can do the following: |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
use Asterisk::AMI; |
119
|
|
|
|
|
|
|
use warnings; |
120
|
|
|
|
|
|
|
no warnings qw(Asterisk::AMI); |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
That will enable warnings but disable any warnings from this module. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head2 Warning - Mixing Event-loops and blocking actions |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
For an intro to Event-Based programming please check out the documentation in AnyEvent::Intro. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
If you are running an event loop and use blocking methods (e.g. get_response, check_response, action, |
129
|
|
|
|
|
|
|
simple_action, connected, or a blocking connect) the outcome is unspecified. It may work, it may lock everything up, the action may |
130
|
|
|
|
|
|
|
work but break something else. I have tested it and behavior seems unpredictable at best and is very |
131
|
|
|
|
|
|
|
circumstantial. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
If you are running an event-loop use non-blocking callbacks! It is why they are there! |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
However if you do play with blocking methods inside of your loops let me know how it goes. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head2 Actions |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head3 ActionIDs |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
This module handles ActionIDs internally and if you supply one in an action it will simply be ignored and overwritten. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=head3 Construction |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
No matter which method you use to send an action (send_action(), simple_action(), or action()), they all accept |
146
|
|
|
|
|
|
|
actions in the same format, which is a hash reference. The only exceptions to this rules are when specifying a |
147
|
|
|
|
|
|
|
callback and a callback timeout, which only work with send_action. |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
To build and send an action you can do the following: |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
%action = ( Action => 'Command', |
152
|
|
|
|
|
|
|
Command => 'sip show peers' |
153
|
|
|
|
|
|
|
); |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
$astman->send_action(\%action); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Alternatively you can also do the following to the same effect: |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
$astman->send_action({ Action => 'Command', |
160
|
|
|
|
|
|
|
Command => 'sip show peers' |
161
|
|
|
|
|
|
|
}); |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
Additionally the value of the hash may be an array reference. When an array reference is used, every value in the |
164
|
|
|
|
|
|
|
array is append as a different line to the action. For example: |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
{ Variable => [ 'var1=1', 'var2=2' ] } |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
Will become: |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Variable: var1=1 |
171
|
|
|
|
|
|
|
Variable: var2=2 |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
When the action is sent. |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=head3 Sending and Retrieving |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
More detailed information on these individual methods is available below |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
The send_action() method can be used to send an action to the AMI. It will return a positive integer, which is the |
180
|
|
|
|
|
|
|
ActionID of the action, on success and will return undef in the event it is unable to send the action. |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
After sending an action you can then get its response in one of two methods. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
The method check_response() accepts an actionid and will return 1 if the action was considered successful, 0 if it |
185
|
|
|
|
|
|
|
failed and undef if an error occurred or on timeout. |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
The method get_response() accepts an actionid and will return a Response object (really just a fancy hash) with the |
188
|
|
|
|
|
|
|
contents of the Action Response as well as any associated Events it generated. It will return undef if an error |
189
|
|
|
|
|
|
|
occurred or on timeout. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
All responses and events are buffered, therefor you can issue several send_action()s and then retrieve/check their |
192
|
|
|
|
|
|
|
responses out of order without losing any information. In-fact, if you are issuing many actions in series you can get |
193
|
|
|
|
|
|
|
much better performance sending them all first and then retrieving them later, rather than waiting for responses |
194
|
|
|
|
|
|
|
immediately after issuing an action. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
Alternatively you can also use simple_action() and action(). simple_action() combines send_action() and |
197
|
|
|
|
|
|
|
check_response(), and therefore returns 1 on success and 0 on failure, and undef on error or timeout. action() |
198
|
|
|
|
|
|
|
combines send_action() and get_response(), and therefore returns a Response object or undef. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=head4 Examples |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
Send and retrieve and action: |
203
|
|
|
|
|
|
|
my $actionid = $astman->send_action({ Action => 'Command', |
204
|
|
|
|
|
|
|
Command => 'sip show peers' |
205
|
|
|
|
|
|
|
}); |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
my $response = $astman->get_response($actionid) |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
This is equivalent to the above: |
210
|
|
|
|
|
|
|
my $response = $astman->action({ Action => 'Command', |
211
|
|
|
|
|
|
|
Command => 'sip show peers' |
212
|
|
|
|
|
|
|
}); |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
The following: |
215
|
|
|
|
|
|
|
my $actionid1 = $astman->send_action({ Action => 'Command', |
216
|
|
|
|
|
|
|
Command => 'sip show peers' |
217
|
|
|
|
|
|
|
}); |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
my $actionid2 = $astman->send_action({ Action => 'Command', |
220
|
|
|
|
|
|
|
Command => 'sip show peers' |
221
|
|
|
|
|
|
|
}); |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
my $actionid3 = $astman->send_action({ Action => 'Command', |
224
|
|
|
|
|
|
|
Command => 'sip show peers' |
225
|
|
|
|
|
|
|
}); |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
my $response3 = $astman->get_response($actionid3); |
228
|
|
|
|
|
|
|
my $response1 = $astman->get_response($actionid1); |
229
|
|
|
|
|
|
|
my $response2 = $astman->get_response($actionid2); |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
Can be much faster than: |
232
|
|
|
|
|
|
|
my $response1 = $astman->action({ Action => 'Command', |
233
|
|
|
|
|
|
|
Command => 'sip show peers' |
234
|
|
|
|
|
|
|
}); |
235
|
|
|
|
|
|
|
my $response2 = $astman->action({ Action => 'Command', |
236
|
|
|
|
|
|
|
Command => 'sip show peers' |
237
|
|
|
|
|
|
|
}); |
238
|
|
|
|
|
|
|
my $response3 = $astman->action({ Action => 'Command', |
239
|
|
|
|
|
|
|
Command => 'sip show peers' |
240
|
|
|
|
|
|
|
}); |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=head3 Originate Examples |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
These don't include non-blocking examples, please read the section on 'Callbacks' below for information |
245
|
|
|
|
|
|
|
on using non-blocking callbacks and events. |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
NOTE: Please read about the 'OriginateHack' option for the constructor above if you plan on using the 'Async' |
248
|
|
|
|
|
|
|
option in your Originate command, as it may be required to properly retrieve the response. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
In these examples we are dialing extension '12345' at a sip peer named 'peer' and when the call connects |
251
|
|
|
|
|
|
|
we drop the channel into 'some_context' at priority 1 for extension 100. |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
Example 1 - A simple non-ASYNC Originate |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
my $response = $astman->action({Action => 'Originate', |
256
|
|
|
|
|
|
|
Channel => 'SIP/peer/12345', |
257
|
|
|
|
|
|
|
Context => 'some_context', |
258
|
|
|
|
|
|
|
Exten => 100, |
259
|
|
|
|
|
|
|
Priority => 1}); |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
And the contents of respone will look similiar to the following: |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
{ |
264
|
|
|
|
|
|
|
'Message' => 'Originate successfully queued', |
265
|
|
|
|
|
|
|
'ActionID' => '3', |
266
|
|
|
|
|
|
|
'GOOD' => 1, |
267
|
|
|
|
|
|
|
'COMPLETED' => 1, |
268
|
|
|
|
|
|
|
'Response' => 'Success' |
269
|
|
|
|
|
|
|
}; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Example 2 - Originate with multiple variables |
272
|
|
|
|
|
|
|
This will set the channel variables 'var1' and 'var2' to 1 and 2, respectfully. |
273
|
|
|
|
|
|
|
The value for the 'Variable' key should be an array reference or an anonymous array in order |
274
|
|
|
|
|
|
|
to set multiple variables. |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
my $response = $astman->action({Action => 'Originate', |
277
|
|
|
|
|
|
|
Channel => 'SIP/peer/12345', |
278
|
|
|
|
|
|
|
Context => 'some_context', |
279
|
|
|
|
|
|
|
Exten => 100, |
280
|
|
|
|
|
|
|
Priority => 1, |
281
|
|
|
|
|
|
|
Variable = [ 'var1=1', 'var2=2' ]}); |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
Example 3 - An Async Originate |
284
|
|
|
|
|
|
|
If your Async Originate never returns please read about the 'OriginateHack' option for the constructor. |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
my $response = $astman->action({Action => 'Originate', |
287
|
|
|
|
|
|
|
Channel => 'SIP/peer/12345', |
288
|
|
|
|
|
|
|
Context => 'some_context', |
289
|
|
|
|
|
|
|
Exten => 100, |
290
|
|
|
|
|
|
|
Priority => 1, |
291
|
|
|
|
|
|
|
Async => 1}); |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
And the contents of response will look similiar to the following: |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
{ |
296
|
|
|
|
|
|
|
'Message' => 'Originate successfully queued', |
297
|
|
|
|
|
|
|
'EVENTS' => [ |
298
|
|
|
|
|
|
|
{ |
299
|
|
|
|
|
|
|
'Exten' => '100', |
300
|
|
|
|
|
|
|
'CallerID' => '', |
301
|
|
|
|
|
|
|
'Event' => 'OriginateResponse', |
302
|
|
|
|
|
|
|
'Privilege' => 'call,all', |
303
|
|
|
|
|
|
|
'Channel' => 'SIP/peer-009c5510', |
304
|
|
|
|
|
|
|
'Context' => 'some_context', |
305
|
|
|
|
|
|
|
'Response' => 'Success', |
306
|
|
|
|
|
|
|
'Reason' => '4', |
307
|
|
|
|
|
|
|
'CallerIDName' => '', |
308
|
|
|
|
|
|
|
'Uniqueid' => '1276543236.82', |
309
|
|
|
|
|
|
|
'ActionID' => '3', |
310
|
|
|
|
|
|
|
'CallerIDNum' => '' |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
], |
313
|
|
|
|
|
|
|
'ActionID' => '3', |
314
|
|
|
|
|
|
|
'GOOD' => 1, |
315
|
|
|
|
|
|
|
'COMPLETED' => 1, |
316
|
|
|
|
|
|
|
'Response' => 'Success' |
317
|
|
|
|
|
|
|
}; |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
More Info: |
320
|
|
|
|
|
|
|
Check out the voip-info.org page for more information on the Originate action. |
321
|
|
|
|
|
|
|
http://www.voip-info.org/wiki/view/Asterisk+Manager+API+Action+Originate |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=head3 Callbacks |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
You may also specify a subroutine to callback when using send_action as well as a timeout. |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
An example of this would be: |
328
|
|
|
|
|
|
|
$astman->send_action({ Action => 'Ping' }, \&somemethod, 7, $somevar); |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
In this example once the action 'Ping' finishes we will call somemethod() and pass it the a copy of our AMI object, |
331
|
|
|
|
|
|
|
the Response Object for the action, and an optional variable $somevar. If a timeout is not specified |
332
|
|
|
|
|
|
|
it will use the default set. A value of 0 means no timeout. When the timeout is reached somemethod() will be called |
333
|
|
|
|
|
|
|
and passed a reference to our $astman and the uncompleted Response Object, therefore somemethod() should check the |
334
|
|
|
|
|
|
|
state of the object. Checking the key {'GOOD'} is usually a good indication if the response is useable. |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
Anonymous subroutines are also acceptable as demostrated in the examples below: |
337
|
|
|
|
|
|
|
my $callback = sub { return }; |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
$astman->send_action({ Action => 'Ping' }, $callback, 7); |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
Or |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
$astman->send_action({ Action => 'Ping' }, sub { return }, 7); |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=head3 Callback Caveats |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
Callbacks only work if we are processing packets, therefore you must be running an event loop. Alternatively, we run |
350
|
|
|
|
|
|
|
mini-event loops for our blocking calls (e.g. action(), get_action()), so in theory if you set callbacks and then |
351
|
|
|
|
|
|
|
issue a blocking call those callbacks should also get triggered. However this is an unsupported scenario. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
Timeouts are done using timers and they are set as soon as you send the object. Therefore if you send an action with a |
354
|
|
|
|
|
|
|
timeout and then monkey around for a long time before getting back to your event loop (to process input) you can time |
355
|
|
|
|
|
|
|
out before ever even attempting to receive the response. |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
A very contrived example: |
358
|
|
|
|
|
|
|
$astman->send_action({ Action => 'Ping' }, \&somemethod, 3); |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
sleep(4); |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
#Start loop |
363
|
|
|
|
|
|
|
$astman->loop; |
364
|
|
|
|
|
|
|
#Oh no we never even tried to get the response yet it will still time out |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
=head2 Passing Variables in an Action Response |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
Sometimes, when working in an event framework, you want a way to associate/map the response to an action with another |
369
|
|
|
|
|
|
|
identifier used in your application. Normally you would have to maintain some sort of separate mapping involving the |
370
|
|
|
|
|
|
|
ActionID to accomplish this. This modules provides a generic way to pass any perl scalar (this includes references) |
371
|
|
|
|
|
|
|
with your action which is then passed to the callback with the response. |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=head3 Passing |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
The variable to be passed to the callback should be passed as the fourth argument to the send_action() method. |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
For example to pass a simple scalar value: |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
my $vartostore = "Stored"; |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
$astman->send_action({ Action => 'Ping' }, \&somemethod, undef, $vartostore }); |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
And to pass a reference: |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
my @vartostore = ("One", "Two"); |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
$astman->send_action({ Action => 'Ping' }, \&somemethod, undef, \@vartostore }); |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=head3 Retrieving |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
The passed variable will be available as the third argument to the callback. |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
To retrieve in a callback: |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
my ($astman, $resp, $store) = @_; |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
print $store . " was stored\n"; |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
=head2 Responses and Events |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
NOTE: Empty fields sent by Asterisk (e.g. 'Account: ' with no value in an event) are represented by the hash |
402
|
|
|
|
|
|
|
value of null string, not undef. This means you need to test for '' |
403
|
|
|
|
|
|
|
(e.g. if ($response->{'Account'} ne '')) ) for any values that might be possibly be empty. |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=head3 Responses |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
Responses are returned as response objects, which are hash references, structured as follows: |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
$response->{'Response'} Response to our packet (Success, Failed, Error, Pong, etc). |
410
|
|
|
|
|
|
|
{'ActionID'} ActionID of this Response. |
411
|
|
|
|
|
|
|
{'Message'} Message line of the response. |
412
|
|
|
|
|
|
|
{'EVENTS'} Array reference containing Event Objects associated with this actionid. |
413
|
|
|
|
|
|
|
{'PARSED'} Hash reference of lines we could parse into key->value pairs. |
414
|
|
|
|
|
|
|
{'CMD'} Contains command output from 'Action: Command's. It is an array reference. |
415
|
|
|
|
|
|
|
{'COMPLETED'} 1 if completed, 0 if not (timeout) |
416
|
|
|
|
|
|
|
{'GOOD'} 1 if good, 0 if bad. Good means no errors and COMPLETED. |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=head3 Events |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
Events are turned into event objects, these are similar to response objects, but their keys vary much more |
421
|
|
|
|
|
|
|
depending on the specific event. |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
Some common contents are: |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
$event->{'Event'} The type of Event |
426
|
|
|
|
|
|
|
{'ActionID'} Only available if this event was caused by an action |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
=head3 Event Handlers |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
Here is a very simple example of how to use event handlers. Please note that the key for the event handler |
431
|
|
|
|
|
|
|
is matched against the event type that asterisk sends. For example if asterisk sends 'Event: Hangup' you use a |
432
|
|
|
|
|
|
|
key of 'Hangup' to match it. This works for any event type that asterisk sends. |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
my $astman = Asterisk::AMI->new(PeerAddr => '127.0.0.1', |
435
|
|
|
|
|
|
|
PeerPort => '5038', |
436
|
|
|
|
|
|
|
Username => 'admin', |
437
|
|
|
|
|
|
|
Secret => 'supersecret', |
438
|
|
|
|
|
|
|
Events => 'on', |
439
|
|
|
|
|
|
|
Handlers => { default => \&do_event, |
440
|
|
|
|
|
|
|
Hangup => \&do_hangup }; |
441
|
|
|
|
|
|
|
); |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
die "Unable to connect to asterisk" unless ($astman); |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
sub do_event { |
446
|
|
|
|
|
|
|
my ($asterisk, $event) = @_; |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
print 'Yeah! Event Type: ' . $event->{'Event'} . "\r\n"; |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
sub do_hangup { |
452
|
|
|
|
|
|
|
my ($asterisk, $event) = @_; |
453
|
|
|
|
|
|
|
print 'Channel ' . $event->{'Channel'} . ' Hungup because ' . $event->{'Cause-txt'} . "\r\n"; |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
#Start some event loop |
457
|
|
|
|
|
|
|
someloop; |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
=head2 How to use in an event-based application |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
Getting this module to work with your event based application is really easy so long as you are running an |
462
|
|
|
|
|
|
|
event-loop that is supported by AnyEvent. Below is a simple example of how to use this module with your |
463
|
|
|
|
|
|
|
preferred event loop. We will use EV as our event loop in this example. I use subroutine references in this |
464
|
|
|
|
|
|
|
example, but you could use anonymous subroutines if you want to. |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
#Use your preferred loop before our module so that AnyEvent will auto-detect it |
467
|
|
|
|
|
|
|
use EV; |
468
|
|
|
|
|
|
|
use Asterisk::AMI: |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
#Create your connection |
471
|
|
|
|
|
|
|
my $astman = Asterisk::AMI->new(PeerAddr => '127.0.0.1', |
472
|
|
|
|
|
|
|
PeerPort => '5038', |
473
|
|
|
|
|
|
|
Username => 'admin', |
474
|
|
|
|
|
|
|
Secret => 'supersecret', |
475
|
|
|
|
|
|
|
Events => 'on', |
476
|
|
|
|
|
|
|
Handlers => { default => \&eventhandler } |
477
|
|
|
|
|
|
|
); |
478
|
|
|
|
|
|
|
#Alternatively you can set Blocking => 0, and set an on_error sub to catch connection errors |
479
|
|
|
|
|
|
|
die "Unable to connect to asterisk" unless ($astman); |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
#Define the subroutines for events |
482
|
|
|
|
|
|
|
sub eventhandler { my ($ami, $event) = @_; print 'Got Event: ',$event->{'Event'},"\r\n"; } |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
#Define a subroutine for your action callback |
485
|
|
|
|
|
|
|
sub actioncb { my ($ami, $response) = @_; print 'Got Action Reponse: ',$response->{'Response'},"\r\n"; } |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
#Send an action |
488
|
|
|
|
|
|
|
my $action = $astman->({ Action => 'Ping' }, \&actioncb); |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
#Do all of you other eventy stuff here, or before all this stuff, whichever .............. |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
#Start our loop |
493
|
|
|
|
|
|
|
EV::loop |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
That's it, the EV loop will allow us to process input from asterisk. Once the action completes it will |
498
|
|
|
|
|
|
|
call the callback, and any events will be dispatched to eventhandler(). As you can see it is fairly |
499
|
|
|
|
|
|
|
straight-forward. Most of the work will be in creating subroutines to be called for various events and |
500
|
|
|
|
|
|
|
actions that you plan to use. |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
=head2 Methods |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
send_action ( ACTION, [ [ CALLBACK ], [ TIMEOUT ], [ USERDATA ] ] ) |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
Sends the action to asterisk, where ACTION is a hash reference. If no errors occurred while sending it returns |
507
|
|
|
|
|
|
|
the ActionID for the action, which is a positive integer above 0. If it encounters an error it will return undef. |
508
|
|
|
|
|
|
|
CALLBACK is optional and should be a subroutine reference or any anonymous subroutine. TIMEOUT is optional and |
509
|
|
|
|
|
|
|
only has an affect if a CALLBACK is specified. USERDATA is optional and is a perl variable that will be passed to |
510
|
|
|
|
|
|
|
the CALLBACK in addition to the response. |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
The use of the CALLBACK and TIMEOUT keys in the ACTION has been deprecated. |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
check_response( [ ACTIONID ], [ TIMEOUT ] ) |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
Returns 1 if the action was considered successful, 0 if it failed, or undef on timeout or error. If no ACTIONID |
517
|
|
|
|
|
|
|
is specified the ACTIONID of the last action sent will be used. If no TIMEOUT is given it blocks, reading in |
518
|
|
|
|
|
|
|
packets until the action completes. This will remove a response from the buffer. |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
get_response ( [ ACTIONID ], [ TIMEOUT ] ) |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
Returns the response object for the action. Returns undef on error or timeout. |
523
|
|
|
|
|
|
|
If no ACTIONID is specified the ACTIONID of the last action sent will be used. If no TIMEOUT is given it |
524
|
|
|
|
|
|
|
blocks, reading in packets until the action completes. This will remove the response from the buffer. |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
action ( ACTION [, TIMEOUT ] ) |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
Sends the action and returns the response object for the action. Returns undef on error or timeout. |
529
|
|
|
|
|
|
|
If no ACTIONID is specified the ACTIONID of the last action sent will be used. |
530
|
|
|
|
|
|
|
If no TIMEOUT is given it blocks, reading in packets until the action completes. This will remove the |
531
|
|
|
|
|
|
|
response from the buffer. |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
simple_action ( ACTION [, TIMEOUT ] ) |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
Sends the action and returns 1 if the action was considered successful, 0 if it failed, or undef on error |
536
|
|
|
|
|
|
|
and timeout. If no ACTIONID is specified the ACTIONID of the last action sent will be used. If no TIMEOUT is |
537
|
|
|
|
|
|
|
given it blocks, reading in packets until the action completes. This will remove the response from the buffer. |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
disconnect () |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
Logoff and disconnects from the AMI. Returns 1 on success and 0 if any errors were encountered. |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
get_event ( [ TIMEOUT ] ) |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
This returns the first event object in the buffer, or if no events are in the buffer it reads in packets |
546
|
|
|
|
|
|
|
waiting for an event. It will return undef if an error occurs. |
547
|
|
|
|
|
|
|
If no TIMEOUT is given it blocks, reading in packets until an event arrives. |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
amiver () |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
Returns the version of the Asterisk Manager Interface we are connected to. Undef until the connection is made |
552
|
|
|
|
|
|
|
(important if you have Blocking => 0). |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
connected ( [ TIMEOUT ] ) |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
This checks the connection to the AMI to ensure it is still functional. It checks at the socket layer and |
558
|
|
|
|
|
|
|
also sends a 'PING' to the AMI to ensure it is still responding. If no TIMEOUT is given this will block |
559
|
|
|
|
|
|
|
waiting for a response. |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
Returns 1 if the connection is good, 0 if it is not. |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
error () |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
Returns 1 if there are currently errors on the socket, 0 if everything is ok. |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
destroy ( [ FATAL ] ) |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
Destroys the contents of all buffers and removes any current callbacks that are set. If FATAL is true |
570
|
|
|
|
|
|
|
it will also destroy our IO handle and its associated watcher. Mostly used internally. Useful if you want to |
571
|
|
|
|
|
|
|
ensure that our IO handle watcher gets removed. |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
loop () |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
Starts an eventloop via AnyEvent. |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
=head1 See Also |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
AnyEvent, Asterisk::AMI::Common, Asterisk::AMI::Common::Dev |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
=head1 AUTHOR |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
Ryan Bullock (rrb3942@gmail.com) |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=head1 BUG REPORTING AND FEEDBACK |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
Please report any bugs or errors to our github issue tracker at http://github.com/rrb3942/perl-Asterisk-AMI/issues or |
588
|
|
|
|
|
|
|
the cpan request tracker at https://rt.cpan.org/Public/Bug/Report.html?Queue=perl-Asterisk-AMI |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
=head1 LICENSE |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
Copyright (C) 2010 by Ryan Bullock (rrb3942@gmail.com) |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
This module is free software. You can redistribute it and/or modify it under the terms of the Artistic License 2.0. |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, but without any warranty; without even the implied |
597
|
|
|
|
|
|
|
warranty of merchantability or fitness for a particular purpose. |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=cut |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
package Asterisk::AMI; |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
#Register warnings |
604
|
1
|
|
|
1
|
|
25348
|
use warnings::register; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
200
|
|
605
|
|
|
|
|
|
|
|
606
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
36
|
|
607
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
71
|
|
|
1
|
|
|
|
|
35
|
|
608
|
|
|
|
|
|
|
|
609
|
1
|
|
|
1
|
|
1875
|
use AnyEvent; |
|
1
|
|
|
|
|
6301
|
|
|
1
|
|
|
|
|
37
|
|
610
|
1
|
|
|
1
|
|
1545
|
use AnyEvent::Handle; |
|
1
|
|
|
|
|
25392
|
|
|
1
|
|
|
|
|
37
|
|
611
|
1
|
|
|
1
|
|
1231
|
use AnyEvent::Socket; |
|
1
|
|
|
|
|
31782
|
|
|
1
|
|
|
|
|
156
|
|
612
|
1
|
|
|
1
|
|
13
|
use Digest::MD5; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
43
|
|
613
|
1
|
|
|
1
|
|
5
|
use Scalar::Util qw/weaken/; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
105
|
|
614
|
1
|
|
|
1
|
|
6
|
use Carp qw/carp/; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
44
|
|
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
#Duh |
617
|
1
|
|
|
1
|
|
977
|
use version; our $VERSION = qv(0.2.5); |
|
1
|
|
|
|
|
3049
|
|
|
1
|
|
|
|
|
8
|
|
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
#Used for storing events while reading command responses Events are stored as hashes in the array Example |
620
|
|
|
|
|
|
|
#$self->{EVETNBUFFER}->{'Event'} = Something |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
#Buffer for holding action responses and data |
623
|
|
|
|
|
|
|
# Structure: $self->{RESPONSEBUFFER}->{'ActionID'}->{'Response'} = (Success|Failure|Follows|Goodbye|Pong|Etc..) |
624
|
|
|
|
|
|
|
# //Reponse Status |
625
|
|
|
|
|
|
|
# {'Message'} = Message //Message in the response {'EVENTS'} = [%hash1, %hash2, ..] //Arry |
626
|
|
|
|
|
|
|
# of Hashes of parsed events and data for this actionID {'PARSED'} = { Hashkey => value, |
627
|
|
|
|
|
|
|
# ...} {'COMPLETED'} = 0 or 1 //If the command is completed {'GOOD'} = 0 or 1 //if this |
628
|
|
|
|
|
|
|
# responses is good, no error, can only be 1 if also COMPLETED |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
#Create a new object and return it; If required options are missing, returns undef |
631
|
|
|
|
|
|
|
sub new { |
632
|
0
|
|
|
0
|
1
|
|
my ($class, %values) = @_; |
633
|
|
|
|
|
|
|
|
634
|
0
|
|
|
|
|
|
my $self = bless {}, $class; |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
#Configure our new object and connect, else return undef |
637
|
0
|
0
|
0
|
|
|
|
if ($self->_configure(%values) && $self->_connect()) { |
638
|
0
|
|
|
|
|
|
return $self; |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
|
641
|
0
|
|
|
|
|
|
return; |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
#Used by anyevent to load our read type |
645
|
|
|
|
|
|
|
sub anyevent_read_type { |
646
|
|
|
|
|
|
|
|
647
|
0
|
|
|
0
|
0
|
|
my ($hdl, $cb) = @_; |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
return sub { |
650
|
0
|
0
|
|
0
|
|
|
if ($hdl->{rbuf} =~ s/^(.+)(?:\015\012\015\012)//sox) { |
651
|
0
|
|
|
|
|
|
$cb->($hdl, $1); |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
|
654
|
0
|
|
|
|
|
|
return 0; |
655
|
|
|
|
|
|
|
} |
656
|
0
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
#Sets variables for this object Also checks for minimum settings Returns 1 if everything was set, 0 if options were |
659
|
|
|
|
|
|
|
#missing |
660
|
|
|
|
|
|
|
sub _configure { |
661
|
0
|
|
|
0
|
|
|
my ($self, %config) = @_; |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
#Required settings |
664
|
0
|
|
|
|
|
|
my @required = ( 'USERNAME', 'SECRET' ); |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
#Defaults |
667
|
0
|
|
|
|
|
|
my %defaults = ( PEERADDR => '127.0.0.1', |
668
|
|
|
|
|
|
|
PEERPORT => 5038, |
669
|
|
|
|
|
|
|
AUTHTYPE => 'plaintext', |
670
|
|
|
|
|
|
|
EVENTS => 'off', |
671
|
|
|
|
|
|
|
BUFFERSIZE => 30000, |
672
|
|
|
|
|
|
|
BLOCKING => 1 |
673
|
|
|
|
|
|
|
); |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
#Create list of all options and acceptable values |
676
|
0
|
|
|
|
|
|
my %config_options = ( ORIGINATEHACK => 'bool', |
677
|
|
|
|
|
|
|
USESSL => 'bool', |
678
|
|
|
|
|
|
|
PEERADDR => '', |
679
|
|
|
|
|
|
|
PEERPORT => 'num', |
680
|
|
|
|
|
|
|
USERNAME => '', |
681
|
|
|
|
|
|
|
SECRET => '', |
682
|
|
|
|
|
|
|
EVENTS => '', |
683
|
|
|
|
|
|
|
TIMEOUT => 'num', |
684
|
|
|
|
|
|
|
KEEPALIVE => 'num', |
685
|
|
|
|
|
|
|
TCP_KEEPALIVE => 'bool', |
686
|
|
|
|
|
|
|
BUFFERSIZE => 'num', |
687
|
|
|
|
|
|
|
HANDLERS => 'HASH', |
688
|
|
|
|
|
|
|
BLOCKING => 'bool', |
689
|
|
|
|
|
|
|
AUTHTYPE => 'md5|plaintext', |
690
|
|
|
|
|
|
|
ON_CONNECT => 'CODE', |
691
|
|
|
|
|
|
|
ON_CONNECT_ERR => 'CODE', |
692
|
|
|
|
|
|
|
ON_ERROR => 'CODE', |
693
|
|
|
|
|
|
|
ON_DISCONNECT => 'CODE', |
694
|
|
|
|
|
|
|
ON_TIMEOUT => 'CODE' |
695
|
|
|
|
|
|
|
); |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
#Config Validation + Setting |
698
|
0
|
|
|
|
|
|
while (my ($key, $val) = each(%config)) { |
699
|
0
|
|
|
|
|
|
my $opt = uc($key); |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
#Unknown keys |
702
|
0
|
0
|
|
|
|
|
if (!exists $config_options{$opt}) { |
|
|
0
|
|
|
|
|
|
703
|
0
|
0
|
|
|
|
|
carp "Unknown constructor option: $key" if warnings::enabled('Asterisk::AMI'); |
704
|
0
|
|
|
|
|
|
next; |
705
|
|
|
|
|
|
|
#Undef values |
706
|
|
|
|
|
|
|
} elsif (!defined $val) { |
707
|
0
|
|
|
|
|
|
next; |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
#Check for correct reference types |
711
|
0
|
0
|
|
|
|
|
if (ref($val) ne $config_options{$opt}) { |
|
|
0
|
|
|
|
|
|
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
#If they are ref types then fail |
714
|
0
|
0
|
|
|
|
|
if ($config_options{$opt} eq 'CODE') { |
|
|
0
|
|
|
|
|
|
715
|
0
|
0
|
|
|
|
|
carp "Constructor option \'$key\' requires an anonymous subroutine or a subroutine reference" if warnings::enabled('Asterisk::AMI'); |
716
|
0
|
|
|
|
|
|
return; |
717
|
|
|
|
|
|
|
} elsif ($config_options{$opt} eq 'HASH') { |
718
|
0
|
0
|
|
|
|
|
carp "Constructor option \'$key\' requires a hash reference" if warnings::enabled('Asterisk::AMI'); |
719
|
0
|
|
|
|
|
|
return; |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
#Boolean values |
723
|
0
|
0
|
|
|
|
|
if ($config_options{$opt} eq 'bool') { |
|
|
0
|
|
|
|
|
|
724
|
0
|
0
|
0
|
|
|
|
if ($val =~ /[^\d]/x || ($val != 0 && $val != 1)) { |
|
|
|
0
|
|
|
|
|
725
|
0
|
0
|
|
|
|
|
carp "Constructor option \'$key\' requires a boolean value (0 or 1)" if warnings::enabled('Asterisk::AMI'); |
726
|
0
|
|
|
|
|
|
return; |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
#Numeric values |
729
|
|
|
|
|
|
|
} elsif ($config_options{$opt} eq 'num') { |
730
|
0
|
0
|
|
|
|
|
if ($val =~ /[^\d]/x) { |
731
|
0
|
0
|
|
|
|
|
carp "Constructor option \'$key\' requires a numeric value" if warnings::enabled('Asterisk::AMI'); |
732
|
0
|
|
|
|
|
|
return; |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
#Hard coded list of options |
735
|
|
|
|
|
|
|
} else { |
736
|
0
|
|
|
|
|
|
my $lval = lc($val); |
737
|
|
|
|
|
|
|
|
738
|
0
|
|
|
|
|
|
my @match = grep { $lval eq $_ } split /\|/x,$config_options{$opt}; |
|
0
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
|
740
|
0
|
0
|
|
|
|
|
if (!@match) { |
741
|
0
|
0
|
|
|
|
|
carp "Constructor option \'$key\' requires one of the following options: $config_options{$opt}" if warnings::enabled('Asterisk::AMI'); |
742
|
0
|
|
|
|
|
|
return; |
743
|
|
|
|
|
|
|
} else { |
744
|
|
|
|
|
|
|
#lowercase it for consistency |
745
|
0
|
|
|
|
|
|
$val = $lval; |
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
#Ensure all handlers are sub refs |
750
|
|
|
|
|
|
|
} elsif ($opt eq 'HANDLERS') { |
751
|
0
|
|
|
|
|
|
while (my ($event, $handler) = each %{$val}) { |
|
0
|
|
|
|
|
|
|
752
|
0
|
0
|
|
|
|
|
if (ref($handler) ne 'CODE') { |
753
|
0
|
0
|
|
|
|
|
carp "Handler for event type \'$event\' must be an anonymous subroutine or a subroutine reference" if warnings::enabled('Asterisk::AMI'); |
754
|
0
|
|
|
|
|
|
return; |
755
|
|
|
|
|
|
|
} |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
|
759
|
0
|
|
|
|
|
|
$self->{CONFIG}->{$opt} = $val; |
760
|
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
#Check for required options |
764
|
0
|
|
|
|
|
|
foreach my $req (@required) { |
765
|
0
|
0
|
|
|
|
|
if (!exists $self->{CONFIG}->{$req}) { |
766
|
0
|
0
|
|
|
|
|
carp "Must supply a username and secret for connecting to asterisk" if warnings::enabled('Asterisk::AMI'); |
767
|
0
|
|
|
|
|
|
return; |
768
|
|
|
|
|
|
|
} |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
#Change default port if using ssl |
772
|
0
|
0
|
|
|
|
|
if ($self->{CONFIG}->{USESSL}) { |
773
|
0
|
|
|
|
|
|
$defaults{PEERPORT} = 5039; |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
#Assign defaults for any missing options |
777
|
0
|
|
|
|
|
|
while (my ($opt, $val) = each(%defaults)) { |
778
|
0
|
0
|
|
|
|
|
if (!defined $self->{CONFIG}->{$opt}) { |
779
|
0
|
|
|
|
|
|
$self->{CONFIG}->{$opt} = $val; |
780
|
|
|
|
|
|
|
} |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
#Make adjustments for Originate Async bullscrap |
784
|
0
|
0
|
|
|
|
|
if ($self->{CONFIG}->{ORIGINATEHACK}) { |
785
|
|
|
|
|
|
|
#Turn on call events, otherwise we wont get the Async response |
786
|
0
|
0
|
|
|
|
|
if (lc($self->{CONFIG}->{EVENTS}) eq 'off') { |
|
|
0
|
|
|
|
|
|
787
|
0
|
|
|
|
|
|
$self->{CONFIG}->{EVENTS} = 'call'; |
788
|
|
|
|
|
|
|
#Fake event type so that we will discard events, else by turning on events our event buffer |
789
|
|
|
|
|
|
|
#Will just continue to fill up. |
790
|
0
|
0
|
|
0
|
|
|
$self->{CONFIG}->{HANDLERS} = { 'JUSTMAKETHEHASHNOTEMPTY' => sub {} } unless ($self->{CONFIG}->{HANDLERS}); |
|
0
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
#They already turned events on, just add call types to it, assume they are doing something with events |
792
|
|
|
|
|
|
|
#and don't mess with the handlers |
793
|
|
|
|
|
|
|
} elsif (lc($self->{CONFIG}->{EVENTS}) !~ /on|call/x) { |
794
|
0
|
|
|
|
|
|
$self->{CONFIG}->{EVENTS} .= ',call'; |
795
|
|
|
|
|
|
|
} |
796
|
|
|
|
|
|
|
} |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
#Initialize the seq number |
799
|
0
|
|
|
|
|
|
$self->{idseq} = 1; |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
#Weaken reference for use in anonsub |
802
|
0
|
|
|
|
|
|
weaken($self); |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
#Set keepalive |
805
|
0
|
0
|
|
0
|
|
|
$self->{CONFIG}->{KEEPALIVE} = AE::timer($self->{CONFIG}->{KEEPALIVE}, $self->{CONFIG}->{KEEPALIVE}, sub { $self->_send_keepalive }) if ($self->{CONFIG}->{KEEPALIVE}); |
|
0
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
|
807
|
0
|
|
|
|
|
|
return 1; |
808
|
|
|
|
|
|
|
} |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
#Handles connection failures (includes login failure); |
811
|
|
|
|
|
|
|
sub _on_connect_err { |
812
|
|
|
|
|
|
|
|
813
|
0
|
|
|
0
|
|
|
my ($self, $message) = @_; |
814
|
|
|
|
|
|
|
|
815
|
0
|
|
|
|
|
|
warnings::warnif('Asterisk::AMI', "Failed to connect to asterisk - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); |
816
|
0
|
|
|
|
|
|
warnings::warnif('Asterisk::AMI', "Error Message: $message"); |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
#Dispatch all callbacks as if they timed out |
819
|
0
|
|
|
|
|
|
$self->_clear_cbs(); |
820
|
|
|
|
|
|
|
|
821
|
0
|
0
|
|
|
|
|
if (exists $self->{CONFIG}->{ON_CONNECT_ERR}) { |
|
|
0
|
|
|
|
|
|
822
|
0
|
|
|
|
|
|
$self->{CONFIG}->{ON_CONNECT_ERR}->($self, $message); |
823
|
|
|
|
|
|
|
} elsif (exists $self->{CONFIG}->{ON_ERROR}) { |
824
|
0
|
|
|
|
|
|
$self->{CONFIG}->{ON_ERROR}->($self, $message); |
825
|
|
|
|
|
|
|
} |
826
|
|
|
|
|
|
|
|
827
|
0
|
|
|
|
|
|
$self->{SOCKERR} = 1; |
828
|
|
|
|
|
|
|
|
829
|
0
|
|
|
|
|
|
$self->destroy(); |
830
|
|
|
|
|
|
|
|
831
|
0
|
|
|
|
|
|
return; |
832
|
|
|
|
|
|
|
} |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
#Handles other errors on the socket |
835
|
|
|
|
|
|
|
sub _on_error { |
836
|
|
|
|
|
|
|
|
837
|
0
|
|
|
0
|
|
|
my ($self, $message) = @_; |
838
|
|
|
|
|
|
|
|
839
|
0
|
|
|
|
|
|
warnings::warnif('Asterisk::AMI', "Received Error on socket - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); |
840
|
0
|
|
|
|
|
|
warnings::warnif('Asterisk::AMI', "Error Message: $message"); |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
#Call all cbs as if they had timed out |
843
|
0
|
|
|
|
|
|
$self->_clear_cbs(); |
844
|
|
|
|
|
|
|
|
845
|
0
|
0
|
|
|
|
|
$self->{CONFIG}->{ON_ERROR}->($self, $message) if (exists $self->{CONFIG}->{ON_ERROR}); |
846
|
|
|
|
|
|
|
|
847
|
0
|
|
|
|
|
|
$self->{SOCKERR} = 1; |
848
|
|
|
|
|
|
|
|
849
|
0
|
|
|
|
|
|
$self->destroy(); |
850
|
|
|
|
|
|
|
|
851
|
0
|
|
|
|
|
|
return; |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
#Handles the remote end disconnecting |
855
|
|
|
|
|
|
|
sub _on_disconnect { |
856
|
|
|
|
|
|
|
|
857
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
858
|
|
|
|
|
|
|
|
859
|
0
|
|
|
|
|
|
my $message = "Remote end disconnected - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"; |
860
|
0
|
|
|
|
|
|
warnings::warnif('Asterisk::AMI', "Remote Asterisk Server ended connection - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
#Call all callbacks as if they had timed out |
863
|
0
|
|
|
|
|
|
_ |
864
|
|
|
|
|
|
|
$self->_clear_cbs(); |
865
|
|
|
|
|
|
|
|
866
|
0
|
0
|
|
|
|
|
if (exists $self->{CONFIG}->{ON_DISCONNECT}) { |
|
|
0
|
|
|
|
|
|
867
|
0
|
|
|
|
|
|
$self->{CONFIG}->{ON_DISCONNECT}->($self, $message); |
868
|
|
|
|
|
|
|
} elsif (exists $self->{CONFIG}->{ON_ERROR}) { |
869
|
0
|
|
|
|
|
|
$self->{CONFIG}->{ON_ERROR}->($self, $message); |
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
|
872
|
0
|
|
|
|
|
|
$self->{SOCKERR} = 1; |
873
|
|
|
|
|
|
|
|
874
|
0
|
|
|
|
|
|
$self->destroy(); |
875
|
|
|
|
|
|
|
|
876
|
0
|
|
|
|
|
|
return; |
877
|
|
|
|
|
|
|
} |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
#What happens if our keep alive times out |
880
|
|
|
|
|
|
|
sub _on_timeout { |
881
|
0
|
|
|
0
|
|
|
my ($self, $message) = @_; |
882
|
|
|
|
|
|
|
|
883
|
0
|
|
|
|
|
|
warnings::warnif('Asterisk::AMI', $message); |
884
|
|
|
|
|
|
|
|
885
|
0
|
0
|
|
|
|
|
if (exists $self->{CONFIG}->{ON_TIMEOUT}) { |
|
|
0
|
|
|
|
|
|
886
|
0
|
|
|
|
|
|
$self->{CONFIG}->{ON_TIMEOUT}->($self, $message); |
887
|
|
|
|
|
|
|
} elsif (exists $self->{CONFIG}->{ON_ERROR}) { |
888
|
0
|
|
|
|
|
|
$self->{CONFIG}->{ON_ERROR}->($self, $message); |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
|
891
|
0
|
|
|
|
|
|
$self->{SOCKERR} = 1; |
892
|
|
|
|
|
|
|
|
893
|
0
|
|
|
|
|
|
return; |
894
|
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
#Things to do after our initial connect |
897
|
|
|
|
|
|
|
sub _on_connect { |
898
|
|
|
|
|
|
|
|
899
|
0
|
|
|
0
|
|
|
my ($self, $fh, $line) = @_; |
900
|
|
|
|
|
|
|
|
901
|
0
|
0
|
|
|
|
|
if ($line =~ /^Asterisk\ Call\ Manager\/([0-9]\.[0-9])$/ox) { |
902
|
0
|
|
|
|
|
|
$self->{AMIVER} = $1; |
903
|
|
|
|
|
|
|
} else { |
904
|
0
|
|
|
|
|
|
warnings::warnif('Asterisk::AMI', "Unknown Protocol/AMI Version from $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); |
905
|
|
|
|
|
|
|
} |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
#Weak reference for us in anonysub |
908
|
0
|
|
|
|
|
|
weaken($self); |
909
|
|
|
|
|
|
|
|
910
|
0
|
|
|
0
|
|
|
$self->{handle}->push_read( 'Asterisk::AMI' => sub { $self->_handle_packet(@_); } ); |
|
0
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
|
912
|
0
|
|
|
|
|
|
return 1; |
913
|
|
|
|
|
|
|
} |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
#Connects to the AMI Returns 1 on success, 0 on failure |
916
|
|
|
|
|
|
|
sub _connect { |
917
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
#Weaken ref for use in anonysub |
920
|
0
|
|
|
|
|
|
weaken($self); |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
#Build a hash of our anyevent::handle options |
923
|
|
|
|
|
|
|
my %hdl = ( connect => [$self->{CONFIG}->{PEERADDR} => $self->{CONFIG}->{PEERPORT}], |
924
|
0
|
|
|
0
|
|
|
on_connect_err => sub { $self->_on_connect_err($_[1]); }, |
925
|
0
|
|
|
0
|
|
|
on_error => sub { $self->_on_error($_[2]) }, |
926
|
0
|
|
|
0
|
|
|
on_eof => sub { $self->_on_disconnect; }, |
927
|
0
|
|
|
0
|
|
|
on_connect => sub { $self->{handle}->push_read( line => sub { $self->_on_connect(@_); } ); }); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
#TLS stuff |
930
|
0
|
0
|
|
|
|
|
$hdl{'tls'} = 'connect' if ($self->{CONFIG}->{USESSL}); |
931
|
|
|
|
|
|
|
#TCP Keepalive |
932
|
0
|
0
|
|
|
|
|
$hdl{'keeplive'} = 1 if ($self->{CONFIG}->{TCP_KEEPALIVE}); |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
#Make connection/create handle |
935
|
0
|
|
|
|
|
|
$self->{handle} = AnyEvent::Handle->new(%hdl); |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
#Return login status if blocking |
938
|
0
|
0
|
|
|
|
|
return $self->_login if ($self->{CONFIG}->{BLOCKING}); |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
#Queue our login |
941
|
0
|
|
|
|
|
|
$self->_login; |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
#If we have a handle, SUCCESS! |
944
|
0
|
0
|
|
|
|
|
return 1 if (defined $self->{handle}); |
945
|
|
|
|
|
|
|
|
946
|
0
|
|
|
|
|
|
return; |
947
|
|
|
|
|
|
|
} |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
sub _handle_packet { |
950
|
0
|
|
|
0
|
|
|
my ($self, $hdl, $buffer) = @_; |
951
|
|
|
|
|
|
|
|
952
|
0
|
|
|
|
|
|
foreach my $packet (split /\015\012\015\012/ox, $buffer) { |
953
|
0
|
|
|
|
|
|
my %parsed; |
954
|
|
|
|
|
|
|
|
955
|
0
|
|
|
|
|
|
foreach my $line (split /\015\012/ox, $packet) { |
956
|
|
|
|
|
|
|
#Is this our command output? |
957
|
0
|
0
|
|
|
|
|
if ($line =~ s/--END\ COMMAND--$//ox) { |
958
|
0
|
|
|
|
|
|
$parsed{'COMPLETED'} = 1; |
959
|
|
|
|
|
|
|
|
960
|
0
|
|
|
|
|
|
push(@{$parsed{'CMD'}},split(/\x20*\x0A/ox, $line)); |
|
0
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
} else { |
962
|
|
|
|
|
|
|
#Regular output, split on :\ |
963
|
0
|
|
|
|
|
|
my ($key, $value) = split /:\ /x, $line, 2; |
964
|
|
|
|
|
|
|
|
965
|
0
|
|
|
|
|
|
$parsed{$key} = $value; |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
} |
968
|
|
|
|
|
|
|
} |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
#Dispatch depending on packet type |
971
|
0
|
0
|
|
|
|
|
if (exists $parsed{'ActionID'}) { |
|
|
0
|
|
|
|
|
|
972
|
0
|
|
|
|
|
|
$self->_handle_action(\%parsed); |
973
|
|
|
|
|
|
|
} elsif (exists $parsed{'Event'}) { |
974
|
0
|
|
|
|
|
|
$self->_handle_event(\%parsed); |
975
|
|
|
|
|
|
|
} |
976
|
|
|
|
|
|
|
} |
977
|
|
|
|
|
|
|
|
978
|
0
|
|
|
|
|
|
return 1; |
979
|
|
|
|
|
|
|
} |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
#Used once and action completes |
982
|
|
|
|
|
|
|
#Determines goodness and performs any oustanding callbacks |
983
|
|
|
|
|
|
|
sub _action_complete { |
984
|
0
|
|
|
0
|
|
|
my ($self, $actionid) = @_; |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
#Determine 'Goodness' |
987
|
0
|
0
|
0
|
|
|
|
if (defined $self->{RESPONSEBUFFER}->{$actionid}->{'Response'} |
988
|
|
|
|
|
|
|
&& $self->{RESPONSEBUFFER}->{$actionid}->{'Response'} =~ /^(?:Success|Follows|Goodbye|Events Off|Pong)$/ox) { |
989
|
0
|
|
|
|
|
|
$self->{RESPONSEBUFFER}->{$actionid}->{'GOOD'} = 1; |
990
|
|
|
|
|
|
|
} |
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
#Do callback and cleanup if callback exists |
993
|
0
|
0
|
|
|
|
|
if (defined $self->{CALLBACKS}->{$actionid}->{'cb'}) { |
994
|
|
|
|
|
|
|
#Stuff needed to process callback |
995
|
0
|
|
|
|
|
|
my $callback = $self->{CALLBACKS}->{$actionid}->{'cb'}; |
996
|
0
|
|
|
|
|
|
my $response = $self->{RESPONSEBUFFER}->{$actionid}; |
997
|
0
|
|
|
|
|
|
my $store = $self->{CALLBACKS}->{$actionid}->{'store'}; |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
#cleanup |
1000
|
0
|
|
|
|
|
|
delete $self->{RESPONSEBUFFER}->{$actionid}; |
1001
|
0
|
|
|
|
|
|
delete $self->{CALLBACKS}->{$actionid}; |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
#Delete Originate Async bullshit |
1004
|
0
|
|
|
|
|
|
delete $response->{'ASYNC'}; |
1005
|
|
|
|
|
|
|
|
1006
|
0
|
|
|
|
|
|
$callback->($self, $response, $store); |
1007
|
|
|
|
|
|
|
} |
1008
|
|
|
|
|
|
|
|
1009
|
0
|
|
|
|
|
|
return 1; |
1010
|
|
|
|
|
|
|
} |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
#Handles proccessing and callbacks for action responses |
1013
|
|
|
|
|
|
|
sub _handle_action { |
1014
|
0
|
|
|
0
|
|
|
my ($self, $packet) = @_; |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
#Snag our actionid |
1017
|
0
|
|
|
|
|
|
my $actionid = $packet->{'ActionID'}; |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
#Discard Unknown ActionIDs |
1020
|
0
|
0
|
|
|
|
|
return unless ($self->{EXPECTED}->{$actionid}); |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
#Event responses |
1023
|
0
|
0
|
|
|
|
|
if (exists $packet->{'Event'}) { |
|
|
0
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
#EventCompleted Event? |
1025
|
0
|
0
|
|
|
|
|
if ($packet->{'Event'} =~ /[cC]omplete/ox) { |
1026
|
0
|
|
|
|
|
|
$self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'} = 1; |
1027
|
|
|
|
|
|
|
} else { |
1028
|
|
|
|
|
|
|
#DBGetResponse and Originate Async Exceptions |
1029
|
0
|
0
|
0
|
|
|
|
if ($packet->{'Event'} eq 'DBGetResponse' || $packet->{'Event'} eq 'OriginateResponse') { |
1030
|
0
|
|
|
|
|
|
$self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'} = 1; |
1031
|
|
|
|
|
|
|
} |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
#To the buffer |
1034
|
0
|
|
|
|
|
|
push(@{$self->{RESPONSEBUFFER}->{$actionid}->{'EVENTS'}}, $packet); |
|
0
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
} |
1036
|
|
|
|
|
|
|
#Response packets |
1037
|
|
|
|
|
|
|
} elsif (exists $packet->{'Response'}) { |
1038
|
|
|
|
|
|
|
#If No indication of future packets, mark as completed |
1039
|
0
|
0
|
|
|
|
|
if ($packet->{'Response'} ne 'Follows') { |
1040
|
|
|
|
|
|
|
#Originate Async Exception is the first test |
1041
|
0
|
0
|
0
|
|
|
|
if (!$self->{RESPONSEBUFFER}->{$actionid}->{'ASYNC'} |
|
|
|
0
|
|
|
|
|
1042
|
|
|
|
|
|
|
&& (!exists $packet->{'Message'} || $packet->{'Message'} !~ /[fF]ollow/ox)) { |
1043
|
0
|
|
|
|
|
|
$self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'} = 1; |
1044
|
|
|
|
|
|
|
} |
1045
|
|
|
|
|
|
|
} |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
#Copy the response into the buffer |
1048
|
0
|
|
|
|
|
|
foreach (keys %{$packet}) { |
|
0
|
|
|
|
|
|
|
1049
|
0
|
0
|
|
|
|
|
if ($_ =~ /^(?:Response|Message|ActionID|Privilege|CMD|COMPLETED)$/ox) { |
1050
|
0
|
|
|
|
|
|
$self->{RESPONSEBUFFER}->{$actionid}->{$_} = $packet->{$_}; |
1051
|
|
|
|
|
|
|
} else { |
1052
|
0
|
|
|
|
|
|
$self->{RESPONSEBUFFER}->{$actionid}->{'PARSED'}->{$_} = $packet->{$_}; |
1053
|
|
|
|
|
|
|
} |
1054
|
|
|
|
|
|
|
} |
1055
|
|
|
|
|
|
|
} |
1056
|
|
|
|
|
|
|
|
1057
|
0
|
0
|
|
|
|
|
if ($self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'}) { |
1058
|
|
|
|
|
|
|
#This aciton is finished do not accept any more packets for it |
1059
|
0
|
|
|
|
|
|
delete $self->{EXPECTED}->{$actionid}; |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
#Determine goodness, do callback |
1062
|
0
|
|
|
|
|
|
$self->_action_complete($actionid); |
1063
|
|
|
|
|
|
|
} |
1064
|
|
|
|
|
|
|
|
1065
|
0
|
|
|
|
|
|
return 1; |
1066
|
|
|
|
|
|
|
} |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
#Handles proccessing and callbacks for 'Event' packets |
1069
|
|
|
|
|
|
|
sub _handle_event { |
1070
|
0
|
|
|
0
|
|
|
my ($self, $event) = @_; |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
#If handlers were configured just dispatch, don't buffer |
1073
|
0
|
0
|
|
|
|
|
if ($self->{CONFIG}->{HANDLERS}) { |
1074
|
0
|
0
|
|
|
|
|
if (exists $self->{CONFIG}->{HANDLERS}->{$event->{'Event'}}) { |
|
|
0
|
|
|
|
|
|
1075
|
0
|
|
|
|
|
|
$self->{CONFIG}->{HANDLERS}->{$event->{'Event'}}->($self, $event); |
1076
|
|
|
|
|
|
|
} elsif (exists $self->{CONFIG}->{HANDLERS}->{'default'}) { |
1077
|
0
|
|
|
|
|
|
$self->{CONFIG}->{HANDLERS}->{'default'}->($self, $event); |
1078
|
|
|
|
|
|
|
} |
1079
|
|
|
|
|
|
|
} else { |
1080
|
|
|
|
|
|
|
#Someone is waiting on this packet, don't bother buffering |
1081
|
0
|
0
|
|
|
|
|
if (exists $self->{CALLBACKS}->{'EVENT'}) { |
1082
|
0
|
|
|
|
|
|
$self->{CALLBACKS}->{'EVENT'}->{'cb'}->($event); |
1083
|
0
|
|
|
|
|
|
delete $self->{CALLBACKS}->{'EVENT'}; |
1084
|
|
|
|
|
|
|
#Save for later |
1085
|
|
|
|
|
|
|
} else { |
1086
|
0
|
|
|
|
|
|
push(@{$self->{EVENTBUFFER}}, $event); |
|
0
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
} |
1088
|
|
|
|
|
|
|
} |
1089
|
|
|
|
|
|
|
|
1090
|
0
|
|
|
|
|
|
return 1; |
1091
|
|
|
|
|
|
|
} |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
#This is used to provide blocking behavior for calls It installs callbacks for an action if it is not in the buffer |
1094
|
|
|
|
|
|
|
#and waits for the response before returning it. |
1095
|
|
|
|
|
|
|
sub _wait_response { |
1096
|
0
|
|
|
0
|
|
|
my ($self, $id, $timeout) = @_; |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
#Already got it? |
1099
|
0
|
0
|
|
|
|
|
if ($self->{RESPONSEBUFFER}->{$id}->{'COMPLETED'}) { |
1100
|
0
|
|
|
|
|
|
my $resp = $self->{RESPONSEBUFFER}->{$id}; |
1101
|
0
|
|
|
|
|
|
delete $self->{RESPONSEBUFFER}->{$id}; |
1102
|
0
|
|
|
|
|
|
delete $self->{CALLBACKS}->{$id}; |
1103
|
0
|
|
|
|
|
|
delete $self->{EXPECTED}->{$id}; |
1104
|
0
|
|
|
|
|
|
return $resp; |
1105
|
|
|
|
|
|
|
} |
1106
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
#Don't Have it, wait for it Install some handlers and use a CV to simulate blocking |
1108
|
0
|
|
|
|
|
|
my $process = AE::cv; |
1109
|
|
|
|
|
|
|
|
1110
|
0
|
|
|
0
|
|
|
$self->{CALLBACKS}->{$id}->{'cb'} = sub { $process->send($_[1]) }; |
|
0
|
|
|
|
|
|
|
1111
|
0
|
0
|
|
|
|
|
$timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout); |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
#Should not need to weaken here because this is a blocking call Only outcomes can be error, timeout, or |
1114
|
|
|
|
|
|
|
#complete, all of which will finish the cb and clear the reference weaken($self) |
1115
|
|
|
|
|
|
|
|
1116
|
0
|
0
|
|
|
|
|
if ($timeout) { |
1117
|
|
|
|
|
|
|
$self->{CALLBACKS}->{$id}->{'timeout'} = sub { |
1118
|
0
|
|
|
0
|
|
|
my $response = $self->{'RESPONSEBUFFER'}->{$id}; |
1119
|
0
|
|
|
|
|
|
delete $self->{RESPONSEBUFFER}->{$id}; |
1120
|
0
|
|
|
|
|
|
delete $self->{CALLBACKS}->{$id}; |
1121
|
0
|
|
|
|
|
|
delete $self->{EXPECTED}->{$id}; |
1122
|
0
|
|
|
|
|
|
$process->send($response); |
1123
|
0
|
|
|
|
|
|
}; |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
#Make sure event loop is up to date in case of sleeps |
1126
|
0
|
|
|
|
|
|
AE::now_update; |
1127
|
|
|
|
|
|
|
|
1128
|
0
|
|
|
|
|
|
$self->{CALLBACKS}->{$id}->{'timer'} = AE::timer $timeout, 0, $self->{CALLBACKS}->{$id}->{'timeout'}; |
1129
|
|
|
|
|
|
|
} |
1130
|
|
|
|
|
|
|
|
1131
|
0
|
|
|
|
|
|
return $process->recv; |
1132
|
|
|
|
|
|
|
} |
1133
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
sub _build_action { |
1135
|
0
|
|
|
0
|
|
|
my ($actionhash, $id) = @_; |
1136
|
|
|
|
|
|
|
|
1137
|
0
|
|
|
|
|
|
my $action; |
1138
|
|
|
|
|
|
|
my $async; |
1139
|
0
|
|
|
|
|
|
my $callback; |
1140
|
0
|
|
|
|
|
|
my $timeout; |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
#Create an action out of a hash |
1143
|
0
|
|
|
|
|
|
while (my ($key, $value) = each(%{$actionhash})) { |
|
0
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
|
1145
|
0
|
|
|
|
|
|
my $lkey = lc($key); |
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
#Callbacks |
1148
|
0
|
0
|
0
|
|
|
|
if ($key eq 'CALLBACK') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1149
|
0
|
0
|
|
|
|
|
carp "Use of the CALLBACK key in an action is deprecated and will be removed in a future release.\n", |
1150
|
|
|
|
|
|
|
"Please use the syntax that is available." if warnings::enabled('Asterisk::AMI'); |
1151
|
|
|
|
|
|
|
|
1152
|
0
|
0
|
|
|
|
|
$callback = $actionhash->{$key} unless (defined $callback); |
1153
|
0
|
|
|
|
|
|
next; |
1154
|
|
|
|
|
|
|
#Timeout |
1155
|
|
|
|
|
|
|
} elsif ($key eq 'TIMEOUT') { |
1156
|
0
|
0
|
|
|
|
|
carp "Use of the TIMEOUT key in an action is deprecated and will be removed in a future release\n", |
1157
|
|
|
|
|
|
|
"Please use the syntax that is available." if warnings::enabled('Asterisk::AMI'); |
1158
|
|
|
|
|
|
|
|
1159
|
0
|
0
|
|
|
|
|
$timeout = $actionhash->{$key} unless (defined $timeout); |
1160
|
0
|
|
|
|
|
|
next; |
1161
|
|
|
|
|
|
|
#Exception of Orignate Async |
1162
|
|
|
|
|
|
|
} elsif ($lkey eq 'async' && $value == 1) { |
1163
|
0
|
|
|
|
|
|
$async = 1; |
1164
|
|
|
|
|
|
|
#Clean out user ActionIDs |
1165
|
|
|
|
|
|
|
} elsif ($lkey eq 'actionid') { |
1166
|
0
|
0
|
|
|
|
|
carp "User supplied ActionID being ignored." if warnings::enabled('Asterisk::AMI'); |
1167
|
0
|
|
|
|
|
|
next; |
1168
|
|
|
|
|
|
|
} |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
#Handle multiple values |
1171
|
0
|
0
|
|
|
|
|
if (ref($value) eq 'ARRAY') { |
1172
|
0
|
|
|
|
|
|
foreach my $var (@{$value}) { |
|
0
|
|
|
|
|
|
|
1173
|
0
|
|
|
|
|
|
$action .= $key . ': ' . $var . "\015\012"; |
1174
|
|
|
|
|
|
|
} |
1175
|
|
|
|
|
|
|
} else { |
1176
|
0
|
|
|
|
|
|
$action .= $key . ': ' . $value . "\015\012"; |
1177
|
|
|
|
|
|
|
} |
1178
|
|
|
|
|
|
|
} |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
#Append ActionID and End Command |
1181
|
0
|
|
|
|
|
|
$action .= 'ActionID: ' . $id . "\015\012\015\012"; |
1182
|
|
|
|
|
|
|
|
1183
|
0
|
|
|
|
|
|
return ($action, $async, $callback, $timeout); |
1184
|
|
|
|
|
|
|
} |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
#Sends an action to the AMI Accepts an Array Returns the actionid of the action |
1187
|
|
|
|
|
|
|
sub send_action { |
1188
|
0
|
|
|
0
|
0
|
|
my ($self, $actionhash, $callback, $timeout, $store) = @_; |
1189
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
#No connection |
1191
|
0
|
0
|
|
|
|
|
return unless ($self->{handle}); |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
#resets id number |
1194
|
0
|
0
|
|
|
|
|
if ($self->{idseq} > $self->{CONFIG}->{BUFFERSIZE}) { |
1195
|
0
|
|
|
|
|
|
$self->{idseq} = 1; |
1196
|
|
|
|
|
|
|
} |
1197
|
|
|
|
|
|
|
|
1198
|
0
|
|
|
|
|
|
my $id = $self->{idseq}++; |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
#Store the Action ID |
1201
|
0
|
|
|
|
|
|
$self->{lastid} = $id; |
1202
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
#Delete anything that might be in the buffer |
1204
|
0
|
|
|
|
|
|
delete $self->{RESPONSEBUFFER}->{$id}; |
1205
|
0
|
|
|
|
|
|
delete $self->{CALLBACKS}->{$id}; |
1206
|
|
|
|
|
|
|
|
1207
|
0
|
|
|
|
|
|
my ($action, $hcb, $htimeout); |
1208
|
|
|
|
|
|
|
|
1209
|
0
|
|
|
|
|
|
($action, $self->{RESPONSEBUFFER}->{$id}->{'ASYNC'}, $hcb, $htimeout) = _build_action($actionhash, $id); |
1210
|
|
|
|
|
|
|
|
1211
|
0
|
0
|
|
|
|
|
$callback = $hcb unless (defined $callback); |
1212
|
0
|
0
|
|
|
|
|
$timeout = $htimeout unless (defined $timeout); |
1213
|
|
|
|
|
|
|
|
1214
|
0
|
0
|
0
|
|
|
|
if ($self->{LOGGEDIN} || lc($actionhash->{'Action'}) =~ /login|challenge/x) { |
1215
|
0
|
|
|
|
|
|
$self->{handle}->push_write($action); |
1216
|
|
|
|
|
|
|
} else { |
1217
|
0
|
|
|
|
|
|
$self->{PRELOGIN}->{$id} = $action; |
1218
|
|
|
|
|
|
|
} |
1219
|
|
|
|
|
|
|
|
1220
|
0
|
|
|
|
|
|
$self->{RESPONSEBUFFER}->{$id}->{'COMPLETED'} = 0; |
1221
|
0
|
|
|
|
|
|
$self->{RESPONSEBUFFER}->{$id}->{'GOOD'} = 0; |
1222
|
0
|
|
|
|
|
|
$self->{EXPECTED}->{$id} = 1; |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
#Weaken ref of use in anonsub |
1225
|
0
|
|
|
|
|
|
weaken($self); |
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
#Set default timeout if needed |
1228
|
0
|
0
|
|
|
|
|
$timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout); |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
#Setup callback |
1231
|
0
|
0
|
|
|
|
|
if (defined $callback) { |
1232
|
|
|
|
|
|
|
#Set callback if defined |
1233
|
0
|
|
|
|
|
|
$self->{CALLBACKS}->{$id}->{'cb'} = $callback; |
1234
|
|
|
|
|
|
|
#Variable to return with Callback |
1235
|
0
|
|
|
|
|
|
$self->{CALLBACKS}->{$id}->{'store'} = $store; |
1236
|
|
|
|
|
|
|
} |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
#Start timer for timeouts |
1239
|
0
|
0
|
0
|
|
|
|
if ($timeout && defined $self->{CALLBACKS}->{$id}) { |
1240
|
|
|
|
|
|
|
$self->{CALLBACKS}->{$id}->{'timeout'} = sub { |
1241
|
0
|
|
|
0
|
|
|
my $response = $self->{RESPONSEBUFFER}->{$id}; |
1242
|
0
|
|
|
|
|
|
my $cb = $self->{CALLBACKS}->{$id}->{'cb'}; |
1243
|
0
|
|
|
|
|
|
my $st = $self->{CALLBACKS}->{$id}->{'store'}; |
1244
|
0
|
|
|
|
|
|
delete $self->{RESPONSEBUFFER}->{$id}; |
1245
|
0
|
|
|
|
|
|
delete $self->{CALLBACKS}->{$id}; |
1246
|
0
|
|
|
|
|
|
delete $self->{EXPECTED}->{$id}; |
1247
|
0
|
|
|
|
|
|
delete $self->{PRELOGIN}->{$id}; |
1248
|
0
|
|
|
|
|
|
$cb->($self, $response, $st);; |
1249
|
0
|
|
|
|
|
|
}; |
1250
|
0
|
|
|
|
|
|
$self->{CALLBACKS}->{$id}->{'timer'} = AE::timer $timeout, 0, $self->{CALLBACKS}->{$id}->{'timeout'}; |
1251
|
|
|
|
|
|
|
} |
1252
|
|
|
|
|
|
|
|
1253
|
0
|
|
|
|
|
|
return $id; |
1254
|
|
|
|
|
|
|
} |
1255
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
#Checks for a response to an action If no actionid is given uses last actionid sent Returns 1 if action success, 0 if |
1257
|
|
|
|
|
|
|
#failure |
1258
|
|
|
|
|
|
|
sub check_response { |
1259
|
0
|
|
|
0
|
0
|
|
my ($self, $actionid, $timeout) = @_; |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
#Check if an actionid was passed, else us last |
1262
|
0
|
0
|
|
|
|
|
$actionid = $self->{lastid} unless (defined $actionid); |
1263
|
|
|
|
|
|
|
|
1264
|
0
|
|
|
|
|
|
my $resp = $self->_wait_response($actionid, $timeout); |
1265
|
|
|
|
|
|
|
|
1266
|
0
|
0
|
|
|
|
|
if ($resp->{'COMPLETED'}) { |
1267
|
0
|
|
|
|
|
|
return $resp->{'GOOD'}; |
1268
|
|
|
|
|
|
|
} |
1269
|
|
|
|
|
|
|
|
1270
|
0
|
|
|
|
|
|
return; |
1271
|
|
|
|
|
|
|
} |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
#Returns the Action with all command data and event Actions are hash references If an actionid is specified returns |
1274
|
|
|
|
|
|
|
#that action, otherwise uses last actionid sent Removes the event from the buffer |
1275
|
|
|
|
|
|
|
sub get_response { |
1276
|
0
|
|
|
0
|
0
|
|
my ($self, $actionid, $timeout) = @_; |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
#Check if an actionid was passed, else us last |
1279
|
0
|
0
|
|
|
|
|
$actionid = $self->{lastid} unless (defined $actionid); |
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
#Wait for the action to complete |
1282
|
0
|
|
|
|
|
|
my $resp = $self->_wait_response($actionid, $timeout); |
1283
|
|
|
|
|
|
|
|
1284
|
0
|
0
|
|
|
|
|
if ($resp->{'COMPLETED'}) { |
1285
|
0
|
|
|
|
|
|
return $resp; |
1286
|
|
|
|
|
|
|
} |
1287
|
|
|
|
|
|
|
|
1288
|
0
|
|
|
|
|
|
return; |
1289
|
|
|
|
|
|
|
} |
1290
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
#Sends an action and returns its data or undef if the command failed |
1292
|
|
|
|
|
|
|
sub action { |
1293
|
0
|
|
|
0
|
0
|
|
my ($self, $action, $timeout) = @_; |
1294
|
|
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
#Send action |
1296
|
0
|
|
|
|
|
|
my $actionid = $self->send_action($action); |
1297
|
0
|
0
|
|
|
|
|
if (defined $actionid) { |
1298
|
|
|
|
|
|
|
#Get response |
1299
|
0
|
|
|
|
|
|
return $self->get_response($actionid, $timeout); |
1300
|
|
|
|
|
|
|
} |
1301
|
|
|
|
|
|
|
|
1302
|
0
|
|
|
|
|
|
return; |
1303
|
|
|
|
|
|
|
} |
1304
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
#Sends an action and returns 1 if it was successful and 0 if it failed |
1306
|
|
|
|
|
|
|
sub simple_action { |
1307
|
0
|
|
|
0
|
0
|
|
my ($self, $action, $timeout) = @_; |
1308
|
|
|
|
|
|
|
|
1309
|
|
|
|
|
|
|
#Send action |
1310
|
0
|
|
|
|
|
|
my $actionid = $self->send_action($action); |
1311
|
|
|
|
|
|
|
|
1312
|
0
|
0
|
|
|
|
|
if (defined $actionid) { |
1313
|
0
|
|
|
|
|
|
my $resp = $self->_wait_response($actionid, $timeout); |
1314
|
0
|
0
|
|
|
|
|
if ($resp->{'COMPLETED'}) { |
1315
|
0
|
|
|
|
|
|
return $resp->{'GOOD'}; |
1316
|
|
|
|
|
|
|
} |
1317
|
|
|
|
|
|
|
} |
1318
|
|
|
|
|
|
|
|
1319
|
0
|
|
|
|
|
|
return; |
1320
|
|
|
|
|
|
|
} |
1321
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
#Calculate md5 response to channel |
1323
|
|
|
|
|
|
|
sub _md5_resp { |
1324
|
0
|
|
|
0
|
|
|
my ($self, $challenge) = @_; |
1325
|
|
|
|
|
|
|
|
1326
|
0
|
|
|
|
|
|
my $md5 = Digest::MD5->new(); |
1327
|
|
|
|
|
|
|
|
1328
|
0
|
|
|
|
|
|
$md5->add($challenge); |
1329
|
0
|
|
|
|
|
|
$md5->add($self->{CONFIG}->{SECRET}); |
1330
|
|
|
|
|
|
|
|
1331
|
0
|
|
|
|
|
|
return $md5->hexdigest; |
1332
|
|
|
|
|
|
|
} |
1333
|
|
|
|
|
|
|
|
1334
|
|
|
|
|
|
|
#Logs into the AMI |
1335
|
|
|
|
|
|
|
sub _login { |
1336
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
#Auth challenge |
1339
|
0
|
|
|
|
|
|
my %challenge; |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
#Timeout to use |
1342
|
|
|
|
|
|
|
my $timeout; |
1343
|
0
|
0
|
|
|
|
|
$timeout = 5 unless ($self->{CONFIG}->{TIMEOUT}); |
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
#Build login action |
1346
|
0
|
|
|
|
|
|
my %action = ( Action => 'login', |
1347
|
|
|
|
|
|
|
Username => $self->{CONFIG}->{USERNAME}, |
1348
|
|
|
|
|
|
|
Events => $self->{CONFIG}->{EVENTS} ); |
1349
|
|
|
|
|
|
|
|
1350
|
|
|
|
|
|
|
#Actions to take for different authtypes |
1351
|
0
|
0
|
|
|
|
|
if (lc($self->{CONFIG}->{AUTHTYPE}) eq 'md5') { |
1352
|
|
|
|
|
|
|
#Do a challenge |
1353
|
0
|
|
|
|
|
|
%challenge = ( Action => 'Challenge', |
1354
|
|
|
|
|
|
|
AuthType => $self->{CONFIG}->{AUTHTYPE}); |
1355
|
|
|
|
|
|
|
} else { |
1356
|
0
|
|
|
|
|
|
$action{'Secret'} = $self->{CONFIG}->{SECRET}; |
1357
|
|
|
|
|
|
|
} |
1358
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
#Blocking connect |
1360
|
0
|
0
|
|
|
|
|
if ($self->{CONFIG}->{BLOCKING}) { |
1361
|
0
|
|
|
|
|
|
return $self->_login_block(\%action, \%challenge, $timeout); |
1362
|
|
|
|
|
|
|
} else { |
1363
|
0
|
|
|
|
|
|
return $self->_login_noblock(\%action, \%challenge, $timeout); |
1364
|
|
|
|
|
|
|
} |
1365
|
|
|
|
|
|
|
|
1366
|
0
|
|
|
|
|
|
return; |
1367
|
|
|
|
|
|
|
} |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
#Checks loging responses, prints errors |
1370
|
|
|
|
|
|
|
sub _logged_in { |
1371
|
0
|
|
|
0
|
|
|
my ($self, $login) = @_; |
1372
|
|
|
|
|
|
|
|
1373
|
0
|
0
|
|
|
|
|
if ($login->{'GOOD'}) { |
1374
|
|
|
|
|
|
|
#Login was good |
1375
|
0
|
|
|
|
|
|
$self->{LOGGEDIN} = 1; |
1376
|
|
|
|
|
|
|
|
1377
|
0
|
0
|
|
|
|
|
$self->{CONFIG}->{ON_CONNECT}->($self) if ($self->{CONFIG}->{ON_CONNECT}); |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
#Flush pre-login buffer |
1380
|
0
|
|
|
|
|
|
foreach (values %{$self->{PRELOGIN}}) { |
|
0
|
|
|
|
|
|
|
1381
|
0
|
|
|
|
|
|
$self->{handle}->push_write($_); |
1382
|
|
|
|
|
|
|
} |
1383
|
|
|
|
|
|
|
|
1384
|
0
|
|
|
|
|
|
delete $self->{PRELOGIN}; |
1385
|
|
|
|
|
|
|
|
1386
|
0
|
|
|
|
|
|
return 1; |
1387
|
|
|
|
|
|
|
} else { |
1388
|
|
|
|
|
|
|
#Login failed |
1389
|
0
|
0
|
|
|
|
|
if ($login->{'COMPLETED'}) { |
1390
|
0
|
|
|
|
|
|
$self->_on_connect_err("Login Failed to Asterisk (bad auth) at $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); |
1391
|
|
|
|
|
|
|
} else { |
1392
|
0
|
|
|
|
|
|
$self->_on_connect_err("Login Failed to Asterisk due to timeout at $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); |
1393
|
|
|
|
|
|
|
} |
1394
|
|
|
|
|
|
|
|
1395
|
0
|
|
|
|
|
|
return; |
1396
|
|
|
|
|
|
|
} |
1397
|
|
|
|
|
|
|
|
1398
|
0
|
|
|
|
|
|
return; |
1399
|
|
|
|
|
|
|
} |
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
#Blocking Login |
1402
|
|
|
|
|
|
|
sub _login_block { |
1403
|
0
|
|
|
0
|
|
|
my ($self, $action, $challenge, $timeout) = @_; |
1404
|
|
|
|
|
|
|
|
1405
|
0
|
|
|
|
|
|
my $resp; |
1406
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
#If a challenge exists do handle it first before the login |
1408
|
0
|
0
|
|
|
|
|
if (%{$challenge}) { |
|
0
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
|
1410
|
|
|
|
|
|
|
#Get challenge response |
1411
|
0
|
|
|
|
|
|
my $chresp = $self->action($challenge,$timeout); |
1412
|
|
|
|
|
|
|
|
1413
|
0
|
0
|
|
|
|
|
if ($chresp->{'GOOD'}) { |
1414
|
|
|
|
|
|
|
|
1415
|
0
|
|
|
|
|
|
$action->{'Key'} = $self->_md5_resp($chresp->{'PARSED'}->{'Challenge'}, $self->{CONFIG}->{SECRET}); |
1416
|
0
|
|
|
|
|
|
$action->{'AuthType'} = $self->{CONFIG}->{AUTHTYPE}; |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
#Login |
1419
|
0
|
|
|
|
|
|
$resp = $self->action($action, $timeout); |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
} else { |
1422
|
|
|
|
|
|
|
#Challenge Failed |
1423
|
0
|
0
|
|
|
|
|
if ($chresp->{'COMPLETED'}) { |
1424
|
0
|
|
|
|
|
|
$self->_on_connect_err("$self->{CONFIG}->{AUTHTYPE} challenge failed"); |
1425
|
|
|
|
|
|
|
} else { |
1426
|
0
|
|
|
|
|
|
$self->_on_connect_err("Timed out waiting for challenge"); |
1427
|
|
|
|
|
|
|
} |
1428
|
|
|
|
|
|
|
|
1429
|
0
|
|
|
|
|
|
return; |
1430
|
|
|
|
|
|
|
} |
1431
|
|
|
|
|
|
|
} else { |
1432
|
|
|
|
|
|
|
#Plaintext login |
1433
|
0
|
|
|
|
|
|
$resp = $self->action($action, $timeout); |
1434
|
|
|
|
|
|
|
} |
1435
|
|
|
|
|
|
|
|
1436
|
0
|
|
|
|
|
|
return $self->_logged_in($resp); |
1437
|
|
|
|
|
|
|
} |
1438
|
|
|
|
|
|
|
|
1439
|
|
|
|
|
|
|
#Non-blocking login |
1440
|
|
|
|
|
|
|
sub _login_noblock { |
1441
|
0
|
|
|
0
|
|
|
my ($self, $action, $challenge, $timeout) = @_; |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
#Weaken ref for use in anonsub |
1444
|
0
|
|
|
|
|
|
weaken($self); |
1445
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
#Callback for login action |
1447
|
0
|
|
|
0
|
|
|
my $login_cb = sub { $self->_logged_in($_[1]) }; |
|
0
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
|
1449
|
|
|
|
|
|
|
#Do a md5 challenge |
1450
|
0
|
0
|
|
|
|
|
if (%{$challenge}) { |
|
0
|
|
|
|
|
|
|
1451
|
|
|
|
|
|
|
#Create callbacks for the challenge |
1452
|
|
|
|
|
|
|
my $challenge_cb = sub { |
1453
|
0
|
0
|
|
0
|
|
|
if ($_[1]->{'GOOD'}) { |
1454
|
0
|
|
|
|
|
|
my $md5 = Digest::MD5->new(); |
1455
|
|
|
|
|
|
|
|
1456
|
0
|
|
|
|
|
|
$md5->add($_[1]->{'PARSED'}->{'Challenge'}); |
1457
|
0
|
|
|
|
|
|
$md5->add($self->{CONFIG}->{SECRET}); |
1458
|
|
|
|
|
|
|
|
1459
|
0
|
|
|
|
|
|
$md5 = $md5->hexdigest; |
1460
|
|
|
|
|
|
|
|
1461
|
0
|
|
|
|
|
|
$action->{'Key'} = $md5; |
1462
|
0
|
|
|
|
|
|
$action->{'AuthType'} = $self->{CONFIG}->{AUTHTYPE}; |
1463
|
|
|
|
|
|
|
|
1464
|
0
|
|
|
|
|
|
$self->send_action($action, $login_cb, $timeout); |
1465
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
} else { |
1467
|
0
|
0
|
|
|
|
|
if ($_[1]->{'COMPLETED'}) { |
1468
|
0
|
|
|
|
|
|
$self->_on_connect_err("$self->{CONFIG}->{AUTHTYPE} challenge failed"); |
1469
|
|
|
|
|
|
|
} else { |
1470
|
0
|
|
|
|
|
|
$self->_on_connect_err("Timed out waiting for challenge"); |
1471
|
|
|
|
|
|
|
} |
1472
|
|
|
|
|
|
|
|
1473
|
0
|
|
|
|
|
|
return; |
1474
|
|
|
|
|
|
|
} |
1475
|
0
|
|
|
|
|
|
}; |
1476
|
|
|
|
|
|
|
|
1477
|
|
|
|
|
|
|
#Send challenge |
1478
|
0
|
|
|
|
|
|
$self->send_action($challenge, $challenge_cb, $timeout); |
1479
|
|
|
|
|
|
|
} else { |
1480
|
|
|
|
|
|
|
#Plaintext login |
1481
|
0
|
|
|
|
|
|
$self->send_action($action, $login_cb, $timeout); |
1482
|
|
|
|
|
|
|
} |
1483
|
|
|
|
|
|
|
|
1484
|
0
|
|
|
|
|
|
return 1; |
1485
|
|
|
|
|
|
|
} |
1486
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
#Disconnect from the AMI If logged in will first issue a logoff |
1488
|
|
|
|
|
|
|
sub disconnect { |
1489
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
1490
|
|
|
|
|
|
|
|
1491
|
0
|
|
|
|
|
|
$self->destroy(); |
1492
|
|
|
|
|
|
|
|
1493
|
|
|
|
|
|
|
#No socket? No Problem. |
1494
|
0
|
|
|
|
|
|
return 1; |
1495
|
|
|
|
|
|
|
} |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
#Pops the topmost event out of the buffer and returns it Events are hash references |
1498
|
|
|
|
|
|
|
sub get_event { |
1499
|
0
|
|
|
0
|
0
|
|
my ($self, $timeout) = @_; |
1500
|
|
|
|
|
|
|
#my $timeout = $_[1]; |
1501
|
|
|
|
|
|
|
|
1502
|
0
|
0
|
|
|
|
|
$timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout); |
1503
|
|
|
|
|
|
|
|
1504
|
0
|
0
|
|
|
|
|
unless (defined $self->{EVENTBUFFER}->[0]) { |
1505
|
|
|
|
|
|
|
|
1506
|
0
|
|
|
|
|
|
my $process = AE::cv; |
1507
|
|
|
|
|
|
|
|
1508
|
0
|
|
|
0
|
|
|
$self->{CALLBACKS}->{'EVENT'}->{'cb'} = sub { $process->send($_[0]) }; |
|
0
|
|
|
|
|
|
|
1509
|
0
|
|
|
0
|
|
|
$self->{CALLBACKS}->{'EVENT'}->{'timeout'} = sub { warnings::warnif('Asterisk::AMI', "Timed out waiting for event"); $process->send(undef); }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
|
1511
|
0
|
0
|
|
|
|
|
$timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout); |
1512
|
|
|
|
|
|
|
|
1513
|
0
|
0
|
|
|
|
|
if ($timeout) { |
1514
|
|
|
|
|
|
|
|
1515
|
|
|
|
|
|
|
#Make sure event loop is up to date in case of sleeps |
1516
|
0
|
|
|
|
|
|
AE::now_update; |
1517
|
|
|
|
|
|
|
|
1518
|
0
|
|
|
|
|
|
$self->{CALLBACKS}->{'EVENT'}->{'timer'} = AE::timer $timeout, 0, $self->{CALLBACKS}->{'EVENT'}->{'timeout'}; |
1519
|
|
|
|
|
|
|
} |
1520
|
|
|
|
|
|
|
|
1521
|
0
|
|
|
|
|
|
return $process->recv; |
1522
|
|
|
|
|
|
|
} |
1523
|
|
|
|
|
|
|
|
1524
|
0
|
|
|
|
|
|
return shift @{$self->{EVENTBUFFER}}; |
|
0
|
|
|
|
|
|
|
1525
|
|
|
|
|
|
|
} |
1526
|
|
|
|
|
|
|
|
1527
|
|
|
|
|
|
|
#Returns server AMI version |
1528
|
|
|
|
|
|
|
sub amiver { |
1529
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
1530
|
0
|
|
|
|
|
|
return $self->{AMIVER}; |
1531
|
|
|
|
|
|
|
} |
1532
|
|
|
|
|
|
|
|
1533
|
|
|
|
|
|
|
#Checks the connection, returns 1 if the connection is good |
1534
|
|
|
|
|
|
|
sub connected { |
1535
|
0
|
|
|
0
|
0
|
|
my ($self, $timeout) = @_; |
1536
|
|
|
|
|
|
|
|
1537
|
0
|
0
|
0
|
|
|
|
if ($self && $self->simple_action({ Action => 'Ping'}, $timeout)) { |
1538
|
0
|
|
|
|
|
|
return 1; |
1539
|
|
|
|
|
|
|
} |
1540
|
|
|
|
|
|
|
|
1541
|
0
|
|
|
|
|
|
return 0; |
1542
|
|
|
|
|
|
|
} |
1543
|
|
|
|
|
|
|
|
1544
|
|
|
|
|
|
|
#Check whether there was an error on the socket |
1545
|
|
|
|
|
|
|
sub error { |
1546
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
1547
|
0
|
|
|
|
|
|
return $self->{SOCKERR}; |
1548
|
|
|
|
|
|
|
} |
1549
|
|
|
|
|
|
|
|
1550
|
|
|
|
|
|
|
#Sends a keep alive |
1551
|
|
|
|
|
|
|
sub _send_keepalive { |
1552
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
1553
|
|
|
|
|
|
|
#Weaken ref for use in anonysub |
1554
|
0
|
|
|
|
|
|
weaken($self); |
1555
|
|
|
|
|
|
|
my $cb = sub { |
1556
|
0
|
0
|
|
0
|
|
|
unless ($_[1]->{'GOOD'}) { |
1557
|
0
|
|
|
|
|
|
$self->_on_timeout("Asterisk failed to respond to keepalive - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}"); |
1558
|
|
|
|
|
|
|
}; |
1559
|
0
|
|
|
|
|
|
}; |
1560
|
|
|
|
|
|
|
|
1561
|
0
|
|
0
|
|
|
|
my $timeout = $self->{CONFIG}->{TIMEOUT} || 5; |
1562
|
|
|
|
|
|
|
|
1563
|
0
|
|
|
|
|
|
return $self->send_action({ Action => 'Ping' }, $cb, $timeout); |
1564
|
|
|
|
|
|
|
} |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
#Calls all callbacks as if they had timed out Used when an error has occured on the socket |
1567
|
|
|
|
|
|
|
sub _clear_cbs { |
1568
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
1569
|
|
|
|
|
|
|
|
1570
|
0
|
|
|
|
|
|
foreach my $id (keys %{$self->{CALLBACKS}}) { |
|
0
|
|
|
|
|
|
|
1571
|
0
|
|
|
|
|
|
my $response = $self->{RESPONSEBUFFER}->{$id}; |
1572
|
0
|
|
|
|
|
|
my $callback = $self->{CALLBACKS}->{$id}->{'cb'}; |
1573
|
0
|
|
|
|
|
|
my $store = $self->{CALLBACKS}->{$id}->{'store'}; |
1574
|
0
|
|
|
|
|
|
delete $self->{RESPONSEBUFFER}->{$id}; |
1575
|
0
|
|
|
|
|
|
delete $self->{CALLBACKS}->{$id}; |
1576
|
0
|
|
|
|
|
|
delete $self->{EXPECTED}->{$id}; |
1577
|
0
|
|
|
|
|
|
$callback->($self, $response, $store); |
1578
|
|
|
|
|
|
|
} |
1579
|
|
|
|
|
|
|
|
1580
|
0
|
|
|
|
|
|
return 1; |
1581
|
|
|
|
|
|
|
} |
1582
|
|
|
|
|
|
|
|
1583
|
|
|
|
|
|
|
#Cleans up |
1584
|
|
|
|
|
|
|
sub destroy { |
1585
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
1586
|
|
|
|
|
|
|
|
1587
|
0
|
|
|
|
|
|
$self->DESTROY; |
1588
|
|
|
|
|
|
|
|
1589
|
0
|
|
|
|
|
|
bless $self, "Asterisk::AMI::destroyed"; |
1590
|
|
|
|
|
|
|
|
1591
|
0
|
|
|
|
|
|
return 1; |
1592
|
|
|
|
|
|
|
} |
1593
|
|
|
|
|
|
|
|
1594
|
|
|
|
|
|
|
#Runs the AnyEvent loop |
1595
|
|
|
|
|
|
|
sub loop { |
1596
|
0
|
|
|
0
|
0
|
|
return AnyEvent->loop; |
1597
|
|
|
|
|
|
|
} |
1598
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
#Bye bye |
1600
|
|
|
|
|
|
|
sub DESTROY { |
1601
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
1602
|
|
|
|
|
|
|
|
1603
|
|
|
|
|
|
|
#Logoff if we are not in error |
1604
|
0
|
0
|
0
|
|
|
|
if (!$self->{SOCKERR} && $self->{LOGGEDIN}) { |
1605
|
0
|
|
|
|
|
|
$self->send_action({ Action => 'Logoff' }); |
1606
|
0
|
|
|
|
|
|
undef $self->{LOGGEDIN}; |
1607
|
|
|
|
|
|
|
} |
1608
|
|
|
|
|
|
|
|
1609
|
|
|
|
|
|
|
#Destroy our handle first to cause it to flush |
1610
|
0
|
0
|
|
|
|
|
if ($self->{handle}) { |
1611
|
0
|
|
|
|
|
|
$self->{handle}->destroy(); |
1612
|
|
|
|
|
|
|
} |
1613
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
#Do our own flushing |
1615
|
0
|
|
|
|
|
|
$self->_clear_cbs(); |
1616
|
|
|
|
|
|
|
|
1617
|
|
|
|
|
|
|
#Cleanup, remove everything |
1618
|
0
|
|
|
|
|
|
%{$self} = (); |
|
0
|
|
|
|
|
|
|
1619
|
|
|
|
|
|
|
|
1620
|
0
|
|
|
|
|
|
return 1; |
1621
|
|
|
|
|
|
|
} |
1622
|
|
|
|
|
|
|
|
1623
|
|
|
|
|
|
|
sub Asterisk::AMI::destroyed::AUTOLOAD { |
1624
|
|
|
|
|
|
|
#Everything Fails! |
1625
|
0
|
|
|
0
|
|
|
return; |
1626
|
|
|
|
|
|
|
} |
1627
|
|
|
|
|
|
|
|
1628
|
|
|
|
|
|
|
1; |