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

Subversion Repositories DevTools

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