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 CommandController;

    25 use Cleaner;

    26 use Utils;

    27 

    28 

    29 #

    30 # Globals.

    31 #

    32 

    33 my $verbose = 0;

    34 my $dummyRun = 0;

    35 my $descriptionFile;

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

    37 my $commandController = CommandController->New($iniData, 'CleanRemote');

    38 my $keepAfter;

    39 my %envsToKeep;

    40 my %relsToKeep;

    41 my %relsToClean;

    42 my @filesToDelete;

    43 my $remoteSite = $iniData->RemoteSite;

    44 my $cleaner;

    45 my $doall = 0; # skips prompting

    46 my $skipWarnings;

    47 

    48 #

    49 # Main.

    50 #

    51 ProcessCommandLine();

    52 $cleaner = Cleaner->New($iniData, 1, $verbose, 0); # 1 = remote

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

    54 ParseDescriptionFile($descriptionFile);

    55 $cleaner->Clean();

    56 

    57 #

    58 # Subs.

    59 #

    60 

    61 sub ProcessCommandLine {

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

    63   my $help;

    64   GetOptions('h' => \$help, 'd' => \$dummyRun, 'v+' => \$verbose, 'f' => \$skipWarnings);

    65 

    66   if ($help) {

    67     Usage(0);

    68   }

    69 

    70   $descriptionFile = shift @ARGV;

    71 

    72   unless ($descriptionFile) {

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

    74     Usage(1);

    75   }

    76 

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

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

    79     Usage(1);

    80   }

    81 

    82   if ($dummyRun and not $verbose) {

    83     $verbose = 1;

    84   }

    85 }

    86 

    87 sub Usage {

    88   my $exitCode = shift;

    89 

    90   Utils::PrintDeathMessage($exitCode, "\nUsage: cleanremote [options] <description_file>

    91 

    92 options:

    93 

    94 -h  help

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

    96 -f  (deprecated)

    97 -v  verbose output (-vv very verbose).\n");

    98 

    99 }

   100 

   101 sub ParseDescriptionFile {

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

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

   104 

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

   106     # Remove line feed, white space and comments.

   107     chomp($line);

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

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

   110     if ($line eq '') {

   111       # Nothing left.

   112       next;

   113     }

   114 

   115     my $keyWord;

   116     my @operand;

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

   118       $keyWord = $1;

   119       @operand = ();

   120       if ($2) {

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

   122       }

   123     } else {

   124       $keyWord = $line;

   125     }

   126 

   127     unless (defined $keyWord) {

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

   129       next;

   130     }

   131 

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

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

   134     }

   135     elsif ($keyWord =~ /^(?:no_prompt)$/ ) {

   136       $doall = 1;    

   137     } elsif ($keyWord =~ /^(?:clean_to|expunge)$/ ) {

   138       my $msg = "You have accidentally left a \"$keyWord\" keyword in your configuration file. That's appropriate for cleaning local archives, but cleanremote just completely deletes stuff. Do you want to continue?";

   139       die unless $cleaner->Query($msg);

   140     }

   141     else {

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

   143     }

   144   }

   145 

   146   close (DES);

   147 

   148   if ($verbose > 1) {

   149     $cleaner->PrintEnvsToKeep();

   150   }

   151 }

   152 

   153 sub CleaningSubroutine {

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

   155   my $thisComp = shift;

   156   my $thisVer = shift;

   157   my $relDir = shift;

   158   print "Cleaning $thisComp $thisVer from $relDir...\n" if ($verbose);

   159   unless ($doall) {

   160     print "Do it?\n";

   161     my $ans = <STDIN>;

   162     die "Not doing" unless $ans =~ m/[ay]/i;

   163     $doall = 1 if $ans =~ m/a/i;

   164   }

   165   die "Couldn't delete $relDir because it didn't exist" unless $remoteSite->DirExists($relDir);

   166   my $fullfile = "$relDir/$thisComp$thisVer.zip";

   167   print "Actually deleting release file $fullfile\n";

   168   DeleteFile($fullfile);

   169   my @files = @{$remoteSite->DirList($relDir) || []};

   170   foreach my $fullfile (@files) {

   171     if ($fullfile =~ m/lpdrt\d{5}\.tmp$/) {

   172       # Remove temp files older than $keepAfter time

   173       my $modifiedTime = $remoteSite->FileModifiedTime($fullfile);

   174       my $keepAfter = $cleaner->{keepAfter};

   175       if ($modifiedTime and (not defined $keepAfter or $modifiedTime <= $keepAfter)) {

   176         print "Actually deleting temp file $fullfile\n";

   177         DeleteFile($fullfile);

   178       } else {

   179         print "Not deleting temp file $fullfile because too new\n";

   180       }

   181     }

   182   }

   183   if (!$dummyRun) {

   184     # Now check the directory is empty and delete the directory if so

   185     @files = @{$remoteSite->DirList($relDir) || []};

   186     @files = map { m/.*\/(.*?)$/; $1 } @files;

   187     print "Wanting to remove directory $relDir - @files files left in it\n" if ($verbose);

   188     DeleteFile($relDir) unless @files;

   189   }

   190 

   191   return 1; # This cleaner doesn't currently support returning of any errors

   192 }

   193 

   194 sub DeleteFile {

   195   my $file = shift;

   196   print "Deleting \"$file\"\n" if ($verbose);

   197 	eval {

   198 		$remoteSite->DeleteFile($file) unless ($dummyRun);

   199 	};

   200 	if ($@) {

   201 		print "Warning: Couldn't delete \"$file\" because \"$@\"\n";

   202 		# Usually because $file is a directory, which turns out not to be

   203 		# empty.

   204 	}

   205 }

   206 

   207 __END__

   208 

   209 =head1 NAME

   210 

   211 CleanRemote - Cleans unwanted releases and files from a remote archive.

   212 

   213 =head1 SYNOPSIS

   214 

   215   cleanremote [options] <description_file>

   216 

   217 options:

   218 

   219   -h  help

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

   221   -f  (deprecated)

   222   -v  verbose output (-vv very verbose)

   223 

   224 =head1 DESCRIPTION

   225 

   226 C<cleanremote> allows releases to be cleaned out of a remote archive. This may be useful if a remote archive is consuming a large amount of disk space and there are old releases present that are no longer required.

   227 

   228 B<Warning: C<cleanremote> has the potential to seriously alter the state of a remote archive, and hence seriously damage productivity of all users of the remote archive. Be very careful using it.>

   229 

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

   231 

   232 =over 4

   233 

   234 =item keep_env <component> <version>

   235 

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

   237 

   238 =item keep_rel <component> <version>

   239 

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

   241 

   242 =item keep_recent_env <component> <num_days>

   243 

   244 Instructs C<cleanremote> to keep all named component releases, including their environments, where the component release has been exported within the specified number of days (since the current time) (note: the export time, rather than release time is used).

   245 

   246 It should be noted that for this keyword to work, an accessible local archive must contain copies of the same component releases as are identified on the remote server as ones to keep.

   247 

   248 This keyword may be used multiple times provided it is used for different components each time.

   249 

   250 =item keep_recent_rel [component] <num_days>

   251 

   252 Instructs C<cleanremote> to keep any component releases exported within the specified number of days (since the current time). If a component name is specified, C<cleanremote> will only keep component releases which match that name (and are sufficiently recent). Please note that the time is taken from time of export, not time of release.

   253 

   254 This keyword may be used multiple times if the command is used for different components. 

   255 

   256 =item keep_recent <num_days>

   257 

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

   259 

   260 =item no_prompt

   261 

   262 Instructs C<cleanremote> to not prompt the user to delete every component. This is equivalent to typing 'a' (all) at the first component prompt.

   263 

   264 =back

   265 

   266 For example:

   267 

   268  keep_env     pixie alpha

   269  keep_env     pixie beta

   270  keep_rel     comp1 rel1

   271  keep_recent  10

   272 

   273 C<cleanremote> 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 deleted (along with temporary files used during FTP uploads). 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<cleanremote> know where to find it.

   274 

   275 Recommended procedure for using C<cleanremote>:

   276 

   277 =over 4

   278 

   279 =item 1

   280 

   281 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.

   282 

   283 =item 2

   284 

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

   286 

   287 =item 3

   288 

   289 Backup the archive.

   290 

   291 =item 4

   292 

   293 Run C<cleanremote> 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<cleanremote>.

   294 

   295 =item 5

   296 

   297 Bring the archive back on-line.

   298 

   299 =item 6

   300 

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

   302 

   303 =back

   304 

   305 =head1 STATUS

   306 

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

   308 

   309 =head1 KNOWN BUGS

   310 

   311 None.

   312 

   313 =head1 COPYRIGHT

   314 

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

   316  All rights reserved.

   317  This component and the accompanying materials are made available

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

   319  which accompanies this distribution, and is available

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

   321  

   322  Initial Contributors:

   323  Nokia Corporation - initial contribution.

   324  

   325  Contributors:

   326  

   327  Description:

   328  

   329 

   330 =cut