Category: |
Utility Scripts |
Author/Contact Info |
ybiC |
Description: |
I wrote this ditty to automate file copies, while retaining last-modified timestamps.
- Backup system configs, web directories, and perl scripts on 4 computers.
- Make it easy to keep perl scripts synchronized across the same 4 PCs.
Create gzipped tarball of all files in specified directories. Status and error messages written to console and logfile. Selectable compression level, recursion(y/n), log and dest files via commandline switches. Tested with Perl5.00503/Debian2.2r3, ActivePerl5.6/Win2k, Perl5.6.1/Cygwin/Win2k.
Sample run logfile at tail of pod. Critique, corrections and comments wildly welcomed.
Thanks to Vynce, mlong, bikeNomad, zdog, Beatnik, clintp, Petruchio and DrZaius for suggestions, tips and pointers. Oh yeah, and some guy named vroom, too.
Latest updates 2001-06-05 14:25 CDT
Correction:
Our very own bikeNomad wrote Archive::Zip, not Archive::Tar.
|
#!/usr/bin/perl -wT
# tgz.pl
# pod at tail
use strict;
use Archive::Tar;
use Getopt::Long;
use Time::localtime;
# List of target directories (omit trailing slash)
my @dirs = qw(
/var/www
/etc
);
# Accept commandline switches
my (%parm, %file);
GetOptions(
'recurse!' => \$parm{recurse},
'cmprlevl=s' => \$parm{cmprlevl},
'outfile=s' => \$file{out},
'logfile=s' => \$file{log},
);
# Default values if no commandline parameters
$parm{recurse} ||= 0; # 1=yes 0=no
$parm{cmprlevl} ||= 9; # compression level (2=big,fast 9=small
+,slow)
$file{out} ||= 'tgzpl.tar.gz';
$file{log} ||= 'tgzpl.log';
# Untaint commandline parameters
Usage() unless ($parm{cmprlevl} =~ (/^[2-9]$/));
Usage() unless ($file{out} =~ (/^.*$/));
Usage() unless ($file{log} =~ (/^.*$/));
# Files readable only by user running this program
umask oct 177;
open(LOG, ">$file{log}") or die "Error opening $file{log}:\n$!";
PrintLogCon("\n Launching $0\n");
TimeStamp();
# Get down to business
my $ArcTar = Archive::Tar -> new();
PrintLogCon(" Read directories and files\n");
while(@dirs) {
my $dir = shift @dirs;
PrintLogCon(" $dir\n");
opendir DIR, $dir or PrintLogCon("Error opening $dir: $!\
+n");
my @infiles = (readdir DIR) or PrintLogCon("Error reading $dir: $!\
+n");
closedir DIR or PrintLogCon("Error closing $dir: $!\
+n");
# skip symlinks, but recurse directories if told to
for(@infiles) {
$_ =~ m/^\.{1,2}$/ and next;
my $absolute = "$dir/$_";
if (-l $absolute) { next; }
if ($parm{recurse}==1 and -d $absolute) {unshift @dirs,$absolute
+;next;}
unless ($ArcTar -> add_files("$absolute")) {
PrintLogCon("Error adding \"$_\" to $file{out}: $!\n");
}
}
}
PrintLogCon("\n Write and compress tgzball\n");
$ArcTar -> write($file{out}, $parm{cmprlevl});
# Wrapitup
$file{outsize} = (stat($file{out}))[7];
PrintLogCon(
" $file{out}\n",
" $file{outsize} bytes\n",
"\n",
" $0 finished.\n"
);
TimeStamp();
close LOG or die "Error closing $file{log}: $!";
######################################################################
+####
sub Usage {
print(
"\n",
" D'oh! Looks like you entered an option that $0 didn't like.
+\n",
"\n",
" tgz.pl\n",
" --recurse\n",
" --norecurse (default)\n",
" --comprlevl=[2-9] (default is 9)\n",
" --outfile=path/file (default is ./tgzpl.tar.gz)\n",
" --logfile=path/file (default is ./tgzpl.log)\n",
"\n",
" Options can also be abreviated:\n",
" (the '=' is optional as well)\n",
" -r \n",
" -n \n",
" -c [2-9]\n",
" -o path/file\n",
" -l path/file\n",
"\n",
" Archive::Tar $Archive::Tar::VERSION\n",
" Getopt::Long $Getopt::Long::VERSION\n",
" Time::localtime $Time::localtime::VERSION\n",
" Perl $]\n",
" OS $^O\n",
"\n",
);
exit;
}
######################################################################
+####
# print messages to both console and logfile
sub PrintLogCon {
print @_;
print(LOG @_) or die "Error printing to $file{log}:\n
+$!";
}
######################################################################
+####
# print date/timestamp to both console and logfile
sub TimeStamp {
printf " %4d-%2d-%2d %2d:%2d:%2d\n\n",
localtime -> year()+1900,
localtime -> mon()+1,
localtime -> mday(),
localtime -> hour(),
localtime -> min(),
localtime -> sec(),
;
printf LOG " %4d-%2d-%2d %2d:%2d:%2d\n\n",
localtime -> year()+1900,
localtime -> mon()+1,
localtime -> mday(),
localtime -> hour(),
localtime -> min(),
localtime -> sec(),
or die "Error printing to $file{log}:\n$!";
}
######################################################################
+####
# for testing purposes
sub Pause {
print"Ctrl+c to abort, <enter> to continue \n";
(<STDIN>);
}
######################################################################
+####
=head1 Name
tgz.pl
=head1 Description
Create gzipped tarball of all files in specified directories.
Status and error messages written to console and logfile.
Selectable compression level, recursion(y/n),
log and dest files selectable via commandline switches.
=head1 Requires
Archive::Tar http://search.cpan.org/search?dist=Archive-Tar
Getopt::Long http://search.cpan.org/search?dist=Getopt-Long
Perl http://www.cpan.org/ports/
gzip http://www.gzip.org/
=head1 Tested
Archive::Tar 0.22
Getopt::Long 2.25 and 2.19
Time::localtime 1.01
gzip 1.13
Perl 5.00503
Debian 2.2r3
Archive::Tar 0.072
Getopt::Long 2.23
Time::localtime 1.01
gzip 1.2.4
ActivePerl 5.006
MSWin32 5.0 b2195 sp1
Archive::Tar 0.22
Getopt::Long 2.24
Time::localtime 1.01
gzip 1.2.4
Perl 5.006001
Cygwin 1.1.8-1
MSWin32 5.0 b2195 sp1
=head1 Updates
2001-06-04 12:40
Retest on Win32 ActivePerl, and on Cygwin.
Add Getopt::Long abreviations to Usage().
'--recurse' option with no argument.
Untaint commandline switches.
Usage().
Getopt::Long commandline switches.
2001-06-03 21:40
Post to PerlMonks (Code Catacombs->Utility Scripts).
Unsubify 'report versions' since only done once.
Test with:
Cygwin Win2kPro
ActivePerl Win2kPro
2001-06-02
Configurable recursion(y/n) and compression level.
Timestamp at start and end of run.
Add umask for bit o'security.
Print to logfile in addition to console.
Depth-first recursion instead of width-first
(while+shift+unshift instead of for+push)
Display outfile size with 'stat'.
Filetest to exclude symlinks.
(avoid endless looop on Debian /etc/apache/conf->./)
(no read-perm check on purpose, so errmsg on unreadable file(s))
Add "qw" to @dirs and move comment out of parens.
2001-06-01
Directory recursion.
Initial working code
Debian 2.2r3
=head1 Todos
Archive::Zip, File::Find, or File::Recurse instead of hand-rolled rec
+ursion.
Good regex instead of blind untaint outfile and logfile from commandl
+ine.
--nolog option where $file{log} = '/dev/null'.
Reduce untaint redundancy.
Reduce TimeStamp() redundancy.
Make logfile 'live'.
Add $version reporting.
=head1 Author
ybiC
=head1 Credits
Thanks to:
Vynce, mlong, bikeNomad, zdog, and Beatnik for recursion suggestion
+s,
Petruchio for assorted tips,
clintp for sane way to add elts to list while looping through same
+list,
DrZaius for slick Getopt::Long pointers,
Oh yeah, and some guy named vroom, too.
=head1 Sample logfile of tgz.pl -r -c 9
Launching tgz.pl
2001- 6- 4 3:41:46
Read directories and files
/var/www
/var/www/HOWTO.ps
/var/www/Webalizer
/etc
/etc/apache
/etc/Net
/etc/imlib
/etc/logrotate.d
/etc/cron.d
/etc/cron.monthly
/etc/rcS.d
/etc/rc6.d
/etc/rc5.d
/etc/rc4.d
/etc/rc3.d
/etc/rc2.d
/etc/rc1.d
/etc/rc0.d
/etc/rc.boot
/etc/cron.weekly
/etc/chatscripts
Error opening /etc/chatscripts: Permission denied
Error reading /etc/chatscripts: Permission denied
Error closing /etc/chatscripts: Permission denied
/etc/ppp
Error opening /etc/ppp: Permission denied
Error reading /etc/ppp: Permission denied
Error closing /etc/ppp: Permission denied
/etc/network
/etc/cron.daily
/etc/default
/etc/apt
/etc/init.d
Write and compress tgzball
/home/me/tgzpl.tar.gz
25293464 bytes
tgz.pl finished.
2001- 6- 4 3:43:11
=cut
|
Re: Yet Another Tarball Script (gzip ta'boot)
by bikeNomad (Priest) on Jun 04, 2001 at 04:28 UTC
|
While I didn't write Archive::Tar, I did write Archive::Zip. Here's a version of ybiC's program that makes zip files instead, just as a demo.
#!/usr/bin/perl -w
# zgz.pl
# pod at tail
use strict;
use Archive::Zip qw(:CONSTANTS :ERROR_CODES);
use Time::localtime;
# Config parameters
my @dirs = qw(
/var/www
/etc
); # omit trailing slash
my %parm = (
cmprlevl => '9', # compression level (2=big,fast 9=small
+,slow)
recurse => '1', # 1=yes, anythingelse=no
);
my %file = (
out => 'zgzpl.zip',
log => 'zgzpl.log',
);
# Files readable only by user running this program
umask oct 177;
open(LOG, ">$file{log}") or die "Error opening $file{log}:\n$!";
PrintLogCon("\n Launching $0\n");
TimeStamp();
PrintLogCon(
" Report versions:\n",
" Archive::Zip $Archive::Zip::VERSION\n",
" Time::localtime $Time::localtime::VERSION\n",
" Perl $]\n",
" OS $^O\n",
"\n",
);
# Get down to business
my $ArcZip = Archive::Zip -> new();
PrintLogCon(" Read directories and files:\n");
while(@dirs) {
my $dir = shift @dirs;
PrintLogCon(" $dir\n");
opendir DIR, $dir or PrintLogCon("Error opening $dir: $!\
+n");
my @infiles = (readdir DIR) or PrintLogCon("Error reading $dir: $!\
+n");
closedir DIR or PrintLogCon("Error closing $dir: $!\
+n");
# skip symlinks, but recurse directories if told to
for(@infiles) {
$_ =~ m/^\.{1,2}$/ and next;
my $absolute = "$dir/$_";
if (-l $absolute) { next; }
if ($parm{recurse}==1 and -d $absolute) {unshift @dirs,$absolute
+;next;}
if (my $member = $ArcZip -> addFile($absolute)) {
$member->desiredCompressionLevel($parm{cmprlevl});
}
else {
PrintLogCon("Error adding \"$_\" to $file{out}: $!\n");
}
}
}
PrintLogCon("\n Write zip file:\n");
$ArcZip -> writeToFileNamed($file{out})
or PrintLogCon("Error writing $file{out}: $!\n");
$file{outsize} = (stat($file{out}))[7];
PrintLogCon(
" $file{out}\n",
" $file{outsize} bytes\n",
"\n",
" $0 finished.\n"
);
TimeStamp();
close LOG or die "Error closing $file{log}: $!";
######################################################################
+####
# print messages to both console and logfile
sub PrintLogCon {
print @_;
print(LOG @_) or die "Error printing to $file{log}:\n
+$!";
}
######################################################################
+####
# print date/timestamp to both console and logfile
sub TimeStamp {
printf " %4d-%2d-%2d %2d:%2d:%2d\n\n",
localtime -> year()+1900,
localtime -> mon()+1,
localtime -> mday(),
localtime -> hour(),
localtime -> min(),
localtime -> sec(),
;
printf LOG " %4d-%2d-%2d %2d:%2d:%2d\n\n",
localtime -> year()+1900,
localtime -> mon()+1,
localtime -> mday(),
localtime -> hour(),
localtime -> min(),
localtime -> sec(),
or die "Error printing to $file{log}:\n$!";
}
######################################################################
+####
# for testing purposes
sub Pause {
print"Ctrl+c to abort, <enter> to continue \n";
(<STDIN>);
}
######################################################################
+####
| [reply] [d/l] |
Re: Yet Another Tarball Script (gzip ta'boot)
by DrZaius (Monk) on Jun 04, 2001 at 06:01 UTC
|
Why no command line? Try changing your hash to this:
use Getopt::Long;
my (%parm, %file);
GetOptions(
'recurse' => \$parm{recurse},
'cmprlevl' => \$parm{cmprlevl},
'outfile' => \$file{out},
'logfile' => \$file{log}
);
$parm{recurse} ||= 1;
$parm{cmprlevl} ||= 9;
$parm{out} ||= 'tgzpl.tar.gz';
$parm{log} ||= 'tgzpl.log';
Now you can use 'gnu' long format args with your program. For example, tgz.pl --cmprlevl=3. Don't forget to untaint these values as well. | [reply] [d/l] |
Re: Yet Another Gzip Tarball Script (New and Improved)
by Beatnik (Parson) on Jun 04, 2001 at 13:06 UTC
|
I actually wrote something similar (but skinnier) a few weeks ago... network backup thing :)
Greetz
Beatnik
... Quidquid perl dictum sit, altum viditur. | [reply] |
|
|