WebSVN – DevTools – Blame – /dpkg_blat/trunk/src/blat/blatDaemon.pl

Rev	Author	Line No.	Line
1038	dpurdie	1	`#! /usr/bin/perl`
		2	`########################################################################`
		3	`# Copyright (C) 2011 Vix-ERG Limited, All rights reserved`
		4	`#`
		5	`# Module name : blatDaemon.pl`
		6	`# Module type :`
		7	`# Compiler(s) : Perl`
		8	`# Environment(s):`
		9	`#`
		10	`# Description :`
		11	`#`
		12	`# Usage : ARGV[0] - Path to config file for this instance`
		13	`#`
		14	`#......................................................................#`
		15
		16	`require 5.008_002;`
		17	`use strict;`
		18	`use warnings;`
		19	`use Getopt::Long;`
		20	`use File::Basename;`
1040	dpurdie	21	`use Data::Dumper;`
		22	`use File::Spec::Functions;`
1038	dpurdie	23	`use POSIX ":sys_wait_h";`
		24	`use File::Temp qw/tempfile/;`
		25
		26	`use FindBin; # Determine the current directory`
		27	`use lib "$FindBin::Bin/lib"; # Allow local libraries`
		28
		29	`use Utils;`
		30	`use StdLogger; # Log to sdtout`
		31	`use Logger; # Log to file`
		32
		33	`#`
		34	`# Database interface`
		35	`# Pinched from jats and modified so that this software is not dependent on JATS`
		36	`#`
		37	`use IO::Handle;`
		38	`use JatsRmApi;`
		39	`use DBI;`
		40
		41	`#`
		42	`# Globals`
		43	`#`
		44	`my $logger = StdLogger->new(); # Stdout logger. Only during config`
		45	`my $name = basename( $ARGV[0]);`
		46	`$name =~ s~.conf$~~;`
		47	`my $now = 0;`
		48	`my $tagDirTime = 0;`
		49	`my $lastDirScan = 0;`
		50	`my $lastReleaseScan = 0;`
1040	dpurdie	51	`my $releaseScanMode = 0;`
		52	`my $lastTagListScan = 0;`
1038	dpurdie	53	`my $transferred;`
		54	`my $mtimeConfig = 0;`
		55	`my $conf;`
		56	`my $extraPkgs;`
1040	dpurdie	57	`my $excludePkgs;`
		58	`my %releaseData;`
1038	dpurdie	59
		60	`#`
		61	`# Describe config uration parameters`
		62	`#`
		63	`my %cdata = (`
		64	`'.ignore' => {'pkg\.(.+)' => 'pkgs' },`
1048	dpurdie	65	`'piddir' => {'mandatory' => 1 , 'fmt' => 'dir'},`
		66	`'sleep' => {'default' => 5 , 'fmt' => 'period'},`
		67	`'dpkg_archive' => {'mandatory' => 1 , 'fmt' => 'dir'},`
		68	`'logfile' => {'mandatory' => 1 , 'fmt' => 'vfile'},`
		69	`'logfile.size' => {'default' => '1M' , 'fmt' => 'size'},`
		70	`'logfile.count' => {'default' => 9 , 'fmt' => 'int'},`
		71	`'verbose' => {'default' => 0 , 'fmt' => 'int'},`
		72	`'user' => {'mandatory' => 1 , 'fmt' => 'text'},`
		73	`'hostname' => {'mandatory' => 1 , 'fmt' => 'text'},`
		74	`'identity' => {'mandatory' => 1 , 'fmt' => 'file'},`
		75	`'bindir' => {'mandatory' => 1 , 'fmt' => 'text'},`
		76	`'tagdir' => {'mandatory' => 1 , 'fmt' => 'dir'},`
		77	`'forcedirscan' => {'default' => 100 , 'fmt' => 'period'},`
		78	`'tagage' => {'default' => '10m' , 'fmt' => 'period'},`
		79	`'tagListUpdate' => {'default' => '1h' , 'fmt' => 'period'},`
		80	`'synctime' => {'default' => '2h' , 'fmt' => 'period'},`
		81	`'syncretry' => {'default' => '5m' , 'fmt' => 'period'},`
		82	`'allProjects' => {'default' => 0 , 'fmt' => 'bool'},`
		83	`'project' => {'mandatory' => 0 , 'fmt' => 'int_list'},`
		84	`'release' => {'mandatory' => 0 , 'fmt' => 'int_list'},`
		85	`'writewindow' => {'default' => '3h' , 'fmt' => 'period'},`
		86	`'maxpackages' => {'default' => 5 , 'fmt' => 'int'},`
		87	`'deletePackages' => {'default' => 0 , 'fmt' => 'bool'},`
		88	`'deleteImmediate' => {'default' => 0 , 'fmt' => 'bool'},`
		89	`'deleteAge' => {'default' => 0 , 'fmt' => 'period'},`
		90	`'packageFilter' => {'default' => undef , 'fmt' => 'text'},`
		91	`'active' => {'default' => 1 , 'fmt' => 'bool'},`
1038	dpurdie	92	`);`
		93
		94
		95	`#`
		96	`# Read in the configuration`
		97	`# Set up a logger`
		98	`# Write a pidfile - thats not used`
		99	`readConfig();`
		100	`Utils::writepid($conf);`
		101	`$logger->logmsg("Starting...");`
		102	`sighandlers($conf);`
		103
		104	`#`
		105	`# Main processing loop`
		106	`# Will exit when terminated by parent`
		107	`#`
		108	`while ( 1 )`
		109	`{`
		110	`$logger->verbose3("Processing");`
		111	`$now = time();`
1040	dpurdie	112
1038	dpurdie	113	`$transferred = {};`
		114	`readConfig();`
1048	dpurdie	115	`if ( $conf->{'active'} )`
		116	`{`
		117	`processReleaseList();`
		118	`processTags();`
		119	`maintainTagList();`
		120	`}`
1040	dpurdie	121	`%releaseData = ();`
		122
1038	dpurdie	123	`sleep( $conf->{'sleep'} );`
1050	dpurdie	124
		125	`#`
		126	`# Reap any and all dead children`
		127	`#`
		128	`my $kid;`
		129	`do {`
		130	`$kid = waitpid(-1, WNOHANG);`
		131	`} while ( $kid > 0 );`
