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	`#`
		12	`# Usage : See POD at end of file`
		13	`#`
		14	`#......................................................................#`
		15
		16	`require 5.008_002;`
		17	`use strict;`
		18	`use warnings;`
		19
		20	`use Pod::Usage;`
		21	`use Getopt::Long;`
		22
		23	`use JatsError;`
		24	`use JatsSystem;`
		25	`use Getopt::Long;`
		26	`use Pod::Usage; # required for help support`
		27	`use JatsRmApi;`
		28	`use ConfigurationFile;`
		29	`use File::Path;`
		30	`use File::Basename;`
		31
		32	`use DBI;`
		33
		34	`#`
		35	`# Options - global`
		36	`#`
		37	`my $VERSION = "2.0.0"; # Update this`
		38	`my $opt_verbose = 0;`
		39	`my $opt_help = 0;`
		40	`my $opt_manual;`
		41	`my $opt_test;`
		42	`my $opt_limit;`
		43	`my $opt_quick;`
		44	`my $opt_phase = '123'; # Default - do all, but don't save data`
4092	dpurdie	45	`my $opt_purge;`
4093	dpurdie	46	`my $opt_pcount = 0;`
3410	dpurdie	47
		48	`#`
		49	`# Globals`
		50	`#`
		51	`my $RM_DB;`
		52	`my $now = time();`
		53	`my $quarantineInstance;`
		54	`my $logPath;`
		55	`my %pkgPvid;`
		56	`my @quarantineItems;`
		57	`my @StrayPackages;`
		58
		59	`our %Releases;`
		60	`our %Packages;`
		61
		62	`#`
		63	`# Default config information`
		64	`# May be replaced by xxx.cnf file`
		65	`#`
		66	`my %config = (`
		67	`'retain' => '31',`
		68	`'qdirAge' => '90',`
		69	`'retainNoRm' => '31',`
		70	`'quarantine' => '/export/devl/quarantine',`
		71	`'dpkg_archive' => '/export/devl/dpkg_archive',`
		72	`'logBase' => '/export/devl/dpkg_archive/.dpkg_archive/quarantinelog',`
		73	`'verbose' => '0',`
		74	`);`
		75
		76	`# List of packages to be retained`
		77	`# May be supplemented by xxx.cnf file`
		78	`my %retainPkgs = (`
		79	`'core_devl' => 1,`
		80	`);`
		81
		82	`#-------------------------------------------------------------------------------`
		83	`# Function : Main Entry`
		84	`#`
		85	`# Description :`
		86	`#`
		87	`# Inputs :`
		88	`#`
		89	`# Returns :`
		90	`#`
		91	`my $result = GetOptions (`
		92	`"help+" => \$opt_help, # flag, multiple use allowed`
		93	`"manual" => \$opt_manual, # flag`
		94	`"verbose:+" => \$opt_verbose, # flag`
		95	`"test:+" => \$opt_test, # Test a version string`
		96	`"limit:n" => \$opt_limit, #`
		97	`"phase:s" => \$opt_phase, # Phase to do`
		98	`"quick" => \$opt_quick, # Don't look for indirects`
4092	dpurdie	99	`"purge" => \$opt_purge, # Purge old quarantined packages`
4093	dpurdie	100	`"pcount:n" => \$opt_pcount, # Count of packages to purge in one hit`
3410	dpurdie	101	`);`
		102
		103	`#`
		104	`# Process help and manual options`
		105	`#`
		106	`pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 \|\| ! $result);`
		107	`pod2usage(-verbose => 1) if ($opt_help == 2 );`
		108	`pod2usage(-verbose => 2) if ($opt_manual \|\| ($opt_help > 2));`
		109	`ErrorConfig( 'name' => 'QUARANTINE',`
		110	`'verbose' => $opt_verbose );`
		111
		112	`#`
		113	`# This utility must be run on the package server`
		114	`my $runHost = 'auperaarc01';`
		115	`my $hostname = lc $ENV{HOSTNAME} \|\| 'Unknown';`
		116	`Warning("Not running on $runHost") unless ( $hostname eq $runHost );`
		117
		118	`#`
		119	`# Needs to run as root so that packages can be moved no matter what the`
		120	`# file permissions are`
		121	`#`
		122	`Warning( "Not running as root") if ( $> );`
		123
		124	`# Read config file`
		125	`# Use max of user verbosity or config verbosity`
		126	`#`
		127	`ReadConfig();`
		128	`if ( $config{verbose} > $opt_verbose )`
		129	`{`
		130	`$opt_verbose = $config{verbose};`
		131	`ErrorConfig( 'verbose' => $opt_verbose );`
		132	`}`
		133
		134	`#`
		135	`# Collect data from Release Manager`
		136	`#`
4092	dpurdie	137	`if ( $opt_phase =~ m~1~ && !$opt_purge )`
3410	dpurdie	138	`{`
		139	`getReleaseDetails();`
		140	`GetAllPackageData();`
		141	`getTopLevelPackages();`
		142	`LocateStrays() unless ($opt_quick);`
		143
		144	`if ( $opt_verbose > 1 )`
		145	`{`
		146	`print "=========================================================================\n";`
		147	`DebugDumpData("Releases", \%Releases);`
		148	`print "=========================================================================\n";`
		149	`DebugDumpData("Packages", \%Packages );`
		150	`}`
		151	`}`
		152
		153	`#`
