[mew-dist 24088] Re: IM fails with Perl 5.8.1

[Tatsuya Kinoshita]

On October 14, 2003, [mew-dist 24074],
Tatsuya Kinoshita <tats at example.com> wrote:

> Perlを5.8.0から5.8.1にアップグレードすると、imputやimgetでエラー
> が起こるようになってしまいました。
> 
> 具体的には、IM/TcpTransaction.pmのtcp_command()やsend_command()で、
> 「$resp = <$CHAN>;」のところで「Bad file descriptor」になってしま
> います。(http://bugs.debian.org/214036)

該当するコードを見てみたところ、最初はalarmのための処理かと思った
のですが、SIGALRMでは$!による判定を使わずに即終了するようにしてい
ますよね。

debian-perlメーリングリスト等でも相談してみたところ、どうやら$!を
エラー判定に使うのはまずそうなので、回避するようにしてみました。
下記のパッチでどうでしょうか。

-- 
木下達也

--- im-145-4/IM/Imap.pm
+++ im-145/IM/Imap.pm
@@ -195,15 +195,8 @@
     if ($resp =~ /^\* \d+ FETCH \((UID $num )?RFC822 \{(\d+)\}/i) {
 	my $size = $2;
 	alarm(imap_timeout()) unless win95p();
-	$! = 0;
 	while (<$HANDLE>) {
-	    unless (win95p()) {
-		alarm(0);
-		if ($!) {   # may be channel truoble
-		    im_warn("lost connection for FETCH(get).\n");
-		    return (-1, 0);
-		}
-	    }
+	    alarm(0) unless win95p();
 	    $size -= length($_);
 	    s/\r\n$/\n/;
 	    im_debug($_) if (&debug('imap'));
@@ -240,15 +233,8 @@
 	my($size, $len) = ($2, $3);
 	my $field = '';
 	alarm(imap_timeout()) unless win95p();
-	$! = 0;
 	while (<$HANDLE>) {
-	    unless (win95p()) {
-		alarm(0);
-		if ($!) {   # may be channel truoble
-		    im_warn("lost connection for FETCH(head).\n");
-		    return (-1, 0);
-		}
-	    }
+	    alarm(0) unless win95p();
 	    $len -= length($_);
 	    s/\r?\n$//;
 	    im_debug("$_\n") if (&debug('imap'));
@@ -299,15 +285,8 @@
 	my $found = 0;
 	my $f;
 	alarm(imap_timeout()) unless win95p();
-	$! = 0;
 	while (<$HANDLE>) {
-	    unless (win95p()) {
-		alarm(0);
-		if ($!) {   # may be channel truoble
-		    im_warn("lost connection for FETCH(from).\n");
-		    return -1;
-		}
-	    }
+	    alarm(0) unless win95p();
 	    $size -= length($_);
 	    s/\r\n$/\n/;
 	    im_debug($_) if (&debug('imap'));
@@ -793,15 +772,8 @@
 	($uid, $size, $len) = ($2, $3, $4);
 	my @hdr;
 	alarm(imap_timeout()) unless win95p();
-	$! = 0;
 	while (<$HANDLE>) {
-	    unless (win95p()) {
-		alarm(0);
-		if ($!) {   # may be channel truoble
-		    im_warn("lost connection for FETCH(scan).\n");
-		    return -1;
-		}
-	    }
+	    alarm(0) unless win95p();
 	    $len -= length;
 	    s/\r?\n$/\n/;
 	    im_warn($_) if (&debug('imap'));
--- im-145-4/IM/Nntp.pm
+++ im-145/IM/Nntp.pm
@@ -178,15 +178,8 @@
     $count++;
     my($found, $f) = (0, '');
     alarm(nntp_timeout()) unless win95p();
-    $! = 0;
     while (<NNTPd>) {
-	unless (win95p()) {
-	    alarm(0);
-	    if ($!) {   # may be channel truoble
-		im_warn("lost connection for HEAD.\n");
-		return -1;
-	    }
-	}
+	alarm(0) unless win95p();
 	s/\r\n$/\n/;
 	last if ($_ =~ /^\.\n$/);
 	s/^\.//;
@@ -214,15 +207,8 @@
 	$count++;
 	my($found, $f) = (0, '');
 	alarm(nntp_timeout()) unless win95p();
-	$! = 0;
 	while (<NNTPd>) {
-	    unless (win95p()) {
-		alarm(0);
-		if ($!) {   # may be channel truoble
-		    im_warn("lost connection for HEAD.\n");
-		    return -1;
-		}
-	    }
+	    alarm(0) unless win95p();
 	    s/\r\n$/\n/;
 	    last if ($_ =~ /^\.\n$/);
 	    s/^\.//;
@@ -285,15 +271,8 @@
     }
     my @Article = ();
     alarm(nntp_timeout()) unless win95p();
-    $! = 0;
     while (<NNTPd>) {
-	unless (win95p()) {
-	    alarm(0);
-	    if ($!) {   # may be channel truoble
-		im_warn("lost connection for ARTICLE.\n");
-		return(-1, '');
-	    }
-	}
+	alarm(0) unless win95p();
 	s/\r\n$/\n/;
 	last if ($_ =~ /^\.\n$/);
 	s/^\.//;
--- im-145-4/IM/Pop.pm
+++ im-145/IM/Pop.pm
@@ -148,15 +148,8 @@
 	return -1;
     }
     alarm(pop_timeout()) unless win95p();
-    $! = 0;
     while (<POPd>) {
-	unless (win95p()) {
-	    alarm(0);
-	    if ($!) {	# may be channel truoble
-		im_warn("lost connection for RETR.\n");
-		return -1;
-	    }
-	}
+	alarm(0) unless win95p();
 	s/\r\n$/\n/;
 	last if ($_ =~ /^\.\n$/);
 	s/^\.//;
@@ -184,15 +177,8 @@
     my(%head);
     undef %head;
     alarm(pop_timeout()) unless win95p();
-    $! = 0;
     while (<POPd>) {
-	unless (win95p()) {
-	    alarm(0);
-	    if ($!) {	# may be channel truoble
-		im_warn("lost connection for HEAD.\n");
-		return 0;
-	    }
-	}
+	alarm(0) unless win95p();
 	s/\r?\n$//;
 	last if ($_ =~ /^\.$/);
 	s/^\.//;
@@ -238,15 +224,8 @@
 	return -1;
     }
     alarm(pop_timeout()) unless win95p();
-    $! = 0;
     while (<POPd>) {
-	unless (win95p()) {
-	    alarm(0);
-	    if ($!) {	# may be channel truoble
-		im_warn("lost connection for UIDL.\n");
-		return -1;
-	    }
-	}
+	alarm(0) unless win95p();
 	s/\r\n$/\n/;
 	last if ($_ =~ /^\.\n$/);
 	im_debug($_) if (&debug('pop'));
--- im-145-4/IM/TcpTransaction.pm
+++ im-145/IM/TcpTransaction.pm
@@ -207,7 +207,7 @@
 	im_notice("<<< $logcmd\n");
 	$Session_log .= "<<< $logcmd\n" if ($Logging);
 	unless (print $CHAN "$command\r\n") {
-	    # may be channel truoble
+	    # may be channel trouble
 	    @Response = ($!);
 	    return 1;
 	}
@@ -220,14 +220,12 @@
     }
     do {
 	alarm(command_timeout()) unless win95p();
-	$! = 0;
 	$resp = <$CHAN>;
-	unless (win95p()) {
-	    alarm(0);
-	    if ($!) {	# may be channel truoble
-		@Response = ("$!");
-		return 1;
-	    }
+	alarm(0) unless win95p();
+	if (!defined($resp)) {
+	    # may be channel trouble
+	    @Response = ("$!");
+	    return 1;
 	}
 	$resp =~ s/[\r\n]+$//;
 	if ($resp =~ /^([0-9][0-9][0-9])/) {
@@ -268,14 +266,12 @@
 	$0 = progname() . ": greeting ($Cur_server)";
     }
     alarm(command_timeout()) unless win95p();
-    $! = 0;
     $resp = <$CHAN>;
-    unless (win95p()) {
-	alarm(0);
-	if ($!) {	# may be channel truoble
-	    im_notice("$!\n");
-	    return '';
-	}
+    alarm(0) unless win95p();
+    if (!defined($resp)) {
+	# may be channel trouble
+	im_notice("$!\n");
+	return '';
     }
     $resp =~ s/[\r\n]+/\n/;
     im_notice(">>> $resp");
@@ -303,14 +299,12 @@
     my $resp;
 
     alarm(command_timeout()) unless win95p();
-    $! = 0;
     $resp = <$CHAN>;
-    unless (win95p()) {
-	alarm(0);
-	if ($!) {	# may be channel truoble
-	    im_notice("$!\n");
-	    return '';
-	}
+    alarm(0) unless win95p();
+    if (!defined($resp)) {
+	# may be channel trouble
+	im_notice("$!\n");
+	return '';
     }
     $resp =~ s/[\r\n]+/\n/;
     im_notice(">>> $resp");