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 =`
		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".`
5125	dpurdie	647	`" WHERE osc.os_id = os.os_id".`
		648	`" AND os.node_id = bc.node_id".`
		649	`" AND bc.bom_id IN".`
5609	dpurdie	650	`" (SELECT bom_id".`
		651	`" FROM".`
		652	`" (SELECT bs.bom_id, b.branch_id, state_id,".`
		653	`" RANK( ) OVER (PARTITION BY bs.state_id,b.branch_id ORDER BY bs.bom_id DESC) SRLNO".`
		654	`" FROM DEPLOYMENT_MANAGER.bom_state bs ,".`
		655	`" DEPLOYMENT_MANAGER.boms b".`
		656	`" WHERE bs.bom_id = b.bom_id".`
		657	`" )".`
		658	`" WHERE SRLNO <= 2".`
		659	`" )".`
5125	dpurdie	660	`" AND pd.PROD_ID (+) = osc.PROD_ID".`
		661	`" AND pv.pkg_id = pkg.pkg_id".`
		662	`" AND osc.prod_id = pv.pv_id".`
5609	dpurdie	663	`" ORDER BY UPPER(pkg.pkg_name), ".`
		664	`" UPPER(pv.PKG_VERSION)".`
5125	dpurdie	665	`$limit;`
		666
		667	`Verbose3("GetRecentDMPackages: $m_sqlstr");`
		668	`my $sth = $DM_DB->prepare($m_sqlstr);`
		669	`if ( defined($sth) )`
		670	`{`
		671	`if ( $sth->execute( ) )`
		672	`{`
		673	`if ( $sth->rows )`
		674	`{`
		675	`while ( @row = $sth->fetchrow_array )`
		676	`{`
		677	`$count++;`
		678	`print join (',',@row), "\n" if ($opt_verbose > 2);`
		679	`my $pvid = $row[0];`
		680	`$Packages{$pvid}{dm} = 1;`
		681	`unless ( exists $Packages{$pvid}{name} )`
		682	`{`
		683	`$Packages{$pvid}{name} = $row[1];`
		684	`$Packages{$pvid}{version} = $row[2];`
		685	`}`
		686	`push @StrayPackages, $pvid;`
		687
		688	`if ( $opt_limit )`
		689	`{`
		690	`last if ( $count > $opt_limit );`
		691	`}`
		692	`}`
		693	`}`
		694	`$sth->finish();`
		695	`}`
		696	`else`
		697	`{`
		698	`Error("GetRecentDMPackages:Execute failure: $m_sqlstr", $sth->errstr() );`
		699	`}`
		700	`}`
		701	`else`
		702	`{`
		703	`Error("GetRecentDMPackages:Prepare failure" );`
		704	`}`
		705
		706	`Verbose ("Extract Deployed Packages: $count rows");`
		707	`}`
		708
		709	`#-------------------------------------------------------------------------------`
3410	dpurdie	710	`# Function : GetDepends`
		711	`#`
		712	`# Description :`
		713	`#`
		714	`# Inputs : @plist - list of pvid's to process`
		715	`#`
		716	`# Returns :`
		717	`#`
		718	`sub GetDepends`
		719	`{`
		720	`my (@plist) = @_;`
		721
		722	`#`
		723	`# Now extract the package dependacies`
		724	`# There may not be any`
		725	`#`
		726	`my $m_sqlstr = "SELECT ".`
		727	`" pd.PV_ID, ".`
		728	`" pd.DPV_ID " .`
		729	`" FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd ".`
		730	`" WHERE pd.PV_ID in ( " . join(',', @plist) . " )";`
		731	`my $sth = $RM_DB->prepare($m_sqlstr);`
		732	`if ( defined($sth) )`
		733	`{`
		734	`if ( $sth->execute( ) )`
		735	`{`
		736	`if ( $sth->rows )`
		737	`{`
		738	`while ( my @row = $sth->fetchrow_array )`
		739	`{`
		740	`my $pvid = $row[0];`
		741	`my $dpvid = $row[1];`
		742	`push @StrayPackages, $dpvid;`
		743	`push @{$Packages{$dpvid}{usedBy}}, $pvid;`
