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



    'project'         => {'mandatory' => 0    , 'fmt' => 'int_list'},
    'release'         => {'mandatory' => 0    , 'fmt' => 'int_list'},
    'writewindow'     => {'default' => '3h'   , 'fmt' => 'period'},
    'maxpackages'     => {'default' => 5      , 'fmt' => 'int'},
    'deletePackages'  => {'default' => 0      , 'fmt' => 'bool'},
    'deleteImmediate' => {'default' => 0      , 'fmt' => 'bool'},
    'deleteAge'       => {'default' => 0      , 'fmt' => 'period'},
);
 
 
#
#   Read in the configuration

    #   Invoke a program on the remote site and parse the results
    #
    #     ssh  -i ./ssh/id_rsa_pkg_admin  pkg_admin@10.247.28.57 "./get_plist.pl"
    #
    #   Returned data looks like:
    #   1141792602 GMT(Wed Mar  8 04:36:42 2006) [DL] ishieldmodules/11.5.0.cots
    #   
    #
    my $remotePkgList;
    my $ph;
    my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";

    $logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");
    open ($ph, "$ssh_cmd |");
    while ( <$ph> )
    {
        chomp;
        if ( parsePkgList($_, \%{$remotePkgList} ) )
        {
 
            $logger->verbose2("processReleaseList:Data: $_");
        }
        else
        {
            $logger->warn("processReleaseList:Bad Data: $_");

    if ( $? != 0 )
    {
        $logger->warn("Cannot retrieve package list: $?");
        return;
    }
#Utils::DebugDumpData ("remotePkgList", $remotePkgList);
    
 
    #
    #   Determine the set of packages in the releases to be transferred
    #   Examine
    #

 
        $logger->verbose2("No packages to process");
        return;
    }
 
 
#    while ( (my ($pname, $pvers)) = each %{$pkgList} )
#    {
#        while ( (my ($pver, $ptime) ) = each %{$pvers} )
#        {
#            print "L-- $pname, $pver, $ptime \n";

#    }
 
    #
    #   Delete Excess Packages
    #       Packages not required on the target
    #           KLUDGE: Don't delete links to packages
    #           Don't delete packages marked for deletion
    #
    my $excessPkgList;
    if ( $conf->{deletePackages} )
    {
        while ( (my ($pname, $pvers)) = each %{$remotePkgList} )

                    {
                        $logger->verbose2("Keep Excluded package: ${pname}");
                        next;
                    }
 
                    if ( exists $pdata->{deleted} )
                    {
                        if ( $conf->{deleteAge} )
                        {
                            if ( $pdata->{deleted} <= $conf->{deleteAge} )
                            {
                                $logger->verbose2("Already marked for future age deletion: ${pname}/${pver}, $pdata->{deleted}");
                                next;
                            }
                            $pdata->{FORCEDELETE} = 1;
                        }
 
                        if ( !$conf->{deleteImmediate} )
                        {
                            $logger->verbose2("Already marked for deletion: ${pname}/${pver}");
                            next;
                        }
                    }
 
                    #
                    #   Force deletion
                    #       deleteImmediate mode
                    #       target is a broken link
                    #
                    $pdata->{FORCEDELETE} = 1
                        if ($conf->{deleteImmediate} || $pdata->{broken});
 
                    $excessPkgList->{$pname}{$pver} = $pdata;
                    $logger->verbose("Excess package: ${pname}/${pver}");
                }
            }
        }

        #
        next if ( exists $excludePkgs->{$pname} );
 
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
        {
            my $tmtime = $remotePkgList->{$pname}{$pver}{time} || 0;
 
            # Package is present in both list
            my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));
            if ( $mtime == 0 )
            {

    delete_pkgs:
    while ( (my ($pname, $pvers)) = each %{$excessPkgList} )
    {
        while ( (my ($pver, $pdata) ) = each %{$pvers} )
        {
            deletePackage ($pname, $pver, $pdata);
            if ( --$txcount <= 0 )
            {
                $logger->warn("Max transfer count exceeded");
                $lastReleaseScan = 0;
                last delete_pkgs;

    #   on the first attempt
    #
    my ($mtime) = Utils::mtime($conf->{'tagdir'} );
    if ( ($mtime > $tagDirTime) || ($now > ($lastDirScan + $conf->{'forcedirscan'})) )
    {
        $logger->verbose2("processTags: ",$conf->{'tagdir'}, $mtime - $tagDirTime, $now - $lastDirScan);
        $tagDirTime = $mtime;
        $lastDirScan = $now;
 
        my $dh;
        unless (opendir($dh, $conf->{'tagdir'}))

        #
        while (my $tag = readdir($dh) )
        {
            next if ( $tag =~ m~^\.~ );
            my $file = "$conf->{'tagdir'}/$tag";
            $logger->verbose3("processTags: $file");
 
            next unless ( -f $file );
            next if ( $tag  eq 'ReleaseList' );
 
            if ( $tag =~ m~(.+)::(.+)~  )
            {

#
# Description     : Delete specified package to target system
#
# Inputs          : $pname          - Name of the package
#                   $pver           - Package version
#                   $pdata          - Hash of extra data
#
# Returns         : true    - Package transferred
#                   false   - Package not transferred
#
sub deletePackage
{
    my ($pname, $pver, $pdata ) = @_;
    my $rv = 0;
    $logger->logmsg("deletePackage: $pname, $pver");
 
    #
    #   Create the process pipe to delete the package
    #   Tar the directory and pipe the result through a ssh session to
    #   the target machine
    #   gtar -czf - -C "$dpkg/${pname}/${pver}" . |  ssh  -i $IDENTITY  pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""
    #
    my $ph;
    my $flags = $pdata->{FORCEDELETE}  ? '' : ' -T';
    my $tgt_cmd = "$conf->{'bindir'}/delete_package $flags \"$pname\" \"$pver\"";
    my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";
 
    $logger->verbose2("deletePackage:tgt_cmd:$tgt_cmd");
    $logger->verbose2("deletePackage:ssh_cmd:$ssh_cmd");
 

    return $rv;
}
 
 
#-------------------------------------------------------------------------------
# Function        : parsePkgList
#
# Description     : Parse one line from a pkgList
#                   Lines are multiple item="data" items
#
# Inputs          : $line                   - Line of data
#                   $hashp                  - Ref to hash to populate
#
# Returns         : A hash of data items
#
sub parsePkgList
{
    my ($line, $hashp) = @_;
    my $rv;
 
    while ( $line =~ m~\s*(.+?)="(.+?)"~ )
    {
        $rv->{$1} = $2;
        $line = $';
    }
#Utils::DebugDumpData ("parsePkgList", $rv);
 
    my $pname = $rv->{pname};
    my $pver =  $rv->{pver};
    return undef unless ( $pname && $pver );
 
    delete $rv->{pname};
    delete $rv->{pver};
    delete $rv->{GMT};
 
    $hashp->{$pname}{$pver} = $rv;
    return $hashp;
}
 
 
#-------------------------------------------------------------------------------
# Function        : sighandlers
#
# Description     : Install signal handlers
#
# Inputs          : $conf           - System config

    $logger->err("@_");
}
 
sub Verbose
{
    $logger->verbose2("@_");
}
 
sub Warning
{
    $logger->warn("@_");

Rev 1040	Rev 1042
Line 82...	Line 82...
82	`'project' => {'mandatory' => 0 , 'fmt' => 'int_list'},`	82	`'project' => {'mandatory' => 0 , 'fmt' => 'int_list'},`
83	`'release' => {'mandatory' => 0 , 'fmt' => 'int_list'},`	83	`'release' => {'mandatory' => 0 , 'fmt' => 'int_list'},`
84	`'writewindow' => {'default' => '3h' , 'fmt' => 'period'},`	84	`'writewindow' => {'default' => '3h' , 'fmt' => 'period'},`
85	`'maxpackages' => {'default' => 5 , 'fmt' => 'int'},`	85	`'maxpackages' => {'default' => 5 , 'fmt' => 'int'},`
86	`'deletePackages' => {'default' => 0 , 'fmt' => 'bool'},`	86	`'deletePackages' => {'default' => 0 , 'fmt' => 'bool'},`
-		87	`'deleteImmediate' => {'default' => 0 , 'fmt' => 'bool'},`
-		88	`'deleteAge' => {'default' => 0 , 'fmt' => 'period'},`
87	`);`	89	`);`
88		90
89		91
90	`#`	92	`#`
91	`# Read in the configuration`	93	`# Read in the configuration`
Line 203...	Line 205...
203	`# Invoke a program on the remote site and parse the results`	205	`# Invoke a program on the remote site and parse the results`
204	`#`	206	`#`
205	`# ssh -i ./ssh/id_rsa_pkg_admin pkg_admin@10.247.28.57 "./get_plist.pl"`	207	`# ssh -i ./ssh/id_rsa_pkg_admin pkg_admin@10.247.28.57 "./get_plist.pl"`
206	`#`	208	`#`
207	`# Returned data looks like:`	209	`# Returned data looks like:`
208	`# 1141792602 GMT(Wed Mar 8 04:36:42 2006) ishieldmodules/11.5.0.cots`	210	`# 1141792602 GMT(Wed Mar 8 04:36:42 2006) [DL] ishieldmodules/11.5.0.cots`
209	`#`	211	`#`
210	`#`	212	`#`
211	`my $remotePkgList;`	213	`my $remotePkgList;`
212	`my $ph;`	214	`my $ph;`
213	`my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";`	215	`my $tgt_cmd = "$conf->{'bindir'}/get_plist.pl";`
Line 216...	Line 218...
216	`$logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");`	218	`$logger->verbose2("processReleaseList:ssh_cmd:$ssh_cmd");`
217	`open ($ph, "$ssh_cmd \|");`	219	`open ($ph, "$ssh_cmd \|");`
218	`while ( <$ph> )`	220	`while ( <$ph> )`
219	`{`	221	`{`
220	`chomp;`	222	`chomp;`
221	`if ( m~^(\d+)\s+GMT\(.*?\)\s+(.+)/(.+)~ )`	223	`if ( parsePkgList($_, \%{$remotePkgList} ) )`
222	`{`	224	`{`
223	`$remotePkgList->{$2}{$3} = $1;`	-
224	`$logger->verbose2("processReleaseList:Data: $_");`	225	`$logger->verbose2("processReleaseList:Data: $_");`
225	`}`	226	`}`
226	`else`	227	`else`
227	`{`	228	`{`
228	`$logger->warn("processReleaseList:Bad Data: $_");`	229	`$logger->warn("processReleaseList:Bad Data: $_");`
Line 233...	Line 234...
233	`if ( $? != 0 )`	234	`if ( $? != 0 )`
234	`{`	235	`{`
235	`$logger->warn("Cannot retrieve package list: $?");`	236	`$logger->warn("Cannot retrieve package list: $?");`
236	`return;`	237	`return;`
237	`}`	238	`}`
-		239	`#Utils::DebugDumpData ("remotePkgList", $remotePkgList);`
-		240
238		241
239	`#`	242	`#`
240	`# Determine the set of packages in the releases to be transferred`	243	`# Determine the set of packages in the releases to be transferred`
241	`# Examine`	244	`# Examine`
242	`#`	245	`#`
Line 297...	Line 300...
297		300
298	`$logger->verbose2("No packages to process");`	301	`$logger->verbose2("No packages to process");`
299	`return;`	302	`return;`
300	`}`	303	`}`
301		304
302		-
303	`# while ( (my ($pname, $pvers)) = each %{$pkgList} )`	305	`# while ( (my ($pname, $pvers)) = each %{$pkgList} )`
304	`# {`	306	`# {`
305	`# while ( (my ($pver, $ptime) ) = each %{$pvers} )`	307	`# while ( (my ($pver, $ptime) ) = each %{$pvers} )`
306	`# {`	308	`# {`
307	`# print "L-- $pname, $pver, $ptime \n";`	309	`# print "L-- $pname, $pver, $ptime \n";`
Line 310...	Line 312...
310	`# }`	312	`# }`
311		313
312	`#`	314	`#`
313	`# Delete Excess Packages`	315	`# Delete Excess Packages`
314	`# Packages not required on the target`	316	`# Packages not required on the target`
315	`# KLUDGE: Don't delete links to packages`	317	`# KLUDGE: Don't delete links to packages`
-		318	`# Don't delete packages marked for deletion`
316	`#`	319	`#`
317	`my $excessPkgList;`	320	`my $excessPkgList;`
318	`if ( $conf->{deletePackages} )`	321	`if ( $conf->{deletePackages} )`
319	`{`	322	`{`
320	`while ( (my ($pname, $pvers)) = each %{$remotePkgList} )`	323	`while ( (my ($pname, $pvers)) = each %{$remotePkgList} )`
Line 333...	Line 336...
333	`{`	336	`{`
334	`$logger->verbose2("Keep Excluded package: ${pname}");`	337	`$logger->verbose2("Keep Excluded package: ${pname}");`
335	`next;`	338	`next;`
336	`}`	339	`}`
337		340
-		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
338	`$excessPkgList->{$pname}{$pver} = $pdata;`	368	`$excessPkgList->{$pname}{$pver} = $pdata;`
339	`$logger->verbose("Excess package: ${pname}/${pver}");`	369	`$logger->verbose("Excess package: ${pname}/${pver}");`
340	`}`	370	`}`
341	`}`	371	`}`
342	`}`	372	`}`
Line 362...	Line 392...
362	`#`	392	`#`
363	`next if ( exists $excludePkgs->{$pname} );`	393	`next if ( exists $excludePkgs->{$pname} );`
364		394
365	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`	395	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
366	`{`	396	`{`
367	`my $tmtime = $remotePkgList->{$pname}{$pver} \|\| 0;`	397	`my $tmtime = $remotePkgList->{$pname}{$pver}{time} \|\| 0;`
368		398
369	`# Package is present in both list`	399	`# Package is present in both list`
370	`my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));`	400	`my ($mtime, $mode) = Utils::mtime( catfile( $conf->{'dpkg_archive'} , $pname, $pver, 'descpkg' ));`
371	`if ( $mtime == 0 )`	401	`if ( $mtime == 0 )`
372	`{`	402	`{`
Line 447...	Line 477...
447	`delete_pkgs:`	477	`delete_pkgs:`
448	`while ( (my ($pname, $pvers)) = each %{$excessPkgList} )`	478	`while ( (my ($pname, $pvers)) = each %{$excessPkgList} )`
449	`{`	479	`{`
450	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`	480	`while ( (my ($pver, $pdata) ) = each %{$pvers} )`
451	`{`	481	`{`
452	`deletePackage ($pname, $pver);`	482	`deletePackage ($pname, $pver, $pdata);`
453	`if ( --$txcount <= 0 )`	483	`if ( --$txcount <= 0 )`
454	`{`	484	`{`
455	`$logger->warn("Max transfer count exceeded");`	485	`$logger->warn("Max transfer count exceeded");`
456	`$lastReleaseScan = 0;`	486	`$lastReleaseScan = 0;`
457	`last delete_pkgs;`	487	`last delete_pkgs;`
Line 734...	Line 764...
734	`# on the first attempt`	764	`# on the first attempt`
735	`#`	765	`#`
736	`my ($mtime) = Utils::mtime($conf->{'tagdir'} );`	766	`my ($mtime) = Utils::mtime($conf->{'tagdir'} );`
737	`if ( ($mtime > $tagDirTime) \|\| ($now > ($lastDirScan + $conf->{'forcedirscan'})) )`	767	`if ( ($mtime > $tagDirTime) \|\| ($now > ($lastDirScan + $conf->{'forcedirscan'})) )`
738	`{`	768	`{`
739	`$logger->verbose2("processTags: ", $mtime - $tagDirTime, $now - $lastDirScan);`	769	`$logger->verbose2("processTags: ",$conf->{'tagdir'}, $mtime - $tagDirTime, $now - $lastDirScan);`
740	`$tagDirTime = $mtime;`	770	`$tagDirTime = $mtime;`
741	`$lastDirScan = $now;`	771	`$lastDirScan = $now;`
742		772
743	`my $dh;`	773	`my $dh;`
744	`unless (opendir($dh, $conf->{'tagdir'}))`	774	`unless (opendir($dh, $conf->{'tagdir'}))`
Line 753...	Line 783...
753	`#`	783	`#`
754	`while (my $tag = readdir($dh) )`	784	`while (my $tag = readdir($dh) )`
755	`{`	785	`{`
756	`next if ( $tag =~ m~^\.~ );`	786	`next if ( $tag =~ m~^\.~ );`
757	`my $file = "$conf->{'tagdir'}/$tag";`	787	`my $file = "$conf->{'tagdir'}/$tag";`
-		788	`$logger->verbose3("processTags: $file");`
-		789
758	`next unless ( -f $file );`	790	`next unless ( -f $file );`
759	`next if ( $tag eq 'ReleaseList' );`	791	`next if ( $tag eq 'ReleaseList' );`
760		792
761	`if ( $tag =~ m~(.+)::(.+)~ )`	793	`if ( $tag =~ m~(.+)::(.+)~ )`
762	`{`	794	`{`
Line 874...	Line 906...
874	`#`	906	`#`
875	`# Description : Delete specified package to target system`	907	`# Description : Delete specified package to target system`
876	`#`	908	`#`
877	`# Inputs : $pname - Name of the package`	909	`# Inputs : $pname - Name of the package`
878	`# $pver - Package version`	910	`# $pver - Package version`
-		911	`# $pdata - Hash of extra data`
879	`#`	912	`#`
880	`# Returns : true - Package transferred`	913	`# Returns : true - Package transferred`
881	`# false - Package not transferred`	914	`# false - Package not transferred`
882	`#`	915	`#`
883	`sub deletePackage`	916	`sub deletePackage`
884	`{`	917	`{`
885	`my ($pname, $pver ) = @_;`	918	`my ($pname, $pver, $pdata ) = @_;`
886	`my $rv = 0;`	919	`my $rv = 0;`
887	`$logger->logmsg("deletePackage: @_");`	920	`$logger->logmsg("deletePackage: $pname, $pver");`
888		921
889	`#`	922	`#`
890	`# Create the process pipe to delete the package`	923	`# Create the process pipe to delete the package`
891	`# Tar the directory and pipe the result through a ssh session to`	924	`# Tar the directory and pipe the result through a ssh session to`
892	`# the target machine`	925	`# the target machine`
893	`# gtar -czf - -C "$dpkg/${pname}/${pver}" . \| ssh -i $IDENTITY pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""`	926	`# gtar -czf - -C "$dpkg/${pname}/${pver}" . \| ssh -i $IDENTITY pkg_admin@${TARGET_HOST} "./receive_package ${rx_opts} \"$pname\" \"$pver\""`
894	`#`	927	`#`
895	`my $ph;`	928	`my $ph;`
-		929	`my $flags = $pdata->{FORCEDELETE} ? '' : ' -T';`
896	`my $tgt_cmd = "$conf->{'bindir'}/delete_package \"$pname\" \"$pver\"";`	930	`my $tgt_cmd = "$conf->{'bindir'}/delete_package $flags \"$pname\" \"$pver\"";`
897	`my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";`	931	`my $ssh_cmd = "ssh -o \"BatchMode yes\" -i $conf->{'identity'} $conf->{'user'}\@$conf->{'hostname'} \"$tgt_cmd\" 2>&1";`
898		932
899	`$logger->verbose2("deletePackage:tgt_cmd:$tgt_cmd");`	933	`$logger->verbose2("deletePackage:tgt_cmd:$tgt_cmd");`
900	`$logger->verbose2("deletePackage:ssh_cmd:$ssh_cmd");`	934	`$logger->verbose2("deletePackage:ssh_cmd:$ssh_cmd");`
901		935
Line 918...	Line 952...
918	`return $rv;`	952	`return $rv;`
919	`}`	953	`}`
920		954
921		955
922	`#-------------------------------------------------------------------------------`	956	`#-------------------------------------------------------------------------------`
-		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	`#-------------------------------------------------------------------------------`
923	`# Function : sighandlers`	993	`# Function : sighandlers`
924	`#`	994	`#`
925	`# Description : Install signal handlers`	995	`# Description : Install signal handlers`
926	`#`	996	`#`
927	`# Inputs : $conf - System config`	997	`# Inputs : $conf - System config`
Line 972...	Line 1042...
972	`$logger->err("@_");`	1042	`$logger->err("@_");`
973	`}`	1043	`}`
974		1044
975	`sub Verbose`	1045	`sub Verbose`
976	`{`	1046	`{`
977	`$logger->verbose("@_");`	1047	`$logger->verbose2("@_");`
978	`}`	1048	`}`
979		1049
980	`sub Warning`	1050	`sub Warning`
981	`{`	1051	`{`
982	`$logger->warn("@_");`	1052	`$logger->warn("@_");`

Subversion Repositories DevTools

(root)/dpkg_blat/trunk/src/blat/blatDaemon.pl – Rev 1040 → 1042