4092	dpurdie	154	`# Scan dpkg_archive and quarantine packages`
3410	dpurdie	155	`#`
		156	`if ( $opt_phase =~ m~2~ )`
		157	`{`
		158	`prepQdir();`
4092	dpurdie	159	`unless ($opt_purge) {`
		160	`readInputData();`
		161	`processDpkgArchive();`
		162	`reportMissingPkgs();`
		163	`}`
3410	dpurdie	164
		165	`Verbose ("Quarantine to: $quarantineInstance");`
		166	`Verbose ("Log to: $logPath");`
		167	`}`
		168
		169	`#`
		170	`# Save internal data for reuse`
		171	`# Used only for testing of indiviual phases`
		172	`#`
		173	`unless ( $opt_phase =~ m~3~ )`
		174	`{`
		175	`savePhaseData();`
		176	`}`
		177
		178	`ErrorDoExit();`
		179	`exit;`
		180
		181	`#-------------------------------------------------------------------------------`
		182	`# Function : ReadConfig`
		183	`#`
		184	`# Description : Read in config file`
		185	`# Must be inthe same directory as the executable`
		186	`#`
		187	`# Inputs :`
		188	`#`
		189	`# Returns :`
		190	`#`
		191
		192	`sub ReadConfig`
		193	`{`
		194	`my $config = $0;`
		195	`$config =~ s~\.pl$~.cnf~;`
		196	`open (CF, '<', $config ) \|\| Error ("Connot open: $config");`
		197	`while ( <CF> )`
		198	`{`
		199	`s~\s+$~~;`
		200	`s~^\s+~~;`
		201	`next if ( m~\s*#~ ); # Comment`
		202	`next unless $_; # Empty`
		203	`if ( m~(.?)\s=\s(.)~ ) {`
		204	`ReportError ("Unknown config value: $1") unless ( exists $config{$1} );`
		205	`$config{$1} = $2;`
		206	`} else {`
		207	`$retainPkgs{$_} = 1;`
		208	`}`
		209	`}`
		210	`close CF;`
		211	`ErrorDoExit();`
		212	`}`
		213
		214	`#-------------------------------------------------------------------------------`
		215	`# Function : getReleaseDetails`
		216	`#`
		217	`# Description : Determine all candiate releases`
		218	`#`
		219	`# Inputs :`
		220	`#`
		221	`# Returns :`
		222	`#`
		223	`sub getReleaseDetails`
		224	`{`
		225	`my (@row);`
		226
		227	`Verbose ("Determine all Release Names");`
		228
		229	`# if we are not or cannot connect then return 0 as we have not found anything`
		230	`connectRM(\$RM_DB) unless $RM_DB;`
		231
		232	`# Get all Releases`
		233	`# From non-archived releases`
		234	`my $m_sqlstr = "SELECT prj.PROJ_NAME, rt.RTAG_NAME, rt.PROJ_ID, rt.RTAG_ID, rt.official" .`
		235	`" FROM release_manager.release_tags rt, release_manager.projects prj" .`
		236	`" WHERE prj.PROJ_ID = rt.PROJ_ID " .`
		237	`" AND rt.official != 'A' ";`
		238	`# " AND rt.official != 'Y'" .`
		239
		240	`Verbose3("getReleaseDetails: $m_sqlstr");`
		241	`my $sth = $RM_DB->prepare($m_sqlstr);`
		242	`if ( defined($sth) )`
		243	`{`
		244	`if ( $sth->execute( ) )`
		245	`{`
		246	`if ( $sth->rows )`
		247	`{`
		248	`while ( @row = $sth->fetchrow_array )`
		249	`{`
		250	`my $rtag_id =$row[3];`
		251	`my $proj_id = $row[2];`
		252
		253	`$Releases{$rtag_id}{pName} = $row[0];`
		254	`$Releases{$rtag_id}{name} = $row[1];`
		255	`$Releases{$rtag_id}{proj_id} = $proj_id;`
		256	`$Releases{$rtag_id}{rtag_id} = $rtag_id;`
		257	`$Releases{$rtag_id}{official} = $row[4];`
		258
		259	`print join (',',@row), "\n" if ($opt_verbose > 2);`
		260	`}`
		261	`}`
		262	`$sth->finish();`
		263	`}`
		264	`else`
		265	`{`
		266	`Error("getReleaseDetails:Execute failure: $m_sqlstr", $sth->errstr() );`
		267	`}`
		268	`}`
		269	`else`
		270	`{`
		271	`Error("getReleaseDetails:Prepare failure" );`
		272	`}`
		273	`}`
		274
		275	`#-------------------------------------------------------------------------------`
		276	`# Function : GetAllPackageData`
		277	`#`
		278	`# Description : Extract all package data`
		279	`#`
		280	`# Inputs :`
		281	`#`
		282	`# Returns :`
		283	`#`
		284
		285	`sub GetAllPackageData`
		286	`{`
		287	`my (@row);`
		288	`my $count = 0;`
		289
		290	`# if we are not or cannot connect then return 0 as we have not found anything`
		291	`connectRM(\$RM_DB) unless $RM_DB;`
		292
		293	`Verbose ("Extract all package data");`
		294
		295	`# First get all packages`
		296	`# From non-archived releases`
		297
		298	`my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';`
		299	`my $m_sqlstr = "SELECT DISTINCT " .`
		300	`"pv.PV_ID, " . #[0]`
		301	`"pkg.PKG_NAME, " . #[1]`
		302	`"pv.PKG_VERSION, " . #[2]`
		303	`"pv.DLOCKED, " . #[3]`
		304	`"pv.PKG_ID," . #[4]`
		305	`"pv.is_patch," . #[5]`
		306	`"pv.build_type,". #[6]`
		307	`"pbi.bsa_id," . #[7]`
		308	`# "pv.CREATOR_ID, " . #[8]`
		309	`# "pv.MODIFIED_STAMP, " . #[9]`
		310	`# "release_manager.PK_RMAPI.return_vcs_tag(pv.PV_ID), " . #[10]`
		311	`"999" .`
		312	`" FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv,".`
		313	`"RELEASE_MANAGER.PACKAGES pkg,".`
		314	`"release_manager.package_build_info pbi" .`
		315	`" WHERE pv.PKG_ID = pkg.PKG_ID" .`
		316	`" AND pv.pv_id = pbi.pv_id(+)" .`
		317	`$limit ;`
		318	`Verbose3("GetAllPackageData: $m_sqlstr");`
		319	`my $sth = $RM_DB->prepare($m_sqlstr);`
		320	`if ( defined($sth) )`
		321	`{`
		322	`if ( $sth->execute( ) )`
		323	`{`
		324	`if ( $sth->rows )`
		325	`{`
		326	`while ( @row = $sth->fetchrow_array )`
		327	`{`
		328	`$count++;`
		329	`print join (',',@row), "\n" if ($opt_verbose > 2);`
		330	`my $pvid = $row[0];`
		331	`unless ( exists $Packages{$pvid}{name} )`
		332	`{`
		333	`$Packages{$pvid}{name} = $row[1];`
		334	`$Packages{$pvid}{version} = $row[2];`
		335	`$Packages{$pvid}{locked} = $row[3];`
		336	`$Packages{$pvid}{pkgid} = $row[4];`
		337	`$Packages{$pvid}{isPatch} = $row[5] \|\| 0;`
		338	`$Packages{$pvid}{buildType} = $row[6] \|\| 0;`
		339	`$Packages{$pvid}{buildStandard} = $row[7] \|\| 0;`
		340
		341	`#$Packages{$pvid}{Creator} = $row[8];`
		342	`#$Packages{$pvid}{Age} = $row[9];`
		343	`#$Packages{$pvid}{vcstag} = $row[10];`
		344
		345	`}`
		346
		347	`if ( $opt_limit )`
		348	`{`
		349	`last if ( $count > $opt_limit );`
		350	`}`
		351	`}`
		352	`}`
		353	`$sth->finish();`
		354	`}`
		355	`else`
		356	`{`
		357	`Error("GetAllPackageData:Execute failure: $m_sqlstr", $sth->errstr() );`
		358	`}`
		359	`}`
		360	`else`
		361	`{`
		362	`Error("GetAllPackageData:Prepare failure" );`
		363	`}`
		364
		365	`Verbose ("All Packages: $count rows");`
		366	`}`
		367
		368
		369	`#-------------------------------------------------------------------------------`
		370	`# Function : getTopLevelPackages`
		371	`#`
		372	`# Description : Extract top level packages from active releases`
		373	`#`
		374	`# Inputs :`
		375	`#`
		376	`# Returns :`
		377	`#`
		378
		379	`sub getTopLevelPackages`
		380	`{`
		381	`my (@row);`
		382	`my $count = 0;`
		383
		384	`# if we are not or cannot connect then return 0 as we have not found anything`
		385	`connectRM(\$RM_DB) unless $RM_DB;`
		386
		387	`Verbose ("Extract toplevel dependencies");`
		388
		389	`# First get all packages that are referenced in a Release`
		390	`# This will only get the top level packages`
		391	`# From non-archived releases`
		392
		393	`my $limit = $opt_limit ? " AND rownum <= $opt_limit" : '';`
		394	`my $m_sqlstr = "SELECT DISTINCT " .`
		395	`"rc.PV_ID, " . #[0]`
		396	`"rt.RTAG_ID, " . #[1]`
		397	`"prj.PROJ_ID " . #[2]`
		398	`" FROM RELEASE_MANAGER.RELEASE_CONTENT rc, ".`
		399	`"release_manager.release_tags rt,".`
		400	`"release_manager.projects prj" .`
		401	`" WHERE prj.PROJ_ID = rt.PROJ_ID" .`
		402	`" and rt.RTAG_ID = rc.RTAG_ID" .`
		403	`" AND rt.official != 'A'" .`
		404	`# " AND rt.official != 'Y' " .`
		405	`$limit;`
		406
		407	`Verbose3("getTopLevelPackages: $m_sqlstr");`
		408	`my $sth = $RM_DB->prepare($m_sqlstr);`
		409	`if ( defined($sth) )`
		410	`{`
		411	`if ( $sth->execute( ) )`
		412	`{`
		413	`if ( $sth->rows )`
		414	`{`
		415	`while ( @row = $sth->fetchrow_array )`
		416	`{`
		417	`$count++;`
		418	`print join (',',@row), "\n" if ($opt_verbose > 2);`
		419	`my $pvid = $row[0];`
		420	`$Packages{$pvid}{tlp} = 1;`
		421	`push @StrayPackages, $pvid;`
		422
		423
		424	`my $rtag_id = $row[1];`
		425	`push @{$Packages{$pvid}{release}}, $rtag_id;`
		426
		427	`my $proj_id = $row[2];`
		428	`push @{$Packages{$pvid}{projects}}, $proj_id`
		429	`unless (grep {$_ eq $proj_id} @{$Packages{$pvid}{projects}});`
		430
		431	`if ( $opt_limit )`
		432	`{`
		433	`last if ( $count > $opt_limit );`
		434	`}`
		435	`}`
		436	`}`
		437	`$sth->finish();`
		438	`}`
		439	`else`
		440	`{`
		441	`Error("getTopLevelPackages:Execute failure: $m_sqlstr", $sth->errstr() );`
		442	`}`
		443	`}`
		444	`else`
		445	`{`
		446	`Error("getTopLevelPackages:Prepare failure" );`
		447	`}`
		448
		449	`Verbose ("Extract toplevel dependencies: $count rows");`
		450	`}`
		451
		452	`#-------------------------------------------------------------------------------`
		453	`# Function : GetDepends`
		454	`#`
		455	`# Description :`
		456	`#`
		457	`# Inputs : @plist - list of pvid's to process`
		458	`#`
		459	`# Returns :`
		460	`#`
		461	`sub GetDepends`
		462	`{`
		463	`my (@plist) = @_;`
		464
		465	`#`
		466	`# Now extract the package dependacies`
		467	`# There may not be any`
		468	`#`
		469	`my $m_sqlstr = "SELECT ".`
		470	`" pd.PV_ID, ".`
		471	`" pd.DPV_ID " .`
		472	`" FROM RELEASE_MANAGER.PACKAGE_DEPENDENCIES pd ".`
		473	`" WHERE pd.PV_ID in ( " . join(',', @plist) . " )";`
		474	`my $sth = $RM_DB->prepare($m_sqlstr);`
		475	`if ( defined($sth) )`
		476	`{`
		477	`if ( $sth->execute( ) )`
		478	`{`
		479	`if ( $sth->rows )`
		480	`{`
		481	`while ( my @row = $sth->fetchrow_array )`
		482	`{`
		483	`my $pvid = $row[0];`
		484	`my $dpvid = $row[1];`
		485	`push @StrayPackages, $dpvid;`
		486	`push @{$Packages{$dpvid}{usedBy}}, $pvid;`
