#!/usr/bin/perl -w
# -*- cperl -*-

=head1 NAME

asterisk - Multigraph-capable plugin to monitor Asterisk

=head1 NOTES

This plugin will produce multiple graphs showing:

 - total number of active channels (replaces asterisk_channels),
   together with breakdown of specific channel types (replaces
   asterisk_channelstypes);

 - the number of messages in all voicemail boxes (replaces
   asterisk_voicemail);

 - DEPRECATED: the number of active MeetMe conferences and users connected to
   them (replace asterisk_meetme and asterisk_meetmeusers, respectively);

 - the number of active ConfBridge conferences (e.g. non-empty ones) and users
   connected to them

 - the number of active channels for a given codec, for both SIP and
   IAX2 channels (replaces asterisk_sipchannels and asterisk_codecs).

=head1 CONFIGURATION

The following configuration parameters are used by this plugin

 [asterisk]
  env.host              - hostname to connect to
  env.port              - port number to connect to
  env.username          - username used for authentication
  env.secret            - secret used for authentication
  env.channels          - The channel types to look for
  env.codecsx           - List of codec IDs (hexadecimal values)
  env.codecs            - List of codecs names, matching codecsx order
  env.enable_meetme     - Set to 1 to enable graphs for the MeetMe application
  env.enable_confbridge - Set to 1 to enable graphs for the ConfBridge application

The "username" and "secret" parameters are mandatory, and have no
defaults.

=head2 DEFAULT CONFIGURATION

 [asterisk]
  env.host 127.0.0.1
  env.port 5038
  env.channels Zap IAX2 SIP
  env.codecsx 0x2 0x4 0x8
  env.codecs gsm ulaw alaw
  env.enable_meetme 0
  env.enable_confbridge 1

=head2 WILDCARD CONFIGURATION

It's possible to use the plugin in a virtual-node capacity, in which
case the host configuration will default to the hostname following the
underscore:

 [asterisk_someserver]
  env.host someserver
  env.port 5038

=head1 AUTHOR

Copyright (C) 2005-2006 Rodolphe Quiédeville <rodolphe@quiedeville.org>
Copyright (C) 2012 Diego Elio Pettenò <flameeyes@flameeyes.eu>

=head1 LICENSE

GPLv2

=head1 MAGIC MARKERS

 #%# family=auto
 #%# capabilities=autoconf

=cut

use strict;
use Munin::Plugin;
use IO::Socket;

# See the following and its subpages for change history in the AMI protocol:
# https://wiki.asterisk.org/wiki/display/AST/Asterisk+Manager+Interface+%28AMI%29+Changes
sub asterisk_command {
  my ($socket, $command) = @_;
  my $line, my $reply;

  $socket->print("Action: command\nCommand: $command\n\n");

  # Response: (Error|Follows|Success)
  $line = $socket->getline;
  if ($line !~ /^Response: Success\r?\n$/) {
    while ( $line = $socket->getline and $line !~ /^\r?\n$/ ) {
      print STDERR "COMMAND: Ignoring unwanted line: $line" if $Munin::Plugin::DEBUG;
    }
    return undef;
  }

  # Message: Command output follows
  $line = $socket->getline;
  print STDERR "COMMAND got response: $line" if $Munin::Plugin::DEBUG;

  # Until we get the --END COMMAND-- marker, it's the command's output.
  while ( $line = $socket->getline and $line =~ /^Output:/ ) {
    print STDERR "COMMAND: got response: $line" if $Munin::Plugin::DEBUG;
    # Don't keep the "Output: " part of the response
    substr($line, 0, 8, '');
    $reply .= $line;
  }
  return $reply;
}

$0 =~ /asterisk(?:_(.+))$/;
my $hostname = $1;

my $peeraddr = $ENV{'host'} || $hostname || '127.0.0.1';
my $peerport = $ENV{'port'} || '5038';

my $username = $ENV{'username'};
my $secret   = $ENV{'secret'};

my @CHANNELS = exists $ENV{'channels'} ? split ' ',$ENV{'channels'} : qw(Zap IAX2 SIP);
my @CODECS = exists $ENV{'codecs'} ? split ' ',$ENV{'codecs'} : qw(gsm ulaw alaw);
my @CODECSX = exists $ENV{'codecsx'} ? split ' ',$ENV{'codecsx'} : qw(0x2 0x4 0x8);

my $meetme_enabled = $ENV{'enable_meetme'} || '0';
my $confbridge_enabled = $ENV{'enable_confbridge'} || '1';

my $line, my $error;
my $socket = new IO::Socket::INET(PeerAddr => $peeraddr,
                                  PeerPort => $peerport,
                                  Proto => 'tcp')
  or $error = "Could not create socket: $!";

