WebSVN – DevTools – Blame – /dpkg_management/trunk/src/sbin/jats_quarantine.pl

Rev	Author	Line No.	Line
3410	dpurdie	1	`########################################################################`
		2	`# Copyright (C) 1998-2013 Vix Technology, All rights reserved`
		3	`#`
		4	`# Module name : jats_quarantine.pl`
		5	`# Module type : Makefile system`
		6	`# Compiler(s) : Perl`
		7	`# Environment(s): jats`
		8	`#`
		9	`# Description : Remove packages from dpkg_archive that are no longer`
3413	dpurdie	10	`# required - if they can be rebuilt.`
3410	dpurdie	11	`#`
		12	`# Usage : See POD at end of file`
		13	`#`
		14	`#......................................................................#`
		15
		16	`require 5.008_002;`
		17	`use strict;`
		18	`use warnings;`
		19
		20	`use Pod::Usage;`
		21	`use Getopt::Long;`
		22
		23	`use JatsError;`
		24	`use JatsSystem;`
		25	`use Getopt::Long;`
		26	`use Pod::Usage; # required for help support`
		27	`use JatsRmApi;`
		28	`use ConfigurationFile;`
		29	`use File::Path;`
		30	`use File::Basename;`
		31
		32	`use DBI;`
		33
		34	`#`
		35	`# Options - global`
		36	`#`
		37	`my $VERSION = "2.0.0"; # Update this`
		38	`my $opt_verbose = 0;`
		39	`my $opt_help = 0;`
		40	`my $opt_manual;`
		41	`my $opt_test;`
		42	`my $opt_limit;`
		43	`my $opt_quick;`
		44	`my $opt_phase = '123'; # Default - do all, but don't save data`
4092	dpurdie	45	`my $opt_purge;`
4093	dpurdie	46	`my $opt_pcount = 0;`
3410	dpurdie	47
		48	`#`
		49	`# Globals`
		50	`#`
4542	dpurdie	51	`my $progBase;`
3410	dpurdie	52	`my $RM_DB;`
		53	`my $now = time();`
		54	`my $quarantineInstance;`
		55	`my $logPath;`
		56	`my %pkgPvid;`
		57	`my @quarantineItems;`
		58	`my @StrayPackages;`
		59
		60	`our %Releases;`
		61	`our %Packages;`
		62
		63	`#`
		64	`# Default config information`
		65	`# May be replaced by xxx.cnf file`
		66	`#`
		67	`my %config = (`
		68	`'retain' => '31',`
		69	`'qdirAge' => '90',`
		70	`'retainNoRm' => '31',`
		71	`'quarantine' => '/export/devl/quarantine',`
		72	`'dpkg_archive' => '/export/devl/dpkg_archive',`
		73	`'logBase' => '/export/devl/dpkg_archive/.dpkg_archive/quarantinelog',`
		74	`'verbose' => '0',`
4542	dpurdie	75	`'S3Bucket' => 'auawsaddp001',`
		76	`'S3Key' => 'Mandatory',`
		77	`'S3Secret' => 'Mandatory',`
3410	dpurdie	78	`);`
		79
		80	`# List of packages to be retained`
		81	`# May be supplemented by xxx.cnf file`
		82	`my %retainPkgs = (`
		83	`'core_devl' => 1,`
		84	`);`
		85
		86	`#-------------------------------------------------------------------------------`
		87	`# Function : Main Entry`
		88	`#`
		89	`# Description :`
		90	`#`
		91	`# Inputs :`
		92	`#`
		93	`# Returns :`
		94	`#`
		95	`my $result = GetOptions (`
		96	`"help+" => \$opt_help, # flag, multiple use allowed`
		97	`"manual" => \$opt_manual, # flag`
		98	`"verbose:+" => \$opt_verbose, # flag`
		99	`"test:+" => \$opt_test, # Test a version string`
		100	`"limit:n" => \$opt_limit, #`
		101	`"phase:s" => \$opt_phase, # Phase to do`
		102	`"quick" => \$opt_quick, # Don't look for indirects`
4092	dpurdie	103	`"purge" => \$opt_purge, # Purge old quarantined packages`
4093	dpurdie	104	`"pcount:n" => \$opt_pcount, # Count of packages to purge in one hit`
3410	dpurdie	105	`);`
		106
		107	`#`
		108	`# Process help and manual options`
		109	`#`
		110	`pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 \|\| ! $result);`
		111	`pod2usage(-verbose => 1) if ($opt_help == 2 );`
		112	`pod2usage(-verbose => 2) if ($opt_manual \|\| ($opt_help > 2));`
		113	`ErrorConfig( 'name' => 'QUARANTINE',`
		114	`'verbose' => $opt_verbose );`
		115
		116	`#`
		117	`# This utility must be run on the package server`
		118	`my $runHost = 'auperaarc01';`
		119	`my $hostname = lc $ENV{HOSTNAME} \|\| 'Unknown';`
		120	`Warning("Not running on $runHost") unless ( $hostname eq $runHost );`
		121
		122	`#`
		123	`# Needs to run as root so that packages can be moved no matter what the`
		124	`# file permissions are`
		125	`#`
		126	`Warning( "Not running as root") if ( $> );`
		127
4542	dpurdie	128	`#`
		129	`# Determine the base of this program`
		130	`# Will be used to find config and local utils`
		131	`#`
		132	`$progBase = $0;`
		133	`$progBase =~ s~/[^/]+$~~;`
		134	`Verbose("ProgBase: $0: $progBase");`
		135
