Contents of /bin/compare-testing-status

#!/usr/bin/perl -w

# Compares the testing_status tables from two versions of security.db.
# To be accurate, both versions must have been created with the same svn
# revision of the tracker data files (but with different package files).

use strict;
use DBI;

my $TESTING="wheezy";
my $MAILTO='secure-testing-team@lists.alioth.debian.org';
my $MAILFROM='sf@sfritsch.de';

my @d = localtime(time);
my $MAILDATE = sprintf("%4d-%02d-%02d", $d[5] + 1900, $d[4] + 1, $d[3]);

if (@ARGV != 2) {
        die "usage:\nlist-updates old.db new.deb\n";
}

my $migrated = {};
my $dtsa = {};
my $removed = {};
my $versions = {};

my $mail_text = "";

my $old_dbh = DBI->connect("dbi:SQLite:dbname=$ARGV[0]","","", { RaiseError => 1 });
my $new_dbh = DBI->connect("dbi:SQLite:dbname=$ARGV[1]","","", { RaiseError => 1 });

my $sth_version = $new_dbh->prepare("SELECT version, archive FROM source_packages WHERE name = ? AND release = '$TESTING' AND subrelease = ? ");
my $sth_desc    = $new_dbh->prepare("SELECT description FROM bugs WHERE name = ?");
my $sth_debbug  = $new_dbh->prepare("SELECT d.bug FROM package_notes p JOIN debian_bugs d ON d.note = p.id WHERE bug_name = ? AND package = ? AND release = ''");

my $old_issues = get_issues($old_dbh);
my $new_issues = get_issues($new_dbh);

foreach my $package ( sort keys %{$old_issues} ) {
        $versions->{$package} = package_version($package); # undef if package does not exist in $new_dbh

        foreach my $issue ( sort keys %{$old_issues->{$package}} ) {
                my $old = $old_issues->{$package}->{$issue};
                my $new = $new_issues->{$package}->{$issue};

                if ( $new ) {
                        if (     $old->{testing_security_fixed} == 0
                             and $new->{testing_security_fixed} == 1 )
                        {
                                push @{$dtsa->{$package}}, $issue;
                                $versions->{$package} = package_version($package, "security");
                        }
                        
                }
                else {
                        if ( ! defined $versions->{$package} ) {
                                push @{$removed->{$package}}, $issue;
                        }
                        elsif ( $old->{testing_security_fixed} != 1 ) {
                                push @{$migrated->{$package}}, $issue;
                        }
                }
        }
}

print_hash($dtsa, "DTSA", <<"EOF");
The following issues have been fixed by uploads to testing-security:

EOF

print_hash($migrated, "Migrated from unstable");

print_hash($removed, "Removed from testing", <<"EOF");
The following issues have been "fixed" by removing the (source) packages from 
testing. This probably means that you have to manually uninstall the 
corresponding binary packages to fix the issues.
It can also mean that the packages have been replaced, or that they have been 
temporarily removed by the release team to make transitions from unstable 
easier.

EOF


if ($mail_text) {
        send_mail();
        print "mail sent.\n";
}
else {
        print "nothing fixed, no mail sent.\n";
}

# workaround DBD::Sqlite bug
undef $sth_version;
undef $sth_desc;
undef $sth_debbug;

########### end MAIN #############

sub print_mail {
        $mail_text .= join('', @_);
}

sub print_both {
        print_mail(@_);
        print @_;
}

sub print_hash {
        my $hash = shift;
        my $name = shift;
        my $desc = shift;

        return if ! scalar keys %{$hash};

        print_both("$name:\n");
        print_both('=' x ( length($name) + 1) , "\n");
        print_mail("$desc") if $desc;

        foreach my $p (sort keys %{$hash}) {
                my $version = "";
                if ( $versions->{$p} ) {
                        $version = " $versions->{$p}";
                }
                print_both("$p"  . $version . ":\n");

                # sort DTSAs first
                my @issues = sort grep(/^DTSA/, @{$hash->{$p}});
                push @issues, sort grep(!/^DTSA/, @{$hash->{$p}});
                my %seen_dbug;
                foreach my $i (@issues) {
                        print_both(issue2string($i));

                        # print debian bug no more than once per package
                        my @dbugs = issue2debbug($i, $p);
                        foreach my $dbug (@dbugs) {
                                if ( ! $seen_dbug{$dbug} ) {
                                        $seen_dbug{$dbug} = 1;
                                        print_both(" "x15 . "http://bugs.debian.org/$dbug\n");
                                }
                        }
                }
                print_both("\n");
        }

}


