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

Subversion Repositories DevTools

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