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
		674	`return int( ($now - $mtime) / (60 * 60 * 24));`
		675	`}`
		676
		677	`#-------------------------------------------------------------------------------`
		678	`# Function : processDpkgArchive`
		679	`#`
		680	`# Description : Scan dpkg_archive`
		681	`#`
		682	`# Inputs :`
		683	`#`
		684	`# Returns :`
		685	`#`
		686	`sub processDpkgArchive`
		687	`{`
		688	`Verbose ("Scanning dpkg_archive");`
		689	`opendir( PKGS, $config{dpkg_archive} ) \|\| Error ("Cannot open dpkg_archive");`
		690	`while ( my $pkgName = readdir(PKGS) )`
		691	`{`
		692	`next if ( $pkgName eq '.' );`
		693	`next if ( $pkgName eq '..' );`
		694	`next if ( $pkgName eq 'lost+found' );`
		695	`next if ( exists $retainPkgs{$pkgName} );`
		696
		697	`my $pkgDir = join('/', $config{dpkg_archive}, $pkgName );`
		698	`if ( -d $pkgDir )`
		699	`{`
		700	`if (opendir (PV, $pkgDir ) )`
		701	`{`
		702
		703	`while ( my $pkgVersion = readdir(PV) )`
		704	`{`
		705	`next if ( $pkgVersion eq '.' );`
		706	`next if ( $pkgVersion eq '..' );`
		707	`my $pkgPath = join('/', $config{dpkg_archive}, $pkgName,$pkgVersion );`
		708	`my $mtime = checkTime($pkgPath);`
		709
		710	`my $pvid;`
		711	`if ( exists ($pkgPvid{$pkgName}) && exists($pkgPvid{$pkgName}{$pkgVersion} ) )`
		712	`{`
		713	`$pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};`
		714	`$Packages{$pvid}{dpkg_archive} = 1;`
		715	`$pkgPvid{$pkgName}{$pkgVersion}{mtime} = $mtime;`
		716	`}`
		717	`else`
		718	`{`
		719	`#`
		720	`# Package is in dpkg-archive, but not in Release`
		721	`# Manager. Allow for a short while`
		722	`#`
		723	`if ( $mtime > $config{retainNoRm} )`
		724	`{`
		725	`#Log("Package not in RM: $pkgName, $pkgVersion, Age: $mtime");`
		726	`quarantineItem( 'X', $mtime, $pkgPath );`
		727	`}`
		728	`}`
		729
		730	`#Message("$pkgName, $pkgVersion, $pkgPvid{$pkgName}{$pkgVersion}{mtime}");`
		731	`}`
		732	`close(PV);`
		733	`}`
		734	`}`
		735	`elsif ( -f $pkgDir )`
		736	`{`
		737	`Warning("Unexpected file in dpkg_archive: $pkgName");`
		738	`Log("Unexpected file in dpkg_archive: $pkgName");`
		739	`quarantineItem( 'F', -1, $pkgDir );`
		740	`}`
		741	`else`
		742	`{`
		743	`Warning("Unexpected entry in dpkg_archive: $pkgName");`
		744	`}`
		745	`}`
		746	`close(PKGS);`
		747
		748
		749	`#`
		750	`#`
		751	`# Display information`
		752	`#`
		753	`foreach my $pkgName ( sort keys %pkgPvid )`
		754	`{`
		755	`foreach my $pkgVersion ( sort keys %{$pkgPvid{$pkgName}} )`
		756	`{`
		757	`my $mtime = $pkgPvid{$pkgName}{$pkgVersion}{mtime} \|\| 0;`
		758	`my $pvid = $pkgPvid{$pkgName}{$pkgVersion}{pvid};`
		759
		760	`if ( $pvid && $mtime )`
		761	`{`
		762	`my $entry = $Packages{$pvid};`
		763	`next if ( exists $entry->{tlp} \|\| exists $entry->{slp} );`
		764	`next if ( $mtime <= $config{retain} );`
		765	`next unless ( $entry->{buildStandard} );`
		766	`next if ( $entry->{isPatch} );`
		767	`next if ( $entry->{locked} ne 'Y');`
		768	`# next if ( $entry->{buildType} eq 'M' );`
		769
		770	`Verbose2("Quarantine:$pvid, $pkgName, $pkgVersion, Age:$mtime, Lock:$entry->{locked}, Patch:$entry->{isPatch}, BS:$entry->{buildStandard}, BT:$entry->{buildType}");`
		771	`quarantineItem( 'Q', $mtime, join('/', $config{dpkg_archive}, $pkgName, $pkgVersion ) );`
		772	`}`
		773	`}`
		774	`}`
		775
		776	`#`
		777	`# Perform the quarantine`
		778	`#`
		779	`doQuarantine();`
		780	`ErrorDoExit();`
		781	`}`
		782
		783	`#-------------------------------------------------------------------------------`
		784	`# Function : reportMissingPkgs`
		785	`#`
		786	`# Description : Report packages that 'should' be in dpkg_archive because`
		787	`# they are essential, but are not`
		788	`#`
		789	`# Inputs :`
		790	`#`
		791	`# Returns :`
		792	`#`
		793	`sub reportMissingPkgs`
		794	`{`
		795	`return;`
		796
		797	`#`
		798	`# Not very useful as there is too much information`
		799	`# It would appear that the quarantine process may have also`
		800	`# been deleting packages from 'closed' as well as 'archived'`
		801	`# releases at some stage.`
		802	`#`
		803	`# Report packages used in not-archived or not-closed releases`
		804	`#`
		805	`my @missing;`
		806	`foreach my $pvid (keys %Packages )`
		807	`{`
		808	`my $entry = $Packages{$pvid};`
		809	`next unless ( exists $entry->{tlp} );`
		810	`# next unless ( exists $entry->{slp} );`
		811	`next if ( $entry->{dpkg_archive} );`
		812	`next unless ( exists $entry->{name} );`
		813
		814	`#`
		815	`# Missing package`
		816	`# Determine if its in use by an active release`
		817	`#`
		818
		819	`my @releases = usedBy($pvid);`
		820	`foreach my $release (@releases )`
		821	`{`
		822	`next if ( $Releases{$release}{official} eq 'Y' );`
		823	`next if ( $Releases{$release}{official} eq 'A' );`
		824	`push @missing, $entry->{name} . ' ' . $entry->{version} . " ($pvid)";`
		825	`last;`
		826	`}`
		827	`}`
		828
		829	`Warning ("Packages required by active releases that are not in dpkg_archive", sort @missing);`
		830	`}`
		831
		832	`#-------------------------------------------------------------------------------`
		833	`# Function : usedBy`
		834	`#`
		835	`# Description : Given a pvid, determine which release(s) need it`
		836	`#`
		837	`# Inputs : $pvid`
		838	`#`
		839	`# Returns : Nothing`
		840	`#`
		841	`sub usedBy`
		842	`{`
		843	`my ($pvid) = @_;`
		844	`my %seen;`
		845
		846	`Error ("PVID is not an essential package") unless ( exists $Packages{$pvid} );`
		847
		848	`my @releases = @{$Packages{$pvid}{'release'}} if exists($Packages{$pvid}{'release'});`
		849	`my @users = @{$Packages{$pvid}{'usedBy'}} if exists($Packages{$pvid}{'usedBy'});`
		850
		851	`while ( @users )`
		852	`{`
		853	`my $pv = pop @users;`
		854
		855	`next if ( exists $seen{$pv} );`
		856	`$seen{$pv} = 1;`
		857
		858	`push @releases, @{$Packages{$pv}{'release'}} if (exists $Packages{$pv}{'release'});`
		859	`push @users, @{$Packages{$pv}{'usedBy'}} if (exists($Packages{$pv}{'usedBy'}));`
		860	`}`
		861	`return @releases;`
		862	`}`
		863
		864	`#-------------------------------------------------------------------------------`
		865	`# Function : quarantineItem`
		866	`#`
		867	`# Description : Add item to the list of stuff to be quarantined`
		868	`#`
		869	`# Inputs : $reason - Reason`
		870	`# $age - Age`
		871	`# $path - Path`
		872	`#`
		873	`# Returns :`
		874	`#`
		875	`sub quarantineItem`
		876	`{`
		877	`my ($reason, $age, $path ) = @_;`
		878	`my %data;`
		879	`$data{reason} = $reason;`
		880	`$data{age} = $age;`
		881	`$data{path} = $path;`
		882
		883	`push @quarantineItems, \%data;`
		884	`}`
		885
		886	`#-------------------------------------------------------------------------------`
		887	`# Function : doQuarantine`
		888	`#`
		889	`# Description : Quarantine files and folders that have been queued up`
		890	`#`
		891	`# Inputs : None`
		892	`#`
		893	`# Returns :`
		894	`#`
		895	`sub doQuarantine`
		896	`{`
		897	`my $testMsg = $opt_test ? 'Test,' : '';`
