[Date Prev][Date Next][Thread Prev][Thread Next]
[Search]
[Date Index]
[Thread Index]
[MacPerl] LWP Example -- kill WebSTAR 2.0 suffix maps
Hi All.
Been hacking a lot of MacPerl stuff at work the last few days.
Can I just say that MacPerl is cool. And BBEdit is cool.
Most of my scripts are one-shot tricks, but this one might
prove to be more generally useful. Some background: In my
job, among other things, I keep an eye on about 25 WebSTAR 2.0
servers. Today I had to remove a suffix map from all of 'em.
So I wrote a perl script to do it. Then I was so excited about
the success, that I spent some extra time to generalize the
code and comment it. Partly inspired by Kevin Reid, I thought
I'd post it.
-Eric
#!perl
# kill_WWW‡_suffix_map.pl
# by Eric Dobbs <dobbs@dobbse.net>
# a script to remove suffix maps from a
# collection of WebSTAR 2.0 servers
# If you only have one server to tweek,
# then you should just use a web browser.
# But if you need to make the same change
# across more than 5 servers, doing it by
# hand is tedious. Whereas hacking perl
# is fun. 8^)
use strict;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Request::Common;
use HTTP::Response;
# need to do this for 25 servers
# each element in this array contains a reference to an anonymous array
# each anonymous array contains the following info:
# nickname domain or ip realm login realm password
my @servers = (
[qw(server1 one.somewhere.com pi_admin password)],
[qw(server2 two.somewhere.com pi_admin password)],
[qw(server3 three.somewhere.com pi_admin password)],
[qw(server4 four.somewhere.com pi_admin password)]
);
# these are the fields in WebSTARs suffix maps.
# they're used in a regex match below. The
# suffix map here is for Tango version 2 -- we
# have just finished upgrading to Tango 3. If
# you do web database development and do not
# know Tango: http://www.pervasive.com
# On the other hand, if you know CGI.pm and DBI.pm ...
# ... but then you are probably using unix 8^)
my $webstar_action = q(TANGO);
my $webstar_suffix = q(\.QRY);
my $webstar_file_type = q([^<\015\012]*); # The fields are wrapped in
my $webstar_file_creator = q([^<\015\012]*); # <TD></TD> tags. These match
my $webstar_MIME_type = q([^<\015\012]*); # everything up to the next <
foreach (@servers) {
my ($name,$ip,$user,$pw) = @$_;
# this is the WebSTAR 2.0 url for text-only modification of suffix maps
my $url = qq(http://$ip/pi_admin_ssi.admin\$adm_suffixmappingstext.ssi);
my $ua = LWP::UserAgent->new();
my $req = HTTP::Request->new(GET => $url);
# This is important. Need to give our UserAgent the
# login name and password for realm authentication.
$req->authorization_basic($user,$pw);
print qq($name\t) . $req->url() . qq(\n);
my $response = $ua->request($req);
if ($response->is_error()) {
print $response->status_line . qq(\n);
} else {
# successfully grabbed the page from the server,
# so now lets see if we can find and remove the suffix
my $content = $response->content();
# here is where we are matching the fields defined above.
# this is grabbing the values needed in POST arguments
# below.
$content =~ m|<TD>$webstar_action</TD>
<TD>$webstar_suffix</TD>
<TD align=CENTER>$webstar_file_type</TD>
<TD align=CENTER>$webstar_file_creator</TD>
<TD>$webstar_MIME_type</TD>
<TD align=CENTER><INPUT TYPE="radio" NAME="selection" VALUE="(\d+)" ></TD>
<TD align=CENTER><INPUT TYPE="number" NAME="order(\d+)" VALUE="(\d+)" SIZE=4 MAXLENGTH=6></TD>|;
my ($selection,$ordernum,$orderval) = ($1,$2,$3);
# if you look at the source for WebSTARs suffix maps,
# you'll find some hidden fields. We'll send these in
# our POST arguments too.
my ($last_locked,$list_count) = ($content =~
m|<INPUT TYPE="hidden" NAME="last_locked" VALUE="(\d+)"><INPUT TYPE="hidden" NAME="list_count" VALUE="(\d+)">|);
print qq(\tselection:$selection\t\tlist_count before:$list_count);
# little error checking -- do not want to delete the
# suffix map unless it is really the one
if (defined($selection) and
defined($ordernum) and
defined($orderval)) {
# This is where all the magic happens. LWP is cool.
# Here we POST the necessary arguments to the server.
# You could also modify this code to add a suffix map.
# One thing -- the $ua object must be remembering the
# authentication information from the last request,
# because none of that is specified here.
$response = $ua->request(POST $url,[
service => qq(suffix_mappings),
last_locked => $last_locked,
list_count => $list_count,
selection => qq($selection),
button => qq(Delete Selection)
]);
if ($response->is_error()) {
print qq(\n) . $response->status_line . qq(\n);
} else {
$content = $response->content();
($last_locked,$list_count) = ($content =~
m|<INPUT TYPE="hidden" NAME="last_locked" VALUE="(\d+)"><INPUT TYPE="hidden" NAME="list_count" VALUE="(\d+)">|);
print qq(\tafter:$list_count);
}
}
print qq(\n\n);
}
}
__END__
-----begin Example output-----
server1 http://one.somewhere.com/pi_admin_ssi.admin$adm_suffixmappingstext.ssi
selection:12 list_count before:35 after:34
server2 http://two.somewhere.com/pi_admin_ssi.admin$adm_suffixmappingstext.ssi
selection: list_count before:34
server3 http://three.somewhere.com/pi_admin_ssi.admin$adm_suffixmappingstext.ssi
500 # Can't resolv address for three.somewhere.com
File 'Macintosh HD:Applications:MacPerl Ÿ:lib:LWP:Protocol:http.pm'; Line 64
server4 http://four.somewhere.com/pi_admin_ssi.admin$adm_suffixmappingstext.ssi
selection:12 list_count before:35 after:34
-----end Example output-----
In this example, server 1 succeeded. 'selection' has a value,
and the 'after' count is 1 less than the 'before' count.
On server 2, the connection and proccessing was successful, but
the suffix in question could not be found. 'selection' does not
have a value, and there is no 'after' count.
The program could not connect to server 3.
Server 4 is another successful one -- shown here mainly to indicate
that the script will continue processing if it hits a server that
it cannot connect to.
===== Want to unsubscribe from this list?
===== Send mail with body "unsubscribe" to macperl-request@macperl.org