3410	dpurdie	136	`# Read config file`
		137	`# Use max of user verbosity or config verbosity`
		138	`#`
		139	`ReadConfig();`
		140	`if ( $config{verbose} > $opt_verbose )`
		141	`{`
		142	`$opt_verbose = $config{verbose};`
		143	`ErrorConfig( 'verbose' => $opt_verbose );`
		144	`}`
		145
		146	`#`
		147	`# Collect data from Release Manager`
		148	`#`
4092	dpurdie	149	`if ( $opt_phase =~ m~1~ && !$opt_purge )`
3410	dpurdie	150	`{`
		151	`getReleaseDetails();`
		152	`GetAllPackageData();`
		153	`getTopLevelPackages();`
		154	`LocateStrays() unless ($opt_quick);`
		155
		156	`if ( $opt_verbose > 1 )`
		157	`{`
		158	`print "=========================================================================\n";`
		159	`DebugDumpData("Releases", \%Releases);`
		160	`print "=========================================================================\n";`
		161	`DebugDumpData("Packages", \%Packages );`
		162	`}`
		163	`}`
		164
		165	`#`
4092	dpurdie	166	`# Scan dpkg_archive and quarantine packages`
3410	dpurdie	167	`#`
		168	`if ( $opt_phase =~ m~2~ )`
		169	`{`
		170	`prepQdir();`
4092	dpurdie	171	`unless ($opt_purge) {`
		172	`readInputData();`
		173	`processDpkgArchive();`
		174	`reportMissingPkgs();`
		175	`}`
