1# IO::Socket::INET.pm 2# 3# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. 4# This program is free software; you can redistribute it and/or 5# modify it under the same terms as Perl itself. 6 7package IO::Socket::INET; 8 9use strict; 10our(@ISA, $VERSION); 11use IO::Socket; 12use Socket; 13use Carp; 14use Exporter; 15use Errno; 16 17@ISA = qw(IO::Socket); 18$VERSION = "1.27"; 19 20my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1; 21 22IO::Socket::INET->register_domain( AF_INET ); 23 24my %socket_type = ( tcp => SOCK_STREAM, 25 udp => SOCK_DGRAM, 26 icmp => SOCK_RAW 27 ); 28 29sub new { 30 my $class = shift; 31 unshift(@_, "PeerAddr") if @_ == 1; 32 return $class->SUPER::new(@_); 33} 34 35sub _sock_info { 36 my($addr,$port,$proto) = @_; 37 my $origport = $port; 38 my @proto = (); 39 my @serv = (); 40 41 $port = $1 42 if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,); 43 44 if(defined $proto && $proto =~ /\D/) { 45 if(@proto = getprotobyname($proto)) { 46 $proto = $proto[2] || undef; 47 } 48 else { 49 $@ = "Bad protocol '$proto'"; 50 return; 51 } 52 } 53 54 if(defined $port) { 55 my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef; 56 my $pnum = ($port =~ m,^(\d+)$,)[0]; 57 58 @serv = getservbyname($port, $proto[0] || "") 59 if ($port =~ m,\D,); 60 61 $port = $serv[2] || $defport || $pnum; 62 unless (defined $port) { 63 $@ = "Bad service '$origport'"; 64 return; 65 } 66 67 $proto = (getprotobyname($serv[3]))[2] || undef 68 if @serv && !$proto; 69 } 70 71 return ($addr || undef, 72 $port || undef, 73 $proto || undef 74 ); 75} 76 77sub _error { 78 my $sock = shift; 79 my $err = shift; 80 { 81 local($!); 82 my $title = ref($sock).": "; 83 $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_); 84 close($sock) 85 if(defined fileno($sock)); 86 } 87 $! = $err; 88 return undef; 89} 90 91sub _get_addr { 92 my($sock,$addr_str, $multi) = @_; 93 my @addr; 94 if ($multi && $addr_str !~ /^\d+(?:\.\d+){3}$/) { 95 (undef, undef, undef, undef, @addr) = gethostbyname($addr_str); 96 } else { 97 my $h = inet_aton($addr_str); 98 push(@addr, $h) if defined $h; 99 } 100 @addr; 101} 102 103sub configure { 104 my($sock,$arg) = @_; 105 my($lport,$rport,$laddr,$raddr,$proto,$type); 106 107 108 $arg->{LocalAddr} = $arg->{LocalHost} 109 if exists $arg->{LocalHost} && !exists $arg->{LocalAddr}; 110 111 ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr}, 112 $arg->{LocalPort}, 113 $arg->{Proto}) 114 or return _error($sock, $!, $@); 115 116 $laddr = defined $laddr ? inet_aton($laddr) 117 : INADDR_ANY; 118 119 return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'") 120 unless(defined $laddr); 121 122 $arg->{PeerAddr} = $arg->{PeerHost} 123 if exists $arg->{PeerHost} && !exists $arg->{PeerAddr}; 124 125 unless(exists $arg->{Listen}) { 126 ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr}, 127 $arg->{PeerPort}, 128 $proto) 129 or return _error($sock, $!, $@); 130 } 131 132 $proto ||= (getprotobyname('tcp'))[2]; 133 134 my $pname = (getprotobynumber($proto))[0]; 135 $type = $arg->{Type} || $socket_type{$pname}; 136 137 my @raddr = (); 138 139 if(defined $raddr) { 140 @raddr = $sock->_get_addr($raddr, $arg->{MultiHomed}); 141 return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'") 142 unless @raddr; 143 } 144 145 while(1) { 146 147 $sock->socket(AF_INET, $type, $proto) or 148 return _error($sock, $!, "$!"); 149 150 if (defined $arg->{Blocking}) { 151 defined $sock->blocking($arg->{Blocking}) 152 or return _error($sock, $!, "$!"); 153 } 154 155 if ($arg->{Reuse} || $arg->{ReuseAddr}) { 156 $sock->sockopt(SO_REUSEADDR,1) or 157 return _error($sock, $!, "$!"); 158 } 159 160 if ($arg->{ReusePort}) { 161 $sock->sockopt(SO_REUSEPORT,1) or 162 return _error($sock, $!, "$!"); 163 } 164 165 if ($arg->{Broadcast}) { 166 $sock->sockopt(SO_BROADCAST,1) or 167 return _error($sock, $!, "$!"); 168 } 169 170 if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) { 171 $sock->bind($lport || 0, $laddr) or 172 return _error($sock, $!, "$!"); 173 } 174 175 if(exists $arg->{Listen}) { 176 $sock->listen($arg->{Listen} || 5) or 177 return _error($sock, $!, "$!"); 178 last; 179 } 180 181 # don't try to connect unless we're given a PeerAddr 182 last unless exists($arg->{PeerAddr}); 183 184 $raddr = shift @raddr; 185 186 return _error($sock, $EINVAL, 'Cannot determine remote port') 187 unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW); 188 189 last 190 unless($type == SOCK_STREAM || defined $raddr); 191 192 return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'") 193 unless defined $raddr; 194 195# my $timeout = ${*$sock}{'io_socket_timeout'}; 196# my $before = time() if $timeout; 197 198 undef $@; 199 if ($sock->connect(pack_sockaddr_in($rport, $raddr))) { 200# ${*$sock}{'io_socket_timeout'} = $timeout; 201 return $sock; 202 } 203 204 return _error($sock, $!, $@ || "Timeout") 205 unless @raddr; 206 207# if ($timeout) { 208# my $new_timeout = $timeout - (time() - $before); 209# return _error($sock, 210# (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL), 211# "Timeout") if $new_timeout <= 0; 212# ${*$sock}{'io_socket_timeout'} = $new_timeout; 213# } 214 215 } 216 217 $sock; 218} 219 220sub connect { 221 @_ == 2 || @_ == 3 or 222 croak 'usage: $sock->connect(NAME) or $sock->connect(PORT, ADDR)'; 223 my $sock = shift; 224 return $sock->SUPER::connect(@_ == 1 ? shift : pack_sockaddr_in(@_)); 225} 226 227sub bind { 228 @_ == 2 || @_ == 3 or 229 croak 'usage: $sock->bind(NAME) or $sock->bind(PORT, ADDR)'; 230 my $sock = shift; 231 return $sock->SUPER::bind(@_ == 1 ? shift : pack_sockaddr_in(@_)) 232} 233 234sub sockaddr { 235 @_ == 1 or croak 'usage: $sock->sockaddr()'; 236 my($sock) = @_; 237 my $name = $sock->sockname; 238 $name ? (sockaddr_in($name))[1] : undef; 239} 240 241sub sockport { 242 @_ == 1 or croak 'usage: $sock->sockport()'; 243 my($sock) = @_; 244 my $name = $sock->sockname; 245 $name ? (sockaddr_in($name))[0] : undef; 246} 247 248sub sockhost { 249 @_ == 1 or croak 'usage: $sock->sockhost()'; 250 my($sock) = @_; 251 my $addr = $sock->sockaddr; 252 $addr ? inet_ntoa($addr) : undef; 253} 254 255sub peeraddr { 256 @_ == 1 or croak 'usage: $sock->peeraddr()'; 257 my($sock) = @_; 258 my $name = $sock->peername; 259 $name ? (sockaddr_in($name))[1] : undef; 260} 261 262sub peerport { 263 @_ == 1 or croak 'usage: $sock->peerport()'; 264 my($sock) = @_; 265 my $name = $sock->peername; 266 $name ? (sockaddr_in($name))[0] : undef; 267} 268 269sub peerhost { 270 @_ == 1 or croak 'usage: $sock->peerhost()'; 271 my($sock) = @_; 272 my $addr = $sock->peeraddr; 273 $addr ? inet_ntoa($addr) : undef; 274} 275 2761; 277 278__END__ 279 280=head1 NAME 281 282IO::Socket::INET - Object interface for AF_INET domain sockets 283 284=head1 SYNOPSIS 285 286 use IO::Socket::INET; 287 288=head1 DESCRIPTION 289 290C<IO::Socket::INET> provides an object interface to creating and using sockets 291in the AF_INET domain. It is built upon the L<IO::Socket> interface and 292inherits all the methods defined by L<IO::Socket>. 293 294=head1 CONSTRUCTOR 295 296=over 4 297 298=item new ( [ARGS] ) 299 300Creates an C<IO::Socket::INET> object, which is a reference to a 301newly created symbol (see the C<Symbol> package). C<new> 302optionally takes arguments, these arguments are in key-value pairs. 303 304In addition to the key-value pairs accepted by L<IO::Socket>, 305C<IO::Socket::INET> provides. 306 307 308 PeerAddr Remote host address <hostname>[:<port>] 309 PeerHost Synonym for PeerAddr 310 PeerPort Remote port or service <service>[(<no>)] | <no> 311 LocalAddr Local host bind address hostname[:port] 312 LocalHost Synonym for LocalAddr 313 LocalPort Local host bind port <service>[(<no>)] | <no> 314 Proto Protocol name (or number) "tcp" | "udp" | ... 315 Type Socket type SOCK_STREAM | SOCK_DGRAM | ... 316 Listen Queue size for listen 317 ReuseAddr Set SO_REUSEADDR before binding 318 Reuse Set SO_REUSEADDR before binding (deprecated, prefer ReuseAddr) 319 ReusePort Set SO_REUSEPORT before binding 320 Broadcast Set SO_BROADCAST before binding 321 Timeout Timeout value for various operations 322 MultiHomed Try all adresses for multi-homed hosts 323 Blocking Determine if connection will be blocking mode 324 325If C<Listen> is defined then a listen socket is created, else if the 326socket type, which is derived from the protocol, is SOCK_STREAM then 327connect() is called. 328 329Although it is not illegal, the use of C<MultiHomed> on a socket 330which is in non-blocking mode is of little use. This is because the 331first connect will never fail with a timeout as the connect call 332will not block. 333 334The C<PeerAddr> can be a hostname or the IP-address on the 335"xx.xx.xx.xx" form. The C<PeerPort> can be a number or a symbolic 336service name. The service name might be followed by a number in 337parenthesis which is used if the service is not known by the system. 338The C<PeerPort> specification can also be embedded in the C<PeerAddr> 339by preceding it with a ":". 340 341If C<Proto> is not given and you specify a symbolic C<PeerPort> port, 342then the constructor will try to derive C<Proto> from the service 343name. As a last resort C<Proto> "tcp" is assumed. The C<Type> 344parameter will be deduced from C<Proto> if not specified. 345 346If the constructor is only passed a single argument, it is assumed to 347be a C<PeerAddr> specification. 348 349If C<Blocking> is set to 0, the connection will be in nonblocking mode. 350If not specified it defaults to 1 (blocking mode). 351 352Examples: 353 354 $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org', 355 PeerPort => 'http(80)', 356 Proto => 'tcp'); 357 358 $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)'); 359 360 $sock = IO::Socket::INET->new(Listen => 5, 361 LocalAddr => 'localhost', 362 LocalPort => 9000, 363 Proto => 'tcp'); 364 365 $sock = IO::Socket::INET->new('127.0.0.1:25'); 366 367 $sock = IO::Socket::INET->new(PeerPort => 9999, 368 PeerAddr => inet_ntoa(INADDR_BROADCAST), 369 Proto => udp, 370 LocalAddr => 'localhost', 371 Broadcast => 1 ) 372 or die "Can't bind : $@\n"; 373 374 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE 375 376As of VERSION 1.18 all IO::Socket objects have autoflush turned on 377by default. This was not the case with earlier releases. 378 379 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE 380 381=back 382 383=head2 METHODS 384 385=over 4 386 387=item sockaddr () 388 389Return the address part of the sockaddr structure for the socket 390 391=item sockport () 392 393Return the port number that the socket is using on the local host 394 395=item sockhost () 396 397Return the address part of the sockaddr structure for the socket in a 398text form xx.xx.xx.xx 399 400=item peeraddr () 401 402Return the address part of the sockaddr structure for the socket on 403the peer host 404 405=item peerport () 406 407Return the port number for the socket on the peer host. 408 409=item peerhost () 410 411Return the address part of the sockaddr structure for the socket on the 412peer host in a text form xx.xx.xx.xx 413 414=back 415 416=head1 SEE ALSO 417 418L<Socket>, L<IO::Socket> 419 420=head1 AUTHOR 421 422Graham Barr. Currently maintained by the Perl Porters. Please report all 423bugs to <perl5-porters@perl.org>. 424 425=head1 COPYRIGHT 426 427Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved. 428This program is free software; you can redistribute it and/or 429modify it under the same terms as Perl itself. 430 431=cut 432