Skip to content

Instantly share code, notes, and snippets.

@hyuki0000

hyuki0000/upftp.pl

Created July 11, 2017 09:47
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save hyuki0000/f58ccabccba37b93dbb5823d4f019341 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save hyuki0000/f58ccabccba37b93dbb5823d4f019341 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. hyuki0000 created this gist Jul 11, 2017.
    166 changes: 166 additions & 0 deletions upftp.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,166 @@
    #!/usr/bin/perl
    #
    # This is UpFtp, Version 1.3
    # Copyright (C) 2000,2003,2006,2017 by Hiroshi Yuki.
    # http://www.hyuki.com/upftp/
    #
    # This program is free software; you can redistribute it and/or
    # modify it under the same terms as Perl itself.
    #
    use strict;
    use warnings;
    use Net::FTP;
    use Net::FTPSSL;

    ########################################
    # Configuration
    ########################################
    # FTPS: Do FTPS (FTP over SSL/TLS)?: 0 (no, use Net::FTP), 1 (yes, use Net::FTPSSL)
    my $ftpssl = 1;
    # FTPS: Encryption Mode.
    my $ftpssl_encryption = EXP_CRYPT;
    # Show debug info: 0 (nodebug), 1 (terse), 2 (verbose)
    my $debug = 0;
    # Show update info.
    my $show_update = 1;
    # Show ftp info: 0 (nodebug), 1 (print ftp session)
    my $ftpdebug = 0;
    # Do ftp?: 0 (yes, use ftp), 1 (no, simulation only)
    my $noftp = 0;
    # Your FTP host name.
    my $hostname = 'yourftp.domain';
    # Your FTP user name.
    my $username = 'yourname';
    # Your FTP password (if empty, I ask you later)
    my $password = '';
    # Remote root directory (in fullpath)
    my $remoterootdir = '/usr/home/ftp/myname';
    # Local root directory (in fullpath)
    my $localrootdir = '/usr/home/myname';
    # File list (in fullpath)
    my $filelist = '/usr/home/myname/filelist.txt';
    # Binary file extension
    my @binary_extension = qw(
    gif jpg png class pdf zip lzh tar gz tgz
    );

    ########################################
    # End of configuration.
    ########################################
    my $ftp;
    my @newfilelist;

    &upftp;
    exit(0);

    sub upftp {
    if ($debug) {
    if ($noftp) {
    print "Simulation only, I do not transfer any file.\n";
    }
    }
    unless ($hostname) {
    print "\$hostname is empty, abort.\n";
    return;
    }
    unless ($username) {
    print "\$username is empty, abort.\n";
    return;
    }
    unless ($password) {
    print "Login to $hostname as $username\n";
    print "Password:";
    chomp($password = <STDIN>);
    }
    unless ($remoterootdir) {
    print "\$remoterootdir is empty, abort.\n";
    return;
    }
    unless ($localrootdir) {
    print "\$localrootdir is empty, abort.\n";
    return;
    }
    unless ($filelist) {
    print "\$filelist is empty, abort.\n";
    return;
    }
    print "filelist is $filelist\n" if ($debug);
    if (!open(FILELIST, $filelist)) {
    print "$filelist is not found.\n";
    return;
    }
    while (<FILELIST>) {
    chomp;
    next if (/^#/);
    my ($filename, $updatetime) = split(/,/);
    $updatetime = 0 if (not defined($updatetime) or $updatetime eq "");
    print "$filename = $updatetime\n" if ($debug > 1);
    my $mtime = (stat("$localrootdir/$filename"))[9];
    $mtime = 0 if (not defined($mtime) or $mtime eq "");
    print "mtime = $mtime\n" if ($debug > 1);
    if (defined($mtime) and $mtime > $updatetime) {
    print "Update $filename\n" if ($debug or $show_update);
    $filename =~ m|(.*)[/\\]|;
    my $subdir = defined($1) ? $1 : '';
    &ftp_put("$localrootdir/$filename", "$remoterootdir/$subdir");
    } else {
    print "Skip $filename\n" if ($debug);
    }
    my $curtime = time;
    push(@newfilelist, "$filename,$curtime\n");
    }
    close(FILELIST);
    &ftp_logout;
    if (!open(FILELIST, "> $filelist")) {
    print "$filelist: Cannot create.\n";
    exit(-1);
    }
    print FILELIST @newfilelist;
    close(FILELIST);
    }

    # Put $localfile to $remotedir.
    sub ftp_put {
    my ($localfile, $remotedir) = @_;
    unless ($ftp) {
    unless ($noftp) {
    if ($ftpssl) {
    $ftp = Net::FTPSSL->new($hostname, Encryption => $ftpssl_encryption, Debug => $ftpdebug);
    } else {
    $ftp = Net::FTP->new($hostname, Debug => $ftpdebug);
    }
    $ftp->login($username, $password);
    }
    }
    print "localfile = $localfile, remotedir = $remotedir\n" if ($debug > 1);
    unless ($noftp) {
    $ftp->cwd($remotedir);
    if (&is_binary($localfile)) {
    $ftp->binary();
    } else {
    $ftp->ascii();
    }
    $ftp->put($localfile);
    }
    }

    # Logout.
    sub ftp_logout {
    if ($ftp) {
    unless ($noftp) {
    $ftp->quit;
    }
    }
    }

    # Ascii? Binary?
    sub is_binary {
    my ($localfile) = @_;
    foreach my $ext (@binary_extension) {
    if ($localfile =~ /\.$ext$/) {
    return 1;
    }
    }
    return 0;
    }
    1;