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
|
---|
42 | use strict;
|
---|
43 | use IO::Socket; # Socket work
|
---|
44 |
|
---|
45 | my $pagerid = shift;
|
---|
46 |
|
---|
47 | ########################## -- BEGIN CONFIGURATION --
|
---|
48 |
|
---|
49 | ## set to 1 for verbose output
|
---|
50 | my $verbose = 1;
|
---|
51 |
|
---|
52 | ## set to 1 if you want to save response
|
---|
53 | my $save_response = 1;
|
---|
54 |
|
---|
55 | ## set to 1 to enable sending
|
---|
56 | my $really_send = 0;
|
---|
57 |
|
---|
58 | ########################### -- END CONFIGURATION --
|
---|
59 |
|
---|
60 | # previous
|
---|
61 | #my $MESSAGE = join(' ', @ARGV);
|
---|
62 |
|
---|
63 | my $MESSAGE='';
|
---|
64 | undef $/;
|
---|
65 | $MESSAGE=<STDIN>;
|
---|
66 | $MESSAGE =~ s/\[EOF\]//g;
|
---|
67 |
|
---|
68 | die "Usage: echo \"message\" \| example_pager.pl PAGER_ID\n\n"
|
---|
69 | unless $pagerid;
|
---|
70 | die "Usage: echo \"message\" \| example_pager.pl PAGER_ID\n\n"
|
---|
71 | unless $MESSAGE;
|
---|
72 |
|
---|
73 | page($pagerid, $MESSAGE);
|
---|
74 |
|
---|
75 | if ($verbose) { print "Done.\n"; }
|
---|
76 | exit(0);
|
---|
77 |
|
---|
78 | ############################################################################
|
---|
79 |
|
---|
80 | sub 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 |
|
---|
233 | sub 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
|
---|