1#!/usr/bin/perl -w
2#
3#
4# Simple program to connect to:
5#     http://www2.pagemart.com/cgi-bin/rbox/pglpage-cgi
6# and send a page.
7#
8# Modified 10/21/99 Will O'Brien willo@savvis.net
9# Originally Written by David Allen s2mdalle@titan.vcu.edu
10# http://opop.nols.com/
11#
12#
13# Modified by R. Wichmann (read message from stdin)
14# <support@la-samhna.de>
15#
16# - added config variables
17# - read MESSAGE from STDIN
18#
19# This file is released under the terms of the GNU General Public License.
20# Please see http://www.gnu.org for more details.
21#
22# This program still beta, but working better.
23#
24# Changelog:
25# 10/21/99:  Modified original code and get paging to function.
26# 10/22/99:  Fixed Error checking.  Checks PIN length, outputs failure message.
27#
28# REQUIRES MODULES:  strict and IO::Socket
29#
30# USAGE FROM COMMAND LINE:  echo "message" | example_pager.pl PAGER_PIN
31# Where PAGER_PIN is the PIN of the pager you want to send MESSAGE to.
32#
33# This program will send the page using
34# www.pagemart.com/cgi-bin/rbox/pglpage-cgi
35# and will store the response in LASTRESPONSE.html when the server replies.
36#
37# If you are looking at this program for examples of code to make it work,
38# check out the page{} subroutine below - it is the meat of this program.
39##############################################################################
40
41# use Socket;                   # INET
42use strict;
43use IO::Socket;               # Socket work
44
45my $pagerid = shift;
46
47########################## -- BEGIN CONFIGURATION --
48
49## set to 1 for verbose output
50my $verbose = 1;
51
52## set to 1 if you want to save response
53my $save_response = 1;
54
55## set to 1 to enable sending
56my $really_send = 0;
57
58########################### -- END  CONFIGURATION --
59
60# previous
61#my $MESSAGE = join(' ', @ARGV);
62
63my $MESSAGE='';
64undef $/;
65$MESSAGE=<STDIN>;
66$MESSAGE =~ s/\[EOF\]//g;
67
68die "Usage:  echo \"message\" \| example_pager.pl PAGER_ID\n\n"
69    unless $pagerid;
70die "Usage:  echo \"message\" \| example_pager.pl PAGER_ID\n\n"
71    unless $MESSAGE;
72
73page($pagerid, $MESSAGE);
74
75if ($verbose) { print "Done.\n"; }
76exit(0);
77
78############################################################################
79
80sub page{
81    my ($name, $text) = @_;
82    my $TRUNCATED = 0;
83    my $PAGE = "";  # The text sent to www.pagemart.com - appended later.
84
85    $pagerid = $name;
86
87    if ($verbose) { print STDERR "Processing pager ID...\n"; }
88    # Eliminate everything but numbers from the pager id
89    $pagerid =~ s/[^0-9]//g;
90
91    # Check the pager id length and so on.
92    if( (((length($pagerid)) < 7)) || ((length($pagerid)) > 10) )
93    {
94	if ($verbose) {
95	    die "Bad pager ID number. A pager id number is 7 or 10 numbers.\n";
96	}
97	else {
98	    exit (1);
99	}
100    }
101
102    if ($verbose) {
103	die "No message specified.\n" unless $text;
104    }
105    else {
106	exit (1) unless $text;
107    }
108
109
110    # This is the format of the message we're going to send via the TCP
111    # socket
112    # POST /cgi-bin/rbox/pglpage-cgi HTTP/1.0
113    # User-Agent: Myprogram/1.00
114    # Accept: */*
115    # Content-length: 35
116    # Content-type: application/x-www-form-urlencoded
117    #
118    # pin2=6807659&message1=stuff+and+nonsense
119
120    if ($verbose) { print STDERR "Processing text of message...\n"; }
121    # A bit of string pre-processing
122    chomp $text;
123    my $strdelim       = "\r\n";    # At the end of each line.
124
125    # Compress the text a bit - eliminate redundant characters - this
126    # helps a lot for pages that have multiple spaces and so on.
127    $text =~s/\n/ /g;          # Linefeeds are spaces
128    $text =~s/\r//g;           # No carriage returns
129    $text =~s/\s+/ /g;         # Multiple whitespace -> one space.
130
131    if(length($text)>=200)
132    {
133	$TRUNCATED = "True";
134	$text = substr($text, 0, 199);      # 200 Character maximum
135    }
136
137    my $encodedmessage = urlencode($text);
138
139    # The length of the request has to be TOTAL QUERY.  If it's just
140    # the length of the string you're sending, it will truncate the
141    # hell out of the page.  So the pager number is length($pagerid)
142    # of course the length of the message, and add the length of the
143    # parameter flags, (PIN= and ?MSSG=) and you're done.
144
145    my $xxmsg = "pin2=$pagerid&";
146    $xxmsg .= "PAGELAUNCHERID=1&";
147    $xxmsg .= $encodedmessage;
148
149    # my $pagelen=length($encodedmessage)+length("pin2=?message1=")+
150    #	length($pagerid)+;
151
152    my $pagelen = length($xxmsg);
153
154    # Build the text we send to the server
155    $PAGE  = "POST /cgi-bin/rbox/pglpage-cgi HTTP/1.0$strdelim";
156    $PAGE .= "User-Agent: Pagent/5.4$strdelim";
157    $PAGE .= "Referer: http://www.weblinkwireless.com/productsnservices/sendingmessage/pssm-sendamessage.html$strdelim";
158    $PAGE .= "Accept: */*$strdelim";
159    $PAGE .= "Content-length: $pagelen$strdelim";
160    $PAGE .= "Content-type: application/x-www-form-urlencoded$strdelim";
161    $PAGE .= "$strdelim";
162    # $PAGE .= "pin2=$pagerid&message1=".$encodedmessage;
163    $PAGE .= $xxmsg;
164
165    if ($verbose) {
166	print STDERR "Sending message...\n\n";
167	print STDERR "$PAGE\n\n";
168    }
169
170
171    my $document='';
172
173    if ($really_send)
174    {
175	# Now we send our data.
176	# Note that this is just quick and dirty, so I'm using a perl module
177	# to do the network dirty work for me.
178	my $sock = IO::Socket::INET->new(PeerAddr => 'www2.pagemart.com',
179					 PeerPort => 'http(80)',
180					 Proto    => 'tcp');
181
182	if ($verbose) {
183	    die "Cannot create socket : $!" unless $sock;
184	}
185	else {
186	    exit (1) unless $sock;
187	}
188	$sock->autoflush();
189	$sock->print("$PAGE");
190
191	$document = join('', $sock->getlines());
192    }
193    else
194    {
195	$document = " really_send was set to 0, page NOT sent";
196    }
197
198    if ($save_response)
199    {
200	if ($verbose)
201	{
202	    print STDERR "Saving response to tmp.html...\n\n";
203	}
204	my $status = 0;
205	open(TMP,">tmp.html") or $status=1;
206	print TMP "$document\n" unless $status;
207	close TMP unless $status;
208    }
209
210    if($document =~ m/NOT/g)
211    {
212	if ($verbose)
213	{
214	    print STDERR "Page not sent.  There was an error. \n";
215	    print STDERR "See tmp.html for what the server sent back to me.\n";
216	}
217	exit(0);
218    } # End if
219    else
220    {
221	if ($verbose)
222	{
223	    $document =~ m/(\d{1,4}) character message out of/g;
224	    print STDERR "Page sent successfully to $pagerid.\n";
225	}
226	exit(0);
227    } # End else
228} # End sub page
229
230
231############################################################################
232
233sub urlencode{
234    my $text    = shift;
235    my $input   = $text;
236
237    chomp $input;
238
239    # Translate all non-letter non-number characters into their %HEX_VAL
240    # and return that string.
241    $input =~ s/([^a-zA-Z0-9-_\.\/])/uc sprintf("%%%02x",ord($1))/eg;
242    $input =~ s/%20/+/g;
243
244    return $input;
245} # End sub urlencode
246