1038	dpurdie	132	`}`
		133	`$logger->logmsg("Child End");`
		134	`exit 0;`
		135
		136	`#-------------------------------------------------------------------------------`
		137	`# Function : readConfig`
		138	`#`
		139	`# Description : Re read the config file if it modification time has changed`
		140	`#`
		141	`# Inputs : Nothing`
		142	`#`
1289	dpurdie	143	`# Returns : 0 - Config not read`
		144	`# 1 - Config read`
		145	`# Config file has changed`
1038	dpurdie	146	`#`
		147	`sub readConfig`
		148	`{`
		149	`my ($mtime) = Utils::mtime($ARGV[0]);`
1289	dpurdie	150	`my $rv = 0;`
		151
1038	dpurdie	152	`if ( $mtimeConfig != $mtime )`
		153	`{`
		154	`$logger->logmsg("Reading config file: $ARGV[0]");`
		155	`$mtimeConfig = $mtime;`
		156	`my $errors;`
		157	`($conf, $errors) = Utils::readconf ( $ARGV[0], \%cdata );`
		158	`if ( scalar @{$errors} > 0 )`
		159	`{`
		160	`warn "$_\n" foreach (@{$errors});`
		161	`die ("Config contained errors\n");`
		162	`}`
		163
		164	`#`
		165	`# Reset some information`
		166	`# Create a new logger`
		167	`#`
		168	`$logger = Logger->new($conf);`
		169	`$conf->{logger} = $logger;`
		170	`$conf->{'pidfile'} = $conf->{'piddir'} . '/' . $name . '.pid';`
		171	`$logger->verbose("Log Levl: $conf->{verbose}");`
		172
		173	`#`
		174	`# Extract extra package config`
		175	`#`
		176	`$extraPkgs = {};`
1040	dpurdie	177	`$excludePkgs = {};`
1038	dpurdie	178	`while (my($key, $data) = each ( %{$conf->{pkgs}} ))`
		179	`{`
1040	dpurdie	180	`if ( $data eq 'EXCLUDE' )`
		181	`{`
		182	`$excludePkgs->{$key} = 1;`
		183	`$logger->verbose("Exclude Pkg: $key");`
		184	`}`
		185	`else`
		186	`{`
		187	`$extraPkgs->{$key}{$data} = 1;`
		188	`$logger->verbose("Extra Pkg: $key -> $data");`
		189	`}`
1038	dpurdie	190	`}`
1046	dpurdie	191
1048	dpurdie	192	`$logger->verbose("Filter Packages: " . $conf->{'packageFilter'})`
		193	`if ( defined $conf->{'packageFilter'} );`
		194
		195	`$logger->warn("Transfer session configured as not active")`
		196	`unless ( $conf->{'active'} );`
		197
		198	`$logger->warn("Transfer all projects packages")`
1050	dpurdie	199	`if ( $conf->{'allProjects'} );`
1048	dpurdie	200
1046	dpurdie	201	`#`
		202	`# When config is read force some actions`
		203	`# - Force tagList to be created`
1050	dpurdie	204	`# - Force release scan`
1048	dpurdie	205	`$lastTagListScan = 0;`
1050	dpurdie	206	`$lastReleaseScan = 0;`
1289	dpurdie	207	`$rv = 1;`
1038	dpurdie	208	`}`
1289	dpurdie	209	`return $rv;`
1038	dpurdie	210	`}`
		211
		212
		213	`#-------------------------------------------------------------------------------`
		214	`# Function : processReleaseList`
		215	`#`
		216	`# Description : Process the release list`
		217	`# Determine if its time to process release list`
		218	`# Determine release list`
		219	`# Determine release content`
		220	`# Determine new items`
		221	`#`
		222	`# Inputs : None`
		223	`#`
		224	`# Returns : Nothing`
		225	`#`
		226	`sub processReleaseList`
		227	`{`
		228	`#`
1044	dpurdie	229	`# Is Release List Processing active`
		230	`# Can configure blat to disable release sync`
		231	`# This will then allow 'new' packages to be sent`
		232	`#`
		233	`if ( $conf->{maxpackages} == 0 \|\| $conf->{'synctime'} <= 0)`
		234	`{`
		235	`$logger->verbose2("processReleaseList disabled");`
		236	`return;`
		237	`}`
		238
		239	`#`
1038	dpurdie	240	`# Time to perform the scan`
		241	`# Will do at startup and every time period there after`
		242	`#`
1040	dpurdie	243	`my $wtime = $releaseScanMode ? $conf->{'syncretry'} : $conf->{'synctime'};`
		244	`return unless ( $now > ($lastReleaseScan + $wtime ));`
1038	dpurdie	245	`$logger->verbose("processReleaseList");`
		246	`$lastReleaseScan = $now;`
1040	dpurdie	247	`$releaseScanMode = 1; # Assume error`
1038	dpurdie	248
		249	`#`
		250	`# Get list of packages from Remote site`
		251	`# Invoke a program on the remote site and parse the results`
		252	`#`
		253	`# ssh -i ./ssh/id_rsa_pkg_admin pkg_admin@10.247.28.57 "./get_plist.pl"`
		254	`#`
		255	`# Returned data looks like:`
1042	dpurdie	256	`# 1141792602 GMT(Wed Mar 8 04:36:42 2006) [DL] ishieldmodules/11.5.0.cots`
1038	dpurdie	257	`#`
		258	`#`
		259	`my $remotePkgList;`
		260	`my $ph;`
1040	dpurdie	261	`my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";`
		262	`my $ssh_cmd = "ssh -n -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";`
1038	dpurdie	263
		264	`$logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");`
		265	`open ($ph, "$ssh_cmd \|");`
		266	`while ( <$ph> )`
		267	`{`
		268	`chomp;`
1042	dpurdie	269	`if ( parsePkgList($_, \%{$remotePkgList} ) )`
1038	dpurdie	270	`{`
		271	`$logger->verbose2("processReleaseList:Data: $_");`
		272	`}`
		273	`else`
		274	`{`
		275	`$logger->warn("processReleaseList:Bad Data: $_");`
		276	`}`
		277	`}`
		278	`close ($ph);`
		279	`$logger->verbose("processReleaseList:End: $?");`
		280	`if ( $? != 0 )`
		281	`{`
		282	`$logger->warn("Cannot retrieve package list: $?");`
		283	`return;`
		284	`}`
