Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

ftpsync

by etchorner (Novice)
on May 30, 2001 at 07:11 UTC ( [id://84156]=sourcecode: print w/replies, xml ) Need Help??
Category: FTP stuff
Author/Contact Info Chris Horner hornerc at earthlink dot net
Description: I cranked this one out after getting tired of either updating files on my website one by one as they are changed or using ncftpput to send 'em all.

It acts as a primitive 'rsync' clone. I use it to compare a local set of files to a remote set. It will create remote files and directories when new local copies are introduced, and will only upload existing files if the local file has a mtime (modification time) newer than the remote file. It's ugly, but it's handy for me on my slow connection to keep my web site up to date.

It's real ugly, it may not be portable, and I could use any advice you all have to offer.

#!/usr/bin/perl
use warnings;
use strict;
use Net::FTP;
$|++;    # Autoflush

# Globals - need to tie these  to a dot file!
my $server    = "";        # CHANGE - FQDN (not URI) of ftp server
my $username  = "";     # CHANGE - ftp server username
my $pass      = "";        # CHANGE - ftp server password
my $home      = "/home/chorner";    # CHANGE - parent path of $localsi
+te
my $localsite = "$home/webdocs";    # CHANGE - local copy of web site
my $new       = my $changed = my $unchanged = 0;
my $ftp;

#################### SUBROUTINES ###############################

#################################################################
# connect - Connect and authenticate w/ server
sub ftpconnect {
    print "Connecting to $server..";

    # Set up connection
    $ftp = Net::FTP->new( $server, Passive => 1, Debug => 0 ) 
        or die "..could not establish connection to $server: $@";
    print "..authenticating..";

    # Log in...
    $ftp->login( $username, $pass ) or die "..unable to authenticate: 
+$!";
    print "..done!\n";
}

######################################################################
# ftplogout - close the connection
sub ftplogout {
    print "Logging out..";
    $ftp->quit or die "..trouble closing the connection to $server: $!
+";
    print "..done!\n";
}

######################################################################
+#
# compare - 
sub compare {
    my @dirlist = `find $localsite`;
    my $rfile;

    for my $file (@dirlist) {
        chomp $file;

        # Translate to remote directory structure
        if ( rdiff($file) ) {

            #  local file is newer - updating! 
            ( $rfile = $file ) =~ s/$home//;

            # This only takes care of files already 
            # existing  both lcl and rmt
            $ftp->put( $file, $rfile );
            print "UPDATED_FILE: $rfile\n";
            $changed++;
        }
        else {

            # local file is older - not updating!
            $unchanged++;
        }
    }
}

####################################################################
# rdiff - compare local and remote mtimes
#         return 1 -> needs updating
#         return 0 -> already updated
# See note below about failing mdtm method
sub rdiff ($) {
    my $file = shift;
    my ( $ltime, $rtime );

    # Get local and remote modification times
    # Test for directories/new files,  they fail the mdtm method
    $ltime = ( stat($file) )[9];
    $file =~ s/$home//;
    if ( !( $rtime = $ftp->mdtm($file) ) ) {

        # mdtm method fails because:
        #      1. rmt file is a directory
        #      2. rmt file doens't exist (either file or dir)
        # Use checknew() to assess and correct this problem
        checknew($file);
        return 0;
    }
    my $diff = $ltime - $rtime;

    # local is older...gotta update!
    if ( $diff > 0 ) {
        return 1;
    }

    # remote is older...no update!
    elsif ( $diff <= 0 ) {
        return 0;
    }

    # At this point something wierd has happened, so 
    # we refuse to update!
    return 0;
}

#######################################################
# checknew -  take care of new lcl files and directories
sub checknew ($) {
    my $localfile = join ( "", $home, @_ );

    if ( -e $localfile && -f $localfile ) {

        # local file is new, rmt file doesn't exist..transfer
        $ftp->put( $localfile, @_ );
        print "ADDED_FILE: @_\n";
        $new++;
        $unchanged--;
        return 0;
    }
    elsif ( -d $localfile && -e $localfile && !( $ftp->cwd(@_) ) ) {

        # remote directory doesn't exist..create
        $ftp->mkdir(@_);
        print "ADDED_DIR: @_\n";
        $new++;
        $unchanged--;
        return 0;
    }
    else {

        # The only reason you are here is that rmt and local dir both 
+exist
        return 1;
    }
}

### MAINS ####
ftpconnect();
compare();
ftplogout();

print
"Changed $changed files, created $new files, and ignored $unchanged fi
+les (including directories)\n";
Replies are listed 'Best First'.
Re: ftpsync
by TheoPetersen (Priest) on May 30, 2001 at 16:50 UTC
    If you are looking for rsync-like behavior but need a Perl implementation, or you just want some code for comparison to your approach, consider fsync.
      Thanks for the link. That was pretty much what I was aiming for.

      I initially tried it using the File::Rsync module until I realized that it requires the having rsh access to the remote server.

      This same problem exists (with the addition of ssh access as well) with fsync, although there are some other nice code snippets that I may <s>steal</s> borrow.

      ftpsync is for us poor schmucks that have only plain vanilla ftp access to the server holding their website.

      I really like the idea of diff transferring, that really cuts down on the total bytes moved. It's made it on to my TODO for this one, although I haven't the slightest idea how to implement it yet. Therein lies the fun....

Re: ftpsync
by maj12 (Novice) on Oct 24, 2001 at 01:16 UTC
    I got this code to work when the remote dirs and files
    dont exist but as soon as I try to overwrite files that
    are already there, it fails with:

    cant put /var/www/accucaps/data/test.cgi, data/test.cgi: Bad file desc +riptor at ./mirror.pl line 121.<br>

    Here's my edited sub:

    sub checknew ($) { my $localfile = join ( "", $home, @_ ); foreach my $myfiles(@_) { $myfiles=~s/^\///; } if ( -e $localfile && -f $localfile ) { # local file is new, rmt file doesn't exist..transfer $ftp->put( $localfile, @_ ) or die "cant put $localfile, @_: $ +!"; print "ADDED_FILE: @_\n"; $new++; $unchanged--; return 0; }

    What gives?
Re: ftpsync
by Anonymous Monk on May 04, 2003 at 06:49 UTC
    Thanks a TON, man. I modified it a bit here & there ('cause directory structures both on local & remote, and their relationships, were totally different, and to change the print stmts a bit). You saved me a crapload of work looking up how to do all this stuff piece by piece. I have it set up as a cron every 15 minutes, piped to a log file, and it works like a charm!

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://84156]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others browsing the Monastery: (2)
As of 2024-12-03 07:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found