sub get_issues {
        my $dbh = shift;
        return $dbh->selectall_hashref(
                'SELECT package, bug, unstable_vulnerable, testing_security_fixed FROM testing_status',
                [ 'package', 'bug' ] );
}

sub package_version {
        my $package = shift;
        my $subrelease = shift || "";
        $sth_version->execute($package, $subrelease);
        my $result = $sth_version->fetchall_arrayref();

        if (scalar @{$result} > 1) {
                return "";
        }
        if (scalar @{$result} == 0) {
                return undef;
        }
        my $archive = "";
        if ($result->[0]->[1] ne 'main') {
                $archive = " ($result->[0]->[1])";
        }
        return $result->[0]->[0] . $archive;      

}

sub issue2string {
        my $issue = shift;
        my $url = "";
        my $desc = "";

        $sth_desc->execute($issue);
        my $result = $sth_desc->fetchall_arrayref();
        $desc = $result->[0]->[0];

        if ( $issue =~ /^CVE-\d{4}-\d{4}/ ) {
                $url = "http://cve.mitre.org/cgi-bin/cvename.cgi?name=" . $issue ;
                return "$issue: $url\n";
        }
        elsif ( $issue =~ /^DTSA-/ ) {
                return "$issue    : $desc\n";
        }
        else {
                return "<no CVE yet> : $desc\n";
        }

}

sub issue2debbug {
        my ($issue, $package) = @_;

        $sth_debbug->execute($issue, $package);
        my $rows = $sth_debbug->fetchall_arrayref();
        my @bugs = map { $_->[0] } @{$rows};

        return @bugs;
}