1042	dpurdie	285	`#Utils::DebugDumpData ("remotePkgList", $remotePkgList);`
		286
1038	dpurdie	287
		288	`#`
		289	`# Determine the set of packages in the releases to be transferred`
		290	`# Examine`
		291	`#`
		292	`my @rlist = getReleaseList();`
1040	dpurdie	293	`unless ( @rlist )`
		294	`{`
		295	`$logger->verbose2("No Releases to Process");`
		296	`return;`
		297	`}`
1038	dpurdie	298	`my $pkgList = getPkgList(@rlist);`
		299
		300	`#`
		301	`# Append extra packages`
		302	`# These are packages that are specifically named by the user`
		303	`#`
		304	`# Note: If there are symbolic links, then the target of the`
		305	`# link is treated used as the package name`
		306	`#`
		307	`# Symlink MUST be within the same directory`
		308	`#`
		309	`# Used to transfer jats2_current`
		310	`#`
		311	`my $pkgLink;`
		312	`while ( (my ($pname, $pvers)) = each %{$extraPkgs} ) {`
		313	`while ( (my ($pver, $pdata) ) = each %{$pvers} ) {`
		314
1040	dpurdie	315	`my $epath = catfile( $conf->{'dpkg_archive'} , $pname, $pver );`
1038	dpurdie	316	`if ( -l $epath )`
		317	`{`
		318	`my $lver = readlink( $epath );`
		319	`if ( ! defined $lver )`
		320	`{`
		321	`$logger->warn("Cant resolve symlink: $pname, $pver");`
		322	`next;`
		323	`}`
		324
		325	`if ( $lver =~ m ~/~ )`
		326	`{`
		327	`$logger->warn("Won't resolve symlink: $pname, $pver, $lver");`
		328	`next;`
		329	`}`
		330	`$pkgLink->{$pname}{$pver} = $lver;`
		331	`$pdata = $pver;`
		332	`$pver = $lver;`
		333	`}`
		334
		335	`$logger->verbose2("Add extra package: $pname, $pver, $pdata");`
		336	`$pkgList->{$pname}{$pver} = $pdata;`
		337	`}`
		338	`}`
		339
1040	dpurdie	340	`#`
		341	`# If there are no packages to process, then assume that this is an error`
		342	`# condition. Retry the operation soon.`
		343	`#`
		344	`unless ( keys %{$pkgList} )`
		345	`{`
		346
		347	`$logger->verbose2("No packages to process");`
		348	`return;`
		349	`}`
		350
1038	dpurdie	351	`# while ( (my ($pname, $pvers)) = each %{$pkgList} )`
		352	`# {`
		353	`# while ( (my ($pver, $ptime) ) = each %{$pvers} )`
		354	`# {`
		355	`# print "L-- $pname, $pver, $ptime \n";`
		356	`#`
		357	`# }`
		358	`# }`
		359
		360	`#`
1040	dpurdie	361	`# Delete Excess Packages`
1038	dpurdie	362	`# Packages not required on the target`
1042	dpurdie	363	`# KLUDGE: Don't delete links to packages`
		364	`# Don't delete packages marked for deletion`
1038	dpurdie	365	`#`
		366	`my $excessPkgList;`
1048	dpurdie	367	`my $excessPkgListCount = 0;`
1038	dpurdie	368	`if ( $conf->{deletePackages} )`
		369	`{`
		370	`while ( (my ($pname, $pvers)) = each %{$remotePkgList} )`
		371	`{`
		372	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
		373	`{`
		374	`if ( !exists $pkgList->{$pname}{$pver} )`
		375	`{`
		376	`if ( exists $pkgLink->{$pname}{$pver} )`
		377	`{`
		378	`$logger->verbose2("Keep Excess package-link: ${pname}/${pver}");`
		379	`next;`
		380	`}`
1040	dpurdie	381
		382	`if ( exists $excludePkgs->{$pname} )`
		383	`{`
		384	`$logger->verbose2("Keep Excluded package: ${pname}");`
		385	`next;`
		386	`}`
		387
1042	dpurdie	388	`if ( exists $pdata->{deleted} )`
		389	`{`
		390	`if ( $conf->{deleteAge} )`
		391	`{`
		392	`if ( $pdata->{deleted} <= $conf->{deleteAge} )`
		393	`{`
		394	`$logger->verbose2("Already marked for future age deletion: ${pname}/${pver}, $pdata->{deleted}");`
		395	`next;`
		396	`}`
		397	`$pdata->{FORCEDELETE} = 1;`
		398	`}`
		399
		400	`if ( !$conf->{deleteImmediate} )`
		401	`{`
		402	`$logger->verbose2("Already marked for deletion: ${pname}/${pver}");`
		403	`next;`
		404	`}`
		405	`}`
		406
		407	`#`
		408	`# Force deletion`
		409	`# deleteImmediate mode`
		410	`# target is a broken link`
		411	`#`
		412	`$pdata->{FORCEDELETE} = 1`
		413	`if ($conf->{deleteImmediate} \|\| $pdata->{broken});`
		414
1038	dpurdie	415	`$excessPkgList->{$pname}{$pver} = $pdata;`
1048	dpurdie	416	`$excessPkgListCount++;`
1038	dpurdie	417	`$logger->verbose("Excess package: ${pname}/${pver}");`
		418	`}`
1050	dpurdie	419	`# else`
		420	`# {`
		421	`# $logger->verbose3("Retain package: ${pname}/${pver}");`
		422	`# }`
1038	dpurdie	423	`}`
		424	`}`
		425	`}`
		426
		427	`#`
		428	`# Process the remote list and the local list`
		429	`# The remote time-stamp is the modification time of the packages descpkg file`
		430	`#`
		431	`# Mark for transfer packages that`
