#!/usr/bin/perl -w
#############################################################################
# License:
#
# This software (hereafter referred to as "program") is free software;
#   you can redistribute it and/or modify it under the terms of the GNU General
#   Public License as published by the Free Software Foundation; either version
#   2 of the License, or (at your option) any later version.
# Note that when redistributing modified versions of this source code, you
#   must ensure that this disclaimer and the above coder's names are included
#   VERBATIM in the modified code.
#
# Disclaimer:
# This program is provided with no warranty of any kind, either expressed or
#   implied.  It is the responsibility of the user (you) to fully research and
#   comprehend the usage of this program.  As with any tool, it can be misused,
#   either intentionally (you're a vandal) or unintentionally (you're a moron).
#   THE AUTHOR(S) IS(ARE) NOT RESPONSIBLE FOR ANYTHING YOU DO WITH THIS PROGRAM
#   or anything that happens because of your use (or misuse) of this program,
#   including but not limited to anything you, your lawyers, or anyone else
#   can dream up.  And now, a relevant quote directly from the GPL:
#
#                           NO WARRANTY
#
#  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
# FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
# OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
# PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
# OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
# TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
# PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
# REPAIR OR CORRECTION.
#
#   ---
#
# Whee, that was fun, wasn't it?  Now let's all get together and think happy
#   thoughts - and remember, the same class of people who made all the above
#   legal spaghetti necessary are the same ones who are stripping your rights
#   away with DVD CCA, DMCA, stupid software patents, and retarded legal
#   challenges to everything we've come to hold dear about our internet.
#   So enjoy your dwindling "freedom" while you can, because 1984 is coming
#   sooner than you think.  :[
#
#############################################################################
# 
# Purpose:
#     To create a program to send pages to a SNPP RFC-1861 compliant server.
# 
# 
# Features:
#       - Easy addition of new service providers by simply editing a hash
#       - Logging to a file
#       - Script returns error status to the system when an error occurs
#       - Verbose error messages to STDOUT when problems occur
#       - Multiple debugging levels
#       - Automatic message truncation when message exceeds providers limit
# 
# 
# Technical Description:
#     Does a standard TCP connect to the providers SNPP service, and sends
#     the message in RFC 1861 compliant manner.
#     
# 
# 
# Changelog:
#     08/29/2002 - v1.0-pre
#         - Script Creation
#
#     08/30/2002 - v1.0-beta1
#         - Added many more providers
#         - Changed listProviders() to sort it's output
#         - Re-wrote the connectTo() function to be compliant with my new
#           standards for function return codes. It now returns 0 on success.
#         - Took out some providers that don't seem to resolve
#
#     10/08/2002 - v1.0-RC1
#         - Added support for paging to multiple devices at once
# 
#     01/31/2003 - v1.00
#         - Version RC1 has been stable and in production for several
#           months, so it is being released as v1.0.
#         - Minor textual changes
#     
#     02/04/2003 - v1.01
#         - Textual changes to a many error messages
#
#     03/28/2003 - v1.02
#         - During SNPP chat, change PAGER command to PAGE.  According to
#           RFC 1861 PAGE is more correct.  This was causing issues with
#           WeblinkWireless2Way as reported by John Olson-Kennedy.
#     
#     11/08/2005 - v1.03
#         - Updated the Verizon SNPP server, thanks to Chris Nowlin for
#           the updated info.
# 
#############################################################################
use strict;
use IO::Socket qw (:DEFAULT :crlf);


## Global Variable(s)
my %conf = (
    "programName"          => $0,                                ## Program name and version
    "version"              => "1.03",
    "authorName"           => 'Brandon Zehm <caspian@dotconf.net> and Steve Kaylor',      ## Information about the author or owner of this script
    "authorEmail"          => 'steversk@steversk.homeip.net',
    "debug"                => 0,
    "error"                => "",                                ## Used for storing error messages
    
    ## These values get used later in the program
    "provider"             => "",
    "message"              => "",
    "receiver"             => "",
    "logFile"              => "",
    "logging"              => "",
);
$conf{"programName"} =~ s/(.)*[\/,\\]//;                         ## Remove path from programName





