# -*- perl -*-
# $Id: errorlib.in,v 1.7 2002/10/06 22:54:48 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;
}

sub unlockreadbugmerge {
    local ($rv) = @_;
    &unfilelock if $rv >= 2;
    &unfilelock if $rv >= 1;
}

sub lockreadbugmerge {
    local ($lref) = @_;
    if (!&lockreadbug($lref)) { return 0; }
    if (!length($s_mergedwith)) { return 1; }
    &unfilelock;
    &filelock('lock/merge');
    if (!&lockreadbug($lref)) { &unfilelock; return 0; }
    return 2;
}

sub lockreadbug {
    local ($lref) = @_;
    &filelock("lock/$lref");
    if (!open(S,"db/$lref.status")) { &unfilelock; return 0; }
    chop($s_originator= <S>);
    chop($s_date= <S>);
    chop($s_subject= <S>);
    chop($s_msgid= <S>);
    chop($s_package= <S>);
    chop($s_keywords= <S>);
    chop($s_done= <S>);
    chop($s_forwarded= <S>);
    chop($s_mergedwith= <S>);
    chop($s_severity= <S>);
    close(S);
	$s_severity = 'normal' if $s_severity eq '';
    return 1;
}

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 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";
	# XXX: bug: this'll only keep the most recent update until index.db
	#      starts getting overwritten by index.db.realtime after update
	my $hash = get_hashname($ref);
	unlink("$gSpoolDir/db/$ref.status.new");
	link("$gSpoolDir/db-h/$hash/$ref.status", "$gSpoolDir/db/$ref.status.new");
	rename("$gSpoolDir/db/$ref.status.new", "$gSpoolDir/db/$ref.status");
	open(IDXDB, "</org/bugs.debian.org/spool/index.db.realtime")
		or open(IDXDB, "</org/bugs.debian.org/spool/index.db");
	open(IDXNEW, ">/org/bugs.debian.org/spool/index.db.realtime.new");
	while(my $line = <IDXDB>) {
		@line = split /\s/, $line;
		last if ($line[1] == $ref);
		print IDXNEW $line;
	}
	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];

	printf IDXNEW "%s %d %d %s [%s] %s %s\n",
			$firstpkg, $ref, $stuff[1], $whendone, $stuff[0],
			$severity, $stuff[5];
	print IDXNEW while(<IDXDB>);
	close(IDXNEW);
	close(IDXDB);
	rename("/org/bugs.debian.org/spool/index.db.realtime.new",
		"/org/bugs.debian.org/spool/index.db.realtime");
	&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')) {
		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;
}


@severities= @gSeverityList;
@showseverities= @severities;
grep ($_= $_ eq '' ? $gDefaultSeverity : $_, @showseverities);
@strongseverities= @gStrongSeverities;
%displayshowseverities= %gSeverityDisplay;

1;