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");`
6241	dpurdie	889	`Log ("Quarantine store Disabled") if ($config{qdirAge} <= 0);`
3423	dpurdie	890	`Log ("Config: $_ = $config{$_}") foreach ( sort keys %config );`
		891	`Log ("Ignore: $_") foreach ( sort keys %retainPkgs );`
3410	dpurdie	892
		893	`#`
		894	`# Create a 'nice' symlink to the latest log file`
		895	`my $logLatest = join('/', $config{logBase}, 'latest');`
		896	`unlink ( $logLatest );`
		897	`symlink( $logName, $logLatest);`
		898
		899	`#`
		900	`# Clean up old files`
		901	`#`
6241	dpurdie	902	`if ($config{qdirAge} > 0) {`
		903	`opendir( Q, $config{quarantine} ) \|\| Error ("opendir failed on: $config{quarantine}" );`
3410	dpurdie	904
6241	dpurdie	905	`# delete any quarantine instance older than 90 days`
		906	`while ( my $file = readdir( Q ) )`
		907	`{`
		908	`#`
		909	`# Skip housekeeping directory entries`
		910	`#`
		911	`next if ( $file eq '.' );`
		912	`next if ( $file eq '..' );`
		913	`next if ( $file eq 'lost+found' );`
3410	dpurdie	914
6241	dpurdie	915	`my $path = join( '/', $config{quarantine} . "/" . $file);`
		916	`my $age = checkTime( $path );`
		917	`if ( $age > $config{qdirAge} )`
		918	`{`
		919	`Log ("Old Quarantine Removed: $path");`
		920	`Verbose ("Test: Delete Dir: $path") if ( $opt_test );`
		921	`rmtree($path, 0, 1) unless $opt_test;`
		922	`}`
3410	dpurdie	923	`}`
6241	dpurdie	924
		925	`closedir( Q );`
3410	dpurdie	926	`}`
		927	`}`
		928
		929	`#-------------------------------------------------------------------------------`
		930	`# Function : checkTime`
		931	`#`
		932	`# Description : Days since modification of a path`
		933	`#`
		934	`# Inputs : Path elements`
		935	`#`
		936	`# Returns : Days since midification`
		937	`#`
		938
		939	`sub checkTime`
		940	`{`
		941	`my ($path) = @_;`
		942	`my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,`
		943	`$atime,$mtime,$ctime,$blksize,$blocks) = stat($path);`
		944
4127	dpurdie	945	`unless(defined $mtime)`
		946	`{`
		947	`Warning("Bad stat for $path");`
		948	`$mtime = 0;`
		949	`}`
		950
3410	dpurdie	951	`return int( ($now - $mtime) / (60 * 60 * 24));`
		952	`}`
		953
		954	`#-------------------------------------------------------------------------------`
		955	`# Function : processDpkgArchive`
		956	`#`
		957	`# Description : Scan dpkg_archive`
		958	`#`
		959	`# Inputs :`
		960	`#`
		961	`# Returns :`
		962	`#`
		963	`sub processDpkgArchive`
		964	`{`
		965	`Verbose ("Scanning dpkg_archive");`
		966	`opendir( PKGS, $config{dpkg_archive} ) \|\| Error ("Cannot open dpkg_archive");`
		967	`while ( my $pkgName = readdir(PKGS) )`
		968	`{`
		969	`next if ( $pkgName eq '.' );`
		970	`next if ( $pkgName eq '..' );`
		971	`next if ( $pkgName eq 'lost+found' );`
		972	`next if ( exists $retainPkgs{$pkgName} );`
		973
		974	`my $pkgDir = join('/', $config{dpkg_archive}, $pkgName );`
		975	`if ( -d $pkgDir )`
		976	`{`
		977	`if (opendir (PV, $pkgDir ) )`
		978	`{`
		979
		980	`while ( my $pkgVersion = readdir(PV) )`
		981	`{`
		982	`next if ( $pkgVersion eq '.' );`
		983	`next if ( $pkgVersion eq '..' );`
4646	dpurdie	984	`next if ( $pkgVersion eq 'latest' ); # Keep latest (often symlink for build system)`
		985
