#!/usr/bin/perl

# This script is (c) 2002 Luis E. Muņoz, All Rights Reserved
# This code can be used under the same terms as Perl itself. It comes
# with absolutely NO WARRANTY. Use at your own risk.

# Dr. Jürgen Vollmer <juergen.vollmer@informatik-vollmer.de>
# - added the -R switch (rename)
# - added -I switch
# - added check for file-size
# Id: ftpsync,v 2.3 2005/06/21 09:05:40 vollmer Exp

use strict;
use warnings;
use Net::FTP;
use File::Find;
use Pod::Usage;
use Getopt::Std;

use vars qw($opt_s $opt_k $opt_u $opt_l $opt_p $opt_r $opt_h $opt_v
	    $opt_d $opt_P $opt_i $opt_I $opt_o $opt_R $opt_c);

getopts('i:I:o:l:s:u:p:r:R:chkvdP');

if ($opt_h)
{
    pod2usage({-exitval => 0,
	       -verbose => 2});
}
				# Defaults are set here
$opt_s ||= 'localhost';
$opt_u ||= 'anonymous';
$opt_p ||= 'someuser@';
$opt_r ||= '/';
$opt_l ||= '.';
$opt_o ||= 0;

my %rename;   # hash of renamings: $rename{$src} = $dest;
my %rrename;  # reverse hash of renamings: $rrname{$dest} = $src;

my $copied_count      = 0;
my $deleted_count     = 0;
my $checked_count     = 0;
my $created_dir_count = 0;
my $deleted_dir_count = 0;

if ($opt_R) {
    for (split (",", $opt_R)) {
	my ($src, $dest) = split ("=");
	$dest || die " option -R expects argument of the form a=b,c=d,...\n";
	my $rx;
	$rx = $src;  $rx =~ s|\.|\\.|g; $rename{$rx}  = $dest;
	$rx = $dest; $rx =~ s|\.|\\.|g; $rrename{$rx} = $src;
    }
}

$opt_I = $opt_i     if ($opt_i && !defined $opt_I);

$opt_i = qr/$opt_i/ if $opt_i;
$opt_I = qr/$opt_I/ if $opt_I;

$|++;				# Autoflush STDIN

my %rem = ();
my %loc = ();

print "Using time offset of $opt_o seconds\n" if $opt_v and $opt_o;

				# Phase 0: Scan local path and see what we
				# have

chdir $opt_l or die "Cannot change dir to $opt_l: $!\n";

find(
     {
	 no_chdir	=> 1,
	 follow		=> 0,	# No symlinks, please
	 wanted		=> sub
	 {
	     return if $File::Find::name eq '.';
	     $File::Find::name =~ s!^\./!!;
	     if ($opt_I and $File::Find::name =~ m/$opt_I/)
	     {
		 print "local: IGNORING $File::Find::name\n" if $opt_d;
		 return;
	     }
	     my $r = $loc{$File::Find::name} =
	     {
		 mdtm => (stat($File::Find::name))[9],
		 size => (stat(_))[7],
		 type => -f _ ? 'f' : -d _ ? 'd'
		     : -l $File::Find::name ? 'l' : '?',
	     };
	     print "local: adding $File::Find::name (",
	     "$r->{mdtm}, $r->{size}, $r->{type})\n" if $opt_d;
	 },
     }, '.' );

				# Phase 1: Build a representation of what's
				# in the remote siter

my $ftp = new Net::FTP ($opt_s,
			Debug		=> $opt_d,
			Passive		=> $opt_P,
			);

die "Failed to connect to server '$opt_s': $!\n" unless $ftp;
die "Failed to login as $opt_u\n" unless $ftp->login($opt_u, $opt_p);
die "Cannot change directory to $opt_r\n" unless $ftp->cwd($opt_r);
warn "Failed to set binary mode\n" unless $ftp->binary();

print "connected\n" if $opt_v;

my $ticks = 0;
my @ticks = ("|", "/", "-", "\\", "|", "/", "-", "\\");
sub tick_start
{
    printf " " if ($opt_c) ;
}
sub tick
{
    return unless ($opt_c);
    printf " " if ($ticks == 0);
    $ticks++;
    printf "\b%s", $ticks[$ticks%8];
}
sub tick_stop
{
    printf "\b\b" if ($opt_c) ;
}

