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

Subversion Repositories DevTools

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