3423	dpurdie	487	`$Packages{$dpvid}{slp} = 1 unless exists $Packages{$dpvid}{tlp};`
3410	dpurdie	488
		489	`print join (',','GetDepends',@row), "\n" if ($opt_verbose > 2);`
		490	`}`
		491	`}`
		492	`$sth->finish();`
		493	`}`
		494	`else`
		495	`{`
		496	`Error("GetDepends:Execute failure: $m_sqlstr", $sth->errstr() );`
		497	`}`
		498	`}`
		499	`else`
		500	`{`
		501	`Error("GetDepends:Prepare failure" );`
		502	`}`
		503	`}`
		504
		505	`#-------------------------------------------------------------------------------`
		506	`# Function : LocateStrays`
		507	`#`
		508	`# Description : Locate stray packages`
		509	`# Try to do several (200) at a time to speed up processing`
		510	`#`
		511	`# Inputs :`
		512	`#`
		513	`# Returns :`
		514	`#`
		515	`sub LocateStrays`
		516	`{`
		517	`Verbose ("Locate indirectly referenced packages");`
		518	`while ( $#StrayPackages >= 0 )`
		519	`{`
		520	`#print "Strays Remaining: ", scalar @StrayPackages ,"\n";`
		521
		522	`my @plist;`
		523	`while ( $#plist <= 200 && @StrayPackages )`
		524	`{`
		525	`my $pv_id = pop @StrayPackages;`
		526	`next if ( exists $Packages{$pv_id}{done} );`
		527	`push @plist, $pv_id;`
		528	`}`
		529
		530	`GetDepends(@plist) if @plist;`
		531
		532	`foreach ( @plist)`
		533	`{`
		534	`$Packages{$_}{done} = 1;`
		535	`}`
		536	`}`
		537	`}`
		538
		539	`#-------------------------------------------------------------------------------`
		540	`# Function : savePhaseData`
		541	`#`
		542	`# Description : Save inter-phase data`
		543	`#`
		544	`# Inputs :`
		545	`#`
		546	`# Returns :`
		547	`#`
		548	`sub savePhaseData`
		549	`{`
		550	`my $count = 0;`
		551	`my $direct = 0;`
		552	`my $indirect = 0;`
		553	`my $buildable = 0;`
		554	`my $bad = 0;`
		555
		556	`foreach my $pvid ( keys %Packages )`
		557	`{`
		558	`my $entry = $Packages{$pvid};`
		559	`unless ( defined $entry->{name} && defined $entry->{version})`
		560	`{`
		561	`Warning ("Package Name or Version not known: $pvid");`
		562	`$bad++;`
		563	`next;`
		564	`}`
		565
		566	`$count++;`
		567	`if ( $entry->{locked} && $entry->{locked} eq 'Y' && $entry->{buildStandard} > 0 )`
		568	`{`
		569	`$buildable++;`
		570	`}`
		571
		572	`$direct++ if ( $entry->{tlp} );`
		573	`$indirect++ if ( $entry->{slp} );`
		574	`}`
		575
		576	`my $file = "quarantine.raw.txt";`
		577	`Verbose ("Create: $file");`
		578	`my $fh = ConfigurationFile::New( $file );`
		579
		580	`$fh->DumpData(`
		581	`"\n# Package Data.\n#\n",`
		582	`"Packages", \%Packages );`
		583
		584	`$fh->DumpData(`
		585	`"\n# Release Data.\n#\n",`
		586	`"Releases", \%Releases );`
		587
		588	`$fh->Close();`
		589
		590	`Verbose("Packages: $count, Bad: $bad: Buildable: $buildable, Directly included: $direct, Indirect: $indirect");`
		591	`}`
		592
		593	`#-------------------------------------------------------------------------------`
		594	`# Function : prepQdir`
		595	`#`
		596	`# Description : Prepare the quarantine target directory`
		597	`# Setup logging`
		598	`#`
		599	`# Done at the start of the 2nd phase`
		600	`#`
		601	`# Inputs :`
		602	`#`
		603	`# Returns :`
		604	`#`
		605	`sub prepQdir`
		606	`{`
		607	`my ( $ss, $mm, $hh, $dd, $mo, $yy ) = ( localtime($now) )[0..5];`
		608	`my $stamp = sprintf("%4.4d%2.2d%2.2d_%2.2d%2.2d%2.2d", $yy+1900, $mo+1, $dd, $hh,$mm,$ss);`
		609
		610	`$quarantineInstance = join('/', $config{quarantine}, $stamp);`
		611
		612	`my $logName = 'quarantine_' . $stamp . '.txt';`
		613	`$logPath = join('/', $config{logBase}, $logName );`
		614	`eval { mkpath($config{logBase}) } unless -d $config{logBase};`
		615	`Error ("Log directory not found/created: $config{logBase}") unless -d $config{logBase};`
		616
		617	`#`
		618	`# Start the log file`
		619	`Log ("TEST Mode Enabled") if $opt_test;`
		620	`Log ("QuarantinePath: $quarantineInstance");`
