#!/usr/local/bin/perl5 -w

# send pages to people via paging company Web interfaces or SNPP

# 

# released to mon list on 7/18/00
# alpha version - please send fixes, improvements, or suggestions to
# Ed Ravin <eravin@panix.com>

use strict;

use Getopt::Long;
use Socket;
use Net::SNPP;

my $myname="pageomat";
my %opt;
GetOptions (\%opt, "debug", "pin=s", "company=s", "timeout=i", "message=s");

my %pageinfo= (
	'skytel'=>
	{ 'url' => 'snpp://snpp.skytel.com:7777' }, 

	'skytel-http' =>
	{ 'url' => 'http://www.skytel.com/servlet/SendMessage',
	  'format' => 'recipients=%s&message=%s',
	  'match' => '(Your Message Status Number is: \d+)|(Skytel Messaging Center Has Received Your Message)' } ,

	'bellsouthips' =>
	{ 'url' => 'http://www.bellsouthips.com/scripts/rampage.dll?ProcessSendMail',
	  'format' => 'pin=%s&media=None&retaddr=&data=%s',
	  'match' => 'Your message has been sent to destination address' },

	'omnipoint' =>
	{ 'url' => 'http://www.omnipoint.com/cgi-bin/message.cgi',
	  'format' => 'load=%s&phone=%s&message=%s',
	  'match' => 'message_sent.html',
	  'referer' => 'Referer: http://www.omnipoint.com/common/center/main.html',
	  'arg1' =>  url_encode('http://www.omnipoint.com/common/center/message_sent.html') },

	'bam' =>
	{ 'url' => 'http://www3.bam.com/cgi-bin/sms/sms.cgi',
	  'format' => 'msg_type=messaging&area_code=%s&exchange=%s&extension=%s&message=%s&tCharacterCount=0',
	  'cut_pin_3' => 'true',
	  'match' => 'Your Message Has Been Accepted For Delivery' },

# att not tested yet
	'att' =>
	{ 'url' => 'http://www.mobile.att.net/mc/pager_show.cgi',
	 'format' => 'category=personal&pin=%s&sizebox=%s' },

	);

my $usage="Usage: $myname --pin=pagerid --company={" . join('|', keys %pageinfo) . "}\n";

my $debug= $opt{'debug'} || undef;

my $pin= $opt{'pin'} || die "$usage";
my $company= $opt{'company'} || die "$usage";
my $timeout= $opt{'timeout'} || 30;
my $message= $opt{'message'} || join (' ', <STDIN>);

$message =~ s/\n/ /g;



# chop up url
my ($protocol, $hostname, $path)= ($pageinfo{$company}{'url'} =~ m!([^:]+)://([^/]+)(.*)!);
my $port;

if ($hostname =~ m!([^:]+)(:\d+)!)
{
	$hostname= $1; $port= $2;
}

$port=80 unless defined($port);
$port=~ s/://;

if ($debug) {
	print "Message to $pin at $company via $pageinfo{$company}{'url'}\n";
	print "Protocol is $protocol, server is $hostname, port is $port, path is $path\n";
}

if ($protocol eq "snpp")
{
	send_snpp($hostname, $port, $pin, $message);
	exit 0;
}


if ($debug) {
	open COMMAND, ">&STDOUT" || die "$0: can't dup fd for debugging: $!";
} else {
    my $pro = getprotobyname ('tcp');
    if (!defined $pro) {
        die "$myname: could not getprotobyname tcp: is there a network here?\n";
    }
    if (!defined socket (COMMAND, PF_INET, SOCK_STREAM, $pro)) {
        die "$myname: could not create socket: $!\n";
    }
    my $address = inet_aton ($hostname);
    if (!defined $address) {
        die "$myname: $hostname could not inet_aton";
    }
    my $sin = sockaddr_in (80, $address);
	if (!defined $sin) {
		die "$0: $hostname/$address could not sockaddr_in";
	}

    my $r;

    die "$0: cannot setsockopt: $!"
        unless setsockopt(COMMAND, SOL_SOCKET, SO_LINGER, pack "i i", 1, 10);

    eval {
        local $SIG{"ALRM"} = sub { die "alarm\n" };

        alarm $timeout;

        $r = connect (COMMAND, $sin);

        alarm 0;
    };

    if ($@) {
                if ($@ eq "alarm\n") {
                        die "$0: $hostname/$address timeout";
                } else {
                        die "$0: $hostname/$address interrupted syscall: $!";
                }
    }

    if (!defined $r) {
        die "$0: $hostname/$address could not connect: $!";
    }

}


if ($company eq "skytel-http")
{
    # Skytel's form chokes on or eats up these characters - so substitute them
    $message =~ s/[&]/{and}/g;
    $message =~ s/[+]/{plus}/g;
    $message =~ s/[%]/{percent}/g;
} elsif ($company eq "bam")
{
    # bam doesn't like carrots.  Silly rabbit...
    $message =~ s/</(/g;
    $message =~ s/>/)/g;
}

$message= url_encode($message);  # format for POST'ing

my $data;

if (defined($pageinfo{$company}{'arg1'}))
{
	$data= sprintf $pageinfo{$company}{'format'},
		$pageinfo{$company}{'arg1'}, $pin, $message;
} elsif (defined($pageinfo{$company}{'cut_pin_3'}))
{
	die "PIN must be 10-digit number for this company"
		unless $pin =~ /^\d{10}$/;
	my ($areacode, $exchange, $suffix)=
		(substr($pin,0,3), substr($pin,3,3), substr($pin,6,4));
	$data= sprintf $pageinfo{$company}{'format'},
		$areacode, $exchange, $suffix, $message;
}
else
{
	$data= sprintf $pageinfo{$company}{'format'}, $pin, $message;
}

select COMMAND; $|=1; select STDOUT;

print COMMAND "POST $path HTTP/1.0\r\n" .
              "Host: $hostname\r\n" .
              "Accept: text/html, text/plain\r\n" .
              "User-Agent: $myname\r\n" .
	( defined($pageinfo{$company}{'referer'}) ?
		"$pageinfo{$company}{'referer'}\r\n" : "" ) .
              "Content-type: application/x-www-form-urlencoded\r\n" .
              "Content-length: " . length($data) . "\r\n\r\n" .
              $data;

print COMMAND "\r\n" if $debug;

$SIG{"PIPE"} = 'IGNORE';
shutdown COMMAND, 1; # SHUT_WR - disallow further writes


my $response= "";
my @response;

alarm $timeout; # just die if we get stuck somehow listening on the socket

@response= <COMMAND>; $response= join('', @response);

print length($response), " bytes received.\n";

if ( $response =~ $pageinfo{$company}{'match'} )
{
	print "Message delivery confirmed to $pin at $hostname:\n";
	exit 0;
} else {
	print "No match - cannot confirm message delivery.\n";
	open TRACE, ">/tmp/pageomat.response.$$" ||
		die "$0: cannot create tracefile /tmp/pageomat.$$: $!";
	print TRACE $response;
	close TRACE;
	exit 1;
}


sub send_snpp
{
	my ($host, $port, $pagerid, $text) = @_;
	my $rc;
	my $snpp = Net::SNPP->new ($host, Port => $port, Timeout => 60)
	   or die "SNPP->new fails: $!";

	$rc= $snpp->send ( Pager => [ $pagerid ], Message => "$text" );
	
	die "SNPP send fails." unless $rc;

	$snpp->quit;
}




sub url_encode {

    my $text = shift;

    $text =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;

    return $text;
}