if ( $socket ) {
  # This will consume the "Asterisk Call Manager" welcome line.
  $socket->getline;

  $socket->print("Action: login\nUsername: $username\nSecret: $secret\nEvents: off\n\n");
  my $response_status = $socket->getline;

  if ( $response_status !~ /^Response: Success\r?\n$/ ) {
    my $response_message = $socket->getline;
    $response_message =~ s/Message: (.*)\r?\n/$1/;
    $error = "Asterisk authentication error: " . $response_message;
  }

  while ( $line = $socket->getline and $line !~ /^\r?\n$/ ) {}
}

if ( $ARGV[0] and $ARGV[0] eq 'autoconf' ) {
  if ( $error ) {
    print "no ($error)\n";
  } else {
    print "yes\n";
  }

  exit 0;
} elsif ( $ARGV[0] and $ARGV[0] eq 'config' ) {
  print "host_name $hostname" if $hostname;

  print <<END;

multigraph asterisk_channels
graph_title Asterisk active channels
graph_args --base 1000 -l 0
graph_vlabel channels
graph_category asterisk
total.label channels
END

  foreach my $channel (@CHANNELS) {
    print <<END;
$channel.draw AREASTACK
$channel.label $channel channels
END
  }

print <<END;

multigraph asterisk_voicemail
graph_title Asterisk voicemail messages
graph_args --base 1000 -l 0
graph_vlabel messages
graph_category asterisk
total.label Total messages
END

if ($meetme_enabled == '1') {
  print <<END;

multigraph asterisk_meetme
graph_title Asterisk meetme statistics
graph_args --base 1000 -l 0
graph_category asterisk
users.label Connected users
conferences.label Active conferences
END
}

if ($confbridge_enabled == '1') {
  print <<END;

multigraph asterisk_confbridge
graph_title Asterisk ConfBridge statistics
graph_args --base 1000 -l 0
graph_category asterisk
users.label Connected users
conferences.label Active conferences
END
}

print <<END;

multigraph asterisk_codecs
graph_title Asterisk channels per codec
graph_args --base 1000 -l 0
graph_vlabel channels
graph_category asterisk
END

  foreach my $codec (@CODECS) {
    print <<END;
$codec.draw AREASTACK
$codec.label $codec channels
END
  }

print <<END;
other.draw AREASTACK
other.label Other known codecs
unknown.draw AREASTACK
unknown.label Unknown codec
END

  unless ( ($ENV{MUNIN_CAP_DIRTYCONFIG} || 0) == 1 ) {
    exit 0;
  }
}

# if we arrive here and we don't have a socket, it's time to exit.
die $error if $error;

my $channels_response = asterisk_command($socket, "core show channels");
#Channel              Location             State   Application(Data)
#Zap/pseudo-198641660 s@frompstn:1         Rsrvd   (None)
#Zap/1-1              4@frompstn:1         Up      ConfBridge(5500)
#2 active channels
#1 active call

my $voicemail_response = asterisk_command($socket, "voicemail show users");
#Context    Mbox  User                      Zone       NewMsg
#default    1234  Example Mailbox                           1
#other      1234  Company2 User                             0
#2 voicemail users configured.

my $meetme_response;
if ($meetme_enabled eq '1') {
  $meetme_response = asterisk_command($socket, "meetme list");
  #Conf Num       Parties        Marked     Activity  Creation
  #5500           0001           N/A        00:00:03  Static
  #* Total number of MeetMe users: 1
}

my $confbridge_response;
if ($confbridge_enabled eq '1') {
  $confbridge_response = asterisk_command($socket, "confbridge list");
  #Conference Bridge Name           Users  Marked Locked Muted
  #================================ ====== ====== ====== =====
  #3                                     1      0 No     No
}

my $sipchannels_response = asterisk_command($socket, "sip show channels");
#Peer             User/ANR         Call ID          Format           Hold     Last Message    Expiry     Peer
#192.168.1.135    yann             1341929961-161    00101/00002     No       Rx: INVITE                 g729
#1 active SIP channel(s)

my $iaxchannels_response = asterisk_command($socket, "iax2 show channels");
#Channel               Peer             Username    ID (Lo/Rem)  Seq (Tx/Rx)  Lag      Jitter  JitBuf  Format  FirstMsg    LastMsg
#IAX2/rodolphe@rodolp  10.8.53.6        rodolphe    00003/01287  00006/00004  00000ms  0148ms  0000ms  gsm     Rx:NEW      Tx:ACK
#1 active IAX channel(s)