3423	dpurdie	621	`Log ("Config: $_ = $config{$_}") foreach ( sort keys %config );`
		622	`Log ("Ignore: $_") foreach ( sort keys %retainPkgs );`
3410	dpurdie	623
		624	`#`
		625	`# Create a 'nice' symlink to the latest log file`
		626	`my $logLatest = join('/', $config{logBase}, 'latest');`
		627	`unlink ( $logLatest );`
		628	`symlink( $logName, $logLatest);`
		629
		630	`#`
		631	`# Clean up old files`
		632	`#`
		633	`opendir( Q, $config{quarantine} ) \|\| Error ("opendir failed on: $config{quarantine}" );`
		634
		635	`# delete any quarantine instance older than 90 days`
		636	`while ( my $file = readdir( Q ) )`
		637	`{`
		638	`#`
		639	`# Skip housekeeping directory entries`
		640	`#`
		641	`next if ( $file eq '.' );`
		642	`next if ( $file eq '..' );`
		643	`next if ( $file eq 'lost+found' );`
		644
		645	`my $path = join( '/', $config{quarantine} . "/" . $file);`
		646	`my $age = checkTime( $path );`
		647	`if ( $age > $config{qdirAge} )`
		648	`{`
		649	`Log ("Old Quarantine Removed: $path");`
		650	`Verbose ("Test: Delete Dir: $path") if ( $opt_test );`
		651	`rmtree($path, 0, 1) unless $opt_test;`
		652	`}`
		653	`}`
		654
		655	`closedir( Q );`
		656	`}`
		657
		658	`#-------------------------------------------------------------------------------`
		659	`# Function : checkTime`
		660	`#`
		661	`# Description : Days since modification of a path`
		662	`#`
		663	`# Inputs : Path elements`
		664	`#`
		665	`# Returns : Days since midification`
		666	`#`
		667
		668	`sub checkTime`
		669	`{`
		670	`my ($path) = @_;`
		671	`my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,`
		672	`$atime,$mtime,$ctime,$blksize,$blocks) = stat($path);`
		673
