home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / INET.pm < prev    next >
Text File  |  2003-11-07  |  11KB  |  432 lines
  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.27";
  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.  
  29. sub new {
  30.     my $class = shift;
  31.     unshift(@_, "PeerAddr") if @_ == 1;
  32.     return $class->SUPER::new(@_);
  33. }
  34.  
  35. sub _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.  
  77. sub _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.  
  91. sub _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.  
  103. sub 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.  
  220. sub 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.  
  227. sub 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.  
  234. sub 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.  
  241. sub 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.  
  248. sub sockhost {
  249.     @_ == 1 or croak 'usage: $sock->sockhost()';
  250.     my($sock) = @_;
  251.     my $addr = $sock->sockaddr;
  252.     $addr ? inet_ntoa($addr) : undef;
  253. }
  254.  
  255. sub 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.  
  262. sub 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.  
  269. sub peerhost {
  270.     @_ == 1 or croak 'usage: $sock->peerhost()';
  271.     my($sock) = @_;
  272.     my $addr = $sock->peeraddr;
  273.     $addr ? inet_ntoa($addr) : undef;
  274. }
  275.  
  276. 1;
  277.  
  278. __END__
  279.  
  280. =head1 NAME
  281.  
  282. IO::Socket::INET - Object interface for AF_INET domain sockets
  283.  
  284. =head1 SYNOPSIS
  285.  
  286.     use IO::Socket::INET;
  287.  
  288. =head1 DESCRIPTION
  289.  
  290. C<IO::Socket::INET> provides an object interface to creating and using sockets
  291. in the AF_INET domain. It is built upon the L<IO::Socket> interface and
  292. inherits all the methods defined by L<IO::Socket>.
  293.  
  294. =head1 CONSTRUCTOR
  295.  
  296. =over 4
  297.  
  298. =item new ( [ARGS] )
  299.  
  300. Creates an C<IO::Socket::INET> object, which is a reference to a
  301. newly created symbol (see the C<Symbol> package). C<new>
  302. optionally takes arguments, these arguments are in key-value pairs.
  303.  
  304. In addition to the key-value pairs accepted by L<IO::Socket>,
  305. C<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.  
  325. If C<Listen> is defined then a listen socket is created, else if the
  326. socket type, which is derived from the protocol, is SOCK_STREAM then
  327. connect() is called.
  328.  
  329. Although it is not illegal, the use of C<MultiHomed> on a socket
  330. which is in non-blocking mode is of little use. This is because the
  331. first connect will never fail with a timeout as the connect call
  332. will not block.
  333.  
  334. The 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
  336. service name.  The service name might be followed by a number in
  337. parenthesis which is used if the service is not known by the system.
  338. The C<PeerPort> specification can also be embedded in the C<PeerAddr>
  339. by preceding it with a ":".
  340.  
  341. If C<Proto> is not given and you specify a symbolic C<PeerPort> port,
  342. then the constructor will try to derive C<Proto> from the service
  343. name.  As a last resort C<Proto> "tcp" is assumed.  The C<Type>
  344. parameter will be deduced from C<Proto> if not specified.
  345.  
  346. If the constructor is only passed a single argument, it is assumed to
  347. be a C<PeerAddr> specification.
  348.  
  349. If C<Blocking> is set to 0, the connection will be in nonblocking mode.
  350. If not specified it defaults to 1 (blocking mode).
  351.  
  352. Examples:
  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.  
  376. As of VERSION 1.18 all IO::Socket objects have autoflush turned on
  377. by 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.  
  389. Return the address part of the sockaddr structure for the socket
  390.  
  391. =item sockport ()
  392.  
  393. Return the port number that the socket is using on the local host
  394.  
  395. =item sockhost ()
  396.  
  397. Return the address part of the sockaddr structure for the socket in a
  398. text form xx.xx.xx.xx
  399.  
  400. =item peeraddr ()
  401.  
  402. Return the address part of the sockaddr structure for the socket on
  403. the peer host
  404.  
  405. =item peerport ()
  406.  
  407. Return the port number for the socket on the peer host.
  408.  
  409. =item peerhost ()
  410.  
  411. Return the address part of the sockaddr structure for the socket on the
  412. peer host in a text form xx.xx.xx.xx
  413.  
  414. =back
  415.  
  416. =head1 SEE ALSO
  417.  
  418. L<Socket>, L<IO::Socket>
  419.  
  420. =head1 AUTHOR
  421.  
  422. Graham Barr. Currently maintained by the Perl Porters.  Please report all
  423. bugs to <perl5-porters@perl.org>.
  424.  
  425. =head1 COPYRIGHT
  426.  
  427. Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
  428. This program is free software; you can redistribute it and/or
  429. modify it under the same terms as Perl itself.
  430.  
  431. =cut
  432.