3410	dpurdie	176
		177	`Verbose ("Quarantine to: $quarantineInstance");`
		178	`Verbose ("Log to: $logPath");`
		179	`}`
		180
		181	`#`
		182	`# Save internal data for reuse`
		183	`# Used only for testing of indiviual phases`
		184	`#`
		185	`unless ( $opt_phase =~ m~3~ )`
		186	`{`
		187	`savePhaseData();`
		188	`}`
		189
		190	`ErrorDoExit();`
		191	`exit;`
		192
		193	`#-------------------------------------------------------------------------------`
		194	`# Function : ReadConfig`
		195	`#`
		196	`# Description : Read in config file`
		197	`# Must be inthe same directory as the executable`
		198	`#`
		199	`# Inputs :`
		200	`#`
		201	`# Returns :`
		202	`#`
		203
		204	`sub ReadConfig`
		205	`{`
		206	`my $config = $0;`
		207	`$config =~ s~\.pl$~.cnf~;`
		208	`open (CF, '<', $config ) \|\| Error ("Connot open: $config");`
		209	`while ( <CF> )`
		210	`{`
		211	`s~\s+$~~;`
		212	`s~^\s+~~;`
		213	`next if ( m~\s*#~ ); # Comment`
		214	`next unless $_; # Empty`
		215	`if ( m~(.?)\s=\s(.)~ ) {`
		216	`ReportError ("Unknown config value: $1") unless ( exists $config{$1} );`
		217	`$config{$1} = $2;`
		218	`} else {`
		219	`$retainPkgs{$_} = 1;`
		220	`}`
		221	`}`
		222	`close CF;`
		223	`ErrorDoExit();`
		224	`}`
		225
		226	`#-------------------------------------------------------------------------------`
		227	`# Function : getReleaseDetails`
		228	`#`
		229	`# Description : Determine all candiate releases`
		230	`#`
		231	`# Inputs :`
		232	`#`
		233	`# Returns :`
		234	`#`
		235	`sub getReleaseDetails`
		236	`{`
		237	`my (@row);`
		238
		239	`Verbose ("Determine all Release Names");`
		240
		241	`# if we are not or cannot connect then return 0 as we have not found anything`
		242	`connectRM(\$RM_DB) unless $RM_DB;`
		243
		244	`# Get all Releases`
		245	`# From non-archived releases`
		246	`my $m_sqlstr = "SELECT prj.PROJ_NAME, rt.RTAG_NAME, rt.PROJ_ID, rt.RTAG_ID, rt.official" .`
		247	`" FROM release_manager.release_tags rt, release_manager.projects prj" .`
		248	`" WHERE prj.PROJ_ID = rt.PROJ_ID " .`
		249	`" AND rt.official != 'A' ";`
		250	`# " AND rt.official != 'Y'" .`
		251
		252	`Verbose3("getReleaseDetails: $m_sqlstr");`
		253	`my $sth = $RM_DB->prepare($m_sqlstr);`
		254	`if ( defined($sth) )`
		255	`{`
		256	`if ( $sth->execute( ) )`
		257	`{`
		258	`if ( $sth->rows )`
		259	`{`
		260	`while ( @row = $sth->fetchrow_array )`
		261	`{`
		262	`my $rtag_id =$row[3];`
		263	`my $proj_id = $row[2];`
		264
		265	`$Releases{$rtag_id}{pName} = $row[0];`
		266	`$Releases{$rtag_id}{name} = $row[1];`
		267	`$Releases{$rtag_id}{proj_id} = $proj_id;`
		268	`$Releases{$rtag_id}{rtag_id} = $rtag_id;`
		269	`$Releases{$rtag_id}{official} = $row[4];`
		270
		271	`print join (',',@row), "\n" if ($opt_verbose > 2);`
		272	`}`
		273	`}`
		274	`$sth->finish();`
		275	`}`
		276	`else`
		277	`{`
		278	`Error("getReleaseDetails:Execute failure: $m_sqlstr", $sth->errstr() );`
		279	`}`
		280	`}`
		281	`else`
		282	`{`
		283	`Error("getReleaseDetails:Prepare failure" );`
		284	`}`
		285	`}`
		286
		287	`#-------------------------------------------------------------------------------`
		288	`# Function : GetAllPackageData`
		289	`#`
		290	`# Description : Extract all package data`
		291	`#`
		292	`# Inputs :`
		293	`#`
		294	`# Returns :`
		295	`#`
		296
		297	`sub GetAllPackageData`
		298	`{`
		299	`my (@row);`
		300	`my $count = 0;`
		301
		302	`# if we are not or cannot connect then return 0 as we have not found anything`
		303	`connectRM(\$RM_DB) unless $RM_DB;`
		304
		305	`Verbose ("Extract all package data");`
		306
		307	`# First get all packages`
		308	`# From non-archived releases`
		309
		310	`my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';`
		311	`my $m_sqlstr = "SELECT DISTINCT " .`
		312	`"pv.PV_ID, " . #[0]`
		313	`"pkg.PKG_NAME, " . #[1]`
		314	`"pv.PKG_VERSION, " . #[2]`
		315	`"pv.DLOCKED, " . #[3]`
		316	`"pv.PKG_ID," . #[4]`
		317	`"pv.is_patch," . #[5]`
		318	`"pv.build_type,". #[6]`
		319	`"pbi.bsa_id," . #[7]`
		320	`# "pv.CREATOR_ID, " . #[8]`
		321	`# "pv.MODIFIED_STAMP, " . #[9]`
		322	`# "release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), " . #[10]`
		323	`"999" .`
		324	`" FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv,".`
		325	`"RELEASE_MANAGER.PACKAGES pkg,".`
		326	`"release_manager.package_build_info pbi" .`
		327	`" WHERE pv.PKG_ID = pkg.PKG_ID" .`
		328	`" AND pv.pv_id = pbi.pv_id(+)" .`
		329	`$limit ;`
		330	`Verbose3("GetAllPackageData: $m_sqlstr");`
		331	`my $sth = $RM_DB->prepare($m_sqlstr);`
		332	`if ( defined($sth) )`
		333	`{`
		334	`if ( $sth->execute( ) )`
		335	`{`
		336	`if ( $sth->rows )`
		337	`{`
		338	`while ( @row = $sth->fetchrow_array )`
		339	`{`
		340	`$count++;`
		341	`print join (',',@row), "\n" if ($opt_verbose > 2);`
		342	`my $pvid = $row[0];`
		343	`unless ( exists $Packages{$pvid}{name} )`
		344	`{`
		345	`$Packages{$pvid}{name} = $row[1];`
		346	`$Packages{$pvid}{version} = $row[2];`
		347	`$Packages{$pvid}{locked} = $row[3];`
		348	`$Packages{$pvid}{pkgid} = $row[4];`
		349	`$Packages{$pvid}{isPatch} = $row[5] \|\| 0;`
		350	`$Packages{$pvid}{buildType} = $row[6] \|\| 0;`
		351	`$Packages{$pvid}{buildStandard} = $row[7] \|\| 0;`
		352
		353	`#$Packages{$pvid}{Creator} = $row[8];`
		354	`#$Packages{$pvid}{Age} = $row[9];`
		355	`#$Packages{$pvid}{vcstag} = $row[10];`
		356
		357	`}`
		358
		359	`if ( $opt_limit )`
		360	`{`
		361	`last if ( $count > $opt_limit );`
		362	`}`
		363	`}`
		364	`}`
		365	`$sth->finish();`
		366	`}`
		367	`else`
		368	`{`
		369	`Error("GetAllPackageData:Execute failure: $m_sqlstr", $sth->errstr() );`
		370	`}`
		371	`}`
		372	`else`
		373	`{`
		374	`Error("GetAllPackageData:Prepare failure" );`
		375	`}`
		376
		377	`Verbose ("All Packages: $count rows");`
		378	`}`
		379
		380
		381	`#-------------------------------------------------------------------------------`
		382	`# Function : getTopLevelPackages`
		383	`#`
		384	`# Description : Extract top level packages from active releases`
		385	`#`
		386	`# Inputs :`
		387	`#`
		388	`# Returns :`
		389	`#`
		390
		391	`sub getTopLevelPackages`
		392	`{`
		393	`my (@row);`
		394	`my $count = 0;`
		395
		396	`# if we are not or cannot connect then return 0 as we have not found anything`
		397	`connectRM(\$RM_DB) unless $RM_DB;`
		398
		399	`Verbose ("Extract toplevel dependencies");`
		400
		401	`# First get all packages that are referenced in a Release`
		402	`# This will only get the top level packages`
		403	`# From non-archived releases`
		404
		405	`my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';`
		406	`my $m_sqlstr = "SELECT DISTINCT " .`
		407	`"rc.PV_ID, " . #[0]`
		408	`"rt.RTAG_ID, " . #[1]`
		409	`"prj.PROJ_ID " . #[2]`
		410	`" FROM RELEASE_MANAGER.RELEASE_CONTENT rc, ".`
		411	`"release_manager.release_tags rt,".`
		412	`"release_manager.projects prj" .`
		413	`" WHERE prj.PROJ_ID = rt.PROJ_ID" .`
		414	`" and rt.RTAG_ID = rc.RTAG_ID" .`
		415	`" AND rt.official != 'A'" .`
		416	`# " AND rt.official != 'Y' " .`
		417	`$limit;`
		418
		419	`Verbose3("getTopLevelPackages: $m_sqlstr");`
		420	`my $sth = $RM_DB->prepare($m_sqlstr);`
		421	`if ( defined($sth) )`
		422	`{`
		423	`if ( $sth->execute( ) )`
		424	`{`
		425	`if ( $sth->rows )`
		426	`{`
		427	`while ( @row = $sth->fetchrow_array )`
		428	`{`
		429	`$count++;`
		430	`print join (',',@row), "\n" if ($opt_verbose > 2);`
		431	`my $pvid = $row[0];`
		432	`$Packages{$pvid}{tlp} = 1;`
		433	`push @StrayPackages, $pvid;`
		434
		435
		436	`my $rtag_id = $row[1];`
		437	`push @{$Packages{$pvid}{release}}, $rtag_id;`
		438
		439	`my $proj_id = $row[2];`
		440	`push @{$Packages{$pvid}{projects}}, $proj_id`
		441	`unless (grep {$_ eq $proj_id} @{$Packages{$pvid}{projects}});`
		442
		443	`if ( $opt_limit )`
		444	`{`
		445	`last if ( $count > $opt_limit );`
		446	`}`
		447	`}`
		448	`}`
		449	`$sth->finish();`
		450	`}`
		451	`else`
		452	`{`
		453	`Error("getTopLevelPackages:Execute failure: $m_sqlstr", $sth->errstr() );`
		454	`}`
		455	`}`
		456	`else`
		457	`{`
		458	`Error("getTopLevelPackages:Prepare failure" );`
		459	`}`
		460
		461	`Verbose ("Extract toplevel dependencies: $count rows");`
		462	`}`
		463
		464	`#-------------------------------------------------------------------------------`
		465	`# Function : GetDepends`
		466	`#`
		467	`# Description :`
		468	`#`
		469	`# Inputs : @plist - list of pvid's to process`
		470	`#`
		471	`# Returns :`
		472	`#`
		473	`sub GetDepends`
		474	`{`
		475	`my (@plist) = @_;`
		476
		477	`#`
		478	`# Now extract the package dependacies`
		479	`# There may not be any`
		480	`#`
		481	`my $m_sqlstr = "SELECT ".`
		482	`" pd.PV_ID, ".`
		483	`" pd.DPV_ID " .`
		484	`" FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd ".`
		485	`" WHERE pd.PV_ID in ( " . join(',', @plist) . " )";`
		486	`my $sth = $RM_DB->prepare($m_sqlstr);`
		487	`if ( defined($sth) )`
		488	`{`
		489	`if ( $sth->execute( ) )`
		490	`{`
		491	`if ( $sth->rows )`
		492	`{`
		493	`while ( my @row = $sth->fetchrow_array )`
		494	`{`
		495	`my $pvid = $row[0];`
		496	`my $dpvid = $row[1];`
		497	`push @StrayPackages, $dpvid;`
		498	`push @{$Packages{$dpvid}{usedBy}}, $pvid;`