sub scan_ftp
{
    my $ftp	= shift;
    my $path	= shift;
    my $rrem	= shift;

    my $rdir = length($path) ? $ftp->dir("-a", $path) : $ftp->dir("-a");
    # "-a" --> list also files starting with a dot

    return unless $rdir and @$rdir;

    for my $f (@$rdir)
    {
	next if $f =~ m/^d.+\s\.\.?$/;

	my $n = (split(/\s+/, $f, 9))[8];
	next unless defined $n;
	tick();
	my $name = '';
	$name = $path . '/' if $path;
	$name .= $n;

	if ($opt_i and $name =~ m/$opt_i/)
	{
	    print "ftp: IGNORING $name\n" if $opt_d;
	    next;
	}

	next if exists $rrem->{$name};

	my $mdtm = ($ftp->mdtm($name) || 0) + $opt_o;
	my $size = $ftp->size($name) || 0;
	my $type = substr($f, 0, 1);

	$type =~ s/-/f/;

	warn "ftp: adding $name ($mdtm, $size, $type)\n" if $opt_d;

	$rrem->{$name} =
	{
	    mdtm => $mdtm,
	    size => $size,
	    type => $type,
	};

	scan_ftp($ftp, $name, $rrem) if $type eq 'd';
    }
}

tick_start();
scan_ftp($ftp, '', \%rem);
tick_stop();

				# Phase 2: Upload "missing files"

for my $l (sort { length($a) <=> length($b) } keys %loc)
{
    warn "Symbolic link $l not supported\n"
	if $loc{$l}->{type} eq 'l';

    if ($loc{$l}->{type} eq 'd')
    {
	next if exists $rem{$l};
	print "create remote dir: $l\n" if $opt_v;
	$opt_k ? print "MKDIR $l\n" : $ftp->mkdir($l)
	    or die "Failed to MKDIR $l\n";
	$created_dir_count++;
    }
    else
    {
	my $r = $l;
	for my $src (keys %rename)
	{
	    if ($l =~ /$src/) {
		my $dest = $rename{$src};
		$r =~ s|$src$|$dest|;
		printf "RENAME $l to $r (during upload)\n" if ($opt_d);
		last;
	    }
	}

	my $checked_count++;
	next if exists $rem{$r} and $rem{$r}->{mdtm} >= $loc{$l}->{mdtm} and
				    $rem{$r}->{size} == $loc{$l}->{size};

	if ($opt_v) {
	    printf "copy %s file to remote: %s\n",
	    	   $rem{$r}? "newer  " : "missing",
		   ($l eq $r) ? $l : $r;
	}
	$opt_k ? print "PUT $l $r\n" : $ftp->put($l, $r)
	    or die "Failed to PUT $l $r\n";
	$copied_count++;
    }
}

				# Phase 3: Delete missing files

for my $r (sort { length($b) <=> length($a) } keys %rem)
{
    if ($rem{$r}->{type} eq 'l')
    {
	warn "Symbolic link $r not supported\n";
	next;
    }

    my $l = $r;

    for my $dest (keys %rrename)
    {
	if ($r =~ /$dest/) {
	    my $src = $rrename{$dest};
	    $l =~ s|$dest$|$src|;
	    printf "RENAME $l to $r (during delete)\n" if ($opt_d);
	}
    }

    next if exists $loc{$l};
    next if ($opt_i and $r =~ m/$opt_i/);

    if ($opt_v) {
	printf "delete remote %s: $r\n", $rem{$r}->{type} eq "d"?"dir ":"file";
    }

    if ($opt_k) {
	print "DELETE $r\n";
    } else {
	if ($rem{$r}->{type} eq "d") {
	    $ftp->rmdir($l, 1) or die "Failed to DELETE directory $l\n";
	    $deleted_dir_count++;
	} else {
	    $ftp->delete($l) or die "Failed to DELETE file $l\n";
	    $deleted_count++;
	}
    }
}

if ($opt_c) {
    printf ".. checked files = %d, copied files = %d, deleted files = %d ".
	   "created dirs = %d, deleted dirs = %d\n",
           $checked_count, $copied_count, $deleted_count,
	   $created_dir_count, $deleted_dir_count;
}

__END__

=pod

=head1 NAME

ftpsync - Sync a hierarchy of local files with a remote FTP repository

(Extended version)

=head1 SYNOPSIS

ftpsync [-h] [-c] [-v] [-d] [-k] [-P] [-s server] [-u username] [-p password] [-r remote] [-l local] [-i ignore] [-I ignore] [-o offset] [-R src=dst,src=dst... ]

=head1 ARGUMENTS

The recognized flags are described below:

=over 2

=item B<-h>

Produce this documentation.

=item B<-c>

During fetching the file list from the remote system a moving | is shown
for each fetched file name. After finishing the transmission
a summary count of copied and deleted files and directoy is emitted.

=item B<-v>

Produce verbose messages while running.

=item B<-d>

Put the C<Net::FTP> object in debug mode and also emit some debugging
information about what's being done.

=item B<-k>

Just kidding. Only announce what would be done but make no change in
neither local nor remote files.
created
=item B<-P>

Set passive mode.

=item B<-i ignore>

Specifies a regexp. Remote files matching this regexp will be left
alone.
If no C<-I ignore> is given, also local files matching this regexp
will be left alone.