3410	dpurdie	986	`my $pkgPath = join('/', $config{dpkg_archive}, $pkgName,$pkgVersion );`
		987	`my $mtime = checkTime($pkgPath);`
		988
		989	`my $pvid;`
		990	`if ( exists ($pkgPvid{$pkgName}) && exists($pkgPvid{$pkgName}{$pkgVersion} ) )`
		991	`{`
		992	`$pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};`
		993	`$Packages{$pvid}{dpkg_archive} = 1;`
		994	`$pkgPvid{$pkgName}{$pkgVersion}{mtime} = $mtime;`
		995	`}`
		996	`else`
		997	`{`
		998	`#`
		999	`# Package is in dpkg-archive, but not in Release`
		1000	`# Manager. Allow for a short while`
		1001	`#`
5534	dpurdie	1002	`$statistics{TotalPackages}++;`
		1003	`$statistics{'NotInReleaseManager'}++;`
3410	dpurdie	1004	`if ( $mtime > $config{retainNoRm} )`
		1005	`{`
		1006	`#Log("Package not in RM: $pkgName, $pkgVersion, Age: $mtime");`
		1007	`quarantineItem( 'X', $mtime, $pkgPath );`
5534	dpurdie	1008	`$statistics{'Quarantine'}++;`
3410	dpurdie	1009	`}`
5534	dpurdie	1010
		1011	`if ($opt_explain)`
		1012	`{`
		1013	`Information("Reason:-, $pkgName, $pkgVersion, Reason:NotInReleaseManager");`
		1014	`}`
3410	dpurdie	1015	`}`
		1016
		1017	`#Message("$pkgName, $pkgVersion, $pkgPvid{$pkgName}{$pkgVersion}{mtime}");`
		1018	`}`
		1019	`close(PV);`
		1020	`}`
		1021	`}`
		1022	`elsif ( -f $pkgDir )`
		1023	`{`
		1024	`Warning("Unexpected file in dpkg_archive: $pkgName");`
		1025	`Log("Unexpected file in dpkg_archive: $pkgName");`
		1026	`quarantineItem( 'F', -1, $pkgDir );`
5534	dpurdie	1027	`$statistics{'fileNotInReleaseManager'}++;`
		1028	`$statistics{'Quarantine'}++;`
		1029	`$statistics{'NotInReleaseManager'}++;`
		1030
		1031	`if ($opt_explain)`
		1032	`{`
		1033	`Information("Reason:-, $pkgDir, -, Reason:fileNotInReleaseManager");`
		1034	`}`
3410	dpurdie	1035	`}`
		1036	`else`
		1037	`{`
		1038	`Warning("Unexpected entry in dpkg_archive: $pkgName");`
		1039	`}`
		1040	`}`
		1041	`close(PKGS);`
		1042
		1043
		1044	`#`
		1045	`#`
5125	dpurdie	1046	`# Scan all packages found in dpkg_archive and see if we should keep it`
		1047	`# Quarantine those we cannot find a reason to keep`
3410	dpurdie	1048	`#`
		1049	`foreach my $pkgName ( sort keys %pkgPvid )`
		1050	`{`
		1051	`foreach my $pkgVersion ( sort keys %{$pkgPvid{$pkgName}} )`
		1052	`{`
		1053	`my $mtime = $pkgPvid{$pkgName}{$pkgVersion}{mtime} \|\| 0;`
		1054	`my $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};`
5253	dpurdie	1055	`my $keepReason = '';`
		1056	`my $entry = $Packages{$pvid};`
3410	dpurdie	1057
		1058	`{`
5253	dpurdie	1059	`# Examine entry. Determine a reason to keep the package`
5534	dpurdie	1060	`# Some reasons to keep a package are no longer needed now that versions are pumped into S3`
3410	dpurdie	1061
5253	dpurdie	1062	`unless ($entry) { $keepReason ='NoPackageEntry'; last;}`
		1063	`unless ($entry->{dpkg_archive}) { $keepReason ='NotInArchive'; last;}`
		1064	`unless ($pvid) { $keepReason = 'NoPVid'; last;}`
