Category: ftp
Author/Contact Info giant
/msg me .)
Description: remote.pl Script for remote-editing files via FTP without depending on any editor-plugins like netrw from vim 6
This script check if any files in a specific dir change and if they do it updates those files on the remote host via FTP
I guess lots of people have written something similar already but it's so trivial that noone released it. So I wrote a dynamical one and thought I'd post it...

Modules needed: Net::FTP, Net::Ping -> both are used in the myftp.pm - module which is used for FTPing files to a host or deleting them.
myftp.pm also got some other functions which aren't used here but well maybe someone needs them somewhere else...		 
########## remote.pl #############

#!/usr/bin/perl -w
# remote.pl Script for remote-editing files via FTP without depending 
+on any editor-plugins like netrw from vim 6
# This script check if any files in a specific dir change and if they 
+do it updates those files on the remote host via FTP
# I guess lots of people have written something similar already but it
+'s so trivial that noone released it. So I wrote a dynamical one and 
+thought I'd post it...
#
# Modules needed: Net::FTP, Net::Ping -> both are used in the myftp.pm
+ - module which is used for FTPing files to a host or deleting them.
# myftp.pm also got some other functions which aren't used here but we
+ll maybe someone needs them somewhere else...
#
# Also needed is a netrc-file, where hostname, ip, user, pw must be co
+ntained in plain-text. (yes I know that's insecure basically but it i
+ssn't here.
# Example "netrc"-file:
# myhost::192.168.0.2::giant::mypassword
# notherhost::192.168.0.1::giant::mypassword
#
# The directory-structure should be like this:
# /remote/                                             -> The basedir
# /remote/remote.pl                                 -> script could al
+so be located somewhere else...
# /remote/netrc                                     -> netrc needed fo
+r script, could also be somewhere else just change path
# /remote/myhost/                                 -> the hostname
# /remote/myhost/giant/                         -> user @ hostname
# /remote/myhost/giant/home/                     -> dir /home on host 
+myhost, must always be absolute
# /remote/myhost/giant/home/stuff/file.pl    -> deeper dir with file f
+ile.pl
#
# With this structure you can even have multiple users for one host...
# Once the script is started it checks every second if there are any n
+ew/changed/removed files and syncs with the specific host.
# 
# Warning: I wouldn't use this in a production-area, I've been testing
+ it and didn't have any problems but you never know so...
# Also I didn't do any checking for special-chars/error-checking etc, 
+could give you problems when transfering files between different OSes
+ for example.

use strict;
use myftp;

my (%netrc, %files, $firsttime, $rdir, $host, $ip, $user, $pw);
my $basedir = 'd:/remote';
my $netrc     = "$basedir/netrc";

open(FILE, "< $netrc") || die "Couldn't open $netrc: $!";
while (<FILE>) {
    chomp;
    my ($host, $ip, $user, $pw) = split(/::/);
    $netrc{$host}{$user} = $pw;
    $netrc{$host}{ip}     = $ip;
}
close(FILE);

print "\n\nRemote-Editing Script started...checking files...\n\n";
while (1) {
    ++$firsttime;
    checkdirs();
    checkifdel();
    sleep 1;
}

sub checkdirs {
    foreach(getdir($basedir)) {
        my $hostdir = $_;
        ($host) = $hostdir =~ /^.*\/(.*)$/;
        die "Unknown host: $host" if (!$netrc{$host});

        foreach(getdir("$basedir/$host")) {
            my $userdir = $_;
            ($user) = $userdir =~ /^.*\/(.*)$/;
            die "Unknown user \@ $host: $user" if (!$netrc{$host}{$use
+r});
            $pw     = $netrc{$host}{$user};
            $ip     = $netrc{$host}{'ip'};
            $rdir = $userdir;
            checkdir($userdir);
        }
    }
}

sub checkdir {
    my $dir = shift;
    my @dirs;

    opendir(DIR, $dir) || warn "Couldn't open Directory $dir: $!";
    while (local $_ = readdir DIR) {
        next if $_ =~ /^\.\.?$/;
        $_ = "$dir/$_";
        push(@dirs, $_) if -d $_;
        checkfile($_) if -f $_;
    }
    closedir(DIR);

    foreach (@dirs) {
        checkdir($_);
    }
}

sub checkfile {
    my $file = shift;
    my $mod_time = (stat($file))[9];
    if ($files{$file}) {
        return if $mod_time <= $files{$file};
        $files{$file} = $mod_time;
        my $localfile = $file;
        (my $remotefile = $file) =~ s/$rdir//g;
        print "\n\n$localfile changed! Updating file \@ $host\n";
        myftp::ftp($ip, $user, $pw, 'PUT', $localfile, $remotefile);
    } else {
        $files{$file} = $mod_time;
        return if $firsttime == 1;
        my $localfile = $file;
        (my $remotefile = $file) =~ s/$rdir//g;
        print "\n\n$localfile changed! Updating file \@ $host\n";
        myftp::ftp($ip, $user, $pw, 'PUT', $localfile, $remotefile);
    }
}

sub checkifdel {
    foreach (keys %files) {
        my $remotefile;
        ($host, $user, $remotefile) = $_ =~ /$basedir\/(.*?)\/(.*?)\/(
+.*)$/;
        $remotefile = "/$remotefile";
        $pw     = $netrc{$host}{$user};
        $ip     = $netrc{$host}{'ip'};
        if (!-f $_) { 
            delete($files{$_}); 
            my $localfile = $_;
            print "\n\n$localfile deleted! Deleting file \@ $host\n";
            myftp::ftp($ip, $user, $pw, 'DEL', $remotefile);
        }
    }
}

sub getdir {
    my $dir = shift;
    my @dirs;
    opendir(DIR, $dir) || warn "Couldn't open Directory $dir: $!";
    while (local $_ = readdir DIR) {
        next if $_ =~ /^\.\.?$/;
        $_ = "$dir/$_";
        push(@dirs, $_) if -d $_;
    }
    closedir(DIR);
    return @dirs;
}




########## myftp.pm #############

package myftp;

use Net::FTP;
use Net::Ping;

my $ftperror     = 0;
my $counter        = 0;
my $maxtries    = 2;
my $idletime    = 10;
my $checksize    = 0;
my $mode            = 'B';

my $ping = Net::Ping->new('icmp');
my $ftp    = '';

sub ftp {
    my ($host, $user, $pw, $type, $value1, $value2) = @_;
    $counter = 0;
    while ($counter <= $maxtries) {
        ++$counter;
        print "\nChecking if $host is alive...($counter)\n";
        if (pingcheck($host) == 1) {
            sleep $idletime;
            next;
        }
        print "Connecting to $host...($counter)\n";
        if (connectftp($host) == 1) {
            sleep $idletime;
            next;
        }
        print "Logging in to $host...($counter)\n";
        if (loginftp($user, $pw) == 1) {
            sleep $idletime;
            next;
        }
        print "Setting transfermode to...";
        if (modeftp($mode) == 1) {
            sleep $idletime;
            next;
        }
        if    ($type eq "LS") {
            if (lsftp($value1) == 1) {
                sleep $idletime;
                next;
            }
        } elsif ($type eq "DIR") {
            if (dirftp($value1) == 1) {
                sleep $idletime;
                next;
            }
        } elsif ($type eq "GET") {
            my $thingy = getftp($value1, $value2);
            if ($thingy == 1) {
                sleep $idletime;
                next;
            } elsif ($thingy == 2) {
                return 1;
            }
        } elsif ($type eq "PUT") {
            if (putftp($value1, $value2) == 1) {
                sleep $idletime;
                next;
            }
        } elsif ($type eq "DEL") {
            if (delftp($value1) == 1) {
                sleep $idletime;
                next;
            }
        } elsif ($type eq "SIZE") {
            if (sizeftp($value1) == 1) {
                sleep $idletime;
                next;
            }
        } else {
            print "Unkown type: $type\n";
            return 1;
        }
        return;
    }
    print "\nMaxtries reached!\n\a";
    $ftp->quit() if $ftp;
    return 1;
}

sub sizeftp {
    my $file = shift;
    my @size = ();
    my $size = '';
    unless(@size = $ftp->dir($file)) { 
        print "Couldn't get Size of $file!\n";
        return 1;
    }
    foreach(@size) {
        ($size) = $_ =~ /^.*?\s+.*?\s+.*?\s+.*?\s+(.*?)\s.*?/; 
    }
    print "$size\n";
    return 0;
}

sub delftp {
    my $file    = shift;
    unless ($ftp->delete($file)) {
        print "Couldn't delete $file!\n";
        return 1;
    }

    print "$file deleted\n";
    return 0;
}

sub putftp {
    my ($localfile, $remotefile) = @_;
    my ($remotesize, $localsize) = '';
    unless ($ftp->put($localfile, $remotefile)) {
        print "Couldn't upload $localfile as $remotefile!\n";
        return 1;
    }
    if ($checksize == 1) {
        $localsize = ((stat($localfile))[7]);
        foreach($ftp->dir($remotefile)) { ($remotesize) = $_ =~ /^.*?\
+s+.*?\s+.*?\s+.*?\s+(.*?)\s.*?/; }
        if ($localsize ne $remotesize) {
            print "Failure while uploading $remotefile as $localfile d
+uring Sizecheck!\n";
            return 1;
        }
    }
    print "Uploaded $localfile as $remotefile\n";
    return 0;
}

sub getftp {
    my ($file, $localfile) = @_;
    my ($remotesize, $localsize) = '';
    my @files = ();
    if (! $localfile) { $file =~ /.*\/(.*)$/; $localfile .= $1; }
    if ($localfile =~ /\/$/) { $file =~ /.*\/(.*)$/; $localfile .= $1;
+ }

    if ($file =~ /\*/) {
        unless (@files = $ftp->ls($file)) {
            print "Couldn't download $file as $localfile: $file does n
+ot exist?!\n";
            return 2;
        }
    } else {
        push(@files, $file);
    }
    foreach $file (@files) {
        if (! $localfile) { ($localfile) = $file =~ /.*\/(.*)$/; }
        unless (@_ = $ftp->ls($file)) {
            print "Couldn't download $file as $localfile: $file does n
+ot exist?!\n";
            return 2;
        }
        unless ($ftp->get($file, $localfile)) {
            print "Couldn't download $file as $localfile!\n";
            return 1;
        }
        if ($checksize == 1) {
            $localsize = ((stat($localfile))[7]);
            foreach($ftp->dir($file)) { ($remotesize) = $_ =~ /^.*?\s+
+.*?\s+.*?\s+.*?\s+(.*?)\s.*?/; }
            if ($localsize ne $remotesize) {
                print "Failure while downloading $file as $localfile: 
+Sizecheck failed ($localsize != $remotesize)!\n";
                return 1;
            }
        }
        print "Downloaded $file\n";
    }
    return 0;
}

sub modeftp {
    my $mode = shift;
    if ($mode eq 'B') { $mode = "binary"; }
    elsif ($mode eq 'A') { $mode = "ascii"; }
    elsif ($mode eq 'E') { $mode = "ebcdic"; }
    elsif ($mode eq "Y") { $mode = "byte"; }
    else { $mode = "binary"; }
    unless ($ftp->$mode()) {
        print "Couldn't set transfermode to $mode!\n";
        return 1;
    }
    print "$mode\n";
    return 0;
}

sub lsftp {
    my $dir     = shift;
    my @dir    = ();
    print "listing(ls) $dir\n";
    unless (@dir = $ftp->ls($dir)) {
        print "Couldn't list $dir\n";
        return 1;
    }
    foreach (@dir) { print $_."\n"; }
    return 0;
}

sub dirftp {
    my $dir     = shift;
    my @dir    = ();
    print "listing(dir) $dir\n";
    unless (@dir = $ftp->dir($dir)) {
        print "Couldn't list $dir\n";
        return 1;
    }
    foreach (@dir) { print $_."\n"; }
    return 0;
}

sub pingcheck {
    my $host = shift;
    if ($ping->ping($host)) {
        return 0;
    } else {
        print "$host is dead...\n";    
        return 1;
    }
}

sub connectftp {
    my $host = $_[0];
    unless ($ftp = Net::FTP->new($host, Timeout => 6, Debug => 0)) {
        print "Couldn't connect to $host\n";
        return 1;
    }
    return 0;
}

sub loginftp {
    my ($user, $pw) = @_;
    unless ($ftp->login($user, $pw)) {
        print "Couldn't login\n";
        return 1;
    }
    return 0;
}
1;
Replies are listed 'Best First'.
Re: ftp remote-editing script
by FoxtrotUniform (Prior) on Jun 26, 2002 at 16:10 UTC

    I like this code. I have three suggestions:

    1. I'd make $firsttime an explicit package variable (refer to it as $main::firsttime) rather than a top-level lexical. After the top-level while loop, you don't refer to it for a long time, and its appearance in checkfile is a bit disorienting.
    2. Instead of running words together in symbol names, I'd separate them with underscores (so $firsttime would become $first_time). This is quite subjective, but I find it much easier to read.
    3. The massive if...elsif...elsif...else statement in sub ftp is ugly. :-) I'd use a dispatch table instead: 
        my %commands = (
    'LS'   => \&lsftp,
    'DIR'  => \&dirftp,
    'GET'  => \&getftp,
    'PUT'  => \&putftp,
    'DEL'  => \&delftp,
    'SIZE' => \&sizeftp,
  );

  [...]

  my $cmd = $commands{$type};
  if(&$cmd($value1, $value2) == 1) {
    sleep $idletime;
    next;
  }

      [download]

      It would take a little bit of work to make the interfaces for each command sub identical (or at least compatible), but I think the savings are worth it.

    --
    The hell with paco, vote for Erudil!
    :wq

[reply]
[d/l]
[select]

Back to Code Catacombs