sub send_mail {
        open(my $sendmail, "| /usr/sbin/sendmail -bm -ti") or die "could not invoke sendmail\n";
        print $sendmail <<"EOF";
From: $MAILFROM
To: $MAILTO
Subject: Security update for Debian Testing - $MAILDATE

This automatic mail gives an overview over security issues that were recently 
fixed in Debian Testing. The majority of fixed packages migrate to testing 
from unstable. If this would take too long, fixed packages are uploaded to the 
testing-security repository instead. It can also happen that vulnerable 
packages are removed from Debian testing.

$mail_text

How to update:
--------------
Make sure the line

        deb http://security.debian.org $TESTING/updates main contrib non-free

is present in your /etc/apt/sources.list. Of course, you also need the line
pointing to your normal $TESTING mirror. You can use

        aptitude update && aptitude dist-upgrade

to install the updates.


More information:
-----------------
More information about which security issues affect Debian can be found in the 
security tracker:

        http://security-tracker.debian.net/tracker/

A list of all known unfixed security issues is at

        http://security-tracker.debian.net/tracker/status/release/testing

EOF
#############################
        close($sendmail);
        if ($?) {
                print "Sendmail error\n";
        }
}
1	stef-guest	6538	#!/usr/bin/perl -w
2
3			# Compares the testing_status tables from two versions of security.db.
4	stef-guest	6547	# To be accurate, both versions must have been created with the same svn
5			# revision of the tracker data files (but with different package files).
6	stef-guest	6538
7			use strict;
8			use DBI;
9
10	thijs	16070	my $TESTING="wheezy";
11	stef-guest	6547	my $MAILTO='secure-testing-team@lists.alioth.debian.org';
12	stef-guest	6538	my $MAILFROM='sf@sfritsch.de';
13
14	nion	8397	my @d = localtime(time);
15	stef-guest	8464	my $MAILDATE = sprintf("%4d-%02d-%02d", $d[5] + 1900, $d[4] + 1, $d[3]);
16	nion	8397
17	stef-guest	6538	if (@ARGV != 2) {
18			die "usage:\nlist-updates old.db new.deb\n";
19			}
20
21			my $migrated = {};
22			my $dtsa = {};
23			my $removed = {};
24			my $versions = {};
25
26			my $mail_text = "";
27
28			my $old_dbh = DBI->connect("dbi:SQLite:dbname=$ARGV[0]","","", { RaiseError => 1 });
29			my $new_dbh = DBI->connect("dbi:SQLite:dbname=$ARGV[1]","","", { RaiseError => 1 });
30
31			my $sth_version = $new_dbh->prepare("SELECT version, archive FROM source_packages WHERE name = ? AND release = '$TESTING' AND subrelease = ? ");
32			my $sth_desc = $new_dbh->prepare("SELECT description FROM bugs WHERE name = ?");
33			my $sth_debbug = $new_dbh->prepare("SELECT d.bug FROM package_notes p JOIN debian_bugs d ON d.note = p.id WHERE bug_name = ? AND package = ? AND release = ''");
34
35			my $old_issues = get_issues($old_dbh);
36			my $new_issues = get_issues($new_dbh);
37
38			foreach my $package ( sort keys %{$old_issues} ) {
39			$versions->{$package} = package_version($package); # undef if package does not exist in $new_dbh
40
41			foreach my $issue ( sort keys %{$old_issues->{$package}} ) {
42			my $old = $old_issues->{$package}->{$issue};
43			my $new = $new_issues->{$package}->{$issue};
44
45			if ( $new ) {
46			if ( $old->{testing_security_fixed} == 0
47			and $new->{testing_security_fixed} == 1 )
48			{
49			push @{$dtsa->{$package}}, $issue;
50			$versions->{$package} = package_version($package, "security");
51			}
52
53			}
54			else {
55			if ( ! defined $versions->{$package} ) {
56			push @{$removed->{$package}}, $issue;
57			}
58			elsif ( $old->{testing_security_fixed} != 1 ) {
59			push @{$migrated->{$package}}, $issue;
60			}
61			}
62			}
63			}
64
65			print_hash($dtsa, "DTSA", <<"EOF");
66			The following issues have been fixed by uploads to testing-security:
67
68			EOF
69
70			print_hash($migrated, "Migrated from unstable");
71
72			print_hash($removed, "Removed from testing", <<"EOF");
73			The following issues have been "fixed" by removing the (source) packages from
74			testing. This probably means that you have to manually uninstall the
75			corresponding binary packages to fix the issues.
76	stef-guest	6578	It can also mean that the packages have been replaced, or that they have been
77	stef-guest	6538	temporarily removed by the release team to make transitions from unstable
78			easier.
79
80			EOF
81
82
83
84			if ($mail_text) {
85			send_mail();
86			print "mail sent.\n";
87			}
88			else {
89			print "nothing fixed, no mail sent.\n";
90			}
91
92			# workaround DBD::Sqlite bug
93			undef $sth_version;
94			undef $sth_desc;
95			undef $sth_debbug;
96
97			########### end MAIN #############
98
99			sub print_mail {
100			$mail_text .= join('', @_);
101			}
102
103			sub print_both {
104			print_mail(@_);
105			print @_;
106			}
107
108			sub print_hash {
109			my $hash = shift;
110			my $name = shift;
111			my $desc = shift;
112
113			return if ! scalar keys %{$hash};
114
115			print_both("$name:\n");
116	stef-guest	6547	print_both('=' x ( length($name) + 1) , "\n");
117	stef-guest	6538	print_mail("$desc") if $desc;
118
119			foreach my $p (sort keys %{$hash}) {
120			my $version = "";
121			if ( $versions->{$p} ) {
122			$version = " $versions->{$p}";
123			}
124			print_both("$p" . $version . ":\n");
125
126			# sort DTSAs first
127			my @issues = sort grep(/^DTSA/, @{$hash->{$p}});
128			push @issues, sort grep(!/^DTSA/, @{$hash->{$p}});
129			my %seen_dbug;
130			foreach my $i (@issues) {
131			print_both(issue2string($i));
132
133			# print debian bug no more than once per package
134			my @dbugs = issue2debbug($i, $p);
135			foreach my $dbug (@dbugs) {
136			if ( ! $seen_dbug{$dbug} ) {
137			$seen_dbug{$dbug} = 1;
138			print_both(" "x15 . "http://bugs.debian.org/$dbug\n");
139			}
140			}
141			}
142			print_both("\n");
143			}
144
145			}
146
147
148			sub get_issues {
149			my $dbh = shift;
150			return $dbh->selectall_hashref(
151			'SELECT package, bug, unstable_vulnerable, testing_security_fixed FROM testing_status',
152			[ 'package', 'bug' ] );
153			}
154
155			sub package_version {
156			my $package = shift;
157			my $subrelease = shift \|\| "";
158			$sth_version->execute($package, $subrelease);
159			my $result = $sth_version->fetchall_arrayref();
160
161			if (scalar @{$result} > 1) {
162			return "";
163			}
164			if (scalar @{$result} == 0) {
165			return undef;
166			}
167			my $archive = "";
168			if ($result->[0]->[1] ne 'main') {
169			$archive = " ($result->[0]->[1])";
170			}
171			return $result->[0]->[0] . $archive;
172
173			}
174
175			sub issue2string {
176			my $issue = shift;
177			my $url = "";
178			my $desc = "";
179
180			$sth_desc->execute($issue);
181			my $result = $sth_desc->fetchall_arrayref();
182			$desc = $result->[0]->[0];
183
184			if ( $issue =~ /^CVE-\d{4}-\d{4}/ ) {
185	stef-guest	6547	$url = "http://cve.mitre.org/cgi-bin/cvename.cgi?name=" . $issue ;
186	stef-guest	6538	return "$issue: $url\n";
187			}
188			elsif ( $issue =~ /^DTSA-/ ) {
189			return "$issue : $desc\n";
190			}
191			else {
192			return "<no CVE yet> : $desc\n";
193			}
194
195			}
196
197			sub issue2debbug {
198			my ($issue, $package) = @_;
199
200			$sth_debbug->execute($issue, $package);
201			my $rows = $sth_debbug->fetchall_arrayref();
202			my @bugs = map { $_->[0] } @{$rows};
203
204			return @bugs;
205			}
206
207			sub send_mail {
208			open(my $sendmail, "\| /usr/sbin/sendmail -bm -ti") or die "could not invoke sendmail\n";
209			print $sendmail <<"EOF";
210			From: $MAILFROM
211			To: $MAILTO
212	nion	8397	Subject: Security update for Debian Testing - $MAILDATE
213	stef-guest	6538
214			This automatic mail gives an overview over security issues that were recently
215	joeyh	6583	fixed in Debian Testing. The majority of fixed packages migrate to testing
216	stef-guest	6538	from unstable. If this would take too long, fixed packages are uploaded to the
217			testing-security repository instead. It can also happen that vulnerable
218			packages are removed from Debian testing.
219
220			$mail_text
221
222	stef-guest	6547	How to update:
223			--------------
224	stef-guest	6538	Make sure the line
225
226			deb http://security.debian.org $TESTING/updates main contrib non-free
227
228	stef-guest	6578	is present in your /etc/apt/sources.list. Of course, you also need the line
229			pointing to your normal $TESTING mirror. You can use
230	stef-guest	6538
231			aptitude update && aptitude dist-upgrade
232
233			to install the updates.
234
235
236			More information:
237			-----------------
238			More information about which security issues affect Debian can be found in the
239			security tracker:
240
241			http://security-tracker.debian.net/tracker/
242
243			A list of all known unfixed security issues is at
244
245			http://security-tracker.debian.net/tracker/status/release/testing
246
247			EOF
248			#############################
249			close($sendmail);
250			if ($?) {
251			print "Sendmail error\n";
252			}
253			}