PageRenderTime 39ms CodeModel.GetById 12ms RepoModel.GetById 0ms app.codeStats 0ms

/IronPython_Main/Runtime/Tests/LinqDlrTests/testenv/perl/lib/io/socket/inet.pm

#
Perl | 414 lines | 290 code | 108 blank | 16 comment | 77 complexity | 7acea65d333b790c168103e74235fe47 MD5 | raw file
Possible License(s): GPL-2.0, MPL-2.0-no-copyleft-exception, CPL-1.0, CC-BY-SA-3.0, BSD-3-Clause, ISC, AGPL-3.0, LGPL-2.1, Apache-2.0
  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. package IO::Socket::INET;
  7. use strict;
  8. our(@ISA, $VERSION);
  9. use IO::Socket;
  10. use Socket;
  11. use Carp;
  12. use Exporter;
  13. use Errno;
  14. @ISA = qw(IO::Socket);
  15. $VERSION = "1.25";
  16. my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
  17. IO::Socket::INET->register_domain( AF_INET );
  18. my %socket_type = ( tcp => SOCK_STREAM,
  19. udp => SOCK_DGRAM,
  20. icmp => SOCK_RAW
  21. );
  22. sub new {
  23. my $class = shift;
  24. unshift(@_, "PeerAddr") if @_ == 1;
  25. return $class->SUPER::new(@_);
  26. }
  27. sub _sock_info {
  28. my($addr,$port,$proto) = @_;
  29. my $origport = $port;
  30. my @proto = ();
  31. my @serv = ();
  32. $port = $1
  33. if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
  34. if(defined $proto) {
  35. if (@proto = ( $proto =~ m,\D,
  36. ? getprotobyname($proto)
  37. : getprotobynumber($proto))
  38. ) {
  39. $proto = $proto[2] || undef;
  40. }
  41. else {
  42. $@ = "Bad protocol '$proto'";
  43. return;
  44. }
  45. }
  46. if(defined $port) {
  47. $port =~ s,\((\d+)\)$,,;
  48. my $defport = $1 || undef;
  49. my $pnum = ($port =~ m,^(\d+)$,)[0];
  50. @serv = getservbyname($port, $proto[0] || "")
  51. if ($port =~ m,\D,);
  52. $port = $pnum || $serv[2] || $defport || undef;
  53. unless (defined $port) {
  54. $@ = "Bad service '$origport'";
  55. return;
  56. }
  57. $proto = (getprotobyname($serv[3]))[2] || undef
  58. if @serv && !$proto;
  59. }
  60. return ($addr || undef,
  61. $port || undef,
  62. $proto || undef
  63. );
  64. }
  65. sub _error {
  66. my $sock = shift;
  67. my $err = shift;
  68. {
  69. local($!);
  70. $@ = join("",ref($sock),": ",@_);
  71. close($sock)
  72. if(defined fileno($sock));
  73. }
  74. $! = $err;
  75. return undef;
  76. }
  77. sub _get_addr {
  78. my($sock,$addr_str, $multi) = @_;
  79. my @addr;
  80. if ($multi && $addr_str !~ /^\d+(?:\.\d+){3}$/) {
  81. (undef, undef, undef, undef, @addr) = gethostbyname($addr_str);
  82. } else {
  83. my $h = inet_aton($addr_str);
  84. push(@addr, $h) if defined $h;
  85. }
  86. @addr;
  87. }
  88. sub configure {
  89. my($sock,$arg) = @_;
  90. my($lport,$rport,$laddr,$raddr,$proto,$type);
  91. $arg->{LocalAddr} = $arg->{LocalHost}
  92. if exists $arg->{LocalHost} && !exists $arg->{LocalAddr};
  93. ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
  94. $arg->{LocalPort},
  95. $arg->{Proto})
  96. or return _error($sock, $!, $@);
  97. $laddr = defined $laddr ? inet_aton($laddr)
  98. : INADDR_ANY;
  99. return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
  100. unless(defined $laddr);
  101. $arg->{PeerAddr} = $arg->{PeerHost}
  102. if exists $arg->{PeerHost} && !exists $arg->{PeerAddr};
  103. unless(exists $arg->{Listen}) {
  104. ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
  105. $arg->{PeerPort},
  106. $proto)
  107. or return _error($sock, $!, $@);
  108. }
  109. $proto ||= (getprotobyname('tcp'))[2];
  110. my $pname = (getprotobynumber($proto))[0];
  111. $type = $arg->{Type} || $socket_type{$pname};
  112. my @raddr = ();
  113. if(defined $raddr) {
  114. @raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
  115. return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
  116. unless @raddr;
  117. }
  118. while(1) {
  119. $sock->socket(AF_INET, $type, $proto) or
  120. return _error($sock, $!, "$!");
  121. if ($arg->{Reuse} || $arg->{ReuseAddr}) {
  122. $sock->sockopt(SO_REUSEADDR,1) or
  123. return _error($sock, $!, "$!");
  124. }
  125. if ($arg->{ReusePort}) {
  126. $sock->sockopt(SO_REUSEPORT,1) or
  127. return _error($sock, $!, "$!");
  128. }
  129. if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) {
  130. $sock->bind($lport || 0, $laddr) or
  131. return _error($sock, $!, "$!");
  132. }
  133. if(exists $arg->{Listen}) {
  134. $sock->listen($arg->{Listen} || 5) or
  135. return _error($sock, $!, "$!");
  136. last;
  137. }
  138. # don't try to connect unless we're given a PeerAddr
  139. last unless exists($arg->{PeerAddr});
  140. $raddr = shift @raddr;
  141. return _error($sock, $EINVAL, 'Cannot determine remote port')
  142. unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
  143. last
  144. unless($type == SOCK_STREAM || defined $raddr);
  145. return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
  146. unless defined $raddr;
  147. # my $timeout = ${*$sock}{'io_socket_timeout'};
  148. # my $before = time() if $timeout;
  149. if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
  150. # ${*$sock}{'io_socket_timeout'} = $timeout;
  151. return $sock;
  152. }
  153. return _error($sock, $!, "Timeout")
  154. unless @raddr;
  155. # if ($timeout) {
  156. # my $new_timeout = $timeout - (time() - $before);
  157. # return _error($sock,
  158. # (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL),
  159. # "Timeout") if $new_timeout <= 0;
  160. # ${*$sock}{'io_socket_timeout'} = $new_timeout;
  161. # }
  162. }
  163. $sock;
  164. }
  165. sub connect {
  166. @_ == 2 || @_ == 3 or
  167. croak 'usage: $sock->connect(NAME) or $sock->connect(PORT, ADDR)';
  168. my $sock = shift;
  169. return $sock->SUPER::connect(@_ == 1 ? shift : pack_sockaddr_in(@_));
  170. }
  171. sub bind {
  172. @_ == 2 || @_ == 3 or
  173. croak 'usage: $sock->bind(NAME) or $sock->bind(PORT, ADDR)';
  174. my $sock = shift;
  175. return $sock->SUPER::bind(@_ == 1 ? shift : pack_sockaddr_in(@_))
  176. }
  177. sub sockaddr {
  178. @_ == 1 or croak 'usage: $sock->sockaddr()';
  179. my($sock) = @_;
  180. my $name = $sock->sockname;
  181. $name ? (sockaddr_in($name))[1] : undef;
  182. }
  183. sub sockport {
  184. @_ == 1 or croak 'usage: $sock->sockport()';
  185. my($sock) = @_;
  186. my $name = $sock->sockname;
  187. $name ? (sockaddr_in($name))[0] : undef;
  188. }
  189. sub sockhost {
  190. @_ == 1 or croak 'usage: $sock->sockhost()';
  191. my($sock) = @_;
  192. my $addr = $sock->sockaddr;
  193. $addr ? inet_ntoa($addr) : undef;
  194. }
  195. sub peeraddr {
  196. @_ == 1 or croak 'usage: $sock->peeraddr()';
  197. my($sock) = @_;
  198. my $name = $sock->peername;
  199. $name ? (sockaddr_in($name))[1] : undef;
  200. }
  201. sub peerport {
  202. @_ == 1 or croak 'usage: $sock->peerport()';
  203. my($sock) = @_;
  204. my $name = $sock->peername;
  205. $name ? (sockaddr_in($name))[0] : undef;
  206. }
  207. sub peerhost {
  208. @_ == 1 or croak 'usage: $sock->peerhost()';
  209. my($sock) = @_;
  210. my $addr = $sock->peeraddr;
  211. $addr ? inet_ntoa($addr) : undef;
  212. }
  213. 1;
  214. __END__
  215. =head1 NAME
  216. IO::Socket::INET - Object interface for AF_INET domain sockets
  217. =head1 SYNOPSIS
  218. use IO::Socket::INET;
  219. =head1 DESCRIPTION
  220. C<IO::Socket::INET> provides an object interface to creating and using sockets
  221. in the AF_INET domain. It is built upon the L<IO::Socket> interface and
  222. inherits all the methods defined by L<IO::Socket>.
  223. =head1 CONSTRUCTOR
  224. =over 4
  225. =item new ( [ARGS] )
  226. Creates an C<IO::Socket::INET> object, which is a reference to a
  227. newly created symbol (see the C<Symbol> package). C<new>
  228. optionally takes arguments, these arguments are in key-value pairs.
  229. In addition to the key-value pairs accepted by L<IO::Socket>,
  230. C<IO::Socket::INET> provides.
  231. PeerAddr Remote host address <hostname>[:<port>]
  232. PeerHost Synonym for PeerAddr
  233. PeerPort Remote port or service <service>[(<no>)] | <no>
  234. LocalAddr Local host bind address hostname[:port]
  235. LocalHost Synonym for LocalAddr
  236. LocalPort Local host bind port <service>[(<no>)] | <no>
  237. Proto Protocol name (or number) "tcp" | "udp" | ...
  238. Type Socket type SOCK_STREAM | SOCK_DGRAM | ...
  239. Listen Queue size for listen
  240. ReuseAddr Set SO_REUSEADDR before binding
  241. Reuse Set SO_REUSEADDR before binding (deprecated, prefer ReuseAddr)
  242. ReusePort Set SO_REUSEPORT before binding
  243. Timeout Timeout value for various operations
  244. MultiHomed Try all adresses for multi-homed hosts
  245. If C<Listen> is defined then a listen socket is created, else if the
  246. socket type, which is derived from the protocol, is SOCK_STREAM then
  247. connect() is called.
  248. Although it is not illegal, the use of C<MultiHomed> on a socket
  249. which is in non-blocking mode is of little use. This is because the
  250. first connect will never fail with a timeout as the connaect call
  251. will not block.
  252. The C<PeerAddr> can be a hostname or the IP-address on the
  253. "xx.xx.xx.xx" form. The C<PeerPort> can be a number or a symbolic
  254. service name. The service name might be followed by a number in
  255. parenthesis which is used if the service is not known by the system.
  256. The C<PeerPort> specification can also be embedded in the C<PeerAddr>
  257. by preceding it with a ":".
  258. If C<Proto> is not given and you specify a symbolic C<PeerPort> port,
  259. then the constructor will try to derive C<Proto> from the service
  260. name. As a last resort C<Proto> "tcp" is assumed. The C<Type>
  261. parameter will be deduced from C<Proto> if not specified.
  262. If the constructor is only passed a single argument, it is assumed to
  263. be a C<PeerAddr> specification.
  264. Examples:
  265. $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
  266. PeerPort => 'http(80)',
  267. Proto => 'tcp');
  268. $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
  269. $sock = IO::Socket::INET->new(Listen => 5,
  270. LocalAddr => 'localhost',
  271. LocalPort => 9000,
  272. Proto => 'tcp');
  273. $sock = IO::Socket::INET->new('127.0.0.1:25');
  274. NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
  275. As of VERSION 1.18 all IO::Socket objects have autoflush turned on
  276. by default. This was not the case with earlier releases.
  277. NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
  278. =back
  279. =head2 METHODS
  280. =over 4
  281. =item sockaddr ()
  282. Return the address part of the sockaddr structure for the socket
  283. =item sockport ()
  284. Return the port number that the socket is using on the local host
  285. =item sockhost ()
  286. Return the address part of the sockaddr structure for the socket in a
  287. text form xx.xx.xx.xx
  288. =item peeraddr ()
  289. Return the address part of the sockaddr structure for the socket on
  290. the peer host
  291. =item peerport ()
  292. Return the port number for the socket on the peer host.
  293. =item peerhost ()
  294. Return the address part of the sockaddr structure for the socket on the
  295. peer host in a text form xx.xx.xx.xx
  296. =back
  297. =head1 SEE ALSO
  298. L<Socket>, L<IO::Socket>
  299. =head1 AUTHOR
  300. Graham Barr. Currently maintained by the Perl Porters. Please report all
  301. bugs to <perl5-porters@perl.org>.
  302. =head1 COPYRIGHT
  303. Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
  304. This program is free software; you can redistribute it and/or
  305. modify it under the same terms as Perl itself.
  306. =cut