4093	dpurdie	898
		899	`# Process entries - oldest first`
		900	`#`
		901	`foreach my $entry (sort {$b->{age} <=> $a->{age} } @quarantineItems)`
3410	dpurdie	902	`{`
		903	`my $rv;`
		904	`my $emsg = ' - with error';`
		905
		906	`my $path = $entry->{path};`
		907	`my $tpath = $path;`
		908	`$tpath =~ s~^$config{dpkg_archive}~~;`
		909	`$tpath = $quarantineInstance.$tpath;`
		910	`my $tdir = dirname ( $tpath );`
		911
		912	`unless ( $opt_test )`
		913	`{`
		914	`unless (-d $tdir)`
		915	`{`
		916	`eval { mkpath($tdir) };`
		917	`ReportError ("Did not create quarantine target: $tdir")`
		918	`unless (-d $tdir);`
		919	`}`
		920
		921	`if (-d $tdir)`
		922	`{`
		923	`$rv = system ('mv', '-n', $path, $tdir);`
		924	`if ( $rv )`
		925	`{`
		926	`ReportError ("Move $path to $tdir");`
		927	`#`
		928	`# Clean up what may have been moved`
		929	`# NOTE: deleted so that we don't loose stuff if it gets ugly`
		930	`# rmtree( $tpath);`
		931	`# rmdir ($tdir);`
		932	`}`
		933	`else`
		934	`{`
		935	`$emsg = '';`
		936	`}`
		937	`}`
		938	`}`
		939	`else`
		940	`{`
		941	`Verbose2("Test: 'mv', '$path', '$tdir'");`
		942	`$emsg = '';`
		943	`}`
		944
		945	`# Log operation with frills`
		946	`Log (sprintf("Quarantined:%s%s,%4.4s,%s%s", $testMsg, $entry->{reason}, $entry->{age}, $path, $emsg));`