3423	dpurdie	744	`$Packages{$dpvid}{slp} = 1 unless exists $Packages{$dpvid}{tlp};`
3410	dpurdie	745
		746	`print join (',','GetDepends',@row), "\n" if ($opt_verbose > 2);`
		747	`}`
		748	`}`
		749	`$sth->finish();`
		750	`}`
		751	`else`
		752	`{`
		753	`Error("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );`
		754	`}`
		755	`}`
		756	`else`
		757	`{`
		758	`Error("GetDepends:Prepare failure" );`
		759	`}`
		760	`}`
		761
		762	`#-------------------------------------------------------------------------------`
		763	`# Function : LocateStrays`
		764	`#`
		765	`# Description : Locate stray packages`
		766	`# Try to do several (200) at a time to speed up processing`
		767	`#`
		768	`# Inputs :`
		769	`#`
		770	`# Returns :`
		771	`#`
		772	`sub LocateStrays`
		773	`{`
		774	`Verbose ("Locate indirectly referenced packages");`
		775	`while ( $#StrayPackages >= 0 )`
		776	`{`
		777	`#print "Strays Remaining: ", scalar @StrayPackages ,"\n";`
		778
		779	`my @plist;`
		780	`while ( $#plist <= 200 && @StrayPackages )`
		781	`{`
		782	`my $pv_id = pop @StrayPackages;`
		783	`next if ( exists $Packages{$pv_id}{done} );`
		784	`push @plist, $pv_id;`
		785	`}`
		786
		787	`GetDepends(@plist) if @plist;`
		788
		789	`foreach ( @plist)`
		790	`{`
		791	`$Packages{$_}{done} = 1;`
		792	`}`
		793	`}`
		794	`}`
		795
		796	`#-------------------------------------------------------------------------------`
		797	`# Function : savePhaseData`
		798	`#`
		799	`# Description : Save inter-phase data`
		800	`#`
		801	`# Inputs :`
		802	`#`
		803	`# Returns :`
		804	`#`
		805	`sub savePhaseData`
		806	`{`
		807	`my $count = 0;`
		808	`my $direct = 0;`
		809	`my $indirect = 0;`
		810	`my $buildable = 0;`
		811	`my $bad = 0;`
5125	dpurdie	812	`my $sdk = 0;`
3410	dpurdie	813
		814	`foreach my $pvid ( keys %Packages )`
		815	`{`
		816	`my $entry = $Packages{$pvid};`
		817	`unless ( defined $entry->{name} && defined $entry->{version})`
		818	`{`
		819	`Warning ("Package Name or Version not known: $pvid");`
		820	`$bad++;`
		821	`next;`
		822	`}`
		823
		824	`$count++;`
		825	`if ( $entry->{locked} && $entry->{locked} eq 'Y' && $entry->{buildStandard} > 0 )`
		826	`{`
		827	`$buildable++;`
		828	`}`
		829
5125	dpurdie	830	`if ( $entry->{tlp} ) {`
		831	`$direct++;`
		832	`}`
		833	`elsif ( $entry->{slp} ) {`
		834	`$indirect++;`
		835	`}`
		836	`elsif ($entry->{sdk}) {`
		837	`$sdk++;`
		838	`}`
		839
3410	dpurdie	840	`}`
		841
		842	`my $file = "quarantine.raw.txt";`
		843	`Verbose ("Create: $file");`
		844	`my $fh = ConfigurationFile::New( $file );`
		845
		846	`$fh->DumpData(`
		847	`"\n# Package Data.\n#\n",`
		848	`"Packages", \%Packages );`
		849
		850	`$fh->DumpData(`
		851	`"\n# Release Data.\n#\n",`
		852	`"Releases", \%Releases );`
		853
		854	`$fh->Close();`
		855
5125	dpurdie	856	`Verbose("Packages: $count, Bad: $bad: Buildable: $buildable, Directly included: $direct, Indirect: $indirect, Sdk: $sdk");`
3410	dpurdie	857	`}`
		858
		859	`#-------------------------------------------------------------------------------`
		860	`# Function : prepQdir`
		861	`#`
		862	`# Description : Prepare the quarantine target directory`
		863	`# Setup logging`
		864	`#`
		865	`# Done at the start of the 2nd phase`
		866	`#`
		867	`# Inputs :`
		868	`#`
		869	`# Returns :`
		870	`#`
		871	`sub prepQdir`
		872	`{`
		873	`my ( $ss, $mm, $hh, $dd, $mo, $yy ) = ( localtime($now) )[0..5];`
		874	`my $stamp = sprintf("%4.4d%2.2d%2.2d_%2.2d%2.2d%2.2d", $yy+1900, $mo+1, $dd, $hh,$mm,$ss);`
		875
		876	`$quarantineInstance = join('/', $config{quarantine}, $stamp);`
		877
		878	`my $logName = 'quarantine_' . $stamp . '.txt';`
		879	`$logPath = join('/', $config{logBase}, $logName );`
		880	`eval { mkpath($config{logBase}) } unless -d $config{logBase};`
		881	`Error ("Log directory not found/created: $config{logBase}") unless -d $config{logBase};`
		882
		883	`#`
		884	`# Start the log file`
		885	`Log ("TEST Mode Enabled") if $opt_test;`
		886	`Log ("QuarantinePath: $quarantineInstance");`
