[Mew-dist 11492] Re: (v6 8660) Re: Re: im-133

Hajimu UMEMOTO ( 梅本 肇 ) ume at example.com
1999年 11月 26日 (金) 20:50:27 JST


  梅本@日立です。

>>>>> On Fri, 26 Nov 1999 10:16:21 +0900
>>>>> onoe at example.com (Atsushi Onoe) said:

onoe> getaddrinfo() を perl で書くというのは大変なのでしょうか。
onoe> IPv6 perl なら getaddrinfo() を使い、なければ自前の getaddrinfo() を使う。
onoe> 自前の getaddrinfo() は gethostbyname() を呼ぶ。

onoe> gethostbyname() 使ってる側は構わず getaddrinfo() に書き換える。
onoe> (wrapper は必要かも)

  この方針で書いてみました。こんなもんで如何でしょ?
  先のパッチは破棄して当てて下さい。
  多分大丈夫だとは思いますが、手近に気軽に試せる IPv4 only なマシンが既
にないので、IPv4 only な環境では試していません。誰かテストして頂けるとあ
りがたいです。

# 気軽に触れるマシンはほとんど KAME 化されてるとも言う。:-)

onoe> アドレスだけを見ていると scope が扱えないので、getipnodebyname() や
onoe> 既に obsolete な gethostbyname2() を使っている人と同様に itojun に
onoe> 怒られます:-)

  結局、getaddrinfo() を使いなさいってことですね。
-------------- next part --------------
Index: IM/TcpTransaction.pm
===================================================================
RCS file: /usr/home/ume/ncvs/src/im/IM/TcpTransaction.pm,v
retrieving revision 1.1.1.15
diff -u -r1.1.1.15 TcpTransaction.pm
--- TcpTransaction.pm	1999/11/10 18:13:09	1.1.1.15
+++ TcpTransaction.pm	1999/11/26 11:33:25
@@ -55,6 +55,88 @@
     use IM::Log;
 }
 
