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

Subversion Repositories DevTools

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