3423	dpurdie	887	`Log ("Config: $_ = $config{$_}") foreach ( sort keys %config );`
		888	`Log ("Ignore: $_") foreach ( sort keys %retainPkgs );`
3410	dpurdie	889
		890	`#`
		891	`# Create a 'nice' symlink to the latest log file`
		892	`my $logLatest = join('/', $config{logBase}, 'latest');`
		893	`unlink ( $logLatest );`
		894	`symlink( $logName, $logLatest);`
		895
		896	`#`
		897	`# Clean up old files`
		898	`#`
		899	`opendir( Q, $config{quarantine} ) \|\| Error ("opendir failed on: $config{quarantine}" );`
		900
		901	`# delete any quarantine instance older than 90 days`
		902	`while ( my $file = readdir( Q ) )`
		903	`{`
		904	`#`
		905	`# Skip housekeeping directory entries`
		906	`#`
		907	`next if ( $file eq '.' );`
		908	`next if ( $file eq '..' );`
		909	`next if ( $file eq 'lost+found' );`
		910
		911	`my $path = join( '/', $config{quarantine} . "/" . $file);`
		912	`my $age = checkTime( $path );`
		913	`if ( $age > $config{qdirAge} )`
		914	`{`
		915	`Log ("Old Quarantine Removed: $path");`
		916	`Verbose ("Test: Delete Dir: $path") if ( $opt_test );`
		917	`rmtree($path, 0, 1) unless $opt_test;`
		918	`}`
		919	`}`
		920
		921	`closedir( Q );`
		922	`}`
		923
		924	`#-------------------------------------------------------------------------------`
		925	`# Function : checkTime`
		926	`#`
		927	`# Description : Days since modification of a path`
		928	`#`
		929	`# Inputs : Path elements`
		930	`#`
		931	`# Returns : Days since midification`
		932	`#`
		933
		934	`sub checkTime`
		935	`{`
		936	`my ($path) = @_;`
		937	`my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,`
		938	`$atime,$mtime,$ctime,$blksize,$blocks) = stat($path);`
		939
4127	dpurdie	940	`unless(defined $mtime)`
		941	`{`
		942	`Warning("Bad stat for $path");`
		943	`$mtime = 0;`
		944	`}`
		945
3410	dpurdie	946	`return int( ($now - $mtime) / (60 * 60 * 24));`
		947	`}`
		948
		949	`#-------------------------------------------------------------------------------`
		950	`# Function : processDpkgArchive`
		951	`#`
		952	`# Description : Scan dpkg_archive`
		953	`#`
		954	`# Inputs :`
		955	`#`
		956	`# Returns :`
		957	`#`
		958	`sub processDpkgArchive`
		959	`{`
		960	`Verbose ("Scanning dpkg_archive");`
		961	`opendir( PKGS, $config{dpkg_archive} ) \|\| Error ("Cannot open dpkg_archive");`
		962	`while ( my $pkgName = readdir(PKGS) )`
		963	`{`
		964	`next if ( $pkgName eq '.' );`
		965	`next if ( $pkgName eq '..' );`
		966	`next if ( $pkgName eq 'lost+found' );`
		967	`next if ( exists $retainPkgs{$pkgName} );`
		968
		969	`my $pkgDir = join('/', $config{dpkg_archive}, $pkgName );`
		970	`if ( -d $pkgDir )`
		971	`{`
		972	`if (opendir (PV, $pkgDir ) )`
		973	`{`
		974
		975	`while ( my $pkgVersion = readdir(PV) )`
		976	`{`
		977	`next if ( $pkgVersion eq '.' );`
		978	`next if ( $pkgVersion eq '..' );`
4646	dpurdie	979	`next if ( $pkgVersion eq 'latest' ); # Keep latest (often symlink for build system)`
		980
3410	dpurdie	981	`my $pkgPath = join('/', $config{dpkg_archive}, $pkgName,$pkgVersion );`
		982	`my $mtime = checkTime($pkgPath);`
		983
		984	`my $pvid;`
		985	`if ( exists ($pkgPvid{$pkgName}) && exists($pkgPvid{$pkgName}{$pkgVersion} ) )`
		986	`{`
		987	`$pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};`
		988	`$Packages{$pvid}{dpkg_archive} = 1;`
		989	`$pkgPvid{$pkgName}{$pkgVersion}{mtime} = $mtime;`
		990	`}`
		991	`else`
		992	`{`
		993	`#`
		994	`# Package is in dpkg-archive, but not in Release`
		995	`# Manager. Allow for a short while`
		996	`#`
5534	dpurdie	997	`$statistics{TotalPackages}++;`
		998	`$statistics{'NotInReleaseManager'}++;`