3423	dpurdie	499	`$Packages{$dpvid}{slp} = 1 unless exists $Packages{$dpvid}{tlp};`
3410	dpurdie	500
		501	`print join (',','GetDepends',@row), "\n" if ($opt_verbose > 2);`
		502	`}`
		503	`}`
		504	`$sth->finish();`
		505	`}`
		506	`else`
		507	`{`
		508	`Error("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );`
		509	`}`
		510	`}`
		511	`else`
		512	`{`
		513	`Error("GetDepends:Prepare failure" );`
		514	`}`
		515	`}`
		516
		517	`#-------------------------------------------------------------------------------`
		518	`# Function : LocateStrays`
		519	`#`
		520	`# Description : Locate stray packages`
		521	`# Try to do several (200) at a time to speed up processing`
		522	`#`
		523	`# Inputs :`
		524	`#`
		525	`# Returns :`
		526	`#`
		527	`sub LocateStrays`
		528	`{`
		529	`Verbose ("Locate indirectly referenced packages");`
		530	`while ( $#StrayPackages >= 0 )`
		531	`{`
		532	`#print "Strays Remaining: ", scalar @StrayPackages ,"\n";`
		533
		534	`my @plist;`
		535	`while ( $#plist <= 200 && @StrayPackages )`
		536	`{`
		537	`my $pv_id = pop @StrayPackages;`
		538	`next if ( exists $Packages{$pv_id}{done} );`
		539	`push @plist, $pv_id;`
		540	`}`
		541
		542	`GetDepends(@plist) if @plist;`
		543
		544	`foreach ( @plist)`
		545	`{`
		546	`$Packages{$_}{done} = 1;`
		547	`}`
		548	`}`
		549	`}`
		550
		551	`#-------------------------------------------------------------------------------`
		552	`# Function : savePhaseData`
		553	`#`
		554	`# Description : Save inter-phase data`
		555	`#`
		556	`# Inputs :`
		557	`#`
		558	`# Returns :`
		559	`#`
		560	`sub savePhaseData`
		561	`{`
		562	`my $count = 0;`
		563	`my $direct = 0;`
		564	`my $indirect = 0;`
		565	`my $buildable = 0;`
		566	`my $bad = 0;`
		567
		568	`foreach my $pvid ( keys %Packages )`
		569	`{`
		570	`my $entry = $Packages{$pvid};`
		571	`unless ( defined $entry->{name} && defined $entry->{version})`
		572	`{`
		573	`Warning ("Package Name or Version not known: $pvid");`
		574	`$bad++;`
		575	`next;`
		576	`}`
		577
		578	`$count++;`
		579	`if ( $entry->{locked} && $entry->{locked} eq 'Y' && $entry->{buildStandard} > 0 )`
		580	`{`
		581	`$buildable++;`
		582	`}`
		583
		584	`$direct++ if ( $entry->{tlp} );`
		585	`$indirect++ if ( $entry->{slp} );`
		586	`}`
		587
		588	`my $file = "quarantine.raw.txt";`
		589	`Verbose ("Create: $file");`
		590	`my $fh = ConfigurationFile::New( $file );`
		591
		592	`$fh->DumpData(`
		593	`"\n# Package Data.\n#\n",`
		594	`"Packages", \%Packages );`
		595
		596	`$fh->DumpData(`
		597	`"\n# Release Data.\n#\n",`
		598	`"Releases", \%Releases );`
		599
		600	`$fh->Close();`
		601
		602	`Verbose("Packages: $count, Bad: $bad: Buildable: $buildable, Directly included: $direct, Indirect: $indirect");`
		603	`}`
		604
		605	`#-------------------------------------------------------------------------------`
		606	`# Function : prepQdir`
		607	`#`
		608	`# Description : Prepare the quarantine target directory`
		609	`# Setup logging`
		610	`#`
		611	`# Done at the start of the 2nd phase`
		612	`#`
		613	`# Inputs :`
		614	`#`
		615	`# Returns :`
		616	`#`
		617	`sub prepQdir`
		618	`{`
		619	`my ( $ss, $mm, $hh, $dd, $mo, $yy ) = ( localtime($now) )[0..5];`
		620	`my $stamp = sprintf("%4.4d%2.2d%2.2d_%2.2d%2.2d%2.2d", $yy+1900, $mo+1, $dd, $hh,$mm,$ss);`
		621
		622	`$quarantineInstance = join('/', $config{quarantine}, $stamp);`
		623
		624	`my $logName = 'quarantine_' . $stamp . '.txt';`
		625	`$logPath = join('/', $config{logBase}, $logName );`
		626	`eval { mkpath($config{logBase}) } unless -d $config{logBase};`
		627	`Error ("Log directory not found/created: $config{logBase}") unless -d $config{logBase};`
		628
		629	`#`
		630	`# Start the log file`
		631	`Log ("TEST Mode Enabled") if $opt_test;`
		632	`Log ("QuarantinePath: $quarantineInstance");`
