CUFP
Beatnik
This code reads a db file with files/dir, tars it and puts it on a remote SMB host.
<CODE>#!/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","zaterdag","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"; }
</CODE><BR>
Param style is constructed for cron usage...<BR>
<CODE>$day</CODE> and <CODE>$month</CODE> strings are in dutch :|<BR>
Sample format of backuplist.db:<BR>
<PRE>
/home/beatnik/code -R
/home/apache -R
/downloads/*.tar.gz
</PRE>
<BR>Greetz<BR>
Beatnik<BR>
... Quidquid perl dictum sit, altum viditur.