[Prev][Next][Index][Thread]

A (perl) script to shutdown jigsaw




This script will fetch a URL, and allow to provide a username password
on the command line. To kill your jigsaw, use something like:

-----
#!/bin/sh
exec url_simple_request -u <admin-user> -p <admin-password> \
    http://<your-jigsaw>/Admin/Exit
-----

This requires that you put the password in the clear in the script, it
s therefore recommended to use both IP and Basic auth to protect
/Admin/Exit...

Thanks to Jean-Luc,

Anselm.
-----
#!/usr/local/bin/perl5  
#
#
# Send a very simple request to an hhtp server.
# The main goal of this script is to administrate
# the W3C jigsaw server
# 
#
# Author: Jean-Luc.Szpyrka@sophia.inria.fr
# Date  : Marc 13th 1997
#
#
#
# Options: 
#      -v          : verbose
#      -u user     : define a username 
#      -p password : define a password
#
# if both user and password are defined, then 
# the request header contains a base64 encoded
# basic user authentification
#
# Remark: to make this script self-sufficient, 
# all the necessary packages has been included at the end 
# of it. If these packages are installed on your site
# and if you prefer to use them, you can uncomment 
# the following 'require' statements
#
# These packages are:
#    getopts.pl from perl5 distrib (require 'getopts.pl') 
#    URL.pl,url_get.pl from CERN (require 'url_get.pl')
#

$usage="url_simple_request.pl [-v][-u user -p password][-h] URL

Send a very simple request to an hhtp server.
The main goal of this script is to administrate
the W3C jigsaw server

Options: 
     -v          : verbose
     -u user     : define a username 
     -p password : define a password
     -h          : help

if both user and password are defined, then 
the request header contains a base64 encoded
basic user authentification
";

&Getopts('vu:p:h') || die "$usage";
die "$usage" if $opt_h || $#ARGV < 0;
if ($opt_u) { $user=$opt_u;} ;
if ($opt_p) { $passwd=$opt_p;} ;
if ($opt_u && $opt_p) { $encode=1; } else {$encode=0} ;
if ($opt_v) {$verbose=1;} else {$verbose=0;};
&verbose("Verbose mode selected");
$url_to_get=$ARGV[0];
&verbose("URL to get = <$url_to_get>");

#
# parse the given URL
#
($protocol, $host, $port, $file) = &parse_url($url_to_get);
&verbose("protocol=$protocol\nhost=$host\nport=$port\nfile=$file");
die "Invalid URL ($url_to_get)" if !$protocol || (!$port && !file) || !host ;

#
# find the IP of the given host
#
if ($host =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
    $destaddr = pack('C4', $1, $2, $3, $4);
} else {
    @temp = gethostbyname($host);
    die "Can't get IP address of $host" unless (@temp);
    $destaddr = $temp[4];
}
#&verbose("destaddr=$destaddr");
#
# find our IP
#
chop($hostname = `hostname`);
@temp = gethostbyname($hostname);
die "Can't get my IP address" unless (@temp);
$srcaddr = $temp[4];

#
# open a tcp connection with this machine
require 'sys/socket.ph';

$proto = (getprotobyname("tcp"))[2];
$sockaddr = 'S n a4 x8';
$src =  pack($sockaddr, &AF_INET, 0    , $srcaddr);
$dest = pack($sockaddr, &AF_INET, $port, $destaddr);

socket(SOCKET, &PF_INET, &SOCK_STREAM, $proto) || die "Cannot open socket: $!";
bind(SOCKET, $src) || die "Cannot bind socket: $!";
connect(SOCKET, $dest) || die "Cannot connect to socket: $!";

#
# send the request to this server
#
select SOCKET; $|=1; select STDOUT;
print SOCKET "GET $file HTTP/1.0\n";
&verbose("SOCKET -> GET $file HTTP/1.0");

if ($encode)  {
    $cookie = &to64("$user:$passwd");
    print SOCKET "Authorization: Basic $cookie\n";
    &verbose("SOCKET -> Authorization: Basic $cookie");
}
print SOCKET "\n";
&verbose("SOCKET ->");

#
# read the answer from the server
# 
while(<SOCKET>) {
    print;
}
#
# close everything
#
close(SOCKET);


# 
sub verbose {
    print "@_\n" if $verbose;
}
#
# ####### /usr/lib/perl5/getopts.pl ########
#

;# getopts.pl - a better getopt.pl

;# Usage:
;#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
;#                           #  side effect.

