is a high-performance, enterprise-grade system for backing up Linux and WinXX PCs and laptops to a server’s disk (http/cgi user interface).
| AutoReconnect.pm (BackupPC-4.3.2) | : | AutoReconnect.pm (BackupPC-4.4.0) |
|---|
| | |
| skipping to change at line 73 | | skipping to change at line 73 |
|---|
| missed one you'd like, please send a patch. | | missed one you'd like, please send a patch. |
| | |
| =head2 CONSTRUCTOR | | =head2 CONSTRUCTOR |
| | |
| =head3 new | | =head3 new |
| | |
| All parameters are passed along verbatim to C<Net::FTP>, as well as | | All parameters are passed along verbatim to C<Net::FTP>, as well as |
| stored in case we have to reconnect. | | stored in case we have to reconnect. |
| | |
| =cut | | =cut |
|
| ; | | |
| | |
|
| sub new { | | sub new |
| my $self = {}; | | { |
| my $class = shift; | | my $self = {}; |
| bless $self,$class; | | my $class = shift; |
| | bless $self, $class; |
| | |
|
| $self->{newargs} = \@_; | | $self->{newargs} = \@_; |
| $self->reconnect(); | | $self->reconnect(); |
| | |
|
| $self; | | $self; |
| } | | } |
| | |
| =head2 METHODS | | =head2 METHODS |
| | |
| Most of the methods are those of L<Net::FTP|Net::FTP>. One additional | | Most of the methods are those of L<Net::FTP|Net::FTP>. One additional |
| method is available: | | method is available: |
| | |
| =head3 reconnect() | | =head3 reconnect() |
| | |
| Abandon the current FTP connection and create a new one, restoring all | | Abandon the current FTP connection and create a new one, restoring all |
| the state we can. | | the state we can. |
| | |
| =cut | | =cut |
|
| ; | | |
| | |
| sub reconnect | | sub reconnect |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| | |
|
| warn "Reconnecting!\n" | | warn "Reconnecting!\n" |
| if ($ENV{DEBUG}); | | if ( $ENV{DEBUG} ); |
| | |
|
| $self->{ftp} = Net::FTP->new(@{$self->{newargs}}) | | $self->{ftp} = Net::FTP->new(@{$self->{newargs}}) |
| or die "Couldn't create new FTP object\n"; | | or die "Couldn't create new FTP object\n"; |
| | |
|
| if ($self->{login}) | | if ( $self->{login} ) { |
| { | | $self->{ftp}->login(@{$self->{login}}); |
| $self->{ftp}->login(@{$self->{login}}); | | } |
| } | | if ( $self->{authorize} ) { |
| if ($self->{authorize}) | | $self->{ftp}->authorize(@{$self->{authorize}}); |
| { | | } |
| $self->{ftp}->authorize(@{$self->{authorize}}); | | if ( $self->{mode} ) { |
| } | | if ( $self->{mode} eq 'ascii' ) { |
| if ($self->{mode}) | | $self->{ftp}->ascii(); |
| { | | } else { |
| if ($self->{mode} eq 'ascii') | | $self->{ftp}->binary(); |
| { | | } |
| $self->{ftp}->ascii(); | | } |
| } | | if ( $self->{cwd} ) { |
| else | | $self->{ftp}->cwd($self->{cwd}); |
| { | | } |
| $self->{ftp}->binary(); | | if ( $self->{hash} ) { |
| } | | $self->{ftp}->hash(@{$self->{hash}}); |
| } | | } |
| if ($self->{cwd}) | | if ( $self->{restart} ) { |
| { | | $self->{ftp}->restart(@{$self->{restart}}); |
| $self->{ftp}->cwd($self->{cwd}); | | } |
| } | | if ( $self->{alloc} ) { |
| if ($self->{hash}) | | $self->{ftp}->restart(@{$self->{alloc}}); |
| { | | } |
| $self->{ftp}->hash(@{$self->{hash}}); | | if ( $self->{pasv} ) { |
| } | | $self->{ftp}->pasv(@{$self->{pasv}}); |
| if ($self->{restart}) | | } |
| { | | if ( $self->{port} ) { |
| $self->{ftp}->restart(@{$self->{restart}}); | | $self->{ftp}->port(@{$self->{port}}); |
| } | | } |
| if ($self->{alloc}) | | |
| { | | |
| $self->{ftp}->restart(@{$self->{alloc}}); | | |
| } | | |
| if ($self->{pasv}) | | |
| { | | |
| $self->{ftp}->pasv(@{$self->{pasv}}); | | |
| } | | |
| if ($self->{port}) | | |
| { | | |
| $self->{ftp}->port(@{$self->{port}}); | | |
| } | | |
| } | | } |
| | |
| sub _auto_reconnect | | sub _auto_reconnect |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my($code)=@_; | | my($code) = @_; |
| | |
|
| my $ret = $code->(); | | my $ret = $code->(); |
| if (!defined($ret)) | | if ( !defined($ret) ) { |
| { | | $self->reconnect(); |
| $self->reconnect(); | | $ret = $code->(); |
| $ret = $code->(); | | } |
| } | | $ret; |
| $ret; | | |
| } | | } |
| | |
| sub _after_pcmd | | sub _after_pcmd |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my($r) = @_; | | my($r) = @_; |
| if ($r) | | if ( $r ) { |
| { | | |
| # succeeded | | # succeeded |
| delete $self->{port}; | | delete $self->{port}; |
| delete $self->{pasv}; | | delete $self->{pasv}; |
| delete $self->{restart}; | | delete $self->{restart}; |
| delete $self->{alloc}; | | delete $self->{alloc}; |
| } | | } |
| $r; | | $r; |
| } | | } |
| | |
| sub login | | sub login |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| | |
|
| $self->{login} = \@_; | | $self->{login} = \@_; |
| $self->{ftp}->login(@_); | | $self->{ftp}->login(@_); |
| } | | } |
| | |
| sub authorize | | sub authorize |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{authorize} = \@_; | | $self->{authorize} = \@_; |
| $self->{ftp}->authorize(@_); | | $self->{ftp}->authorize(@_); |
| } | | } |
| | |
| sub site | | sub site |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{ftp}->site(@_); | | $self->{ftp}->site(@_); |
| } | | } |
| | |
| sub ascii | | sub ascii |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{mode} = 'ascii'; | | $self->{mode} = 'ascii'; |
| $self->_auto_reconnect(sub { $self->{ftp}->ascii() }); | | $self->_auto_reconnect(sub { $self->{ftp}->ascii() }); |
| } | | } |
| | |
| sub binary | | sub binary |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{mode} = 'binary'; | | $self->{mode} = 'binary'; |
| $self->_auto_reconnect(sub { $self->{ftp}->binary() }); | | $self->_auto_reconnect(sub { $self->{ftp}->binary() }); |
| } | | } |
| | |
| sub rename | | sub rename |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_auto_reconnect(sub { $self->{ftp}->rename(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->rename(@a) }); |
| } | | } |
| | |
| sub delete | | sub delete |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_auto_reconnect(sub { $self->{ftp}->delete(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->delete(@a) }); |
| } | | } |
| | |
| sub cwd | | sub cwd |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| my $ret = $self->_auto_reconnect(sub { $self->{ftp}->cwd(@a) }); | | my $ret = $self->_auto_reconnect(sub { $self->{ftp}->cwd(@a) }); |
| if (defined($ret)) | | if ( defined($ret) ) { |
| { | | $self->{cwd} = $self->{ftp}->pwd() |
| $self->{cwd} = $self->{ftp}->pwd() | | or die "Couldn't get directory after cwd\n"; |
| or die "Couldn't get directory after cwd\n"; | | } |
| } | | $ret; |
| $ret; | | |
| } | | } |
| | |
| sub cdup | | sub cdup |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| my $ret = $self->_auto_reconnect(sub { $self->{ftp}->cdup(@a) }); | | my $ret = $self->_auto_reconnect(sub { $self->{ftp}->cdup(@a) }); |
| if (defined($ret)) | | if ( defined($ret) ) { |
| { | | $self->{cwd} = $self->{ftp}->pwd() |
| $self->{cwd} = $self->{ftp}->pwd() | | or die "Couldn't get directory after cdup\n"; |
| or die "Couldn't get directory after cdup\n"; | | } |
| } | | $ret; |
| $ret; | | |
| } | | } |
| | |
| sub pwd | | sub pwd |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_auto_reconnect(sub { $self->{ftp}->pwd(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->pwd(@a) }); |
| } | | } |
| | |
| sub rmdir | | sub rmdir |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_auto_reconnect(sub { $self->{ftp}->rmdir(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->rmdir(@a) }); |
| } | | } |
| | |
| sub mkdir | | sub mkdir |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_auto_reconnect(sub { $self->{ftp}->mkdir(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->mkdir(@a) }); |
| } | | } |
| | |
| sub ls | | sub ls |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| my $ret = $self->_auto_reconnect(sub { $self->{ftp}->ls(@a) }); | | my $ret = $self->_auto_reconnect(sub { $self->{ftp}->ls(@a) }); |
| return $ret ? (wantarray ? @$ret : $ret) : undef; | | return $ret ? (wantarray ? @$ret : $ret) : undef; |
| } | | } |
| | |
| sub dir | | sub dir |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| my $ret = $self->_auto_reconnect(sub { $self->{ftp}->dir(@a) }); | | my $ret = $self->_auto_reconnect(sub { $self->{ftp}->dir(@a) }); |
| return $ret ? (wantarray ? @$ret : $ret) : undef; | | return $ret ? (wantarray ? @$ret : $ret) : undef; |
| } | | } |
| | |
| sub restart | | sub restart |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->{restart} = \@a; | | $self->{restart} = \@a; |
| $self->{ftp}->restart(@_); | | $self->{ftp}->restart(@_); |
| } | | } |
| | |
| sub retr | | sub retr |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->retr(@a) })); | | $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->retr(@a) })); |
| } | | } |
| | |
| sub get | | sub get |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_auto_reconnect(sub { $self->{ftp}->get(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->get(@a) }); |
| } | | } |
| | |
| sub mdtm | | sub mdtm |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_auto_reconnect(sub { $self->{ftp}->mdtm(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->mdtm(@a) }); |
| } | | } |
| | |
| sub size | | sub size |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_auto_reconnect(sub { $self->{ftp}->size(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->size(@a) }); |
| } | | } |
| | |
| sub abort | | sub abort |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{ftp}->abort(); | | $self->{ftp}->abort(); |
| } | | } |
| | |
| sub quit | | sub quit |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{ftp}->quit(); | | $self->{ftp}->quit(); |
| } | | } |
| | |
| sub hash | | sub hash |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->{hash} = \@a; | | $self->{hash} = \@a; |
| $self->{ftp}->hash(@_); | | $self->{ftp}->hash(@_); |
| } | | } |
| | |
| sub alloc | | sub alloc |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->{alloc} = \@a; | | $self->{alloc} = \@a; |
| $self->_auto_reconnect(sub { $self->{ftp}->alloc(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->alloc(@a) }); |
| } | | } |
| | |
| sub put | | sub put |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_auto_reconnect(sub { $self->{ftp}->put(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->put(@a) }); |
| } | | } |
| | |
| sub put_unique | | sub put_unique |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_auto_reconnect(sub { $self->{ftp}->put_unique(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->put_unique(@a) }); |
| } | | } |
| | |
| sub append | | sub append |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_auto_reconnect(sub { $self->{ftp}->append(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->append(@a) }); |
| } | | } |
| | |
| sub unique_name | | sub unique_name |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{ftp}->unique_name(@_); | | $self->{ftp}->unique_name(@_); |
| } | | } |
| | |
| sub supported | | sub supported |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_auto_reconnect(sub { $self->{ftp}->supported(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->supported(@a) }); |
| } | | } |
| | |
| sub port | | sub port |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->{port} = \@a; | | $self->{port} = \@a; |
| $self->_auto_reconnect(sub { $self->{ftp}->port(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->port(@a) }); |
| } | | } |
| | |
| sub pasv | | sub pasv |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->{pasv} = \@a; | | $self->{pasv} = \@a; |
| $self->_auto_reconnect(sub { $self->{ftp}->pasv(@a) }); | | $self->_auto_reconnect(sub { $self->{ftp}->pasv(@a) }); |
| } | | } |
| | |
| sub nlst | | sub nlst |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->nlst(@a) })); | | $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->nlst(@a) })); |
| } | | } |
| | |
| sub stou | | sub stou |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->stou(@a) })); | | $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->stou(@a) })); |
| } | | } |
| | |
| sub appe | | sub appe |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->appe(@a) })); | | $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->appe(@a) })); |
| } | | } |
| | |
| sub list | | sub list |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| my @a = @_; | | my @a = @_; |
| $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->list(@a) })); | | $self->_after_pcmd($self->_auto_reconnect(sub { $self->{ftp}->list(@a) })); |
| } | | } |
| | |
| sub pasv_xfer | | sub pasv_xfer |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{ftp}->pasv_xfer(@_); | | $self->{ftp}->pasv_xfer(@_); |
| } | | } |
| | |
| sub pasv_xfer_unique | | sub pasv_xfer_unique |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{ftp}->pasv_xfer_unique(@_); | | $self->{ftp}->pasv_xfer_unique(@_); |
| } | | } |
| | |
| sub pasv_wait | | sub pasv_wait |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{ftp}->pasv_wait(@_); | | $self->{ftp}->pasv_wait(@_); |
| } | | } |
| | |
| sub message | | sub message |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{ftp}->message(@_); | | $self->{ftp}->message(@_); |
| } | | } |
| | |
| sub code | | sub code |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{ftp}->code(@_); | | $self->{ftp}->code(@_); |
| } | | } |
| | |
| sub ok | | sub ok |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{ftp}->ok(@_); | | $self->{ftp}->ok(@_); |
| } | | } |
| | |
| sub status | | sub status |
| { | | { |
|
| my $self = shift; | | my $self = shift; |
| $self->{ftp}->status(@_); | | $self->{ftp}->status(@_); |
| } | | } |
| | |
| =head1 AUTHOR | | =head1 AUTHOR |
| | |
| Scott Gifford <sgifford@suspectclass.com> | | Scott Gifford <sgifford@suspectclass.com> |
| | |
| =head1 BUGS | | =head1 BUGS |
| | |
| We should really be smarter about when to retry. | | We should really be smarter about when to retry. |
| | |
| | | |
| End of changes. 54 change blocks. |
|---|
| 208 lines changed or deleted | | 192 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 