[debian-devel:02573] Bug#JP/117: perl dumps core

[Fumitoshi UKAI <ukai@debian.or.jp>]

From: Fumitoshi UKAI <ukai@xxxxxxxxxxxxx>
Subject: [debian-devel:02540] Bug#17: perl dumps core (Re: Bug#13: jless 332-iso224 alreadey released)
Date: Fri, 9 Jan 1998 10:48:01 +0900

>  debbugs の scripts/process を実行する時に perl が core を吐いて
>  しまう場合があるから
> 
> です。どうも最後の方の unlock するあたりのようなのですが…

ちょっと調べた結果、どうも debbus/scripts/process の
以下のあたりみたいですねぇ。

# SMTPしゃべるように書きなおそうかな。

    print DEBUG "mailing to >",join('|',@recips),"<\n";
    $SIG{'CHLD'} = 'chldhandle';
#print DEBUG "mailing sigchild set up<\n";
    $c = open(U,"-|");
#print DEBUG "mailing opened pipe fork<\n";
    defined($c) || die $!;
#print DEBUG "mailing opened pipe fork ok $c<\n";
    if (!$c) { # ie, we are in the child process
#print DEBUG "mailing child<\n";
        unless (open(STDERR,">&STDOUT")) {
#print DEBUG "mailing child opened stderr<\n";
            print STDOUT "redirect stderr: $!\n";
#print DEBUG "mailing child opened stderr fail<\n";
            exit 1;
#print DEBUG "mailing child opened stderr fail exit !?<\n";
        }
#print DEBUG "mailing child opened stderr ok<\n";
        $c= open(D,"|-");
#print DEBUG "mailing child forked again<\n";
        defined($c) || die $!;
#print DEBUG "mailing child forked again ok $c<\n";
        if (!$c) { # ie, we are the child process
#print DEBUG "mailing grandchild<\n";
            exec '/usr/sbin/sendmail','-odi','-oem','-oi',@recips;
#print DEBUG "mailing grandchild exec failed<\n";
            die $!;
#print DEBUG "mailing grandchild died !?<\n";
        }
#print DEBUG "mailing child not grandchild<\n";
        print(D $msg) || die $!;
#print DEBUG "mailing child printed msg<\n";
        close(D);
#print DEBUG "mailing child closed pipe<\n";
        die "\n*** command returned exit status $?\n" if $?;
#print DEBUG "mailing child exit status ok<\n";
        exit 0;
#print DEBUG "mailing child exited ?!<\n";
    }
#print DEBUG "mailing parent<\n";
    $results='';
#print DEBUG "mailing parent results emptied<\n";
    while(<U>) { $results.= $_; }
#print DEBUG "mailing parent results read >$results<\n";
    close(U);
#print DEBUG "mailing parent results closed<\n";
    $results.= "\n*** child returned exit status $?\n" if $?;
#print DEBUG "mailing parent exit status ok<\n";
    $SIG{'CHLD'}='DEFAULT';
#print DEBUG "mailing parent sigchild default<\n";
    if (length($results)) { &quit("running sendmail: $results"); }
#print DEBUG "mailing parent results ok<\n";

-- 
鵜飼文敏