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 '..' );`
4646	dpurdie	725	`next if ( $pkgVersion eq 'latest' ); # Keep latest (often symlink for build system)`
		726
3410	dpurdie	727	`my $pkgPath = join('/', $config{dpkg_archive}, $pkgName,$pkgVersion );`
		728	`my $mtime = checkTime($pkgPath);`
		729
		730	`my $pvid;`
		731	`if ( exists ($pkgPvid{$pkgName}) && exists($pkgPvid{$pkgName}{$pkgVersion} ) )`
		732	`{`
		733	`$pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};`
		734	`$Packages{$pvid}{dpkg_archive} = 1;`
		735	`$pkgPvid{$pkgName}{$pkgVersion}{mtime} = $mtime;`
		736	`}`
		737	`else`
		738	`{`
		739	`#`
		740	`# Package is in dpkg-archive, but not in Release`
		741	`# Manager. Allow for a short while`
		742	`#`
		743	`if ( $mtime > $config{retainNoRm} )`
		744	`{`
		745	`#Log("Package not in RM: $pkgName, $pkgVersion, Age: $mtime");`
		746	`quarantineItem( 'X', $mtime, $pkgPath );`
		747	`}`
		748	`}`
		749
		750	`#Message("$pkgName, $pkgVersion, $pkgPvid{$pkgName}{$pkgVersion}{mtime}");`
		751	`}`
		752	`close(PV);`
		753	`}`
		754	`}`
		755	`elsif ( -f $pkgDir )`
		756	`{`
		757	`Warning("Unexpected file in dpkg_archive: $pkgName");`
		758	`Log("Unexpected file in dpkg_archive: $pkgName");`
		759	`quarantineItem( 'F', -1, $pkgDir );`
		760	`}`
		761	`else`
		762	`{`
		763	`Warning("Unexpected entry in dpkg_archive: $pkgName");`
		764	`}`
		765	`}`
		766	`close(PKGS);`
		767
		768
		769	`#`
		770	`#`
		771	`# Display information`
		772	`#`
		773	`foreach my $pkgName ( sort keys %pkgPvid )`
		774	`{`
		775	`foreach my $pkgVersion ( sort keys %{$pkgPvid{$pkgName}} )`
		776	`{`
		777	`my $mtime = $pkgPvid{$pkgName}{$pkgVersion}{mtime} \|\| 0;`
		778	`my $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};`
		779
		780	`if ( $pvid && $mtime )`
		781	`{`
		782	`my $entry = $Packages{$pvid};`
		783	`next if ( exists $entry->{tlp} \|\| exists $entry->{slp} );`
		784	`next if ( $mtime <= $config{retain} );`
		785	`next unless ( $entry->{buildStandard} );`
		786	`next if ( $entry->{isPatch} );`
		787	`next if ( $entry->{locked} ne 'Y');`
		788	`# next if ( $entry->{buildType} eq 'M' );`
		789
		790	`Verbose2("Quarantine:$pvid, $pkgName, $pkgVersion, Age:$mtime, Lock:$entry->{locked}, Patch:$entry->{isPatch}, BS:$entry->{buildStandard}, BT:$entry->{buildType}");`
		791	`quarantineItem( 'Q', $mtime, join('/', $config{dpkg_archive}, $pkgName, $pkgVersion ) );`
		792	`}`
		793	`}`
		794	`}`
		795
		796	`#`
		797	`# Perform the quarantine`
		798	`#`
		799	`doQuarantine();`
		800	`ErrorDoExit();`
		801	`}`
		802
		803	`#-------------------------------------------------------------------------------`
		804	`# Function : reportMissingPkgs`
		805	`#`
		806	`# Description : Report packages that 'should' be in dpkg_archive because`
		807	`# they are essential, but are not`
		808	`#`
		809	`# Inputs :`
		810	`#`
		811	`# Returns :`
		812	`#`
		813	`sub reportMissingPkgs`
		814	`{`
		815	`return;`
		816
		817	`#`
		818	`# Not very useful as there is too much information`
		819	`# It would appear that the quarantine process may have also`
		820	`# been deleting packages from 'closed' as well as 'archived'`
		821	`# releases at some stage.`
		822	`#`
		823	`# Report packages used in not-archived or not-closed releases`
		824	`#`
		825	`my @missing;`
		826	`foreach my $pvid (keys %Packages )`
		827	`{`
		828	`my $entry = $Packages{$pvid};`
		829	`next unless ( exists $entry->{tlp} );`
		830	`# next unless ( exists $entry->{slp} );`
		831	`next if ( $entry->{dpkg_archive} );`
		832	`next unless ( exists $entry->{name} );`
		833
		834	`#`
		835	`# Missing package`
		836	`# Determine if its in use by an active release`
		837	`#`
		838
		839	`my @releases = usedBy($pvid);`
		840	`foreach my $release (@releases )`
		841	`{`
		842	`next if ( $Releases{$release}{official} eq 'Y' );`
		843	`next if ( $Releases{$release}{official} eq 'A' );`
		844	`push @missing, $entry->{name} . ' ' . $entry->{version} . " ($pvid)";`
		845	`last;`
		846	`}`
		847	`}`
		848
		849	`Warning ("Packages required by active releases that are not in dpkg_archive", sort @missing);`
		850	`}`
		851
		852	`#-------------------------------------------------------------------------------`
		853	`# Function : usedBy`
		854	`#`
		855	`# Description : Given a pvid, determine which release(s) need it`
		856	`#`
		857	`# Inputs : $pvid`
		858	`#`
		859	`# Returns : Nothing`
		860	`#`
		861	`sub usedBy`
		862	`{`
		863	`my ($pvid) = @_;`
		864	`my %seen;`
		865
		866	`Error ("PVID is not an essential package") unless ( exists $Packages{$pvid} );`
		867
		868	`my @releases = @{$Packages{$pvid}{'release'}} if exists($Packages{$pvid}{'release'});`
		869	`my @users = @{$Packages{$pvid}{'usedBy'}} if exists($Packages{$pvid}{'usedBy'});`
		870
		871	`while ( @users )`
		872	`{`
		873	`my $pv = pop @users;`
		874
		875	`next if ( exists $seen{$pv} );`
		876	`$seen{$pv} = 1;`
		877
		878	`push @releases, @{$Packages{$pv}{'release'}} if (exists $Packages{$pv}{'release'});`
		879	`push @users, @{$Packages{$pv}{'usedBy'}} if (exists($Packages{$pv}{'usedBy'}));`
		880	`}`
		881	`return @releases;`
		882	`}`
		883
		884	`#-------------------------------------------------------------------------------`
		885	`# Function : quarantineItem`
		886	`#`
		887	`# Description : Add item to the list of stuff to be quarantined`
		888	`#`
		889	`# Inputs : $reason - Reason`
		890	`# $age - Age`
		891	`# $path - Path`
		892	`#`
		893	`# Returns :`
		894	`#`
		895	`sub quarantineItem`
		896	`{`
		897	`my ($reason, $age, $path ) = @_;`
		898	`my %data;`
		899	`$data{reason} = $reason;`
		900	`$data{age} = $age;`
		901	`$data{path} = $path;`
		902
		903	`push @quarantineItems, \%data;`
		904	`}`
		905
		906	`#-------------------------------------------------------------------------------`
		907	`# Function : doQuarantine`
		908	`#`
		909	`# Description : Quarantine files and folders that have been queued up`
		910	`#`
		911	`# Inputs : None`
		912	`#`
		913	`# Returns :`
		914	`#`
		915	`sub doQuarantine`
		916	`{`
		917	`my $testMsg = $opt_test ? 'Test,' : '';`