4093	dpurdie	947
		948	`# Limit packages quarantined`
		949	`if ($opt_pcount > 0)`
		950	`{`
		951	`$opt_pcount--;`
		952	`if ($opt_pcount == 0)`
		953	`{`
		954	`Log ("Quarantine package count exceeded. Quarantine terminated");`
		955	`last;`
		956	`}`
		957	`}`
3410	dpurdie	958	`}`
		959	`}`
		960
		961	`#-------------------------------------------------------------------------------`
		962	`# Function : Log`
		963	`#`
		964	`# Description : Log a string`
		965	`#`
		966	`# Inputs : Line to log`
		967	`#`
		968	`# Returns :`
		969	`#`
		970	`sub Log`
		971	`{`
		972	`my ($line) = @_;`
4093	dpurdie	973	`Verbose("Log: " . $line);`
3410	dpurdie	974
		975	`if (open ( LF, '+>>', $logPath ) )`
		976	`{`
		977	`print LF $line . "\n";`
		978	`close LF;`
		979	`}`
		980	`}`
		981
		982	`#-------------------------------------------------------------------------------`
		983	`# Function : readInputData`
		984	`#`
		985	`# Description : Write out data in a form to allow post processing`
		986	`#`
		987	`# Inputs :`
		988	`#`
		989	`# Returns :`
		990	`#`
		991	`sub readInputData`
		992	`{`
		993	`unless ( keys(%Packages) > 0 )`
		994	`{`
		995	`my $fname = "quarantine.raw.txt";`
		996	`Verbose ("Reading: $fname");`
		997	`Error "Cannot locate $fname" unless ( -f $fname );`
		998	`require $fname;`
		999
		1000	`Error "Data in $fname is not valid\n"`
		1001	`unless ( keys(%Packages) > 0 );`
		1002	`}`
		1003
		1004	`#`
		1005	`# Create a lookup from package name/version to pvid`
		1006	`#`
		1007	`Verbose ("Create PackageVersion to PVID hash");`
		1008	`foreach my $pvid ( keys %Packages )`
		1009	`{`
		1010	`my $name = $Packages{$pvid}{name};`
		1011	`my $version = $Packages{$pvid}{version};`
		1012	`if ( $name && $version )`
		1013	`{`
		1014	`$pkgPvid{$name}{$version}{pvid} = $pvid;`
		1015	`}`
		1016	`}`
		1017	`}`
		1018
		1019	`#-------------------------------------------------------------------------------`
		1020	`# Documentation`
		1021	`#`
		1022
		1023	`=pod`
		1024
		1025	`=for htmltoc SYSUTIL::`
		1026
		1027	`=head1 NAME`
		1028
		1029	`jats_quarantine - Determine packages to be quarantined`
		1030
		1031	`=head1 SYNOPSIS`
		1032
		1033	`jats jats_quarantine [options]`
		1034
		1035	`Options:`
		1036	`-help - brief help message`
		1037	`-help -help - Detailed help message`
		1038	`-man - Full documentation`
		1039	`-verbose[=n] - Control output`
		1040	`-phase=nn - Perform named phases`
