#!/usr/bin/perl

# Asterisk time zone registration program
#
# Matthew Gast
# May 2006
#
# This program connects to the Asterisk manager and initiates time
# zone registration calls to extensions on the remote channel list
# when they SIP register.

use POE::Session;
use POE::Component::Client::Asterisk::Manager;
use POE;

use strict;

my $DEBUG = 1;

my @REMOTE_CHANNEL_LIST = ( 300, 201 );
my $CALLERID = 'Time Zone Setup';
my $TZ_EXTEN = '*89';
my $TZ_PRIORITY = '1'; # priority to start call at in asterisk dialplan
my $TZ_CONTEXT = 'from-internal';
my $REG_CALL_DELAY = 3; # seconds to allow requested data to get in

######################################################################

sub debug_print {

# This is a utility function that prints the string sent to it.

  my $output = $_[0];
  if ($DEBUG) {
    print "$output";
  }

}

######################################################################

sub makeTZSetupCall {

# This function initiates a call from the registration extension to the
# target extension if it is a "remote" extension that gets these calls.
#
# Preconditions:  The POE context to initiate the call is passed, along
#                 with a target extension.
# Postconditions: No return value; however, the call event has been sent.

  debug_print("-----TZ setup call queuer begins\n");

  # Convenient handles for references
  my $heap = $_[0];
  my $exten = $_[1];
  my $callOK = 0;

  foreach my $number (@REMOTE_CHANNEL_LIST) {
    if ($number == $exten) {
      debug_print("Extension $exten is on the remote channel list\n");
      $callOK = 1;
    }
  }

  if ($callOK) {
    $heap->{server}->put({'Action' => 'Originate',
			  'Channel' => 'SIP/' . $exten,
			  'Context' => $TZ_CONTEXT,
			  'Exten' => $TZ_EXTEN,
			  'Priority' => $TZ_PRIORITY,
			  'Callerid' => $CALLERID,
			 });
  } else {
    debug_print("Calls can only be made to the remote channel list\n");
    debug_print("Add $exten to the remote channel list if this is needed\n");
  }

  debug_print("-----TZ setup call queuer ends\n");

} # makeTZSetupCall

######################################################################

sub getTZChannelVars {

# This function sends requests for channel variables specific to an
# extension
#
# Preconditions:  The POE context (heap) is passssed in, along with
#                 a target extension.
# Postconditions: No return values; however, requests for additional
#                 channel variables have been sent.

  debug_print("-----Entering getTZChannelVars\n");

  my $heap=$_[0];
  my $exten=$_[1];

  debug_print("Asking for SIP data for $exten\n");
  $heap->{server}->put({'Action' => 'sipshowpeer',
			'Peer' => $exten,
		       });
  
  debug_print("Asking for time skew for $exten\n");
  $heap->{server}->put({'Action' => 'DBGet',
  			'Family' => 'tz',
			'Key' => $exten . '-TIMESKEW',
		       });

  debug_print("Asking for start time of time skew for $exten\n");
  $heap->{server}->put({'Action' => 'DBGet',
  			'Family' => 'tz',
			'Key' => $exten . '-TIMESKEW_START',
		       });

  debug_print("Asking for end time of time skew for $exten\n");
  $heap->{server}->put({'Action' => 'DBGet',
  			'Family' => 'tz',
			'Key' => $exten . '-TIMESKEW_END',
		       });

  debug_print("Asking for IP address of $exten\n");
  $heap->{server}->put({'Action' => 'DBGet',
  			'Family' => 'tz',
			'Key' => $exten . '-TIMESKEW_ADDR',
		       });
  debug_print("-----Exiting getTZChannelVars\n");

} # getTZChannelVars

######################################################################

sub input_state_handler {

# This function handles the input callback.  It is called whenever
# input is available on the manager console.
#
# Preconditions:  The input context is available from POE.
# Postconditions: None.

  my $input = $_[ARG0];

  require Data::Dumper;
  debug_print(Data::Dumper->Dump([$input]));

} # input_state_handler

######################################################################

