Point folks reading the first answer to the rsync-debug script mentioned
[rsync-web.git] / 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;