4092	dpurdie	1041	`-purge - Just purge the old quarantined files`
3410	dpurdie	1042	`-test - Do not delete files`
		1043	`-limit=n - Limit packages processed. Test only`
4093	dpurdie	1044	`-pcount=n - Limit package count`
3410	dpurdie	1045
		1046	`=head1 OPTIONS`
		1047
		1048	`=over 8`
		1049
		1050	`=item B<-help>`
		1051
		1052	`Print a brief help message and exits.`
		1053
		1054	`=item B<-help -help>`
		1055
		1056	`Print a detailed help message with an explanation for each option.`
		1057
		1058	`=item B<-man>`
		1059
		1060	`Prints the manual page and exits.`
		1061
		1062	`=item B<-verbose[=n]>`
		1063
		1064	`This option control the programs output. Normally this program will not generate`
		1065	`any output. It will only generate output on error conditions. This is intentional`
		1066	`as the program will be run as a cron-job and output errors will be mailed out.`
		1067
		1068	`A verbose level of 1. will display progress information`
		1069
		1070	`A verbose level of 3. will display detailed tracing of all operations`
		1071
		1072	`=item B<-phase=list>`
		1073
		1074	`This option will limit the work done by the program. There are two phases`
		1075	`called: 1 and 2.`
		1076
		1077	`Phase-1 will examine Release Manager collect package-version information.`
		1078	`Phase-2 will examine dpkg_archive and collect package-version information. It`
		1079	`will then initiate the quarantine operation.`
		1080
		1081	`The default operation is to perform phase-1 and phase-2.`
		1082
		1083	`If only phase-1 is specified then the RM data is saved, to be used by a`
		1084	`later phase.`
		1085
		1086	`If only phase-2 is specified then saved RM data is restored.`
		1087
		1088	`This option can simplify testing.`
		1089
4092	dpurdie	1090	`=item B<-purge>`
		1091
		1092	`This option will only purge the old quarantine directories. It will not quarantine new`
		1093	`package versions.`
		1094
3410	dpurdie	1095	`=item B<-test>`
		1096
		1097	`Do not delete or move files and directories. Report what would have been done.`
		1098
		1099	`=item B<-limit=n>`
		1100
		1101	`Limit the number of packages processed by the tool. This is only used to`
		1102	`simplify testing of the program`
		1103
		1104	`=back`
		1105
		1106	`=head1 DESCRIPTION`
		1107
		1108	`This program is a tool used in the maintainance of dpkg_archive.`
		1109	`It will:`
		1110
		1111	`=over 8`
		1112
		1113	`=item *`
		1114
		1115	`Determine package-versions in use by Release Manager.`
		1116
		1117	`=item *`
		1118
		1119	`Determine package-versions that can be rebuilt`
		1120
		1121	`=item *`
		1122
		1123	`Recursively find all the dependent packages of all packages. New package`
		1124	`versions are called 'indirect' dependencies. They are buried. This process can`
		1125	`take several minutes.`
		1126
		1127	`=back`
		1128
		1129	`The data collected is dumped into a text file for later processing.`
		1130
		1131	`=cut`
		1132

Subversion Repositories DevTools

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