File Coverage

blib/lib/Asterisk/AMI.pm
Criterion Covered Total %
statement 30 449 6.6
branch 0 218 0.0
condition 0 38 0.0
subroutine 10 63 15.8
pod 1 15 6.6
total 41 783 5.2


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.8
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 ()
568              
569             Destroys the contents of all buffers and removes any current callbacks that are set.
570             Mostly used internally. Useful if you want to ensure that our IO handle watcher gets removed.
571             Gets called automatically when our object goes out of scope.
572              
573             loop ()
574              
575             Starts an event loop via AnyEvent.
576              
577             break ()
578              
579             Breaks/exits the current event loop. The program will continue from where the event loop was invoked.
580              
581             =head1 See Also
582              
583             AnyEvent, Asterisk::AMI::Common, Asterisk::AMI::Common::Dev
584              
585             =head1 AUTHOR
586              
587             Ryan Bullock (rrb3942@gmail.com)
588              
589             =head1 BUG REPORTING AND FEEDBACK
590              
591             Please report any bugs or errors to our github issue tracker at http://github.com/rrb3942/perl-Asterisk-AMI/issues or
592             the cpan request tracker at https://rt.cpan.org/Public/Bug/Report.html?Queue=perl-Asterisk-AMI
593              
594             =head1 LICENSE
595              
596             Copyright (C) 2011 by Ryan Bullock (rrb3942@gmail.com)
597              
598             This module is free software. You can redistribute it and/or modify it under the terms of the Artistic License 2.0.
599              
600             This program is distributed in the hope that it will be useful, but without any warranty; without even the implied
601             warranty of merchantability or fitness for a particular purpose.
602              
603             =cut
604              
605             package Asterisk::AMI;
606              
607             #Register warnings
608 1     1   13365 use warnings::register;
  1         1  
  1         98  
609              
610 1     1   3 use strict;
  1         1  
  1         15  
611 1     1   2 use warnings;
  1         3  
  1         17  
612              
613 1     1   938 use AnyEvent;
  1         3866  
  1         24  
614 1     1   631 use AnyEvent::Handle;
  1         14523  
  1         26  
615 1     1   538 use AnyEvent::Socket;
  1         10042  
  1         80  
616 1     1   5 use Digest::MD5;
  1         1  
  1         28  
617 1     1   3 use Scalar::Util qw/weaken/;
  1         1  
  1         58  
618 1     1   3 use Carp qw/carp/;
  1         1  
  1         34  
619              
620             #Duh
621 1     1   428 use version 0.77; our $VERSION = version->declare("v0.2.8");
  1         1332  
  1         4  