## Provider hash - edit this to add new providers
## Note that this list IS case sensitive.
## FYI this list came from http://www.notepager.net/snpp.htm
my %provider = (

##  Provider Name                     Hostname                     Port    Max-message-length  ##
    
    "AdvancedPagingWireless"     => [ "gateway.adv-supr.com",      444,    230 ],
    "Airtouch"                   => [ "snpp.airtouch.com",         444,    240 ],
    "AllCom"                     => [ "207.2.221.125",             444,    245 ],
    "Ameritch"                   => [ "pagemart.com",              444,      0 ],
    "AzCom"                      => [ "aszom.net",                 444,      0 ],
    "Baystar"                    => [ "209.44.230.3",              444,      0 ],
    "BellMobility"               => [ "pmcl.net",                  444,      0 ],    
    "CommunicationsSpecialists"  => [ "pageme.comspeco.com",       444,      0 ],
    "ContactPaging"              => [ "207.140.31.163",            444,      0 ],
    "CTC"                        => [ "snpp.metrocall.com",        444,      0 ],
    "DataComm"                   => [ "209.191.211.38",            444,      0 ],
    "DataPage"                   => [ "63.166.125.242",            444,      0 ],
    "DigiPage"                   => [ "page.pageks.com",           444,      0 ],
    "ExtelMobile"                => [ "extel-gsm.com",             444,      0 ],
    "Graylink"                   => [ "epage.graylink.com",        444,      0 ],
    "Highland"                   => [ "alphapage.cc",              444,    250 ],
    "LauttamusCommunications"    => [ "avlc1.lauttamus.com",       444,    250 ],
    "Metrocall"                  => [ "snpp.metrocall.com",        444,    200 ],
    "NetworkServices"            => [ "12.29.171.249",             444,      0 ],
    "Nextel"                     => [ "pecos.nextel.com",          444,      0 ],
    "Nextel2way"                 => [ "snpp.nextel.com",           444,      0 ],
    "NortheastPaging"            => [ "epage.graylink.com",        444,    230 ],
    "OmnicomPaging"              => [ "mail.pagerpeople.com",      444,      0 ],
    "PagemartCanada"             => [ "pmcl.net",                  444,      0 ],
    "PriorityCommunication"      => [ "mail2.sendalpha.com",       444,      0 ],
    "ProPage"                    => [ "page.propage.net",          444,    240 ],
    "Porta-phonePaging"          => [ "epage.porta-phone.com",     444,    150 ],
    "Satellink"                  => [ "snpp.satellink.net",        444,    240 ],
    "Skytel"                     => [ "snpp.skytel.com",           444,    240 ],
    "Verizon"                    => [ "snpp.myairmail.com",        444,      0 ],    
    "WeblinkWireless"            => [ "pagemart.net",              444,      0 ],    
    "WeblinkWireless2Way"        => [ "airmessage.net",            444,      0 ],    

## The folowing services appear to be dead, or we have incorrect information
#    "AAA"                        => [ "wirelessgate.snpp.net",     444,      0 ],
#    "Alphanow"                   => [ "alphanow.net",              444,      0 ],  
#    "Infopage"                   => [ "snpp.infopagesystems.com",  444,      0 ],
#    "Tele-Trak"                  => [ "page.tele-track.com",       444,      0 ],
#    "TSCNet"                     => [ "kes.tscnet.com",            444,      0 ],
#    "UCP"                        => [ "alpahnow.net",              444,    120 ],    

);









#############################
##
##      MAIN PROGRAM
##
#############################


## Process Command Line
processCommandLine();