4127	dpurdie	674	`unless(defined $mtime)`
		675	`{`
		676	`Warning("Bad stat for $path");`
		677	`$mtime = 0;`
		678	`}`
		679
3410	dpurdie	680	`return int( ($now - $mtime) / (60 * 60 * 24));`
		681	`}`
		682
		683	`#-------------------------------------------------------------------------------`
		684	`# Function : processDpkgArchive`
		685	`#`
		686	`# Description : Scan dpkg_archive`
		687	`#`
		688	`# Inputs :`
		689	`#`
		690	`# Returns :`
		691	`#`
		692	`sub processDpkgArchive`
		693	`{`
		694	`Verbose ("Scanning dpkg_archive");`
		695	`opendir( PKGS, $config{dpkg_archive} ) \|\| Error ("Cannot open dpkg_archive");`
		696	`while ( my $pkgName = readdir(PKGS) )`
		697	`{`
		698	`next if ( $pkgName eq '.' );`
		699	`next if ( $pkgName eq '..' );`
		700	`next if ( $pkgName eq 'lost+found' );`
		701	`next if ( exists $retainPkgs{$pkgName} );`
		702
		703	`my $pkgDir = join('/', $config{dpkg_archive}, $pkgName );`
		704	`if ( -d $pkgDir )`
		705	`{`
		706	`if (opendir (PV, $pkgDir ) )`
		707	`{`
		708
		709	`while ( my $pkgVersion = readdir(PV) )`
		710	`{`
		711	`next if ( $pkgVersion eq '.' );`
		712	`next if ( $pkgVersion eq '..' );`
		713	`my $pkgPath = join('/', $config{dpkg_archive}, $pkgName,$pkgVersion );`
		714	`my $mtime = checkTime($pkgPath);`
		715
		716	`my $pvid;`
		717	`if ( exists ($pkgPvid{$pkgName}) && exists($pkgPvid{$pkgName}{$pkgVersion} ) )`
		718	`{`
		719	`$pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};`
		720	`$Packages{$pvid}{dpkg_archive} = 1;`
		721	`$pkgPvid{$pkgName}{$pkgVersion}{mtime} = $mtime;`
		722	`}`
		723	`else`
		724	`{`
		725	`#`
		726	`# Package is in dpkg-archive, but not in Release`
		727	`# Manager. Allow for a short while`
		728	`#`
		729	`if ( $mtime > $config{retainNoRm} )`
		730	`{`
		731	`#Log("Package not in RM: $pkgName, $pkgVersion, Age: $mtime");`
		732	`quarantineItem( 'X', $mtime, $pkgPath );`
		733	`}`
		734	`}`
		735
		736	`#Message("$pkgName, $pkgVersion, $pkgPvid{$pkgName}{$pkgVersion}{mtime}");`
		737	`}`
		738	`close(PV);`
		739	`}`
		740	`}`
		741	`elsif ( -f $pkgDir )`
		742	`{`
		743	`Warning("Unexpected file in dpkg_archive: $pkgName");`
		744	`Log("Unexpected file in dpkg_archive: $pkgName");`
		745	`quarantineItem( 'F', -1, $pkgDir );`
		746	`}`
		747	`else`
		748	`{`
		749	`Warning("Unexpected entry in dpkg_archive: $pkgName");`
		750	`}`
		751	`}`
		752	`close(PKGS);`
		753
		754
		755	`#`
		756	`#`
		757	`# Display information`
		758	`#`
		759	`foreach my $pkgName ( sort keys %pkgPvid )`
		760	`{`
		761	`foreach my $pkgVersion ( sort keys %{$pkgPvid{$pkgName}} )`
		762	`{`
		763	`my $mtime = $pkgPvid{$pkgName}{$pkgVersion}{mtime} \|\| 0;`
		764	`my $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};`
		765
		766	`if ( $pvid && $mtime )`
		767	`{`
		768	`my $entry = $Packages{$pvid};`
		769	`next if ( exists $entry->{tlp} \|\| exists $entry->{slp} );`
		770	`next if ( $mtime <= $config{retain} );`
		771	`next unless ( $entry->{buildStandard} );`
		772	`next if ( $entry->{isPatch} );`
		773	`next if ( $entry->{locked} ne 'Y');`
		774	`# next if ( $entry->{buildType} eq 'M' );`
		775
		776	`Verbose2("Quarantine:$pvid, $pkgName, $pkgVersion, Age:$mtime, Lock:$entry->{locked}, Patch:$entry->{isPatch}, BS:$entry->{buildStandard}, BT:$entry->{buildType}");`
		777	`quarantineItem( 'Q', $mtime, join('/', $config{dpkg_archive}, $pkgName, $pkgVersion ) );`
		778	`}`
		779	`}`
		780	`}`
		781
		782	`#`
		783	`# Perform the quarantine`
		784	`#`
		785	`doQuarantine();`
		786	`ErrorDoExit();`
		787	`}`
		788
		789	`#-------------------------------------------------------------------------------`
		790	`# Function : reportMissingPkgs`
		791	`#`
		792	`# Description : Report packages that 'should' be in dpkg_archive because`
		793	`# they are essential, but are not`
		794	`#`
		795	`# Inputs :`
		796	`#`
		797	`# Returns :`
		798	`#`
		799	`sub reportMissingPkgs`
		800	`{`
		801	`return;`
		802
		803	`#`
		804	`# Not very useful as there is too much information`
		805	`# It would appear that the quarantine process may have also`
		806	`# been deleting packages from 'closed' as well as 'archived'`
		807	`# releases at some stage.`
		808	`#`
		809	`# Report packages used in not-archived or not-closed releases`
		810	`#`
		811	`my @missing;`
		812	`foreach my $pvid (keys %Packages )`
		813	`{`
		814	`my $entry = $Packages{$pvid};`
		815	`next unless ( exists $entry->{tlp} );`
		816	`# next unless ( exists $entry->{slp} );`
		817	`next if ( $entry->{dpkg_archive} );`
		818	`next unless ( exists $entry->{name} );`
		819
		820	`#`
		821	`# Missing package`
		822	`# Determine if its in use by an active release`
		823	`#`
		824
		825	`my @releases = usedBy($pvid);`
		826	`foreach my $release (@releases )`
		827	`{`
		828	`next if ( $Releases{$release}{official} eq 'Y' );`
		829	`next if ( $Releases{$release}{official} eq 'A' );`
		830	`push @missing, $entry->{name} . ' ' . $entry->{version} . " ($pvid)";`
		831	`last;`
		832	`}`
		833	`}`
		834
		835	`Warning ("Packages required by active releases that are not in dpkg_archive", sort @missing);`
		836	`}`
		837
		838	`#-------------------------------------------------------------------------------`
		839	`# Function : usedBy`
		840	`#`
		841	`# Description : Given a pvid, determine which release(s) need it`
		842	`#`
		843	`# Inputs : $pvid`
		844	`#`
		845	`# Returns : Nothing`
		846	`#`
		847	`sub usedBy`
		848	`{`
		849	`my ($pvid) = @_;`
		850	`my %seen;`
		851
		852	`Error ("PVID is not an essential package") unless ( exists $Packages{$pvid} );`
		853
		854	`my @releases = @{$Packages{$pvid}{'release'}} if exists($Packages{$pvid}{'release'});`
		855	`my @users = @{$Packages{$pvid}{'usedBy'}} if exists($Packages{$pvid}{'usedBy'});`
		856
		857	`while ( @users )`
		858	`{`
		859	`my $pv = pop @users;`
		860
		861	`next if ( exists $seen{$pv} );`
		862	`$seen{$pv} = 1;`
		863
		864	`push @releases, @{$Packages{$pv}{'release'}} if (exists $Packages{$pv}{'release'});`
		865	`push @users, @{$Packages{$pv}{'usedBy'}} if (exists($Packages{$pv}{'usedBy'}));`
		866	`}`
		867	`return @releases;`
		868	`}`
		869
		870	`#-------------------------------------------------------------------------------`
		871	`# Function : quarantineItem`
		872	`#`
		873	`# Description : Add item to the list of stuff to be quarantined`
		874	`#`
		875	`# Inputs : $reason - Reason`
		876	`# $age - Age`
		877	`# $path - Path`
		878	`#`
		879	`# Returns :`
		880	`#`
		881	`sub quarantineItem`
		882	`{`
		883	`my ($reason, $age, $path ) = @_;`
		884	`my %data;`
		885	`$data{reason} = $reason;`
		886	`$data{age} = $age;`
		887	`$data{path} = $path;`
		888
		889	`push @quarantineItems, \%data;`
		890	`}`
		891
		892	`#-------------------------------------------------------------------------------`
		893	`# Function : doQuarantine`
		894	`#`
		895	`# Description : Quarantine files and folders that have been queued up`
		896	`#`
		897	`# Inputs : None`
		898	`#`
		899	`# Returns :`
		900	`#`
		901	`sub doQuarantine`
		902	`{`
		903	`my $testMsg = $opt_test ? 'Test,' : '';`
