- From: Anselm Baird_Smith <abaird@www43.inria.fr>
- Date: Thu, 3 Apr 1997 15:25:35 +0200 (MET DST)
- To: www-jigsaw@w3.org
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$
#
Received on Thursday, 3 April 1997 08:25:39 UTC