5534	dpurdie	1065	`if (exists $entry->{tlp}) { $keepReason = 'TopLevelPackage'; last;}`
		1066	`if (exists $entry->{slp}) { $keepReason = 'SecondLevelPackage'; last;}`
		1067	`if (exists $entry->{sdk}) { $keepReason ='inSdk'; last;}`
		1068	`if (exists $entry->{dm}) { $keepReason = 'inDeploymentManager'; last;}`
		1069	`if ($entry->{isPatch}) { $keepReason = 'isPatch'; last;}`
		1070	`if ($mtime <= $config{retain}) { $keepReason ='RetainTime:' . ($config{retain} - $mtime); last;}`
		1071	`#unless ($entry->{buildStandard}) { $keepReason ='NoBuildStandard:' . $mtime; last;}`
5253	dpurdie	1072	`if ($entry->{locked} ne 'Y') { $keepReason ='NotLocked:' . $entry->{locked}; last;}`
		1073	`#if ($entry->{buildType} eq 'M') { $keepReason ='ManualBuild:' . $entry->{buildType}; last;}`
		1074
		1075	`$pkgPvid{$pkgName}{$pkgVersion}{keepReason} = $keepReason;`
		1076	`}`
		1077
		1078	`unless ( $keepReason )`
		1079	`{`
3410	dpurdie	1080	`Verbose2("Quarantine:$pvid, $pkgName, $pkgVersion, Age:$mtime, Lock:$entry->{locked}, Patch:$entry->{isPatch}, BS:$entry->{buildStandard}, BT:$entry->{buildType}");`
		1081	`quarantineItem( 'Q', $mtime, join('/', $config{dpkg_archive}, $pkgName, $pkgVersion ) );`
5534	dpurdie	1082	`$keepReason = 'Quarantine';`
3410	dpurdie	1083	`}`
5253	dpurdie	1084
		1085	`if ($opt_explain)`
		1086	`{`
		1087	`Information("Reason:$pvid, $pkgName, $pkgVersion, Reason:$keepReason");`
		1088	`}`
5534	dpurdie	1089
		1090	`#`
		1091	`# Maintain Stats`
		1092	`# Only use the Base Reason - remove details after the ':' character`
		1093	`#`
		1094	`my $sReason = $keepReason;`
		1095	`$sReason =~ s~:.*$~~;`
		1096	`$statistics{$sReason}++;`
		1097	`$statistics{TotalPackages}++;`