4093	dpurdie	904
		905	`# Process entries - oldest first`
		906	`#`
4127	dpurdie	907	`my $countRemain = ( scalar @quarantineItems );`
4093	dpurdie	908	`foreach my $entry (sort {$b->{age} <=> $a->{age} } @quarantineItems)`
3410	dpurdie	909	`{`
		910	`my $rv;`
		911	`my $emsg = ' - with error';`
		912
		913	`my $path = $entry->{path};`
		914	`my $tpath = $path;`
		915	`$tpath =~ s~^$config{dpkg_archive}~~;`
		916	`$tpath = $quarantineInstance.$tpath;`
		917	`my $tdir = dirname ( $tpath );`
		918
		919	`unless ( $opt_test )`
		920	`{`
		921	`unless (-d $tdir)`
		922	`{`
		923	`eval { mkpath($tdir) };`
		924	`ReportError ("Did not create quarantine target: $tdir")`
		925	`unless (-d $tdir);`
		926	`}`
		927
		928	`if (-d $tdir)`
		929	`{`
		930	`$rv = system ('mv', '-n', $path, $tdir);`
		931	`if ( $rv )`
		932	`{`
		933	`ReportError ("Move $path to $tdir");`
		934	`#`
		935	`# Clean up what may have been moved`
		936	`# NOTE: deleted so that we don't loose stuff if it gets ugly`
		937	`# rmtree( $tpath);`
		938	`# rmdir ($tdir);`
		939	`}`
		940	`else`
		941	`{`
		942	`$emsg = '';`
		943	`}`
		944	`}`
		945	`}`
		946	`else`
		947	`{`
		948	`Verbose2("Test: 'mv', '$path', '$tdir'");`
		949	`$emsg = '';`
		950	`}`
		951
		952	`# Log operation with frills`
		953	`Log (sprintf("Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $emsg));`