3423	dpurdie	633	`Log ("Config: $_ = $config{$_}") foreach ( sort keys %config );`
		634	`Log ("Ignore: $_") foreach ( sort keys %retainPkgs );`
3410	dpurdie	635
		636	`#`
		637	`# Create a 'nice' symlink to the latest log file`
		638	`my $logLatest = join('/', $config{logBase}, 'latest');`
		639	`unlink ( $logLatest );`
		640	`symlink( $logName, $logLatest);`
		641
		642	`#`
		643	`# Clean up old files`
		644	`#`
		645	`opendir( Q, $config{quarantine} ) \|\| Error ("opendir failed on: $config{quarantine}" );`
		646
		647	`# delete any quarantine instance older than 90 days`
		648	`while ( my $file = readdir( Q ) )`
		649	`{`
		650	`#`
		651	`# Skip housekeeping directory entries`
		652	`#`
		653	`next if ( $file eq '.' );`
		654	`next if ( $file eq '..' );`
		655	`next if ( $file eq 'lost+found' );`
		656
		657	`my $path = join( '/', $config{quarantine} . "/" . $file);`
		658	`my $age = checkTime( $path );`
		659	`if ( $age > $config{qdirAge} )`
		660	`{`
		661	`Log ("Old Quarantine Removed: $path");`
		662	`Verbose ("Test: Delete Dir: $path") if ( $opt_test );`
		663	`rmtree($path, 0, 1) unless $opt_test;`
		664	`}`
		665	`}`
		666
		667	`closedir( Q );`
		668	`}`
		669
		670	`#-------------------------------------------------------------------------------`
		671	`# Function : checkTime`
		672	`#`
		673	`# Description : Days since modification of a path`
		674	`#`
		675	`# Inputs : Path elements`
		676	`#`
		677	`# Returns : Days since midification`
		678	`#`
		679
		680	`sub checkTime`
		681	`{`
		682	`my ($path) = @_;`
		683	`my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,`
		684	`$atime,$mtime,$ctime,$blksize,$blocks) = stat($path);`
		685
4127	dpurdie	686	`unless(defined $mtime)`
		687	`{`
		688	`Warning("Bad stat for $path");`
		689	`$mtime = 0;`
		690	`}`
		691