3410	dpurdie	1098	`}`
		1099	`}`
		1100
		1101	`#`
		1102	`# Perform the quarantine`
		1103	`#`
		1104	`doQuarantine();`
		1105	`}`
		1106
		1107	`#-------------------------------------------------------------------------------`
		1108	`# Function : reportMissingPkgs`
		1109	`#`
		1110	`# Description : Report packages that 'should' be in dpkg_archive because`
		1111	`# they are essential, but are not`
		1112	`#`
		1113	`# Inputs :`
		1114	`#`
		1115	`# Returns :`
		1116	`#`
		1117	`sub reportMissingPkgs`
		1118	`{`
		1119	`return;`
		1120
		1121	`#`
		1122	`# Not very useful as there is too much information`
		1123	`# It would appear that the quarantine process may have also`
		1124	`# been deleting packages from 'closed' as well as 'archived'`
		1125	`# releases at some stage.`
		1126	`#`
		1127	`# Report packages used in not-archived or not-closed releases`
		1128	`#`
		1129	`my @missing;`
		1130	`foreach my $pvid (keys %Packages )`
		1131	`{`
		1132	`my $entry = $Packages{$pvid};`
		1133	`next unless ( exists $entry->{tlp} );`
		1134	`# next unless ( exists $entry->{slp} );`
		1135	`next if ( $entry->{dpkg_archive} );`
		1136	`next unless ( exists $entry->{name} );`
		1137
		1138	`#`
		1139	`# Missing package`
		1140	`# Determine if its in use by an active release`
		1141	`#`
		1142
		1143	`my @releases = usedBy($pvid);`
		1144	`foreach my $release (@releases )`
		1145	`{`
		1146	`next if ( $Releases{$release}{official} eq 'Y' );`
		1147	`next if ( $Releases{$release}{official} eq 'A' );`
		1148	`push @missing, $entry->{name} . ' ' . $entry->{version} . " ($pvid)";`
		1149	`last;`
		1150	`}`
		1151	`}`
		1152
		1153	`Warning ("Packages required by active releases that are not in dpkg_archive", sort @missing);`
		1154	`}`
		1155
		1156	`#-------------------------------------------------------------------------------`
		1157	`# Function : usedBy`
		1158	`#`
		1159	`# Description : Given a pvid, determine which release(s) need it`
		1160	`#`
		1161	`# Inputs : $pvid`
		1162	`#`
		1163	`# Returns : Nothing`
		1164	`#`
		1165	`sub usedBy`
		1166	`{`
		1167	`my ($pvid) = @_;`
		1168	`my %seen;`
		1169
		1170	`Error ("PVID is not an essential package") unless ( exists $Packages{$pvid} );`
		1171
		1172	`my @releases = @{$Packages{$pvid}{'release'}} if exists($Packages{$pvid}{'release'});`
		1173	`my @users = @{$Packages{$pvid}{'usedBy'}} if exists($Packages{$pvid}{'usedBy'});`
		1174
		1175	`while ( @users )`
		1176	`{`
		1177	`my $pv = pop @users;`
		1178
		1179	`next if ( exists $seen{$pv} );`
		1180	`$seen{$pv} = 1;`
		1181
		1182	`push @releases, @{$Packages{$pv}{'release'}} if (exists $Packages{$pv}{'release'});`
		1183	`push @users, @{$Packages{$pv}{'usedBy'}} if (exists($Packages{$pv}{'usedBy'}));`
		1184	`}`
		1185	`return @releases;`
		1186	`}`
		1187
		1188	`#-------------------------------------------------------------------------------`
5534	dpurdie	1189	`# Function : reportStats`
		1190	`#`
		1191	`# Description : Report statistics`
		1192	`# Write statistics to a file`
		1193	`# Write to a tmp file, then rename.`
		1194	`# Attempt to make the operation atomic - so that the file consumer`
		1195	`# doesn't get a badly formed file.`
		1196	`#`
		1197	`#`
		1198	`# Inputs :`
		1199	`#`
		1200	`# Returns :`
		1201	`#`
		1202	`sub reportStats`
		1203	`{`
		1204	`#`
		1205	`# Time stamp the stats`
		1206	`#`
		1207	`$statistics{'timeStamp'} = time();`
		1208
		1209	`#`
		1210	`# Save stats to a known file for Nagios to use`
		1211	`#`
		1212	`my $statsfiletmp = join('/', $config{logBase}, 'quarantine.stats.tmp' );`
		1213	`my $statsfile = join('/', $config{logBase}, 'quarantine.stats');`
		1214
		1215	`my $fh;`
		1216	`unless (open ($fh, '>', $statsfiletmp))`
		1217	`{`
		1218	`$fh = undef;`
		1219	`Warning("Cannot create temp stats file: $!");`
		1220	`}`
		1221	`else`
		1222	`{`
		1223	`foreach my $key ( sort { lc($a) cmp lc($b) } keys %statistics)`
		1224	`{`
		1225	`print $fh $key . ':' . $statistics{$key} . "\n";`
		1226	`Log('Statistics: '. $key . ':' . $statistics{$key});`
		1227	`}`
		1228	`close $fh;`
		1229
		1230	`# Rename temp to real file`
		1231	`rename $statsfiletmp, $statsfile;`
		1232	`}`
		1233	`}`
		1234
		1235
		1236	`#-------------------------------------------------------------------------------`
