| 1 |
# Configuration and some common code
|
| 2 |
|
| 3 |
use vars qw($pts_dir $spool_dir $conf_template $db_filename $db_tags_filename
|
| 4 |
$sendmail $sendmailnobody $sources $pts_email @available_tags @default_tags
|
| 5 |
%db_content $db %db_tags_content $db_tags
|
| 6 |
%bin2src %src $open_count);
|
| 7 |
|
| 8 |
# Configuration variables
|
| 9 |
$pts_dir = "/org/packages.qa.debian.org";
|
| 10 |
$spool_dir = "$pts_dir/spool";
|
| 11 |
$conf_template = "$pts_dir/etc/conf_tpl.txt";
|
| 12 |
$db_filename = "$pts_dir/db/subscription.db";
|
| 13 |
$db_tags_filename = "$pts_dir/db/tags.db";
|
| 14 |
$sendmail = '/usr/sbin/sendmail -f bounces@packages.qa.debian.org';
|
| 15 |
$sendmailnobody = '/usr/sbin/sendmail -f bounces-likely-spam@packages.qa.debian.org';
|
| 16 |
$sources = "/org/packages.qa.debian.org/www/incoming/sources";
|
| 17 |
$pts_email = 'pts@qa.debian.org';
|
| 18 |
@available_tags = qw(default bts bts-control cvs summary ddtp
|
| 19 |
upload-source upload-binary katie-other);
|
| 20 |
@default_tags = qw(default bts bts-control summary upload-source katie-other);
|
| 21 |
|
| 22 |
# Global variables
|
| 23 |
%db_content = ();
|
| 24 |
$db = undef;
|
| 25 |
%db_tags_content = ();
|
| 26 |
$db_tags = undef;
|
| 27 |
%bin2src = ();
|
| 28 |
%src = ();
|
| 29 |
$open_count = 0;
|
| 30 |
|
| 31 |
# Common code
|
| 32 |
sub open_db_write {
|
| 33 |
$DB_BTREE->{'flags'} = R_DUP;
|
| 34 |
if ($open_count <= 0) {
|
| 35 |
$db = tie %db_content, "DB_File", $db_filename, O_RDWR|O_CREAT,
|
| 36 |
0660, $DB_BTREE
|
| 37 |
or die "Can't open database $db_filename : $!\n";
|
| 38 |
$db_tags = tie %db_tags_content, "DB_File", $db_tags_filename,
|
| 39 |
O_RDWR|O_CREAT, 0660, $DB_HASH
|
| 40 |
or die "Can't open database $db_tags_filename : $!\n";
|
| 41 |
}
|
| 42 |
$open_count++;
|
| 43 |
}
|
| 44 |
sub open_db_read {
|
| 45 |
$DB_BTREE->{'flags'} = R_DUP;
|
| 46 |
if ($open_count <= 0) {
|
| 47 |
if (-f $db_filename and -f $db_tags_filename) {
|
| 48 |
$db = tie %db_content, "DB_File", $db_filename, O_RDONLY,
|
| 49 |
0660, $DB_BTREE
|
| 50 |
or die "Can't open database $db_filename : $!\n";
|
| 51 |
$db_tags = tie %db_tags_content, "DB_File", $db_tags_filename,
|
| 52 |
O_RDONLY, 0660, $DB_HASH
|
| 53 |
or die "Can't open database $db_tags_filename : $!\n";
|
| 54 |
} else {
|
| 55 |
open_db_write();
|
| 56 |
}
|
| 57 |
}
|
| 58 |
$open_count++;
|
| 59 |
}
|
| 60 |
sub close_db {
|
| 61 |
$open_count--;
|
| 62 |
if ($open_count <= 0) {
|
| 63 |
undef $db;
|
| 64 |
untie %db_content;
|
| 65 |
}
|
| 66 |
}
|
| 67 |
sub subscribe {
|
| 68 |
my ($address, $package) = @_;
|
| 69 |
open_db_write();
|
| 70 |
my @emails = $db->get_dup($package);
|
| 71 |
my $found = 0;
|
| 72 |
foreach (@emails) {
|
| 73 |
$found = 1 if ($_ eq $address);
|
| 74 |
}
|
| 75 |
$db_content{$package} = $address if (! $found);
|
| 76 |
close_db();
|
| 77 |
return ! $found;
|
| 78 |
}
|
| 79 |
sub unsubscribe {
|
| 80 |
my ($address, $package) = @_;
|
| 81 |
my $ok = 1;
|
| 82 |
open_db_write();
|
| 83 |
if ($db->find_dup($package, $address) == 0) {
|
| 84 |
$db->del_dup($package, $address);
|
| 85 |
} else {
|
| 86 |
$ok = 0;
|
| 87 |
}
|
| 88 |
close_db();
|
| 89 |
return $ok;
|
| 90 |
}
|
| 91 |
sub which {
|
| 92 |
my ($address) = @_;
|
| 93 |
my @l;
|
| 94 |
my %seen;
|
| 95 |
open_db_read();
|
| 96 |
foreach my $p (keys %db_content) {
|
| 97 |
next if (exists $seen{$p});
|
| 98 |
$seen{$p} = 1;
|
| 99 |
if ($db->find_dup($p, $address) == 0) {
|
| 100 |
push @l, $p;
|
| 101 |
}
|
| 102 |
}
|
| 103 |
close_db();
|
| 104 |
return @l;
|
| 105 |
}
|
| 106 |
sub list {
|
| 107 |
my ($package) = @_;
|
| 108 |
open_db_read();
|
| 109 |
my @l = $db->get_dup($package);
|
| 110 |
close_db();
|
| 111 |
return @l;
|
| 112 |
}
|
| 113 |
sub load_sources {
|
| 114 |
return if (scalar(keys %bin2src));
|
| 115 |
open(SOURCES, "< $sources") || warn "Can't open $sources: $!\n";
|
| 116 |
while(defined($_=<SOURCES>)) {
|
| 117 |
my ($bin, $comp, $src) = (split(/\s+/));
|
| 118 |
$bin2src{lc($bin)} = lc($src);
|
| 119 |
$src{lc($src)} = 1;
|
| 120 |
}
|
| 121 |
close(SOURCES);
|
| 122 |
}
|
| 123 |
sub map_package {
|
| 124 |
my ($pkg) = @_;
|
| 125 |
my ($package, @msg);
|
| 126 |
load_sources();
|
| 127 |
if (exists $src{$pkg}) {
|
| 128 |
$package = $pkg;
|
| 129 |
} elsif (exists $bin2src{$pkg}) {
|
| 130 |
$package = $bin2src{$pkg};
|
| 131 |
push @msg, "$pkg is not a source package. However $package is \n";
|
| 132 |
push @msg, "the source package for the $pkg binary package.\n";
|
| 133 |
push @msg, "\n";
|
| 134 |
} else {
|
| 135 |
$package = $pkg;
|
| 136 |
push @msg, "$pkg is neither a source package nor a binary package. \n";
|
| 137 |
push @msg, "It may be a 'virtual package' or a mistake...\n";
|
| 138 |
push @msg, "\n";
|
| 139 |
}
|
| 140 |
return ($package, @msg);
|
| 141 |
}
|
| 142 |
sub available_tags {
|
| 143 |
return @available_tags;
|
| 144 |
}
|
| 145 |
sub is_valid_tag {
|
| 146 |
my ($tag) = @_;
|
| 147 |
$tag = lc($tag);
|
| 148 |
foreach (available_tags()) {
|
| 149 |
return 1 if ($tag eq $_);
|
| 150 |
}
|
| 151 |
return 0;
|
| 152 |
}
|
| 153 |
sub clean_tags {
|
| 154 |
my %h;
|
| 155 |
foreach (@_) { $h{lc($_)} = 1 }
|
| 156 |
return grep { defined($h{$_}) && $h{$_} } available_tags();
|
| 157 |
}
|
| 158 |
sub get_default_tags {
|
| 159 |
my ($email) = @_;
|
| 160 |
$email = lc($email);
|
| 161 |
open_db_read();
|
| 162 |
my @res;
|
| 163 |
if (exists $db_tags_content{$email}) {
|
| 164 |
@res = split(/,/, $db_tags_content{$email});
|
| 165 |
} else {
|
| 166 |
@res = @default_tags;
|
| 167 |
}
|
| 168 |
close_db();
|
| 169 |
return @res;
|
| 170 |
}
|
| 171 |
sub set_default_tags {
|
| 172 |
my ($email, @tags) = @_;
|
| 173 |
open_db_write();
|
| 174 |
$db_tags_content{lc($email)} = join(",", clean_tags(@tags));
|
| 175 |
close_db();
|
| 176 |
}
|
| 177 |
sub get_tags {
|
| 178 |
my ($email, $package) = @_;
|
| 179 |
$email = lc($email);
|
| 180 |
$package = lc($package);
|
| 181 |
open_db_read();
|
| 182 |
my @res;
|
| 183 |
if (exists $db_tags_content{"$email#$package"}) {
|
| 184 |
@res = split(/,/, $db_tags_content{"$email#$package"});
|
| 185 |
} elsif (exists $db_tags_content{$email}) {
|
| 186 |
@res = split(/,/, $db_tags_content{$email});
|
| 187 |
} else {
|
| 188 |
@res = @default_tags;
|
| 189 |
}
|
| 190 |
close_db();
|
| 191 |
return @res;
|
| 192 |
}
|
| 193 |
sub set_tags {
|
| 194 |
my ($email, $package, @tags) = @_;
|
| 195 |
open_db_write();
|
| 196 |
$db_tags_content{lc("$email#$package")} = join(",", clean_tags(@tags));
|
| 197 |
close_db();
|
| 198 |
}
|
| 199 |
|
| 200 |
1;
|
Parent Directory
| 
Revision Log