Contents of /bin/dtsasync

#!/usr/bin/perl
# Processes hints files in the specified directory.
use strict;
use warnings;

my $dir=shift || die "need a hint directory\n";

my $fromsuite="etch-proposed-updates ";
my $tosuite="etch";
my $archive="/org/secure-testing.debian.net/";
my $heidicmd="heidi -a $tosuite";
                        
sub getlines {
        my $suite=shift;
        my $package=shift;

        my @ret;
        my $pid;
        die "Can’t fork: $!" unless defined($pid = open(KID, "-|"));
        if ($pid) {
                while (<KID>) {
                        chomp;
                        push @ret, $_;
                }
                close KID;
        }
        else {
                exec "dak", "ls", "-s", $suite, "-f", "heidi", "-S", $package
                        or die "can't exec dak ls: $!";
        }

        return @ret;
}

my $run_dinstall=0;

print "dtsasync started at ".localtime(time)."\n\n";

foreach my $hint (glob "$dir/*") {
        next if $hint =~/\/README$/;
        if (! open (IN, $hint)) {
                print "Cannot read $hint\n";
                next;
        }
        print "Processing $hint\n";
        while (<IN>) {
                chomp;
                s/#.*//;
                s/^\s+//;
                s/\s+$//;
                next unless length;

                if (/^sync\s+(.*)\/(.*)/) {
                        my $sync_package=$1;
                        my $sync_version=$2;

                        print "Syncing $sync_package/$sync_version\n";
                        print "Current status:\n";
                        system("dak", "ls", "-S", $sync_package);
                        
                        my @fromlines=getlines($fromsuite, $sync_package);
                        if (! @fromlines) {
                                print "Not available in version $sync_version, doing nothing.\n";
                                next;
                        }
                        my @tolines=getlines($tosuite, $sync_package);
                        my @toheidi;

                        foreach my $line (@fromlines) {
                                next if grep { $_ eq $line } @tolines;
                                
                                my ($pkg, $version, $arch)=split(' ', $line, 3);
                                next unless $version eq $sync_version;
                                push @toheidi, $line;
                        }

                        if (! @toheidi) {
                                print "In sync, doing nothing.\n";
                                next;
                        }
                        
                        print "Syncing these:\n";
                        open(HEIDI, "| $heidicmd") || print "$heidicmd failed!\n";
                        foreach (@toheidi) {
                                print "$_\n";
                                print HEIDI "$_\n";
                        }
                        close HEIDI || print "$heidicmd exited nonzero!\n";
                        
                        print "New status:\n";
                        system("dak", "ls", "-S", $sync_package);
                        
                        $run_dinstall=1;
                }
                else {
                        print "$hint: parse failure on line $.\n";
                }
        }
        close IN;
}

if ($run_dinstall) {
        system("touch", "$archive/RUN-DINSTALL");
}
1	#!/usr/bin/perl
2	# Processes hints files in the specified directory.
3	use strict;
4	use warnings;
5
6	my $dir=shift \|\| die "need a hint directory\n";
7
8	my $fromsuite="etch-proposed-updates ";
9	my $tosuite="etch";
10	my $archive="/org/secure-testing.debian.net/";
11	my $heidicmd="heidi -a $tosuite";
12
13	sub getlines {
14	my $suite=shift;
15	my $package=shift;
16
17	my @ret;
18	my $pid;
19	die "Can’t fork: $!" unless defined($pid = open(KID, "-\|"));
20	if ($pid) {
21	while (<KID>) {
22	chomp;
23	push @ret, $_;
24	}
25	close KID;
26	}
27	else {
28	exec "dak", "ls", "-s", $suite, "-f", "heidi", "-S", $package
29	or die "can't exec dak ls: $!";
30	}
31
32	return @ret;
33	}
34
35	my $run_dinstall=0;
36
37	print "dtsasync started at ".localtime(time)."\n\n";
38
39	foreach my $hint (glob "$dir/*") {
40	next if $hint =~/\/README$/;
41	if (! open (IN, $hint)) {
42	print "Cannot read $hint\n";
43	next;
44	}
45	print "Processing $hint\n";
46	while (<IN>) {
47	chomp;
48	s/#.*//;
49	s/^\s+//;
50	s/\s+$//;
51	next unless length;
52
53	if (/^sync\s+(.)\/(.)/) {
54	my $sync_package=$1;
55	my $sync_version=$2;
56
57	print "Syncing $sync_package/$sync_version\n";
58	print "Current status:\n";
59	system("dak", "ls", "-S", $sync_package);
60
61	my @fromlines=getlines($fromsuite, $sync_package);
62	if (! @fromlines) {
63	print "Not available in version $sync_version, doing nothing.\n";
64	next;
65	}
66	my @tolines=getlines($tosuite, $sync_package);
67	my @toheidi;
68
69	foreach my $line (@fromlines) {
70	next if grep { $_ eq $line } @tolines;
71
72	my ($pkg, $version, $arch)=split(' ', $line, 3);
73	next unless $version eq $sync_version;
74	push @toheidi, $line;
75	}
76
77	if (! @toheidi) {
78	print "In sync, doing nothing.\n";
79	next;
80	}
81
82	print "Syncing these:\n";
83	open(HEIDI, "\| $heidicmd") \|\| print "$heidicmd failed!\n";
84	foreach (@toheidi) {
85	print "$_\n";
86	print HEIDI "$_\n";
87	}
88	close HEIDI \|\| print "$heidicmd exited nonzero!\n";
89
90	print "New status:\n";
91	system("dak", "ls", "-S", $sync_package);
92
93	$run_dinstall=1;
94	}
95	else {
96	print "$hint: parse failure on line $.\n";
97	}
98	}
99	close IN;
100	}
101
102	if ($run_dinstall) {
103	system("touch", "$archive/RUN-DINSTALL");
104	}