#!/usr/bonsaitools/bin/perl --
#
# gifsize: adds HEIGHT= and WIDTH= to images referenced in specified HTML
# file.
#
# Gifsize's home is: http://www.ugcs.caltech.edu/~werdna/gifsize/
#
# if HEIGHT= and WIDTH= fields are already present, this will try to
# re-calculate them
#
#  Usage: gifsize <name of HTML file(s)>
#    -- renames original HTML file to *.html.bak
#
#
#
#  Andrew Tong, werdna@ugcs.caltech.edu
#
#  Version 0.5, 19 January 1995
#       Fixed some serious bugs in the regular expressions.
#       gifsize will now tell you what it's working on as it chugs along
#       Now, it won't run if it finds a .html.bak file already existing.
#
#  Version 0.2, 16 January 1995
#  some code based on "client", an example program from Programming Perl,
#       pp 342-344
#
# Supported URL conventions:
#   o Relative path referencing ("images/title.gif")
#   o Absolute path referencing ("/ports/images/title.gif")
#   o Absolute referencing into user directory ("/~user/images/title.gif")
#   o Full URLs ("http://www.ugcs.caltech.edu/whatsnew.gif")
#
# Known bugs in V0.5: 
#
#   - Is known to screw up all your links---hard and symbolic
#   - Chokes on inlined JPEGs
#   - Confuses LOWSRC with SRC
#   - queries to other servers tend to die ungracefully if connection is 
# refused, or if it times out.  In fact, the entire program may die rather 
# ungracefully if you've got a gif that's referenced incorrectly, or if 
# you've referenced a non-existent or corrupted GIF.
#
# At least it shouldn't munge your HTML in these cases, though....
#
#
#
#
#  THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT WARRANTY OF ANY KIND.
#
#                    !!   USE AT YOUR OWN RISK   !!
#
#
#
#
#
#       Variables:                              Description
#
#       $SearchURLS                     Set to YES to enable connecting
#                                       to other servers to grab gifs
#                                       referenced as http://foo.com/1.gif
#
#       $DocumentRoot                   Set to DocumentRoot, as defined
#                                       in your srm.conf file.  Needed if
#                                       if want to process URLs that look
#                                       like <IMG SRC="/images/foo.gif">
#
#       $HOMEDIRS                       Set to directory where home
#                                       directories are located.  This
#                                       is needed if you want to process
#                                       URLs that look like:
#                                       <IMG SRC="/~user/pics/foo.gif">
#
#       $UserDir                        Set to directory where users keep
#                                       their web documents, as defined in
#                                       srm.conf.  This is needed if you
#                                       want to process URLs that look like:
#                                       <IMG SRC="/~user/pics/foo.gif">
#

$SearchURLS = 'YES';
$DocumentRoot = "/usr/local/etc/httpd/htdocs";
$UserDir = "public_html";
$HOMEDIRS = "/home";

############################################################################
# Main routine.  processes all files specified on command line, skipping
# any file for which a .bak file exists.
############################################################################

foreach $FILE (@ARGV) {
    if (open(TEST, "<$FILE.bak")) {
         print "Skipping $FILE -- found $FILE.bak\n";
         close(TEST);
    } else {
    print "Converting $FILE\n";
    &convert($FILE);
    }
}



###########################################################################
# Subroutine does all the actual HTML parsing --- grabs GIF URLs and tells
# other routines to open the images and get their size
###########################################################################

