~ubuntu-branches/ubuntu/hardy/slack/hardy-proposed

« back to all changes in this revision

Viewing changes to src/slack-stage

  • Committer: Bazaar Package Importer
  • Author(s): Andrew Pollock
  • Date: 2007-10-27 16:14:42 UTC
  • Revision ID: james.westby@ubuntu.com-20071027161442-z3wjuy3juutuxu7m
Tags: upstream-0.14.1
ImportĀ upstreamĀ versionĀ 0.14.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#!/usr/bin/perl -w
 
2
# $Id: slack-stage,v 1.8 2006/09/25 18:35:17 alan Exp $
 
3
# vim:sw=2
 
4
# vim600:fdm=marker
 
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.
 
8
#
 
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
 
12
 
 
13
require 5.006;
 
14
use warnings FATAL => qw(all);
 
15
use strict;
 
16
use sigtrap qw(die untrapped normal-signals
 
17
               stack-trace any error-signals);
 
18
 
 
19
use File::Path;
 
20
use File::Find;
 
21
 
 
22
use constant LIB_DIR => '/usr/lib/slack';
 
23
use lib LIB_DIR;
 
24
use Slack;
 
25
 
 
26
my @rsync = ('rsync',
 
27
              '--recursive',
 
28
              '--times',
 
29
              '--perms',
 
30
              '--sparse',
 
31
              );
 
32
 
 
33
(my $PROG = $0) =~ s#.*/##;
 
34
 
 
35
sub check_stage ();
 
36
sub sync_role ($$@);
 
37
sub apply_default_perms_to_role ($$);
 
38
 
 
39
########################################
 
40
# Environment
 
41
# Helpful prefix to die messages
 
42
$SIG{__DIE__} = sub { die "FATAL[$PROG]: @_"; };
 
43
# Set a reasonable umask
 
44
umask 077;
 
45
# Get out of wherever (possibly NFS-mounted) we were
 
46
chdir("/")
 
47
  or die "Could not chdir /: $!";
 
48
# Autoflush on STDERR
 
49
select((select(STDERR), $|=1)[0]);
 
50
 
 
51
########################################
 
52
# Config and option parsing {{{
 
53
my $usage = Slack::default_usage("$PROG [options] <role> [<role>...]");
 
54
$usage .= <<EOF;
 
55
 
 
56
  --subdir DIR
 
57
      Sync this subdir only.  Possible values for DIR are 'files' and
 
58
      'scripts'.
 
59
EOF
 
60
# Option defaults
 
61
my %opt = ();
 
62
Slack::get_options(
 
63
  opthash => \%opt,
 
64
  command_line_options => [
 
65
    'subdir=s',
 
66
  ],
 
67
  usage => $usage,
 
68
  required_options => [ qw(cache stage) ],
 
69
);
 
70
 
 
71
# Arguments are required
 
72
die "No roles given!\n\n$usage" unless @ARGV;
 
73
 
 
74
# We only allow certain values for this option
 
75
if ($opt{subdir}) {
 
76
  unless ($opt{subdir} eq 'files' or $opt{subdir} eq 'scripts') {
 
77
    die "--subdir option must be 'files' or 'scripts'\n\n$usage";
 
78
  }
 
79
} else {
 
80
  $opt{subdir} = '';
 
81
}
 
82
 
 
83
# Prepare for backups
 
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 $@;
 
91
    }
 
92
  }
 
93
  push(@rsync, "--backup", "--backup-dir=$opt{'backup-dir'}");
 
94
}
 
95
 
 
96
# Pass options along to rsync
 
97
if ($opt{'dry-run'}) {
 
98
  push @rsync, '--dry-run';
 
99
}
 
100
# Pass options along to rsync
 
101
if ($opt{'verbose'} > 1) {
 
102
  push @rsync, '--verbose';
 
103
}
 
104
# }}}
 
105
 
 
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"
 
113
  my @role = ();
 
114
  # Make sure we've got the right perms before we copy stuff down
 
115
  check_stage();
 
116
 
 
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) {
 
121
      ($opt{verbose} > 1)
 
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)
 
125
    }
 
126
  }
 
127
 
 
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;
 
134
      ($opt{verbose} > 1)
 
135
        and print STDERR "$PROG: Calling sync_role for $full_role, @role\n";
 
136
      sync_role($full_role, 'files', @role);
 
137
    }
 
138
  }
 
139
 
 
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);
 
143
  }
 
144
}
 
145
exit 0;
 
146
 
 
147
# Make sure the stage directory exists and is mode 0700, to protect files
 
