aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xclubber187
1 files changed, 113 insertions, 74 deletions
diff --git a/clubber b/clubber
index 537a8da..35568bf 100755
--- a/clubber
+++ b/clubber
@@ -8,6 +8,13 @@
# @author Tom Ryder <tom@sanctum.geek.nz>
# @copyright 2012 Sanctum
#
+# $Author$
+# $Date$
+# $Id$
+# $Revision$
+# $Source$
+#
+package Sanctum::Clubber;
#
# Force me to write this properly.
@@ -16,48 +23,54 @@ use strict;
use warnings;
#
+# Set a version number to shut perlcritic up.
+#
+our $VERSION => 1.0;
+
+#
# Import required Perl libraries; these are all pretty standard.
#
use Cwd qw(abs_path);
use Digest::MD5;
+use English qw(-no_match_vars);
use File::Basename;
use File::Find;
use Getopt::Long;
#
-# Ignore stupid and useless messages from File::Find.
-#
-no warnings 'File::Find';
-
-#
# Check ldd is available.
#
-chomp(my $ldd = `which ldd`);
-if (!$ldd) {
- error("Couldn't find ldd in your \$PATH.");
+chomp( my $ldd = qx/which ldd/ );
+if ( !$ldd ) {
+ error('Could not find ldd in your PATH.');
}
#
# Check options.
#
-my ($chroot, $dry) = ("", 0);
-my $config = GetOptions("chroot=s" => \$chroot,
- "dry" => \$dry);
+my ( $chroot, $dry ) = ( q{}, 0 );
+my $config = GetOptions(
+ 'chroot=s' => \$chroot,
+ 'dry' => \$dry
+);
if ($chroot) {
$chroot = abs_path($chroot);
- if (!-d $chroot) {
- error("Nominated chroot %s doesn't seem to be a directory.", $chroot);
+ if ( !-d $chroot ) {
+ error( 'Nominated chroot %s does not seem to be a directory.',
+ $chroot );
}
-} elsif ($dry) {
- error("Doesn't make sense to specify --dry without --chroot.");
+}
+elsif ($dry) {
+ error('Does not make sense to specify --dry without --chroot.');
}
#
# Check we were passed at least one parameter, otherwise print a helpful
# message.
#
-if (!@ARGV) {
- printf STDOUT "USAGE: ${0} [--chroot] [--dry] binary1 binary2 ... \n";
+if ( !@ARGV ) {
+ printf {*STDOUT} "USAGE: %s [--chroot] [--dry] binary1 binary2 ... \n",
+ $PROGRAM_NAME;
exit 0;
}
@@ -67,10 +80,11 @@ if (!@ARGV) {
my $binaries = [];
foreach my $argument (@ARGV) {
$argument = abs_path($argument);
- if (-f $argument) {
- push @$binaries, $argument;
- } else {
- error("File %s doesn't seem to exist.", $argument);
+ if ( -f $argument ) {
+ push @{$binaries}, $argument;
+ }
+ else {
+ error( 'File %s does not seem to exist.', $argument );
}
}
@@ -78,15 +92,7 @@ foreach my $argument (@ARGV) {
# Run ldd on all the files and slurp all the absolute paths; put them into a
# hash to keep things unique.
#
-my $libraries = {};
-foreach my $binary (@$binaries) {
- my $output = [qx/${ldd} ${binary}/];
- foreach my $line (@$output) {
- if ($line =~ m#(/\S*lib\S+)#) {
- $libraries->{$1} = 1;
- }
- }
-}
+my $libraries = get_libraries($binaries);
#
# Include all libnss libraries available, because even static binaries depend
@@ -101,15 +107,17 @@ foreach my $binary (@$binaries) {
my $nsslibs = {};
my $nssfind = sub {
my $basename = $_;
- if ($File::Find::name =~ /libnss.+\.so/) {
- if (!exists $nsslibs->{$basename} or length($File::Find::name) < length($nsslibs->{$basename})) {
+ if ( $File::Find::name =~ /libnss.+[.]so/msx ) {
+ if ( not exists $nsslibs->{$basename}
+ or length($File::Find::name) < length( $nsslibs->{$basename} ) )
+ {
$nsslibs->{$basename} = $File::Find::name;
}
}
};
-find($nssfind, qw(/lib /usr/lib));
-foreach my $nsslib (keys(%$nsslibs)) {
- $libraries->{$nsslibs->{$nsslib}} = 1;
+find( $nssfind, qw(/lib /usr/lib) );
+foreach my $nsslib ( keys %{$nsslibs} ) {
+ $libraries->{ $nsslibs->{$nsslib} } = 1;
}
#
@@ -117,7 +125,7 @@ foreach my $nsslib (keys(%$nsslibs)) {
# and which directories require creating.
#
if ($chroot) {
- my ($directories, $imports) = ({}, {});
+ my ( $directories, $imports ) = ( {}, {} );
#
# First we'll recurse through the list of libraries and flag any
@@ -129,13 +137,13 @@ if ($chroot) {
# library. If it doesn't exist or if it's different, we'll flag it for
# overwriting.
#
- foreach my $library (keys(%$libraries)) {
+ foreach my $library ( keys %{$libraries} ) {
my $directory = dirname($library);
#
# If the directory doesn't exist, flag it for creation.
#
- if (!-d "${chroot}${directory}") {
+ if ( !-d "${chroot}${directory}" ) {
$directories->{$directory} = 1;
}
@@ -143,39 +151,44 @@ if ($chroot) {
# If the library exists, we need to see if it's the same as our source
# library.
#
- if (-f "${chroot}${library}") {
+ if ( -f "${chroot}${library}" ) {
#
# Get MD5 checksum of source library.
#
- open(my $src, "<", $library)
- or error("Couldn't read file %s to checksum it.", $library);
- binmode($src);
+ open my $src, '<', $library
+ or error( 'Could not read file %s to checksum it.', $library );
+ binmode $src;
my $src_checksum = Digest::MD5->new->addfile($src)->hexdigest;
- close($src);
+ close $src
+ or error( 'Could not close file %s.', $library );
#
# Get MD5 checksum of library presently occupying the path to
# which we intend to copy this library.
#
- open(my $dst, "<", "${chroot}${library}")
- or error("Couldn't read file %s to checksum it.", "${chroot}${library}");
- binmode($dst);
+ open my $dst, '<', "${chroot}${library}"
+ or error( 'Could not read file %s to checksum it.',
+ "${chroot}${library}" );
+ binmode $dst;
my $dst_checksum = Digest::MD5->new->addfile($dst)->hexdigest;
- close($dst);
+ close $dst
+ or error( 'Could not close file %s.', $library );
#
# Compare checksums; if they're different, we need to copy the
# library in.
#
- if ($src_checksum ne $dst_checksum) {
+ if ( $src_checksum ne $dst_checksum ) {
$imports->{$library} = 1;
}
+ }
+
#
# The library doesn't exist, so we need to copy it in.
#
- } else {
+ else {
$imports->{$library} = 1;
}
}
@@ -183,63 +196,72 @@ if ($chroot) {
#
# Check there's something for us to do.
#
- if (keys %$directories || keys %$imports) {
+ if ( keys %{$directories} || keys %{$imports} ) {
#
# If we're just supposed to print what we do, all the better, do
# that and then quit; and for that, we don't require root privileges.
#
if ($dry) {
- if (keys %$directories) {
- printf STDOUT "Create directories:\n";
- foreach my $directory (sort(keys(%$directories))) {
- printf STDOUT " %s\n", "${chroot}${directory}";
+ if ( keys %{$directories} ) {
+ printf {*STDOUT} "Create directories:\n";
+ foreach my $directory ( sort keys %{$directories} ) {
+ printf {*STDOUT} " %s\n", "${chroot}${directory}";
}
}
- if (keys %$imports) {
- printf STDOUT "Copy libraries:\n";
- foreach my $import (sort(keys(%$imports))) {
- printf STDOUT " %s -> %s\n", $import, "${chroot}${import}";
+ if ( keys %{$imports} ) {
+ printf {*STDOUT} "Copy libraries:\n";
+ foreach my $import ( sort keys %{$imports} ) {
+ printf {*STDOUT} " %s -> %s\n", $import,
+ "${chroot}${import}";
}
}
+ }
+
#
# Otherwise, we'd best get started, and we need root privileges.
#
- } else {
+ else {
#
# Bail if we're not root.
#
- if ($< != 0 || $> != 0) {
- error("You must have root permissions to use the --chroot parameter.");
+ if ( $UID != 0 || $EUID != 0 ) {
+ error(
+'You must have root permissions to use the --chroot parameter.'
+ );
}
#
# Create directories and import libraries.
#
- foreach my $directory (sort(keys(%$directories))) {
- system("mkdir -pv ${chroot}${directory}");
+ foreach my $directory ( sort keys %{$directories} ) {
+ system "mkdir -pv ${chroot}${directory}";
}
- foreach my $import (sort(keys(%$imports))) {
- system("cp -pv ${import} ${chroot}${import}");
+ foreach my $import ( sort keys %{$imports} ) {
+ system "cp -pv ${import} ${chroot}${import}";
}
}
+ }
+
#
# If there's nothing we need to do, say so.
#
- } else {
- printf STDOUT "Nothing to do.\n";
+ else {
+ printf {*STDOUT} "Nothing to do.\n";
}
+}
+
#
# If we don't have a chroot, we can just print the list of libraries, and we're
# done.
#
-} else {
- foreach my $library (sort(keys(%$libraries))) {
- printf STDOUT "%s\n", $library;
+else {
+ foreach my $library ( sort keys %{$libraries} ) {
+ printf {*STDOUT} "%s\n", $library;
}
}
@@ -249,11 +271,28 @@ if ($chroot) {
exit 0;
#
+# Run ldd on all the files and slurp all the absolute paths; put them into a
+# hash to keep things unique.
+#
+sub get_libraries {
+ my ($targets) = @_;
+ foreach my $target ( @{$targets} ) {
+ my $output = [qx/${ldd} ${target}/];
+ foreach my $line ( @{$output} ) {
+ if ( $line =~ m/(\/\S*lib\S+)/msx ) {
+ $libraries->{$1} = 1;
+ }
+ }
+ }
+ return $libraries;
+}
+
+#
# Print a usage message and exit with non-zero.
#
sub usage {
- my $message = shift @_;
- printf STDERR "USAGE: ${message}\n", @_;
+ my ( $message, @params ) = @_;
+ printf {*STDERR} "USAGE: ${message}\n", @params;
exit 1;
}
@@ -261,8 +300,8 @@ sub usage {
# Print a usage message and exit with non-zero.
#
sub error {
- my $message = shift @_;
- printf STDERR "ERROR: ${message}\n", @_;
+ my ( $message, @params ) = @_;
+ printf {*STDERR} "ERROR: ${message}\n", @params;
exit 1;
}