sub convert {
    local($file) = @_;
    local($original);
    open(ORIGINAL, "<$file") || die "Couldn't open $file\n";
    while (<ORIGINAL>) {
        $original .= $_;
    }
    close (ORIGINAL);
    @PATH = split(/\//, $file);
    pop(@PATH);
    $REL = join("/", @PATH);
    
    @original=split(/</, $original);
    for ($i=0; $i <= $#original; $i++) {

        if ($original[$i] =~ /[^\000]*img[^\000]*src\s*=\s*"[^\000]*"[^\000]*>[^\000]*/i) {
            $original[$i] =~ s/\s*width\s*=\s*\d*\s*/ /gi;
            $original[$i] =~ s/\s*height\s*=\s*\d*\s*/ /gi;
            $_ = $original[$i];
            ($one, $two, $three, $four, $five, $six, $seven) = /([^\000]*)img([^\000]*)src(\s*)=(\s*)"([^"]*)"([^\000]*)>([^\000]*)/i; #"
            print "\tProcessing GIF $five...\n";
            if ($five =~ /^\/\~.*/) {
                @PATH = split(/\//, $five);
                shift(@PATH); $user = shift(@PATH) ; $rel = join ("/", @PATH);
                $user =~ s/^\~//;
                $size = &gifsize("$HOMEDIRS/$user/$UserDir/$rel");
                $original[$i] = join("", $one, 'IMG', $two, " ", $size, " ", 'SRC', $three, '=', $four, '"', $five, '"', $six, '>', $seven); 
            } elsif ($five =~ /^http:\/\/.*/) {
                if ($SearchURLS eq 'YES') {
                    ($dummy, $dummy, $server, $url) = split(/\//, $five, 4);
                    ($them,$port) = split(/:/, $server);
                    $size = &URLsize($them,$port);
                    $original[$i] = join("", $one, 'IMG', $two, " ", $size, " ", 'SRC', $three, '=', $four, '"', $five, '"', $six, '>', $seven); 
                }
            } elsif ($five =~ /^\/.*/) {
                $size = &gifsize("$DocumentRoot$five");
                $original[$i] = join("", $one, 'IMG', $two, " ", $size, " ", 'SRC', $three, '=', $four, '"', $five, '"', $six, '>', $seven); 
            } else {
                if ($REL eq '') {
                    $size = &gifsize("$five");
                } else {
                    $size = &gifsize("$REL/$five");
                }
                $original[$i] = join("", $one, 'IMG', $two, " ", $size, " ", 'SRC', $three, '=', $four, '"', $five, '"', $six, '>', $seven); 
            }
        }
    }
    rename($file, "$file.bak");
    open(CONVERTED, ">$file") || die "Could not write to $file!\n";
    print CONVERTED join("<", @original);
    close(CONVERTED);
}


###########################################################################
# Subroutine gets the size of the specified GIF
###########################################################################

sub gifsize {
local($filename) = @_;
open(GIF, "<$filename") || die "Can't open GIF $filename\n"; 
read(GIF, $type, 6); $type =~ /GIF8[7,9]a/ || die "Invalid GIF $filename\n"; 
read(GIF, $s, 4) == 4 || die "Corrupted GIF!\n"; close(GIF);
($a,$b,$c,$d)=unpack("C"x4,$s);
join ("", 'WIDTH=', $b<<8|$a, ' HEIGHT=', $d<<8|$c);
}

###########################################################################
# Subroutine grabs a gif from another server, and gets its size
###########################################################################

sub URLsize {
local($them,$port) = @_;
$port = 80 unless $port;
$them = 'localhost' unless $them;

$AF_INET = 2;
$SOCK_STREAM = 1;

$SIG{'INT'} = 'dokill';
sub dokill {
    kill 9,$child if $child;
}

$sockaddr = 'S n a4 x8';

chop($hostname = `hostname`);

($name,$aliases,$proto) = getprotobyname('tcp');
($name,$aliases,$port) = getservbyname($port,'tcp')
    unless $port =~ /^\d+$/;;
($name,$aliases,$type,$len,$thisaddr) =
        gethostbyname($hostname);
($name,$aliases,$type,$len,$thataddr) = gethostbyname($them);

$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
$that = pack($sockaddr, $AF_INET, $port, $thataddr);

# Make the socket filehandle.

die $! unless (socket(S, $AF_INET, $SOCK_STREAM, $proto)); 

# Give the socket an address.

die $! unless (bind(S, $this));

# Call up the server.

die $! unless (connect(S,$that));

# Set socket to be command buffered.

select(S); $| = 1; select(STDOUT);

print S "GET /$url\n";
read(S, $type, 6); $type =~ /GIF8[7,9]a/ || die "Invalid GIF $url\n"; 
read(S, $s, 4) == 4 || die "Corrupted GIF $url!\n";
shutdown(S, 2);
($a,$b,$c,$d)=unpack("C"x4,$s);
join ("", 'WIDTH=', $b<<8|$a, ' HEIGHT=', $d<<8|$c);
}