3410	dpurdie	692	`return int( ($now - $mtime) / (60 * 60 * 24));`
		693	`}`
		694
		695	`#-------------------------------------------------------------------------------`
		696	`# Function : processDpkgArchive`
		697	`#`
		698	`# Description : Scan dpkg_archive`
		699	`#`
		700	`# Inputs :`
		701	`#`
		702	`# Returns :`
		703	`#`
		704	`sub processDpkgArchive`
		705	`{`
		706	`Verbose ("Scanning dpkg_archive");`
		707	`opendir( PKGS, $config{dpkg_archive} ) \|\| Error ("Cannot open dpkg_archive");`
		708	`while ( my $pkgName = readdir(PKGS) )`
		709	`{`
		710	`next if ( $pkgName eq '.' );`
		711	`next if ( $pkgName eq '..' );`
		712	`next if ( $pkgName eq 'lost+found' );`
		713	`next if ( exists $retainPkgs{$pkgName} );`
		714
		715	`my $pkgDir = join('/', $config{dpkg_archive}, $pkgName );`
		716	`if ( -d $pkgDir )`
		717	`{`
		718	`if (opendir (PV, $pkgDir ) )`
		719	`{`
		720
		721	`while ( my $pkgVersion = readdir(PV) )`
		722	`{`
		723	`next if ( $pkgVersion eq '.' );`
		724	`next if ( $pkgVersion eq '..' );`
		725	`my $pkgPath = join('/', $config{dpkg_archive}, $pkgName,$pkgVersion );`
		726	`my $mtime = checkTime($pkgPath);`
		727
		728	`my $pvid;`
		729	`if ( exists ($pkgPvid{$pkgName}) && exists($pkgPvid{$pkgName}{$pkgVersion} ) )`
		730	`{`
		731	`$pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};`
		732	`$Packages{$pvid}{dpkg_archive} = 1;`
		733	`$pkgPvid{$pkgName}{$pkgVersion}{mtime} = $mtime;`
		734	`}`
		735	`else`
		736	`{`
		737	`#`
		738	`# Package is in dpkg-archive, but not in Release`
		739	`# Manager. Allow for a short while`
		740	`#`
		741	`if ( $mtime > $config{retainNoRm} )`
		742	`{`
		743	`#Log("Package not in RM: $pkgName, $pkgVersion, Age: $mtime");`
		744	`quarantineItem( 'X', $mtime, $pkgPath );`
		745	`}`
		746	`}`
		747
		748	`#Message("$pkgName, $pkgVersion, $pkgPvid{$pkgName}{$pkgVersion}{mtime}");`
		749	`}`
		750	`close(PV);`
		751	`}`
		752	`}`
		753	`elsif ( -f $pkgDir )`
		754	`{`
		755	`Warning("Unexpected file in dpkg_archive: $pkgName");`
		756	`Log("Unexpected file in dpkg_archive: $pkgName");`
		757	`quarantineItem( 'F', -1, $pkgDir );`
		758	`}`
		759	`else`
		760	`{`
		761	`Warning("Unexpected entry in dpkg_archive: $pkgName");`
		762	`}`
		763	`}`
		764	`close(PKGS);`
		765
		766
		767	`#`
		768	`#`
		769	`# Display information`
		770	`#`
		771	`foreach my $pkgName ( sort keys %pkgPvid )`
		772	`{`
		773	`foreach my $pkgVersion ( sort keys %{$pkgPvid{$pkgName}} )`
		774	`{`
		775	`my $mtime = $pkgPvid{$pkgName}{$pkgVersion}{mtime} \|\| 0;`
		776	`my $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};`
		777
		778	`if ( $pvid && $mtime )`
		779	`{`
		780	`my $entry = $Packages{$pvid};`
		781	`next if ( exists $entry->{tlp} \|\| exists $entry->{slp} );`
		782	`next if ( $mtime <= $config{retain} );`
		783	`next unless ( $entry->{buildStandard} );`
		784	`next if ( $entry->{isPatch} );`
		785	`next if ( $entry->{locked} ne 'Y');`
		786	`# next if ( $entry->{buildType} eq 'M' );`
		787
		788	`Verbose2("Quarantine:$pvid, $pkgName, $pkgVersion, Age:$mtime, Lock:$entry->{locked}, Patch:$entry->{isPatch}, BS:$entry->{buildStandard}, BT:$entry->{buildType}");`
		789	`quarantineItem( 'Q', $mtime, join('/', $config{dpkg_archive}, $pkgName, $pkgVersion ) );`
		790	`}`
		791	`}`
		792	`}`
		793
		794	`#`
		795	`# Perform the quarantine`
		796	`#`
		797	`doQuarantine();`
		798	`ErrorDoExit();`
		799	`}`
		800
		801	`#-------------------------------------------------------------------------------`
		802	`# Function : reportMissingPkgs`
		803	`#`
		804	`# Description : Report packages that 'should' be in dpkg_archive because`
		805	`# they are essential, but are not`
		806	`#`
		807	`# Inputs :`
		808	`#`
		809	`# Returns :`
		810	`#`
		811	`sub reportMissingPkgs`
		812	`{`
		813	`return;`
		814
		815	`#`
		816	`# Not very useful as there is too much information`
		817	`# It would appear that the quarantine process may have also`
		818	`# been deleting packages from 'closed' as well as 'archived'`
		819	`# releases at some stage.`
		820	`#`
		821	`# Report packages used in not-archived or not-closed releases`
		822	`#`
		823	`my @missing;`
		824	`foreach my $pvid (keys %Packages )`
		825	`{`
		826	`my $entry = $Packages{$pvid};`
		827	`next unless ( exists $entry->{tlp} );`
		828	`# next unless ( exists $entry->{slp} );`
		829	`next if ( $entry->{dpkg_archive} );`
		830	`next unless ( exists $entry->{name} );`
		831
		832	`#`
		833	`# Missing package`
		834	`# Determine if its in use by an active release`
		835	`#`
		836
		837	`my @releases = usedBy($pvid);`
		838	`foreach my $release (@releases )`
		839	`{`
		840	`next if ( $Releases{$release}{official} eq 'Y' );`
		841	`next if ( $Releases{$release}{official} eq 'A' );`
		842	`push @missing, $entry->{name} . ' ' . $entry->{version} . " ($pvid)";`
		843	`last;`
		844	`}`
		845	`}`
		846
		847	`Warning ("Packages required by active releases that are not in dpkg_archive", sort @missing);`
		848	`}`
		849
		850	`#-------------------------------------------------------------------------------`
		851	`# Function : usedBy`
		852	`#`
		853	`# Description : Given a pvid, determine which release(s) need it`
		854	`#`
		855	`# Inputs : $pvid`
		856	`#`
		857	`# Returns : Nothing`
		858	`#`
		859	`sub usedBy`
		860	`{`
		861	`my ($pvid) = @_;`
		862	`my %seen;`
		863
		864	`Error ("PVID is not an essential package") unless ( exists $Packages{$pvid} );`
		865
		866	`my @releases = @{$Packages{$pvid}{'release'}} if exists($Packages{$pvid}{'release'});`
		867	`my @users = @{$Packages{$pvid}{'usedBy'}} if exists($Packages{$pvid}{'usedBy'});`
		868
		869	`while ( @users )`
		870	`{`
		871	`my $pv = pop @users;`
		872
		873	`next if ( exists $seen{$pv} );`
		874	`$seen{$pv} = 1;`
		875
		876	`push @releases, @{$Packages{$pv}{'release'}} if (exists $Packages{$pv}{'release'});`
		877	`push @users, @{$Packages{$pv}{'usedBy'}} if (exists($Packages{$pv}{'usedBy'}));`
		878	`}`
		879	`return @releases;`
		880	`}`
		881
		882	`#-------------------------------------------------------------------------------`
		883	`# Function : quarantineItem`
		884	`#`
		885	`# Description : Add item to the list of stuff to be quarantined`
		886	`#`
		887	`# Inputs : $reason - Reason`
		888	`# $age - Age`
		889	`# $path - Path`
		890	`#`
		891	`# Returns :`
		892	`#`
		893	`sub quarantineItem`
		894	`{`
		895	`my ($reason, $age, $path ) = @_;`
		896	`my %data;`
		897	`$data{reason} = $reason;`
		898	`$data{age} = $age;`
		899	`$data{path} = $path;`
		900
		901	`push @quarantineItems, \%data;`
		902	`}`
		903
		904	`#-------------------------------------------------------------------------------`
		905	`# Function : doQuarantine`
		906	`#`
		907	`# Description : Quarantine files and folders that have been queued up`
		908	`#`
		909	`# Inputs : None`
		910	`#`
		911	`# Returns :`
		912	`#`
		913	`sub doQuarantine`
		914	`{`
		915	`my $testMsg = $opt_test ? 'Test,' : '';`
