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