Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Network backup thing

by Beatnik (Parson)
on May 13, 2001 at 19:44 UTC ( [id://80044]=CUFP: print w/replies, xml ) Need Help??

This code reads a db file with files/dir, tars it and puts it on a remote SMB host.
#!/usr/bin/perl use strict; use Archive::Tar; use File::Find; use Filesys::SmbClientParser; #Samba here I come my $samba_user = ""; my $samba_password = ""; my $samba_remote_host = ""; my $samba_share = ""; my $samba_current_host = ""; #Samba Remote share subdir #Empty means root share #Could be combined with $ENV{HOSTNAME} my $smb = new Filesys::SmbClientParser; $smb->Debug(0); #Dont dump SmbClient output on tty $smb->User($samba_user); $smb->Password($samba_password); $smb->Host($samba_remote_host); $smb->Share($samba_share); $smb->cd($samba_current_host); my $errorstring = <<EOS; Oops, Please define a backup method ! --daily : daily backup (incremental & rotating) -d : daily backup (incremental & rotating) --weekly : weekly backup (full & rotating) -w : weekly backup (full & rotating) --monthly : monthly backup (full & non rotating) -m : monthly backup (full & non rotating) EOS my $mode = undef; if (!@ARGV) { die $errorstring; } if ($ARGV[0] =~ /^\-*d/) { $mode = "d"; } if ($ARGV[0] =~ /^\-*w/) { $mode = "w"; } if ($ARGV[0] =~ /^\-*m/) { $mode = "m"; } if (!$mode) { die $errorstring; } #Shoot me because I didn't use Getopt my %patterns = ('*'=>'.*','?'=>'.'); my %methods = ('d'=>'daily','w'=>'weekly','m'=>'monthly'); my $tar = Archive::Tar->new(); open(LIST,"<backuplist.db") || die $!; #file with directories to backup while(my $line = <LIST>) { my @files = (); chomp $line; if (!$line) { next; } my $pattern = undef; my $path = undef; my $file = undef; my $option = undef; ($line,$option) = split(/ /,$line); if ($line !~ /[?*]/) { if (-l $line || -S $line || -p $line || -c $line || -b $line || -t + $line) { next; } #No symlinks, sockets, pipes, character files, block files or ttys if (-d $line) { $pattern = "*"; $path = $line; } } else { ($path,$pattern) = $line =~ /([^?*]*)\/(.*)/; } if (!-e $path) { next; } if ($pattern && $option =~ /r/i) { $pattern =~ s{(.)}{$patterns{$1} || "\Q$1" }ge; find(sub { if (/$pattern$/) { push(@files,$File::Find::dir."/".$_) +; } }, $path); } if ($pattern && $option !~ /r/i) { if ($path !~ /\/$/) { $path .= "/"; } @files = glob($path.$pattern); @files = grep { !-l $_ && !-S $_ && !-p $_ && !-c $_ && !-b $_ && + !-t $_ && !-d $_ } @files; } print "Adding $path to $methods{$mode} backup\n"; if ($mode eq "d") { @files = grep { $_ if -M $_ <= 1 } @files; } $tar->add_files(@files); } close(LIST); my $day = ("maandag","dinsdag","woensdag","donderdag","vrijdag","zater +dag","zondag")[(localtime)[6]-1]; my $week = "week-".int ((localtime)[3] / 7); my $month = ("januari","februari","maart","april","mei","juni","juli", +"augustus","september","oktober","november","december")[(localtime)[4 +]]."-".((localtime)[5]+1900); my $filename = $mode eq "d" ? $day : ($mode eq "w" ? $week : $month); if (-e $filename.".tar.gz") { unlink $filename.".tar.gz"; } $tar->write("$filename.tar.gz"); if ($tar->error) { die $tar->error; } my $counter = 0; my $error = undef; while ($counter != 2) { $error = $smb->put($filename.".tar.gz",$filename.".tar.gz"); if ($error != 2) { $counter++; } else { last; } } if ($counter == 2) { die $error; } else { unlink $filename.".tar.gz"; +}

Param style is constructed for cron usage...
$day and $month strings are in dutch :|
Sample format of backuplist.db:
/home/beatnik/code -R
/home/apache -R
/downloads/*.tar.gz

Greetz
Beatnik
... Quidquid perl dictum sit, altum viditur.

Replies are listed 'Best First'.
Re: Network backup thing
by DrZaius (Monk) on May 13, 2001 at 21:16 UTC
    Looking at this code makes me think life would be good with URI::SMB. This particular script would loose the
    my $samba_user = ""; my $samba_password = ""; my $samba_remote_host = ""; my $samba_share = ""; my $samba_current_host = ""; #Samba Remote share subdir #Empty means root share #Could be combined with $ENV{HOSTNAME}

    part. I would then use Getopts::Long to change the interface to something like:

    $0 --(daily|weekly|hourly|etc) --smb=smb://user:pass@host/share

    If --smb was not set, it could check the env before dieing.

    And it would be really helpful if Filesys::SmbClientParser accepted one of these.

    Have you thought about use URI's for your db file? That way you can back up not just local files, but files on other smb hosts, webpages, ftp files or hunks of ldap. Well, anything that uri supports and has a client for.

      Well uhm, TIMTOWTDI
      If the SMB connection (or network connection in general) would fail, there would still be a backup :)
      As a sidenote, I wasn't able to locate URI::SMB on CPAN, nor as Google search result... Is it some dark and well hidden module?

      Greetz
      Beatnik
      ... Quidquid perl dictum sit, altum viditur.
        Actually, URI::SMB does not exsit, but life would definetly be good if it existed. I've seen a lot of code that could use it, but haven't actually written any yet.

        I haven't had the itch yet, but as my sysadmin days continue, I'm sure it will happen sooner or later.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://80044]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others meditating upon the Monastery: (8)
As of 2024-03-28 15:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found