rsync_wrapper.pl

   1 #      __
   2 #     /\ \ From the mind of
   3 #    /  \ \
   4 #   / /\ \ \_____ Lee Eakin  <LEakin@Nostrum.COM>
   5 #  /  \ \ \______\       or  <Lee@Eakin.ORG>
   6 # / /\ \ \/____  /
   7 # \ \ \ \____\/ / Wrapper module for the rsync program
   8 #  \ \ \/____  /  rsync can be found at http://rsync.samba.org/rsync/
   9 #   \ \____\/ /
  10 #    \/______/
  11
  12 package Rsync;
  13 require 5.004;
  14
  15 use FileHandle;
  16 use IPC::Open3 qw(open3);
  17 use Carp;
  18
  19 use strict;
  20
  21 =head1 NAME
  22
  23 Rsync - perl module interface to B<rsync> http://rsync.samba.org/rsync/
  24
  25 =head1 SYNOPSIS
  26
  27 use Rsync;
  28
  29 $obj = Rsync->new(qw(-az C<-e> /usr/local/bin/ssh
  30          --rsync-path /usr/local/bin/rsync));
  31
  32 $obj->exec(qw(localdir rhost:remdir))
  33          or warn "rsync failed\n";
  34
  35 =head1 DESCRIPTION
  36
  37 Perl Convenience wrapper for B<rsync> program.  Written for B<rsync> 2.3.1 but
  38 should perform properly with most versions.
  39
  40 =cut
  41
  42 # options from the rsync man pae
  43 ###### Boolean flags ######
  44 # -h, --help                  show this help screen
  45 # -v, --verbose               increase verbosity
  46 # -q, --quiet                 decrease verbosity
  47 # -c, --checksum              always checksum
  48 # -a, --archive               archive mode
  49 # -r, --recursive             recurse into directories
  50 # -R, --relative              use relative path names
  51 # -b, --backup                make backups (default ~  suffix)
  52 # -u, --update                update only (don't overwrite newer files)
  53 # -l, --links                 preserve soft links
  54 # -L, --copy-links            treat soft links like regular files
  55 #     --copy-unsafe-links     copy links outside the source tree
  56 #     --safe-links            ignore links outside the destination tree
  57 # -H, --hard-links            preserve hard links
  58 # -p, --perms                 preserve permissions
  59 # -o, --owner                 preserve owner (root only)
  60 # -g, --group                 preserve group
  61 # -D, --devices               preserve devices (root only)
  62 # -t, --times                 preserve times
  63 # -S, --sparse                handle sparse files efficiently
  64 # -n, --dry-run               show what would have been transferred
  65 # -W, --whole-file            copy whole files, no incremental checks
  66 # -x, --one-file-system       don't cross filesystem boundaries
  67 # -C, --cvs-exclude           auto ignore files in the same way CVS does
  68 #                             RCS SCCS CVS CVS.adm RCSLOG cvslog.* tags TAGS
  69 #                             .make.state .nse_depinfo *~ #* .#* ,* *.old *.bak
  70 #                             *.BAK *.orig *.rej .del-* *.a *.o *.obj *.so *.Z
  71 #                             *.elc *.ln core
  72 #     --delete                delete files that don't exist on the sending side
  73 #     --delete-excluded       also delete excluded files on the receiving side
  74 #     --partial               keep partially transferred files
  75 #     --force                 force deletion of directories even if not empty
  76 #     --numeric-ids           don't map uid/gid values by user/group name
  77 # -I, --ignore-times          don't exclude files that match length and time
  78 #     --size-only             only use file size when determining if a file
  79 #                             should be transferred
  80 # -z, --compress              compress file data
  81 #     --version               print version number
  82 #     --daemon                run as a rsync daemon
  83 #     --stats                 give some file transfer stats
  84 #     --progress              show progress during transfer
  85 ###### scalar values ######
  86 #     --csum-length=LENGTH    <=16 bit md4 checksum size
  87 # -B, --block-size=SIZE       checksum blocking size (default 700)
  88 #     --timeout=TIME          set IO timeout in seconds
  89 #     --port=PORT             specify alternate rsyncd port number
  90 # -e, --rsh=COMMAND           specify rsh replacement
  91 # -T, --temp-dir=DIR          create temporary files in directory DIR
  92 #     --compare-dest=DIR      also compare destination files relative to DIR
  93 #     --exclude-from=FILE     exclude patterns listed in FILE
  94 #     --include-from=FILE     don't exclude patterns listed in FILE
  95 #     --config=FILE           specify alternate rsyncd.conf file
  96 #     --password-file=FILE    get password from FILE
  97 #     --log-format=FORMAT     log file transfers using specified format
  98 #     --suffix=SUFFIX         override backup suffix
  99 #     --rsync-path=PATH       specify path to rsync on the remote machine
 100 ###### array values ######
 101 #     --exclude=PATTERN       exclude files matching PATTERN
 102 #     --include=PATTERN       don't exclude files matching PATTERN
 103 #
 104
 105 =over 4
 106
 107 =item Rsync::new
 108
 109 $obj = new Rsync;
 110
 111    or
 112
 113 $obj = Rsync->new;
 114
 115    or
 116
 117 $obj = Rsync->new(@options);
 118
 119 =back
 120
 121 Create an Rsync object.  Any options passed at creation are stored in
 122 the object as defaults for all future exec call on that object.  Options
 123 are the same as those in L<rsync> with the addition of
 124 --path-to-rsync which can be used to override the hardcoded default of
 125 /usr/local/bin/rsync, and --debug which causes the module functions to
 126 print some debugging information to STDERR.
 127
 128 =cut
 129
 130 sub new {
 131    my $class=shift;
 132
 133    # seed the options hash, booleans, scalars, excludes, data,
 134    # status, stderr/stdout storage for last exec
 135    my $self={
 136       # the full path name to the rsync binary
 137       'path-to-rsync' => '/usr/local/bin/rsync',
 138       # these are the boolean flags to rsync, all default off, including them
 139       # in the args list turns them on
 140       'flag' => {qw(
 141          --archive         0   --backup          0   --checksum          0
 142          --compress        0   --copy-links      0   --copy-unsafe-links 0
 143          --cvs-exclude     0   --daemon          0   --delete            0
 144          --delete-excluded 0   --devices         0   --dry-run           0
 145          --force           0   --group           0   --hard-links        0
 146          --help            0   --ignore-times    0   --links             0
 147          --numeric-ids     0   --one-file-system 0   --owner             0
 148          --partial         0   --perms           0   --progress          0
 149          --quiet           0   --recursive       0   --relative          0
 150          --safe-links      0   --size-only       0   --sparse            0
 151          --stats           0   --times           0   --update            0
 152          --verbose         0   --version         0   --whole-file        0
 153       )},
 154       # these have simple scalar args we cannot easily check
 155       'scalar' => {qw(
 156          --block-size      0   --compare-dest    0   --config            0
 157          --csum-length     0   --exclude-from    0   --include-from      0
 158          --log-format      0   --password-file   0   --port              0
 159          --rsh             0   --rsync-path      0   --suffix            0
 160          --temp-dir        0   --timeout         0
 161       )},
 162       # these can be specified multiple times and are additive, the doc also
 163       # specifies that it is an ordered list so we must preserve that order
 164       'exclude'     => [],
 165       # source/destination path names and hostnames
 166       'data'        => [],
 167       # return status from last exec
 168       'status'      => 0,
 169       'realstatus'  => 0,
 170       # whether or not to print debug statements
 171       'debug'       => 0,
 172       # stderr from last exec in array format (messages from remote rsync proc)
 173       'err'         => [],
 174       # stdout from last exec in array format (messages from local rsync proc)
 175       'out'         => [],
 176    };
 177    if (@_) {
 178       &defopts($self,@_) or return undef;
 179    }
 180    bless $self, $class;
 181 }
 182
 183 =over 4
 184
 185 =item Rsync::defopts
 186
 187 defopts $obj @options;
 188
 189    or
 190
 191 $obj->defopts(@options);
 192
 193 =back
 194
 195 Set default options for future exec calls for the object.  See L<rsync>
 196 for a complete list of valid options.  This is really the internal
 197 function that B<new> calls but you can use it too.  Presently there is no way
 198 to turn off the boolean options short of creating another object, but if it is
 199 needed and the B<rsync> guys don't use it, I may add hooks to let + and ++ or a
 200 leading no- toggle it back off similar to B<Getopt::Long> (the GNU way).
 201
 202 =cut
 203
 204 sub defopts {
 205    my $self=shift;
 206    my @opts=@_;
 207
 208    # need a conversion table in case someone uses the short options
 209    my %short=(qw(
 210       -B  --block-size   -C  --cvs-exclude     -D  --devices   -H  --hard-links
 211       -I  --ignore-times -L  --copy-links      -R  --relative  -T  --temp-dir
 212       -W  --whole-file   -a  --archive         -b  --backup    -c  --checksum
 213       -e  --rsh          -g  --group           -h  --help      -l  --links
 214       -n  --dry-run      -o  --owner           -p  --perms     -q  --quiet
 215       -r  --recursive    -s  --sparse          -t  --times     -u  --update
 216       -v  --verbose      -x  --one-file-system -z  --compress
 217    ));
 218    while (my $opt=shift @opts) {
 219       my $arg;
 220       print(STDERR "setting debug flag\n"),$self->{debug}=1,next
 221          if $opt eq '--debug';
 222       print STDERR "processing option: $opt\n" if $self->{debug};
 223       if ($opt=~/^-/) {
 224          # handle short opts first
 225          if ($opt=~/^-(\w+)$/) {
 226             foreach (split '',$1) {
 227                print STDERR "short option: -$_\n" if $self->{debug};
 228                if (exists $short{'-'.$_}) {
 229                   $opt=$short{'-'.$_};
 230                   # convert it to the long form
 231                   $opt=$short{$opt} if exists $short{$opt};
 232                   # handle the 3 short opts that require args
 233                   $self->{scalar}{$opt}=shift(@opts),next if (/^[BeT]$/);
 234                   # handle the rest
 235                   $self->{flag}{$opt}=1,next if exists $self->{flag}{$opt};
 236                }
 237                carp "$opt - unknown option\n";
 238                return undef;
 239             }
 240          }
 241          # handle long opts with = args
 242          if ($opt=~/^(--\w+[\w-]*)=(.*)$/) {
 243             print STDERR "splitting longopt: $opt ($1 $2)\n" if $self->{debug};
 244             ($opt,$arg)=($1,$2);
 245          }
 246          # handle boolean flags
 247          $self->{flag}{$opt}=1,next if exists $self->{flag}{$opt};
 248          # handle simple scalars
 249          $self->{scalar}{$opt}=($arg || shift @opts),next
 250             if exists $self->{scalar}{$opt};
 251          # handle excludes
 252          if ($opt eq '--exclude') {
 253             $arg||=shift @opts;
 254             # if they sent a reset, we will too
 255             $self->{exclude}=[],next if $arg eq '!';
 256             # otherwise add it to the list
 257             push @{$self->{exclude}},$arg;
 258             next;
 259          }
 260          # to preserve order we store both includes and excludes in the same
 261          # array.  We use the leading '+ ' (plus space) trick from the man
 262          # page to accomplish this.
 263          if ($opt eq '--include') {
 264             $arg||=shift @opts;
 265             # first check to see if this is really an exclude
 266             push(@{$self->{exclude}},$arg),next if $arg=~s/^- //;
 267             # next see if they sent a reset, if they did, we will too
 268             $self->{exclude}=[],next if $arg eq '!';
 269             # if it really is an include, fix it first, since we use exclude
 270             $arg='+ '.$arg unless $arg=~/^\+ /;
 271             push @{$self->{exclude}},$arg;
 272             next;
 273          }
 274          # handle our special case to override hard-coded path to rsync
 275          $self->{'path-to-rsync'}=($arg || shift @opts),next
 276             if $opt eq '--path-to-rsync';
 277          # if we get this far nothing matched so it must be an error
 278          carp "$opt - unknown option\n";
 279          return undef;
 280       } else { # must be data (source/destination info)
 281          print STDERR "adding to data array: $opt\n" if $self->{debug};
 282          push(@{$self->{data}},$opt);
 283       }
 284    }
 285    1;
 286 }
 287
 288 =over 4
 289
 290 =item Rsunc::exec
 291
 292 exec $obj @options or warn "rsync failed\n";
 293
 294    or
 295
 296 $obj->exec(@options) or warn "rsync failed\n";
 297
 298 =back
 299
 300 This is the function that does the real work.  Any options passed to this
 301 routine are appended to any pre-set options and are not saved.  They effect
 302 the current execution of B<rsync> only.  It returns 1 if the return status was
 303 zero (or true), if the B<rsync> return status was non-zero it returns undef and
 304 stores the return status.  You can examine the return status from rsync and
 305 any output to stdout and stderr with the functions listed below.
 306
 307 =cut
 308
 309 sub exec {
 310    my $self=shift;
 311    my @cmd=($self->{'path-to-rsync'});
 312
 313    foreach (sort keys %{$self->{flag}}) {
 314       push @cmd,$_ if $self->{flag}{$_};
 315    }
 316    foreach (sort keys %{$self->{scalar}}) {
 317       push @cmd,$_.'='.$self->{scalar}{$_} if $self->{scalar}{$_};
 318    }
 319    foreach (@{$self->{exclude}}) {
 320       push @cmd,'--exclude='.$_;
 321    }
 322    foreach (@{$self->{data}}) {
 323       push @cmd,$_;
 324    }
 325    push @cmd,@_ if @_;
 326    print STDERR "exec: @cmd\n" if $self->{debug};
 327    my $in=FileHandle->new; my $out=FileHandle->new; my $err=FileHandle->new;
 328    my $pid=eval{ open3 $in,$out,$err,@cmd };
 329    if ($@) {
 330       $self->{realstatus}=0;
 331       $self->{status}=255;
 332       $self->{err}=[$@,"Execution of rsync failed.\n"];
 333       return undef;
 334    }
 335    $in->close; # we don't use it and neither should rsync (at least not yet)
 336    $self->{err}=[ $err->getlines ];
 337    $self->{out}=[ $out->getlines ];
 338    $err->close;
 339    $out->close;
 340    waitpid $pid,0;
 341    $self->{realstatus}=$?;
 342    $self->{status}=$?>>8;
 343    return undef if $self->{status};
 344    return 1;
 345 }
 346
 347 =over 4
 348
 349 =item Rsync::status
 350
 351 $rval = status $obj;
 352
 353    or
 354
 355 $rval = $obj->status;
 356
 357 =back
 358
 359 Returns the status from last B<exec> call right shifted 8 bits.
 360
 361 =cut
 362
 363 sub status {
 364    my $self=shift;
 365    return $self->{status};
 366 }
 367
 368 =over 4
 369
 370 =item Rsync::realstatus
 371
 372 $rval = realstatus $obj;
 373
 374    or
 375
 376 $rval = $obj->realstatus;
 377
 378 =back
 379
 380 Returns the real status from last B<exec> call (not right shifted).
 381
 382 =cut
 383
 384 sub realstatus {
 385    my $self=shift;
 386    return $self->{realstatus};
 387 }
 388
 389 =over 4
 390
 391 =item Rsync::err
 392
 393 $aref = err $obj;
 394
 395    or
 396
 397 $aref = $obj->err;
 398
 399 =back
 400
 401 Returns an array or a reference to the array containing all output to stderr
 402 from the last B<exec> call.  B<rsync> sends all messages from the remote
 403 B<rsync> process to stderr.  This functions purpose is to make it easier for
 404 you to parse that output for appropriate information.
 405
 406 =cut
 407
 408 sub err {
 409    my $self=shift;
 410    return(wantarray ? @{$self->{err}} : $self->{err});
 411 }
 412
 413 =over 4
 414
 415 =item Rsync::out
 416
 417 $aref = out $obj;
 418
 419    or
 420
 421 $aref = $obj->out;
 422
 423 =back
 424
 425 Similar to the B<err> function, this returns an array or a reference to the
 426 array containing all output to stdout from the last B<exec> call.  B<rsync>
 427 sends all messages from the local B<rsync> process to stdout.
 428
 429 =cut
 430
 431 sub out {
 432    my $self=shift;
 433    return(wantarray ? @{$self->{out}} : $self->{out});
 434 }
 435
 436 =head1 Author
 437
 438 Lee Eakin E<lt>leakin@nostrum.comE<gt>
 439
 440 =head1 Credits
 441
 442 Gerard Hickey                             C<PGP::Pipe>
 443
 444 Russ Allbery                              C<PGP::Sign>
 445
 446 Graham Barr                               C<Net::*>
 447
 448 Andrew Tridgell and Paul Mackerras        C<rsync(1)>
 449
 450 John Steele   E<lt>steele@nostrum.comE<gt>
 451
 452 Philip Kizer  E<lt>pckizer@nostrum.comE<gt>
 453
 454 Larry Wall                                C<perl(1)>
 455
 456 I borrowed many clues on wrapping an external program from the PGP modules,
 457 and I would not have had such a useful tool to wrap except for the great work
 458 of the B<rsync> authors.  Thanks also to Graham Barr, the author of the libnet
 459 modules and many others, for looking over this code.  Of course I must mention
 460 the other half of my brain, John Steele, and his good friend Philip Kizer for
 461 finding B<rsync> and bringing it to my attention.  And I would not have been
 462 able to enjoy writing useful tools if not for the creator of the B<perl>
 463 language.
 464
 465 =head1 Copyrights
 466
 467       Copyleft (l) 1999, by Lee Eakin
 468
 469 =cut
 470
 471 1;