+sub mew_getaddrinfo ($$;$$$$) {
+    return getaddrinfo(@_) if (eval '&AF_INET6');	# perl supports IPv6
+
+    my ($node, $serv, $family, $socktype, $proto, $flags) = @_;
+
+    my ($pe_name, $pe_aliases, $pe_proto);
+    my ($se_name, $se_aliases, $se_port);
+    if (unixp()) {
+	$proto = 'tcp' unless ($proto);
+	($pe_name, $pe_aliases, $pe_proto) = getprotobyname($proto);
+    }
+    $pe_proto = 6 unless ($pe_name);
+    ($se_name, $se_aliases, $se_port) = getservbyname($serv, $proto)
+	if (unixp());
+    unless ($se_name) {
+	if ($serv eq 'smtp') {
+	    $se_port = 25;
+	} elsif ($serv eq 'http') {
+	    $se_port = 80;
+	} elsif ($serv eq 'nntp') {
+	    $se_port = 119;
+	} elsif ($serv eq 'pop3') {
+	    $se_port = 110;
+	} elsif ($serv eq 'imap') {
+	    $se_port = 143;
+	} else {
+	    im_err("unknown service: $serv\n");
+	    return undef;
+	}
+    }
+
+    my ($he_name, $he_alias, $he_type, $he_len, @he_addrs);
+    if ($node =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
+	@he_addrs = (pack('C4', $1, $2, $3, $4));
+    } elsif ($node =~ /^[\da-f:]+$/i) {
+	if ($node =~ /::.*::/) {
+	    im_err("bad server address in IPv6 format: $node\n");
+	    return undef;
+	}
+	if ($node =~ /::/) {
+	    (my $t = $node) =~ s/[^:]//g;
+	    my $n = 7 - length($t);
+	    $t = ':0:';
+	    while ($n--) {
+		$t .= '0:';
+	    }
+	    $node =~ s/::/$t/;
+	}
+	if ($node =~ /^([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*)$/i) {
+	    @he_addrs = (pack('n8',
+		    hex("0x$1"), hex("0x$2"), hex("0x$3"), hex("0x$4"),
+		    hex("0x$5"), hex("0x$6"), hex("0x$7"), hex("0x$8")));
+	} else {
+	    im_err("bad server address in IPv6 format: $node\n");
+	    return undef;
+	}
+    } else {
+	alarm(dns_timeout()) unless win95p();
+	($he_name, $he_alias, $he_type, $he_len, @he_addrs)
+	  = gethostbyname($node);
+	alarm(0) unless win95p();
+	return undef unless ($he_name);
+    }
+
+    my ($he_addr, @infos);
+    foreach $he_addr (@he_addrs) {
+	my $family = (length($he_addr) == 4) ? AF_INET : inet6_family();
+	my $sin;
+	if ($family == AF_INET) {
+	    $sin = pack_sockaddr_in($se_port, $he_addr);
+	} else {
+	    $sin = pack_sockaddr_in6($se_port, $he_addr);
+	}
+	push(@infos, $family);
+	push(@infos, $socktype);
+	push(@infos, $pe_proto);
+	push(@infos, $sin);
+	push(@infos, $he_name);
+    }
+    @infos;
+}
+
 ##### MAKE TCP CONNECTION TO SPECIFIED SERVER #####
 #
 # connect_server(server_list, protocol, root)
@@ -64,10 +146,10 @@
 #	return value: handle if success
 #
 sub connect_server ($$$) {
-    my ($servers, $proto, $root) = @_;
+    my ($servers, $serv, $root) = @_;
 
     if ($#$servers < 0) {
-	im_err("no server specified for $proto\n");
+	im_err("no server specified for $serv\n");
 	return '';
     }
 
@@ -75,34 +157,10 @@
 
     no strict 'refs'; # XXX
     local (*SOCK) = \*{$TcpSockName};
-    $SOCK = $proto;
+    $SOCK = $serv;
     @Response = ();
-    my ($pe_name, $pe_aliases, $pe_proto);
-    my ($se_name, $se_aliases, $se_port);
-    ($pe_name, $pe_aliases, $pe_proto) = getprotobyname ('tcp') if (unixp());
-    unless ($pe_name) {
-	$pe_proto = 6;
-    }
-    ($se_name, $se_aliases, $se_port) = getservbyname ($proto, 'tcp')
-	if (unixp());
-    unless ($se_name) {
-	if ($proto eq 'smtp') {
-	    $se_port = 25;
-	} elsif ($proto eq 'http') {
-	    $se_port = 80;
-	} elsif ($proto eq 'nntp') {
-	    $se_port = 119;
-	} elsif ($proto eq 'pop3') {
-	    $se_port = 110;
-	} elsif ($proto eq 'imap') {
-	    $se_port = 143;
-	} else {
-	    im_err("unknown service: $proto\n");
-	    return '';
-	}
-    }
-    my ($he_name, $he_alias, $he_type, $he_len, $he_addr, @he_addrs);
-    my ($family, $s, $localport, $remoteport, $sin);
+    my (@he_infos);
+    my ($s, $localport, $remoteport);
     while ($s = shift(@$servers)) {
 	my ($r) = ($#$servers >= 0) ? 'skipped' : 'failed';
 	# manage server[/remoteport]%localport
@@ -112,7 +170,7 @@
 	    if ($s =~ s/\/(\d+)$//) {
 		$remoteport = $1;
 	    } else {
-		$remoteport = $se_port;
+		$remoteport = $serv;
 	    }
 	    if ($main::SSH_server eq 'localhost') {
 		im_warn( "Don't use port-forwarding to `localhost'.\n" );
@@ -123,11 +181,11 @@
 		    $Cur_server = "$Cur_server%$remoteport";
 		} else { # Connection failed.
 		    im_warn( "Can't login to $main::SSH_server\n" );
-		    if ($proto eq 'smtp') {
-			&log_action($proto, $Cur_server,
+		    if ($serv eq 'smtp') {
+			&log_action($serv, $Cur_server,
 				    join(',', @main::Recipients), $r, @Response);
 		    } else { # NNTP
-			&log_action($proto, $Cur_server,
+			&log_action($serv, $Cur_server,
 				    $main::Newsgroups, $r, @Response);
 		    }
 		    next;
@@ -140,67 +198,42 @@
 	    $s = $1;
 	    $Cur_server = "$s/$remoteport";
 	} else {
-	    $remoteport = $se_port;
+	    $remoteport = $serv;
 	    $Cur_server = $s;
 	}
-	if ($s =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
-	    @he_addrs = (pack('C4', $1, $2, $3, $4));
-	    $family = AF_INET;
-	} elsif ($s =~ /^[\da-f:]+$/i) {
-	    if ($s =~ /::.*::/) {
-		im_err("bad server address in IPv6 format: $s\n");
-		return '';
-	    }
-	    if ($s =~ /::/) {
-		(my $t = $s) =~ s/[^:]//g;
-		my $n = 7 - length($t);
-		$t = ':0:';
-		while ($n--) {
-		    $t .= '0:';
-		}
-		$s =~ s/::/$t/;
-	    }
-	    if ($s =~ /^([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*):([\da-f]*)$/i) {
-		@he_addrs = (pack('n8',
-		    hex("0x$1"), hex("0x$2"), hex("0x$3"), hex("0x$4"),
-		    hex("0x$5"), hex("0x$6"), hex("0x$7"), hex("0x$8")));
-		$family = inet6_family(); # AF_INET6
-	    } else {
-		im_err("bad server address in IPv6 format: $s\n");
-		return '';
-	    }
-	} else {
-	    alarm(dns_timeout()) unless win95p();
-	    $0 = progname() . ": gethostbyname($s)";
-	    ($he_name, $he_alias, $he_type, $he_len, @he_addrs)
-	      = gethostbyname ($s);
-	    alarm(0) unless win95p();
-	    unless ($he_name) {
-		im_warn("address unknown for $s\n");
-		@Response = ("address unknown for $s");
-		if ($proto eq 'smtp') {
-		    &log_action($proto, $Cur_server,
-				join(',', @main::Recipients), $r, @Response);
-		} else { # NNTP
-		    &log_action($proto, $Cur_server,
-				$main::Newsgroups, $r, @Response);
-		}
-		next;
-	    }
-	    $family = $he_type;
-	}
-
-	foreach $he_addr (@he_addrs) {
+	$0 = progname() . ": getaddrinfo($s)";
+	@he_infos = mew_getaddrinfo($s, $remoteport, AF_UNSPEC, SOCK_STREAM);
+	if ($#he_infos < 0) {
+	    im_warn("address unknown for $s\n");
+	    @Response = ("address unknown for $s");
+	    if ($serv eq 'smtp') {
+		&log_action($serv, $Cur_server,
+			    join(',', @main::Recipients), $r, @Response);
+	    } else { # NNTP
+		&log_action($serv, $Cur_server,
+			    $main::Newsgroups, $r, @Response);
+	    }
+	    next;
+	}
+	while ($#he_infos >= 0) {
+	    my ($family, $socktype, $proto, $sin, $canonname)
+		= splice(@he_infos, 0, 5);
 	    if ($root && unixp()) {
 		my $name = priv_sock($family);
+		my $port;
 		if ($name eq '') {
 		    im_err("privilege port pool is empty.\n");
 		    return '';
 		}
+		if ($family == AF_INET) {
+		    $port = (unpack_sockaddr_in($sin))[0];
+		} else {
+		    $port = (unpack_sockaddr_in6($sin))[0];
+		}
 		*SOCK = \*{$name};
-		$SOCK = $proto;
+		$SOCK = $port;
 	    } else {
-		unless (socket(SOCK, $family, SOCK_STREAM, $pe_proto)) {
+		unless (socket(SOCK, $family, $socktype, $proto)) {
 		    im_err("socket creation failed: $!.\n");
 		    return '';
 		}
@@ -212,19 +245,14 @@
                 }
 	    }
 
-	    if ($family == AF_INET) {
-		$sin = &pack_sockaddr_in($remoteport, $he_addr);
-	    } else { # AF_INET6
-		$sin = inet6_pack_sockaddr_in6($family, $remoteport, $he_addr);
-	    }
-	    im_notice("opening $proto session to $s($remoteport).\n");
+	    im_notice("opening $serv session to $s($remoteport).\n");
 	    alarm(connect_timeout()) unless win95p();
-	    $0 = progname() . ": connecting to $s with $proto";
+	    $0 = progname() . ": connecting to $s with $serv";
 	    if (connect (SOCK, $sin)) {
 		alarm(0) unless win95p();
 		select (SOCK); $| = 1; select (STDOUT);
 		$Session_log .= 
-		    "Transcription of $proto session follows:\n" if ($Logging);
+		    "Transcription of $serv session follows:\n" if ($Logging);
 		im_debug("handle $TcpSockName allocated.\n")
 		    if (&debug('tcp'));
 		$TcpSockName++;
@@ -234,16 +262,16 @@
 	    alarm(0) unless win95p();
 	    close(SOCK);
 	}
-	im_notice("$proto server $s($remoteport) did not respond.\n");
-	if ($proto eq 'smtp') {
-	    &log_action($proto, $Cur_server,
+	im_notice("$serv server $s($remoteport) did not respond.\n");
+	if ($serv eq 'smtp') {
+	    &log_action($serv, $Cur_server,
 			join(',', @main::Recipients), $r, @Response);
 	} else { # NNTP
-	    &log_action($proto, $Cur_server,
+	    &log_action($serv, $Cur_server,
 			$main::Newsgroups, $r, @Response);
 	}
     }
-    im_warn("WARNING: $proto connection was not established.\n");
+    im_warn("WARNING: $serv connection was not established.\n");
     return '';
 }
 
@@ -413,7 +441,7 @@
     my $count = shift;
 
     pool_priv_sock_af($count, AF_INET);
-    pool_priv_sock_af($count, inet6_family());
+    pool_priv_sock_af($count, inet6_family()) if (eval '&AF_INET6');
 }
 
 sub pool_priv_sock_af ($$) {


Mew-dist メーリングリストの案内