3410	dpurdie	1237	`# Function : quarantineItem`
		1238	`#`
		1239	`# Description : Add item to the list of stuff to be quarantined`
		1240	`#`
		1241	`# Inputs : $reason - Reason`
		1242	`# $age - Age`
		1243	`# $path - Path`
		1244	`#`
		1245	`# Returns :`
		1246	`#`
		1247	`sub quarantineItem`
		1248	`{`
		1249	`my ($reason, $age, $path ) = @_;`
		1250	`my %data;`
		1251	`$data{reason} = $reason;`
		1252	`$data{age} = $age;`
		1253	`$data{path} = $path;`
		1254
		1255	`push @quarantineItems, \%data;`
		1256	`}`
		1257
		1258	`#-------------------------------------------------------------------------------`
		1259	`# Function : doQuarantine`
		1260	`#`
		1261	`# Description : Quarantine files and folders that have been queued up`
		1262	`#`
		1263	`# Inputs : None`
		1264	`#`
		1265	`# Returns :`
		1266	`#`
		1267	`sub doQuarantine`
		1268	`{`
		1269	`my $testMsg = $opt_test ? 'Test,' : '';`
4093	dpurdie	1270
		1271	`# Process entries - oldest first`
		1272	`#`
4127	dpurdie	1273	`my $countRemain = ( scalar @quarantineItems );`
4093	dpurdie	1274	`foreach my $entry (sort {$b->{age} <=> $a->{age} } @quarantineItems)`
3410	dpurdie	1275	`{`
		1276	`my $rv;`
		1277	`my $emsg = ' - with error';`
5272	dpurdie	1278	`my $s3error = 0;`
3410	dpurdie	1279
		1280	`my $path = $entry->{path};`
		1281	`my $tpath = $path;`
		1282	`$tpath =~ s~^$config{dpkg_archive}~~;`
		1283	`$tpath = $quarantineInstance.$tpath;`
		1284	`my $tdir = dirname ( $tpath );`
		1285
		1286	`unless ( $opt_test )`
		1287	`{`
4542	dpurdie	1288	`#`
		1289	`# Transfer to Amazon S3 storage first`
		1290	`# The transfer is done via an external program (script)`
		1291	`# The transfer will tar-zip the packageVersion`
		1292	`#`
		1293	`{`
		1294	`my $s3msg = "";`
		1295	`my $pv = $path;`
		1296
		1297	`#`
		1298	`# Export the Secrets in EnvVars`
		1299	`# Use program defaults so that we don't need to specify them`
		1300	`# on the command line - for all to see`
		1301	`#`
		1302	`$ENV{AWSKEY} = $config{S3Key};`
		1303	`$ENV{AWSSECRET} = $config{S3Secret};`
		1304
		1305	`$rv = system ( "$progBase/savePkgToS3.sh", "--bucket=$config{S3Bucket}" ,"--path=$path" );`
		1306	`if ( $rv )`
		1307	`{`
		1308	`ReportError ("Move $path to S3");`
		1309	`$s3msg = ' - with S3 error';`
5272	dpurdie	1310	`$s3error = 1;`
		1311	`$emsg = ' - S3 Error prevented quarantine';`
5534	dpurdie	1312	`$statistics{'S3TransferError'}++;`
		1313
4542	dpurdie	1314	`}`
		1315	`Log (sprintf("S3Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $s3msg));`
		1316	`}`
		1317
5272	dpurdie	1318	`unless ($s3error)`
3410	dpurdie	1319	`{`
6104	dpurdie	1320	`if ($config{qdirAge} <= 0)`
3410	dpurdie	1321	`{`
6104	dpurdie	1322	`#`
		1323	`# Just delete the package-version`
		1324	`#`
		1325	`rmtree( $path);`
		1326	`if (-d $path)`
5272	dpurdie	1327	`{`
6104	dpurdie	1328	`ReportError ("Deleting $path ");`
		1329	`$statistics{'QuarantineError'}++;`
		1330	`$emsg = ' - Delete error';`
5272	dpurdie	1331	`}`
		1332	`else`
		1333	`{`
		1334	`$emsg = '';`
		1335	`}`