1040	dpurdie	432	`# Are in the local set but not the remote set`
1038	dpurdie	433	`# Have a different time stamp`
		434	`#`
		435	`# Ignore packages not in the local archive`
		436	`# Ignore packages that don't have a descpkg`
		437	`# Ignore packages that are writable - still being formed`
		438	`#`
		439	`my $needPkgList;`
1048	dpurdie	440	`my $needPkgListCount = 0;`
		441	`my $filteredCount = 0;`
		442	`my $missingCount = 0;`
		443	`my $writableCount = 0;`
		444	`my $excludeCount = 0;`
1038	dpurdie	445	`while ( (my ($pname, $pvers)) = each %{$pkgList} )`
		446	`{`
1040	dpurdie	447	`#`
		448	`# Ignore excluded packages`
		449	`#`
1048	dpurdie	450	`if ( exists $excludePkgs->{$pname} )`
		451	`{`
		452	`$excludeCount++;`
		453	`next;`
		454	`}`
1040	dpurdie	455
1048	dpurdie	456	`#`
		457	`# Ignore packages that are filtered out`
		458	`#`
		459	`if ( defined $conf->{'packageFilter'} )`
		460	`{`
		461	`unless ( $pname =~ m~$conf->{'packageFilter'}~ )`
		462	`{`
		463	`$logger->verbose3("Filtering out: ${pname}");`
		464	`$filteredCount++;`
		465	`next;`
		466	`}`
		467	`}`
		468
1038	dpurdie	469	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
		470	`{`
1042	dpurdie	471	`my $tmtime = $remotePkgList->{$pname}{$pver}{time} \|\| 0;`
1038	dpurdie	472
		473	`# Package is present in both list`
1040	dpurdie	474	`my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));`
1038	dpurdie	475	`if ( $mtime == 0 )`
		476	`{`
		477	`# PackageVersion not in local archive (at least the descpkg file is not)`
		478	`# Skip now - will pick it up later`
		479	`$logger->verbose("Package not in dpkg_archive: $pname, $pver");`
1048	dpurdie	480	`$missingCount++;`
1038	dpurdie	481	`next;`
		482	`}`
		483
		484	`if ( $mode & 0222 )`
		485	`{`
		486	`# Descpkg file is writable`
		487	`# Package may be in the process of being created`
1048	dpurdie	488	`# If the package has been writable for a long time, then`
1038	dpurdie	489	`# consider for transfer`
		490	`my $age = $now - $mtime;`
		491	`if ( $age < ($conf->{'writewindow '} \|\| 600) )`
		492	`{`
		493	`$logger->verbose("Package is writable: $pname, $pver, ", $now - $mtime);`
1048	dpurdie	494	`$writableCount++;`
1038	dpurdie	495	`next;`
		496	`}`
		497	`}`
		498
		499	`if ( $mtime != $tmtime )`
		500	`{`
		501	`# Package not present on target, or timestamps differ`
		502	`$logger->verbose("Package Needs to be transferred: $pname, $pver, $mtime, $tmtime");`
		503	`$needPkgList->{$pname}{$pver} = $pdata;`
1048	dpurdie	504	`$needPkgListCount++;`
1038	dpurdie	505	`next;`
		506	`}`
		507	`}`
		508	`}`
		509
1048	dpurdie	510
1038	dpurdie	511	`#`
		512	`# Debug output only`
		513	`# Display what we need to transfer`
		514	`#`
		515	`if ( $conf->{verbose} > 2 )`
		516	`{`
		517	`while ( (my ($pname, $pvers)) = each %{$needPkgList} )`
		518	`{`
		519	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
		520	`{`
		521	`$logger->verbose("Need to transfer: $pname, $pver, $pdata");`
		522	`}`
		523	`}`
		524	`}`
1048	dpurdie	525	`if ( $conf->{verbose} )`
		526	`{`
		527	`$logger->verbose("Packages to transfer: $needPkgListCount");`
		528	`$logger->verbose("Packages to delete: $excessPkgListCount");`
		529	`$logger->verbose("Packages filtered out: $filteredCount");`
		530	`$logger->verbose("Packages missing: $missingCount");`
		531	`$logger->verbose("Packages still writable: $writableCount");`
		532	`$logger->verbose("Packages excluded: $excludeCount");`
		533	`}`
1038	dpurdie	534
		535	`#`
		536	`# Time to do the real work`
		537	`# Transfer packages and delete excess packages`
		538	`# Note: Perform the transfers first`
		539	`# Limit the number of packages processed in one pass`
		540	`#`
		541	`my $txcount = $conf->{maxpackages};`
		542
		543	`#`
		544	`# Transfer packages that we have identified`
		545	`#`
		546	`send_pkgs:`
		547	`while ( (my ($pname, $pvers)) = each %{$needPkgList} )`
		548	`{`
		549	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
		550	`{`
		551	`if ( --$txcount <= 0 )`
		552	`{`
1050	dpurdie	553	`$logger->warn("Max transfer count exceeded: $needPkgListCount transfer remaining");`
1038	dpurdie	554	`$lastReleaseScan = 0;`
		555	`last send_pkgs;`
		556	`}`
1289	dpurdie	557
		558	`if ( readConfig() )`
		559	`{`
		560	`$logger->warn("Config file changed");`
		561	`$lastReleaseScan = 0;`
		562	`$txcount = 0;`
		563	`last send_pkgs;`
		564	`}`
		565
1044	dpurdie	566	`transferPackage ($pname, $pver, $pdata);`
1048	dpurdie	567	`$needPkgListCount--;`
1038	dpurdie	568	`}`
		569	`}`
		570
		571	`#`
		572	`# Delete packages that have been identified as excess`
		573	`#`
		574	`delete_pkgs:`
		575	`while ( (my ($pname, $pvers)) = each %{$excessPkgList} )`
		576	`{`
		577	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
		578	`{`
		579	`if ( --$txcount <= 0 )`
		580	`{`
1050	dpurdie	581	`$logger->warn("Max transfer count exceeded: $excessPkgListCount deletion remaining");`
1038	dpurdie	582	`$lastReleaseScan = 0;`
		583	`last delete_pkgs;`
		584	`}`
1289	dpurdie	585
		586	`if ( readConfig() )`
		587	`{`
		588	`$logger->warn("Config file changed");`
		589	`$lastReleaseScan = 0;`
		590	`$txcount = 0;`
		591	`last send_pkgs;`
		592	`}`
		593