3410	dpurdie	999	`if ( $mtime > $config{retainNoRm} )`
		1000	`{`
		1001	`#Log("Package not in RM: $pkgName, $pkgVersion, Age: $mtime");`
		1002	`quarantineItem( 'X', $mtime, $pkgPath );`
5534	dpurdie	1003	`$statistics{'Quarantine'}++;`
3410	dpurdie	1004	`}`
5534	dpurdie	1005
		1006	`if ($opt_explain)`
		1007	`{`
		1008	`Information("Reason:-, $pkgName, $pkgVersion, Reason:NotInReleaseManager");`
		1009	`}`
3410	dpurdie	1010	`}`
		1011
		1012	`#Message("$pkgName, $pkgVersion, $pkgPvid{$pkgName}{$pkgVersion}{mtime}");`
		1013	`}`
		1014	`close(PV);`
		1015	`}`
		1016	`}`
		1017	`elsif ( -f $pkgDir )`
		1018	`{`
		1019	`Warning("Unexpected file in dpkg_archive: $pkgName");`
		1020	`Log("Unexpected file in dpkg_archive: $pkgName");`
		1021	`quarantineItem( 'F', -1, $pkgDir );`
5534	dpurdie	1022	`$statistics{'fileNotInReleaseManager'}++;`
		1023	`$statistics{'Quarantine'}++;`
		1024	`$statistics{'NotInReleaseManager'}++;`
		1025
		1026	`if ($opt_explain)`
		1027	`{`
		1028	`Information("Reason:-, $pkgDir, -, Reason:fileNotInReleaseManager");`
		1029	`}`
3410	dpurdie	1030	`}`
		1031	`else`
		1032	`{`
		1033	`Warning("Unexpected entry in dpkg_archive: $pkgName");`
		1034	`}`
		1035	`}`
		1036	`close(PKGS);`
		1037
		1038
		1039	`#`
		1040	`#`
5125	dpurdie	1041	`# Scan all packages found in dpkg_archive and see if we should keep it`
		1042	`# Quarantine those we cannot find a reason to keep`
3410	dpurdie	1043	`#`
		1044	`foreach my $pkgName ( sort keys %pkgPvid )`
		1045	`{`
		1046	`foreach my $pkgVersion ( sort keys %{$pkgPvid{$pkgName}} )`
		1047	`{`
		1048	`my $mtime = $pkgPvid{$pkgName}{$pkgVersion}{mtime} \|\| 0;`
		1049	`my $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};`
5253	dpurdie	1050	`my $keepReason = '';`
		1051	`my $entry = $Packages{$pvid};`
3410	dpurdie	1052
		1053	`{`
5253	dpurdie	1054	`# Examine entry. Determine a reason to keep the package`
5534	dpurdie	1055	`# Some reasons to keep a package are no longer needed now that versions are pumped into S3`
3410	dpurdie	1056
5253	dpurdie	1057	`unless ($entry) { $keepReason ='NoPackageEntry'; last;}`
		1058	`unless ($entry->{dpkg_archive}) { $keepReason ='NotInArchive'; last;}`
		1059	`unless ($pvid) { $keepReason = 'NoPVid'; last;}`
5534	dpurdie	1060	`if (exists $entry->{tlp}) { $keepReason = 'TopLevelPackage'; last;}`
		1061	`if (exists $entry->{slp}) { $keepReason = 'SecondLevelPackage'; last;}`
		1062	`if (exists $entry->{sdk}) { $keepReason ='inSdk'; last;}`
		1063	`if (exists $entry->{dm}) { $keepReason = 'inDeploymentManager'; last;}`
		1064	`if ($entry->{isPatch}) { $keepReason = 'isPatch'; last;}`
		1065	`if ($mtime <= $config{retain}) { $keepReason ='RetainTime:' . ($config{retain} - $mtime); last;}`
		1066	`#unless ($entry->{buildStandard}) { $keepReason ='NoBuildStandard:' . $mtime; last;}`
5253	dpurdie	1067	`if ($entry->{locked} ne 'Y') { $keepReason ='NotLocked:' . $entry->{locked}; last;}`
		1068	`#if ($entry->{buildType} eq 'M') { $keepReason ='ManualBuild:' . $entry->{buildType}; last;}`
		1069
		1070	`$pkgPvid{$pkgName}{$pkgVersion}{keepReason} = $keepReason;`
		1071	`}`
		1072
		1073	`unless ( $keepReason )`
		1074	`{`
3410	dpurdie	1075	`Verbose2("Quarantine:$pvid, $pkgName, $pkgVersion, Age:$mtime, Lock:$entry->{locked}, Patch:$entry->{isPatch}, BS:$entry->{buildStandard}, BT:$entry->{buildType}");`
		1076	`quarantineItem( 'Q', $mtime, join('/', $config{dpkg_archive}, $pkgName, $pkgVersion ) );`