3410	dpurdie	1336	`}`
6104	dpurdie	1337	`else`
		1338	`{`
		1339	`#`
		1340	`# Transfer then delete to local directory`
		1341	`#`
		1342	`unless (-d $tdir)`
		1343	`{`
		1344	`eval { mkpath($tdir) };`
		1345	`ReportError ("Did not create quarantine target: $tdir")`
		1346	`unless (-d $tdir);`
		1347	`}`
		1348
		1349	`if (-d $tdir)`
		1350	`{`
		1351	`$rv = system ('mv', '-n', $path, $tdir);`
		1352	`if ( $rv )`
		1353	`{`
		1354	`ReportError ("Move $path to $tdir");`
		1355	`$statistics{'QuarantineError'}++;`
		1356
		1357	`#`
		1358	`# Clean up what may have been moved`
		1359	`# NOTE: deleted so that we don't loose stuff if it gets ugly`
		1360	`# rmtree( $tpath);`
		1361	`# rmdir ($tdir);`
		1362	`}`
		1363	`else`
		1364	`{`
		1365	`$emsg = '';`
		1366	`}`
		1367	`}`
		1368	`}`
3410	dpurdie	1369	`}`
		1370	`}`
		1371	`else`
		1372	`{`
		1373	`Verbose2("Test: 'mv', '$path', '$tdir'");`
		1374	`$emsg = '';`
		1375	`}`
		1376
		1377	`# Log operation with frills`
		1378	`Log (sprintf("Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $emsg));`
4093	dpurdie	1379
		1380	`# Limit packages quarantined`
4127	dpurdie	1381	`$countRemain--;`
4093	dpurdie	1382	`if ($opt_pcount > 0)`
		1383	`{`
		1384	`$opt_pcount--;`
		1385	`if ($opt_pcount == 0)`
		1386	`{`
4127	dpurdie	1387	`Log ("Quarantine package count exceeded. Quarantine terminated. $countRemain packages remaining");`
4093	dpurdie	1388	`last;`
		1389	`}`
		1390	`}`
3410	dpurdie	1391	`}`
		1392	`}`
		1393
		1394	`#-------------------------------------------------------------------------------`
		1395	`# Function : Log`
		1396	`#`
		1397	`# Description : Log a string`
		1398	`#`
		1399	`# Inputs : Line to log`
		1400	`#`
		1401	`# Returns :`
		1402	`#`
		1403	`sub Log`
		1404	`{`
		1405	`my ($line) = @_;`
4093	dpurdie	1406	`Verbose("Log: " . $line);`
3410	dpurdie	1407
		1408	`if (open ( LF, '+>>', $logPath ) )`
		1409	`{`
		1410	`print LF $line . "\n";`
		1411	`close LF;`
		1412	`}`
		1413	`}`
		1414
		1415	`#-------------------------------------------------------------------------------`
		1416	`# Function : readInputData`
		1417	`#`
		1418	`# Description : Write out data in a form to allow post processing`
		1419	`#`
		1420	`# Inputs :`
		1421	`#`
		1422	`# Returns :`
		1423	`#`
		1424	`sub readInputData`
		1425	`{`
		1426	`unless ( keys(%Packages) > 0 )`
		1427	`{`
		1428	`my $fname = "quarantine.raw.txt";`
		1429	`Verbose ("Reading: $fname");`
		1430	`Error "Cannot locate $fname" unless ( -f $fname );`
		1431	`require $fname;`
		1432
		1433	`Error "Data in $fname is not valid\n"`
		1434	`unless ( keys(%Packages) > 0 );`
		1435	`}`
		1436
		1437	`#`
		1438	`# Create a lookup from package name/version to pvid`
		1439	`#`
		1440	`Verbose ("Create PackageVersion to PVID hash");`
		1441	`foreach my $pvid ( keys %Packages )`
		1442	`{`
		1443	`my $name = $Packages{$pvid}{name};`
		1444	`my $version = $Packages{$pvid}{version};`
		1445	`if ( $name && $version )`
		1446	`{`
		1447	`$pkgPvid{$name}{$version}{pvid} = $pvid;`
		1448	`}`
		1449	`}`
		1450	`}`
		1451
		1452	`#-------------------------------------------------------------------------------`
		1453	`# Documentation`
		1454	`#`
		1455
		1456	`=pod`
		1457
		1458	`=for htmltoc SYSUTIL::`
		1459
		1460	`=head1 NAME`
		1461
		1462	`jats_quarantine - Determine packages to be quarantined`
		1463
		1464	`=head1 SYNOPSIS`
		1465
		1466	`jats jats_quarantine [options]`
		1467
		1468	`Options:`
		1469	`-help - brief help message`
		1470	`-help -help - Detailed help message`
		1471	`-man - Full documentation`
		1472	`-verbose[=n] - Control output`