1044	dpurdie	594	`deletePackage ($pname, $pver, $pdata);`
1048	dpurdie	595	`$excessPkgListCount--;`
1038	dpurdie	596	`}`
		597	`}`
		598
		599	`#`
		600	`# Send package list to the target`
		601	`#`
		602	`sendPackageList ($pkgList);`
1040	dpurdie	603
		604	`#`
		605	`# On a successful transfer`
		606	`# Force tag processing`
		607	`# Set scan Mode to normal`
		608	`#`
		609	`$tagDirTime = 0;`
		610	`$releaseScanMode = 0;`
1038	dpurdie	611	`}`
		612
		613	`#-------------------------------------------------------------------------------`
		614	`# Function : sendPackageList`
		615	`#`
		616	`# Description : Transfer package list to the target`
		617	`#`
		618	`# Inputs : $pkgList - Ref to hash of package names and versions`
		619	`#`
1040	dpurdie	620	`# Returns : Nothing`
		621	`# Don't really care about any errors from this process`
		622	`# Its not essential`
1038	dpurdie	623	`#`
		624	`sub sendPackageList`
		625	`{`
		626	`my ($pkgList) = @_;`
		627	`my ($fh, $filename) = tempfile( "/tmp/blat.$$.XXXX", SUFFIX => '.txt');`
		628	`$logger->verbose("sendPackageList:TmpFile: $filename");`
		629
		630	`#`
		631	`# Create a temp file with data`
		632	`#`
		633	`foreach my $pname ( sort keys %{$pkgList} )`
		634	`{`
		635	`foreach my $pver ( sort keys %{$pkgList->{$pname}} )`
		636	`{`
		637	`print $fh "$pname/$pver\n";`
		638	`}`
		639	`}`
		640	`close $fh;`
		641
		642	`#`
		643	`# Transfer to target`
		644	`# Create the process pipe to transfer the file`
		645	`# gzip the file and pipe the result through a ssh session to the target machine`
		646	`# gzip -c filename \| ssh -i $IDENTITY pkg_admin@${TARGET_HOST} "./receive_file filename"`
		647	`#`
		648	`my $ph;`
		649	`my $gzip_cmd = "gzip --no-name -c \"$filename\"";`
1040	dpurdie	650	`my $tgt_cmd = "$conf->{'bindir'}/receive_file \"ArchiveList\"";`
		651	`my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";`
1038	dpurdie	652
		653	`$logger->verbose2("sendPackageList:gzip_cmd:$gzip_cmd");`
		654	`$logger->verbose2("sendPackageList:tgt_cmd:$tgt_cmd");`
		655	`$logger->verbose2("sendPackageList:ssh_cmd:$ssh_cmd");`
		656
		657	`open ($ph, "$gzip_cmd \| $ssh_cmd \|");`
		658	`while ( <$ph> )`
		659	`{`
		660	`chomp;`
		661	`$logger->verbose2("sendPackageList:Data: $_");`
		662	`}`
		663	`close ($ph);`
		664	`$logger->verbose("sendPackageList:End: $?");`
		665	`unlink $filename;`
		666	`}`
		667
		668
		669	`#-------------------------------------------------------------------------------`
		670	`# Function : getPkgList`
		671	`#`
		672	`# Description : Determine a set of package versions within the list`
		673	`# of provided releases`
		674	`#`
		675	`# Inputs : @rlist - A list of releases to examine`
		676	`#`
		677	`# Returns : Ref to a hask of package versions`
		678	`#`
		679	`sub getPkgList`
		680	`{`
		681	`my %pdata;`
		682	`my $RM_DB;`
		683	`connectRM(\$RM_DB);`
		684	`$logger->verbose("getPkgList");`
		685
		686	`#`
		687	`# Determine the releases that are in this project`
		688	`# Build up an sql query`
		689	`#`
		690	`my @m_rlist;`
		691	`push @m_rlist,"rc.RTAG_ID=$_" foreach ( @_ );`
		692	`my $m_rlist = join ' OR ', @m_rlist;`
1048	dpurdie	693	`my $m_sqlstr = "SELECT DISTINCT pv.PV_ID, pkg.PKG_NAME, pv.PKG_VERSION, pv.IS_DEPLOYABLE" .`
1038	dpurdie	694	`" FROM RELEASE_MANAGER.RELEASE_CONTENT rc, RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .`
		695	`" WHERE ( $m_rlist ) AND rc.PV_ID = pv.PV_ID AND pv.PKG_ID = pkg.PKG_ID" .`
		696	`" ORDER by PKG_NAME DESC";`
		697	`$logger->verbose3("getPkgList:Sql:$m_sqlstr");`
		698
		699	`my $sth = $RM_DB->prepare($m_sqlstr);`
		700	`if ( defined($sth) )`
		701	`{`
		702	`if ( $sth->execute( ) )`
		703	`{`
		704	`if ( $sth->rows )`
		705	`{`
		706	`while (my @row = $sth->fetchrow_array )`
		707	`{`
		708	`$logger->verbose2("getPkgList:Data:@row");`
		709	`$pdata{$row[1]}{$row[2]} = 1;`
		710	`}`
		711	`}`
		712	`$sth->finish();`
		713	`}`
		714	`}`
		715	`else`
		716	`{`
		717	`$logger->warn("getPkgList: SQL Prepare failure");`
		718	`}`
1050	dpurdie	719
		720	`disconnectRM(\$RM_DB);`
1038	dpurdie	721	`return \%pdata;`
		722	`}`
		723
		724
		725	`#-------------------------------------------------------------------------------`
		726	`# Function : getReleaseList`
		727	`#`
		728	`# Description : Determine the list of releases to be proccessed`
1040	dpurdie	729	`# From:`
		730	`# Convert projects to a list of releases`
		731	`# Configured list of releases`
1038	dpurdie	732	`#`
		733	`# Inputs : None`
		734	`#`
		735	`# Returns : A list of releases to be processed`
		736	`#`
		737	`sub getReleaseList`
		738	`{`
		739	`my $RM_DB;`
		740	`my %rlist;`
