279 lines
9.0 KiB
Perl
279 lines
9.0 KiB
Perl
#!/usr/bin/perl -w
|
|
# $Id: slack-stage 180 2008-01-19 08:26:19Z alan $
|
|
# vim:sw=2
|
|
# vim600:fdm=marker
|
|
# Copyright (C) 2004-2008 Alan Sundell <alan@sundell.net>
|
|
# All Rights Reserved. This program comes with ABSOLUTELY NO WARRANTY.
|
|
# See the file COPYING for details.
|
|
#
|
|
# This script is in charge of copying files from the local cache
|
|
# directory to the local stage, building a unified single tree onstage
|
|
# from the multiple trees that are the role + subroles in the cache
|
|
|
|
require 5.006;
|
|
use warnings FATAL => qw(all);
|
|
use strict;
|
|
use sigtrap qw(die untrapped normal-signals
|
|
stack-trace any error-signals);
|
|
|
|
use File::Path;
|
|
use File::Find;
|
|
|
|
use constant LIB_DIR => '/usr/lib/slack';
|
|
use lib LIB_DIR;
|
|
use Slack;
|
|
|
|
my @rsync = ('rsync',
|
|
'--recursive',
|
|
'--times',
|
|
'--ignore-times',
|
|
'--perms',
|
|
'--sparse',
|
|
);
|
|
|
|
(my $PROG = $0) =~ s#.*/##;
|
|
|
|
sub check_stage ();
|
|
sub sync_role ($$@);
|
|
sub apply_default_perms_to_role ($$);
|
|
|
|
########################################
|
|
# Environment
|
|
# Helpful prefix to die messages
|
|
$SIG{__DIE__} = sub { die "FATAL[$PROG]: @_"; };
|
|
# Set a reasonable umask
|
|
umask 077;
|
|
# Get out of wherever (possibly NFS-mounted) we were
|
|
chdir("/")
|
|
or die "Could not chdir /: $!";
|
|
# Autoflush on STDERR
|
|
select((select(STDERR), $|=1)[0]);
|
|
|
|
########################################
|
|
# Config and option parsing {{{
|
|
my $usage = Slack::default_usage("$PROG [options] <role> [<role>...]");
|
|
$usage .= <<EOF;
|
|
|
|
--subdir DIR
|
|
Sync this subdir only. Possible values for DIR are 'files' and
|
|
'scripts'.
|
|
EOF
|
|
# Option defaults
|
|
my %opt = ();
|
|
Slack::get_options(
|
|
opthash => \%opt,
|
|
command_line_options => [
|
|
'subdir=s',
|
|
],
|
|
usage => $usage,
|
|
required_options => [ qw(cache stage) ],
|
|
);
|
|
|
|
# Arguments are required
|
|
die "No roles given!\n\n$usage" unless @ARGV;
|
|
|
|
# We only allow certain values for this option
|
|
if ($opt{subdir}) {
|
|
unless ($opt{subdir} eq 'files' or $opt{subdir} eq 'scripts') {
|
|
die "--subdir option must be 'files' or 'scripts'\n\n$usage";
|
|
}
|
|
} else {
|
|
$opt{subdir} = '';
|
|
}
|
|
|
|
# Prepare for backups
|
|
if ($opt{backup} and $opt{'backup-dir'}) {
|
|
# Make sure backup directory exists
|
|
unless (-d $opt{'backup-dir'}) {
|
|
($opt{verbose} > 0) and print STDERR "Creating backup directory '$opt{'backup-dir'}'\n";
|
|
if (not $opt{'dry-run'}) {
|
|
eval { mkpath($opt{'backup-dir'}); };
|
|
die "Could not mkpath backup dir '$opt{'backup-dir'}': $@\n" if $@;
|
|
}
|
|
}
|
|
push(@rsync, "--backup", "--backup-dir=$opt{'backup-dir'}");
|
|
}
|
|
|
|
# Pass options along to rsync
|
|
if ($opt{'dry-run'}) {
|
|
push @rsync, '--dry-run';
|
|
}
|
|
# Pass options along to rsync
|
|
if ($opt{'verbose'} > 1) {
|
|
push @rsync, '--verbose';
|
|
}
|
|
# }}}
|
|
|
|
# copy over the new files
|
|
for my $full_role (@ARGV) {
|
|
# Split the full role (e.g. google.foogle.woogle) into components
|
|
my @role_parts = split(/\./, $full_role);
|
|
die "Internal error: Expect at least one role part" if not @role_parts;
|
|
# Reassemble parts one at a time onto @role and sync as we go,
|
|
# so we do "google", then "google.foogle", then "google.foogle.woogle"
|
|
my @role = ();
|
|
# Make sure we've got the right perms before we copy stuff down
|
|
check_stage();
|
|
|
|
# For the base role, do both files and scripts.
|
|
push @role, shift @role_parts;
|
|
for my $subdir(qw(files scripts)) {
|
|
if (not $opt{subdir} or $opt{subdir} eq $subdir) {
|
|
($opt{verbose} > 1)
|
|
and print STDERR "$PROG: Calling sync_role for $full_role, @role\n";
|
|
# @role here will have one element, so sync_role will use --delete
|
|
sync_role($full_role, $subdir, @role)
|
|
}
|
|
}
|
|
|
|
# For all subroles, just do the files.
|
|
# (If we wanted script subroles to work like files, we'd get rid of this
|
|
# distinction and simplify the code.)
|
|
if (not $opt{subdir} or $opt{subdir} eq 'files') {
|
|
while (@role_parts) {
|
|
push @role, shift @role_parts;
|
|
($opt{verbose} > 1)
|
|
and print STDERR "$PROG: Calling sync_role for $full_role, @role\n";
|
|
sync_role($full_role, 'files', @role);
|
|
}
|
|
}
|
|
|
|
for my $subdir (qw(files scripts)) {
|
|
apply_default_perms_to_role($full_role, $subdir)
|
|
if (not $opt{subdir} or $opt{subdir} eq $subdir);
|
|
}
|
|
}
|
|
exit 0;
|
|
|
|
# Make sure the stage directory exists and is mode 0700, to protect files
|
|
# underneath in transit
|
|
sub check_stage () {
|
|
my $stage = $opt{stage} . "/roles";
|
|
if (not $opt{'dry-run'}) {
|
|
if (not -d $stage) {
|
|
($opt{verbose} > 0) and print STDERR "$PROG: Creating '$stage'\n";
|
|
eval { mkpath($stage); };
|
|
die "Could not mkpath cache dir '$stage': $@\n" if $@;
|
|
}
|
|
($opt{verbose} > 0) and print STDERR "$PROG: Checking perms on '$stage'\n";
|
|
if ($> != 0) {
|
|
warn "WARNING[$PROG]: Not superuser; unable to chown files\n";
|
|
} else {
|
|
chown(0, 0, $stage)
|
|
or die "Could not chown 0:0 '$stage': $!\n";
|
|
}
|
|
chmod(0700, $stage)
|
|
or die "Could not chmod 0700 '$stage': $!\n";
|
|
}
|
|
}
|
|
|
|
# Copy the files for a role from CACHE to STAGE
|
|
sub sync_role ($$@) {
|
|
my ($full_role, $subdir, @role) = @_;
|
|
my @this_rsync = @rsync;
|
|
|
|
# If we were only given one role part, we're in the base role
|
|
my $in_base_role = (scalar @role == 1);
|
|
|
|
# For the base role, delete any files that don't exist in the cache.
|
|
# Not for the subrole (otherwise we'll delete all files not in
|
|
# the subrole, which may be most of them!)
|
|
if ($in_base_role) {
|
|
push @this_rsync, "--delete";
|
|
}
|
|
|
|
# (a) => a/files
|
|
# (a,b,c) => a/files.b.c
|
|
my $src_path = $role[0].'/'.join(".", $subdir, @role[1 .. $#role]);
|
|
# This one's a little simpler:
|
|
my $dst_path = $full_role.'/'.$subdir;
|
|
|
|
# final / is important for rsync
|
|
my $source = $opt{cache} . "/roles/" . $src_path . "/";
|
|
my $destination = $opt{stage} . "/roles/" . $dst_path . "/";
|
|
if (not -d $destination and -d $source) {
|
|
($opt{verbose} > 0) and print STDERR "$PROG: Creating '$destination'\n";
|
|
if (not $opt{'dry-run'}) {
|
|
eval { mkpath($destination); };
|
|
die "Could not mkpath stage dir '$destination': $@\n" if $@;
|
|
}
|
|
}
|
|
|
|
# We no longer require the source to exist
|
|
if (not -d $source) {
|
|
# but we need to remove the destination if the source
|
|
# doesn't exist and we're in the base role
|
|
if ($in_base_role) {
|
|
rmtree($destination);
|
|
# rmtree() doesn't throw exceptions or give a return value useful
|
|
# for detecting failure, so we just check after the fact.
|
|
die "Could not rmtree '$destination' when '$source' missing\n"
|
|
if -e $destination;
|
|
}
|
|
# if we continue, rsync will fail because source is missing,
|
|
# so we don't.
|
|
return;
|
|
}
|
|
|
|
# All this to run an rsync command
|
|
my @command = (@this_rsync, $source, $destination);
|
|
($opt{verbose} > 0) and print STDERR "$PROG: Syncing $src_path with '@command'\n";
|
|
Slack::wrap_rsync(@command);
|
|
}
|
|
|
|
# This just takes the base role, and chowns/chmods everything under it to
|
|
# give it some sensible permissions. Basically, the only thing we preserve
|
|
# about the original permissions is the executable bit, since that's the
|
|
# only thing source code controls systems like CVS, RCS, Perforce seem to
|
|
# preserve.
|
|
sub apply_default_perms_to_role ($$) {
|
|
my ($role, $subdir) = @_;
|
|
my $destination = $opt{stage} . "/roles/" . $role;
|
|
|
|
if ($subdir) {
|
|
$destination .= '/' . $subdir;
|
|
}
|
|
|
|
# If the destination doesn't exist, it's probably because the source didn't
|
|
return if not -d $destination;
|
|
|
|
($opt{verbose} > 0) and print STDERR "$PROG: Setting default perms on $destination\n";
|
|
if ($> != 0) {
|
|
warn "WARNING[$PROG]: Not superuser; won't be able to chown files\n";
|
|
}
|
|
# Use File::Find to recurse the directory
|
|
find({
|
|
# The "wanted" subroutine is called for every directory entry
|
|
wanted => sub {
|
|
return if $opt{'dry-run'};
|
|
($opt{verbose} > 2) and print STDERR "$File::Find::name\n";
|
|
if (-l) {
|
|
# symlinks shouldn't be in here,
|
|
# since we dereference when copying
|
|
warn "WARNING[$PROG]: Skipping symlink at $File::Find::name: $!\n";
|
|
return;
|
|
} elsif (-f _) { # results of last stat saved in the "_"
|
|
if (-x _) {
|
|
chmod 0555, $_
|
|
or die "Could not chmod 0555 $File::Find::name: $!";
|
|
} else {
|
|
chmod 0444, $_
|
|
or die "Could not chmod 0444 $File::Find::name: $!";
|
|
}
|
|
} elsif (-d _) {
|
|
chmod 0755, $_
|
|
or die "Could not chmod 0755 $File::Find::name: $!";
|
|
} else {
|
|
warn "WARNING[$PROG]: Unknown file type at $File::Find::name: $!\n";
|
|
}
|
|
return if $> != 0; # skip chowning if not superuser
|
|
chown 0, 0, $_
|
|
or die "Could not chown 0:0 $File::Find::name: $!";
|
|
},
|
|
# end of wanted function
|
|
},
|
|
# way down here, we have the directory to traverse with File::Find
|
|
$destination,
|
|
);
|
|
}
|