5534	dpurdie	1473	`-explain - Display each package version disposition`
3410	dpurdie	1474	`-phase=nn - Perform named phases`
4092	dpurdie	1475	`-purge - Just purge the old quarantined files`
3410	dpurdie	1476	`-test - Do not delete files`
		1477	`-limit=n - Limit packages processed. Test only`
4093	dpurdie	1478	`-pcount=n - Limit package count`
3410	dpurdie	1479
		1480	`=head1 OPTIONS`
		1481
		1482	`=over 8`
		1483
		1484	`=item B<-help>`
		1485
		1486	`Print a brief help message and exits.`
		1487
		1488	`=item B<-help -help>`
		1489
		1490	`Print a detailed help message with an explanation for each option.`
		1491
		1492	`=item B<-man>`
		1493
		1494	`Prints the manual page and exits.`
		1495
		1496	`=item B<-verbose[=n]>`
		1497
		1498	`This option control the programs output. Normally this program will not generate`
		1499	`any output. It will only generate output on error conditions. This is intentional`
		1500	`as the program will be run as a cron-job and output errors will be mailed out.`
		1501
		1502	`A verbose level of 1. will display progress information`
		1503
		1504	`A verbose level of 3. will display detailed tracing of all operations`
		1505
5534	dpurdie	1506	`=item B<-explain[=n]>`
		1507
		1508	`This option will output a line per package-version explaining the reason that`
		1509	`packages are retained.`
		1510
		1511	`Only a level of 1 is supported.`
		1512
3410	dpurdie	1513	`=item B<-phase=list>`
		1514
		1515	`This option will limit the work done by the program. There are two phases`
		1516	`called: 1 and 2.`
		1517
		1518	`Phase-1 will examine Release Manager collect package-version information.`
		1519	`Phase-2 will examine dpkg_archive and collect package-version information. It`
		1520	`will then initiate the quarantine operation.`
		1521
		1522	`The default operation is to perform phase-1 and phase-2.`
		1523
		1524	`If only phase-1 is specified then the RM data is saved, to be used by a`
		1525	`later phase.`
		1526
		1527	`If only phase-2 is specified then saved RM data is restored.`
		1528
		1529	`This option can simplify testing.`
		1530
4092	dpurdie	1531	`=item B<-purge>`
		1532
		1533	`This option will only purge the old quarantine directories. It will not quarantine new`
		1534	`package versions.`
		1535
3410	dpurdie	1536	`=item B<-test>`
		1537
		1538	`Do not delete or move files and directories. Report what would have been done.`
		1539
		1540	`=item B<-limit=n>`
		1541
		1542	`Limit the number of packages processed by the tool. This is only used to`
		1543	`simplify testing of the program`
		1544
		1545	`=back`
		1546
		1547	`=head1 DESCRIPTION`
		1548
		1549	`This program is a tool used in the maintainance of dpkg_archive.`
		1550	`It will:`
		1551
		1552	`=over 8`
		1553
		1554	`=item *`
		1555
		1556	`Determine package-versions in use by Release Manager.`
		1557
		1558	`=item *`
		1559
5125	dpurdie	1560	`Determine package-versions in recent Deployment Manager SBOMS.`
		1561
		1562	`=item *`
		1563
3410	dpurdie	1564	`Determine package-versions that can be rebuilt`
		1565
		1566	`=item *`
		1567
		1568	`Recursively find all the dependent packages of all packages. New package`
		1569	`versions are called 'indirect' dependencies. They are buried. This process can`
		1570	`take several minutes.`
		1571
		1572	`=back`
		1573
		1574	`The data collected is dumped into a text file for later processing.`
		1575
		1576	`=cut`
		1577

Subversion Repositories DevTools

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