## Open the log file if needed
if ($conf{'logFile'}) {
    if (openLogFile($conf{'logFile'})) {
        quit("ERROR: An error occured while opening the log file [$conf{'logFile'}].  The error was: $!", 1);
    }
}


## Connect to the correct SNPP server
if (connectTo($provider{$conf{'provider'}}[0], $provider{$conf{'provider'}}[1])) { 
    quit($conf{'error'}, 1);
}


## Send the page
if (SNPPchat($conf{'receiver'}, $conf{'message'})) {
    quit($conf{'error'}, 1);
}


## Disconnect from the server
close SERVER;


## Quit with a nice exit message
quit("SUCCESS: The message was sent successfully to $conf{'receiver'} through $conf{'provider'}.",0);
































######################################################################
## Function:    help ()
##
## Description: For all those newbies ;) 
##              Prints a help message and exits the program.
## 
######################################################################
sub help {
print <<EOM;

$conf{'programName'}-$conf{'version'} by $conf{'authorName'} <$conf{'authorEmail'}>

Usage:  $conf{'programName'} [options]
  
  Required:
    -p <provider>             to see a list of providers try "-h provider"
    -m <message>              message - this is usually limited to 240 characters
    -r <receiver>             usually a pager number (use multiple times for more
                              than one pager - not all SNPP servers support this)
    
  Optional:
    -l <logfile>              enable logging to a file
    -h [provider]             or --help[=provider]
    -v                        verbosity - use multiple times for greater effect

EOM
quit("", 1);
}










######################################################################
## Function:    listProviders ()
##
## Description: Displays the list of providers from the global
##              variable %provider
## 
######################################################################
sub listProviders {
    print "\n$conf{'programName'}-$conf{'version'} by $conf{'authorName'} <$conf{'authorEmail'}>\n\n";
    print "Supported Providers:\n";
    foreach my $key (sort(keys(%provider))) {
        print "    $key\n";
    }
    print "\n";
    return(1);
}










######################################################################
##  Function: initialize ()
##  
##  Does all the script startup jibberish.
##  
######################################################################
sub initialize {

  ## Set STDOUT to flush immediatly after each print  
  $| = 1;

  ## Intercept signals
  $SIG{'QUIT'}  = sub { quit("$$ - EXITING: Received SIG$_[0]", 1); };
  $SIG{'INT'}   = sub { quit("$$ - EXITING: Received SIG$_[0]", 1); };
  $SIG{'KILL'}  = sub { quit("$$ - EXITING: Received SIG$_[0]", 1); };
  $SIG{'TERM'}  = sub { quit("$$ - EXITING: Received SIG$_[0]", 1); };
  
  ## ALARM and HUP signals are not supported in Win32
  unless ($^O =~ /win/i) {
    $SIG{'HUP'}   = sub { quit("$$ - EXITING: Received SIG$_[0]", 1); };
    $SIG{'ALRM'}  = sub { quit("$$ - EXITING: Received SIG$_[0]", 1); };
  }
  
  return(1);
}













