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

Subversion Repositories DevTools

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