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

Subversion Repositories DevTools

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