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

Subversion Repositories DevTools

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