src/packaging/MacOS/Uninstall.14.15

   1 #!/usr/bin/perl -w
   2 # real Perl code begins here
   3 #
   4 # Adapted from Apple's uninstall-devtools.pl (Version 7 for Xcode Tools 1.2)
   5 #
   6 # BSD License: c.f. <http://www.opensource.org/licenses/bsd-license>
   7 #
   8
   9 use strict;
  10 use warnings;
  11 use File::Basename;
  12
  13 use vars qw ($do_nothing $print_donothing_removals $receipts_dir $verbose $noisy_warnings);
  14 use vars qw ($suppress_spin $spin_counter $spin_state $spin_slower_downer);
  15 use vars qw (%exception_list $gen_dirs @gen_files @rmfiles @rmdirs @rmpkg);
  16
  17 #----------------------------------------------------------------------------------------
  18
  19 $do_nothing = 0;
  20 $print_donothing_removals = 1;
  21 $verbose = 1;
  22 $noisy_warnings = 0;
  23
  24 # One of rm -rf in this script uses $receipts_dir -- change with care.
  25 $receipts_dir = "/Library/Receipts";
  26
  27 %exception_list = (
  28 );
  29
  30 $gen_dirs = { };
  31
  32 @gen_files = (
  33     "/var/db/openafs/etc/cacheinfo",
  34     "/var/db/openafs/etc/ThisCell",
  35     "/var/db/openafs/etc/config/afsd.options",
  36     "/var/db/openafs/etc/config/afs.conf",
  37     "/var/db/openafs/etc/CellServDB.save",
  38     "/var/db/openafs/etc/CellServDB.master.last",
  39     "/var/db/openafs/etc/CellServDB",
  40     "/var/db/openafs/etc/config/settings.plist",
  41 );
  42
  43 #----------------------------------------------------------------------------------------
  44
  45 $| = 1;
  46
  47 sub main {
  48     # commandline args:
  49     #     0: dir of packages to remove
  50     #     1: flag indicating whether to keep package receipts
  51     #     2: flag indicating whether to supress spin indicator
  52
  53     if (!@ARGV) {
  54         use FindBin qw($Bin);
  55         @ARGV = ("$Bin/..", 0, 0);
  56     }
  57     $suppress_spin = defined ($ARGV[2]) && $ARGV[2];
  58
  59     $spin_counter = 0;
  60     $spin_state = 0;
  61     spin_rate_slow ();
  62
  63     pre_print ();
  64     print "Uninstalling OpenAFS package:\n\n";
  65
  66     remove_generated_files ();
  67     remove_main_packages ();
  68     remove_generated_directories ();
  69
  70     if ($do_nothing == 0) {
  71         # When osascript runs some shell commands, newlines are printed as just
  72         # \r instead of \n for some reason, so anything output kinda overwrites
  73         # earlier output. The final 'tr' in the pipeline here turns them back
  74         # into \n newlines. pkgutil --forget at least will print output like
  75         # "Forgot package 'foo'".
  76         my $rmcmd = "osascript -e 'do shell script \"/bin/rm -f @rmfiles; " .
  77                     "/bin/rmdir @rmdirs; echo @rmpkg | xargs -n 1 " .
  78                     "/usr/sbin/pkgutil --forget\" with administrator " .
  79                     "privileges' | tr '\\r' '\\n'";
  80         system $rmcmd;
  81         my $retcode = $? >> 8;
  82         if ($retcode != 0) {
  83             print_warning ("Warning:  There may have been a problem uninstalling\n");
  84         }
  85     }
  86
  87     pre_print ();
  88     print "\nFinished uninstalling.\n";
  89 }
  90
  91 sub remove_main_packages {
  92      my @pkglist = ("org.openafs.OpenAFS-debug.pkg",
  93                     "org.openafs.OpenAFS.pkg",
  94                     );
  95
  96     foreach (@pkglist) {
  97         s/\.pkg$//;
  98         my $pkgname = $_;
  99         my $pkg = $pkgname.".pkg";
 100         my $bomroot;
 101
 102         if (not open(INFO, '-|', "/usr/sbin/pkgutil --pkg-info $pkg | " .
 103                                  "grep ^volume: | cut -d' ' -f2-")) {
 104             print_warning("Warning: Could not get pkg info for $pkg " .
 105                           "(maybe it's not installed?)\n");
 106             next;
 107         }
 108
 109         $bomroot = <INFO>;
 110         if ((not close(INFO)) or (!defined($bomroot))) {
 111             print_warning("Warning: Could not get pkg info for $pkg " .
 112                           "(maybe it's not installed?)\n");
 113             next;
 114         }
 115
 116         chomp $bomroot;
 117
 118         pre_print();
 119         print "\nFound pkg install root $bomroot for $pkg\n";
 120
 121         spin_rate_slow ();
 122
 123         if (not open (LSBOM, '-|', "/usr/sbin/pkgutil --only-files --files $pkg")) {
 124             print_warning("Warning: Error running pkgutil --only-files --files $pkg\n");
 125             next;
 126         }
 127
 128         while (<LSBOM>) {
 129             chomp;
 130             m#^(.*/.*)$#;
 131             next if (!defined ($1) || $1 eq "");
 132             my $filename = $bomroot . $1;
 133
 134             remove_a_file ($filename);
 135         }
 136         close (LSBOM);
 137
 138         my $rooth = { };
 139
 140         if (not open (LSBOM, '-|', "/usr/sbin/pkgutil --only-dirs --files $pkg")) {
 141             print_warning("Warning: Error running pkgutil --only-dirs --files $pkg\n");
 142             next;
 143         }
 144
 145         while (<LSBOM>) {
 146             chomp;
 147             m#^(.*/.*)$#;
 148             next if (!defined ($1) || $1 eq "");
 149             my $directory = $bomroot . $1;
 150             if (-d $directory) {
 151                 $rooth = add_directory_to_tree ($directory, $rooth);
 152             } else {
 153                 if ($noisy_warnings) {
 154                     print_warning ("Warning: \"$directory\" listed in BOM " .
 155                                    "but not present on system.\n");
 156                 }
 157             }
 158         }
 159         close (LSBOM);
 160
 161         spin_rate_fast ();
 162         remove_empty_directories ($rooth, $bomroot);
 163
 164         remove_package_receipts($pkg) if (!defined ($ARGV[1]) || !$ARGV[1]);
 165     }
 166 }
 167
 168 sub remove_generated_files {
 169     foreach (@gen_files) {
 170         remove_a_file ($_);
 171     }
 172 }
 173
 174 sub remove_generated_directories {
 175     remove_empty_directories ($gen_dirs, "/");
 176 }
 177
 178 sub add_directory_to_tree {
 179     my $dir = shift;
 180     my $rooth = shift;
 181     my $p = $rooth;
 182
 183     my @pathcomp = split /\//, $dir;
 184
 185     progress_point ();
 186     foreach (@pathcomp) {
 187         my $cur_name = $_;
 188         if ($cur_name eq "" || !defined ($cur_name)) {
 189             $cur_name = "/";
 190         }
 191         if (!defined ($p->{"$cur_name"})) {
 192             $p->{$cur_name} = { };
 193         }
 194         $p = $p->{$cur_name};
 195     }
 196     return $rooth;
 197 }
 198
 199 sub remove_empty_directories {
 200     my $rooth = shift;
 201     my $path = shift;
 202     my $children = (scalar (keys %{$rooth}));
 203     my $dirs_remain = 0;
 204
 205     if ($children > 0) {
 206         foreach my $dirname (sort keys %{$rooth}) {
 207             my $printpath;
 208             $printpath = "$path/$dirname";
 209             $printpath =~ s#^/*#/#;
 210             remove_empty_directories ($rooth->{$dirname}, "$printpath");
 211             $dirs_remain = 1 if (-d "$printpath");
 212         }
 213     }
 214
 215     if ($dirs_remain == 0) {
 216         maybe_remove_ds_store ("$path");
 217     }
 218
 219     remove_a_dir ("$path");
 220 }
 221
 222 sub remove_a_file {
 223     my $fn = shift;
 224     my $dirname = dirname ($fn);
 225     my $basename = basename ($fn);
 226     my $ufs_rsrc_file = "$dirname/._$basename";
 227
 228     progress_point ();
 229     return if (!defined ($fn) || $fn eq "");
 230
 231     # Leave any files that are shared between packages alone.
 232     if (defined($exception_list{$fn})) {
 233         if ($noisy_warnings) {
 234             print_warning ("Warning: file \"$fn\" intentionally not removed, " .
 235                            "even though it's in the BOM.\n");
 236         }
 237         return;
 238     }
 239
 240     if (! -f $fn && ! -l $fn) {
 241         if ($noisy_warnings) {
 242             print_warning ("Warning: file \"$fn\" present in BOM but not found on disc.\n");
 243         }
 244         return;
 245     }
 246
 247     if ($do_nothing == 1) {
 248         print_donothing ("rm $fn\n");
 249         print_donothing ("rm $ufs_rsrc_file\n") if ( -f $ufs_rsrc_file);
 250     } else {
 251         unshift(@rmfiles, "$fn");
 252         unshift(@rmfiles, "$ufs_rsrc_file") if ( -f $ufs_rsrc_file);
 253     }
 254 }
 255
 256 sub remove_a_dir {
 257     my $dir = shift;
 258
 259     progress_point ();
 260     return if (!defined ($dir) || $dir eq "" || $dir eq "/" || $dir eq "/usr");
 261     if (! -d $dir) {
 262         if ($noisy_warnings) {
 263             print_warning ("Warning: directory \"$dir\" present in BOM " .
 264                            "but not found on disc.\n");
 265         }
 266         return;
 267     }
 268
 269     if ($do_nothing == 1) {
 270         print_donothing ("rmdir $dir\n");
 271     } else {
 272         push(@rmdirs, "$dir");
 273     }
 274 }
 275
 276 sub remove_package_receipts {
 277     my $pkgname = shift;
 278     $pkgname =~ s#/##g;  # There shouldn't be any path seps in the pkg name...
 279     return if (!defined ($pkgname) || $pkgname eq ""
 280                || $pkgname eq "." || $pkgname eq "..");
 281
 282     if ($do_nothing == 1) {
 283         print_donothing("pkgutil --forget $pkgname\n");
 284     } else {
 285         push(@rmpkg, $pkgname);
 286     }
 287 }
 288
 289 sub maybe_remove_ds_store {
 290     my $path = shift;
 291     my $filecount = 0;
 292     return if (!defined ($path) || $path eq "" || $path eq "/" || $path eq "/usr");
 293     return if (! -f "$path/.DS_Store");
 294
 295     open (LS, "/bin/ls -a '$path' |");
 296     while (<LS>) {
 297         chomp;
 298         next if (m#^\.$# || m#^\.\.$#);
 299         $filecount++;
 300     }
 301     close (LS);
 302
 303     if ($filecount == 1) {
 304         remove_a_file ("$path/.DS_Store");
 305     }
 306 }
 307
 308 sub print_donothing {
 309     my $msg = shift;
 310     return if ($print_donothing_removals != 1);
 311     pre_print ();
 312     print $msg;
 313 }
 314
 315 sub print_verbose {
 316     my $msg = shift;
 317     return if ($verbose != 1);
 318     pre_print ();
 319     print $msg;
 320 }
 321
 322 sub print_warning {
 323     my $msg = shift;
 324     pre_print ();
 325     print STDERR $msg;
 326 }
 327
 328 sub print_error {
 329     my $msg = shift;
 330     pre_print ();
 331     print STDERR $msg;
 332 }
 333
 334 sub pre_print {
 335     print " \b" unless ($suppress_spin);
 336 }
 337
 338 sub spin_rate_slow {
 339     $spin_slower_downer = 150;
 340 }
 341
 342 sub spin_rate_fast {
 343     $spin_slower_downer = 75;
 344 }
 345
 346 sub progress_point {
 347     return if ($suppress_spin);
 348     $spin_counter++;
 349     if (($spin_counter % $spin_slower_downer) == 0) {
 350         my $spin_chars = "|/-\\";
 351         my $c = substr ($spin_chars, $spin_state % 4, 1);
 352         $spin_state++;
 353         print "\e[7m$c\e[m\b";
 354     }
 355 }
 356
 357 main ();