4093	dpurdie	954
		955	`# Limit packages quarantined`
4127	dpurdie	956	`$countRemain--;`
4093	dpurdie	957	`if ($opt_pcount > 0)`
		958	`{`
		959	`$opt_pcount--;`
		960	`if ($opt_pcount == 0)`
		961	`{`
4127	dpurdie	962	`Log ("Quarantine package count exceeded. Quarantine terminated. $countRemain packages remaining");`
4093	dpurdie	963	`last;`
		964	`}`
		965	`}`
3410	dpurdie	966	`}`
		967	`}`
		968
		969	`#-------------------------------------------------------------------------------`
		970	`# Function : Log`
		971	`#`
		972	`# Description : Log a string`
		973	`#`
		974	`# Inputs : Line to log`
		975	`#`
		976	`# Returns :`
		977	`#`
		978	`sub Log`
		979	`{`
		980	`my ($line) = @_;`
4093	dpurdie	981	`Verbose("Log: " . $line);`
3410	dpurdie	982
		983	`if (open ( LF, '+>>', $logPath ) )`
		984	`{`
		985	`print LF $line . "\n";`
		986	`close LF;`
		987	`}`
		988	`}`
		989
		990	`#-------------------------------------------------------------------------------`
		991	`# Function : readInputData`
		992	`#`
		993	`# Description : Write out data in a form to allow post processing`
		994	`#`
		995	`# Inputs :`
		996	`#`
		997	`# Returns :`
		998	`#`
		999	`sub readInputData`
		1000	`{`
		1001	`unless ( keys(%Packages) > 0 )`
		1002	`{`
		1003	`my $fname = "quarantine.raw.txt";`
		1004	`Verbose ("Reading: $fname");`
		1005	`Error "Cannot locate $fname" unless ( -f $fname );`
		1006	`require $fname;`
		1007
		1008	`Error "Data in $fname is not valid\n"`
		1009	`unless ( keys(%Packages) > 0 );`
		1010	`}`
		1011
		1012	`#`
		1013	`# Create a lookup from package name/version to pvid`
		1014	`#`
		1015	`Verbose ("Create PackageVersion to PVID hash");`
		1016	`foreach my $pvid ( keys %Packages )`
		1017	`{`
		1018	`my $name = $Packages{$pvid}{name};`
		1019	`my $version = $Packages{$pvid}{version};`
		1020	`if ( $name && $version )`
		1021	`{`
		1022	`$pkgPvid{$name}{$version}{pvid} = $pvid;`
		1023	`}`
		1024	`}`
		1025	`}`
		1026
		1027	`#-------------------------------------------------------------------------------`
		1028	`# Documentation`
		1029	`#`
		1030
		1031	`=pod`
		1032
		1033	`=for htmltoc SYSUTIL::`
		1034
		1035	`=head1 NAME`
		1036
		1037	`jats_quarantine - Determine packages to be quarantined`
		1038
		1039	`=head1 SYNOPSIS`
		1040
		1041	`jats jats_quarantine [options]`
		1042
		1043	`Options:`
		1044	`-help - brief help message`
		1045	`-help -help - Detailed help message`
		1046	`-man - Full documentation`
		1047	`-verbose[=n] - Control output`
		1048	`-phase=nn - Perform named phases`
