#!/usr/bin/perl
#
# __copy1__
# __copy2__
#
# ---- ORIGINAL COPYRIGHT ---
#
# This script is (c) 2002 Luis E. Muoz, All Rights Reserved
#                (c) 2005 Peter Orvos, All Rights Reserved
#                (c) 2007 Lorenzo Canovi, All Right Reserved
# This code can be used under the same terms as Perl itself. It comes
# with absolutely NO WARRANTY. Use at your own risk.
#
# 
# ---- CHANGELOG ----
#
# 2018.03.08 lorenzo canovi <lorenzo@kubiclabs.com>
#  - fixed typo at line 201 (spurious 'd' char on eol)
#
# 2011.03 lorenzo canovi <lorenzo@kubiclabs.com>
#  - fixed modification time, now try to handle different dialects,
#    and sends all knownw commands (MFMT, MDTM, SITE UTIME)
#
# 2010.03 lorenzo canovi <lorenzo@kubiclabs.com>
#  - added update of modification time
#
# 2007.05 lorenzo canovi <lorenzo@kubiclabs.com>
#  - die if not options passed
#  - added -n option (alias for -k)
#
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_o $opt_D $opt_R $opt_n
	    $opt_t);

sub time2mdtm($);
sub scan_ftp($$$$);
sub time2utime($);

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

die "must supply local dir\n"	if (!$opt_l);
die "must supply remote dir\n"	if (!$opt_r);

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

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

#kanna
$opt_k	= 1	if defined $opt_n;
$opt_t ||= 0;

$|++;                           # Autoflush STDIN

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

#kanna
print "$0 1.1-k1 (2018.03)\n" if $opt_v;


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;
             }
             stat($File::Find::name);
             my $type = -f _ ? 'f' : -d _ ? 'd' : -l $File::Find::name ? 'l' : '?';
             my @dirs = split /\//, $File::Find::name if $opt_R >= 0;
             if ($opt_R >= 0 && $opt_R + ($type eq 'd' ? 0 : 1) < @dirs) {
                 print "local: IGNORING(depth) $File::Find::name\n" if $opt_d;
                 return;
             }
             my $r = $loc{$File::Find::name} = 
             {
                 mdtm => (stat(_))[9],
                 size => (stat(_))[7],
                 type => $type,
             };
             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 site

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;

scan_ftp($ftp, '', \%rem, $opt_R);

if ($opt_D) {
                                # Phase 2: Download "missing files"
   for my $l (sort { length($a) <=> length($b) } keys %rem)
   {
       warn "Symbolic link $l not supported\n"
            if $rem{$l}->{type} eq 'l';
   
       if ($rem{$l}->{type} eq 'd')
       {
            next if exists $loc{$l};
            print "$l dir missing in the local repository\n" if $opt_v;
            $opt_k ? print "mkdir $l\n" : mkdir($l)
                or die "Failed to MKDIR $l\n";
       }
       else
       {
            if (!exists $loc{$l} or $rem{$l}->{mdtm} <= $loc{$l}->{mdtm}) {
            	print "$l file missing or older in the local repository\n" 
                	if $opt_v;
            	$opt_k ? print "GET $l $l\n" : $ftp->get($l, $l)
                	or die "Failed to GET $l\n";
	    }
	    if (!$opt_k && $opt_t) {
	     	my (@tmp) = stat("$opt_l/$l")	or die;
		if ($tmp[9] != $rem{$l}->{mdtm}) {
			print "$l update mtime\n"
                		if $opt_v;
	    		utime( time(), $rem{$l}->{mdtm}, "$opt_l/$l" ) or die;
		}
	    }
       }
   }
}
else
{
                                # 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 "$l dir missing in the FTP repository\n" if $opt_v;
            $opt_k ? print "MKDIR $l\n" : $ftp->mkdir($l)
                or die "Failed to MKDIR $l\n";
       }
       else
       {
	   if (exists $rem{$l}) {
		if ($opt_t and $rem{$l}->{mdtm} != ($loc{$l}->{mdtm} + $opt_o) ) {
		       warn( "sync remote mtime"
		      		. " r=" . time2mdtm($rem{$l}->{mdtm})
		      		. " l=" . time2mdtm($loc{$l}->{mdtm})
				. " $l"
				. "\n"
			       	);
		       # try all :)
		       $ftp->quot( "SITE", "UTIME", time2mdtm($loc{$l}->{mdtm} - $opt_o), $l );
		       $ftp->quot( "SITE", "UTIME", time2utime($loc{$l}->{mdtm} - $opt_o), $l );
		       $ftp->quot( "MFMT", time2mdtm($loc{$l}->{mdtm} - $opt_o), $l );
		       $ftp->quot( "MDTM", time2mdtm($loc{$l}->{mdtm} - $opt_o), $l );
	       	}
            	next if $rem{$l}->{mdtm} >= $loc{$l}->{mdtm};
	    }
            print "put ftp missing/older: $l\n" 
                if $opt_v;
            if ($opt_k) {
	    	print "PUT $l $l\n";
	    } else {
	    	$ftp->put($l, $l)
                	or die "Failed to PUT $l\n";
		if ($opt_t) {
		       $ftp->quot( "SITE", "UTIME", time2mdtm($loc{$l}->{mdtm} - $opt_o), $l );
		       $ftp->quot( "SITE", "UTIME", time2utime($loc{$l}->{mdtm} - $opt_o), $l );
		       $ftp->quot( "MFMT", time2mdtm($loc{$l}->{mdtm} - $opt_o), $l );
		       $ftp->quot( "MDTM", time2mdtm($loc{$l}->{mdtm} - $opt_o), $l );
		}
  	    }
       }
   }
}
                                # Phase 3: Delete missing files