4093	dpurdie	916
		917	`# Process entries - oldest first`
		918	`#`
4127	dpurdie	919	`my $countRemain = ( scalar @quarantineItems );`
4093	dpurdie	920	`foreach my $entry (sort {$b->{age} <=> $a->{age} } @quarantineItems)`
3410	dpurdie	921	`{`
		922	`my $rv;`
		923	`my $emsg = ' - with error';`
		924
		925	`my $path = $entry->{path};`
		926	`my $tpath = $path;`
		927	`$tpath =~ s~^$config{dpkg_archive}~~;`
		928	`$tpath = $quarantineInstance.$tpath;`
		929	`my $tdir = dirname ( $tpath );`
		930
		931	`unless ( $opt_test )`
		932	`{`
4542	dpurdie	933	`#`
		934	`# Transfer to Amazon S3 storage first`
		935	`# The transfer is done via an external program (script)`
		936	`# The transfer will tar-zip the packageVersion`
		937	`#`
		938	`{`
		939	`my $s3msg = "";`
		940	`my $pv = $path;`
		941
		942	`#`
		943	`# Export the Secrets in EnvVars`
		944	`# Use program defaults so that we don't need to specify them`
		945	`# on the command line - for all to see`
		946	`#`
		947	`$ENV{AWSKEY} = $config{S3Key};`
		948	`$ENV{AWSSECRET} = $config{S3Secret};`
		949
		950	`$rv = system ( "$progBase/savePkgToS3.sh", "--bucket=$config{S3Bucket}" ,"--path=$path" );`
		951	`if ( $rv )`
		952	`{`
		953	`ReportError ("Move $path to S3");`
		954	`$s3msg = ' - with S3 error';`
		955	`}`
		956	`Log (sprintf("S3Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $s3msg));`
		957	`}`
		958
		959	`#`
		960	`# Transfer then delete to local directory`
		961	`#`
3410	dpurdie	962	`unless (-d $tdir)`
		963	`{`
		964	`eval { mkpath($tdir) };`
		965	`ReportError ("Did not create quarantine target: $tdir")`
		966	`unless (-d $tdir);`
		967	`}`
		968
		969	`if (-d $tdir)`
		970	`{`
		971	`$rv = system ('mv', '-n', $path, $tdir);`
		972	`if ( $rv )`
		973	`{`
		974	`ReportError ("Move $path to $tdir");`
		975	`#`
		976	`# Clean up what may have been moved`
		977	`# NOTE: deleted so that we don't loose stuff if it gets ugly`
		978	`# rmtree( $tpath);`
		979	`# rmdir ($tdir);`
		980	`}`
		981	`else`
		982	`{`
		983	`$emsg = '';`
		984	`}`
		985	`}`
		986	`}`
		987	`else`
		988	`{`
		989	`Verbose2("Test: 'mv', '$path', '$tdir'");`
		990	`$emsg = '';`
		991	`}`
		992
		993	`# Log operation with frills`
		994	`Log (sprintf("Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $emsg));`
4093	dpurdie	995
		996	`# Limit packages quarantined`
4127	dpurdie	997	`$countRemain--;`
4093	dpurdie	998	`if ($opt_pcount > 0)`
		999	`{`
		1000	`$opt_pcount--;`
		1001	`if ($opt_pcount == 0)`
		1002	`{`
4127	dpurdie	1003	`Log ("Quarantine package count exceeded. Quarantine terminated. $countRemain packages remaining");`
4093	dpurdie	1004	`last;`
		1005	`}`
		1006	`}`
3410	dpurdie	1007	`}`
		1008	`}`
		1009
		1010	`#-------------------------------------------------------------------------------`
		1011	`# Function : Log`
		1012	`#`
		1013	`# Description : Log a string`
		1014	`#`
		1015	`# Inputs : Line to log`
		1016	`#`
		1017	`# Returns :`
		1018	`#`
		1019	`sub Log`
		1020	`{`
		1021	`my ($line) = @_;`
