#!/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
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.