bin/fsr

   1 #!/usr/bin/perl
   2 $ID = q$Id: fsr,v 1.8 2004/03/22 06:34:16 eagle Exp $;
   3 #
   4 # fsr -- Recursively apply AFS fs commands.
   5 #
   6 # Written by Carol Oliver
   7 # Portions by Russ Allbery <rra@stanford.edu>
   8 # Inspired by a script written by Larry Schwimmer
   9 # Copyright 1999, 2004 Board of Trustees, Leland Stanford Jr. University
  10 #
  11 # This program is free software; you may redistribute it and/or modify it
  12 # under the same terms as Perl itself.
  13
  14 ##############################################################################
  15 # Site configuration
  16 ##############################################################################
  17
  18 # The full path to fs.  Allow for Linux where the preferred location may be on
  19 # local disk.
  20 ($FS)  = grep { -x $_ } qw(/usr/bin/fs /usr/afsws/bin/fs /usr/pubsw/bin/fs);
  21 $FS ||= '/usr/afsws/bin/fs';
  22
  23 ##############################################################################
  24 # Modules and declarations
  25 ##############################################################################
  26
  27 require 5.003;
  28
  29 use strict;
  30 use vars qw($CROSSMOUNTS $FS $ID $NOMOUNTS $VERBOSE);
  31
  32 use File::Find qw(find);
  33 use Getopt::Long qw(GetOptions);
  34
  35 ##############################################################################
  36 # Command-line parsing
  37 ##############################################################################
  38
  39 # Given an fs subcommand and its arguments, parse it into three lists.  The
  40 # first list contains all of the arguments, including the subcommand, to pass
  41 # fs before a directory name.  The second list contains all of the directories
  42 # the command should be applied to.  The third list contains everything after
  43 # the directory name.
  44 sub parse_fs_command {
  45     my (@args) = @_;
  46     my $command = shift @args;
  47
  48     # fs commands can either take their arguments in a particular order or can
  49     # have them flagged with a particular option.  We use this table to encode
  50     # information about how to parse each fs command.
  51     #
  52     # The first value in this table says whether there are positional
  53     # arguments before the files we'll recurse on.  The second value says
  54     # whether the files we'll recurse on are the last positional arguments
  55     # (and we can suck up everything to the end of the arguments unless
  56     # there's a flag).  The third value gives the option letter for the option
  57     # that takes a list of directories.
  58     my %commands = (cleanacl  => [undef, 'yes', 'p'],
  59                     copyacl   => ['yes', 'yes', 't'],
  60                     ca        => ['yes', 'yes', 't'],
  61                     listacl   => [undef, 'yes', 'p'],
  62                     la        => [undef, 'yes', 'p'],
  63                     listquota => [undef, 'yes', 'p'],
  64                     lq        => [undef, 'yes', 'p'],
  65                     lsmount   => [undef, 'yes', 'd'],
  66                     setacl    => [undef, undef, 'd'],
  67                     sa        => [undef, undef, 'd'],
  68                     setquota  => [undef, undef, 'p'],
  69                     sq        => [undef, undef, 'p'],
  70                     whereis   => [undef, 'yes', 'p']);
  71
  72     # These are fs options for various commands that take arguments.  (There
  73     # are other options that don't take arguments; these are special because
  74     # we have to pull their arguments out of the argument list.)
  75     my %options = map { $_ => 1 } qw(a d f p t);
  76
  77     # Figure out what fs command we're dealing with.
  78     my @fscmds = grep { /^$command/ } keys %commands;
  79     if (@fscmds > 1) {
  80         die "$0: ambiguous fs command $command";
  81     } elsif (!@fscmds) {
  82         die "$0: unknown or unapplicable fs command $command\n";
  83     }
  84     $command = $fscmds[0];
  85     my @props = @{ $commands{$command} };
  86
  87     # First we take a pass through all of our arguments, pulling out anything
  88     # that's an option (and all of the arguments that go with it).  Then, if
  89     # we don't find the list of directories that way, we pull them out of the
  90     # remaining positional arguments which are now simple to parse.
  91     #
  92     # We pull all options out into the prefix (the part that we're going to
  93     # put before the directories) since we can provide them in any order and
  94     # that's easiest.  The non-option arguments go into @tail.
  95     #
  96     # The $seen_from flag is set if we've seen a -fromdir option and the
  97     # command is expecting a -todir option.  This is so that if we see a
  98     # -fromdir option, we won't assume that non-option arguments are the
  99     # fromdir.
 100     #
 101     # The $required flag is set if we need to put the right option flag before
 102     # the directory argument to fs.  $flag holds the command-line flag used to
 103     # introduce a directory.
 104     my (@head, @dirs, @tail, $seen_from, $flag, $required);
 105     while (@args) {
 106         local $_ = shift @args;
 107         if ($_ =~ /^-(.)/) {
 108             my $option = $1;
 109             if ($option eq $props[2]) {
 110                 $flag = $_;
 111                 push (@dirs, shift @args) while (@args && $args[0] !~ /^-/);
 112             } elsif ($options{$option}) {
 113                 push (@head, $_);
 114                 push (@head, shift @args)
 115                     while (@args && $args[0] !~ /^-/);
 116                 if ($props[2] eq 't' && $option eq 'f') {
 117                     $seen_from = 1;
 118                 }
 119                 $required = 1;
 120             } else {
 121                 push (@head, $_);
 122             }
 123         } else {
 124             push (@tail, $_);
 125         }
 126     }
 127     if (@dirs) {
 128         push (@head, $flag);
 129     } else {
 130         push (@head, shift @tail) if ($props[0] && !$seen_from);
 131         push (@head, "-$props[2]") if $required;
 132         if ($props[1]) {
 133             push (@dirs, shift @tail)
 134                 while (@tail && $tail[0] !~ /^-/);
 135         } else {
 136             push (@dirs, shift @tail);
 137         }
 138     }
 139     unshift (@head, $command);
 140     return (\@head, \@dirs, \@tail);
 141 }
 142
 143 ##############################################################################
 144 # AFS probing
 145 ##############################################################################
 146
 147 # Given a path, returns true if it is a mount point.  Fork off fs the hard way
 148 # since we don't care about its output and want to protect against weird
 149 # directory names.
 150 sub ismount {
 151     my ($path) = @_;
 152     my $pid = fork;
 153     if (!defined $pid) {
 154         die "$0: can't fork: $!\n";
 155     } elsif ($pid == 0) {
 156         open (STDOUT, '> /dev/null') or die "$0: can't open /dev/null: $!\n";
 157         open (STDERR, '>&STDOUT') or die "$0: can't dup stdout: $!\n";
 158         exec ($FS, 'lsmount', $path) or die "$0: can't exec $FS: $!\n";
 159     } else {
 160         waitpid ($pid, 0);
 161     }
 162     return ($? == 0);
 163 }
 164
 165 # The function that runs fs on all appropriate directories.  Run from inside
 166 # the invocation of find.  Takes the file to operate on, a reference to an
 167 # array holding the initial part of the fs command, and a reference to an
 168 # array holding the final part of the fs command.
 169 sub run_fs {
 170     my ($path, $head, $tail) = @_;
 171     return if (-l $path || !-d _);
 172     unless ($CROSSMOUNTS) {
 173         if (ismount $path) {
 174             $File::Find::prune = 1;
 175             return;
 176         }
 177     }
 178     print "\nDirectory: $File::Find::name\n" if $VERBOSE;
 179     system ($FS, @$head, $path, @$tail) == 0
 180         or warn "$0: $FS @$head $path @$tail failed\n";
 181 }
 182
 183 ##########################################################################
 184 # Main routine
 185 ##########################################################################
 186
 187 # Get output in the right order.
 188 $| = 1;
 189
 190 # Trim extraneous garbage from the path.
 191 my $fullpath = $0;
 192 $0 =~ s%.*/%%;
 193
 194 # Parse command line options.
 195 my ($help, $nomounts, $version);
 196 Getopt::Long::config ('bundling', 'no_ignore_case', 'require_order');
 197 GetOptions ('help|h'         => \$help,
 198             'no-mounts|M'    => \$nomounts,
 199             'cross-mounts|m' => \$CROSSMOUNTS,
 200             'verbose|V'      => \$VERBOSE,
 201             'version|v'      => \$version) or exit 1;
 202 if ($help) {
 203     print "Feeding myself to perldoc, please wait....\n";
 204     exec ('perldoc', '-t', $0) or die "Cannot fork: $!\n";
 205 } elsif ($version) {
 206     my $version = join (' ', (split (' ', $ID))[1..3]);
 207     $version =~ s/,v\b//;
 208     $version =~ s/(\S+)$/($1)/;
 209     $version =~ tr%/%-%;
 210     print $version, "\n";
 211     exit 0;
 212 }
 213 die "Usage: $0 [-hMmVv] <fs-command> [<fs-options>]\n" unless @ARGV;
 214
 215 # @ARGV now contains the fs command and its options.  We need to parse it out
 216 # into three lists.  The first contains the fs subcommand and any options that
 217 # should occur before the directory, the second contains the set of
 218 # directories to operate on, and the third contains all the options that
 219 # should occur after the directory.
 220 my ($head, $dirs, $tail) = parse_fs_command (@ARGV);
 221
 222 # If -M was used, we need to filter out any mount points or non-directories
 223 # from the set of directories provided.
 224 if ($nomounts) {
 225     @$dirs = grep { !-l $_ && -d _ && !ismount ($_) } @$dirs;
 226 }
 227 die "$0: no directories to process\n" unless @$dirs;
 228
 229 # Now, do the actual work.  Run find on each of the provided directories,
 230 # passing in to the function the head and tail of the fs command.
 231 $File::Find::dont_use_nlink = 1;
 232 find (sub { run_fs ($_, $head, $tail) }, @$dirs);
 233 exit 0;
 234 __END__
 235
 236 ##############################################################################
 237 # Documentation
 238 ##############################################################################
 239
 240 =head1 NAME
 241
 242 fsr - Recursively apply AFS fs commands
 243
 244 =head1 SYNOPSIS
 245
 246 fsr [B<-hMmVv>] I<fs-command> I<fs-options>
 247
 248 =head1 DESCRIPTION
 249
 250 B<fsr> wraps the basic AFS B<fs> command to make it recursive.  It only
 251 works with the B<fs> subcommands that act on directories, namely
 252 C<cleanacl>, C<copyacl>, C<listacl>, C<listquota>, C<lsmount>, C<setacl>,
 253 C<setquota>, and C<whereis>.  All aliases for those commands are also
 254 supported.
 255
 256 To apply an B<fs> command recursively, just run B<fsr> instead of B<fs>,
 257 leaving all of the other options and command ordering the same.  To use any
 258 of the options specific to B<fsr>, give them immediately after C<fsr> on the
 259 command line and before the B<fs> subcommand.
 260
 261 Note that for C<copyacl>, only the target directory will be recursive.  In
 262 other words, B<fsr> will let you copy the ACLs from a single directory to
 263 every directory in a target tree, but won't let you copy ACLs from one
 264 directory hierarchy to another matching hierarchy.
 265
 266 Run C<fs help> for more usage information for B<fs>.
 267
 268 =head1 OPTIONS
 269
 270 =over 4
 271
 272 =item B<-h>, B<--help>
 273
 274 Print out this documentation (which is done simply by feeding the script to
 275 C<perldoc -t>) and then exit.
 276
 277 =item B<-m>, B<--cross-mounts>
 278
 279 Enable crossing of mountpoints.  Be very careful with this option, since
 280 when using it, B<fsr> will happily recurse into arbitrarily deep file
 281 systems.  No check is made for whether a given volume had already been
 282 visited, so recursive volume structures will cause B<fsr> to descend
 283 indefinitely deep.  Only use this option if you know the structure of the
 284 directory tree you're using it on.
 285
 286 =item B<-M>, B<--no-mounts>
 287
 288 Normally, B<fsr> will recurse into all directories specified on the command
 289 line, regardless of whether those directories are mount points or not.  Only
 290 mount points underneath those directories won't be crossed (in the absence
 291 of the B<-m> option).  With this option, any directories specified on the
 292 command line that are actually mount points will also be skipped.
 293
 294 =item B<-V>, B<--verbose>
 295
 296 Print out each directory that B<fsr> acts on as it does so.
 297
 298 =item B<-v>, B<--version>
 299
 300 Print the version of B<fsr> and exit.
 301
 302 =back
 303
 304 =head1 EXAMPLES
 305
 306 Give person1 all AFS permissions (rlidwka) on the group directory F<mygroup>
 307 and removes all AFS permissions to that directory for person2:
 308
 309     fsr sa /afs/ir/group/mygroup person1 all person2 none
 310
 311 Gives personX AFS read permissions (rl) recursively to the directories
 312 beginning with C<cs> in the current working directory, except for any
 313 subdirectories that are actually mount points:
 314
 315     fsr sa -dir cs* -acl personX read
 316
 317 Same as above, but recursively descends across mountpoints (be very careful
 318 with this):
 319
 320     fsr -m sa -dir cs* -acl personX read
 321
 322 Gives personX AFS read permissions to all directories in the current
 323 directory and recursively to non-mount-point directories below them, but
 324 skipping any directories in the current directory that are actually mount
 325 points:
 326
 327     fsr -M sa -dir * -acl personX read
 328
 329 =head1 NOTES
 330
 331 B<fsr> ignores symlinks.
 332
 333 =head1 SEE ALSO
 334
 335 fs(1)
 336
 337 The current version of this program is available from its web page at
 338 L<http://www.eyrie.org/~eagle/software/fsr/>.
 339
 340 =head1 AUTHORS
 341
 342 Written by Russ Allbery <rra@stanford.edu> and Carol Oliver.  Inspired by a
 343 script written by Larry Schwimmer.
 344
 345 =head1 COPYRIGHT AND LICENSE
 346
 347 Copyright 1999, 2004 Board of Trustees, Leland Stanford Jr. University.
 348
 349 This program is free software; you may redistribute it and/or modify it
 350 under the same terms as Perl itself.
 351
 352 =cut