######################################################################
##  Function: processCommandLine ()
##  
##  Processes command line storing important data in global var %conf
##  
######################################################################
sub processCommandLine {
  
  
  ############################
  ##  Process command line  ##
  ############################
  
  my $numargv = scalar(@ARGV);
  help() unless ($numargv);
  for (my $counter = 0; $counter < $numargv; $counter++) {
      
      if ($ARGV[$counter] =~ /^-h$|^--help/i) {           ## Help ##
          if ($ARGV[$counter] =~ /provider/i) { 
              listProviders();
              quit("", 1);
          }
          if ( ($ARGV[$counter + 1]) and ($ARGV[$counter + 1] =~ /provider/i) ) {
              listProviders();
              quit("", 1);
          }
          help();
      }
      
      elsif ($ARGV[$counter] =~ s/^-v+//i) {               ## Verbosity ##
          my $tmp = (length($&) - 1);
          $conf{'debug'} += $tmp;
      }
      
      elsif ($ARGV[$counter] =~ /^-p$/i) {                 ## Provider ##
          $counter++;
          $conf{'provider'} = $ARGV[$counter];
      }
      
      elsif ($ARGV[$counter] =~ /^-m$/i) {                 ## Message ##
          $counter++;
          $conf{'message'} = $ARGV[$counter];
      }
      
      elsif ($ARGV[$counter] =~ /^-r$/i) {                 ## Receiver ##
          $counter++;
          $conf{'receiver'} .= "$ARGV[$counter] ";
      }
      
      elsif ($ARGV[$counter] =~ /^-l$/i) {                 ## Log File ##
          $counter++;
          $conf{'logFile'} = $ARGV[$counter];
      }
      
      else {                                               ## Invalid Option ##
          quit("ERROR:  The option '$ARGV[$counter]' is unrecognised.", 1);
      }

  }
  
  ###############################################
  ##  Debugging - Print the contents of %conf  ##
  ###############################################
  
  printmsg ("Configuration: ", 4); foreach my $key (keys(%conf)) { printmsg ("Key: $key =>\t Value: $conf{$key}", 4) if ($key and $conf{$key}); }
  
    
  ###################################################
  ##  Verify required variables are set correctly  ##
  ###################################################
  my @required = (
                    'provider',
                    'message',
                    'receiver',
  );
  foreach (@required) {
      if (!$conf{$_}) {
          quit("ERROR: Value [$_] was not defined.  Try $conf{'programName'} -h", 1);
      }
  }
  
  ## Make sure the reciever value contains only numeric values.
  if ($conf{'receiver'} !~ /^(\d|\s)+$/) {
      quit("ERROR: The receiver value must not contain non-numeric values.", 1);
  }
  
  ## Make sure the provider is valid
  if (!$provider{$conf{'provider'}}[0]) {
      quit("ERROR: The provider [$conf{'provider'}] is not known.  Try \"$conf{'programName'} -h provider\" for a list of providers.", 1);
  }
  
  ## Check message length - if it's too long truncate it and print a warning message
  if ( ($provider{$conf{'provider'}}[2] != 0) and (length($conf{'message'}) > $provider{$conf{'provider'}}[2]) ) {
      printmsg("WARNING: The message your sending will be truncated because it is longer than the limit of $provider{$conf{'provider'}}[2] characters.", 0);
      $conf{'message'} = substr($conf{'message'}, 0, $provider{$conf{'provider'}}[2]);
  }
  
  ## Make sure the message does not have any line ending characters in it.
  $conf{'message'} =~ s/\r\n|\n\r|\r|\n/ /ig;
  
  return(1);
}













###############################################################################################
##  Function:    printmsg (string $message, int $level)
##
##  Description: Handles all messages - logging them to a log file, 
##               printing them to the screen or both depending on
##               the $level passed in, $conf{'debug'} and wether
##               $conf{'mode'}.
##
##  Input:       $message          A message to be printed, logged, etc.
##               $level            The debug level of the message. If
##                                 not defined 0 will be assumed.  0 is
##                                 considered a normal message, 1 and 
##                                 higher is considered a debug message.
##  
##  Output:      Prints to STDOUT, to LOGFILE, both, or none depending 
##               on the state of the program.
##  
##  Example:     ("WARNING: We believe in generic error messages... NOT!\n", 1);
###############################################################################################
sub printmsg {
  my %incoming = ();
  (
    $incoming{'message'},
    $incoming{'level'}
  ) = @_;
  $incoming{'level'} = 0 if (!defined($incoming{'level'}));
  
  ## Print to the log file if $conf{'logging'} is true and $conf{'debug'} >= $incoming{'level'}
  if ($conf{'logging'} and ($conf{'debug'} >= $incoming{'level'}) ) {
      print LOGFILE "$$ - " . localtime() . " - $incoming{'message'}\n";
  }
  
  ## Print to STDOUT always
  if ($conf{'debug'} >= $incoming{'level'}) {
      print "$$ - " . localtime() . " - $incoming{'message'}\n";
  }
  
  ## Return
  return(1);
}