4093	dpurdie	918
		919	`# Process entries - oldest first`
		920	`#`
4127	dpurdie	921	`my $countRemain = ( scalar @quarantineItems );`
4093	dpurdie	922	`foreach my $entry (sort {$b->{age} <=> $a->{age} } @quarantineItems)`
3410	dpurdie	923	`{`
		924	`my $rv;`
		925	`my $emsg = ' - with error';`
		926
		927	`my $path = $entry->{path};`
		928	`my $tpath = $path;`
		929	`$tpath =~ s~^$config{dpkg_archive}~~;`
		930	`$tpath = $quarantineInstance.$tpath;`
		931	`my $tdir = dirname ( $tpath );`
		932
		933	`unless ( $opt_test )`
		934	`{`
4542	dpurdie	935	`#`
		936	`# Transfer to Amazon S3 storage first`
		937	`# The transfer is done via an external program (script)`
		938	`# The transfer will tar-zip the packageVersion`
		939	`#`
		940	`{`
		941	`my $s3msg = "";`
		942	`my $pv = $path;`
		943
		944	`#`
		945	`# Export the Secrets in EnvVars`
		946	`# Use program defaults so that we don't need to specify them`
		947	`# on the command line - for all to see`
		948	`#`
		949	`$ENV{AWSKEY} = $config{S3Key};`
		950	`$ENV{AWSSECRET} = $config{S3Secret};`
		951
		952	`$rv = system ( "$progBase/savePkgToS3.sh", "--bucket=$config{S3Bucket}" ,"--path=$path" );`
		953	`if ( $rv )`
		954	`{`
		955	`ReportError ("Move $path to S3");`
		956	`$s3msg = ' - with S3 error';`
		957	`}`
		958	`Log (sprintf("S3Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $s3msg));`
		959	`}`
		960
		961	`#`
		962	`# Transfer then delete to local directory`
		963	`#`
