1 #!perl

     2 # Copyright (c) 2001-2009 Nokia Corporation and/or its subsidiary(-ies).

     3 # All rights reserved.

     4 # This component and the accompanying materials are made available

     5 # under the terms of the License "Eclipse Public License v1.0"

     6 # which accompanies this distribution, and is available

     7 # at the URL "http://www.eclipse.org/legal/epl-v10.html".

     8 # 

     9 # Initial Contributors:

    10 # Nokia Corporation - initial contribution.

    11 # 

    12 # Contributors:

    13 # 

    14 # Description:

    15 # 

    16 #

    17 

    18 use strict;

    19 use FindBin;

    20 use lib "$FindBin::Bin";

    21 use Getopt::Long;

    22 use IniData;

    23 use RelData;

    24 use File::Copy;

    25 use File::Path;

    26 use File::Spec;

    27 use File::Basename;

    28 use Cleaner;

    29 use Utils;

    30 use Cwd;

    31 

    32 #

    33 # Globals.

    34 #

    35 

    36 my $verbose = 0;

    37 my $overwrite = 0;

    38 my $dummyRun = 0;

    39 my $descriptionFile;

    40 my $iniData = IniData->New();

    41 my $cleaner; # object that does most of it

    42 my $cleanTo;

    43 my $expunge = 0; # don't leave reldatas lying around

    44 my $reallyClean;

    45 

    46 #

    47 # Main.

    48 #

    49 

    50 ProcessCommandLine();

    51 $cleaner = Cleaner->New($iniData, 0, $verbose, $reallyClean); # 0 = local not remote

    52 ParseDescriptionFile($descriptionFile);

    53 $cleaner->SetCleaningSubroutine(\&CleaningSubroutine);

    54 if (!$expunge) {

    55   $cleaner->SetRevertingSubroutine(\&RevertingSubroutine);

    56 }

    57 $cleaner->Clean();

    58 

    59 

    60 #

    61 # Subs.

    62 #

    63 

    64 sub ProcessCommandLine {

    65   Getopt::Long::Configure ("bundling");

    66   my $help;

    67   GetOptions('h' => \$help, 'd' => \$dummyRun, 'v+' => \$verbose, 'o' => \$overwrite, 'r' => \$reallyClean);

    68 

    69   if ($help) {

    70     Usage(0);

    71   }

    72 

    73   $descriptionFile = shift @ARGV;

    74 

    75   unless ($descriptionFile) {

    76     print "Error: Archive cleaning description file not specified\n";

    77     Usage(1);

    78   }

    79 

    80   unless ($#ARGV == -1) {

    81     print "Error: Invalid number of arguments\n";

    82     Usage(1);

    83   }

    84 

    85   if ($dummyRun and not $verbose) {

    86     $verbose = 1;

    87   }

    88 }

    89 

    90 sub Usage {

    91   my $exitCode = shift;

    92 

    93   Utils::PrintDeathMessage($exitCode, "\nUsage: cleanlocalarch [options] description-file

    94 

    95 options:

    96 

    97 -h  help

    98 -d  dummy run (don't do anything) - assumes -v

    99 -r  really clean (removes corrupt and partially released components)

   100 -v  verbose output (-vv very verbose)

   101 -o  overwrite destination (delete destination then normal copy)

   102 

   103 Please note, if you are in the process of publishing components to the archive

   104 and specify the -r option you may lose partially released components.\n");

   105 

   106 }

   107 

   108 sub ParseDescriptionFile {

   109   if ($dummyRun) { print "Running in dummy mode...\n"; }

   110   if ($verbose) { print "Parsing \"$descriptionFile\"...\n"; }

   111   open (DES, $descriptionFile) or die "Unable to open \"$descriptionFile\" for reading: $!\n";

   112 

   113   while (my $line = <DES>) {

   114     # Remove line feed, white space and comments.

   115     chomp($line);

   116     $line =~ s/^\s*$//;

   117     $line =~ s/#.*//;

   118     if ($line eq '') {

   119       # Nothing left.

   120       next;

   121     }

   122 

   123     my $keyWord;

   124     my @operand;

   125     if ($line =~ /^(\w+)\s+(.*)/) {

   126       $keyWord = $1;

   127       @operand = ();

   128       if ($2) {

   129         @operand = split /\s+/, $2;

   130       }

   131     } else {

   132       $keyWord = $line;

   133     }

   134 

   135     unless (defined $keyWord) {

   136       die "Error: Invalid line in \"$descriptionFile\":\n$line\n";

   137       next;

   138     }

   139 

   140     if ($cleaner->ProcessDescriptionLine($descriptionFile, $keyWord, @operand)) {

   141       # We're happy because Cleaner.pm knows what to do with this line

   142     } elsif ($keyWord =~ /^clean_to$/) {

   143       unless ($#operand == 0) {

   144         die "Error: Incorrect number of arguments to \'$keyWord\' keyword in \"$descriptionFile\"\nSyntax: clean_to <path>\n";

   145       }

   146       if ($cleanTo) {

   147         die "Error: \'$keyWord\' keyword specifed more than once in \"$descriptionFile\"\n";

   148       }

   149       $cleanTo = $operand[0];

   150     } elsif ($keyWord =~ /^delete$/) {

   151       if (@operand) {

   152         die "Error: Incorrect number of arguments to \'$keyWord\' keyword in \"$descriptionFile\"\nSyntax: delete\n";

   153       }

   154     } elsif ($keyWord =~ /^expunge$/) {

   155       $expunge = 1;

   156       $cleaner->{expunge_already_cleaned} = 1;

   157     } elsif ($keyWord =~ /^no_prompt$/) {

   158       print "Warning: currently, CleanLocalArch does not prompt. 'no_prompt' keyword is redundant.\n";

   159     } else {

   160       die "Error: Unknown keyword \'$keyWord\' in \"$descriptionFile\"\n";

   161     }

   162   }

   163 

   164   close (DES);

   165 

   166   unless ($cleanTo || $expunge) {

   167     die "Error: \"Clean to\" path not specified in \"$descriptionFile\"\n";

   168   }

   169   if ($cleanTo && $expunge) {

   170     die "Error: can't specify both \"clean_to\" and \"expunge\" in \"$descriptionFile\"\n";

   171   }

   172 

   173   if ($verbose > 1) {

   174     $cleaner->PrintEnvsToKeep();

   175   }

   176 }

   177 

   178 sub CleaningSubroutine {

   179   # This actually gets run by Cleaner.pm (it's a callback)

   180   my $thisComp = shift;

   181   my $thisVer = shift;

   182   my $relDir = shift;

   183   if ($expunge) {

   184     print "Expunging $thisComp $thisVer from $relDir...\n" if ($verbose);

   185     return DeleteComp($relDir);

   186   }

   187   print "Archiving $thisComp $thisVer from $relDir to $cleanTo...\n" if ($verbose);

   188   my $cleanDir = "$cleanTo\\$thisComp\\$thisVer";

   189   

   190   if (CopyComp($relDir, $cleanDir)) {

   191     print "Wiping $thisComp $thisVer from $relDir...\n" if ($verbose);

   192     if (DeleteComp("$relDir")) {

   193       # Check if the remaining dir is empty

   194       my ($parent, $file, $ext) = Utils::SplitFileName($relDir);

   195       return DeleteCompIfEmpty($parent);

   196     }

   197     else {

   198       # Call the reverting subroutine here because cleaner.pm will only revert clean components

   199       RevertingSubroutine($thisComp, $thisVer, $relDir);

   200     }

   201   }

   202   

   203   return 0;

   204 }

   205 

   206 sub RevertingSubroutine {

   207   # Again, this gets run by Cleaner.pm

   208   my $thisComp = shift;

   209   my $thisVer = shift;

   210   my $relDir = shift;

   211   

   212   print "Restoring $thisComp $thisVer to $relDir...\n" if ($verbose);

   213   

   214   # create the reldir if required

   215   if(!-d $relDir) {

   216     Utils::MakeDir($relDir);

   217   }

   218   

   219   my $fullCleanToPath = File::Spec->catdir($cleanTo, $thisComp, $thisVer);

   220   

   221   my $dirContents = Utils::ReadDir($fullCleanToPath);

   222   foreach my $thisFile (@$dirContents) {

   223      copy(File::Spec->catdir($fullCleanToPath, $thisFile), $relDir);

   224   }  

   225 

   226   print "Removing copy of $thisComp $thisVer from $cleanTo...\n" if ($verbose);

   227   if (DeleteComp("$cleanTo\\$thisComp\\$thisVer")) {

   228     # Check if the remaining dir is empty

   229     return DeleteCompIfEmpty("$cleanTo\\$thisComp");

   230   }

   231   else {

   232     # Failed to even delete component

   233     return 0;

   234   }

   235 }

   236 

   237 sub CopyComp {

   238   my $dir = shift;

   239   my $destDir = shift;

   240 

   241   if (-e $destDir) {

   242     if ($overwrite) {

   243       if ($verbose > 0) { print "Overwriting by deleting \"$destDir\"\n"; }

   244       DeleteComp("$destDir");

   245     }

   246     else {

   247       print "Error: Can't copy \"$dir\" to \"$destDir\" because directory \"$destDir\" already exists\n";

   248       return 0;

   249     }

   250   }

   251 

   252   my $failed = 0;

   253   my @copied;

   254   eval {

   255     Utils::MakeDir($destDir) unless $dummyRun;

   256   };

   257   if ($@) {

   258     print "$@";

   259     $failed = 1;

   260   }

   261 

   262   if($failed==0) {

   263     my $dirContents = Utils::ReadDir($dir);

   264     foreach my $thisFile (@$dirContents) {

   265       if ($verbose > 1) { print "\tCopying \"$dir\\$thisFile\" to \"$destDir\"...\n"; }

   266       if ($dummyRun) {

   267         return 1;

   268       }

   269       else {

   270         if (copy($dir."\\".$thisFile, $destDir)) {

   271           push @copied, $thisFile;

   272         }

   273         else {

   274           print "Error: Couldn't copy \"$dir\\$thisFile\" to \"$destDir\": $!\n";

   275           $failed = 1;

   276           if (-f $destDir."\\".$thisFile) {

   277             # Must've part-copied this file

   278             push @copied, $thisFile;

   279           }

   280           last;

   281         }

   282       }

   283     }

   284   }

   285 

   286   if ($failed) {

   287     # Revert copied files

   288     foreach my $thisFile (@copied) {

   289       unlink $destDir."\\".$thisFile or print "Error: Couldn't delete $destDir\\$thisFile when cleaning up\n";

   290     }

   291     DeleteCompIfEmpty($destDir) or print "Error: Couldn't clean up empty directory $destDir\n";

   292   }

   293 

   294   return ($failed == 0);

   295 }

   296 

   297 sub DeleteComp {

   298   my $dir = shift;

   299 

   300   if (!$dummyRun) {

   301     local $SIG{__WARN__} = sub {my $line = shift;

   302                                 $line =~ s/ at .*$//;

   303                                 print "Error: $line\n";};

   304     

   305     my $reldataFile = File::Spec->catdir($dir, 'reldata');

   306 

   307     my $origDir = cwd();

   308     chdir(dirname($dir));

   309     

   310     if (-e $reldataFile) {

   311       # Delete the reldata file first, if something goes wrong other tools will identify the archived component

   312       # as corrupt by the absence of reldata

   313       if (!unlink $reldataFile) {

   314         print "Error: Couldn't delete \"$reldataFile\"\n";

   315         return 0;

   316       }

   317     }

   318     

   319     if (!rmtree($dir, 0, 0) or -d $dir) {

   320       print "Error: Couldn't delete \"$dir\"\n";

   321       return 0;

   322     }

   323     else {

   324       chdir($origDir);

   325       return 1;

   326     }

   327   }

   328   else {

   329     return 1;

   330   }

   331 }

   332 

   333 sub DeleteCompIfEmpty {

   334   my $dir = shift;

   335 

   336   if (!$dummyRun) {

   337     if (opendir(DIR, $dir)) {

   338       my @files = grep( !/\.\.?$/, readdir DIR);

   339       if (!closedir(DIR)) {

   340         die "Error: Couldn't close '$dir' after reading. Aborting\n";

   341       }

   342       if (scalar(@files) == 0) {

   343         print "Tidying $dir...\n" if ($verbose);

   344         return DeleteComp("$dir");

   345 

   346       }

   347       else {

   348         return 1; # Nothing to do

   349       }

   350     }

   351     else {

   352       print "Warning: Couldn't open '$dir' directory for reading. An empty directory may have been left behind.\n";

   353       return 1; # Warning only

   354     }

   355   }

   356   else {

   357     return 1; # Dummy run

   358   }

   359 }

   360 

   361 __END__

   362 

   363 =head1 NAME

   364 

   365 CleanLocalArch - Cleans unwanted releases from the local release archive.

   366 

   367 =head1 SYNOPSIS

   368 

   369   cleanlocalarch [options] <description_file>

   370 

   371 options:

   372 

   373   -h  help

   374   -d  dummy run (don't do anything) - assumes -v

   375   -r  really clean (removes corrupt and partially released components)

   376   -v  verbose output (-vv very verbose)

   377   -o  overwrite destination (delete destination then normal copy)

   378 

   379 Please note, if you are in the process of publishing components to the archive and specify the -r option you may lose partially released components.

   380 

   381 =head1 DESCRIPTION

   382 

   383 C<CleanLocalArch> allows releases to be cleaned out of a local archive. This may be useful if a local archive is consuming a large amount of disk space and there are old releases present that are no longer required. Note that releases to be cleaned are normally backed up to a user defined directory before being deleted. This allows the cleaned releases to be permanently archived (to say a writable CDROM) before they are deleted.

   384 

   385 If C<CleanLocalArch> encounters an error while backing up releases to be cleaned, it will attempt to back out of the change by deleting the backups of any releases already done. If C<CleanLocalArch> encounters errors while backing out of a clean, it has the potential to leave releases in the backup directory. Similarly, if after backing up all releases to delete, it encounters errors while actually deleting them, it may leave releases in the local archive. However the clean can be repeated to a fresh backup directory once the problem has been isolated to get rid of these releases.

   386 

   387 Before using C<CleanLocalArchive> you must write a plain text file that describes which releases you want to keep etc. The following keywords are supported:

   388 

   389 =over 4

   390 

   391 =item keep_env <component> <version>

   392 

   393 Instructs C<CleanLocalArchive> to keep all the component versions in the environment from which the specified component was released. This keyword may be used multiple times.

   394 

   395 =item keep_rel <component> <version>

   396 

   397 Instructs C<CleanLocalArchive> to keep a specific component release. This keyword may be used multiple times.

   398 

   399 =item keep_recent_env <component> <num_days>

   400 

   401 Instructs C<CleanLocalArchive> to keep all named component releases, including their environments, where the component release has been made within the specified number of days (since the current time). This keyword may be used multiple times provided it is used for different components each time.

   402 

   403 =item keep_recent_rel [component] <num_days>

   404 

   405 Instructs C<CleanLocalArchive> to keep any component releases made within the specified number of days (since the current time). If a component name is specified, C<CleanLocalArchive> will only keep component releases which match that name (and are sufficiently recent). This keyword may be used multiple times if the command is used for different components.

   406 

   407 =item keep_recent <num_days>

   408 

   409 B<Depricated:> Equivalent to keep_recent_rel without a component name entered.

   410 

   411 =item clean_to

   412 

   413 Specifies where to move release to be cleaned. Use of this keyword is mandatory and may only be used once. There is an alternative, 'expunge', which will actually delete the releases - but this is only intended for test scripts and use on real, important archives is strongly discouraged.

   414 

   415 =item force

   416 

   417 This keyword, which takes no operands, specifies that cleanlocalarch should be non-interactive.

   418 

   419 =back

   420 

   421 For example:

   422 

   423  keep_env     pixie alpha

   424  keep_env     pixie beta

   425  keep_rel     comp1 rel1

   426  keep_recent  10

   427  clean_to     \\backup\pixie_cleaned_releases

   428 

   429 C<CleanLocalArch> will work out which component releases need to be kept in order to satisfy the specified keep criteria. All other component releases found in the archive will be moved to the C<clean_to> directory. B<It is therefore extremely important that the list of environments to keep is complete>. It is recommended that this file be controlled using a configuration management tool. It is also recommended that each project has only one description file, and that all users of C<CleanLocalArch> know where to find it.

   430 

   431 Recommended procedure for using C<CleanLocalArch>:

   432 

   433 =over 4

   434 

   435 =item 1

   436 

   437 Inform all users of the archive that a clean is about to be performed, and that the archive will be unavailable whilst this is happening.

   438 

   439 =item 2

   440 

   441 Take the archive off-line or alter directory permissions such that you are the only person that can access it.

   442 

   443 =item 3

   444 

   445 Backup the archive.

   446 

   447 =item 4

   448 

   449 Run C<CleanLocalArchive> and carefully check the list of components that are about to be cleaned. If you are happy, type 'yes' to continue, otherwise type 'no', modify your description file and re-run C<CleanLocalArchive>.

   450 

   451 =item 5

   452 

   453 Backup the C<clean_to> directory.

   454 

   455 =item 6

   456 

   457 Bring the archive back on-line.

   458 

   459 =item 7

   460 

   461 Inform all users of the archive that it is available for use once more.

   462 

   463 =back

   464 

   465 =head1 STATUS

   466 

   467 Supported. If you find a problem, please report it to us.

   468 

   469 =head1 COPYRIGHT

   470 

   471  Copyright (c) 2001-2009 Nokia Corporation and/or its subsidiary(-ies).

   472  All rights reserved.

   473  This component and the accompanying materials are made available

   474  under the terms of the License "Eclipse Public License v1.0"

   475  which accompanies this distribution, and is available

   476  at the URL "http://www.eclipse.org/legal/epl-v10.html".

   477  

   478  Initial Contributors:

   479  Nokia Corporation - initial contribution.

   480  

   481  Contributors:

   482  

   483  Description:

   484  

   485 

   486 =cut