5534	dpurdie	1077	`$keepReason = 'Quarantine';`
3410	dpurdie	1078	`}`
5253	dpurdie	1079
		1080	`if ($opt_explain)`
		1081	`{`
		1082	`Information("Reason:$pvid, $pkgName, $pkgVersion, Reason:$keepReason");`
		1083	`}`
5534	dpurdie	1084
		1085	`#`
		1086	`# Maintain Stats`
		1087	`# Only use the Base Reason - remove details after the ':' character`
		1088	`#`
		1089	`my $sReason = $keepReason;`
		1090	`$sReason =~ s~:.*$~~;`
		1091	`$statistics{$sReason}++;`
		1092	`$statistics{TotalPackages}++;`
3410	dpurdie	1093	`}`
		1094	`}`
		1095
		1096	`#`
		1097	`# Perform the quarantine`
		1098	`#`
		1099	`doQuarantine();`
		1100	`ErrorDoExit();`
		1101	`}`
		1102
		1103	`#-------------------------------------------------------------------------------`
		1104	`# Function : reportMissingPkgs`
		1105	`#`
		1106	`# Description : Report packages that 'should' be in dpkg_archive because`
		1107	`# they are essential, but are not`
		1108	`#`
		1109	`# Inputs :`
		1110	`#`
		1111	`# Returns :`
		1112	`#`
		1113	`sub reportMissingPkgs`
		1114	`{`
		1115	`return;`
		1116
		1117	`#`
		1118	`# Not very useful as there is too much information`
		1119	`# It would appear that the quarantine process may have also`
		1120	`# been deleting packages from 'closed' as well as 'archived'`
		1121	`# releases at some stage.`
		1122	`#`
		1123	`# Report packages used in not-archived or not-closed releases`
		1124	`#`
		1125	`my @missing;`
		1126	`foreach my $pvid (keys %Packages )`
		1127	`{`
		1128	`my $entry = $Packages{$pvid};`
		1129	`next unless ( exists $entry->{tlp} );`
		1130	`# next unless ( exists $entry->{slp} );`
		1131	`next if ( $entry->{dpkg_archive} );`
		1132	`next unless ( exists $entry->{name} );`
		1133
		1134	`#`
		1135	`# Missing package`
		1136	`# Determine if its in use by an active release`
		1137	`#`
		1138
		1139	`my @releases = usedBy($pvid);`
		1140	`foreach my $release (@releases )`
		1141	`{`
		1142	`next if ( $Releases{$release}{official} eq 'Y' );`
		1143	`next if ( $Releases{$release}{official} eq 'A' );`
		1144	`push @missing, $entry->{name} . ' ' . $entry->{version} . " ($pvid)";`
		1145	`last;`
		1146	`}`
		1147	`}`
		1148
		1149	`Warning ("Packages required by active releases that are not in dpkg_archive", sort @missing);`
		1150	`}`
		1151
		1152	`#-------------------------------------------------------------------------------`
		1153	`# Function : usedBy`
		1154	`#`
		1155	`# Description : Given a pvid, determine which release(s) need it`
		1156	`#`
		1157	`# Inputs : $pvid`
		1158	`#`
		1159	`# Returns : Nothing`
		1160	`#`
		1161	`sub usedBy`
		1162	`{`
		1163	`my ($pvid) = @_;`
		1164	`my %seen;`
		1165
		1166	`Error ("PVID is not an essential package") unless ( exists $Packages{$pvid} );`
		1167
		1168	`my @releases = @{$Packages{$pvid}{'release'}} if exists($Packages{$pvid}{'release'});`
		1169	`my @users = @{$Packages{$pvid}{'usedBy'}} if exists($Packages{$pvid}{'usedBy'});`
		1170
		1171	`while ( @users )`
		1172	`{`
		1173	`my $pv = pop @users;`
		1174
		1175	`next if ( exists $seen{$pv} );`
		1176	`$seen{$pv} = 1;`
		1177
		1178	`push @releases, @{$Packages{$pv}{'release'}} if (exists $Packages{$pv}{'release'});`
		1179	`push @users, @{$Packages{$pv}{'usedBy'}} if (exists($Packages{$pv}{'usedBy'}));`
		1180	`}`
		1181	`return @releases;`
		1182	`}`
		1183
		1184	`#-------------------------------------------------------------------------------`