=item B<-I ignore>

Specifies a regexp. Local files matching this regexp will be left alone.

=item B<-s server>

Specify the FTP server to use. Defaults to C<localhost>.

=item B<-u username>

Specify the username. Defaults to 'anonymous'.

=item B<-p password>

Password used for connection. Defaults to an anonymous pseudo-email
address.

=item B<-r remote>

Specifies the remote directory to match against the local directory.

=item B<-l local>

Specifies the local directory to match against the remote directory.

=item B<-o offset>

Allows the specification of a time offset between the FTP server and
the local host. This makes it easier to correct time skew or
differences in time zones.

=item B<-R src1=dest1,src2=dst2,...>

Copy the local file src to the remote system and rename it to dest.

Several source / destinations pairs may be given an should be separated by a
comma.

If there are local files F<foo/a> and F<bar/a>, giving the option C<-Ra=b>
specifies to copy the local F<foo/a> to the remote file F<foo/b>
as well as F<bar/a> is copied to the remote file F<bar/b>.
If you want only F<foo/a> to be renamed, use: -Rfoo/a=foo/b.

This may be used e.g. to copy a F<.htaccess> file from the local site, where
it's "disabled" (by naming it F<htaccess>, i.e. without the leading dot on the
local site) and "enable" it by copying it as F<.htaccess> to the remote site.
Doing so, your local copy of the web pages may be seen without any access
restriction, while on the remote site, the user must provide a password (see
the specifications of F<.htaccess> of your web server).

=back

=head1 DESCRIPTION

This is an example script that should be usable as is for simple
website maintenance. It synchronizes a hierarchy of local files /
directories with a subtree of an FTP server.

The synchronyzation is quite simplistic (it uses time stamps and
file size comparision). It was written to explain how
to C<use Net::FTP> and C<File::Find>.

Always use the C<-k> option before using it in production, to avoid
data loss.

Synchronyzation means:

=over

=item

* If a local file is newer or differs in size, then put it to the remote site.

=item

* If a file exists only on the local site, then put it to the remote site.

=item

* If the file exists only on the remote site, delete it from the remote site.

=item

* Remote files are stored in the same directory hierarchy as the local files.

=item

* Create remote directories as needed.

=item

* Delete remote directories if they are not existent locally.

=back

=head1 EXAMPLE

   ftpsync -c -s my.ftp -u lem -p 37337 \
        -l /my/local/site -i '\bRCS\b|\bCVS\b|(^\.)|/\.|(~$)' -v -o 14400 \
        -R htaccess=.htaccess,htpasswd=.htpasswd

The regexp I feed to -i should prevent any CVS control files, which begins with
a dot, as well as all RCS files, and any Emacs backups from being touched at
all. I also specify an offset of 14,400 seconds (4 hours) to compensate for
the fact that this FTP server is running in my local time zone instead of in
UTC, as it should be.
The -R flag specifies that F<htaccess> files are copied as files F<.htaccess>

=head1 BUGS

The synchronization is not quite complete. This script does not deal
with symbolic links. Many cases are not handled to keep the code short
and understandable.

=head1 REQUIREMENTS

Perl(1) and the perl modules C<Net::FTP>, C<File::Find>, C<Pod::Usage>.

=head1 AUTHORS

The original script was written by Luis E. Muņoz <luismunoz@cpan.org>

It was extended by
Dr. Jürgen Vollmer <juergen.vollmer@informatik-vollmer.de>, who added

  - the -R switch (rename)
  - the -I switch and modified -i
  - the -c switch
  - a check for file-sizes

=head1 HOMEPAGE

Homepage of the I<original> version of B<ftpsync>:

http://mipagina.cantv.net/lem/perl/ftpsync Its documentation may be found at
http://www.linuxjournal.com/article.php?sid=6686


Homepage of I<this> version of B<ftpsync>:

http://www.informatik-vollmer.de/software/ftpsync.html

If you find this software useful, I (Juergen Vollmer)
would be glad to receive a postcard
from you, showing the place where you're living:

Dr. Juergen Vollmer, Viktoriastrasse 15,
D-76133 Karlsruhe, Germany.

=head1 LICENSE

This code can be used under the same terms as Perl itself. It comes
with absolutely NO WARRANTY.

Use at your own risk.

=head1 VERSION

2.0 of 2005/01/25

=head1 SEE ALSO

Perl(1).

=cut


#############################################################################
# Log: ftpsync,v $
# Revision 2.3  2005/06/21 09:05:40  vollmer
# typoo
#
# Revision 2.2  2005/01/25 20:02:08  vollmer
# added some documentation
#
# Revision 2.1  2005/01/25 19:41:42  vollmer
# released my version to public
#
# 2004/06/19 15:04:05 vollmer
# Initial revision of the extended version
#
#############################################################################