# -*- perl -*-
-# $Id: errorlib.in,v 1.23 2003/05/24 22:43:55 cjwatson Exp $
-sub F_SETLK { 6; } sub F_WRLCK{ 1; }
-$flockstruct= 'sslll'; # And there ought to be something for this too.
-
-sub get_hashname {
- return "" if ( $_[ 0 ] < 0 );
- return sprintf "%02d", $_[ 0 ] % 100;
-}
+use Mail::Address;
+use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522 getmailbody);
+use Debbugs::Packages qw(:all);
+use Debbugs::Common qw(:all);
+use Debbugs::Status qw(:all);
+use Carp;
sub unlockreadbugmerge {
local ($rv) = @_;
&unfilelock if $rv >= 1;
}
-sub lockreadbugmerge {
- local ($lref, $location) = @_;
- local $data;
- if (!($data = &lockreadbug($lref, $location))) { return ( 0, undef ); }
- if (!length($data{mergedwith})) { return ( 1, $data ); }
- &unfilelock;
- &filelock('lock/merge');
- if (!&lockreadbug($lref, $location)) { &unfilelock; return ( 0, undef ); }
- return ( 2, $data );
-}
-
-sub getbuglocation {
- my ( $bugnum, $ext ) = @_;
- my $archdir = sprintf "%02d", $bugnum % 100;
- return 'archive' if ( -r "$gSpoolDir/archive/$archdir/$bugnum.$ext" );
- return 'db' if ( -r "$gSpoolDir/db/$bugnum.$ext" );
- return 'db-h' if ( -r "$gSpoolDir/db-h/$archdir/$bugnum.$ext" );
- return undef;
-}
-
-sub getlocationpath {
- my ($location) = @_;
- if ($location eq 'archive') {
- return "$gSpoolDir/archive";
- } elsif ($location eq 'db') {
- return "$gSpoolDir/db";
- } else {
- return "$gSpoolDir/db-h";
- }
-}
-
-sub readbug {
- local ($lref, $location) = @_;
- my $hash = get_hashname($lref);
- $path = getlocationpath($location);
- if (!open(S,"$path/$hash/$lref.status")) { &unfilelock; return undef; }
- my %data;
- chop($data{originator}= <S>);
- chop($data{date}= <S>);
- chop($data{subject}= <S>);
- chop($data{msgid}= <S>);
- chop($data{package}= <S>);
- chop($data{keywords}= <S>);
- chop($data{done}= <S>);
- chop($data{forwarded}= <S>);
- chop($data{mergedwith}= <S>);
- chop($data{severity}= <S>);
- chop($data{versions}= <S>);
- chop($data{fixed_versions}= <S>);
- close(S);
- $data{severity} = 'normal' if $data{severity} eq '';
- return \%data;
-}
-
-sub lockreadbug {
- local ($lref, $location) = @_;
- &filelock("lock/$lref");
- return readbug($lref, $location);
-}
-
-sub writebug {
- local ($ref, $data, $location) = @_;
- my $hash = get_hashname($ref);
- my $change;
- $path = getlocationpath($location);
- open(S,">$path/$hash/$ref.status.new") || &quit("opening $path/$hash/$ref.status.new: $!");
- print(S
- "$data->{originator}\n".
- "$data->{date}\n".
- "$data->{subject}\n".
- "$data->{msgid}\n".
- "$data->{package}\n".
- "$data->{keywords}\n".
- "$data->{done}\n".
- "$data->{forwarded}\n".
- "$data->{mergedwith}\n".
- "$data->{severity}\n".
- "$data->{versions}\n".
- "$data->{fixed_versions}\n") || &quit("writing $path/$hash/$ref.status.new: $!");
- close(S) || &quit("closing $path/$hash/$ref.status.new: $!");
- if (-e "$path/$hash/$ref.status") {
- $change = 'change';
- } else {
- $change = 'new';
- }
- rename("$path/$hash/$ref.status.new","$path/$hash/$ref.status") ||
- &quit("installing new $path/$hash/$ref.status: $!");
- &bughook($change,$ref,
- "$data->{originator}\n".
- "$data->{date}\n".
- "$data->{subject}\n".
- "$data->{msgid}\n".
- "$data->{package}\n".
- "$data->{keywords}\n".
- "$data->{done}\n".
- "$data->{forwarded}\n".
- "$data->{mergedwith}\n".
- "$data->{severity}\n".
- "$data->{versions}\n".
- "$data->{fixed_versions}\n");
- &unfilelock;
-}
-
-sub filelock {
- # NB - NOT COMPATIBLE WITH `with-lock'
- local ($lockfile,$flockpushno,$evalstring,$count,$errors,@s1,@s2) = @_;
- $flockpushno= $#filelocks+1;
- $count= 10; $errors= '';
- for (;;) {
- $evalstring= "
- open(FLOCK${flockpushno},\"> \$lockfile\") || die \"open: \$!\";
- \$flockwant= pack(\$flockstruct,&F_WRLCK,0,0,1,0);".
- ($] >= 5.000 ? "
- fcntl(FLOCK$flockpushno,&F_SETLK,\$flockwant) || die \"setlk: \$!\";" : "
- \$z= syscall(&SYS_fcntl,fileno(FLOCK$flockpushno),&F_SETLK,\$flockwant) < 0
- && die \"syscall fcntl setlk: \$!\";") ."
- (\@s1= lstat(\$lockfile)) || die \"lstat: \$!\";
- (\@s2= stat(FLOCK$flockpushno)) || die \"fstat: \$!\";
- join(',',\@s1) eq join(',',\@s2) || die \"file switched\";
- 1;
- ";
- last if eval $evalstring;
- $errors .= $@;
- eval "close(FLOCK$flockpushno);";
- if (--$count <=0) {
- $errors =~ s/\n+$//;
- &quit("failed to get lock on file $lockfile: $errors // $evalstring");
- }
- sleep 10;
- }
- push(@cleanups,'unfilelock');
- push(@filelocks,$lockfile);
-}
-
-sub unfilelock {
- local ($lockfile) = pop(@filelocks);
- pop(@cleanups);
- eval 'close(FLOCK'.($#filelocks+1).');' || warn "failed to close lock file: $!";
- unlink($lockfile) || warn "failed to remove lock file: $!";
-}
-
-sub quit {
- print DEBUG "quitting >$_[0]<\n";
- local ($u);
- while ($u= $cleanups[$#cleanups]) { &$u; }
- die "*** $_[0]\n";
-}
-
%saniarray= ('<','lt', '>','gt', '&','amp', '"','quot');
sub sani {
- local ($in) = @_;
- local ($out);
- while ($in =~ m/[<>&"]/) {
- $out.= $`. '&'. $saniarray{$&}. ';';
- $in=$';
- }
- $out.= $in;
- $out;
-}
-
-sub update_realtime {
- my ($file, $bug, $new) = @_;
-
- # update realtime index.db
-
- open(IDXDB, "<$file") or die "Couldn't open $file";
- open(IDXNEW, ">$file.new");
-
- my $line;
- while($line = <IDXDB>) {
- my @line = split /\s/, $line;
- last if ($line[1] == $bug);
- print IDXNEW $line;
- }
-
- if ($new eq "NOCHANGE") {
- print IDXNEW $line;
- } elsif ($new eq "REMOVE") {
- 0;
- } else {
- print IDXNEW $new;
- }
-
- print IDXNEW while(<IDXDB>);
-
- close(IDXNEW);
- close(IDXDB);
-
- rename("$file.new", $file);
-
- return $line;
+ my ($in) = @_;
+ carp "You should be using HTML::Entities instead.";
+ $in =~ s/([<>&"])/$saniarray{$1}/g;
+ return $in;
}
-sub bughook_archive {
- my $ref = shift;
- &filelock("debbugs.trace.lock");
- &appendfile("debbugs.trace","archive $ref\n");
- my $line = update_realtime(
- "$gSpoolDir/index.db.realtime",
- $ref,
- "REMOVE");
- update_realtime("$gSpoolDir/index.archive.realtime",
- $ref, $line);
- &unfilelock;
-}
-
-sub bughook {
- my ( $type, $ref ) = ( shift, shift );
- &filelock("debbugs.trace.lock");
-
- &appendfile("debbugs.trace","$type $ref\n",@_);
-
- my @stuff=split /\n/, "$_[0]\n\n\n\n\n\n\n";
-
- my $firstpkg;
- my $whendone = "open";
- my $severity = $gDefaultSeverity;
- ($firstpkg = $stuff[4]) =~ s/[,\s].*$//;
- $whendone = "forwarded" if length $stuff[7];
- $whendone = "done" if length $stuff[6];
- $severity = $stuff[9] if length $stuff[9];
-
- my $k = sprintf "%s %d %d %s [%s] %s %s\n",
- $firstpkg, $ref, $stuff[1], $whendone, $stuff[0],
- $severity, $stuff[5];
-
- update_realtime("$gSpoolDir/index.db.realtime", $ref, $k);
-
- &unfilelock;
-}
-
-sub appendfile {
- my $file = shift;
- if (!open(AP,">>$file")) {
- print DEBUG "failed open log<\n";
- print DEBUG "failed open log err $!<\n";
- &quit("opening $file (appendfile): $!");
- }
- print(AP @_) || &quit("writing $file (appendfile): $!");
- close(AP) || &quit("closing $file (appendfile): $!");
-}
-
-sub getmailbody {
- my $entity = shift;
- my $type = $entity->effective_type;
- if ($type eq 'text/plain' or
- ($type =~ m#text/# and $type ne 'text/html') or
- $type eq 'application/pgp') {
- return $entity->bodyhandle;
- } elsif ($type eq 'multipart/alternative') {
- # RFC 2046 says we should use the last part we recognize.
- for my $part (reverse $entity->parts) {
- my $ret = getmailbody($part);
- return $ret if $ret;
- }
- } else {
- # For other multipart types, we just pretend they're
- # multipart/mixed and run through in order.
- for my $part ($entity->parts) {
- my $ret = getmailbody($part);
- return $ret if $ret;
- }
- }
- return undef;
+sub get_addresses {
+ return
+ map { $_->address() }
+ map { Mail::Address->parse($_) } @_;
}
-sub escapelog {
- my @log = @_;
- map { s/^([\01-\07\030])/\030$1/gm } @log;
- return \@log;
-}
-
-
@severities= grep { not exists $gObsoleteSeverities{$_} } @gSeverityList;
@showseverities= @severities;
grep ($_= $_ eq '' ? $gDefaultSeverity : $_, @showseverities);
-@strongseverities= @gStrongSeverities;
%displayshowseverities= %gSeverityDisplay;
+# compatibility
+if (defined $gFowardList and not defined $gForwardList) {
+ $gForwardList = $gFowardList;
+}
+
1;
projects / debbugs.git / blobdiff