]> git.deb.at Git - deb/packages.git/blob - bin/build-maintainerdb
Merge branch 'archive-master' of git+ssh://git.debian.org/git/webwml/packages into...
[deb/packages.git] / bin / build-maintainerdb
1 #! /usr/bin/perl
2
3 #   build-maintainerdb - convert several Packages files to maintainer database
4 #   Copyright (c) 1998,9,2001,3,4,6  Martin Schulze <joey@debian.org>
5 #   Copyright (C) 2007 Joerg Jaspert <joerg@debian.org>
6 #
7 #   This program is free software; you can redistribute it and/or modify
8 #   it under the terms of the GNU General Public License as published by
9 #   the Free Software Foundation; either version 2 of the License, or
10 #   (at your option) any later version.
11 #
12 #   This program is distributed in the hope that it will be useful,
13 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
14 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 #   GNU General Public License for more details.
16 #
17 #   You should have received a copy of the GNU General Public License
18 #   along with this program; if not, write to the Free Software
19 #   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20
21 #   Todo:
22 #    . Read maintainer changes from overrides file(s), need to rub
23 #      out all existing entries
24
25 use strict;
26 use warnings;
27 use DB_File;
28
29 use lib '../lib';
30
31 use Deb::Versions;
32
33 # read the configuration
34 if (!open (C, "../config.sh")) {
35     print "\nInternal Error: Cannot open configuration file.\n\n";
36     exit 0;
37 }
38 my $topdir = "/org/packages.debian.org";
39 while (<C>) {
40     $topdir = $1 if (/^\s*topdir="?(.*)"?\s*$/);
41 }
42 close (C);
43
44 #my $maildomain = "packages.debian.org";
45 my $ptsdomain = "packages.qa.debian.org";
46
47
48 my $maintainerfile = "$topdir/../mirrors/ftp.debian.org/indices/Maintainers";
49 my $maintainerdb = "$topdir/conf/maintainer";
50 my $overridefile = "$topdir/conf/maintainerdb.override";
51 my $rblfile = "$topdir/conf/rbllist";
52 my $rhsblfile = "$topdir/mail/rhsbllist";
53 my $calloutfile = "$topdir/mail/callout_users";
54 my @postcall = ( "/usr/sbin/postmap", $maintainerdb );
55 my $opt_verbose = 0;
56 my $dbdir = "$topdir/files/db";
57
58 my %maint;
59 my %binsrc;
60
61 # Lets take pdo database input files for the source mapping
62 sub read_bin_src_mapping
63 {
64     tie my %src_packages, 'DB_File', "$dbdir/sources_small.db",
65     O_RDONLY, 0666, $DB_BTREE
66         or die "couldn't tie DB $dbdir/sources_small.db: $!";
67     tie my %src2bin, 'DB_File', "$dbdir/sources_packages.db",
68     O_RDONLY, 0666, $DB_BTREE
69         or die "couldn't open $dbdir/sources_packages.db: $!";
70
71     my %bin;
72     while (my ($source, $data) = each %src_packages) {
73         my @src = map { [ split(/\s+/) ] } split( /\0/, $data );
74         my $newest = (sort( { version_cmp($b->[-1],$a->[-1]) } @src))[0];
75         my ($section, $version) = @{$newest}[2,5];
76         
77         my $bin_data = $src2bin{$source};
78         unless ($bin_data) {
79             warn "no binary data found for $source\n";
80             # source packages without binaries have most
81             # likely been succeded
82             next;
83         }
84         
85         my @bin = map { [ split(/\s+/) ] } split( /\0/, $bin_data );
86         my %seen;
87         foreach (@bin) {
88             my ($pkg, $ver) = @{$_}[2,3];
89             next if $seen{"$pkg/$ver"}++; # weed out multiple arches/suites faster
90             if ($bin{$pkg}
91                 && ($bin{$pkg}{source} ne $source)
92                 && (version_cmp($bin{$pkg}{version},$ver) > 0)) {
93                 next;
94             } else {
95                 $bin{$pkg} = { version => $ver, source => $source,
96                                target => "$section" };
97                 $binsrc{$pkg} = $source;
98             }
99         }
100         $binsrc{$source} = $source;
101     }
102 }
103
104 sub package_maintainer
105 {
106     my $pkg = shift;
107     my $login = shift;
108     my $addr = shift;
109     my $home = "/debian/home/$login";
110
111     if (-d $home) {
112         if (-f "$home/.forward-$pkg") {
113             return "$login-$pkg\@master.debian.org";
114         }
115     }
116     return $addr;
117 }
118
119 sub read_maintainer
120 {
121     my $file = shift;
122     my $package;
123     my $maintainer;
124     my $maint;
125
126     open (F, "$file") || die "Can't open $file, $!";
127     printf "Reading %s\n", $file if ($opt_verbose);
128     while (<F>) {
129         next if (/^#/);
130         next if (/^$/);
131         /(\S+)\s+(.*)/;
132         $package=$1; $maint=$2;
133         if (! exists $maint{$package}) {
134             printf "  EVAL (%s, \"%s\")\n", $package, $maint if ($opt_verbose > 2);
135
136                 if (exists $maint{$package}) {
137                     $maint{$package} .= " ";
138                     printf "  EXPAND (%s)\n", $package if ($opt_verbose > 2);
139                 }
140                 if ($maint =~ /.*<(.*)>/) {
141                     $maint{$package} .= $1;
142                     printf "  ADD (%s, %s)\n", $package, $1 if ($opt_verbose > 2);
143                 } elsif ($maint =~ /\s*(\S+)\s+\(.*\)/) {
144                     $maint{$package} .= $1;
145                     printf "  ADD (%s, %s)\n", $package, $1 if ($opt_verbose > 2);
146                 } else {
147                     $maint{$package} .= $maint;
148                     printf "  ADD (%s, %s)\n", $package, $maint if ($opt_verbose > 2);
149                 }
150
151             printf "  %s: %s\n", $package, $maint{$package} if ($opt_verbose > 1);
152
153 # Short what? Whats this supposed to do, except creating new (and 99% broken) something -> email mappings?
154 #           my $pkgshort = "";
155 #           if ($package =~ /(.*[^\d\.]+)([\d\.]*\d)$/) {
156 #               $pkgshort = $1;
157 #               print "Short what? $pkgshort (long is $package)\n";
158 #               $maint{$pkgshort} = $maint{$package} if (! exists $maint{$pkgshort});
159 #               printf "  %s: %s\n", $pkgshort, $maint{$package} if ($opt_verbose > 1);
160 #           }
161 #           if ($maint{$package} =~ /([^\@]+)\@(master\.)?debian\.org/) {
162 #               my $addrsave = $maint{$package} if ($opt_verbose > 1);
163 #               $maint{$package} = package_maintainer ($package, $1, $maint{$package});
164 #               printf "  Changed to %s\n", $maint{$package} if ($opt_verbose > 1 && ($addrsave ne $maint{$package}));
165 #               if (length ($pkgshort) > 0) {
166 #                   $maint{$pkgshort} = package_maintainer ($pkgshort, $1, $maint{$pkgshort});
167 #               }
168 #           }
169         } else {
170             printf "Skipping double $package\n" if ($opt_verbose);
171             printf "LINE: $_" if ($opt_verbose > 2);
172         }
173     }
174     close (F);
175 }
176
177
178
179 sub write_maintainer
180 {
181     my $file = shift;
182
183     printf "Writing to %s.new\n", $file if ($opt_verbose > 0);
184     open (CONF, ">$file.new") || die "Can't open $file.new, $!";
185     open (WRITE, "| cdbmake $file.cdb $file.cdb.tmp") || die "Can't talk to cdbmake, $!";
186     open (RBL, ">$rblfile.new") || die "Can't open $file.new, $!";
187     open (RHSBL, ">$rhsblfile.new") || die "Can't open $file.new, $!";
188     open (CALLOUT, ">$calloutfile.new") || die "Can't open $file.new, $!";
189     my $forward;
190     foreach my $package (sort(keys(%maint))) {
191 # It is possible that we do not know a source package -> in that case fall back to old behaviour
192 # and only mail the maintainer. Can happen when pdo doesnt know the suite the source is in, like
193 # it doesnt know oldstable-proposed-updates at date of writing this code.
194         $forward = "$maint{$package}";
195         if ($binsrc{$package}) {
196             $forward .= ", $binsrc{$package}_contact\@$ptsdomain";
197         }
198         printf "%s -> %s\n", $package, $forward if ($opt_verbose);
199         printf CONF "%s:\t%s\n", $package, $forward;
200         printf WRITE "+%d,%d:%s->%s\n", length($package), length($forward), $package, $forward;
201         printf RBL "%s : zen.spamhaus.org : cbl.abuseat.org\n", $package; 
202         printf RHSBL "%s : bogusmx.rfc-ignorant.org/\$sender_address_domain : dsn.rfc-ignorant.org/\$sender_address_domain\n", $package;
203         printf CALLOUT "%s\n", $package;
204 #       printf "%s -> %s and pts: %s\n", $package, $maint{$package}, $binsrc{$package} if ($opt_verbose);
205 #       printf CONF "%s@%s\t%s, %s_contact@%s\n", $package, $maildomain, $maint{$package}, $binsrc{$package}, $ptsdomain;
206     }
207     print WRITE "\n";
208     close (CONF);
209     close (WRITE);
210     close (RBL);
211     close (RHSBL);
212     close (CALLOUT);
213     printf "Renaming the new files\n" if ($opt_verbose > 0);
214     system "mv -f $file.new $file";
215     system "mv -f $rblfile.new $rblfile";
216     system "mv -f $rhsblfile.new $rhsblfile";
217     system "mv -f $calloutfile.new $calloutfile";
218 #    printf "Executing @postcall\n" if ($opt_verbose > 0);
219 #    system @postcall;
220 }
221
222 sub help
223 {
224     print "build-maintainerdb - Build the maintainer db for packages.debian.org.\n";
225     print "-d     debug, changes output file to ./maintainerdb\n";
226     print "-h     This help\n";
227     print "-v     Increase verbosity by 1\n";
228     print "-vv    Increase verbosity by 2\n";
229     print "-vvv   Increase verbosity by 3\n";
230 }
231
232
233 # Main program
234 #
235 while ($#ARGV > -1) {
236     if ($ARGV[0] eq "-v") {
237         $opt_verbose++;
238     } elsif ($ARGV[0] eq "-vv") {
239         $opt_verbose+= 2;
240     } elsif ($ARGV[0] eq "-vvv") {
241         $opt_verbose+= 3;
242     } elsif ($ARGV[0] eq "-h") {
243         help();
244     } elsif ($ARGV[0] eq "-d") {
245         $maintainerdb = "./maintainerdb";
246     }
247     shift;
248 }
249
250 &read_bin_src_mapping();
251
252 &read_maintainer ($overridefile);
253 &read_maintainer ($maintainerfile);
254
255 &write_maintainer ($maintainerdb);
256