5534	dpurdie	1185	`# Function : reportStats`
		1186	`#`
		1187	`# Description : Report statistics`
		1188	`# Write statistics to a file`
		1189	`# Write to a tmp file, then rename.`
		1190	`# Attempt to make the operation atomic - so that the file consumer`
		1191	`# doesn't get a badly formed file.`
		1192	`#`
		1193	`#`
		1194	`# Inputs :`
		1195	`#`
		1196	`# Returns :`
		1197	`#`
		1198	`sub reportStats`
		1199	`{`
		1200	`#`
		1201	`# Time stamp the stats`
		1202	`#`
		1203	`$statistics{'timeStamp'} = time();`
		1204
		1205	`#`
		1206	`# Save stats to a known file for Nagios to use`
		1207	`#`
		1208	`my $statsfiletmp = join('/', $config{logBase}, 'quarantine.stats.tmp' );`
		1209	`my $statsfile = join('/', $config{logBase}, 'quarantine.stats');`
		1210
		1211	`my $fh;`
		1212	`unless (open ($fh, '>', $statsfiletmp))`
		1213	`{`
		1214	`$fh = undef;`
		1215	`Warning("Cannot create temp stats file: $!");`
		1216	`}`
		1217	`else`
		1218	`{`
		1219	`foreach my $key ( sort { lc($a) cmp lc($b) } keys %statistics)`
		1220	`{`
		1221	`print $fh $key . ':' . $statistics{$key} . "\n";`
		1222	`Log('Statistics: '. $key . ':' . $statistics{$key});`
		1223	`}`
		1224	`close $fh;`
		1225
		1226	`# Rename temp to real file`
		1227	`rename $statsfiletmp, $statsfile;`
		1228	`}`
		1229	`}`
		1230
		1231
		1232	`#-------------------------------------------------------------------------------`
3410	dpurdie	1233	`# Function : quarantineItem`
		1234	`#`
		1235	`# Description : Add item to the list of stuff to be quarantined`
		1236	`#`
		1237	`# Inputs : $reason - Reason`
		1238	`# $age - Age`
		1239	`# $path - Path`
		1240	`#`
		1241	`# Returns :`
		1242	`#`
		1243	`sub quarantineItem`
		1244	`{`
		1245	`my ($reason, $age, $path ) = @_;`
		1246	`my %data;`
		1247	`$data{reason} = $reason;`
		1248	`$data{age} = $age;`
		1249	`$data{path} = $path;`
		1250
		1251	`push @quarantineItems, \%data;`
		1252	`}`
		1253
		1254	`#-------------------------------------------------------------------------------`
		1255	`# Function : doQuarantine`
		1256	`#`
		1257	`# Description : Quarantine files and folders that have been queued up`
		1258	`#`
		1259	`# Inputs : None`
		1260	`#`
		1261	`# Returns :`
		1262	`#`
		1263	`sub doQuarantine`
		1264	`{`
		1265	`my $testMsg = $opt_test ? 'Test,' : '';`
4093	dpurdie	1266
		1267	`# Process entries - oldest first`
		1268	`#`
4127	dpurdie	1269	`my $countRemain = ( scalar @quarantineItems );`
4093	dpurdie	1270	`foreach my $entry (sort {$b->{age} <=> $a->{age} } @quarantineItems)`
3410	dpurdie	1271	`{`
		1272	`my $rv;`
		1273	`my $emsg = ' - with error';`
5272	dpurdie	1274	`my $s3error = 0;`
3410	dpurdie	1275
		1276	`my $path = $entry->{path};`
		1277	`my $tpath = $path;`
		1278	`$tpath =~ s~^$config{dpkg_archive}~~;`
		1279	`$tpath = $quarantineInstance.$tpath;`
		1280	`my $tdir = dirname ( $tpath );`
		1281
		1282	`unless ( $opt_test )`
		1283	`{`
4542	dpurdie	1284	`#`
		1285	`# Transfer to Amazon S3 storage first`
		1286	`# The transfer is done via an external program (script)`
		1287	`# The transfer will tar-zip the packageVersion`
		1288	`#`
		1289	`{`
		1290	`my $s3msg = "";`
		1291	`my $pv = $path;`
		1292
		1293	`#`
		1294	`# Export the Secrets in EnvVars`
		1295	`# Use program defaults so that we don't need to specify them`
		1296	`# on the command line - for all to see`
		1297	`#`
		1298	`$ENV{AWSKEY} = $config{S3Key};`
		1299	`$ENV{AWSSECRET} = $config{S3Secret};`
		1300
		1301	`$rv = system ( "$progBase/savePkgToS3.sh", "--bucket=$config{S3Bucket}" ,"--path=$path" );`
		1302	`if ( $rv )`
		1303	`{`
		1304	`ReportError ("Move $path to S3");`
		1305	`$s3msg = ' - with S3 error';`
5272	dpurdie	1306	`$s3error = 1;`
		1307	`$emsg = ' - S3 Error prevented quarantine';`
