WebSVN – DevTools – Blame – /dpkg_management/trunk/src/sbin/jats_quarantine.pl

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

Subversion Repositories DevTools

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