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