1048	dpurdie	741	`my $m_sqlstr;`
1038	dpurdie	742	`$logger->verbose("getReleaseList");`
		743
		744	`#`
1040	dpurdie	745	`# Cache data`
		746	`# Only for one cycle of the main loop`
		747	`#`
		748	`if ( exists $releaseData{getReleaseList} )`
		749	`{`
		750	`$logger->verbose3("getReleaseList:Cache hit");`
		751	`return @{$releaseData{getReleaseList}};`
		752	`}`
		753
		754	`#`
1048	dpurdie	755	`# All projects`
1038	dpurdie	756	`#`
1048	dpurdie	757	`if ( $conf->{'allProjects'} )`
1038	dpurdie	758	`{`
1048	dpurdie	759	`$m_sqlstr = "SELECT rt.RTAG_ID" .`
		760	`" FROM RELEASE_MANAGER.RELEASE_TAGS rt" .`
1050	dpurdie	761	`" WHERE rt.OFFICIAL != 'A'";`
		762	`#" AND rt.OFFICIAL != 'Y'";`
1048	dpurdie	763	`}`
		764	`else`
		765	`{`
1038	dpurdie	766	`#`
1048	dpurdie	767	`# Convert list of projects into a list of releases`
1038	dpurdie	768	`#`
1048	dpurdie	769	`my @plist = split /[,\s]+/, $conf->{'project'} \|\| '';`
		770	`if ( @plist )`
		771	`{`
		772	`#`
		773	`# Determine the releases that are in this project`
		774	`# Build up an sql query`
		775	`#`
		776	`my @m_plist;`
		777	`push @m_plist,"PROJ_ID=$_" foreach ( @plist );`
		778	`my $m_plist = join ' OR ', @m_plist;`
		779	`$m_sqlstr = "SELECT rt.RTAG_ID" .`
		780	`" FROM RELEASE_MANAGER.RELEASE_TAGS rt" .`
		781	`" WHERE ( $m_plist ) AND rt.OFFICIAL != 'A' AND rt.OFFICIAL != 'Y'";`
		782	`}`
		783	`}`
1038	dpurdie	784
1048	dpurdie	785	`if ( defined $m_sqlstr )`
		786	`{`
1038	dpurdie	787	`$logger->verbose3("getReleaseList:Sql:$m_sqlstr");`
1048	dpurdie	788	`connectRM(\$RM_DB);`
1038	dpurdie	789	`my $sth = $RM_DB->prepare($m_sqlstr);`
		790	`if ( defined($sth) )`
		791	`{`
		792	`if ( $sth->execute( ) )`
		793	`{`
		794	`if ( $sth->rows )`
		795	`{`
		796	`while (my @row = $sth->fetchrow_array )`
		797	`{`
		798	`$logger->verbose2("getReleaseList:Data:@row");`
		799	`$rlist{$row[0]} = 1;`
		800	`}`
		801	`}`
		802	`$sth->finish();`
		803	`}`
		804	`}`
		805	`else`
		806	`{`
		807	`$logger->warn("getReleaseList: SQL Prepare failure");`
		808	`}`
1050	dpurdie	809	`disconnectRM(\$RM_DB);`
1038	dpurdie	810	`}`
		811
		812	`#`
		813	`# Add in the user specified list of releases`
		814	`#`
		815	`my @rlist = split /[,\s]+/, $conf->{'release'} \|\| '';`
		816	`$rlist{$_} = 1 foreach(@rlist);`
		817
		818	`#`
		819	`# Sort for pretty display only`
		820	`#`
1040	dpurdie	821	`@{$releaseData{getReleaseList}} = sort {$a <=> $b} keys %rlist;`
		822
		823	`return @{$releaseData{getReleaseList}};`
1038	dpurdie	824	`}`
		825
1040	dpurdie	826	`#-------------------------------------------------------------------------------`
		827	`# Function : maintainTagList`
		828	`#`
		829	`# Description : Maintain a data structure for the maintenance of the`
		830	`# tags directory`
		831	`#`
		832	`# Inputs : None`
		833	`#`
		834	`# Returns : Nothing`
		835	`#`
		836	`sub maintainTagList`
		837	`{`
		838	`#`
		839	`# Time to perform the scan`
		840	`# Will do at startup and every time period there after`
		841	`#`
		842	`return unless ( $now > ($lastTagListScan + $conf->{tagListUpdate} ));`
		843	`$logger->verbose("maintainTagList");`
		844	`$lastTagListScan = $now;`
1038	dpurdie	845
1040	dpurdie	846	`#`
		847	`# Get list of things`
		848	`#`
		849	`my %config;`
		850	`%{$config{projects}} = map { $_ => 1 } split (/[,\s]+/, $conf->{'project'} \|\| '');`
		851	`%{$config{releases}} = map { $_ => 1 } getReleaseList();`
		852
		853	`#`
		854	`# Save data`
		855	`#`
		856	`my $dump = Data::Dumper->new([\%config], [qw(*config)]);`
		857	`#print $dump->Dump;`
		858	`#$dump->Reset;`
		859
		860	`#`
		861	`# Save config data`
		862	`#`
		863	`my $conf_file = catfile( $conf->{'tagdir'},'.config' );`
		864	`$logger->verbose3("maintainTagList: Writting $conf_file");`
		865
		866	`my $fh;`
		867	`open ( $fh, '>', $conf_file ) or $logger->err("Can't create $conf_file: $!");`
		868	`print $fh $dump->Dump;`
		869	`close $fh;`
		870	`}`
		871
		872
1038	dpurdie	873	`#-------------------------------------------------------------------------------`
		874	`# Function : processTags`
		875	`#`
		876	`# Description : Process tags and send marked package versions to the target`
		877	`# Determine if new tags are present`
		878	`# Process each tag`
		879	`#`
		880	`# Inputs : None`
		881	`#`
		882	`# Returns : Nothing`
		883	`#`
		884	`sub processTags`
		885	`{`
		886	`#`
		887	`# Determine if new tags are present by examining the time`
		888	`# that the directory was last modified.`
		889	`#`
		890	`# Allow for a forced scan to catch packages that did not transfer`
		891	`# on the first attempt`
		892	`#`
		893	`my ($mtime) = Utils::mtime($conf->{'tagdir'} );`
		894	`if ( ($mtime > $tagDirTime) \|\| ($now > ($lastDirScan + $conf->{'forcedirscan'})) )`
		895	`{`
