source: trunk/scripts/example_pager.pl@ 101

Last change on this file since 101 was 1, checked in by katerina, 19 years ago

Initial import

File size: 6.6 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.