# SMSfcts.pm module
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#NAME
#  SMSfcts.pm - First test for sanity of mod_perl inside apache
#
#SYNOPSIS
#  http://host.dom.ain/hello/world
#
#DESCRIPTION
#  This is a mod_perl module that contains the common routines for the SMSmsg
#  CGI script and the SMSmsg.pm mod_perl module.  This separation was done so
#  that we can send SMS messages whether or not we have mod_perl installed.
#
#EXAMPLES
#
#FILES
#
#BUGS
#
#SEE ALSO
#
#AUTHOR
#  John Chambers <jc@trillian.mit.edu>
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

package SMSfcts;

use strict;
use CGI;
use CGI::Carp 'fatalsToBrowser';
use diagnostics;

my $query = new CGI;
my @names = $query->param();

my %ids     = ();	# SMS recipient ids
my %name    = ();	# SMS recipient names
my %phnum   = ();	# SMS recipient phone numbers
my %smsid   = ();	# SMS recipient ids (digits of phone numbers)
my %carrier = ();	# SMS recipient carrier names
my %where   = ();	# Where to send the message
my %type    = ();	# How   to send the message

my $rcptcnt = 0;	# Number of SMS recipients
my $V = $main::V || 2;

my $self;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Create an instance of this module:
sub new {
	$self = {};
    bless $self;
    $self->initialize ();
    return $self;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Do we have any initialization?
sub initialize {
	return 1;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub cgi {
	my $id = shift;
	my $F = "$main::P/cgi" || '';
	my $Fr = $query->param('CGIfrom') || '';
	my $RT = $query->param('CGIreplyto') || '';
	my $CB = $query->param('CGIcallback') || '';
	my $uri = $where{$id};
	my $url = "http://$uri";
	my($cmd,$en,$ln,$rsp);
	print "$F: From: $Fr<br>\n" if $V>1;
	print "$F: Reply-To: $RT<br>\n" if $V>1;
	print "$F: Callback: $CB<br>\n" if $V>1;
	if ($uri =~ "^vtext.com/.*messaging_lo.jsp") {
		print "$F: Recognized Verizon's SMS message forwarder.<br>\n" if $V>1;
		$cmd = "w3post $url";
		if (open(POST,"| $cmd")) {
			print "$F: Opened pipe to '$cmd' command.<br>\n" if $V>1;
			print POST "?min=$smsid{$id}";
			if ($Fr) {
				print POST "&trackResponses=No&showgroup=n&Send.x=Yes&DOMAIN_NAME=\@vtext.com";
				print POST "&subject=$Fr";
			}
			if ($RT) {
				print POST "&sender=$RT";
			}
			if ($CB) {
				print POST "&callback=$CB";
			}
			print POST "&text=";
			for $ln (@_) {
				print "ln: \"$ln\"<br>\n" if $V>1;
				($en = $ln) =~ s/(\W)/'%'.ord($1)/ge;
				print "en: \"$en\"<br>\n" if $V>1;
				print POST $en;
			}
			print POST "\n\n";
			close POST;
		} else {
			print "$F: <b>Can't open 'w3post $url' command.</b><br>\n" if $V>0;
		}
	} else {
		print "<b>$F: Don't recognize CGI '$uri'<br>\n" if $V>0;
	}
	print "<b>$F: NOT FULLY IMPLEMENTED YET</b><br>\n" if $V>0;
	return 0;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Send one message.  The first arg is the recipient;
# the rest of the args are lines of the message.
sub email {
	my $id = shift;
	my $F = $main::P . '/email';
	my $P = "$main::P";
	my($ad,$cm,$ln,$pn,$rcpt,$st);
	print "$F: id='$id' V=$V<br>\r" if $V>0;
	$rcpt = "$id ($name{$id} $smsid{$id} $where{$id})";
	print "$F: rcpt='$rcpt'<br>\r" if $V>1;
	($pn = $smsid{$id});
	print "$F: pn='$pn'<br>\r" if $V>1;
	$ad = $pn . '@' . $where{$id};
	print "$F: ad='$ad'<br>\r" if $V>1;
	$cm = "SendMsg to $ad";
	print "$F: cm='$cm'<br>\r" if $V>1;
	if (open(MAIL,"| $cm")) {
		print "$F: Opened '| $cm'<br>\r" if $V>1;
		for $ln (@_) {
			print "Line: \"$ln\"<br>\n" if $V>1;
			print MAIL "$ln\n";
		}
		$st = close MAIL;
		if ($st) {
			print "$P: Message to $rcpt accepted.<br>\n" if $V>0;
		} else {
			print "<b>$P: Message to $rcpt failed (status $st)</b><br>\n" if $V>0;
		}
	} else {
		print "<b>### Can't run '$cm' ($!)</b><br>\n" if $V>0;
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub getrcpts {
	my $rfile = shift;
	my $F = $main::P . '/getrcpts';
	my($id,$l,$line,$n,$v);
	unless (open(RFILE,$rfile)) {
		print "<b>### Can't read recipient file '$rfile' [$!]</b><br>\r";
		return 0;
	}
	print "Recipient file='$rfile' opened.<br>\r" if $V>1;
line:
	while ($l = <RFILE>) {
		$l =~ s"[\r\s]+$"";
		$line ++;
		print "RFILE line $line: '$l'<br>\n" if $V>4;
		if ($l =~ /^\s*#/) {	# Comments ignored
		} elsif ($l eq '') {	# Blank lines ignored
		} elsif (($n,$v) = ($l =~ /^([^:]+):\s*(.*)/)) {
			$n = lc($n);		# Names are caseless
			print "$n: '$v'<br>\n" if $V>3;
			if ($n eq 'id') {
				if ($id = $v) {	# Remember this recipient's id
					print "<b>+++ Warning: Duplicate id '$id'</b> ($ids{$id} earlier)<br>\n"
						if $ids{$id};
					$ids{$id}++;	# Count the occurrences of the ids
					print "--- <b>$id</b><br>\n" if $V>1;
					$rcptcnt++;
				}
				next line;
			}
			next line unless $id;
			if ($n eq 'name') {
				$name{$id} = $v;
				print "--- $id name='$v'<br>\n" if $V>1;
			} elsif ($n eq 'phone') {
				$phnum{$id} = $v;
				($smsid{$id} = $v) =~ s/\D+//g;
				print "--- $id phnum='$phnum{id}'<br>\n" if $V>1;
				print "--- $id smsid='$smsid{$id}'<br>\n" if $V>1;
			} elsif ($n eq 'carrier') {
				$carrier{$id} = $v;
				print "--- $id carrier='$v'<br>\n" if $V>1;
			} elsif ($n eq 'method') {
				if ($v =~ s/^([@!])//) {
					$type{$id}  = $1;	# Default method is email
					$where{$id} = $v;	# Remainder is address or command
					print "--- $id Type='$type{$id}' method='$where{$id}'<br>\n" if $V>1;
				} else {
					$type{$id}  = '@';	# Default method is email
					$where{$id} = $v;
					print "--- $id type='\@' where='$v'<br>\n" if $V>1;
				}
			} else {
				print "<b>### Unknown name '$n'</b><br>\n" if $V>1;
			}
		} else {
			print "<b>### Can't parse '$l'</b><br>\n" if $V>1;
		}
	}
	print "Recipient file='$rfile' done ($rcptcnt rcpts)<br>\r" if $V>2;
	close RFILE;
	return $rcptcnt;	# Return recipient count
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# This routine is called to handle one SMSmsg request
sub form {
	my $r = shift;
	my $F = "$main::P/form";
	my($msg,$n,$rcpt,@rcpt,$rfile,$scdir,$v,@vals);
	my $rcptfile = 'SMSdata.txt';
	my($usec,$umin,$uhour,$umday,$umon,$uyear) =    gmtime(time); $uyear += 1900; $umon += 1;
	my($lsec,$lmin,$lhour,$lmday,$lmon,$lyear) = localtime(time); $lyear += 1900; $lmon += 1;
	my $udt = sprintf "%04d/%02d/%02d %02d:%02d:%02d",$uyear,$umon,$umday,$uhour,$umin,$usec;
	my $ldt = sprintf "%04d/%02d/%02d %02d:%02d:%02d",$lyear,$lmon,$lmday,$lhour,$lmin,$lsec;
	my $cwd  = `pwd`;      $cwd  =~ s"[\r\s]+$"";
	my $host = `hostname`; $host =~ s"[\r\s]+$"";

	$V = $main::V || 2;
	print "	Client: $host<br>\n";
	print "	Universal time: $udt.<br>\n";
	print "	Our local time: $ldt.<br>\n";
	print "	Current dir: $cwd<br>\n";
	print "	Verbosity: $V<br>\n";
	print "<p>\n";

	$V = $query->param('V') || $V;

	if ($V>1) {
		print "<hr>Here are our form elements:\n";
		print "<dl compact>\n";
		for $n (sort @names) {
			if (@vals = $query->param($n)) {
				for $v (@vals) {
					$v =~ s"([,;:])"$1 "g;
					print "<dt>$n<dd>'$v'\n";
				}
			} elsif ($v = $query->param($n)) {
				$v =~ s"([,;:])"$1 "g;
				print "<dt>$n<dd>\"$v\"\n";
			} else {
				print "<dt>$n<dd>(NO VALUE)\n";
			}
		}
		print "</dl>\n";
	}

	if ($V>1) {
		print "<hr>Here are our environment variables:\n";
		print "<dl>\n";
		for $n (sort keys %ENV) {
			$v = $ENV{$n};
			if ($n eq 'HTTP_ACCEPT') {
				$v =~ s",", "g;
			} elsif ($n eq 'PATH') {
				$v =~ s":" "g;
			} else {
			}
			print "<dt>$n<dd>$v\n";
		}
		print "</dl>\n";
	}

# Look for our list of SMS recipients:
	print "Find list of SMS recipients ...<br>\r" if $V>1;
	$v = $ENV{'SCRIPT_FILENAME'};
	print "SCRIPT_FILENAME='$v'<br>\r" if $V>1;
	($scdir = $v) =~ s"[^/]*$"";
	print "Directory: '$scdir'<br>\r" if $V>1;
	chdir $scdir;
	$rfile = "$scdir$rcptfile";
	print "Recipient file='$rfile' ...<br>\r" if $V>1;
	$n = &getrcpts($rfile);
	print "File '$rfile' has $n entries.<br>\r" if $V>1;

# Were we passed a message and a recipient?
	if ($msg = $query->param('msg')) {
		print "$F: Message '$msg'<br>\r" if $V>1;	
		if (@rcpt = $query->param('rcpt')) {	# Multiple recipients
			$n = int(@rcpt);
			print "$F: We have $n recipients:<br>\r" if $V>1;	
			for $rcpt (@rcpt) {
				print "$F: recipient '$rcpt' type '$type{$rcpt}'<br>\r" if $V>1;	
				if ($type{$rcpt} eq '!') {
					print "$F: recipient '$rcpt' is type '$type{$rcpt}'<br>\r" if $V>1;	
					&cgi($rcpt,$msg);
				} else {
					print "$F: recipient '$rcpt' is $smsid{$rcpt}\@$where{$rcpt}<br>\r" if $V>1;	
					&email($rcpt,$msg); 
				}
			}
		} elsif ($rcpt = $query->param('rcpt')) {	# Single recipient
			print "$F: Recipient '$rcpt'<br>\r" if $V>1;	
			&email($rcpt,$msg);
		} else {
			print "$F: No recipient(s).<p><br>\r" if $V>1;
		}
	} else {
		print "$F: No message.<p><br>\r" if $V>1;
	}

# Produce box for a message:
	print "<hr>";
	print "<form method=POST action='SMSmsg'>\n";
	print "<textarea name='msg' cols=60 rows=5 wrap=physical>\n";
	print "</textarea><br>\n";

# Parameters for SMS via CGI:
	print "Data for Verizon CGI script:<br>\n";
	print "<table>\n";
	print "<tr><td align=right>From:</td><td><input type=text name=CGIfrom size=40></td></tr>\n";
	print "<tr><td align=right>Reply-To:</td><td><input type=text name=CGIreplyto size=40></td></tr>\n";
	print "<tr><td align=right>Callback:</td><td><input type=text name=CGIcallback size=40></td></tr>\n";
	print "</table>\n";

# Show the list of recipients:
	print "<p>\n";
	print "Check one or more recipients below,\n";
	print "then press <input type=submit value='Send'>\n";
	print "<p>\n";
	&rcptlist();
	print "Verbosity: <input type=text name=V size=1 value=$V><br>\n";
	print "</form>\n";

# Finish up the HTML:
	print "<br>Done.\n" if $V>1;
	print "</BODY>\n";
	print "</HTML>\n";
	return 1;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Produce the HTML table that shows the recipient list.
sub rcptlist() {
	my $id;
	print "<table border=3><caption>SMS recipients</caption>\n";
	print "\t<th></th>\n";
	print "\t<th>name</th>\n";
	print "\t<th>id</th>\n";
	print "\t<th>phone</th>\n";
	print "\t<th>carrier</th>\n";
	print "\t<th>method</th>\n";
	for $id (sort keys %ids) {
		print "\t<tr>\n";
		print "\t\t<td><input type=checkbox name='rcpt' value='$id'></th>\n";
		print "\t\t<td>$name{$id}</th>\n";
		print "\t\t<td align=center>$id</th>\n";
		print "\t\t<td align=right><TT>$phnum{$id}</TT></th>\n";
		print "\t\t<td>$carrier{$id}</th>\n";
		print "\t\t<td>$type{$id}$where{$id}</th>\n";
		print "\t</tr>\n";
	}
	print "</table><br>\n";
}

1;	# Gotta let mod_perl know that we loaded OK.
__END__