1042	dpurdie	896	`$logger->verbose2("processTags: ",$conf->{'tagdir'}, $mtime - $tagDirTime, $now - $lastDirScan);`
1038	dpurdie	897	`$tagDirTime = $mtime;`
		898	`$lastDirScan = $now;`
		899
		900	`my $dh;`
		901	`unless (opendir($dh, $conf->{'tagdir'}))`
		902	`{`
		903	`$logger->warn ("can't opendir $conf->{'tagdir'}: $!");`
		904	`return;`
		905	`}`
		906
		907	`#`
		908	`# Process each entry`
		909	`# Ignore those that start with a .`
		910	`#`
		911	`while (my $tag = readdir($dh) )`
		912	`{`
		913	`next if ( $tag =~ m~^\.~ );`
		914	`my $file = "$conf->{'tagdir'}/$tag";`
1042	dpurdie	915	`$logger->verbose3("processTags: $file");`
		916
1038	dpurdie	917	`next unless ( -f $file );`
		918	`next if ( $tag eq 'ReleaseList' );`
		919
		920	`if ( $tag =~ m~(.+)::(.+)~ )`
		921	`{`
		922	`my $package = $1;`
		923	`my $version = $2;`
		924	`if ( transferPackage( $package, $version ))`
		925	`{`
		926	`unlink $file;`
		927	`}`
		928	`else`
		929	`{`
		930	`my ($mtime) = Utils::mtime( $file );`
		931	`if ( $now - $mtime > $conf->{'tagage'} )`
		932	`{`
		933	`$logger->warn ("Delete unsatisfied tag: $tag");`
		934	`unlink $file;`
		935	`}`
		936	`}`
		937	`}`
		938	`}`
		939	`closedir $dh;`
		940	`}`
		941	`}`
		942
		943	`#-------------------------------------------------------------------------------`
		944	`# Function : transferPackage`
		945	`#`
		946	`# Description : Transfer specified package to target system`
		947	`#`
		948	`# Inputs : $pname - Name of the package`
		949	`# $pver - Package version`
		950	`# $plink - (optional) Symlink in same package`
		951	`#`
		952	`# Returns : true - Package transferred`
		953	`# false - Package not transferred`
		954	`#`
		955	`sub transferPackage`
		956	`{`
		957	`my ($pname, $pver, $plink ) = @_;`
		958	`my $rv = 0;`
		959	`$logger->logmsg("transferPackage: @_");`
		960
		961	`#`
1040	dpurdie	962	`# Do not transfer excluded files`
		963	`#`
		964	`if ( exists $excludePkgs->{$pname} )`
		965	`{`
1048	dpurdie	966	`$logger->warn("transferPackage: Excluded package not transferred: $pname, $pver");`
1040	dpurdie	967	`return 1;`
		968	`}`
1048	dpurdie	969
1040	dpurdie	970	`#`
1048	dpurdie	971	`# Apply package filter`
		972	`#`
		973	`if ( defined $conf->{'packageFilter'} )`
		974	`{`
		975	`unless ( $pname =~ m~$conf->{'packageFilter'}~ )`
		976	`{`
		977	`$logger->warn("transferPackage: Filtered out package not transferred: $pname, $pver");`
		978	`return 1;`
		979	`}`
		980	`}`
		981
		982	`#`
1038	dpurdie	983	`# plink of 1 is not a symlink`
		984	`#`
		985	`$plink = undef if ( defined($plink) && $plink eq '1' );`
		986
		987	`#`
		988	`# If its been transferred in the current scan, then`
		989	`# indicate that all is well`
		990	`#`
		991	`if ( $transferred->{$pname}{$pver} )`
		992	`{`
		993	`$logger->verbose("transferPackage: Already transferred");`
		994	`return 1;`
		995	`}`
		996
1040	dpurdie	997	`my $sfile = catfile( $conf->{'dpkg_archive'} , $pname, $pver );`
1038	dpurdie	998	`unless ( -d $sfile )`
		999	`{`
		1000	`$logger->warn("transferPackage:Package not found: $pname, $pver");`
		1001	`return $rv;`
		1002	`}`
		1003
		1004	`#`
		1005	`# Create the process piple to transfer the package`
		1006	`# Tar the directory and pipe the result through a ssh session to`
		1007	`# the target machine`
		1008	`# gtar -czf - -C "$dpkg/${pname}/${pver}" . \| ssh -i $IDENTITY pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""`
		1009	`#`
		1010	`my $ph;`
		1011	`my $tar_cmd = "gtar -czf - -C \"$sfile\" .";`
		1012	`my $tgt_opts = defined($plink) ? "\"-L$plink\"" : '';`
1040	dpurdie	1013	`my $tgt_cmd = "$conf->{'bindir'}/receive_package $tgt_opts \"$pname\" \"$pver\"";`
		1014	`my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";`
1038	dpurdie	1015
		1016	`$logger->verbose2("transferPackage:tar_cmd:$tar_cmd");`
		1017	`$logger->verbose2("transferPackage:tgt_cmd:$tgt_cmd");`
		1018	`$logger->verbose2("transferPackage:ssh_cmd:$ssh_cmd");`
		1019
		1020	`open ($ph, "$tar_cmd \| $ssh_cmd \|");`
		1021	`while ( <$ph> )`
		1022	`{`
		1023	`chomp;`
		1024	`$logger->verbose2("transferPackage:Data: $_");`
		1025	`}`
		1026	`close ($ph);`
		1027	`$logger->verbose("transferPackage:End: $?");`
		1028	`if ( $? == 0 )`
		1029	`{`
		1030	`#`
		1031	`# Mark has having been transferred in the current cycle`
		1032	`#`
		1033	`$transferred->{$pname}{$pver} = 1;`
		1034	`$rv = 1;`
		1035	`}`
		1036	`else`
		1037	`{`
		1038	`$logger->warn("transferPackage:Transfer Error: $pname, $pver, $?");`
		1039	`}`
		1040	`return $rv;`
		1041	`}`
		1042
		1043	`#-------------------------------------------------------------------------------`
		1044	`# Function : deletePackage`
		1045	`#`
		1046	`# Description : Delete specified package to target system`
		1047	`#`
		1048	`# Inputs : $pname - Name of the package`
		1049	`# $pver - Package version`