622              
623             #Used for storing events while reading command responses Events are stored as hashes in the array Example
624             #$self->{EVETNBUFFER}->{'Event'} = Something
625              
626             #Buffer for holding action responses and data
627             # Structure: $self->{RESPONSEBUFFER}->{'ActionID'}->{'Response'} = (Success|Failure|Follows|Goodbye|Pong|Etc..)
628             # //Reponse Status
629             # {'Message'} = Message //Message in the response {'EVENTS'} = [%hash1, %hash2, ..] //Arry
630             # of Hashes of parsed events and data for this actionID {'PARSED'} = { Hashkey => value,
631             # ...} {'COMPLETED'} = 0 or 1 //If the command is completed {'GOOD'} = 0 or 1 //if this
632             # responses is good, no error, can only be 1 if also COMPLETED
633              
634             #Create a new object and return it; If required options are missing, returns undef
635             sub new {
636 0     0 1   my ($class, %values) = @_;
637              
638 0           my $self = bless {}, $class;
639              
640             #Configure our new object and connect, else return undef
641 0 0 0       if ($self->_configure(%values) && $self->_connect()) {
642 0           return $self;
643             }
644              
645 0           return;
646             }
647              
648             #Used by anyevent to load our read type
649             sub anyevent_read_type {
650              
651 0     0 0   my ($hdl, $cb) = @_;
652              
653             return sub {
654 0 0   0     if ($hdl->{rbuf} =~ s/^(.+)(?:\015\012\015\012)//sox) {
655 0           $cb->($hdl, $1);
656             }
657              
658 0           return 0;
659             }
660 0           }
661              
662             #Sets variables for this object Also checks for minimum settings Returns 1 if everything was set, 0 if options were
663             #missing
664             sub _configure {
665 0     0     my ($self, %config) = @_;
666              
667             #Required settings
668 0           my @required = ( 'USERNAME', 'SECRET' );
669              
670             #Defaults
671 0           my %defaults = ( PEERADDR => '127.0.0.1',
672             PEERPORT => 5038,
673             AUTHTYPE => 'plaintext',
674             EVENTS => 'off',
675             BUFFERSIZE => 30000,
676             BLOCKING => 1
677             );
678              
679             #Create list of all options and acceptable values
680 0           my %config_options = ( ORIGINATEHACK => 'bool',
681             USESSL => 'bool',
682             PEERADDR => '',
683             PEERPORT => 'num',
684             USERNAME => '',
685             SECRET => '',
686             EVENTS => '',
687             TIMEOUT => 'num',
688             KEEPALIVE => 'num',
689             TCP_KEEPALIVE => 'bool',
690             BUFFERSIZE => 'num',
691             HANDLERS => 'HASH',
692             BLOCKING => 'bool',
693             AUTHTYPE => 'md5|plaintext',
694             ON_CONNECT => 'CODE',
695             ON_CONNECT_ERR => 'CODE',
696             ON_ERROR => 'CODE',
697             ON_DISCONNECT => 'CODE',
698             ON_TIMEOUT => 'CODE'
699             );
700              
701             #Config Validation + Setting
702 0           while (my ($key, $val) = each(%config)) {
703 0           my $opt = uc($key);
704              
705             #Unknown keys
706 0 0         if (!exists $config_options{$opt}) {
    0          
707 0 0         carp "Unknown constructor option: $key" if warnings::enabled('Asterisk::AMI');
708 0           next;
709             #Undef values
710             } elsif (!defined $val) {
711 0           next;
712             }
713              
714             #Check for correct reference types
715 0 0         if (ref($val) ne $config_options{$opt}) {
    0          
716              
717             #If they are ref types then fail
718 0 0         if ($config_options{$opt} eq 'CODE') {
    0          
719 0 0         carp "Constructor option \'$key\' requires an anonymous subroutine or a subroutine reference" if warnings::enabled('Asterisk::AMI');
720 0           return;
721             } elsif ($config_options{$opt} eq 'HASH') {
722 0 0         carp "Constructor option \'$key\' requires a hash reference" if warnings::enabled('Asterisk::AMI');
723 0           return;
724             }
725              
726             #Boolean values
727 0 0         if ($config_options{$opt} eq 'bool') {
    0          
728 0 0 0       if ($val =~ /[^\d]/x || ($val != 0 && $val != 1)) {
      0        
729 0 0         carp "Constructor option \'$key\' requires a boolean value (0 or 1)" if warnings::enabled('Asterisk::AMI');
730 0           return;
731             }
732             #Numeric values
733             } elsif ($config_options{$opt} eq 'num') {
734 0 0         if ($val =~ /[^\d]/x) {
735 0 0         carp "Constructor option \'$key\' requires a numeric value" if warnings::enabled('Asterisk::AMI');
736 0           return;
737             }
738             #Hard coded list of options
739             } else {
740 0           my $lval = lc($val);
741              
742 0           my @match = grep { $lval eq $_ } split /\|/x,$config_options{$opt};
  0            
743              
744 0 0         if (!@match) {
745 0 0         carp "Constructor option \'$key\' requires one of the following options: $config_options{$opt}" if warnings::enabled('Asterisk::AMI');
746 0           return;
747             } else {
748             #lowercase it for consistency
749 0           $val = $lval;
750             }
751             }
752              
753             #Ensure all handlers are sub refs
754             } elsif ($opt eq 'HANDLERS') {
755 0           while (my ($event, $handler) = each %{$val}) {
  0            
756 0 0         if (ref($handler) ne 'CODE') {
757 0 0         carp "Handler for event type \'$event\' must be an anonymous subroutine or a subroutine reference" if warnings::enabled('Asterisk::AMI');
758 0           return;
759             }
760             }
761             }
762              
763 0           $self->{CONFIG}->{$opt} = $val;
764             }
765              
766              
767             #Check for required options
768 0           foreach my $req (@required) {
769 0 0         if (!exists $self->{CONFIG}->{$req}) {
770 0 0         carp "Must supply a username and secret for connecting to asterisk" if warnings::enabled('Asterisk::AMI');
771 0           return;
772             }
773             }
774              
775             #Change default port if using ssl
776 0 0         if ($self->{CONFIG}->{USESSL}) {
777 0           $defaults{PEERPORT} = 5039;
778             }
779              
780             #Assign defaults for any missing options
781 0           while (my ($opt, $val) = each(%defaults)) {
782 0 0         if (!defined $self->{CONFIG}->{$opt}) {
783 0           $self->{CONFIG}->{$opt} = $val;
784             }
785             }
786              
787             #Make adjustments for Originate Async bullscrap
788 0 0         if ($self->{CONFIG}->{ORIGINATEHACK}) {
789             #Turn on call events, otherwise we wont get the Async response
790 0 0         if (lc($self->{CONFIG}->{EVENTS}) eq 'off') {
    0          
791 0           $self->{CONFIG}->{EVENTS} = 'call';
792             #Fake event type so that we will discard events, else by turning on events our event buffer
793             #Will just continue to fill up.
794 0 0   0     $self->{CONFIG}->{HANDLERS} = { 'JUSTMAKETHEHASHNOTEMPTY' => sub {} } unless ($self->{CONFIG}->{HANDLERS});
795             #They already turned events on, just add call types to it, assume they are doing something with events
796             #and don't mess with the handlers
797             } elsif (lc($self->{CONFIG}->{EVENTS}) !~ /on|call/x) {
798 0           $self->{CONFIG}->{EVENTS} .= ',call';
799             }
800             }
801              
802             #Initialize the seq number
803 0           $self->{idseq} = 1;
804              
805             #Weaken reference for use in anonsub
806 0           weaken($self);
807              
808             #Set keepalive
809 0 0   0     $self->{CONFIG}->{KEEPALIVE} = AE::timer($self->{CONFIG}->{KEEPALIVE}, $self->{CONFIG}->{KEEPALIVE}, sub { $self->_send_keepalive }) if ($self->{CONFIG}->{KEEPALIVE});
  0            
810            
811 0           return 1;
812             }
813              
814             #Handles connection failures (includes login failure);
815             sub _on_connect_err {
816              
817 0     0     my ($self, $message) = @_;
818              
819 0           warnings::warnif('Asterisk::AMI', "Failed to connect to asterisk - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
820 0           warnings::warnif('Asterisk::AMI', "Error Message: $message");
821              
822             #Dispatch all callbacks as if they timed out
823 0           $self->_clear_cbs();
824              
825 0 0         if (exists $self->{CONFIG}->{ON_CONNECT_ERR}) {
    0          
826 0           $self->{CONFIG}->{ON_CONNECT_ERR}->($self, $message);
827             } elsif (exists $self->{CONFIG}->{ON_ERROR}) {
828 0           $self->{CONFIG}->{ON_ERROR}->($self, $message);
829             }
830              
831 0           $self->{SOCKERR} = 1;
832              
833 0           $self->destroy();
834              
835 0           return;
836             }
837              
838             #Handles other errors on the socket
839             sub _on_error {
840              
841 0     0     my ($self, $message) = @_;
842              
843 0           warnings::warnif('Asterisk::AMI', "Received Error on socket - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
844 0           warnings::warnif('Asterisk::AMI', "Error Message: $message");
845            
846             #Call all cbs as if they had timed out
847 0           $self->_clear_cbs();
848              
849 0 0         $self->{CONFIG}->{ON_ERROR}->($self, $message) if (exists $self->{CONFIG}->{ON_ERROR});
850            
851 0           $self->{SOCKERR} = 1;
852              
853 0           $self->destroy();
854              
855 0           return;
856             }
857              
858             #Handles the remote end disconnecting
859             sub _on_disconnect {
860              
861 0     0     my ($self) = @_;
862              
863 0           my $message = "Remote end disconnected - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}";
864 0           warnings::warnif('Asterisk::AMI', "Remote Asterisk Server ended connection - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
865              
866             #Call all callbacks as if they had timed out
867 0           _
868             $self->_clear_cbs();
869              
870 0 0         if (exists $self->{CONFIG}->{ON_DISCONNECT}) {
    0          
871 0           $self->{CONFIG}->{ON_DISCONNECT}->($self, $message);
872             } elsif (exists $self->{CONFIG}->{ON_ERROR}) {
873 0           $self->{CONFIG}->{ON_ERROR}->($self, $message);
874             }
875              
876 0           $self->{SOCKERR} = 1;
877              
878 0           $self->destroy();
879              
880 0           return;
881             }
882              
883             #What happens if our keep alive times out
884             sub _on_timeout {
885 0     0     my ($self, $message) = @_;
886              
887 0           warnings::warnif('Asterisk::AMI', $message);
888              
889 0 0         if (exists $self->{CONFIG}->{ON_TIMEOUT}) {
    0          
890 0           $self->{CONFIG}->{ON_TIMEOUT}->($self, $message);
891             } elsif (exists $self->{CONFIG}->{ON_ERROR}) {
892 0           $self->{CONFIG}->{ON_ERROR}->($self, $message);
893             }
894              
895 0           $self->{SOCKERR} = 1;
896              
897 0           return;
898             }
899              
900             #Things to do after our initial connect
901             sub _on_connect {
902              
903 0     0     my ($self, $fh, $line) = @_;
904              
905 0 0         if ($line =~ /^Asterisk\ Call\ Manager\/([0-9]\.[0-9])$/ox) {
906 0           $self->{AMIVER} = $1;
907             } else {
908 0           warnings::warnif('Asterisk::AMI', "Unknown Protocol/AMI Version from $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
909             }
910              
911             #Weak reference for us in anonysub
912 0           weaken($self);
913              
914 0     0     $self->{handle}->push_read( 'Asterisk::AMI' => sub { $self->_handle_packet(@_); } );
  0            
915              
916 0           return 1;
917             }
918              
919             #Connects to the AMI Returns 1 on success, 0 on failure
920             sub _connect {
921 0     0     my ($self) = @_;
922              
923             #Weaken ref for use in anonysub
924 0           weaken($self);
925              
926             #Build a hash of our anyevent::handle options
927             my %hdl = ( connect => [$self->{CONFIG}->{PEERADDR} => $self->{CONFIG}->{PEERPORT}],
928 0     0     on_connect_err => sub { $self->_on_connect_err($_[1]); },
929 0     0     on_error => sub { $self->_on_error($_[2]) },
930 0     0     on_eof => sub { $self->_on_disconnect; },
931 0     0     on_connect => sub { $self->{handle}->push_read( line => sub { $self->_on_connect(@_); } ); });
  0            
  0            
932              
933             #TLS stuff
934 0 0         $hdl{'tls'} = 'connect' if ($self->{CONFIG}->{USESSL});
935             #TCP Keepalive
936 0 0         $hdl{'keeplive'} = 1 if ($self->{CONFIG}->{TCP_KEEPALIVE});
937              
938             #Make connection/create handle
939 0           $self->{handle} = AnyEvent::Handle->new(%hdl);
940              
941             #Return login status if blocking
942 0 0         return $self->_login if ($self->{CONFIG}->{BLOCKING});
943              
944             #Queue our login
945 0           $self->_login;
946              
947             #If we have a handle, SUCCESS!
948 0 0         return 1 if (defined $self->{handle});
949              
950 0           return;
951             }
952              
953             sub _handle_packet {
954 0     0     my ($self, $hdl, $buffer) = @_;
955              
956 0           foreach my $packet (split /\015\012\015\012/ox, $buffer) {
957 0           my %parsed;
958              
959 0           foreach my $line (split /\015\012/ox, $packet) {
960             #Is this our command output?
961 0 0         if ($line =~ s/--END\ COMMAND--$//ox) {
962 0           $parsed{'COMPLETED'} = 1;
963              
964 0           push(@{$parsed{'CMD'}},split(/\x20*\x0A/ox, $line));
  0            
965             } else {
966             #Regular output, split on :\
967 0           my ($key, $value) = split /:\ /x, $line, 2;
968              
969 0           $parsed{$key} = $value;
970              
971             }
972             }
973              
974             #Dispatch depending on packet type
975 0 0         if (exists $parsed{'ActionID'}) {
    0          
976 0           $self->_handle_action(\%parsed);
977             } elsif (exists $parsed{'Event'}) {
978 0           $self->_handle_event(\%parsed);
979             }
980             }
981              
982 0           return 1;
983             }
984              
985             #Used once and action completes
986             #Determines goodness and performs any oustanding callbacks
987             sub _action_complete {
988 0     0     my ($self, $actionid) = @_;
989              
990             #Determine 'Goodness'
991 0 0 0       if (defined $self->{RESPONSEBUFFER}->{$actionid}->{'Response'}
992             && $self->{RESPONSEBUFFER}->{$actionid}->{'Response'} =~ /^(?:Success|Follows|Goodbye|Events Off|Pong)$/ox) {
993 0           $self->{RESPONSEBUFFER}->{$actionid}->{'GOOD'} = 1;
994             }
995              
996             #Do callback and cleanup if callback exists
997 0 0         if (defined $self->{CALLBACKS}->{$actionid}->{'cb'}) {
998             #Stuff needed to process callback
999 0           my $callback = $self->{CALLBACKS}->{$actionid}->{'cb'};
1000 0           my $response = $self->{RESPONSEBUFFER}->{$actionid};
1001 0           my $store = $self->{CALLBACKS}->{$actionid}->{'store'};
1002              
1003             #cleanup
1004 0           delete $self->{RESPONSEBUFFER}->{$actionid};
1005 0           delete $self->{CALLBACKS}->{$actionid};
1006              
1007             #Delete Originate Async bullshit
1008 0           delete $response->{'ASYNC'};
1009              
1010 0           $callback->($self, $response, $store);
1011             }
1012              
1013 0           return 1;
1014             }
1015              
1016             #Handles proccessing and callbacks for action responses
1017             sub _handle_action {
1018 0     0     my ($self, $packet) = @_;
1019              
1020             #Snag our actionid
1021 0           my $actionid = $packet->{'ActionID'};
1022              
1023             #Discard Unknown ActionIDs
1024 0 0         return unless ($self->{EXPECTED}->{$actionid});
1025              
1026             #Event responses
1027 0 0         if (exists $packet->{'Event'}) {
    0          
1028             #EventCompleted Event?
1029 0 0         if ($packet->{'Event'} =~ /[cC]omplete/ox) {
1030 0           $self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'} = 1;
1031             } else {
1032             #DBGetResponse and Originate Async Exceptions
1033 0 0 0       if ($packet->{'Event'} eq 'DBGetResponse' || $packet->{'Event'} eq 'OriginateResponse') {
1034 0           $self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'} = 1;
1035             }
1036            
1037             #To the buffer
1038 0           push(@{$self->{RESPONSEBUFFER}->{$actionid}->{'EVENTS'}}, $packet);
  0            
1039             }
1040             #Response packets
1041             } elsif (exists $packet->{'Response'}) {
1042             #If No indication of future packets, mark as completed
1043 0 0         if ($packet->{'Response'} ne 'Follows') {
1044             #Originate Async Exception is the first test
1045 0 0 0       if (!$self->{RESPONSEBUFFER}->{$actionid}->{'ASYNC'}
      0        
1046             && (!exists $packet->{'Message'} || $packet->{'Message'} !~ /[fF]ollow/ox)) {
1047 0           $self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'} = 1;
1048             }
1049             }
1050              
1051             #Copy the response into the buffer
1052 0           foreach (keys %{$packet}) {
  0            
1053 0 0         if ($_ =~ /^(?:Response|Message|ActionID|Privilege|CMD|COMPLETED)$/ox) {
1054 0           $self->{RESPONSEBUFFER}->{$actionid}->{$_} = $packet->{$_};
1055             } else {
1056 0           $self->{RESPONSEBUFFER}->{$actionid}->{'PARSED'}->{$_} = $packet->{$_};
1057             }
1058             }
1059             }
1060            
1061 0 0         if ($self->{RESPONSEBUFFER}->{$actionid}->{'COMPLETED'}) {
1062             #This aciton is finished do not accept any more packets for it
1063 0           delete $self->{EXPECTED}->{$actionid};
1064              
1065             #Determine goodness, do callback
1066 0           $self->_action_complete($actionid);
1067             }
1068              
1069 0           return 1;
1070             }
1071              
1072             #Handles proccessing and callbacks for 'Event' packets
1073             sub _handle_event {
1074 0     0     my ($self, $event) = @_;
1075              
1076             #If handlers were configured just dispatch, don't buffer
1077 0 0         if ($self->{CONFIG}->{HANDLERS}) {
1078 0 0         if (exists $self->{CONFIG}->{HANDLERS}->{$event->{'Event'}}) {
    0          
1079 0           $self->{CONFIG}->{HANDLERS}->{$event->{'Event'}}->($self, $event);
1080             } elsif (exists $self->{CONFIG}->{HANDLERS}->{'default'}) {
1081 0           $self->{CONFIG}->{HANDLERS}->{'default'}->($self, $event);
1082             }
1083             } else {
1084             #Someone is waiting on this packet, don't bother buffering
1085 0 0         if (exists $self->{CALLBACKS}->{'EVENT'}) {
1086 0           $self->{CALLBACKS}->{'EVENT'}->{'cb'}->($event);
1087 0           delete $self->{CALLBACKS}->{'EVENT'};
1088             #Save for later
1089             } else {
1090 0           push(@{$self->{EVENTBUFFER}}, $event);
  0            
1091             }
1092             }
1093              
1094 0           return 1;
1095             }
1096              
1097             #This is used to provide blocking behavior for calls It installs callbacks for an action if it is not in the buffer
1098             #and waits for the response before returning it.
1099             sub _wait_response {
1100 0     0     my ($self, $id, $timeout) = @_;
1101              
1102             #Already got it?
1103 0 0         if ($self->{RESPONSEBUFFER}->{$id}->{'COMPLETED'}) {
1104 0           my $resp = $self->{RESPONSEBUFFER}->{$id};
1105 0           delete $self->{RESPONSEBUFFER}->{$id};
1106 0           delete $self->{CALLBACKS}->{$id};
1107 0           delete $self->{EXPECTED}->{$id};
1108 0           return $resp;
1109             }
1110              
1111             #Don't Have it, wait for it Install some handlers and use a CV to simulate blocking
1112 0           my $process = AE::cv;
1113              
1114 0     0     $self->{CALLBACKS}->{$id}->{'cb'} = sub { $process->send($_[1]) };
  0            
1115 0 0         $timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout);
1116              
1117             #Should not need to weaken here because this is a blocking call Only outcomes can be error, timeout, or
1118             #complete, all of which will finish the cb and clear the reference weaken($self)
1119              
1120 0 0         if ($timeout) {
1121             $self->{CALLBACKS}->{$id}->{'timeout'} = sub {
1122 0     0     my $response = $self->{'RESPONSEBUFFER'}->{$id};
1123 0           delete $self->{RESPONSEBUFFER}->{$id};
1124 0           delete $self->{CALLBACKS}->{$id};
1125 0           delete $self->{EXPECTED}->{$id};
1126 0           $process->send($response);
1127 0           };
1128              
1129             #Make sure event loop is up to date in case of sleeps
1130 0           AE::now_update;
1131              
1132 0           $self->{CALLBACKS}->{$id}->{'timer'} = AE::timer $timeout, 0, $self->{CALLBACKS}->{$id}->{'timeout'};
1133             }
1134              
1135 0           return $process->recv;
1136             }
1137              
1138             sub _build_action {
1139 0     0     my ($actionhash, $id) = @_;
1140              
1141 0           my $action;
1142             my $async;
1143 0           my $callback;
1144 0           my $timeout;
1145              
1146             #Create an action out of a hash
1147 0           while (my ($key, $value) = each(%{$actionhash})) {
  0            
1148              
1149 0           my $lkey = lc($key);
1150              
1151             #Callbacks
1152 0 0 0       if ($key eq 'CALLBACK') {
    0          
    0          
    0          
1153 0 0         carp "Use of the CALLBACK key in an action is deprecated and will be removed in a future release.\n",
1154             "Please use the syntax that is available." if warnings::enabled('Asterisk::AMI');
1155              
1156 0 0         $callback = $actionhash->{$key} unless (defined $callback);
1157 0           next;
1158             #Timeout
1159             } elsif ($key eq 'TIMEOUT') {
1160 0 0         carp "Use of the TIMEOUT key in an action is deprecated and will be removed in a future release\n",
1161             "Please use the syntax that is available." if warnings::enabled('Asterisk::AMI');
1162              
1163 0 0         $timeout = $actionhash->{$key} unless (defined $timeout);
1164 0           next;
1165             #Exception of Orignate Async
1166             } elsif ($lkey eq 'async' && $value == 1) {
1167 0           $async = 1;
1168             #Clean out user ActionIDs
1169             } elsif ($lkey eq 'actionid') {
1170 0 0         carp "User supplied ActionID being ignored." if warnings::enabled('Asterisk::AMI');
1171 0           next;
1172             }
1173              
1174             #Handle multiple values
1175 0 0         if (ref($value) eq 'ARRAY') {
1176 0           foreach my $var (@{$value}) {
  0            
1177 0           $action .= $key . ': ' . $var . "\015\012";
1178             }
1179             } else {
1180 0           $action .= $key . ': ' . $value . "\015\012";
1181             }
1182             }
1183              
1184             #Append ActionID and End Command
1185 0           $action .= 'ActionID: ' . $id . "\015\012\015\012";
1186              
1187 0           return ($action, $async, $callback, $timeout);
1188             }
1189              
1190             #Sends an action to the AMI Accepts an Array Returns the actionid of the action
1191             sub send_action {
1192 0     0 0   my ($self, $actionhash, $callback, $timeout, $store) = @_;
1193              
1194             #No connection
1195 0 0         return unless ($self->{handle});
1196              
1197             #resets id number
1198 0 0         if ($self->{idseq} > $self->{CONFIG}->{BUFFERSIZE}) {
1199 0           $self->{idseq} = 1;
1200             }
1201              
1202 0           my $id = $self->{idseq}++;
1203              
1204             #Store the Action ID
1205 0           $self->{lastid} = $id;
1206              
1207             #Delete anything that might be in the buffer
1208 0           delete $self->{RESPONSEBUFFER}->{$id};
1209 0           delete $self->{CALLBACKS}->{$id};
1210              
1211 0           my ($action, $hcb, $htimeout);
1212              
1213 0           ($action, $self->{RESPONSEBUFFER}->{$id}->{'ASYNC'}, $hcb, $htimeout) = _build_action($actionhash, $id);
1214              
1215 0 0         $callback = $hcb unless (defined $callback);
1216 0 0         $timeout = $htimeout unless (defined $timeout);
1217              
1218 0 0 0       if ($self->{LOGGEDIN} || lc($actionhash->{'Action'}) =~ /login|challenge/x) {
1219 0           $self->{handle}->push_write($action);
1220             } else {
1221 0           $self->{PRELOGIN}->{$id} = $action;
1222             }
1223              
1224 0           $self->{RESPONSEBUFFER}->{$id}->{'COMPLETED'} = 0;
1225 0           $self->{RESPONSEBUFFER}->{$id}->{'GOOD'} = 0;
1226 0           $self->{EXPECTED}->{$id} = 1;
1227              
1228             #Weaken ref of use in anonsub
1229 0           weaken($self);
1230              
1231             #Set default timeout if needed
1232 0 0         $timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout);
1233              
1234             #Setup callback
1235 0 0         if (defined $callback) {
1236             #Set callback if defined
1237 0           $self->{CALLBACKS}->{$id}->{'cb'} = $callback;
1238             #Variable to return with Callback
1239 0           $self->{CALLBACKS}->{$id}->{'store'} = $store;
1240             }
1241              
1242             #Start timer for timeouts
1243 0 0 0       if ($timeout && defined $self->{CALLBACKS}->{$id}) {
1244             $self->{CALLBACKS}->{$id}->{'timeout'} = sub {
1245 0     0     my $response = $self->{RESPONSEBUFFER}->{$id};
1246 0           my $cb = $self->{CALLBACKS}->{$id}->{'cb'};
1247 0           my $st = $self->{CALLBACKS}->{$id}->{'store'};
1248 0           delete $self->{RESPONSEBUFFER}->{$id};
1249 0           delete $self->{CALLBACKS}->{$id};
1250 0           delete $self->{EXPECTED}->{$id};
1251 0           delete $self->{PRELOGIN}->{$id};
1252 0           $cb->($self, $response, $st);;
1253 0           };
1254 0           $self->{CALLBACKS}->{$id}->{'timer'} = AE::timer $timeout, 0, $self->{CALLBACKS}->{$id}->{'timeout'};
1255             }
1256              
1257 0           return $id;
1258             }
1259              
1260             #Checks for a response to an action If no actionid is given uses last actionid sent Returns 1 if action success, 0 if
1261             #failure
1262             sub check_response {
1263 0     0 0   my ($self, $actionid, $timeout) = @_;
1264              
1265             #Check if an actionid was passed, else us last
1266 0 0         $actionid = $self->{lastid} unless (defined $actionid);
1267              
1268 0           my $resp = $self->_wait_response($actionid, $timeout);
1269              
1270 0 0         if ($resp->{'COMPLETED'}) {
1271 0           return $resp->{'GOOD'};
1272             }
1273              
1274 0           return;
1275             }
1276              
1277             #Returns the Action with all command data and event Actions are hash references If an actionid is specified returns
1278             #that action, otherwise uses last actionid sent Removes the event from the buffer
1279             sub get_response {
1280 0     0 0   my ($self, $actionid, $timeout) = @_;
1281              
1282             #Check if an actionid was passed, else us last
1283 0 0         $actionid = $self->{lastid} unless (defined $actionid);
1284              
1285             #Wait for the action to complete
1286 0           my $resp = $self->_wait_response($actionid, $timeout);
1287            
1288 0 0         if ($resp->{'COMPLETED'}) {
1289 0           return $resp;
1290             }
1291              
1292 0           return;
1293             }
1294              
1295             #Sends an action and returns its data or undef if the command failed
1296             sub action {
1297 0     0 0   my ($self, $action, $timeout) = @_;
1298            
1299             #Send action
1300 0           my $actionid = $self->send_action($action);
1301 0 0         if (defined $actionid) {
1302             #Get response
1303 0           return $self->get_response($actionid, $timeout);
1304             }
1305              
1306 0           return;
1307             }
1308              
1309             #Sends an action and returns 1 if it was successful and 0 if it failed
1310             sub simple_action {
1311 0     0 0   my ($self, $action, $timeout) = @_;
1312              
1313             #Send action
1314 0           my $actionid = $self->send_action($action);
1315              
1316 0 0         if (defined $actionid) {
1317 0           my $resp = $self->_wait_response($actionid, $timeout);
1318 0 0         if ($resp->{'COMPLETED'}) {
1319 0           return $resp->{'GOOD'};
1320             }
1321             }
1322              
1323 0           return;
1324             }
1325              
1326             #Calculate md5 response to channel
1327             sub _md5_resp {
1328 0     0     my ($self, $challenge) = @_;
1329              
1330 0           my $md5 = Digest::MD5->new();
1331              
1332 0           $md5->add($challenge);
1333 0           $md5->add($self->{CONFIG}->{SECRET});
1334              
1335 0           return $md5->hexdigest;
1336             }
1337              
1338             #Logs into the AMI
1339             sub _login {
1340 0     0     my ($self) = @_;
1341              
1342             #Auth challenge
1343 0           my %challenge;
1344              
1345             #Timeout to use
1346             my $timeout;
1347 0 0         $timeout = 5 unless ($self->{CONFIG}->{TIMEOUT});
1348            
1349             #Build login action
1350             my %action = ( Action => 'login',
1351             Username => $self->{CONFIG}->{USERNAME},
1352 0           Events => $self->{CONFIG}->{EVENTS} );
1353              
1354             #Actions to take for different authtypes
1355 0 0         if (lc($self->{CONFIG}->{AUTHTYPE}) eq 'md5') {
1356             #Do a challenge
1357             %challenge = ( Action => 'Challenge',
1358 0           AuthType => $self->{CONFIG}->{AUTHTYPE});
1359             } else {
1360 0           $action{'Secret'} = $self->{CONFIG}->{SECRET};
1361             }
1362              
1363             #Blocking connect
1364 0 0         if ($self->{CONFIG}->{BLOCKING}) {
1365 0           return $self->_login_block(\%action, \%challenge, $timeout);
1366             } else {
1367 0           return $self->_login_noblock(\%action, \%challenge, $timeout);
1368             }
1369              
1370 0           return;
1371             }
1372              
1373             #Checks loging responses, prints errors
1374             sub _logged_in {
1375 0     0     my ($self, $login) = @_;
1376              
1377 0 0         if ($login->{'GOOD'}) {
1378             #Login was good
1379 0           $self->{LOGGEDIN} = 1;
1380              
1381 0 0         $self->{CONFIG}->{ON_CONNECT}->($self) if ($self->{CONFIG}->{ON_CONNECT});
1382              
1383             #Flush pre-login buffer
1384 0           foreach (values %{$self->{PRELOGIN}}) {
  0            
1385 0           $self->{handle}->push_write($_);
1386             }
1387              
1388 0           delete $self->{PRELOGIN};
1389              
1390 0           return 1;
1391             } else {
1392             #Login failed
1393 0 0         if ($login->{'COMPLETED'}) {
1394 0           $self->_on_connect_err("Login Failed to Asterisk (bad auth) at $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
1395             } else {
1396 0           $self->_on_connect_err("Login Failed to Asterisk due to timeout at $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
1397             }
1398              
1399 0           return;
1400             }
1401              
1402 0           return;
1403             }
1404              
1405             #Blocking Login
1406             sub _login_block {
1407 0     0     my ($self, $action, $challenge, $timeout) = @_;
1408              
1409 0           my $resp;
1410              
1411             #If a challenge exists do handle it first before the login
1412 0 0         if (%{$challenge}) {
  0            
1413              
1414             #Get challenge response
1415 0           my $chresp = $self->action($challenge,$timeout);
1416              
1417 0 0         if ($chresp->{'GOOD'}) {
1418              
1419 0           $action->{'Key'} = $self->_md5_resp($chresp->{'PARSED'}->{'Challenge'}, $self->{CONFIG}->{SECRET});
1420 0           $action->{'AuthType'} = $self->{CONFIG}->{AUTHTYPE};
1421              
1422             #Login
1423 0           $resp = $self->action($action, $timeout);
1424            
1425             } else {
1426             #Challenge Failed
1427 0 0         if ($chresp->{'COMPLETED'}) {
1428 0           $self->_on_connect_err("$self->{CONFIG}->{AUTHTYPE} challenge failed");
1429             } else {
1430 0           $self->_on_connect_err("Timed out waiting for challenge");
1431             }
1432              
1433 0           return;
1434             }
1435             } else {
1436             #Plaintext login
1437 0           $resp = $self->action($action, $timeout);
1438             }
1439              
1440 0           return $self->_logged_in($resp);
1441             }
1442              
1443             #Non-blocking login
1444             sub _login_noblock {
1445 0     0     my ($self, $action, $challenge, $timeout) = @_;
1446              
1447             #Weaken ref for use in anonsub
1448 0           weaken($self);
1449              
1450             #Callback for login action
1451 0     0     my $login_cb = sub { $self->_logged_in($_[1]) };
  0            
1452              
1453             #Do a md5 challenge
1454 0 0         if (%{$challenge}) {
  0            
1455             #Create callbacks for the challenge
1456             my $challenge_cb = sub {
1457 0 0   0     if ($_[1]->{'GOOD'}) {
1458 0           my $md5 = Digest::MD5->new();
1459              
1460 0           $md5->add($_[1]->{'PARSED'}->{'Challenge'});
1461 0           $md5->add($self->{CONFIG}->{SECRET});
1462              
1463 0           $md5 = $md5->hexdigest;
1464              
1465 0           $action->{'Key'} = $md5;
1466 0           $action->{'AuthType'} = $self->{CONFIG}->{AUTHTYPE};
1467              
1468 0           $self->send_action($action, $login_cb, $timeout);
1469            
1470             } else {
1471 0 0         if ($_[1]->{'COMPLETED'}) {
1472 0           $self->_on_connect_err("$self->{CONFIG}->{AUTHTYPE} challenge failed");
1473             } else {
1474 0           $self->_on_connect_err("Timed out waiting for challenge");
1475             }
1476              
1477 0           return;
1478             }
1479 0           };
1480              
1481             #Send challenge
1482 0           $self->send_action($challenge, $challenge_cb, $timeout);
1483             } else {
1484             #Plaintext login
1485 0           $self->send_action($action, $login_cb, $timeout);
1486             }
1487              
1488 0           return 1;
1489             }
1490              
1491             #Disconnect from the AMI If logged in will first issue a logoff
1492             sub disconnect {
1493 0     0 0   my ($self) = @_;
1494              
1495 0           $self->destroy();
1496              
1497             #No socket? No Problem.
1498 0           return 1;
1499             }
1500              
1501             #Pops the topmost event out of the buffer and returns it Events are hash references
1502             sub get_event {
1503 0     0 0   my ($self, $timeout) = @_;
1504             #my $timeout = $_[1];
1505              
1506 0 0         $timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout);
1507              
1508 0 0         unless (defined $self->{EVENTBUFFER}->[0]) {
1509              
1510 0           my $process = AE::cv;
1511              
1512 0     0     $self->{CALLBACKS}->{'EVENT'}->{'cb'} = sub { $process->send($_[0]) };
  0            
1513 0     0     $self->{CALLBACKS}->{'EVENT'}->{'timeout'} = sub { warnings::warnif('Asterisk::AMI', "Timed out waiting for event"); $process->send(undef); };
  0            
  0            
1514              
1515 0 0         $timeout = $self->{CONFIG}->{TIMEOUT} unless (defined $timeout);
1516              
1517 0 0         if ($timeout) {
1518              
1519             #Make sure event loop is up to date in case of sleeps
1520 0           AE::now_update;
1521              
1522 0           $self->{CALLBACKS}->{'EVENT'}->{'timer'} = AE::timer $timeout, 0, $self->{CALLBACKS}->{'EVENT'}->{'timeout'};
1523             }
1524              
1525 0           return $process->recv;
1526             }
1527              
1528 0           return shift @{$self->{EVENTBUFFER}};
  0            
1529             }
1530              
1531             #Returns server AMI version
1532             sub amiver {
1533 0     0 0   my ($self) = @_;
1534 0           return $self->{AMIVER};
1535             }
1536              
1537             #Checks the connection, returns 1 if the connection is good
1538             sub connected {
1539 0     0 0   my ($self, $timeout) = @_;
1540            
1541 0 0 0       if ($self && $self->simple_action({ Action => 'Ping'}, $timeout)) {
1542 0           return 1;
1543             }
1544              
1545 0           return 0;
1546             }
1547              
1548             #Check whether there was an error on the socket
1549             sub error {
1550 0     0 0   my ($self) = @_;
1551 0           return $self->{SOCKERR};
1552             }
1553              
1554             #Sends a keep alive
1555             sub _send_keepalive {
1556 0     0     my ($self) = @_;
1557             #Weaken ref for use in anonysub
1558 0           weaken($self);
1559             my $cb = sub {
1560 0 0   0     unless ($_[1]->{'GOOD'}) {
1561 0           $self->_on_timeout("Asterisk failed to respond to keepalive - $self->{CONFIG}->{PEERADDR}:$self->{CONFIG}->{PEERPORT}");
1562             };
1563 0           };
1564              
1565 0   0       my $timeout = $self->{CONFIG}->{TIMEOUT} || 5;
1566            
1567 0           return $self->send_action({ Action => 'Ping' }, $cb, $timeout);
1568             }
1569              
1570             #Calls all callbacks as if they had timed out Used when an error has occured on the socket
1571             sub _clear_cbs {
1572 0     0     my ($self) = @_;
1573              
1574 0           foreach my $id (keys %{$self->{CALLBACKS}}) {
  0            
1575 0           my $response = $self->{RESPONSEBUFFER}->{$id};
1576 0           my $callback = $self->{CALLBACKS}->{$id}->{'cb'};
1577 0           my $store = $self->{CALLBACKS}->{$id}->{'store'};
1578 0           delete $self->{RESPONSEBUFFER}->{$id};
1579 0           delete $self->{CALLBACKS}->{$id};
1580 0           delete $self->{EXPECTED}->{$id};
1581 0           $callback->($self, $response, $store);
1582             }
1583              
1584 0           return 1;
1585             }
1586              
1587             #Cleans up
1588             sub destroy {
1589 0     0 0   my ($self) = @_;
1590              
1591 0           $self->DESTROY;
1592              
1593 0           bless $self, "Asterisk::AMI::destroyed";
1594              
1595 0           return 1;
1596             }
1597              
1598             #Run event loop via anyevent
1599             sub loop {
1600 0     0 0   $_[0]->{tmp_loop} = AnyEvent->condvar;
1601 0           my $exit = $_[0]->{tmp_loop}->recv;
1602 0           delete $_[0]->{tmp_loop};
1603 0           return $exit;
1604             }
1605              
1606             #Ends exits loops
1607             sub break {
1608 0 0   0 0   if (defined $_[0]->{tmp_loop}) {
1609 0           $_[0]->{tmp_loop}->send(1);
1610             }
1611             }
1612              
1613             #Bye bye
1614             sub DESTROY {
1615 0     0     my ($self) = @_;
1616              
1617             #Logoff if we are not in error
1618 0 0 0       if (!$self->{SOCKERR} && $self->{LOGGEDIN}) {
1619 0           $self->send_action({ Action => 'Logoff' });
1620 0           undef $self->{LOGGEDIN};
1621             }
1622              
1623             #Destroy our handle first to cause it to flush
1624 0 0         if ($self->{handle}) {
1625 0           $self->{handle}->destroy();
1626             }
1627              
1628             #Do our own flushing
1629 0           $self->_clear_cbs();
1630              
1631             #Cleanup, remove everything
1632 0           %{$self} = ();
  0            
1633              
1634 0           return 1;
1635             }
1636              
1637             sub Asterisk::AMI::destroyed::AUTOLOAD {
1638             #Everything Fails!
1639 0     0     return;
1640             }
1641              
1642             1;