use constant {
DARWIN_SYS_getsockopt => 118, # from bsd/kern/syscalls.master
GETSOCKOPT_MAXLEN => 512, # enough for now I guess...
};
sub darwin_getsockopt {
my $optval = "\0" x GETSOCKOPT_MAXLEN;
my $optlen=pack('i',GETSOCKOPT_MAXLEN);
my $rv=syscall(DARWIN_SYS_getsockopt,fileno($_[0]),$_[1],$_[2],$optval,$optlen);
return $rv < 0 ? undef : substr($optval,0,unpack('i',$optlen));
}
####
use Socket qw'PF_INET SOCK_STREAM IPPROTO_TCP inet_aton sockaddr_in';
use constant {
DARWIN_TCP_INFO => 0x200, # from bsd/netinet/tcp.h
DARWIN_SYS_getsockopt => 118, # from bsd/kern/syscalls.master
GETSOCKOPT_MAXLEN => 512, # enough for now I guess...
};
sub darwin_getsockopt {
my $optval = "\0" x GETSOCKOPT_MAXLEN;
my $optlen=pack('i',GETSOCKOPT_MAXLEN);
my $rv=syscall(DARWIN_SYS_getsockopt,fileno($_[0]),$_[1],$_[2],$optval,$optlen);
return $rv < 0 ? undef : substr($optval,0,unpack('i',$optlen));
}
my $GETSOCKOPT_FUNC = $^O eq 'darwin' ? \&darwin_getsockopt : \&CORE::getsockopt;
my $TCP_INFO = ($^O eq 'darwin' ? DARWIN_TCP_INFO : eval { Socket::TCP_INFO() })
or die "This system doesn't support the TCP_INFO structure.\n";
my ($testHost,$testPort)=('perl.org',443);
socket(my $sock, PF_INET, SOCK_STREAM, IPPROTO_TCP)
or die "Could not create socket - $!\n";
my $iaddr=inet_aton($testHost);
my $paddr=sockaddr_in($testPort,$iaddr);
connect($sock,$paddr)
or die "Failed to connect to $testHost:$testPort - $!\n";
my $tcpInfoData=$GETSOCKOPT_FUNC->($sock,IPPROTO_TCP,$TCP_INFO)
or die "Error while calling getsockopt - $!\n";
my $tcpInfoLength=length($tcpInfoData);
if($tcpInfoLength < 256) {
print "This system doesn't have a TCP_INFO structure large enough to reproduce the problem.\n";
}elsif($tcpInfoLength == 256) {
print "The TCP_INFO structure seems to be truncated to 256 bytes on this system.\n";
}else{
print "This system doesn't seem to be affected by the problem (TCP_INFO length: $tcpInfoLength).\n";
}
##
##
sub getsockopt_darwin_gen {
return &CORE::getsockopt if(@_ < 4);
my $optlen = pop;
my $optval = "\0" x $optlen;
$optlen=pack('i',$optlen);
my $rv=syscall(DARWIN_SYS_getsockopt,fileno($_[0]),$_[1],$_[2],$optval,$optlen);
return $rv < 0 ? undef : substr($optval,0,unpack('i',$optlen));
}