148
# underneath in transit
 
149
sub check_stage () {
 
150
  my $stage = $opt{stage} . "/roles";
 
151
  if (not $opt{'dry-run'}) {
 
152
    if (not -d $stage) {
 
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 $@;
 
156
    }
 
157
    ($opt{verbose} > 0) and print STDERR "$PROG: Checking perms on '$stage'\n";
 
158
    if ($> != 0) {
 
159
      warn "WARNING[$PROG]: Not superuser; unable to chown files\n";
 
160
    } else {
 
161
      chown(0, 0, $stage)
 
162
        or die "Could not chown 0:0 '$stage': $!\n";
 
163
    }
 
164
    chmod(0700, $stage)
 
165
      or die "Could not chmod 0700 '$stage': $!\n";
 
166
  }
 
167
}
 
168
 
 
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;
 
173
 
 
174
  # If we were only given one role part, we're in the base role
 
175
  my $in_base_role = (scalar @role == 1);
 
176
 
 
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!)
 
180
  if ($in_base_role) {
 
181
    push @this_rsync, "--delete";
 
182
  }
 
183
 
 
184
  # (a)     => a/files 
 
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;
 
189
 
 
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 $@;
 
198
      }
 
199
  }
 
200
 
 
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
 
205
    if ($in_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"
 
210
        if -e $destination;
 
211
    }
 
212
    # if we continue, rsync will fail because source is missing,
 
213
    # so we don't.
 
214
    return;
 
215
  }
 
216
 
 
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";
 
220
  my ($rsync_pid);
 
221
  if ($rsync_pid = fork) {
 
222
    # Parent
 
223
  } elsif (defined $rsync_pid) {
 
224
    # Child
 
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";
 
231
    exec(@command);
 
232
    die "Could not exec '@command': $!\n";
 
233
  } else {
 
234
    die "Could not fork: $!\n";
 
235
  }
 
236
  my $kid = waitpid($rsync_pid, 0);
 
237
  if ($kid != $rsync_pid) {
 
238
    die "waitpid returned $kid\n";
 
239
  } elsif ($?) {
 
240
    Slack::check_system_exit(@command);
 
241
  }
 
242
}
 
243
 
 
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
 
248
# preserve.
 
249
sub apply_default_perms_to_role ($$) {
 
250
  my ($role, $subdir) = @_;
 
251
  my $destination = $opt{stage} . "/roles/" . $role;
 
252
 
 
253
  if ($subdir) {
 
254
    $destination .= '/' . $subdir;
 
255
  }
 
256
 
 
257
  # If the destination doesn't exist, it's probably because the source didn't
 
258
  return if not -d $destination;
 
259
 
 
260
  ($opt{verbose} > 0) and print STDERR "$PROG: Setting default perms on $destination\n";
 
261
  if ($> != 0) {
 
262
    warn "WARNING[$PROG]: Not superuser; won't be able to chown files\n";
 
263
  }
 
264
  # Use File::Find to recurse the directory
 
265
  find({
 
266
      # The "wanted" subroutine is called for every directory entry
 
267
      wanted => sub {
 
268
        return if $opt{'dry-run'};
 
269
        ($opt{verbose} > 2) and print STDERR "$File::Find::name\n";
 
270
        if (-l) {
 
271
          # symlinks shouldn't be in here,
 
272
          #     since we dereference when copying
 
273
          warn "WARNING[$PROG]: Skipping symlink at $File::Find::name: $!\n";
 
274
          return;
 
275
        } elsif (-f _) { # results of last stat saved in the "_"
 
276
          if (-x _) {
 
277
            chmod 0555, $_
 
278
              or die "Could not chmod 0555 $File::Find::name: $!";
 
279
          } else {
 
280
            chmod 0444, $_
 
281
              or die "Could not chmod 0444 $File::Find::name: $!";
 
282
          }
 
283
        } elsif (-d _) {
 
284
          chmod 0755, $_
 
285
            or die "Could not chmod 0755 $File::Find::name: $!";
 
286
        } else {
 
287
          warn "WARNING[$PROG]: Unknown file type at $File::Find::name: $!\n";
 
288
        }
 
289
        return if $> != 0; # skip chowning if not superuser
 
290
        chown 0, 0, $_
 
291
          or die "Could not chown 0:0 $File::Find::name: $!";
 
292
      },
 
293
      # end of wanted function
 
294
    },
 
295
    # way down here, we have the directory to traverse with File::Find
 
296
    $destination,
 
297
  );
 
298
}