ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Socket.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.60 by root, Thu Aug 21 18:45:16 2008 UTC vs.
Revision 1.71 by root, Thu Feb 12 17:33:38 2009 UTC

… …
57 inet_aton 57 inet_aton
58 tcp_server 58 tcp_server
59 tcp_connect 59 tcp_connect
60); 60);
61 61
62our $VERSION = 4.232; 62our $VERSION = 4.34;
63 63
64=item $ipn = parse_ipv4 $dotted_quad 64=item $ipn = parse_ipv4 $dotted_quad
65 65
66Tries to parse the given dotted quad IPv4 address and return it in 66Tries to parse the given dotted quad IPv4 address and return it in
67octet form (or undef when it isn't in a parsable format). Supports all 67octet form (or undef when it isn't in a parsable format). Supports all
… …
443C<sctp>. The default is currently C<tcp>, but in the future, this function 443C<sctp>. The default is currently C<tcp>, but in the future, this function
444might try to use other protocols such as C<sctp>, depending on the socket 444might try to use other protocols such as C<sctp>, depending on the socket
445type and any SRV records it might find. 445type and any SRV records it might find.
446 446
447C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use 447C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
448only IPv4) or C<6> (use only IPv6). This setting might be influenced by 448only IPv4) or C<6> (use only IPv6). The default is influenced by
449C<$ENV{PERL_ANYEVENT_PROTOCOLS}>. 449C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
450 450
451C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or 451C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
452C<undef> in which case it gets automatically chosen). 452C<undef> in which case it gets automatically chosen to be C<SOCK_STREAM>
453unless C<$proto> is C<udp>).
453 454
454The callback will receive zero or more array references that contain 455The callback will receive zero or more array references that contain
455C<$family, $type, $proto> for use in C<socket> and a binary 456C<$family, $type, $proto> for use in C<socket> and a binary
456C<$sockaddr> for use in C<connect> (or C<bind>). 457C<$sockaddr> for use in C<connect> (or C<bind>).
457 458
… …
474 475
475sub resolve_sockaddr($$$$$$) { 476sub resolve_sockaddr($$$$$$) {
476 my ($node, $service, $proto, $family, $type, $cb) = @_; 477 my ($node, $service, $proto, $family, $type, $cb) = @_;
477 478
478 if ($node eq "unix/") { 479 if ($node eq "unix/") {
479 return $cb->() if $family || !/^\//; # no can do 480 return $cb->() if $family || $service !~ /^\//; # no can do
480 481
481 return $cb->([AF_UNIX, $type, 0, Socket::pack_sockaddr_un $service]); 482 return $cb->([AF_UNIX, defined $type ? $type : SOCK_STREAM, 0, Socket::pack_sockaddr_un $service]);
482 } 483 }
483 484
484 unless (AF_INET6) { 485 unless (AF_INET6) {
485 $family != 6 486 $family != 6
486 or return $cb->(); 487 or return $cb->();
… …
717 # also http://advogato.org/article/672.html 718 # also http://advogato.org/article/672.html
718 719
719 my %state = ( fh => undef ); 720 my %state = ( fh => undef );
720 721
721 # name/service to type/sockaddr resolution 722 # name/service to type/sockaddr resolution
722 resolve_sockaddr $host, $port, 0, 0, 0, sub { 723 resolve_sockaddr $host, $port, 0, 0, undef, sub {
723 my @target = @_; 724 my @target = @_;
724 725
725 $state{next} = sub { 726 $state{next} = sub {
726 return unless exists $state{fh}; 727 return unless exists $state{fh};
727 728
… …
748 $state{next}(); 749 $state{next}();
749 }) if $timeout; 750 }) if $timeout;
750 751
751 # called when the connect was successful, which, 752 # called when the connect was successful, which,
752 # in theory, could be the case immediately (but never is in practise) 753 # in theory, could be the case immediately (but never is in practise)
753 my $connected = sub { 754 $state{connected} = sub {
754 delete $state{ww}; 755 delete $state{ww};
755 delete $state{to}; 756 delete $state{to};
756 757
757 # we are connected, or maybe there was an error 758 # we are connected, or maybe there was an error
758 if (my $sin = getpeername $state{fh}) { 759 if (my $sin = getpeername $state{fh}) {
759 my ($port, $host) = unpack_sockaddr $sin; 760 my ($port, $host) = unpack_sockaddr $sin;
760 761
761 my $guard = guard { 762 my $guard = guard { %state = () };
762 %state = ();
763 };
764 763
765 $connect->($state{fh}, format_address $host, $port, sub { 764 $connect->(delete $state{fh}, format_address $host, $port, sub {
766 $guard->cancel; 765 $guard->cancel;
767 $state{next}(); 766 $state{next}();
768 }); 767 });
769 } else { 768 } else {
770 # dummy read to fetch real error code 769 # dummy read to fetch real error code
… …
773 } 772 }
774 }; 773 };
775 774
776 # now connect 775 # now connect
777 if (connect $state{fh}, $sockaddr) { 776 if (connect $state{fh}, $sockaddr) {
778 $connected->(); 777 $state{connected}->();
779 } elsif ($! == &Errno::EINPROGRESS # POSIX 778 } elsif ($! == &Errno::EINPROGRESS # POSIX
780 || $! == &Errno::EWOULDBLOCK 779 || $! == &Errno::EWOULDBLOCK
781 # WSAEINPROGRESS intentionally not checked - it means something else entirely 780 # WSAEINPROGRESS intentionally not checked - it means something else entirely
782 || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt 781 || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
783 || $! == AnyEvent::Util::WSAEWOULDBLOCK) { 782 || $! == AnyEvent::Util::WSAEWOULDBLOCK) {
784 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected); 783 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $state{connected});
785 } else { 784 } else {
786 $state{next}(); 785 $state{next}();
787 } 786 }
788 }; 787 };
789 788
… …
854 }, sub { 853 }, sub {
855 my ($fh, $thishost, $thisport) = @_; 854 my ($fh, $thishost, $thisport) = @_;
856 warn "bound to $thishost, port $thisport\n"; 855 warn "bound to $thishost, port $thisport\n";
857 }; 856 };
858 857
858Example: bind a server on a unix domain socket.
859
860 tcp_server "unix/", "/tmp/mydir/mysocket", sub {
861 my ($fh) = @_;
862 };
863
859=cut 864=cut
860 865
861sub tcp_server($$$;$) { 866sub tcp_server($$$;$) {
862 my ($host, $service, $accept, $prepare) = @_; 867 my ($host, $service, $accept, $prepare) = @_;
863 868

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines