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

Subversion Repositories DevTools

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