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

 use File::Basename;
 use Data::Dumper;
 use File::Spec::Functions;
 use POSIX ":sys_wait_h";
 use File::Temp qw/tempfile/;
+use Digest::MD5;
 use FindBin;                                    # Determine the current directory
 use lib "$FindBin::Bin/lib";                    # Allow local libraries
 use Utils;
 my $excludePkgs;
 my %releaseData;
 my $comError = 0;
 my $yday = -1;
 my $RemotePkgList = {};
+my $targetBinDir = "$FindBin::Bin/targetBin";
+#
 #   Contain statisics maintained while operating
 #       Can be dumped with a kill -USR2
 #       List here for documentation
     #   Get list of packages from Remote site
     #   Invoke a program on the remote site and parse the results
+    #
     #   Returned data looks like:
     #       Metadata avail="140100452"
+    #       BlatBin MD5="9e2c6e45af600a20a01dbcb7570da1f1" file="stat.pl"
     #       time="1497586865" GMT="Fri Jun 16 04:21:05 2017" pname="ERGissaccounts" pver="1.0.7169.mas"
     #       time="1497954104" GMT="Tue Jun 20 10:21:44 2017" pname="ERGissaccounts" pver="1.0.7178.mas" deleted="0"
+    #
     my $remotePkgList;
     my $remoteData;
+    my $blatBinData;
     my $ph;
     my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";
     my $ssh_cmd = sshCmd($tgt_cmd);
     $logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");
     while ( <$ph> )
+    {
         chomp;
         if ($_ =~ m~^Metadata\s+~)
+        {
-            parsePkgMetaData($_, \%{$remoteData})
+            parsePkgMetaData($_, \%{$remoteData});
+        }
+        elsif ($_ =~ m~^BlatBin\s+~)
+        {
+            parseBlatBinData($_, \%{$blatBinData})
+        }
         else
+        {
             if ( parsePkgList($_, \%{$remotePkgList} ) )
+            {
         $statistics{state} = 'No Remote Package List';
         return;
+    }
 #Utils::DebugDumpData ("remotePkgList", $remotePkgList);
+#Utils::DebugDumpData ("blatBinData", $blatBinData);
+    #
+    #   Determine the Blat Bin packages that need to be transferred
+    #   Transfer Blats Bin files before attempting to transfer packages
+    #
+    my $blatBinList = getBlatBin();
+    foreach my $file ( keys %{$blatBinList} )
+    {
+        if (exists $blatBinData->{$file}) {
+            if ($blatBinData->{$file} eq $blatBinList->{$file}) {
+                delete $blatBinList->{$file};
+            }
+        }
+    }
+#Utils::DebugDumpData ("blatBinList", $blatBinList);
+    transferBlatBin($blatBinList);
+    #
     #   Determine the set of packages in the releases to be transferred
+    #
     my $pkgList;
     if ( $conf->{'allArchive'} )
     return \%archiveList;
+}
 #-------------------------------------------------------------------------------
+# Function        : getBlatBin
+#
+# Description     : Get the list of files that should be in the targetbin directory
+#
+# Inputs          : Nothing
+#
+# Returns         : A hash of data
+#
+sub getBlatBin
+{
+    my $data;
+    $logger->verbose("getBlatBin: $targetBinDir");
+    if (opendir(DIR, $targetBinDir ) ) {
+        my @vlist = readdir(DIR);
+        closedir DIR;
+        foreach my $vname ( sort @vlist )
+        {
+            next if ( $vname eq '.' );
+            next if ( $vname eq '..' );
+            next unless ( -f "$targetBinDir/$vname" );
+            if (open FILE, "$targetBinDir/$vname") {
+                $data->{$vname} = Digest::MD5->new->addfile(*FILE)->hexdigest;
+                close (FILE);
+            }
+        }
+    } else {
+        $logger->warn("BlatBin Not Found: $targetBinDir");
+    }
+    return $data;
+}
+#-------------------------------------------------------------------------------
 # Function        : maintainTagList
+#
 # Description     : Maintain a data structure for the maintenance of the
 #                   tags directory
+#
+    }
     $statistics{tagCount} = $tagCount;
