| Subject: | IO::Socket assumes getservbyname etc. exist w/fix |
Not all systems (e.g. BeOS) define getservbyname, getprotobyname and
getprotobynumber.
This patch a start for support for these platforms. Of course more
protocols and services need to be added:
*** OINET.pm Wed Jan 20 13:37:39 2010
--- INET.pm Wed Jan 20 14:13:09 2010
***************
*** 48,53 ****
--- 48,65 ----
sub _get_proto_number {
my $name = lc(shift);
return undef unless defined $name;
+
+ if($^O eq 'beos') {
+ my %protocols = ( # Add more as you wish
+ 'tcp' => 6,
+ 'udp' => 17
+ );
+ if(exists($protocols{$name})) {
+ return $protocols{$name};
+ }
+ return undef;
+ }
+
return $proto_number{$name} if exists $proto_number{$name};
my @proto = getprotobyname($name);
***************
*** 60,65 ****
--- 72,89 ----
sub _get_proto_name {
my $num = shift;
return undef unless defined $num;
+
+ if($^O eq 'beos') {
+ my %protocols = ( # Add more as you wish
+ 6 => 'tcp',
+ 17 => 'udp',
+ );
+ if(exists($protocols{$num})) {
+ return $protocols{$num};
+ }
+ return undef;
+ }
+
return $proto_name{$num} if exists $proto_name{$num};
my @proto = getprotobynumber($num);
***************
*** 90,104 ****
my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef;
my $pnum = ($port =~ m,^(\d+)$,)[0];
! @serv = getservbyname($port, _get_proto_name($proto) || "")
! if ($port =~ m,\D,);
!
! $port = $serv[2] || $defport || $pnum;
! unless (defined $port) {
! $@ = "Bad service '$origport'";
! return;
! }
$proto = _get_proto_number($serv[3]) if @serv && !$proto;
}
--- 114,139 ----
my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef;
my $pnum = ($port =~ m,^(\d+)$,)[0];
! if($^O eq 'beos') {
! my %ports = ( # Add more as you wish
! 'smtp' => 25,
! );
! unless(exists($ports{$port})) {
! $@ = "Bad service '$origport'";
! return;
! }
! $port = $ports{$port};
! } else {
! @serv = getservbyname($port, _get_proto_name($proto) || "")
! if ($port =~ m,\D,);
!
! $port = $serv[2] || $defport || $pnum;
! unless (defined $port) {
! $@ = "Bad service '$origport'";
! return;
! }
+ }
$proto = _get_proto_number($serv[3]) if @serv && !$proto;
}