1042	dpurdie	1050	`# $pdata - Hash of extra data`
1038	dpurdie	1051	`#`
		1052	`# Returns : true - Package transferred`
		1053	`# false - Package not transferred`
		1054	`#`
		1055	`sub deletePackage`
		1056	`{`
1042	dpurdie	1057	`my ($pname, $pver, $pdata ) = @_;`
1038	dpurdie	1058	`my $rv = 0;`
1042	dpurdie	1059	`$logger->logmsg("deletePackage: $pname, $pver");`
1038	dpurdie	1060
		1061	`#`
		1062	`# Create the process pipe to delete the package`
		1063	`# Tar the directory and pipe the result through a ssh session to`
		1064	`# the target machine`
		1065	`# gtar -czf - -C "$dpkg/${pname}/${pver}" . \| ssh -i $IDENTITY pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""`
		1066	`#`
		1067	`my $ph;`
1042	dpurdie	1068	`my $flags = $pdata->{FORCEDELETE} ? '' : ' -T';`
		1069	`my $tgt_cmd = "$conf->{'bindir'}/delete_package $flags \"$pname\" \"$pver\"";`
1040	dpurdie	1070	`my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";`
1038	dpurdie	1071
1040	dpurdie	1072	`$logger->verbose2("deletePackage:tgt_cmd:$tgt_cmd");`
		1073	`$logger->verbose2("deletePackage:ssh_cmd:$ssh_cmd");`
1038	dpurdie	1074
		1075	`open ($ph, "$ssh_cmd \|");`
		1076	`while ( <$ph> )`
		1077	`{`
		1078	`chomp;`
		1079	`$logger->verbose2("deletePackage:Data: $_");`
		1080	`}`
		1081	`close ($ph);`
		1082	`$logger->verbose("deletePackage:End: $?");`
		1083	`if ( $? == 0 )`
		1084	`{`
		1085	`$rv = 1;`
		1086	`}`
		1087	`else`
		1088	`{`
		1089	`$logger->warn("deletePackage:Error: $pname, $pver, $?");`
		1090	`}`
		1091	`return $rv;`
		1092	`}`
		1093
		1094
		1095	`#-------------------------------------------------------------------------------`
1042	dpurdie	1096	`# Function : parsePkgList`
		1097	`#`
		1098	`# Description : Parse one line from a pkgList`
		1099	`# Lines are multiple item="data" items`
		1100	`#`
		1101	`# Inputs : $line - Line of data`
		1102	`# $hashp - Ref to hash to populate`
		1103	`#`
		1104	`# Returns : A hash of data items`
		1105	`#`
		1106	`sub parsePkgList`
		1107	`{`
		1108	`my ($line, $hashp) = @_;`
		1109	`my $rv;`
		1110
		1111	`while ( $line =~ m~\s*(.+?)="(.+?)"~ )`
		1112	`{`
		1113	`$rv->{$1} = $2;`
		1114	`$line = $';`
		1115	`}`
		1116	`#Utils::DebugDumpData ("parsePkgList", $rv);`
		1117
		1118	`my $pname = $rv->{pname};`
		1119	`my $pver = $rv->{pver};`
		1120	`return undef unless ( $pname && $pver );`
		1121
		1122	`delete $rv->{pname};`
		1123	`delete $rv->{pver};`
		1124	`delete $rv->{GMT};`
		1125
		1126	`$hashp->{$pname}{$pver} = $rv;`
		1127	`return $hashp;`
		1128	`}`
		1129
		1130
		1131	`#-------------------------------------------------------------------------------`
1038	dpurdie	1132	`# Function : sighandlers`
		1133	`#`
		1134	`# Description : Install signal handlers`
		1135	`#`
		1136	`# Inputs : $conf - System config`
		1137	`#`
		1138	`# Returns : Nothing`
		1139	`#`
		1140	`sub sighandlers`
		1141	`{`
		1142	`my $conf = shift;`
		1143	`my $logger = $conf->{logger};`
		1144
		1145	`$SIG{TERM} = sub {`
		1146	`# On shutdown`
		1147	`$logger->logmsg('Received SIGTERM. Shutting down....' );`
		1148	`unlink $conf->{'pidfile'} if (-f $conf->{'pidfile'});`
		1149	`exit 0;`
		1150	`};`
		1151
		1152	`$SIG{HUP} = sub {`
		1153	`# On logrotate`
		1154	`$logger->logmsg('Received SIGHUP.');`
		1155	`$logger->rotatelog();`
		1156	`};`
		1157
		1158	`$SIG{USR1} = sub {`
		1159	`# On Force Archive Sync`
		1160	`$logger->logmsg('Received SIGUSR1.');`
1046	dpurdie	1161	`$lastReleaseScan = 0;`
		1162	`$lastTagListScan = 0;`
1038	dpurdie	1163	`};`
		1164
		1165	`$SIG{__WARN__} = sub { $logger->warn("@_") };`
		1166	`$SIG{__DIE__} = sub { $logger->err("@_") };`
		1167
		1168
		1169	`}`
		1170
		1171	`#-------------------------------------------------------------------------------`
		1172	`# Function : Error, Verbose, Warning`
		1173	`#`
		1174	`# Description : Support for JatsRmApi`
		1175	`#`
		1176	`# Inputs : Message`
		1177	`#`
		1178	`# Returns : Nothing`
		1179	`#`
		1180	`sub Error`
		1181	`{`
		1182	`$logger->err("@_");`
		1183	`}`
		1184
		1185	`sub Verbose`
		1186	`{`
1042	dpurdie	1187	`$logger->verbose2("@_");`
1038	dpurdie	1188	`}`
		1189
		1190	`sub Warning`
		1191	`{`
		1192	`$logger->warn("@_");`
		1193	`}`
		1194
		1195
		1196
		1197

Subversion Repositories DevTools

(root)/dpkg_blat/trunk/src/blat/blatDaemon.pl – Rev 1289