3410	dpurdie	964	`unless (-d $tdir)`
		965	`{`
		966	`eval { mkpath($tdir) };`
		967	`ReportError ("Did not create quarantine target: $tdir")`
		968	`unless (-d $tdir);`
		969	`}`
		970
		971	`if (-d $tdir)`
		972	`{`
		973	`$rv = system ('mv', '-n', $path, $tdir);`
		974	`if ( $rv )`
		975	`{`
		976	`ReportError ("Move $path to $tdir");`
		977	`#`
		978	`# Clean up what may have been moved`
		979	`# NOTE: deleted so that we don't loose stuff if it gets ugly`
		980	`# rmtree( $tpath);`
		981	`# rmdir ($tdir);`
		982	`}`
		983	`else`
		984	`{`
		985	`$emsg = '';`
		986	`}`
		987	`}`
		988	`}`
		989	`else`
		990	`{`
		991	`Verbose2("Test: 'mv', '$path', '$tdir'");`
		992	`$emsg = '';`
		993	`}`
		994
		995	`# Log operation with frills`
		996	`Log (sprintf("Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $emsg));`
4093	dpurdie	997
		998	`# Limit packages quarantined`
4127	dpurdie	999	`$countRemain--;`
4093	dpurdie	1000	`if ($opt_pcount > 0)`
		1001	`{`
		1002	`$opt_pcount--;`
		1003	`if ($opt_pcount == 0)`
		1004	`{`
4127	dpurdie	1005	`Log ("Quarantine package count exceeded. Quarantine terminated. $countRemain packages remaining");`
4093	dpurdie	1006	`last;`
		1007	`}`
		1008	`}`
3410	dpurdie	1009	`}`
		1010	`}`
		1011
		1012	`#-------------------------------------------------------------------------------`
		1013	`# Function : Log`
		1014	`#`
		1015	`# Description : Log a string`
		1016	`#`
		1017	`# Inputs : Line to log`
		1018	`#`
		1019	`# Returns :`
		1020	`#`
		1021	`sub Log`
		1022	`{`
		1023	`my ($line) = @_;`
4093	dpurdie	1024	`Verbose("Log: " . $line);`
3410	dpurdie	1025
		1026	`if (open ( LF, '+>>', $logPath ) )`
		1027	`{`
		1028	`print LF $line . "\n";`
		1029	`close LF;`
		1030	`}`
		1031	`}`
		1032
		1033	`#-------------------------------------------------------------------------------`
		1034	`# Function : readInputData`
		1035	`#`
		1036	`# Description : Write out data in a form to allow post processing`
		1037	`#`
		1038	`# Inputs :`
		1039	`#`
		1040	`# Returns :`
		1041	`#`
		1042	`sub readInputData`
		1043	`{`
		1044	`unless ( keys(%Packages) > 0 )`
		1045	`{`
		1046	`my $fname = "quarantine.raw.txt";`
		1047	`Verbose ("Reading: $fname");`
		1048	`Error "Cannot locate $fname" unless ( -f $fname );`
		1049	`require $fname;`
		1050
		1051	`Error "Data in $fname is not valid\n"`
		1052	`unless ( keys(%Packages) > 0 );`
		1053	`}`
		1054
		1055	`#`
		1056	`# Create a lookup from package name/version to pvid`
		1057	`#`
		1058	`Verbose ("Create PackageVersion to PVID hash");`
		1059	`foreach my $pvid ( keys %Packages )`
		1060	`{`
		1061	`my $name = $Packages{$pvid}{name};`
		1062	`my $version = $Packages{$pvid}{version};`
		1063	`if ( $name && $version )`
		1064	`{`
		1065	`$pkgPvid{$name}{$version}{pvid} = $pvid;`
		1066	`}`
		1067	`}`
		1068	`}`
		1069
		1070	`#-------------------------------------------------------------------------------`
		1071	`# Documentation`
		1072	`#`
		1073
		1074	`=pod`
		1075
		1076	`=for htmltoc SYSUTIL::`
		1077
		1078	`=head1 NAME`
		1079
		1080	`jats_quarantine - Determine packages to be quarantined`
		1081
		1082	`=head1 SYNOPSIS`
		1083
		1084	`jats jats_quarantine [options]`
		1085
		1086	`Options:`
		1087	`-help - brief help message`
		1088	`-help -help - Detailed help message`
		1089	`-man - Full documentation`
		1090	`-verbose[=n] - Control output`
		1091	`-phase=nn - Perform named phases`