if ($opt_D) {
    for my $r (sort { length($b) <=> length($a) } keys %loc)
    {
        if ($loc{$r}->{type} eq 'l')
        {
            warn "Symbolic link $r not supported\n";
            next;
        }
            
        next if exists $rem{$r};
    
        print "$r file missing from the FTP repository\n" if $opt_v;
        if ($loc{$r}->{type} eq 'd') {
            $opt_k ? print "rmdir $r\n" : rmdir($r)
                or die "Failed to DELETE $r\n";
        } else {
            $opt_k ? print "rm $r\n" : unlink($r)
                or die "Failed to DELETE $r\n";
        }
    }
}
else
{
    for my $r (sort { length($b) <=> length($a) } keys %rem)
    {
        if ($rem{$r}->{type} eq 'l')
        {
            warn "Symbolic link $r not supported\n";
            next;
        }
            
        next if exists $loc{$r};
    
	if ($rem{$r}->{type} eq 'd') {
        	print "$r directory missing locally\n" if $opt_v;
        	$opt_k ? print "RMDIR $r\n" : $ftp->rmdir($r)
            		or die "Failed to RMDIR $r\n";
    	} else {
        	print "$r file missing locally\n" if $opt_v;
        	$opt_k ? print "DELETE $r\n" : $ftp->delete($r)
            		or die "Failed to DELETE $r\n";
	}
    }
}

exit( 0 );


sub scan_ftp($$$$)
{
    my $ftp     = shift;
    my $path    = shift;
    my $rrem    = shift;
    my $mdepth  = shift;

    my $rdir = length($path) ? $ftp->dir($path) : $ftp->dir();

    return unless $rdir and @$rdir;

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

        my @line = split(/\s+/, $f, 9);
        my $n = (@line == 4) ? $line[3] : $line[8]; # Compatibility with windows FTP
        next unless defined $n;

        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 = (@line == 4) ? ($line[2] =~/\<DIR\>/i ? 'd' : 'f') : substr($f, 0, 1); # Compatibility with windows FTP

        $type =~ s/-/f/;

        warn "ftp: adding $name ($mdtm, $size, $type)\n" if $opt_d;
        
        $rrem->{$name} = 
        {
            mdtm => $mdtm,
            size => $size,
            type => $type,
        } if $type ne 'd' || $mdepth != 0;

        scan_ftp($ftp, $name, $rrem, $mdepth-1) if $type eq 'd' && $mdepth != 0;
    }
}


sub time2mdtm($)
{
	my ($time)	= @_;
	my @time	= localtime($time);
	my $out;

	$out	= sprintf( "%04d%02d%02d%02d%02d%02d",
			$time[5] + 1900, $time[4] + 1, $time[3],
		       	$time[2], $time[1], $time[0] );
	return $out;
}


# same as time2mdtm, but without seconds
#
sub time2utime($)
{
	my ($time)	= @_;
	my @time	= localtime($time);
	my $out;

	$out	= sprintf( "%04d%02d%02d%02d%02d",
			$time[5] + 1900, $time[4] + 1, $time[3],
		       	$time[2], $time[1] );
	return $out;
}


__END__

=pod

=head1 NAME

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

=head1 SYNOPSIS

ftpsync [-h] [-v] [-d] [-k|-n] [-P]
	[-s server] [-u username] [-p password]
 	[-i ignore] [-o offset]
	[-t]
	-l local -r remote 

=head1 ARGUMENTS

The recognized flags are described below:

=over 2

=item B<-h>

Produce this documentation.

=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> or B<-n>

Just kidding. Only announce what would be done but make no change in
neither local nor remote files. (kanna: added -n for compatibility
with the most commands around)

=item B<-P>

Set passive mode.

=item B<-D>

Download directory, rather than upload (default).

=item B<-i ignore>

Specifies a regexp. 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<-R max_recurse_depth>

Maximal depth of recursive directory synchron. 0 is for no recurse, -1 is for unlimited (default).

=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<-t>

(kanna) force update of modification time when downloading/uploading.

=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 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.

=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 AUTHORS

Luis E. Muoz <luismunoz@cpan.org>,
modified on 2005 by Peter Orvos,
modified on 2007 by Lorenzo Canovi <kanna@lcanovi.com>

=head1 SEE ALSO

Perl(1).

=cut