4092	dpurdie	1049	`-purge - Just purge the old quarantined files`
3410	dpurdie	1050	`-test - Do not delete files`
		1051	`-limit=n - Limit packages processed. Test only`
4093	dpurdie	1052	`-pcount=n - Limit package count`
3410	dpurdie	1053
		1054	`=head1 OPTIONS`
		1055
		1056	`=over 8`
		1057
		1058	`=item B<-help>`
		1059
		1060	`Print a brief help message and exits.`
		1061
		1062	`=item B<-help -help>`
		1063
		1064	`Print a detailed help message with an explanation for each option.`
		1065
		1066	`=item B<-man>`
		1067
		1068	`Prints the manual page and exits.`
		1069
		1070	`=item B<-verbose[=n]>`
		1071
		1072	`This option control the programs output. Normally this program will not generate`
		1073	`any output. It will only generate output on error conditions. This is intentional`
		1074	`as the program will be run as a cron-job and output errors will be mailed out.`
		1075
		1076	`A verbose level of 1. will display progress information`
		1077
		1078	`A verbose level of 3. will display detailed tracing of all operations`
		1079
		1080	`=item B<-phase=list>`
		1081
		1082	`This option will limit the work done by the program. There are two phases`
		1083	`called: 1 and 2.`
		1084
		1085	`Phase-1 will examine Release Manager collect package-version information.`
		1086	`Phase-2 will examine dpkg_archive and collect package-version information. It`
		1087	`will then initiate the quarantine operation.`
		1088
		1089	`The default operation is to perform phase-1 and phase-2.`
		1090
		1091	`If only phase-1 is specified then the RM data is saved, to be used by a`
		1092	`later phase.`
		1093
		1094	`If only phase-2 is specified then saved RM data is restored.`
		1095
		1096	`This option can simplify testing.`
		1097
4092	dpurdie	1098	`=item B<-purge>`
		1099
		1100	`This option will only purge the old quarantine directories. It will not quarantine new`
		1101	`package versions.`
		1102
3410	dpurdie	1103	`=item B<-test>`
		1104
		1105	`Do not delete or move files and directories. Report what would have been done.`
		1106
		1107	`=item B<-limit=n>`
		1108
		1109	`Limit the number of packages processed by the tool. This is only used to`
		1110	`simplify testing of the program`
		1111
		1112	`=back`
		1113
		1114	`=head1 DESCRIPTION`
		1115
		1116	`This program is a tool used in the maintainance of dpkg_archive.`
		1117	`It will:`
		1118
		1119	`=over 8`
		1120
		1121	`=item *`
		1122
		1123	`Determine package-versions in use by Release Manager.`
		1124
		1125	`=item *`
		1126
		1127	`Determine package-versions that can be rebuilt`
		1128
		1129	`=item *`
		1130
		1131	`Recursively find all the dependent packages of all packages. New package`
		1132	`versions are called 'indirect' dependencies. They are buried. This process can`
		1133	`take several minutes.`
		1134
		1135	`=back`
		1136
		1137	`The data collected is dumped into a text file for later processing.`
		1138
		1139	`=cut`
		1140

Subversion Repositories DevTools

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