4093	dpurdie	1022	`Verbose("Log: " . $line);`
3410	dpurdie	1023
		1024	`if (open ( LF, '+>>', $logPath ) )`
		1025	`{`
		1026	`print LF $line . "\n";`
		1027	`close LF;`
		1028	`}`
		1029	`}`
		1030
		1031	`#-------------------------------------------------------------------------------`
		1032	`# Function : readInputData`
		1033	`#`
		1034	`# Description : Write out data in a form to allow post processing`
		1035	`#`
		1036	`# Inputs :`
		1037	`#`
		1038	`# Returns :`
		1039	`#`
		1040	`sub readInputData`
		1041	`{`
		1042	`unless ( keys(%Packages) > 0 )`
		1043	`{`
		1044	`my $fname = "quarantine.raw.txt";`
		1045	`Verbose ("Reading: $fname");`
		1046	`Error "Cannot locate $fname" unless ( -f $fname );`
		1047	`require $fname;`
		1048
		1049	`Error "Data in $fname is not valid\n"`
		1050	`unless ( keys(%Packages) > 0 );`
		1051	`}`
		1052
		1053	`#`
		1054	`# Create a lookup from package name/version to pvid`
		1055	`#`
		1056	`Verbose ("Create PackageVersion to PVID hash");`
		1057	`foreach my $pvid ( keys %Packages )`
		1058	`{`
		1059	`my $name = $Packages{$pvid}{name};`
		1060	`my $version = $Packages{$pvid}{version};`
		1061	`if ( $name && $version )`
		1062	`{`
		1063	`$pkgPvid{$name}{$version}{pvid} = $pvid;`
		1064	`}`
		1065	`}`
		1066	`}`
		1067
		1068	`#-------------------------------------------------------------------------------`
		1069	`# Documentation`
		1070	`#`
		1071
		1072	`=pod`
		1073
		1074	`=for htmltoc SYSUTIL::`
		1075
		1076	`=head1 NAME`
		1077
		1078	`jats_quarantine - Determine packages to be quarantined`
		1079
		1080	`=head1 SYNOPSIS`
		1081
		1082	`jats jats_quarantine [options]`
		1083
		1084	`Options:`
		1085	`-help - brief help message`
		1086	`-help -help - Detailed help message`
		1087	`-man - Full documentation`
		1088	`-verbose[=n] - Control output`
		1089	`-phase=nn - Perform named phases`
4092	dpurdie	1090	`-purge - Just purge the old quarantined files`
3410	dpurdie	1091	`-test - Do not delete files`
		1092	`-limit=n - Limit packages processed. Test only`
4093	dpurdie	1093	`-pcount=n - Limit package count`
3410	dpurdie	1094
		1095	`=head1 OPTIONS`
		1096
		1097	`=over 8`
		1098
		1099	`=item B<-help>`
		1100
		1101	`Print a brief help message and exits.`
		1102
		1103	`=item B<-help -help>`
		1104
		1105	`Print a detailed help message with an explanation for each option.`
		1106
		1107	`=item B<-man>`
		1108
		1109	`Prints the manual page and exits.`
		1110
		1111	`=item B<-verbose[=n]>`
		1112
		1113	`This option control the programs output. Normally this program will not generate`
		1114	`any output. It will only generate output on error conditions. This is intentional`
		1115	`as the program will be run as a cron-job and output errors will be mailed out.`
		1116
		1117	`A verbose level of 1. will display progress information`
		1118
		1119	`A verbose level of 3. will display detailed tracing of all operations`
		1120
		1121	`=item B<-phase=list>`
		1122
		1123	`This option will limit the work done by the program. There are two phases`
		1124	`called: 1 and 2.`
		1125
		1126	`Phase-1 will examine Release Manager collect package-version information.`
		1127	`Phase-2 will examine dpkg_archive and collect package-version information. It`
		1128	`will then initiate the quarantine operation.`
		1129
		1130	`The default operation is to perform phase-1 and phase-2.`
		1131
		1132	`If only phase-1 is specified then the RM data is saved, to be used by a`
		1133	`later phase.`
		1134
		1135	`If only phase-2 is specified then saved RM data is restored.`
		1136
		1137	`This option can simplify testing.`
		1138
4092	dpurdie	1139	`=item B<-purge>`
		1140
		1141	`This option will only purge the old quarantine directories. It will not quarantine new`
		1142	`package versions.`
		1143
3410	dpurdie	1144	`=item B<-test>`
		1145
		1146	`Do not delete or move files and directories. Report what would have been done.`
		1147
		1148	`=item B<-limit=n>`
		1149
		1150	`Limit the number of packages processed by the tool. This is only used to`
		1151	`simplify testing of the program`
		1152
		1153	`=back`
		1154
		1155	`=head1 DESCRIPTION`
		1156
		1157	`This program is a tool used in the maintainance of dpkg_archive.`
		1158	`It will:`
		1159
		1160	`=over 8`
		1161
		1162	`=item *`
		1163
		1164	`Determine package-versions in use by Release Manager.`
		1165
		1166	`=item *`
		1167
		1168	`Determine package-versions that can be rebuilt`
		1169
		1170	`=item *`
		1171
		1172	`Recursively find all the dependent packages of all packages. New package`
		1173	`versions are called 'indirect' dependencies. They are buried. This process can`
		1174	`take several minutes.`
		1175
		1176	`=back`
		1177
		1178	`The data collected is dumped into a text file for later processing.`
		1179
		1180	`=cut`
		1181

Subversion Repositories DevTools

(root)/dpkg_management/trunk/src/sbin/jats_quarantine.pl – Rev 4542