File-Remote
view release on metacpan or search on metacpan
# $Id: Remote.pm,v 1.17 2005/01/10 21:47:52 nwiger Exp $
####################################################################
#
# Copyright (c) 1998-2003 Nathan Wiger <nate@sun.com>
#
# This module takes care of dealing with files regardless of whether
# they're local or remote. It allows you to create and edit files
# without having to worry about their physical location. If a file
# passed in is of the form 'host:/path/to/file', then it uses rsh/rcp
# or ssh/scp (depending on how you configure it) calls to edit the file
# remotely. Otherwise, it edits the file locally.
#
# It is my intent to provide a full set of File::Remote routines that
# mirror the standard file routines. If anybody notices any that are
# missing or even has some suggestions for useful ones, I'm all ears.
#
# For full documentation, use "perldoc Remote.pm" or "man File::Remote"
#
# This module is free software; you may copy this under the terms of
# the GNU General Public License, or the Artistic License, copies of
# which should have accompanied your Perl kit.
#
####################################################################
#=========================== Setup =================================
# Basic module setup
require 5.005;
package File::Remote;
use strict;
use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS $VERSION
%RW_HANDLES %RO_HANDLES %RW_TMPFILES %RO_TMPFILES);
use Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
rreadfile rwritefile rmkdir rrmdir rrm runlink rcp rcopy rtouch rchown
rchmod rmove rmv rbackup setrsh setrcp settmp ropen rclose rappend rprepend
rsymlink rlink readfile writefile mkdir rmdir rm unlink cp copy touch chown
chmod move mv backup open close append prepend symlink link readlink rreadlink
);
%EXPORT_TAGS = (
files => [qw(ropen rclose rreadfile rwritefile runlink rcopy rtouch rmove
rbackup rappend rprepend rlink rsymlink rreadlink)],
config => [qw(setrsh setrcp settmp)],
dirs => [qw(rmkdir rrmdir)],
perms => [qw(rchown rchmod)],
standard => [qw(ropen rclose rreadfile rwritefile runlink rcopy rtouch rmove
rbackup rappend rprepend setrsh setrcp settmp rmkdir rrmdir
rchown rchmod rsymlink rlink rreadlink)],
aliases => [qw(rrm rmv rcp)],
replace => [qw(open close readfile writefile unlink rm copy cp touch move mv
backup append prepend setrsh setrcp settmp mkdir rmdir chown chmod
symlink link readlink)]
);
# Straight from CPAN
$VERSION = do { my @r=(q$Revision: 1.17 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
# Errors
use Carp;
# Need the basic File classes to make it work
use File::Copy qw(!copy !move); # prevent namespace clashes
use File::Path;
# For determining remote or local file
use Sys::Hostname;
#======================== Configuration ==========================
# Defaults
my @OPT = (
rsh => "/usr/bin/rsh",
rcp => "/usr/bin/rcp",
tmp => "/tmp"
);
# This determines whether or not we should spend some time trying
# to see if rsh and rcp are set to valid values before using them.
# By default these checks are not done because they're SLOW...
# Note that if you enable these then you must use absolute paths
# when calling setrsh and setrcp; "setrsh('ssh')" will fail.
my $CHECK_RSH_IS_VALID = 0;
my $CHECK_RCP_IS_VALID = 0;
# This is whether or not to spend the extra cycles (and network
# latency) checking whether a remote file is actually writeable
# when we try to open it with > or >>. Note: Unsetting this can
# result in strange and unpredictable behavior, messing with it
# is NOT recommended.
my $CHECK_REMOTE_FILES = 1;
#======================== Misc. Settings =========================
# This is the default class for the File::Remote object (from CGI.pm!)
my $DefaultClass ||= 'File::Remote';
my $DefaultClassObject; # holds an object later on
# This should not need to be overridden
(my $hostname = hostname()) =~ s/\..*//;
# Need to check our OS. As of this release, only UNIX is supported;
# perhaps this will change in the future, but probably not.
# Don't check $^O because we'd have to write an exhaustive function.
die "Sorry, File::Remote only supports UNIX systems\n" unless (-d "/");
#========================== Functions ============================
# Simple debugging function
my $DEBUG = 0;
sub _debug { warn "debug: ", @_ if $DEBUG };
if ($recurse) {
rmtree(["$ldir"], 0, 0) or return undef;
} else {
rmdir $ldir or return undef;
}
}
return 1;
}
#######
# Usage: $remote->copy($file1, $file2);
#
# This copies files around, just like UNIX cp. If one of
# the files is remote, it uses rcp. Both files cannot be
# remote.
#######
*rcp = \©
*rcopy = \©
*cp = \©
sub copy {
# This copies the given file, either locally or remotely
# depending on whether or not it's remote or not.
my($self, $srcfile, $destfile) = _self_or_default(@_);
croak "Bad usage of copy" unless ($srcfile && $destfile);
my($srhost, $slfile) = _parsepath($srcfile);
my($drhost, $dlfile) = _parsepath($destfile);
if($srhost || $drhost) {
_debug("copy -- system($self->setrcp, $srcfile, $destfile)");
$self->_system($self->setrcp, $srcfile, $destfile) or return undef;
} else {
_debug("copy -- copy($slfile, $dlfile)");
File::Copy::copy($slfile, $dlfile) or return undef;
}
return 1;
}
#######
# Usage: $remote->move($file1, $file2);
#
# This moves files around, just like UNIX mv. If one of
# the files is remote, it uses rcp/rm. Both files cannot be
# remote.
#######
*rmove = \&move;
*rmv = \&move;
*mv = \&move;
sub move {
# This does NOT fall through to a standard rename command,
# simply because there are too many platforms on which this
# works too differently (Solaris vs. Linux, for ex).
(©(@_) && &unlink(@_)) || return undef;
return 1;
}
#######
# Usage: $remote->chown($file1, $file2);
#
# This chown's files just like UNIX chown.
#######
*rchown = \&chown;
sub chown {
# If remote, subshell it; else, use Perl's chown
# Form of chown is the same as normal chown
my($self, $uid, $gid, $file) = _self_or_default(@_);
croak "Bad usage of chown" unless ($uid && $gid && $file);
my($rhost, $lfile) = _parsepath($file);
if($rhost) {
$self->_system($self->setrsh, $rhost, "'chown $uid $lfile ; chgrp $gid $lfile'") or return undef;
} else {
# Check if we need to resolve stuff
($uid) = getpwnam($uid) if ($uid =~ /[a-zA-Z]/);
($gid) = getgrnam($gid) if ($gid =~ /[a-zA-Z]/);
chown($uid, $gid, $lfile) || return undef;
}
return 1;
}
#######
# Usage: $remote->chmod($mode, $file);
#
# This chmod's files just like UNIX chmod.
#######
*rchmod = \&chmod;
sub chmod {
# Same as chown, really easy
my($self, $mode, $file) = _self_or_default(@_);
croak "Bad usage of chmod" unless ($mode && $file);
my($rhost, $lfile) = _parsepath($file);
if($rhost) {
$self->_system($self->setrsh, $rhost, "'chmod $mode $lfile'") or return undef;
} else {
chmod($mode, $lfile) || return undef;
}
return 1;
}
#######
# Usage: $remote->unlink($file);
#
# This removes files, just like UNIX rm.
#######
*rrm = \&unlink;
*rm = \&unlink;
*runlink = \&unlink;
sub unlink {
# Really easy
my($self, $file) = _self_or_default(@_);
croak "Bad usage of unlink" unless ($file);
my($rhost, $lfile) = _parsepath($file);
if($rhost) {
$self->_system($self->setrsh, $rhost, "'rm -f $lfile'") or return undef;
} else {
CORE::unlink($lfile) || return undef;
}
return 1;
}
#######
# Usage: $remote->link($file);
#
# This links files, just like UNIX ln.
#######
*rln = \&link;
*ln = \&link;
*rlink = \&link;
sub link {
# This logic is similar to copy, only if a host:/path
# is specified, that must be specified for both - we
# can't link across servers! (obviously)
my($self, $srcfile, $destfile) = _self_or_default(@_);
croak "Bad usage of link" unless ($srcfile && $destfile);
my($srhost, $slfile) = _parsepath($srcfile);
my($drhost, $dlfile) = _parsepath($destfile);
if($srhost && $drhost) {
if($srhost eq $drhost) {
$self->_system($self->setrsh, $srhost, "ln", $slfile, $dlfile) or return undef;
} else {
croak "Cannot link two files from different hosts!";
my @prefile = $self->readfile($file) or return undef;
my @newfile = (@prefile, @file) or return undef;
$self->writefile($file, @newfile) or return undef;
return 1;
}
#######
# Usage: $remote->prepend($file, @file);
#
# This is just like writefile, only that it prepends to the file
# rather than overwriting it.
#######
*rprepend = \&prepend;
sub prepend {
my($self, $file, @file) = _self_or_default(@_);
croak "Bad usage of prepend" unless ($file);
my @postfile = $self->readfile($file) or return undef;
my @newfile = (@file, @postfile) or return undef;
$self->writefile($file, @newfile) or return undef;
return 1;
}
1;
#------------------------------------------------
# Documentation starts down here...
#------------------------------------------------
__END__ DATA
=head1 NAME
File::Remote - Read/write/edit remote files transparently
=head1 SYNOPSIS
#
# Two ways to use File::Remote
#
# First, the function-based style. Here, we can use the
# special :replace tag to overload Perl builtins!
#
use File::Remote qw(:replace); # special :replace tag
# read from a remote file
open(REMOTE, "host:/remote/file") or die $!;
print while (<REMOTE>);
close(REMOTE);
# writing a local file still works!
open(LOCAL, ">>/local/file");
print LOCAL "This is a new line.\n";
close(LOCAL);
mkdir("host:/remote/dir", 0755);
unlink("host:/remote/file");
unlink("/local/file"); # still works too!
symlink("host:/remote/src", "host:/remote/dest");
chown("root", "other", "host:/remote/dir/file");
chmod(0600, "host:/remote/dir/file");
#
# Next, the object-oriented style, if you don't want to
# mess with the builtins.
#
use File::Remote;
my $remote = new File::Remote;
# Standard filehandles
$remote->open(FILE, ">>host:/remote/file") or die $!;
print FILE "Here's a line that's added.\n";
$remote->close(FILE);
# Create a new file and change its permissions
$remote->mkdir("host:/remote/dir");
$remote->touch("host:/remote/dir/file");
# Move files around
$remote->copy("/local/file", "host:/remote/file") or warn $!;
$remote->move("host:/remote/file", "/local/file");
# Read and write whole files
my @file = $remote->readfile("host:/remote/file");
$remote->writefile("/local/file", @file);
# Backup a file with a suffix
$remote->backup("host:/remote/oldfile", "save");
# Use secure connection methods
my $secure = new File::Remote (rsh => "/usr/local/bin/ssh",
rcp => "/usr/local/bin/scp");
$secure->unlink("/local/file");
$secure->rmdir("host:/remote/dir");
=head1 DESCRIPTION
This module takes care of dealing with files regardless of whether
they're local or remote. It allows you to create and edit files without
having to worry about their physical location on the network. If a file
passed into a function is of the form C<host:/path/to/file>, then
C<File::Remote> uses rsh/rcp (or ssh/scp, depending on how you configure it)
to edit the file remotely. Otherwise, it assumes the file is local and
passes calls directly through to Perl's core functions.
The nice thing about this module is that you can use it for I<all> your
file calls, since it handles both remote and local files transparently.
This means you don't have to put a whole bunch of checks for remote files
in your code. Plus, if you use the function-oriented interface along with
the C<:replace> tag, you can actually redefine the Perl builtin file
functions. This means that your existing Perl scripts can automatically
handle remote files with no re-engineering(!).
There are two ways to program with C<File::Remote>, an object-oriented
style and a function-oriented style. Both methods work equally well,
it's just a matter of taste. One advantage of the object-oriented
method is that this allows you to read and write from different servers
using different methods (eg, rsh vs. ssh) simultaneously:
# Object-oriented method
use File::Remote;
my $remote = new File::Remote;
my $secure = new File::Remote (rsh => "/bin/ssh", rcp => "/bin/scp");
# Securely copy, write, and remove a file in one swoop...
$remote->open(LOCAL, "/local/file") or die "Open failed: $!\n";
$secure->open(REMOTE, "host:/remote/file") or die "Open failed: $!\n";
print REMOTE "$_" while (<LOCAL>);
$remote->close(LOCAL);
$secure->close(REMOTE);
# And let's move some files around securely
$secure->move("/local/file", "host:/remote/file");
$secure->copy("host:/remote/file", "/local/file");
To use the function-oriented interface, you must import the special tag
called C<:replace> which will actually replace the Perl builtin functions:
# Replace Perl's file methods with File::Remote's
use File::Remote qw(:replace);
open(FILE, ">host:/remote/file") or die "Open failed: $!\n";
print FILE "Hello, world!\n";
close(FILE) or die "Close failed: $!\n";
mkdir("/local/new/dir", "2775");
mkdir("host:/remote/new/dir");
chown("root", "other", "/local/new/dir");
unlink("host:/remote/file");
This is pretty neat; since C<File::Remote> will pass calls to local files
straight through to Perl's core functions, you'll be able to do all this
"transparently" and not care about the locations of the files. Plus,
this has the big advantage of making your existing Perl scripts capable
of dealing with remote files without having to rewrite any code.
Because the names for the C<File::Remote> methods clash with the Perl builtins,
if you use the function-oriented style with the C<:standard> tag there is
an extra 'r' added to the front of the function names. Thus, C<<$remote->open>>
becomes 'ropen' in the C<:standard> function-oriented version:
# Function-oriented method
use File::Remote qw(:standard); # use standard function names
setrsh("/share/bin/ssh");
setrcp("/share/bin/scp");
# same functionality, but there's an "r" prefix
ropen(FILE, "host:/remote/file") or die "Open failed: $!\n";
print while (<FILE>);
rclose(FILE) or die "Close failed: $!\n";
runlink("host:/remote/file");
rmkdir("host:/remote/dir");
rchmod("0700", "host:/remote/dir");
That's kinda nasty, though. I recommend you use the C<:replace> tag,
personally.
=head1 FUNCTIONS
Below are each of the functions you can make use of with C<File::Remote>.
Remember, for the function-oriented style, unless you use the C<:replace>
tag you'll have to add an extra 'r' to the start of each function name.
For all functions, the file arg can be either local or remote.
=head2 new(opt => val, opt => val)
This is the main constructor when you're using the object-oriented
method of calling. You only need to use this if you're using the
object-oriented calling form. You can pass it three arguments which
change how it works:
rsh - path to your rsh or ssh program
rcp - path to your rcp or scp program
tmp - path to your tmp directory
So, for example:
use File::Remote;
my $secure = File::Remote->new(rsh => '/usr/local/bin/ssh',
rcp => '/usr/local/bin/scp',
tmp => '/var/run');
$secure->copy($src, $dest);
The above would setup your C<$secure> object so that calls to methods on
it would use ssh and scp for connections.
=head2 setrsh(prog) ; setrcp(prog) ; settmp(dir)
These perform the equivalent functionality to setting the above flags,
for use in the function-oriented method of calling. So, if you were to
decide you didn't want to use the OO method, but instead wanted to use
the drop-in replacement function method (which I prefer):
use File::Remote qw(:replace);
setrsh('/usr/local/bin/ssh');
setrcp('/usr/local/bin/scp');
settmp('/var/run');
copy($src, $dest);
That chain of calls would have the exact same effect, only using the
function-oriented format instead of the object-oriented format.
=head2 open(HANDLE, file) ; close(HANDLE)
Used to open and close files just like the Perl builtins. These functions
accept both string filehandles and typeglob references, so any valid
Perl open calls:
open(FILE, ">> $file");
open(*FILE, ">$file");
open(\*FH, "< $file");
Should work, except for the 5.6 and later:
open(my $fh, $file);
This does not work when using C<File::Remote>. Patches to overcome this
are welcomed.
=head2 touch(file)
Updates the modification time on a file, or creates it if it doesn't exist,
just like the UNIX touch command.
=head2 mkdir(dir [, mode]) ; rmdir(dir [, recurse])
Create a dir with optional octal mode [mode]; remove a dir tree optionally
recursively. By default, rmdir works recursively, and the mode of the new
dir from mkdir depends on your umask.
=head2 copy(file1, file2)
Simply copies a file, just like File::Copy's function of the same name.
You can also address it as 'cp' (if you import the :aliases tag).
=head2 move(file1, file2)
Moves a file ala File::Copy. You can also address it as 'mv'
(if you import the :aliases tag).
=head2 chmod(mode, file) ; chown(owner, group, file)
Change the permissions or the owner of a file.
=head2 unlink(file)
Remove a file. You can also address it as 'rm' (if you import the :aliases tag).
=head2 link(file1, file2)
Create a hard link between two files. The caveat to this function
is that both files must be local, or both files must be remote.
=head2 symlink(file1, file2)
Works just like link only creates symbolic instead of hard links.
=head2 readlink(file)
This reads what a symbolic link points to, just like the Perl builtin.
=head2 backup(file, [file|suffix])
This backs up a file, useful if you're going to be manipulating it.
If you just call it without the optional second filename or suffix,
the suffix 'bkup' will be added to the file. Either file can be local
or remote; this is really just a front-end to copy().
=head2 readfile(file) , writefile(file, @data)
These read and write whole files in one swoop, just like File::Slurp.
readfile() returns an array of the file, and writefile just returns
success or failure.
=head2 append(file, @data) , prepend(file, @data)
Similar to writefile(), only these don't overwrite the file, these
either append or prepend the data to the file.
=head1 EXAMPLES
Here's some more examples of how to use this module:
=head2 1. Add a new user to /etc/passwd on your server
This might be useful if you've got some type of web-based newuser
program that runs on a host other than the one you have to edit
/etc/passwd on:
# Function-oriented method
use File::Remote qw(:replace);
$passwd = "server:/etc/passwd";
backup($passwd, 'old'); # back it up to be safe
open(PASSWD, ">>$passwd") or die "Couldn't write $passwd: $!\n";
print PASSWD "$newuser_entry\n";
close(PASSWD);
=head2 2. Securely copy over a bunch of files
( run in 1.886 second using v1.01-cache-2.11-cpan-71847e10f99 )