4092	dpurdie	1092	`-purge - Just purge the old quarantined files`
3410	dpurdie	1093	`-test - Do not delete files`
		1094	`-limit=n - Limit packages processed. Test only`
4093	dpurdie	1095	`-pcount=n - Limit package count`
3410	dpurdie	1096
		1097	`=head1 OPTIONS`
		1098
		1099	`=over 8`
		1100
		1101	`=item B<-help>`
		1102
		1103	`Print a brief help message and exits.`
		1104
		1105	`=item B<-help -help>`
		1106
		1107	`Print a detailed help message with an explanation for each option.`
		1108
		1109	`=item B<-man>`
		1110
		1111	`Prints the manual page and exits.`
		1112
		1113	`=item B<-verbose[=n]>`
		1114
		1115	`This option control the programs output. Normally this program will not generate`
		1116	`any output. It will only generate output on error conditions. This is intentional`
		1117	`as the program will be run as a cron-job and output errors will be mailed out.`
		1118
		1119	`A verbose level of 1. will display progress information`
		1120
		1121	`A verbose level of 3. will display detailed tracing of all operations`
		1122
		1123	`=item B<-phase=list>`
		1124
		1125	`This option will limit the work done by the program. There are two phases`
		1126	`called: 1 and 2.`
		1127
		1128	`Phase-1 will examine Release Manager collect package-version information.`
		1129	`Phase-2 will examine dpkg_archive and collect package-version information. It`
		1130	`will then initiate the quarantine operation.`
		1131
		1132	`The default operation is to perform phase-1 and phase-2.`
		1133
		1134	`If only phase-1 is specified then the RM data is saved, to be used by a`
		1135	`later phase.`
		1136
		1137	`If only phase-2 is specified then saved RM data is restored.`
		1138
		1139	`This option can simplify testing.`
		1140
4092	dpurdie	1141	`=item B<-purge>`
		1142
		1143	`This option will only purge the old quarantine directories. It will not quarantine new`
		1144	`package versions.`
		1145
3410	dpurdie	1146	`=item B<-test>`
		1147
		1148	`Do not delete or move files and directories. Report what would have been done.`
		1149
		1150	`=item B<-limit=n>`
		1151
		1152	`Limit the number of packages processed by the tool. This is only used to`
		1153	`simplify testing of the program`
		1154
		1155	`=back`
		1156
		1157	`=head1 DESCRIPTION`
		1158
		1159	`This program is a tool used in the maintainance of dpkg_archive.`
		1160	`It will:`
		1161
		1162	`=over 8`
		1163
		1164	`=item *`
		1165
		1166	`Determine package-versions in use by Release Manager.`
		1167
		1168	`=item *`
		1169
		1170	`Determine package-versions that can be rebuilt`
		1171
		1172	`=item *`
		1173
		1174	`Recursively find all the dependent packages of all packages. New package`
		1175	`versions are called 'indirect' dependencies. They are buried. This process can`
		1176	`take several minutes.`
		1177
		1178	`=back`
		1179
		1180	`The data collected is dumped into a text file for later processing.`
		1181
		1182	`=cut`
		1183

Subversion Repositories DevTools

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