#!/usr/bin/perl
#
# upload.pl
#
# Usage upload.pl <source directory> <ftp site> <user name> <password>
# <ftp directory>
#
#
# Script for generating the ftp commands to logicalshift.org.uk
# Copyright (C) 1999 Andrew Hunter (andrew@logicalshift.org.uk)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#
# Contributor(s): No one yet.
#
use Net::FTP;
use IO::Handle;
use DirHandle;
use File::stat;
use POSIX;
use Time::gmtime;
use Time::Local;
$DEBUG=0;
# Constants & tables
%months = ( Jan => 0,
Feb => 1,
Mar => 2,
Apr => 3,
May => 4,
Jun => 5,
Jul => 6,
Aug => 7,
Sep => 8,
Oct => 9,
Nov => 10,
Dec => 11 );
$now = gmtime();
$year = $now->year();
$sourcedir = $ARGV[0];
$ftpsite = $ARGV[1];
$username = $ARGV[2];
$password = $ARGV[3];
$ftpdir = $ARGV[4];
# Functions
# If your ftp server uses a different format from the one used here, try
# changing the regexp for recognising the format
sub getstructure
{
my ($ftpdir, $ftp, $realroot, $dispdot) = @_;
my $dirs = [ ];
my @dirlist = $ftp->dir("/$ftpdir");
if ($dispdot)
{
print STDERR "."; flush STDERR;
}
# We assume unix-style directory listings
my $x;
for ($x=0; $x<=$#dirlist; $x++)
{
if ($dirlist[$x] =~ /^((d|\-)((r|\-)(w|\-)(x|s|\-)){3,3}) *([0-9]+) *([^\s]+) *([^\s]+) *([0-9]+) *(... .. .....) *(.*)$/)
{
# $1 - permissions
# $7 - no. files
# $8 - user
# $9 - group
# $10 - size
# $11 - date
# $12 - filename
my $perm = $1;
my $files = $7;
my $user = $8;
my $group = $9;
my $size = $10;
my $adate = $11;
my $fname = $12;
my $date;
if ($adate =~ /^([A-Za-z]+) *([0-9]+) *([0-9]+):([0-9]+)$/)
{
$date = gmtime(timegm(0, $4, $3, $2, $months{$1}, $year));
}
elsif ($adate =~ /^([A-Za-z]+) *([0-9]+) *([0-9]+)$/)
{
$date = gmtime(timegm(0, 0, 0, $2, $months{$1}, $3));
}
else
{
die "Unrecognised date: $adate";
}
my $struct = [];
my $type = "FILE";
if ($fname !~ /^\.*$/)
{
if ($perm =~ /^d/)
{
$type = "DIR";
$struct = getstructure("$ftpdir/$fname", $ftp,
"$realroot/$fname");
}
my $entry = [ $type, "$realroot/$fname", $date, $size, $struct ];
$$dirs[$#$dirs+1] = $entry;
}
}
}
return $dirs;
}
sub printstructure
{
my ($dirs) = @_;
for (my $x=0; $x<=$#$dirs; $x++)
{
my ($out) = $$dirs[$x];
my ($type, $fname, $date, $size, $struct) = @$out;
print STDERR " $fname\n";
if ($type eq "DIR")
{
printstructure($struct);
}
}
}
sub getfilestructure
{
my ($dir, $realroot) = @_;
my $dirhandle = new DirHandle($dir);
my @dirlist = $dirhandle->read();
my $dirs = [];
print STDERR "."; flush STDERR;
for (my $x=0; $x<=$#dirlist; $x++)
{
if (($dirlist[$x] !~ /\~$/) &&
($dirlist[$x] !~ /^\#.*\#$/) &&
($dirlist[$x] !~ /^\.*$/))
{
# Find out about that file
my $stats = stat("$dir/$dirlist[$x]");
my $struct = [];
my $type = "FILE";
my $size = $stats->size;
my $date = gmtime($stats->mtime);
if (S_ISDIR($stats->mode))
{
$type = "DIR";
$struct = getfilestructure("$dir/$dirlist[$x]",
"$realroot/$dirlist[$x]");
}
my $entry = [ $type, "$realroot/$dirlist[$x]", $date, $size,
$struct ];
$$dirs[$#$dirs+1] = $entry;
}
}
return $dirs;
}
sub findfile
{
my ($filename, $files) = @_;
for (my $x=0; $x<=$#$files; $x++)
{
my $entries = $$files[$x];
if ($filename eq $$entries[1])
{
return $entries;
}
}
return 0;
}
sub ftprmdir
{
my ($dirname, $level) = @_;
my $dirstruct = getstructure($dirname, $ftp, $dirname);
for (my $x=0; $x<=$#$dirstruct; $x++)
{
my $entry = $$dirstruct[$x];
if ($$entry[0] eq "FILE")
{
$ftp->delete($$entry[1]);
}
else
{
ftprmdir($$entry[1], $level+2);
$ftp->rmdir($$entry[1]);
}
}
$ftp->rmdir($dirname);
}
sub clearout
{
my ($ftpfiles, $realfiles) = @_;
for (my $x=0; $x<=$#$ftpfiles; $x++)
{
my $entry = $$ftpfiles[$x];
my $realentry = findfile($$entry[1], $realfiles);
if (!$realentry)
{
print STDERR " Erasing $$entry[1]\n";
if ($$entry[0] eq "DIR")
{
ftprmdir("/$ftpdir/$$entry[1]", $$entry[4], 2);
}
else
{
$ftp->delete("/$ftpdir/$$entry[1]");
}
}
}
}
sub uploadnew
{
my ($ftpfiles, $realfiles) = @_;
for (my $x=0; $x<=$#$realfiles; $x++)
{
my $entry = $$realfiles[$x];
my $ftpentry = findfile($$entry[1], $ftpfiles);
if (!$ftpentry)
{
print STDERR " $$entry[1]\n";
if ($$entry[0] eq "DIR")
{
$ftp->mkdir("/$ftpdir/$$entry[1]");
uploadnew([], $$entry[4]);
}
else
{
my $foo = "$sourcedir/$$entry[1]";
my $bar = "/$ftpdir/$$entry[1]";
$ftp->put($foo, $bar);
}
}
else
{
if ($$entry[0] eq "DIR")
{
uploadnew($$ftpentry[4], $$entry[4]);
}
}
}
}
sub uploadchanged
{
my ($ftpfiles, $realfiles) = @_;
for (my $x=0; $x<=$#$realfiles; $x++)
{
my $entry = $$realfiles[$x];
my $ftpentry = findfile($$entry[1], $ftpfiles);
if ($ftpentry)
{
my $cur = $$entry[2];
my $old = $$ftpentry[2];
my $changed = 0;
if ($cur->year > $old->year)
{
$changed = 1;
}
elsif ($cur->year == $old->year &&
$cur->mon > $old->mon)
{
$changed = 1;
}
elsif ($cur->year == $old->year &&
$cur->mon == $old->mon &&
$cur->mday > $old->mday)
{
$changed = 1;
}
elsif ($cur->year == $old->year &&
$cur->mon == $old->mon &&
$cur->mday == $old->mday &&
$cur->hour > $old->hour)
{
$changed = 1;
}
elsif ($cur->year == $old->year &&
$cur->mon == $old->mon &&
$cur->mday == $old->mday &&
$cur->hour == $old->hour &&
$cur->min > $old->min)
{
$changed = 1;
}
if ($$entry[3] != $$ftpentry[3])
{
$changed = 1;
}
if ($$entry[0] eq "DIR")
{
uploadchanged($$ftpentry[4], $$entry[4]);
}
elsif ($changed)
{
my $foo = "$sourcedir/$$entry[1]";
my $bar = "/$ftpdir/$$entry[1]";
print STDERR " $$entry[1]\n";
$ftp->put("$sourcedir/$$entry[1]",
"/$ftpdir/$$entry[1]");
}
}
else
{
die "Whoops - programmer is a spoon!";
}
}
}
# Code starts here
print STDERR "upload.pl v0.1 written by Andrew Hunter\n";
print STDERR "Contacting ftp site...\n";
$ftp = Net::FTP->new("$ftpsite", Debug => 0);
# $ftp->hash(1, 1024);
$ftp->login("$username", "$password");
$ftp->cwd("/$ftpdir");
$ftp->binary();
print STDERR "Checking supported commands...";
flush STDERR;
if (!$ftp->supported("MKD"))
{
die "Does not support mkdir";
}
print STDERR "M";
flush STDERR;
if (!$ftp->supported("RMD"))
{
die "Does not support rmdir";
}
print STDERR "R";
flush STDERR;
if (!$ftp->supported("DELE"))
{
die "Does not support delete";
}
print STDERR "D";
flush STDERR;
if (!$ftp->supported("LIST"))
{
die "Does not support LIST";
}
print STDERR "L";
flush STDERR;
if (!$ftp->supported("STOR"))
{
die "Does not support STOR! This could make transfer difficult";
}
print STDERR "S";
flush STDERR;
print STDERR "...OK\n";
# Get the file structure from the ftp server
print STDERR "Reading the directory structure.";
flush STDERR;
my $dirs = getstructure($ftpdir, $ftp, "", 1);
print STDERR "\n";
if ($DEBUG)
{
printstructure($dirs);
}
print STDERR "Reading the actual structure.";
flush STDERR;
my $actualdirs = getfilestructure($sourcedir);
print STDERR "\n";
if ($DEBUG)
{
printstructure($actualdirs);
}
print STDERR "Clearing out the dead files and directories...\n";
clearout($dirs, $actualdirs);
print STDERR "Uploading new files and directories...\n";
uploadnew($dirs, $actualdirs);
print STDERR "Rereading the directory structure.";
flush STDERR;
my $dirs = getstructure($ftpdir, $ftp, "", 1);
print STDERR "\n";
print STDERR "Uploading changed files and directories...\n";
uploadchanged($dirs, $actualdirs);
print STDERR "Rereading the directory structure 2.";
flush STDERR;
my $dirs = getstructure($ftpdir, $ftp, "", 1);
print STDERR "\n";
print STDERR "Uploading changed files and directories 2...\n";
uploadchanged($dirs, $actualdirs);