+}
 #-------------------------------------------------------------------------------
+# Function        : transferBlatBin
+#
+# Description     : Transfer any of the Blat Bin files that are out of date
+#                   on the target
+#
+# Inputs          : $fileHash       - A hash whose files are those that need
+#                                     to be updated
+#
+# Returns         :
+#
+sub transferBlatBin
+{
+    my ($hash) = @_;
+    $logger->verbose("transferBlatBin");
+    foreach my $file ( sort keys %{$hash})
+    {
+        $logger->logmsg("transferBlatBin: $file");
+        #
+        #   Transfer one file using only 'ssh'
+        #   Create the target directory on the fly
+        #   Manipulate file permissions
+        #   Report errors
+        my $tar_cmd = "cat \"$targetBinDir/$file\"";
+        my $tgt_cmd = "mkdir -p ~/bin && chmod +x+w \"~/bin/$file\" && cat > \"~/bin/$file\" && chmod +x-w \"~/bin/$file\" || exit 1";
+        my $ssh_cmd = sshCmd($tgt_cmd);
+        my $cat_cmd =
+        $logger->verbose2("transferBlatBin:tar_cmd:$tar_cmd");
+        $logger->verbose2("transferBlatBin:tgt_cmd:$tgt_cmd");
+        $logger->verbose2("transferBlatBin:ssh_cmd:$ssh_cmd");
+        my $ph;
+        open ($ph, "$tar_cmd | $ssh_cmd |");
+        while ( <$ph> )
+        {
+            chomp;
+            $logger->verbose2("transferBlatBin:Data: $_");
+        }
+        close ($ph);
+        $logger->verbose("transferBlatBin:End: $?");
+        if ( $? != 0 )
+        {
+            $logger->warn("transferBlatBin:Transfer Error: $file, $?");
+        }
+        LogTxError ($?);
+    }
+}
+#-------------------------------------------------------------------------------
 # Function        : transferPackage
+#
 # Description     : Transfer specified package to target system
+#
 # Inputs          : $pname          - Name of the package
     #       It may have been transferred in this cycle
     #       It may have been in the archive anyway
+    #
     if ( exists($RemotePkgList->{$pname}) && exists ($RemotePkgList->{$pname}{$pver})) {
         $logger->verbose("transferPackage: Already in archive");
-	#$logger->logmsg("transferPackage: $pname, $pver : Already in archive");
+        #$logger->logmsg("transferPackage: $pname, $pver : Already in archive");
         return 1;
+    }
     my $sfile = catfile( $conf->{'dpkg_archive'} , $pname, $pver );
     unless ( -d $sfile )
         $logger->verbose2("parsePkgMetaData: $1 = $2");
+    }
+}
+#-------------------------------------------------------------------------------
+# Function        : parseBlatBinData
+#
+# Description     : Parse one line of Blat Bin data from a pkgList
+#                   Lines are of the form:
+#                   BlatBin MD5="dbc4507f4db5b41f7358b28bce65a15d" file="ddp-gtar"
+#
+# Inputs          : $line                   - Line of data
+#                   $hashp                  - Ref to hash to populate
+#
+# Returns         : Nothing
+#
+sub parseBlatBinData
+{
+    my ($line, $hashp) = @_;
+    my $rv;
+    $line =~ s~^\S+~~;
+    while ( $line =~ m~\s*(.+?)="(.+?)"~ )
+    {
+        $rv->{$1} = $2;
+        $line = $';
+    }
+#Utils::DebugDumpData ("parseBlatBinData", $rv);
+    my $fname = $rv->{file};
+    my $md5 =  $rv->{MD5};
+    return undef unless ( $fname && $md5 );
+    $logger->verbose2("parseBlatBinData: $fname : $md5");
+    $hashp->{$fname} = $md5;
+}
 #-------------------------------------------------------------------------------
 # Function        : resetDailyStatistics
+#
 # Description     : Called periodically to reset the daily statistics

Subversion Repositories DevTools

(root)/dpkg_blat/trunk/src/blat/blatDaemon.pl – Rev 6148 → 6320