sub response_state_handler {

# This function handles any response from the Asterisk manager.  It is
# typically called when the manager has issued a response to a GetVar
# query or some other channel variable state query.
#
# Preconditions:  This directly accesses something from the immediate
#                 outer scope, and uses the ARG0 POE construct.
# Postconditions: We have put any channel variables into the POE heap
#                 so they are available to other routines.

  debug_print("-----Starting response processing\n");

  # The main point is to get any variable/value pairs from Asterisk;
  # however, we also want to get the IP address from the SIP peer
  # context.  So, let's see what's in the channel hash.

  my $variable = $_[ARG0]->{'Variable'};
  my $value = $_[ARG0]->{'Value'};
  my $peer_ip = $_[ARG0]->{'Address-IP'};

  if (defined($value)) {
    # If there is a value, this is a variable
    debug_print("Variable $variable has a value of $value; adding to heap\n");
    $_[HEAP]->{$variable} = $value;
  } elsif (defined($peer_ip)) {
    # If there is a Peer IP, it means we're working with a SIP context
    debug_print("SIP context found; Peer IP address is $peer_ip\n");
    $_[HEAP]->{'SIP-Peer-IP'}=$peer_ip;
  } else {
    # Nothing to do
    debug_print("Response type not of variable or SIP address not currently handled.\n");
  }
  debug_print("-----Ending response processing\n");

} # response_state_handler

######################################################################

sub db_response_state_handler {

# This function reads a response from the database.  When a query is
# returned against the database, this function will store it in the
# heap.
#
# Preconditions:  This is called by POE, so we use the POE context
# 		  construction to get at the heap and channel variables.
# Postconditions: The variable value has been stored.

  debug_print("-----Starting database response event processing\n");

  my $family = $_[ARG0]->{'Family'};
  my $key = $_[ARG0]->{'Key'};
  my $value = $_[ARG0]->{'Val'};

  if (defined($family)) {
  	debug_print("Key $key in DB family $family has value = $value\n");
	# Store in heap
	$_[HEAP]->{$key} = $value;
  } else {
  	# it is unlikely this will ever be called
  	debug_print("ERROR - No family found?\n");
  }

  debug_print("-----Ending database response event processing\n");

} # db_response_state_handler

######################################################################

sub register_state_handler {

# This function is called whenever a new extension registers.  It
# checks to see that the new extension is in the remote extension list,
# asks for channel information from Asterisk, and sets up a potential
# configuration call
#
# Preconditions:  This is called by POE, so we use the POE context
#                 construction to get at the heap and channel variables.
# Postconditions: The registration call is queued.

  debug_print("-----Registration event processing\n");

  my $heap = $_[HEAP];
  my $session = $_[SESSION];
  my $kernel = $_[KERNEL];
  my $peer = $_[ARG0]->{Peer};

  # From peer information in the POE heap, get the extension.  This
  # is given as an Asterisk channel, so we need to split off the
  # technology.  Note that it doesn't handle extensions with slashes
  # in the name.

  debug_print("\tExtension is $peer; ");
  my @exten_parts = split('/',$peer);
  # everything after slash is exten number
  my $exten_num = @exten_parts[1];
  debug_print("extension number is $exten_num\n");

  # Ask for channel variables...
  getTZChannelVars($heap, $exten_num);

  # ...and give the process a few seconds to come up with them,
  # since the handlers are not preemptible; note the "call" inline
  # state is defined by us, not the inputs from Asterisk manager
  debug_print("Queuing call event for $REG_CALL_DELAY seconds\n");
  $kernel->delay_set("call", $REG_CALL_DELAY, $exten_num);

  debug_print("-----Registration event processing complete\n");

} # register_state_handler

######################################################################