5534	dpurdie	1308	`$statistics{'S3TransferError'}++;`
		1309
4542	dpurdie	1310	`}`
		1311	`Log (sprintf("S3Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $s3msg));`
		1312	`}`
		1313
5272	dpurdie	1314	`unless ($s3error)`
3410	dpurdie	1315	`{`
6104	dpurdie	1316	`if ($config{qdirAge} <= 0)`
3410	dpurdie	1317	`{`
6104	dpurdie	1318	`#`
		1319	`# Just delete the package-version`
		1320	`#`
		1321	`rmtree( $path);`
		1322	`if (-d $path)`
5272	dpurdie	1323	`{`
6104	dpurdie	1324	`ReportError ("Deleting $path ");`
		1325	`$statistics{'QuarantineError'}++;`
		1326	`$emsg = ' - Delete error';`
5272	dpurdie	1327	`}`
		1328	`else`
		1329	`{`
		1330	`$emsg = '';`
		1331	`}`
3410	dpurdie	1332	`}`
6104	dpurdie	1333	`else`
		1334	`{`
		1335	`#`
		1336	`# Transfer then delete to local directory`
		1337	`#`
		1338	`unless (-d $tdir)`
		1339	`{`
		1340	`eval { mkpath($tdir) };`
		1341	`ReportError ("Did not create quarantine target: $tdir")`
		1342	`unless (-d $tdir);`
		1343	`}`
		1344
		1345	`if (-d $tdir)`
		1346	`{`
		1347	`$rv = system ('mv', '-n', $path, $tdir);`
		1348	`if ( $rv )`
		1349	`{`
		1350	`ReportError ("Move $path to $tdir");`
		1351	`$statistics{'QuarantineError'}++;`
		1352
		1353	`#`
		1354	`# Clean up what may have been moved`
		1355	`# NOTE: deleted so that we don't loose stuff if it gets ugly`
		1356	`# rmtree( $tpath);`
		1357	`# rmdir ($tdir);`
		1358	`}`
		1359	`else`
		1360	`{`
		1361	`$emsg = '';`
		1362	`}`
		1363	`}`
		1364	`}`
3410	dpurdie	1365	`}`
		1366	`}`
		1367	`else`
		1368	`{`
		1369	`Verbose2("Test: 'mv', '$path', '$tdir'");`
		1370	`$emsg = '';`
		1371	`}`
		1372
		1373	`# Log operation with frills`
		1374	`Log (sprintf("Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $emsg));`
4093	dpurdie	1375
		1376	`# Limit packages quarantined`
4127	dpurdie	1377	`$countRemain--;`
4093	dpurdie	1378	`if ($opt_pcount > 0)`
		1379	`{`
		1380	`$opt_pcount--;`
		1381	`if ($opt_pcount == 0)`
		1382	`{`
4127	dpurdie	1383	`Log ("Quarantine package count exceeded. Quarantine terminated. $countRemain packages remaining");`
4093	dpurdie	1384	`last;`
		1385	`}`
		1386	`}`
3410	dpurdie	1387	`}`
		1388	`}`
		1389
		1390	`#-------------------------------------------------------------------------------`
		1391	`# Function : Log`
		1392	`#`
		1393	`# Description : Log a string`
		1394	`#`
		1395	`# Inputs : Line to log`
		1396	`#`
		1397	`# Returns :`
		1398	`#`
		1399	`sub Log`
		1400	`{`
		1401	`my ($line) = @_;`
4093	dpurdie	1402	`Verbose("Log: " . $line);`
3410	dpurdie	1403
		1404	`if (open ( LF, '+>>', $logPath ) )`
		1405	`{`
		1406	`print LF $line . "\n";`
		1407	`close LF;`
		1408	`}`
		1409	`}`
		1410
		1411	`#-------------------------------------------------------------------------------`
		1412	`# Function : readInputData`
		1413	`#`
		1414	`# Description : Write out data in a form to allow post processing`
		1415	`#`
		1416	`# Inputs :`
		1417	`#`
		1418	`# Returns :`
		1419	`#`
		1420	`sub readInputData`
		1421	`{`
		1422	`unless ( keys(%Packages) > 0 )`
		1423	`{`
		1424	`my $fname = "quarantine.raw.txt";`
		1425	`Verbose ("Reading: $fname");`
		1426	`Error "Cannot locate $fname" unless ( -f $fname );`
		1427	`require $fname;`
		1428
		1429	`Error "Data in $fname is not valid\n"`
		1430	`unless ( keys(%Packages) > 0 );`
		1431	`}`
		1432
		1433	`#`
		1434	`# Create a lookup from package name/version to pvid`
		1435	`#`
		1436	`Verbose ("Create PackageVersion to PVID hash");`
		1437	`foreach my $pvid ( keys %Packages )`
		1438	`{`
		1439	`my $name = $Packages{$pvid}{name};`
		1440	`my $version = $Packages{$pvid}{version};`
		1441	`if ( $name && $version )`
		1442	`{`
		1443	`$pkgPvid{$name}{$version}{pvid} = $pvid;`
		1444	`}`
		1445	`}`
		1446	`}`
		1447
		1448	`#-------------------------------------------------------------------------------`
		1449	`# Documentation`
		1450	`#`
		1451
		1452	`=pod`
		1453
		1454	`=for htmltoc SYSUTIL::`
		1455
		1456	`=head1 NAME`
		1457
		1458	`jats_quarantine - Determine packages to be quarantined`
		1459
		1460	`=head1 SYNOPSIS`
		1461
		1462	`jats jats_quarantine [options]`
		1463
		1464	`Options:`
		1465	`-help - brief help message`
		1466	`-help -help - Detailed help message`
		1467	`-man - Full documentation`
		1468	`-verbose[=n] - Control output`
