scripts/errorlib.in

   1 # -*- perl -*-
   2 # $Id: errorlib.in,v 1.19 2003/05/03 20:01:20 doogie Exp $
   3
   4 sub F_SETLK { 6; } sub F_WRLCK{ 1; }
   5 $flockstruct= 'sslll'; # And there ought to be something for this too.
   6
   7 sub get_hashname {
   8     return "" if ( $_[ 0 ] < 0 );
   9     return sprintf "%02d", $_[ 0 ] % 100;
  10 }
  11
  12 sub unlockreadbugmerge {
  13     local ($rv) = @_;
  14     &unfilelock if $rv >= 2;
  15     &unfilelock if $rv >= 1;
  16 }
  17
  18 sub lockreadbugmerge {
  19     local ($lref, $location) = @_;
  20     local $data;
  21     if (!($data = &lockreadbug($lref, $location))) { return ( 0, undef ); }
  22     if (!length($data{mergedwith})) { return ( 1, $data ); }
  23     &unfilelock;
  24     &filelock('lock/merge');
  25     if (!&lockreadbug($lref, $location)) { &unfilelock; return ( 0, undef ); }
  26     return ( 2, $data );
  27 }
  28
  29 sub readbug {
  30     local ($lref, $location) = @_;
  31     my $hash = get_hashname($lref);
  32     if ($location eq 'archive') {
  33         $path = 'archive';
  34     } else {
  35         $path = 'db-h';
  36     }
  37     if (!open(S,"$path/$hash/$lref.status")) { &unfilelock; return undef; }
  38     my %data;
  39     chop($data{originator}= <S>);
  40     chop($data{date}= <S>);
  41     chop($data{subject}= <S>);
  42     chop($data{msgid}= <S>);
  43     chop($data{package}= <S>);
  44     chop($data{keywords}= <S>);
  45     chop($data{done}= <S>);
  46     chop($data{forwarded}= <S>);
  47     chop($data{mergedwith}= <S>);
  48     chop($data{severity}= <S>);
  49     chop($data{versions}= <S>);
  50     chop($data{fixed_versions}= <S>);
  51     close(S);
  52         $data{severity} = 'normal' if $data{severity} eq '';
  53     return \%data;
  54 }
  55
  56 sub lockreadbug {
  57     local ($lref, $location) = @_;
  58     &filelock("lock/$lref");
  59     return readbug($lref, $location);
  60 }
  61
  62 sub writebug {
  63     local ($ref, $data, $location) = @_;
  64     my $hash = get_hashname($ref);
  65     my $change;
  66     if ($location eq 'archive') {
  67         $path = 'archive';
  68     } else {
  69         $path = 'db-h';
  70     }
  71     open(S,">$path/$hash/$ref.status.new") || &quit("opening $path/$hash/$ref.status.new: $!");
  72     print(S
  73           "$data->{originator}\n".
  74           "$data->{date}\n".
  75           "$data->{subject}\n".
  76           "$data->{msgid}\n".
  77           "$data->{package}\n".
  78           "$data->{keywords}\n".
  79           "$data->{done}\n".
  80           "$data->{forwarded}\n".
  81           "$data->{mergedwith}\n".
  82           "$data->{severity}\n".
  83           "$data->{versions}\n".
  84           "$data->{fixed_versions}\n") || &quit("writing $path/$hash/$ref.status.new: $!");
  85     close(S) || &quit("closing $path/$hash/$ref.status.new: $!");
  86     if (-e "$path/$hash/$ref.status") {
  87         $change = 'change';
  88     } else {
  89         $change = 'new';
  90     }
  91     rename("$path/$hash/$ref.status.new","$path/$hash/$ref.status") ||
  92         &quit("installing new $path/$hash/$ref.status: $!");
  93         &bughook($change,$ref,
  94           "$data->{originator}\n".
  95           "$data->{date}\n".
  96           "$data->{subject}\n".
  97           "$data->{msgid}\n".
  98           "$data->{package}\n".
  99           "$data->{keywords}\n".
 100           "$data->{done}\n".
 101           "$data->{forwarded}\n".
 102           "$data->{mergedwith}\n".
 103           "$data->{severity}\n".
 104           "$data->{versions}\n".
 105           "$data->{fixed_versions}\n");
 106     &unfilelock;
 107 }
 108
 109 sub filelock {
 110     # NB - NOT COMPATIBLE WITH `with-lock'
 111     local ($lockfile,$flockpushno,$evalstring,$count,$errors,@s1,@s2) = @_;
 112     $flockpushno= $#filelocks+1;
 113     $count= 10; $errors= '';
 114     for (;;) {
 115         $evalstring= "
 116             open(FLOCK${flockpushno},\"> \$lockfile\") || die \"open: \$!\";
 117             \$flockwant= pack(\$flockstruct,&F_WRLCK,0,0,1,0);".
 118                 ($] >= 5.000 ? "
 119             fcntl(FLOCK$flockpushno,&F_SETLK,\$flockwant) || die \"setlk: \$!\";" : "
 120             \$z= syscall(&SYS_fcntl,fileno(FLOCK$flockpushno),&F_SETLK,\$flockwant) < 0
 121                  && die \"syscall fcntl setlk: \$!\";") ."
 122             (\@s1= lstat(\$lockfile)) || die \"lstat: \$!\";
 123             (\@s2= stat(FLOCK$flockpushno)) || die \"fstat: \$!\";
 124             join(',',\@s1) eq join(',',\@s2) || die \"file switched\";
 125             1;
 126         ";
 127         last if eval $evalstring;
 128         $errors .= $@;
 129         eval "close(FLOCK$flockpushno);";
 130         if (--$count <=0) {
 131             $errors =~ s/\n+$//;
 132             &quit("failed to get lock on file $lockfile: $errors // $evalstring");
 133         }
 134         sleep 10;
 135     }
 136     push(@cleanups,'unfilelock');
 137     push(@filelocks,$lockfile);
 138 }
 139
 140 sub unfilelock {
 141     local ($lockfile) = pop(@filelocks);
 142     pop(@cleanups);
 143     eval 'close(FLOCK'.($#filelocks+1).');' || warn "failed to close lock file: $!";
 144     unlink($lockfile) || warn "failed to remove lock file: $!";
 145 }
 146
 147 sub quit {
 148     print DEBUG "quitting >$_[0]<\n";
 149     local ($u);
 150     while ($u= $cleanups[$#cleanups]) { &$u; }
 151     die "*** $_[0]\n";
 152 }
 153
 154 %saniarray= ('<','lt', '>','gt', '&','amp', '"','quot');
 155
 156 sub sani {
 157     local ($in) = @_;
 158     local ($out);
 159     while ($in =~ m/[<>&"]/) {
 160         $out.= $`. '&'. $saniarray{$&}. ';';
 161         $in=$';
 162     }
 163     $out.= $in;
 164     $out;
 165 }
 166
 167 sub update_realtime {
 168         my ($file, $bug, $new) = @_;
 169
 170         # update realtime index.db
 171
 172         open(IDXDB, "<$file") or die "Couldn't open $file";
 173         open(IDXNEW, ">$file.new");
 174
 175         my $line;
 176         while($line = <IDXDB>) {
 177                 my @line = split /\s/, $line;
 178                 last if ($line[1] == $ref);
 179                 print IDXNEW $line;
 180         }
 181
 182         if ($new eq "NOCHANGE") {
 183                 print IDXNEW $line;
 184         } elsif ($new eq "REMOVE") {
 185                 0;
 186         } else {
 187                 print IDXNEW $new;
 188         }
 189
 190         print IDXNEW while(<IDXDB>);
 191
 192         close(IDXNEW);
 193         close(IDXDB);
 194
 195         rename("$file.new", $file);
 196
 197         return $line;
 198 }
 199
 200 sub bughook_archive {
 201         my $ref = shift;
 202         &filelock("debbugs.trace.lock");
 203         &appendfile("debbugs.trace","archive $ref\n");
 204         my $line = update_realtime(
 205                 "$gSpoolDir/index.db.realtime",
 206                 $ref,
 207                 "REMOVE");
 208         update_realtime("$gSpoolDir/index.archive.realtime",
 209                 $ref, $line);
 210         &unfilelock;
 211 }
 212
 213 sub bughook {
 214         my ( $type, $ref ) = ( shift, shift );
 215         &filelock("debbugs.trace.lock");
 216
 217         &appendfile("debbugs.trace","$type $ref\n",@_);
 218
 219         my @stuff=split /\n/, "$_[0]\n\n\n\n\n\n\n";
 220
 221         my $firstpkg;
 222         my $whendone = "open";
 223         my $severity = $gDefaultSeverity;
 224         ($firstpkg = $stuff[4]) =~ s/[,\s].*$//;
 225         $whendone = "forwarded" if length $stuff[7];
 226         $whendone = "done" if length $stuff[6];
 227         $severity = $stuff[9] if length $stuff[9];
 228
 229         my $k = sprintf "%s %d %d %s [%s] %s %s\n",
 230                         $firstpkg, $ref, $stuff[1], $whendone, $stuff[0],
 231                         $severity, $stuff[5];
 232
 233         update_realtime("$gSpoolDir/index.db.realtime", $ref, $k);
 234
 235         &unfilelock;
 236 }
 237
 238 sub appendfile {
 239         my $file = shift;
 240         if (!open(AP,">>$file")) {
 241                 print DEBUG "failed open log<\n";
 242                 print DEBUG "failed open log err $!<\n";
 243                 &quit("opening $file (appendfile): $!");
 244         }
 245         print(AP @_) || &quit("writing $file (appendfile): $!");
 246         close(AP) || &quit("closing $file (appendfile): $!");
 247 }
 248
 249 sub getmailbody {
 250         my $entity = shift;
 251         my $type = $entity->effective_type;
 252         if ($type eq 'text/plain' or
 253             ($type =~ m#text/# and $type ne 'text/html') or
 254             $type eq 'application/pgp') {
 255                 return $entity->bodyhandle;
 256         } elsif ($type eq 'multipart/alternative') {
 257                 # RFC 2046 says we should use the last part we recognize.
 258                 for my $part (reverse $entity->parts) {
 259                         my $ret = getmailbody($part);
 260                         return $ret if $ret;
 261                 }
 262         } else {
 263                 # For other multipart types, we just pretend they're
 264                 # multipart/mixed and run through in order.
 265                 for my $part ($entity->parts) {
 266                         my $ret = getmailbody($part);
 267                         return $ret if $ret;
 268                 }
 269         }
 270         return undef;
 271 }
 272
 273 sub escapelog {
 274         my @log = @_;
 275         map { s/^([\01-\07\030])/\030$1/gm } @log;
 276         return \@log;
 277 }
 278
 279
 280 @severities= grep { not exists $gObsoleteSeverities{$_} } @gSeverityList;
 281 @showseverities= @severities;
 282 grep ($_= $_ eq '' ? $gDefaultSeverity : $_, @showseverities);
 283 @strongseverities= @gStrongSeverities;
 284 %displayshowseverities= %gSeverityDisplay;
 285
 286 1;