contrib/shell_utils/cleanappledouble.pl.in

   1 #!@PERL@
   2 #
   3 # $Id: cleanappledouble.pl.in,v 1.1 2002-01-17 05:59:25 srittau Exp $
   4 #
   5 # cleanappledouble.pl
   6 # Copyright (C) 2001 Heath Kehoe <hakehoe@avalon.net>
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License
  10 # as published by the Free Software Foundation; either version 2
  11 # of the License, or (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program; if not, write to the Free Software
  20 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21 #
  22
  23 require 5;
  24 use Getopt::Std;
  25
  26 sub usage {
  27     print STDERR <<EOF;
  28 Usage: $0 [-r] [-v] directory [directory ...]
  29
  30 Scans each directory and:
  31  1) removes orphaned .AppleDouble files (from <directory>/.AppleDouble)
  32  2) fixes permissions on .AppleDouble files to match corresponding data file (minus x bits)
  33  3) fixes owner/group of .AppleDouble files to match corresponding data file (root only)
  34
  35 Options:
  36   -r   Recursively check all subdirectories of each directory
  37   -R   Like -r but follows symbolic links to directories (warning: no loop-checking is done)
  38   -p   Preview: no deletions or changes are actually made
  39   -v   Verbose
  40 EOF
  41     exit 1;
  42 }
  43
  44 $isroot = ($> == 0);
  45
  46 sub S_ISDIR {
  47     my($mode) = @_;
  48     return (($mode & 0170000) == 0040000);
  49 }
  50 sub S_ISREG {
  51     my($mode) = @_;
  52     return (($mode & 0170000) == 0100000);
  53 }
  54 sub S_ISLNK {
  55     my($mode) = @_;
  56     return (($mode & 0170000) == 0120000);
  57 }
  58
  59
  60 sub do_dir {
  61     my($dir) = @_;
  62     my($f, $havead, @dirlist, $mode, $uid, $gid, $fn);
  63     my(%dm, %du, %dg);
  64
  65     print STDERR "Scanning $dir ...\n" if($opt_v);
  66
  67     $havead = -d "$dir/.AppleDouble";
  68
  69     # there's nothing more to do if we're not recursive and there's no .AppleDouble
  70     return if(!$havead && !$opt_r);
  71
  72     opendir DIR, $dir   or do {
  73                 warn "Can't opendir $dir: $!\n";
  74                 return;
  75     };
  76     while(defined($f = readdir DIR)) {
  77         next if($f eq ".");
  78         next if($f eq "..");
  79         next if($f eq ".AppleDouble");
  80         next if($f eq ".AppleDesktop");
  81
  82         (undef, undef, $mode, undef, $uid, $gid) = lstat "$dir/$f";
  83         next if(!defined($mode));
  84
  85         if(S_ISLNK($mode)) {
  86             (undef, undef, $mode, undef, $uid, $gid) = stat "$dir/$f";
  87             next if(!defined($mode));
  88             next if(S_ISDIR($mode) && !$opt_R);
  89         }
  90         if(S_ISDIR($mode)) {
  91             push @dirlist, $f if($opt_r);
  92         } elsif(S_ISREG($mode)) {
  93             if($havead) {
  94                 $dm{$f} = $mode & 0666;
  95                 $du{$f} = $uid;
  96                 $dg{$f} = $gid;
  97             }
  98         } else {
  99             warn "Ignoring special file: $dir/$f\n";
 100         }
 101     }
 102     closedir DIR;
 103
 104     if($havead) {
 105         if(opendir DIR, "$dir/.AppleDouble") {
 106             while(defined($f = readdir DIR)) {
 107                 next if($f eq ".");
 108                 next if($f eq "..");
 109                 next if($f eq ".Parent");
 110
 111                 $fn = "$dir/.AppleDouble/$f";
 112                 (undef, undef, $mode, undef, $uid, $gid) = stat $fn;
 113                 next if(!defined($mode));
 114
 115                 if(S_ISDIR($mode)) {
 116                     warn "Found subdirectory $f in $dir/.AppleDouble\n";
 117                     next;
 118                 }
 119                 unless(exists $dm{$f}) {
 120                     print STDERR "Deleting $fn ...\n" if($opt_v);
 121                     if($opt_p) {
 122                         print "rm '$fn'\n";
 123                     } else {
 124                         unlink "$fn" or warn "Can't unlink $fn: $!\n";
 125                     }
 126                     next;
 127                 }
 128                 $mode = $mode & 07777;
 129                 if($mode != $dm{$f}) {
 130                     printf STDERR "Changing permissions from %o to %o on $fn\n", $mode, $dm{$f} if($opt_v);
 131                     if($opt_p) {
 132                         printf "chmod %o '$fn'\n", $dm{$f};
 133                     } else {
 134                         chmod $dm{$f}, $fn or warn "Can't chmod $fn: $!\n";
 135                     }
 136                 }
 137                 if($isroot && ($uid != $du{$f} || $gid != $dg{$f})) {
 138                     print STDERR "Changing owner from $uid:$gid to $du{$f}:$dg{$f} on $fn\n" if($opt_v);
 139                     if($opt_p) {
 140                         print "chown $du{$f}:$dg{$f} '$fn'\n";
 141                     } else {
 142                         chown $du{$f}, $dg{$f}, $fn or warn "Can't chown $fn: $!\n";
 143                     }
 144                 }
 145             }
 146             closedir DIR;
 147         } else {
 148             warn "Can't opendir $dir/.AppleDouble: $!\n";
 149         }
 150     }
 151
 152     if($opt_r) {
 153         foreach $f ( @dirlist ) {
 154             do_dir("$dir/$f");
 155         }
 156     }
 157 }
 158
 159 usage unless(getopts 'prRv');
 160 usage if(@ARGV == 0);
 161
 162 if($opt_R) {
 163     $opt_r = 1;
 164 }
 165
 166 foreach $d ( @ARGV ) {
 167     do_dir $d;
 168 }
 169