2
# $Id: slack-stage,v 1.8 2006/09/25 18:35:17 alan Exp $
5
# Copyright (C) 2004-2006 Alan Sundell <alan@sundell.net>
6
# All Rights Reserved. This program comes with ABSOLUTELY NO WARRANTY.
7
# See the file COPYING for details.
9
# This script is in charge of copying files from the local cache
10
# directory to the local stage, building a unified single tree onstage
11
# from the multiple trees that are the role + subroles in the cache
14
use warnings FATAL => qw(all);
16
use sigtrap qw(die untrapped normal-signals
17
stack-trace any error-signals);
22
use constant LIB_DIR => '/usr/lib/slack';
33
(my $PROG = $0) =~ s#.*/##;
37
sub apply_default_perms_to_role ($$);
39
########################################
41
# Helpful prefix to die messages
42
$SIG{__DIE__} = sub { die "FATAL[$PROG]: @_"; };
43
# Set a reasonable umask
45
# Get out of wherever (possibly NFS-mounted) we were
47
or die "Could not chdir /: $!";
49
select((select(STDERR), $|=1)[0]);
51
########################################
52
# Config and option parsing {{{
53
my $usage = Slack::default_usage("$PROG [options] <role> [<role>...]");
57
Sync this subdir only. Possible values for DIR are 'files' and
64
command_line_options => [
68
required_options => [ qw(cache stage) ],
71
# Arguments are required
72
die "No roles given!\n\n$usage" unless @ARGV;
74
# We only allow certain values for this option
76
unless ($opt{subdir} eq 'files' or $opt{subdir} eq 'scripts') {
77
die "--subdir option must be 'files' or 'scripts'\n\n$usage";
84
if ($opt{backup} and $opt{'backup-dir'}) {
85
# Make sure backup directory exists
86
unless (-d $opt{'backup-dir'}) {
87
($opt{verbose} > 0) and print STDERR "Creating backup directory '$opt{'backup-dir'}'\n";
88
if (not $opt{'dry-run'}) {
89
eval { mkpath($opt{'backup-dir'}); };
90
die "Could not mkpath backup dir '$opt{'backup-dir'}': $@\n" if $@;
93
push(@rsync, "--backup", "--backup-dir=$opt{'backup-dir'}");
96
# Pass options along to rsync
97
if ($opt{'dry-run'}) {
98
push @rsync, '--dry-run';
100
# Pass options along to rsync
101
if ($opt{'verbose'} > 1) {
102
push @rsync, '--verbose';
106
# copy over the new files
107
for my $full_role (@ARGV) {
108
# Split the full role (e.g. google.foogle.woogle) into components
109
my @role_parts = split(/\./, $full_role);
110
die "Internal error: Expect at least one role part" if not @role_parts;
111
# Reassemble parts one at a time onto @role and sync as we go,
112
# so we do "google", then "google.foogle", then "google.foogle.woogle"
114
# Make sure we've got the right perms before we copy stuff down
117
# For the base role, do both files and scripts.
118
push @role, shift @role_parts;
119
for my $subdir(qw(files scripts)) {
120
if (not $opt{subdir} or $opt{subdir} eq $subdir) {
122
and print STDERR "$PROG: Calling sync_role for $full_role, @role\n";
123
# @role here will have one element, so sync_role will use --delete
124
sync_role($full_role, $subdir, @role)
128
# For all subroles, just do the files.
129
# (If we wanted script subroles to work like files, we'd get rid of this
130
# distinction and simplify the code.)
131
if (not $opt{subdir} or $opt{subdir} eq 'files') {
132
while (@role_parts) {
133
push @role, shift @role_parts;
135
and print STDERR "$PROG: Calling sync_role for $full_role, @role\n";
136
sync_role($full_role, 'files', @role);
140
for my $subdir (qw(files scripts)) {
141
apply_default_perms_to_role($full_role, $subdir)
142
if (not $opt{subdir} or $opt{subdir} eq $subdir);
147
# Make sure the stage directory exists and is mode 0700, to protect files
148
# underneath in transit
150
my $stage = $opt{stage} . "/roles";
151
if (not $opt{'dry-run'}) {
153
($opt{verbose} > 0) and print STDERR "$PROG: Creating '$stage'\n";
154
eval { mkpath($stage); };
155
die "Could not mkpath cache dir '$stage': $@\n" if $@;
157
($opt{verbose} > 0) and print STDERR "$PROG: Checking perms on '$stage'\n";
159
warn "WARNING[$PROG]: Not superuser; unable to chown files\n";
162
or die "Could not chown 0:0 '$stage': $!\n";
165
or die "Could not chmod 0700 '$stage': $!\n";
169
# Copy the files for a role from CACHE to STAGE
170
sub sync_role ($$@) {
171
my ($full_role, $subdir, @role) = @_;
172
my @this_rsync = @rsync;
174
# If we were only given one role part, we're in the base role
175
my $in_base_role = (scalar @role == 1);
177
# For the base role, delete any files that don't exist in the cache.
178
# Not for the subrole (otherwise we'll delete all files not in
179
# the subrole, which may be most of them!)
181
push @this_rsync, "--delete";
185
# (a,b,c) => a/files.b.c
186
my $src_path = $role[0].'/'.join(".", $subdir, @role[1 .. $#role]);
187
# This one's a little simpler:
188
my $dst_path = $full_role.'/'.$subdir;
190
# final / is important for rsync
191
my $source = $opt{cache} . "/roles/" . $src_path . "/";
192
my $destination = $opt{stage} . "/roles/" . $dst_path . "/";
193
if (not -d $destination and -d $source) {
194
($opt{verbose} > 0) and print STDERR "$PROG: Creating '$destination'\n";
195
if (not $opt{'dry-run'}) {
196
eval { mkpath($destination); };
197
die "Could not mkpath stage dir '$destination': $@\n" if $@;
201
# We no longer require the source to exist
202
if (not -d $source) {
203
# but we need to remove the destination if the source
204
# doesn't exist and we're in the base role
206
rmtree($destination);
207
# rmtree() doesn't throw exceptions or give a return value useful
208
# for detecting failure, so we just check after the fact.
209
die "Could not rmtree '$destination' when '$source' missing\n"
212
# if we continue, rsync will fail because source is missing,
217
# All this to run an rsync command
218
my @command = (@this_rsync, $source, $destination);
219
($opt{verbose} > 0) and print STDERR "$PROG: Syncing $src_path with '@command'\n";
221
if ($rsync_pid = fork) {
223
} elsif (defined $rsync_pid) {
225
open(STDIN, "<", "/dev/null")
226
or die "Could not redirect STDIN from /dev/null\n";
227
# This redirection is necessary because rsync sends
228
# verbose output to STDOUT
229
open(STDOUT, ">&STDERR")
230
or die "Could not redirect STDOUT to STDERR\n";
232
die "Could not exec '@command': $!\n";
234
die "Could not fork: $!\n";
236
my $kid = waitpid($rsync_pid, 0);
237
if ($kid != $rsync_pid) {
238
die "waitpid returned $kid\n";
240
Slack::check_system_exit(@command);
244
# This just takes the base role, and chowns/chmods everything under it to
245
# give it some sensible permissions. Basically, the only thing we preserve
246
# about the original permissions is the executable bit, since that's the
247
# only thing source code controls systems like CVS, RCS, Perforce seem to
249
sub apply_default_perms_to_role ($$) {
250
my ($role, $subdir) = @_;
251
my $destination = $opt{stage} . "/roles/" . $role;
254
$destination .= '/' . $subdir;
257
# If the destination doesn't exist, it's probably because the source didn't
258
return if not -d $destination;
260
($opt{verbose} > 0) and print STDERR "$PROG: Setting default perms on $destination\n";
262
warn "WARNING[$PROG]: Not superuser; won't be able to chown files\n";
264
# Use File::Find to recurse the directory
266
# The "wanted" subroutine is called for every directory entry
268
return if $opt{'dry-run'};
269
($opt{verbose} > 2) and print STDERR "$File::Find::name\n";
271
# symlinks shouldn't be in here,
272
# since we dereference when copying
273
warn "WARNING[$PROG]: Skipping symlink at $File::Find::name: $!\n";
275
} elsif (-f _) { # results of last stat saved in the "_"
278
or die "Could not chmod 0555 $File::Find::name: $!";
281
or die "Could not chmod 0444 $File::Find::name: $!";
285
or die "Could not chmod 0755 $File::Find::name: $!";
287
warn "WARNING[$PROG]: Unknown file type at $File::Find::name: $!\n";
289
return if $> != 0; # skip chowning if not superuser
291
or die "Could not chown 0:0 $File::Find::name: $!";
293
# end of wanted function
295
# way down here, we have the directory to traverse with File::Find