Subversion Repositories DevTools

Rev

Rev 1040 | Rev 1044 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

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