[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]

[MacPerl-WebCGI] 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-webcgi-request@macperl.org