# After all the data is fetched we can proceed to process it, the
# connection can be closed as we don't need any more data.
$socket->close();

my $active_channels = 'U';
$active_channels = $1 if $channels_response =~ /\n([0-9]+) active channels?/;

print <<END;

multigraph asterisk_channels
total.value $active_channels
END

my @channels_list = split(/\r?\n/, $channels_response) if $channels_response;
foreach my $channel (@CHANNELS) {
  print "$channel.value ";
  print $channels_response ? scalar(grep(/^$channel\//, @channels_list)) : "U";
  print "\n";
}

print "\nmultigraph asterisk_voicemail\n";
if ( !$voicemail_response or $voicemail_response =~ /no voicemail users/ ) {
  print "total.value U\n";
} else {
  my $messages = 0;
  foreach my $line (split(/\r?\n/, $voicemail_response)) {
    next unless $line =~ / ([0-9]+)$/;
    $messages += $1;
  }

  print "total.value $messages\n";
}

if ($meetme_enabled == '1') {
  print "\nmultigraph asterisk_meetme\n";
  if ( !$meetme_response ) {
    print <<END;
users.value U
conferences.value U
END
  } else {
    if ( $meetme_response =~ /No active/ ) {
      print <<END;
users.value 0
conferences.value 0
END
    } else {
      my @meetme_list = split(/\r?\n/, $meetme_response);

      my $users = pop(@meetme_list);
      $users =~ s/^Total number of MeetMe users: ([0-9]+)$/$1/;

      print "users.value $users\n";
      print "conferences.value " . (scalar(@meetme_list)-1) . "\n";
    }
  }
}

if ($confbridge_enabled == '1') {
  print "\nmultigraph asterisk_confbridge\n";
  if ( !$confbridge_response ) {
    print <<END;
users.value U
conferences.value U
END
  } else {
    my @confbridge_list = split(/\r?\n/, $confbridge_response);
    # Remove column headers, then line of =
    shift(@confbridge_list);
    shift(@confbridge_list);

    my $users = 0;
    foreach my $bridge (@confbridge_list) {
      my @fields = split ' ', $bridge;
      # yes we ARE parsing a command's output. if we end up getting some
      # unexpected things, just break out to and avoid computing nonsense.
      if (scalar(@fields) < 5 or $fields[1] !~ /^[0-9]+$/) {
        last;
      }
      $users += $fields[1];
    }

    print "users.value $users\n";
    print "conferences.value " . (scalar(@confbridge_list)) . "\n";
  }
}

print "\nmultigraph asterisk_codecs\n";
if ( !$sipchannels_response and !$iaxchannels_response ) {
  foreach my $codec (@CODECS) {
    print "$codec.value U\n";
  }
  print <<END;
other.value U
unknown.value U
END
} else {
  my %results;
  my ($start, $unknown, $other)=(0,0,0);
  foreach my $codec (@CODECS) {
    $results{$codec} = 0;
  }

  # split the channels' listing and drop header and footnotes
  my @sipchannels = $sipchannels_response ? split(/\r?\n/, $sipchannels_response) : ();
  pop(@sipchannels); shift(@sipchannels);
  my @iaxchannels = $iaxchannels_response ? split(/\r?\n/, $iaxchannels_response) : ();
  pop(@iaxchannels); shift(@iaxchannels);

  foreach my $sipchan (@sipchannels) {
    my $found = 0;
    my @fields = split ' ', $sipchan;
	$fields[3] =~ s/[()]//g;
    if ($fields[3] eq 'nothing') {
      $unknown += 1;
      next;
    }
    foreach my $codec (@CODECS) {
      if ($fields[3] eq "$codec") {
        $results{$codec} = $results{$codec} + 1;
        $found = 1;
        last;
      }
    }
    if (! $found) {
      $other += 1;
      print STDERR "CODEC: SIP other format $fields[4]\n" if $Munin::Plugin::DEBUG;
    }
  }

  foreach my $iaxchan (@iaxchannels) {
    my $found = 0;
    my @fields = split ' ', $iaxchan;

    if ($fields[8] eq '0x0') {
      $unknown += 1;
      next;
    }
    foreach my $codec (@CODECS) {
      if ($fields[8] eq "$codec") {
        $results{$codec} = $results{$codec} + 1;
        $found = 1;
        last;
      }
    }
    if (! $found) {
      $other += 1;
      print STDERR "CODEC: IAX2 other format: $fields[8]\n" if $Munin::Plugin::DEBUG;
    }
  }

  foreach my $codec (@CODECS) {
    print "$codec.value $results{$codec}\n";
  }
  print "other.value $other\n";
  print "unknown.value $unknown\n";
}