###############################################################################################
## FUNCTION:    
##   openLogFile ( $filename )
## 
## 
## DESCRIPTION: 
##   Opens the file $filename and attaches it to the filehandle "LOGFILE".  Returns 0 on success
##   and non-zero on failure.  Error codes are listed below, and the error message gets set in
##   global variable $!.
##   
##   
## Example: 
##   openFile ("/var/log/scanAlert.log");
##
###############################################################################################
sub openLogFile {
    ## Get the incoming filename
    my $filename = $_[0];
    
    ## Make sure our file exists, and if the file doesn't exist then create it
    if ( ! -f $filename ) {
        printmsg("NOTICE: The file [$filename] does not exist.  Creating it now with mode [0600].", 0);
        open (LOGFILE, ">>$filename");
        close LOGFILE;
        chmod (0600, $filename);
    }
    
    ## Now open the file and attach it to a filehandle
    open (LOGFILE,">>$filename") or return (1);
    
    ## Put the file into non-buffering mode
    select LOGFILE;
    $| = 1;
    select STDOUT;
    
    ## Tell the rest of the program that we can log now
    $conf{'logging'} = "yes";
    
    ## Return success
    return(0);
}












###############################################################################################
## FUNCTION: connectTo($server, $port)
##
##
## DESCRIPTION: 
##   Does a TCP/IP network connect to $server:$port and attaches that connection handle to
##   the socket SOCKET.   If the port is left blank port 80 is assumed.  Returns zero on
##   success and non-zero on failure.  If an error occurs the corrosponding error message
##   will get stored in $conf{'error'}
##   
##   
## EXAMPLE: 
##   connectTo ("www.google.com", 80);
##           
###############################################################################################
sub connectTo {
  ## Get incoming variables
  my %incoming = ();
  ( 
    $incoming{'server'},
    $incoming{'port'}
  ) = @_;
  
  printmsg("connectTo() - function entry", 3);
  
  
  ## Check incoming variables
  $incoming{'port'} = 80 if ($incoming{'port'} eq "");
  if ($incoming{'server'} eq "") {
      $conf{'error'} = "ERROR: connectTo() Incoming \$server variable was empty.";
      return(1);
  }
  
  
  ## Open a IP socket in stream mode with tcp protocol
  printmsg("connectTo() - requesting a streaming tcp/ip socket from the system", 3);
  socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || block {
      $conf{'error'} = "ERROR:  Problem opening a tcp/ip socket with the system.";
      return(2);
  };
  
  
  ## Translating the hostname (or IP) into a socket address structure
  printmsg("connectTo() - translating the hostname (or IP) into a socket address structure", 3);
  my $inet_aton = inet_aton($incoming{'server'}) || block {
      $conf{'error'} = "ERROR: DNS resolution failed for [$incoming{'server'}]";
      return(3);
  };
  
  
  ## Create the data structure $dest by calling sockaddr_in(port, 32bit IP)
  printmsg("connectTo() - packing the port and socket address structure into a single data structure", 3);
  my $dest = sockaddr_in ($incoming{'port'}, $inet_aton) || block {
      $conf{'error'} = "ERROR: Calling sockaddr_in() returned the error: $!";
      return(4);
  };
  
  
  ## Connect our socket to SERVER
  printmsg("connectTo() - connecting the socket to the server", 3);
  connect(SERVER, $dest) || block {
      $conf{'error'} = "ERROR:  Connection attempt to [$incoming{'server'}:$incoming{'port'}] failed! $!";
      return(5);
  };
  printmsg("connectTo() - successfully connected to $incoming{'server'}:$incoming{'port'}", 3);
  
  
  ## Force our output to flush immediatly after a print.
  printmsg("connectTo() - setting non-buffering mode on the network connection", 3);
  select(SERVER);
  $| = 1;
  select(STDOUT);
  
  
  ## Return no errors
  printmsg("connectTo() - sub exit: returning a 0 error-level", 3);
  return(0);
}















