- The ftp/mirror port's lchat.pl file uses the old pack('S n a4 x8', ...)

  method for constructing a sockaddr_in to pass to connect().
  This approach breaks on more recent FreeBSDs which are more strict about
  the first two bytes of sockaddr_in.

- Patch modifies lchat.pl to use perl's &Socket'pack_sockaddr_in and
  &Socket'unpack_sockaddr_in functions to do the right thing.

PR:		ports/131911
Submitted by:	G. Paul Ziemba <p-fbsd-bugs@ziemba.us>

2 files changed, 164 insertions, 58 deletions

diff --git a/ftp/mirror/files/patch-af b/ftp/mirror/files/patch-af
deleted file mode 100644
index 8a659e1080c1..000000000000
--- a/ftp/mirror/files/patch-af
+++ /dev/null
@@ -1,58 +0,0 @@
-*** lchat.pl.orig	Fri May 29 21:05:46 1998
---- lchat.pl	Mon Jun  8 14:34:37 1998
-***************
-*** 161,167 ****
-  # Similar to open_port, but does less.  Used for PASV code with ftp.pl
-  # -Erez Zadok.
-  sub open_newport { ## public
-! 	local($server, $port, $newsock) = @_;
-  
-  	local($serveraddr,$serverproc);
-  
---- 161,167 ----
-  # Similar to open_port, but does less.  Used for PASV code with ftp.pl
-  # -Erez Zadok.
-  sub open_newport { ## public
-! 	local($server, $port, *newsock) = @_;
-  
-  	local($serveraddr,$serverproc);
-  
-***************
-*** 180,197 ****
-  	}
-  	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
-  
-! 	unless (connect($newsock, $serverproc)) {
-! 		($!) = ($!, close($newsock)); # close newsock while saving $!
-  		return undef;
-  	}
-  # We opened with the local address set to ANY, at this stage we know
-  # which interface we are using.  This is critical if our machine is
-  # multi-homed, with IP forwarding off, so fix-up.
-  	local($fam,$lport);
-! 	($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname($newsock));
-  	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
-  # end of post-connect fixup
-! 	select((select($newsock), $| = 1)[0]);
-  	return 1;
-  }
-  ##############################################################################
---- 180,197 ----
-  	}
-  	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
-  
-! 	unless (connect(newsock, $serverproc)) {
-! 		($!) = ($!, close(newsock)); # close newsock while saving $!
-  		return undef;
-  	}
-  # We opened with the local address set to ANY, at this stage we know
-  # which interface we are using.  This is critical if our machine is
-  # multi-homed, with IP forwarding off, so fix-up.
-  	local($fam,$lport);
-! 	($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname(newsock));
-  	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
-  # end of post-connect fixup
-! 	select((select(newsock), $| = 1)[0]);
-  	return 1;
-  }
-  ##############################################################################
diff --git a/ftp/mirror/files/patch-lchat.pl b/ftp/mirror/files/patch-lchat.pl
new file mode 100644
index 000000000000..2f702de9dcc0
--- /dev/null
+++ b/ftp/mirror/files/patch-lchat.pl
@@ -0,0 +1,164 @@
+--- lchat.pl.orig	1998-05-29 12:05:46.000000000 -0700
++++ lchat.pl	2009-02-20 09:33:47.000000000 -0800
+@@ -66,6 +66,7 @@
+ 	# Perl 5 has a special way of getting them via the 'use Socket'
+ 	# above.
+ 	$main'pf_inet = &Socket'PF_INET;
++	$main'af_inet = &Socket'AF_INET;
+ 	$main'sock_stream = &Socket'SOCK_STREAM;
+ 	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
+ 	$main'tcp_proto = $proto;
+@@ -74,6 +75,7 @@
+ 	# Perl 4 needs to have the socket.ph file created when perl was
+ 	# installed.
+ 	$main'pf_inet = &'PF_INET;
++	$main'af_inet = &'AF_INET;
+ 	$main'sock_stream = &'SOCK_STREAM;
+ 	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
+ 	$main'tcp_proto = $proto;
+@@ -85,6 +87,7 @@
+ 	# Use hardwired versions
+ 	# but who the heck would change these anyway? (:-)
+ 	$main'pf_inet = 2;
++	$main'af_inet = 2;
+ 	$main'sock_stream = 1; # Sigh... On Solaris set this to 2
+ 	$main'tcp_proto = 6;
+ 	warn "lchat.pl: using hardwired in network constantants";
+@@ -93,7 +96,6 @@
+ # Are we using the SOCKS version of perl?
+ $using_socks = 0;    # 0=no (default), 1=yes
+ 
+-$sockaddr = 'S n a4 x8';
+ if( ! $on_win ){
+ 	chop( $thishost = `hostname` );
+ 	if( $thishost eq '' ){
+@@ -107,6 +109,54 @@
+ 	$thishost = 'localhost';
+ }
+ 
++#
++# $packedsocketname = _pack_sin($portnumber, $ipaddress)
++#
++sub _pack_sin
++{
++    my $packed;
++
++    if ( $] =~ /^5\.\d+$/ ) {
++	#
++	# FreeBSD has a slightly different (from the rest of the world)
++	# sockaddr_in definition, so rely on Socket module to handle it.
++	#
++	$packed = &Socket'pack_sockaddr_in(@_[0,1]);
++    } else {
++	#
++	# Old-fashioned way to set up sockaddr_in structure. Not
++	# correct for "modern" FreeBSD (>= 5.X ?)
++	#
++	$packed = pack('S n a4 x8', $main'af_inet, 0, $thisaddr);
++    }
++    return $packed;
++}
++
++#
++# ($port, $ipaddress) = _unpack_sin($packedsocketname)
++#
++sub _unpack_sin
++{
++    my @PA;
++
++    if ( $] =~ /^5\.\d+$/ ) {
++	#
++	# FreeBSD has a slightly different (from the rest of the world)
++	# sockaddr_in definition, so rely on Socket module to handle it.
++	# Docs say "Will croak if the structure does not have AF_INET in
++	# the right place."
++	#
++	@PA = &Socket'unpack_sockaddr_in($_[0]);
++    } else {
++	#
++	# Old-fashioned way to parse sockaddr_in structure. Not
++	# correct for "modern" FreeBSD (>= 5.X ?)
++	#
++	(undef, @PA) = unpack('S n a4 x8', $_[0]);
++    }
++    return @PA;
++}
++
+ 
+ ## &chat'open_port("server.address",$port_number);
+ ## opens a named or numbered TCP server
+@@ -117,7 +167,7 @@
+ 
+ 	# We may be multi-homed, start with 0, fixup once connexion is made
+ 	$thisaddr = "\0\0\0\0" ;
+-	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
++	$thisproc = &_pack_sin(0, $thisaddr);
+ 
+ 	if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
+ 		$serveraddr = pack('C4', $1, $2, $3, $4);
+@@ -128,7 +178,7 @@
+ 		}
+ 		$serveraddr = $x[4];
+ 	}
+-	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
++	$serverproc = &_pack_sin($port, $serveraddr);
+ 	unless (socket(S, $main'pf_inet, $main'sock_stream, $main'tcp_proto)) {
+ 		($!) = ($!, close(S)); # close S while saving $!
+ 		return undef;
+@@ -150,9 +200,9 @@
+ # We opened with the local address set to ANY, at this stage we know
+ # which interface we are using.  This is critical if our machine is
+ # multi-homed, with IP forwarding off, so fix-up.
+-	local($fam,$lport);
+-	($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname(S));
+-	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
++	local($lport);
++	($lport,$thisaddr) = &_unpack_sin(getsockname(S));
++	$thisproc = &_pack_sin(0, $thisaddr);
+ # end of post-connect fixup
+ 	select((select(S), $| = 1)[0]);
+ 	return 1;
+@@ -161,13 +211,13 @@
+ # Similar to open_port, but does less.  Used for PASV code with ftp.pl
+ # -Erez Zadok.
+ sub open_newport { ## public
+-	local($server, $port, $newsock) = @_;
++	local($server, $port, *newsock) = @_;
+ 
+ 	local($serveraddr,$serverproc);
+ 
+ 	# We may be multi-homed, start with 0, fixup once connexion is made
+ 	$thisaddr = "\0\0\0\0" ;
+-	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
++	$thisproc = &_pack_sin(0, $thisaddr);
+ 
+ 	if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
+ 		$serveraddr = pack('C4', $1, $2, $3, $4);
+@@ -178,20 +228,20 @@
+ 		}
+ 		$serveraddr = $x[4];
+ 	}
+-	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
++	$serverproc = &_pack_sin($port, $serveraddr);
+ 
+-	unless (connect($newsock, $serverproc)) {
+-		($!) = ($!, close($newsock)); # close newsock while saving $!
++	unless (connect(newsock, $serverproc)) {
++		($!) = ($!, close(newsock)); # close newsock while saving $!
+ 		return undef;
+ 	}
+ # We opened with the local address set to ANY, at this stage we know
+ # which interface we are using.  This is critical if our machine is
+ # multi-homed, with IP forwarding off, so fix-up.
+-	local($fam,$lport);
+-	($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname($newsock));
+-	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
++	local($lport);
++	($lport,$thisaddr) = &_unpack_sin(getsockname(newsock));
++	$thisproc = &_pack_sin(0, $thisaddr);
+ # end of post-connect fixup
+-	select((select($newsock), $| = 1)[0]);
++	select((select(newsock), $| = 1)[0]);
+ 	return 1;
+ }
+ ##############################################################################