5534	dpurdie	1469	`-explain - Display each package version disposition`
3410	dpurdie	1470	`-phase=nn - Perform named phases`
4092	dpurdie	1471	`-purge - Just purge the old quarantined files`
3410	dpurdie	1472	`-test - Do not delete files`
		1473	`-limit=n - Limit packages processed. Test only`
4093	dpurdie	1474	`-pcount=n - Limit package count`
3410	dpurdie	1475
		1476	`=head1 OPTIONS`
		1477
		1478	`=over 8`
		1479
		1480	`=item B<-help>`
		1481
		1482	`Print a brief help message and exits.`
		1483
		1484	`=item B<-help -help>`
		1485
		1486	`Print a detailed help message with an explanation for each option.`
		1487
		1488	`=item B<-man>`
		1489
		1490	`Prints the manual page and exits.`
		1491
		1492	`=item B<-verbose[=n]>`
		1493
		1494	`This option control the programs output. Normally this program will not generate`
		1495	`any output. It will only generate output on error conditions. This is intentional`
		1496	`as the program will be run as a cron-job and output errors will be mailed out.`
		1497
		1498	`A verbose level of 1. will display progress information`
		1499
		1500	`A verbose level of 3. will display detailed tracing of all operations`
		1501
5534	dpurdie	1502	`=item B<-explain[=n]>`
		1503
		1504	`This option will output a line per package-version explaining the reason that`
		1505	`packages are retained.`
		1506
		1507	`Only a level of 1 is supported.`
		1508
3410	dpurdie	1509	`=item B<-phase=list>`
		1510
		1511	`This option will limit the work done by the program. There are two phases`
		1512	`called: 1 and 2.`
		1513
		1514	`Phase-1 will examine Release Manager collect package-version information.`
		1515	`Phase-2 will examine dpkg_archive and collect package-version information. It`
		1516	`will then initiate the quarantine operation.`
		1517
		1518	`The default operation is to perform phase-1 and phase-2.`
		1519
		1520	`If only phase-1 is specified then the RM data is saved, to be used by a`
		1521	`later phase.`
		1522
		1523	`If only phase-2 is specified then saved RM data is restored.`
		1524
		1525	`This option can simplify testing.`
		1526
4092	dpurdie	1527	`=item B<-purge>`
		1528
		1529	`This option will only purge the old quarantine directories. It will not quarantine new`
		1530	`package versions.`
		1531
3410	dpurdie	1532	`=item B<-test>`
		1533
		1534	`Do not delete or move files and directories. Report what would have been done.`
		1535
		1536	`=item B<-limit=n>`
		1537
		1538	`Limit the number of packages processed by the tool. This is only used to`
		1539	`simplify testing of the program`
		1540
		1541	`=back`
		1542
		1543	`=head1 DESCRIPTION`
		1544
		1545	`This program is a tool used in the maintainance of dpkg_archive.`
		1546	`It will:`
		1547
		1548	`=over 8`
		1549
		1550	`=item *`
		1551
		1552	`Determine package-versions in use by Release Manager.`
		1553
		1554	`=item *`
		1555
5125	dpurdie	1556	`Determine package-versions in recent Deployment Manager SBOMS.`
		1557
		1558	`=item *`
		1559
3410	dpurdie	1560	`Determine package-versions that can be rebuilt`
		1561
		1562	`=item *`
		1563
		1564	`Recursively find all the dependent packages of all packages. New package`
		1565	`versions are called 'indirect' dependencies. They are buried. This process can`
		1566	`take several minutes.`
		1567
		1568	`=back`
		1569
		1570	`The data collected is dumped into a text file for later processing.`
		1571
		1572	`=cut`
		1573

Subversion Repositories DevTools

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