sub call_state_handler {

# This function is called to initiate the telephone call to register
# the remote user's time zone.
#
# Preconditions:  POE context for the extension is available, with
#                 information on the time skew.  That information
#                 is obtained via the 'response' event, so it should
#                 be available before this function starts.  The
#                 extension in question is passed explicitly.
# Postconditions: The telephone call has been made, if necessary.

  debug_print("------Entered call setup\n");

  # Get extension out of arguments to function
  my @args = @_[ ARG0 .. $#_ ];
  my $exten = $args[0];

  # Variables we use to determine if the call is required
  my $skew = $_[HEAP]->{$exten.'-TIMESKEW'};
  my $skew_addr = $_[HEAP]->{$exten.'-TIMESKEW_ADDR'};
  my $skew_start = $_[HEAP]->{$exten.'-TIMESKEW_START'};
  my $skew_end = $_[HEAP]->{$exten.'-TIMESKEW_END'};
  my $sip_peer_ip = $_[HEAP]->{'SIP-Peer-IP'};
  my $now = time();

  if (!defined($skew)) {
  	debug_print("Skew not defined!  Call is required.\n");
	makeTZSetupCall($_[HEAP], $exten);
  } else {
  	debug_print("Extension from calling param is $exten\n");
  	debug_print("Checking for variables:\n");
  	debug_print("\t$exten-TIMESKEW = $skew\n");
  	debug_print("\t$exten-TIMESKEW_ADDR = $skew_addr\n");
  	debug_print("\tIP from SIP header = $sip_peer_ip\n");
  	debug_print("\tTime is $now\n");
  	debug_print("\t$exten-TIMESKEW_START =  $skew_start\n");
  	debug_print("\t$exten-TIMESKEW_END = $skew_end\n");
  
  	debug_print("Testing to see if re-setup is required\n");
  	# Resetup required only if IP address has changed or the
	# TZ registration has expired
  	if ($now > $skew_end) {
    		debug_print("Make call - time offset has expired.\n");
    		makeTZSetupCall($_[HEAP], $exten);
  	} elsif (!($skew_addr eq $sip_peer_ip)) {
    		debug_print("Make call - SIP reg address changed\n");
    		makeTZSetupCall($_[HEAP], $exten);
  	} else {
    		debug_print("No call -- IP unchanged & records unexpired\n");
	}
  }

  # Need to clean up heap
  debug_print("Clearing heap variables\n");
  undef $_[HEAP]->{$exten.'-TIMESKEW'};
  undef $_[HEAP]->{$exten.'-TIMESKEW_ADDR'};
  undef $_[HEAP]->{$exten.'-TIMESKEW_START'};
  undef $_[HEAP]->{$exten.'-TIMESKEW_END'};
  undef $_[HEAP]->{'SIP-Peer-IP'};

  debug_print("------Exiting call setup\n");
  
} # call_state_handler

######################################################################

sub unregister_state_handler {

# This function is called when an extension unregisters from Asterisk.
# It currently doesn't do anything.
#
# Preconditions:  The POE context for the extension is available.
# Postconditions: If debug is active, a message that the extension
#                 has unregistered is printed.

  debug_print("-----Unregister handler started\n");

  my $peer = $_[ARG0]->{Peer};
  debug_print "\tExtension is $peer; ";
  my @exten_parts = split('/',$peer);
  # everything after slash is the extension number
  my $exten = @exten_parts[1];
  debug_print "extension number $exten unregistered\n";

  debug_print("-----Unregister handler finished\n");

} # unregister_state_handler

######################################################################


POE::Component::Client::Asterisk::Manager->new(
	Alias           => 'monitor',
        RemoteHost      => 'localhost',
        RemotePort      => 5038, # default port
	Username	=> 'autotzcaller',
	Password	=> 'secretpassword',
        CallBacks  => {
                input    => ':all',  # catchall for all manager events
		response => {
			'Response' => 'Success',
		},
		dbresponse => {
			'Event' => 'DBGetResponse',
		},
		register => {
			'Event' => 'PeerStatus',
			'PeerStatus' => 'Registered',
		},
		unregister => {
			'Event' => 'PeerStatus',
			'PeerStatus' => 'Unregistered',
		},
        },
        inline_states => {
		input      => \&input_state_handler,
		response   => \&response_state_handler,
		dbresponse => \&db_response_state_handler,
		register   => \&register_state_handler,
		call       => \&call_state_handler,
		unregister => \&unregister_state_handler,
	},
  );

POE::Kernel->run();
exit(0);