sub Getopts {
    local($argumentative) = @_;
    local(@args,$_,$first,$rest);
    local($errs) = 0;
    local($[) = 0;

    @args = split( / */, $argumentative );
    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
	($first,$rest) = ($1,$2);
	$pos = index($argumentative,$first);
	if($pos >= $[) {
	    if($args[$pos+1] eq ':') {
		shift(@ARGV);
		if($rest eq '') {
		    ++$errs unless @ARGV;
		    $rest = shift(@ARGV);
		}
		eval "\$opt_$first = \$rest;";
	    }
	    else {
		eval "\$opt_$first = 1";
		if($rest eq '') {
		    shift(@ARGV);
		}
		else {
		    $ARGV[0] = "-$rest";
		}
	    }
	}
	else {
	    print STDERR "Unknown option: $first\n";
	    ++$errs;
	    if($rest ne '') {
		$ARGV[0] = "-$rest";
	    }
	    else {
		shift(@ARGV);
	    }
	}
    }
    $errs == 0;
}

####### end of getopts.pls ########

#
# ########## URL.pl ############
#
#
# URL.pl - package to parse WWW URLs
#
# @(#)URL.pl	1.7 26 Sep 1995
# @(#)URL.pl	1.7 /home/magenta/cc/dc/zippy/src/perl/url_get/SCCS/s.URL.pl
#
# Hacked by Stephane Bortzmeyer <bortzmeyer@cnam.cnam.fr> to add support
# for empty paths in URLs and to accept dashes in host names. 22 Jan 1994
#
# Jack Lund 9/3/93 zippy@ccwf.cc.utexas.edu
#
# syntax: &url'parse_url(URL)
# returns array containing following:
# 	protocol	protocol string from url. ex: "gopher", "http".
#	host		host that specified protocol server is running on
#	port		port that server answers on
# the rest of the array is protocol-dependant. See code for details.
#

sub parse_url {
    local($url) = @_;

    if ($url =~ m#^(\w+):#) {
	$protocol = $1;
	$protocol =~ tr/A-Z/a-z/;
    } else {
	return undef;
    }

    if ($protocol eq "file" || $protocol eq "ftp") {

# URL of type: file://hostname[:port]/path

	if ($url =~ m#^\s*\w+://([^ \t/:]+):?(\d*)(.*)$#) {
	    $host = $1;
	    $host =~ tr/A-Z/a-z/;
	    $port = ($2 ne "" ? $2 : 21);
	    if ($host eq "localhost") {
		$port = undef;
	    }
	    $path = ($3 ? $3 : '/');
	    return ($protocol, $host, $port, $path);
	}

# URL of type: file:/path

	if ($url =~ m#^\s*\w+:(.*)$#) {
	    $host = "localhost";  # Current host
	    $port = undef;
	    return ($protocol, $host, $port, $1);
	}
	return undef;
    }

# URL of type: http://host[:port]/path[?search-string]

    if ($protocol eq "http") {
	if ($url =~ m#^\s*\w+://([\w-\.]+):?(\d*)([^ \t]*)$#) {
	    $server = $1;
	    $server =~ tr/A-Z/a-z/;
	    $port = ($2 ne "" ? $2 : 80);
	    $path = ( $3 ? $3 : '/');
	    return ($protocol, $server, $port, $path);
	}
	return undef;
    }
}
######## end of URL.pl ########

####### 64 encoding from url_get.pl #######
# @(#)url_get.pl	1.18 22 Jan 1996
# @(#)url_get.pl	1.18 /home/magenta/cc/dc/zippy/src/perl/url_get/SCCS/s.url_get.pl
#
# url_get.pl      --- get a document given a WWW URL
#
# Modified by Jack Lund 7/19/94 to add functionality and deal with HTTP
# 1.0 headers
#
# Hacked by Stephane Bortzmeyer <bortzmeyer@cnam.cnam.fr> to add "ftp" URLs.
# 22 Jan 1994
#
# Jack Lund 9/3/93 zippy@ccwf.cc.utexas.edu
#
# from hget by:
# Oscar Nierstrasz 26/8/93 oscar@cui.unige.ch

sub to64 {
    local($instring) = @_;
    local($out) = "";
    local($chunk, $i, $index, $len, $bitstring);
    local($basis_64) = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
    
    $len = length($instring);
    
    $i = 0;
    while ($i < $len) {
        $chunk = pack("a3", substr($instring, $i));
        $i += 3;
	$bitstring = unpack("B*", $chunk);
        $index = ord(pack("B8", "00".substr($bitstring, 0, 6)));
        $out .= substr($basis_64, $index, 1);
        $index = ord(pack("B8", "00".substr($bitstring, 6, 6)));
        $out .= substr($basis_64, $index, 1);
        if ($i == $len + 2) {
            $out .= "=";
        }
        else {
            $index = ord(pack("B8", "00".substr($bitstring, 12, 6)));
            $out .= substr($basis_64, $index, 1);
        }
        if ($i >= $len + 1) {
            $out .= "=";
        }
        else {
            $index = ord(pack("B8", "00".substr($bitstring, 18, 6)));
            $out .= substr($basis_64, $index, 1);
        }
    }
    
    return $out;
}
###########

#
# $Logs$
#