###############################################################################################
##  Function:    SNPPchat (string $receiver, string $message )
##
##  Description: Communicates with SNPP server and sends message to 
##               specified pager
##
##  Input:       $receiver         Pager number to send message to.  This may be more than one
##                                 pager number separated by whitespace.  Not all servers 
##                                 support this.
##               $message          Message that will be sent to the pager
##                                
##  
##  Output:      Returns zero on success, or non-zero on error.  
##               Error messages will be stored in $conf{'error'}
##               
##  
##  Example:     ();
###############################################################################################
sub SNPPchat {
    my %incoming = ();
    (
        $incoming{'receiver'},
        $incoming{'message'},
    ) = @_;
    
    
    ## Make sure the system greeted us correctly
    my $status = <SERVER>;
    ## If the result isn't correct, return an error code and message
    if ($status !~ /220/i) {
        $status =~ s/$CRLF//;
        $conf{'error'} = "The system didn't greet us properly!  The server returned [$status]";
        return(1);
    }
    
    
    ## Send the pager number and make sure it accepts it.
    ## I've seen lots of strange errors be returned from this, like "Mailbox Full" and "Unknown Pager ID".
    foreach my $receiver (split(/\s+/, $incoming{'receiver'})) {
        print SERVER "PAGE $receiver$CRLF";
        $status = <SERVER>;
        ## If the result isn't correct, return an error code and message
        if ($status !~ /250/i) {
            $status =~ s/$CRLF//;
            $conf{'error'} = "The Pager ID [$receiver] was rejected with the error [$status].  The pending message was [$incoming{'message'}].";
            return(2);
        }
    }
    
    
    ## Enter message to be sent
    print SERVER "MESS $incoming{'message'}$CRLF";
    $status = <SERVER>;
    ## If the result isn't correct, return an error code and message
    if ($status !~ /250/i) {
        $status =~ s/$CRLF//;
        $conf{'error'} = "Error requesting permission to send a message.  The server returned [$status]";
        return(3);
    }
    
    
    ##  Send the actual message
    print SERVER "SEND$CRLF";
    $status = <SERVER>;
    ## If the result isn't correct, return an error code and message
    if ($status !~ /250/i) {
        $status =~ s/$CRLF//;
        $conf{'error'} = "The message was rejected with the error [$status]";
        return(4);
    }
    
    
    ##  Quit to terminate the connection
    print SERVER "QUIT$CRLF";
    $status = <SERVER>;
    ## If the result isn't correct, return an error code and message
    if ($status !~ /221/i) {
        $status =~ s/$CRLF//;
        $conf{'error'} = "The QUIT command failed with the error [$status]";
        return(5);
    }
    
    
    ## Return Success
    return(0);
}












#####################################################################
##  Function:    quit (string $message, int $errorLevel)
##  
##  Description: Exits the program, optionally printing $message.  It 
##               returns an exit error level of $errorLevel to the 
##               system  (0 means no errors, and is assumed if empty.)
##
##  Example:     quit("Exiting program normally", 0);
######################################################################
sub quit {
  my %incoming = ();
  (
    $incoming{'message'},
    $incoming{'errorLevel'}
  ) = @_;
  $incoming{'errorLevel'} = 0 if (!defined($incoming{'errorLevel'}));
  
  
  ## Print exit message
  if ($incoming{'message'}) { 
    printmsg("$incoming{'message'}", 0);
  }
  
  ## Exit the program
  exit($incoming{'errorLevel'});
}

    

syntax highlighted by Code2HTML, v. 0.9.1