POE-Component-Client-DNS-1.051/0000700000076500000240000000000011265274412014565 5ustar trocstaffPOE-Component-Client-DNS-1.051/CHANGES0000644000076500000240000001205711265274416015603 0ustar trocstaff================================ 2009-10-14 03:06:11 -0400 v1_051 ================================ commit 752c05c86c55c7f42c614ad0e56110b0e3543a6c Author: Rocco Caputo Date: Wed Oct 14 03:06:11 2009 -0400 Prepare for release. commit 9946ea262b24edac293ce709a99875af9aed2f9f Author: Rocco Caputo Date: Mon Oct 12 23:57:38 2009 -0400 Add a 00_info.t test to help debug platform and dependency based issues. commit 86564af4621eacd93cf3ae4aeb66b27756f2f6e5 Author: Rocco Caputo Date: Mon Sep 14 02:01:34 2009 -0400 Administrivia to convert the repository to git. ================================ 2009-08-28 06:46:24 +0000 v1_050 ================================ commit e88dccf85d700690d4dfa2a4b96a2503436a9bf3 Author: Rocco Caputo Date: Fri Aug 28 06:46:24 2009 +0000 Jonathan Yu found a warning while packaging this distro for Debian. I've applied his patch from rt.cpan.org 48335, and I took his suggestion to start using Test::NoWarnings. Philip Gwyn found a strange case where IPv6 localhost was returned as ::1 rather than the long form. Added a check for both forms. Bumped the version to 1.050 for release. commit 89a38b07ec86b0a4c7ffa3d07824db42f71325d3 Author: Rocco Caputo Date: Fri Aug 28 06:03:27 2009 +0000 Fix a POD error (line too long, broken link to RT) reported by Jonathan Yu, ironically in rt.cpan.org ticket 48336. :) commit 57333ebe319083d11505682c3ee50eaf0255e85a Author: Rocco Caputo Date: Mon Aug 17 04:36:45 2009 +0000 Fix a warning for /etc/hosts files that contain blank lines or comments. Suggested by Leonid Rashkovsky in e-mail. =============================== 2009-07-28 06:01:07 +0000 v1_04 =============================== commit 66459a39445fcc2bccefd87614bbd7a88da7603e Author: Rocco Caputo Date: Tue Jul 28 06:01:07 2009 +0000 Use latest POE, and prepare for a new release. commit 0444141729f991b6fd0c8b401a24be064eadb490 Author: Rocco Caputo Date: Mon Jul 27 04:51:28 2009 +0000 Added a machine-readable repository directory to the distribution. Documented the bug tracker, repository, and other resource URLs. commit 6aef81d8a208a87523e61858aad7de6408018c00 Author: Rocco Caputo Date: Sun Jul 26 06:30:34 2009 +0000 Resolve (heh) rt.cpan.org ticket #13899. AAAA requests will check for IPv6 addresses in /etc/hosts or your favorite operating system's equivalent. commit f2a0d801de751f7167f807b47e0b92f7b7871869 Author: Rocco Caputo Date: Sun Jul 26 05:59:34 2009 +0000 Resolve rt.cpan.org ticket #13492 by Sébastien Aperghis-Tramoni, #14723 by Branislav Gerzo, and umbrella ticket #15009 by cycling through the list of resolvers known to Net::DNS if the top one times out. commit 8837031bcb73a570ccf78ac9a326eff1d3eef63f Author: Rocco Caputo Date: Wed Feb 18 05:41:14 2009 +0000 Applied a patch by René Mayorga, resolving rt.cpan.org ticket 41313. René's patch uses Net::DNS to find poe.perl.org's address and use that instead of hardcoded values. Thanks also go to René for submitting the patch through rt.cpan.org. I may never have discovered ticket 506915 on bugs.debian.org. =============================== 2009-02-18 04:48:06 +0000 v1_03 =============================== commit 40146e80790ee6cc57509435335b72a78f5d4d73 Author: Rocco Caputo Date: Wed Feb 18 04:48:06 2009 +0000 Fix warnings uncovered by POE's recent global-warning issue. commit 25a1c546a0baa5502b9db1420a5604ad0b1ae499 Author: Jonathan Steinert Date: Mon Feb 2 07:50:33 2009 +0000 Make it safe to have more than one PoCoDNS object. Somehow this bug has been no problem for people this entire time. An amazing trick really :D =============================== 2009-01-13 20:08:27 +0000 v1_02 =============================== commit 48c0fd5bd0bb563af05909ea7a1da4d51c99699d Author: Rocco Caputo Date: Tue Jan 13 20:08:27 2009 +0000 A host-file test was failing because its address segments were wider than single octets. =============================== 2008-10-29 16:18:54 +0000 v1_01 =============================== commit 85d4bb5f8b4507e7a564c8e85f3c9049f468012f Author: Rocco Caputo Date: Wed Oct 29 16:18:54 2008 +0000 New version. commit a5442ca84b9193c7b51edcd3189ad87062f24193 Author: Rocco Caputo Date: Wed Oct 15 03:18:31 2008 +0000 Accommodate DNS change for poe.perl.org in the tests. commit aa430132cd83be5ed5de23957e35278d34e12a8c Author: Rocco Caputo Date: Mon Mar 24 17:33:22 2008 +0000 Apply Martin Ferrari's patch to skip network tests if there's no detectable network. Resolves rt.cpan.org ticket 33677. ============== End of Excerpt ============== POE-Component-Client-DNS-1.051/lib/0000700000076500000240000000000011265274412015333 5ustar trocstaffPOE-Component-Client-DNS-1.051/lib/POE/0000700000076500000240000000000011265274412015756 5ustar trocstaffPOE-Component-Client-DNS-1.051/lib/POE/Component/0000700000076500000240000000000011265274412017720 5ustar trocstaffPOE-Component-Client-DNS-1.051/lib/POE/Component/Client/0000700000076500000240000000000011265274412021136 5ustar trocstaffPOE-Component-Client-DNS-1.051/lib/POE/Component/Client/DNS.pm0000644000076500000240000005362611265273432022147 0ustar trocstaff# License and documentation are after __END__. # vim: ts=2 sw=2 expandtab package POE::Component::Client::DNS; use strict; use vars qw($VERSION); $VERSION = '1.051'; use Carp qw(croak); use Socket qw(unpack_sockaddr_in inet_ntoa); use Net::DNS; use POE; use constant DEBUG => 0; # A hosts file we found somewhere. my $global_hosts_file; # Object fields. "SF" stands for "self". sub SF_ALIAS () { 0 } sub SF_TIMEOUT () { 1 } sub SF_NAMESERVERS () { 2 } sub SF_RESOLVER () { 3 } sub SF_HOSTS_FILE () { 4 } sub SF_HOSTS_MTIME () { 5 } sub SF_HOSTS_CTIME () { 6 } sub SF_HOSTS_INODE () { 7 } sub SF_HOSTS_CACHE () { 8 } sub SF_HOSTS_BYTES () { 9 } sub SF_SHUTDOWN () { 10 } sub SF_REQ_BY_SOCK () { 11 } # Spawn a new PoCo::Client::DNS session. This basically is a # constructor, but it isn't named "new" because it doesn't create a # usable object. Instead, it spawns the object off as a session. sub spawn { my $type = shift; croak "$type requires an even number of parameters" if @_ % 2; my %params = @_; my $alias = delete $params{Alias}; $alias = "resolver" unless $alias; my $timeout = delete $params{Timeout}; $timeout = 90 unless $timeout; my $nameservers = delete $params{Nameservers}; my $resolver = Net::DNS::Resolver->new(); $nameservers ||= [ $resolver->nameservers() ]; my $hosts = delete $params{HostsFile}; croak( "$type doesn't know these parameters: ", join(', ', sort keys %params) ) if scalar keys %params; my $self = bless [ $alias, # SF_ALIAS $timeout, # SF_TIMEOUT $nameservers, # SF_NAMESERVERS $resolver, # SF_RESOLVER $hosts, # SF_HOSTS_FILE 0, # SF_HOSTS_MTIME 0, # SF_HOSTS_CTIME 0, # SF_HOSTS_INODE { }, # SF_HOSTS_CACHE 0, # SF_HOSTS_BYTES 0, # SF_SHUTDOWN ], $type; # Set the list of nameservers, if one was supplied. # May redundantly reset itself. $self->[SF_RESOLVER]->nameservers(@$nameservers); POE::Session->create( object_states => [ $self => { _default => "_dns_default", _start => "_dns_start", _stop => "_dns_stop", got_dns_response => "_dns_response", resolve => "_dns_resolve", send_request => "_dns_do_request", shutdown => "_dns_shutdown", }, ], ); return $self; } # Public method interface. sub resolve { my $self = shift; croak "resolve() needs an even number of parameters" if @_ % 2; my %args = @_; croak "resolve() must include an 'event'" unless exists $args{event}; croak "resolve() must include a 'context'" unless exists $args{context}; croak "resolve() must include a 'host'" unless exists $args{host}; $poe_kernel->call( $self->[SF_ALIAS], "resolve", \%args ); return undef; } sub shutdown { my $self = shift; $poe_kernel->call( $self->[SF_ALIAS], "shutdown" ); } # Start the resolver session. Record the parameters which were # validated in spawn(), create the internal resolver object, and set # an alias which we'll be known by. sub _dns_start { my ($object, $kernel) = @_[OBJECT, KERNEL]; $kernel->alias_set($object->[SF_ALIAS]); } # Dummy handler to avoid ASSERT_DEFAULT problems. sub _dns_stop { # do nothing } # Receive a request. Version 4 API. This uses extra reference counts # to keep the client sessions alive until responses are ready. sub _dns_resolve { my ($self, $kernel, $sender, $event, $host, $type, $class) = @_[OBJECT, KERNEL, SENDER, ARG0, ARG1, ARG2, ARG3]; my $debug_info = "in Client::DNS request at $_[CALLER_FILE] line $_[CALLER_LINE]\n"; my ($api_version, $context, $timeout); # Version 3 API. Pass the entire request as a hash. if (ref($event) eq 'HASH') { my %args = %$event; $type = delete $args{type}; $type = "A" unless $type; $class = delete $args{class}; $class = "IN" unless $class; $event = delete $args{event}; die "Must include an 'event' $debug_info" unless $event; $context = delete $args{context}; die "Must include a 'context' $debug_info" unless $context; $timeout = delete $args{timeout}; $host = delete $args{host}; die "Must include a 'host' $debug_info" unless $host; $api_version = 3; } # Parse user args from the magical $response format. Version 2 API. elsif (ref($event) eq "ARRAY") { $context = $event; $event = shift @$context; $api_version = 2; } # Whee. Version 1 API. else { $context = [ ]; $api_version = 1; } # Default the request's timeout. $timeout = $self->[SF_TIMEOUT] unless $timeout; # Set an extra reference on the sender so it doesn't go away. $kernel->refcount_increment($sender->ID, __PACKAGE__); # If it's an IN type A request, check /etc/hosts or the equivalent. # -><- This is not always the right thing to do, but it's more right # more often than never checking at all. if (($type eq "A" or $type eq "AAAA") and $class eq "IN") { my $address = $self->check_hosts_file($host, $type); if (defined $address) { # Pretend the request went through a name server. my $packet = Net::DNS::Packet->new($address, $type, "IN"); $packet->push( "answer", Net::DNS::RR->new( Name => $host, TTL => 1, Class => $class, Type => $type, Address => $address, ) ); # Send the response immediately, and return. _send_response( api_ver => $api_version, sender => $sender, event => $event, host => $host, type => $type, class => $class, context => $context, response => $packet, error => "", ); return; } } # We are here. Yield off to the state where the request will be # sent. This is done so that the do-it state can yield or delay # back to itself for retrying. my $now = time(); $kernel->call( $self->[SF_ALIAS], send_request => { sender => $sender, event => $event, host => $host, type => $type, class => $class, context => $context, started => $now, ends => $now + $timeout, api_ver => $api_version, nameservers => [ $self->[SF_RESOLVER]->nameservers() ], } ); } # Perform the real request. May recurse to perform retries. sub _dns_do_request { my ($self, $kernel, $req) = @_[OBJECT, KERNEL, ARG0]; # Did the request time out? my $remaining = $req->{ends} - time(); if ($remaining <= 0) { _send_response( %$req, response => undef, error => "timeout", ); return; } # Send the request. my $resolver_socket = $self->[SF_RESOLVER]->bgsend( $req->{host}, $req->{type}, $req->{class} ); # The request failed? Attempt to retry. unless ($resolver_socket) { $remaining = 1 if $remaining > 1; $kernel->delay_add(send_request => $remaining, $req); return; } # Set a timeout for the request, and watch the response socket for # activity. $self->[SF_REQ_BY_SOCK]->{$resolver_socket} = $req; $kernel->delay($resolver_socket, $remaining / 2, $resolver_socket); $kernel->select_read($resolver_socket, 'got_dns_response'); # Save the socket for pre-emptive shutdown. $req->{resolver_socket} = $resolver_socket; } # A resolver query timed out. Keep trying until we run out of time. # Also, if the top nameserver is the one we tried, then cycle the # nameservers. sub _dns_default { my ($self, $kernel, $event, $args) = @_[OBJECT, KERNEL, ARG0, ARG1]; my $socket = $args->[0]; return unless defined($socket) and $event eq $socket; my $req = delete $self->[SF_REQ_BY_SOCK]->{$socket}; return unless $req; # Stop watching the socket. $kernel->select_read($socket); # No more time remaining? We must time out. my $remaining = $req->{ends} - time(); if ($remaining <= 0) { _send_response( %$req, response => undef, error => "timeout", ); return; } # There remains time. Let's try again. # The nameserver we tried has failed us. If it's the top # nameserver in Net::DNS's list, then send it to the back and retry. my @nameservers = $self->[SF_RESOLVER]->nameservers(); if ($nameservers[0] eq $req->{nameservers}[0]) { push @nameservers, shift(@nameservers); $self->[SF_RESOLVER]->nameservers(@nameservers); $req->{nameservers} = \@nameservers; } # Retry. $kernel->yield(send_request => $req); # Don't accidentally handle signals. return; } # A resolver query generated a response. Post the reply back. sub _dns_response { my ($self, $kernel, $socket) = @_[OBJECT, KERNEL, ARG0]; my $req = delete $self->[SF_REQ_BY_SOCK]->{$socket}; return unless $req; # Turn off the timeout for this request, and stop watching the # resolver connection. $kernel->delay($socket); $kernel->select_read($socket); # Read the DNS response. my $packet = $self->[SF_RESOLVER]->bgread($socket); # Set the packet's answerfrom field, if the packet was received ok # and an answerfrom isn't already included. This uses the # documented peerhost() method if (defined $packet and !defined $packet->answerfrom) { my $answerfrom = getpeername($socket); if (defined $answerfrom) { $answerfrom = (unpack_sockaddr_in($answerfrom))[1]; $answerfrom = inet_ntoa($answerfrom); $packet->answerfrom($answerfrom); } } # Send the response. _send_response( %$req, response => $packet, error => $self->[SF_RESOLVER]->errorstring(), ); } sub _dns_shutdown { my ($self, $kernel) = @_[OBJECT, KERNEL]; # Clean up all pending socket timeouts and selects. foreach my $socket (keys %{$self->[SF_REQ_BY_SOCK]}) { DEBUG and warn "SHT: Shutting down resolver socket $socket"; my $req = delete $self->[SF_REQ_BY_SOCK]->{$socket}; $kernel->delay($socket); $kernel->select($req->{resolver_socket}); # Let the client session go. DEBUG and warn "SHT: Releasing sender ", $req->{sender}->ID; $poe_kernel->refcount_decrement($req->{sender}->ID, __PACKAGE__); } # Clean out our global timeout. $kernel->delay(send_request => undef); # Clean up our global alias. DEBUG and warn "SHT: Resolver removing alias $self->[SF_ALIAS]"; $kernel->alias_remove($self->[SF_ALIAS]); $self->[SF_SHUTDOWN] = 1; } # Send a response. Fake a postback for older API versions. Send a # nice, tidy hash for new ones. Also decrement the reference count # that's keeping the requester session alive. sub _send_response { my %args = @_; # Simulate a postback for older API versions. my $api_version = delete $args{api_ver}; if ($api_version < 3) { $poe_kernel->post( $args{sender}, $args{event}, [ $args{host}, $args{type}, $args{class}, @{$args{context}} ], [ $args{response}, $args{error} ], ); } # New, fancy, shiny hash-based response. else { $poe_kernel->post( $args{sender}, $args{event}, { host => $args{host}, type => $args{type}, class => $args{class}, context => $args{context}, response => $args{response}, error => $args{error}, } ); } # Let the client session go. $poe_kernel->refcount_decrement($args{sender}->ID, __PACKAGE__); } ### NOT A POE EVENT HANDLER sub check_hosts_file { my ($self, $host, $type) = @_; # Use the hosts file that was specified, or find one. my $use_hosts_file; if (defined $self->[SF_HOSTS_FILE]) { $use_hosts_file = $self->[SF_HOSTS_FILE]; } else { # Discard the hosts file name if it has disappeared. $global_hosts_file = undef if ( $global_hosts_file and !-f $global_hosts_file ); # Try to find a hosts file if one doesn't exist. unless ($global_hosts_file) { my @candidates = ( "/etc/hosts", ); if ($^O eq "MSWin32" or $^O eq "Cygwin") { my $sys_dir; $sys_dir = $ENV{SystemRoot} || "c:\\Windows"; push( @candidates, "$sys_dir\\System32\\Drivers\\Etc\\hosts", "$sys_dir\\System\\Drivers\\Etc\\hosts", "$sys_dir\\hosts", ); } foreach my $candidate (@candidates) { next unless -f $candidate; $global_hosts_file = $candidate; $global_hosts_file =~ s/\\+/\//g; $self->[SF_HOSTS_MTIME] = 0; $self->[SF_HOSTS_CTIME] = 0; $self->[SF_HOSTS_INODE] = 0; last; } } # We use the global hosts file. $use_hosts_file = $global_hosts_file; } # Still no hosts file? Don't bother reading it, then. return unless $use_hosts_file; # Blow away our cache if the file doesn't exist. $self->[SF_HOSTS_CACHE] = { } unless -f $use_hosts_file; # Reload the hosts file if times have changed. my ($inode, $bytes, $mtime, $ctime) = (stat $use_hosts_file)[1, 7, 9,10]; unless ( $self->[SF_HOSTS_MTIME] == ($mtime || -1) and $self->[SF_HOSTS_CTIME] == ($ctime || -1) and $self->[SF_HOSTS_INODE] == ($inode || -1) and $self->[SF_HOSTS_BYTES] == ($bytes || -1) ) { return unless open(HOST, "<", $use_hosts_file); my %cached_hosts; while () { next if /^\s*\#/; # skip all-comment lines next if /^\s*$/; # skip empty lines chomp; # Bare split discards leading and trailing whitespace. my ($address, @aliases) = split; next unless defined $address; my $type = ($address =~ /:/) ? "AAAA" : "A"; foreach my $alias (@aliases) { $cached_hosts{$alias}{$type}{$address} = 1; } } close HOST; # Normalize our cached hosts. while (my ($alias, $type_rec) = each %cached_hosts) { while (my ($type, $address_rec) = each %$type_rec) { $cached_hosts{$alias}{$type} = (keys %$address_rec)[0]; } } $self->[SF_HOSTS_CACHE] = \%cached_hosts; $self->[SF_HOSTS_MTIME] = $mtime; $self->[SF_HOSTS_CTIME] = $ctime; $self->[SF_HOSTS_INODE] = $inode; $self->[SF_HOSTS_BYTES] = $bytes; } # Return whatever match we have. return unless ( (exists $self->[SF_HOSTS_CACHE]{$host}) and (exists $self->[SF_HOSTS_CACHE]{$host}{$type}) ); return $self->[SF_HOSTS_CACHE]{$host}{$type}; } ### NOT A POE EVENT HANDLER sub get_resolver { my $self = shift; return $self->[SF_RESOLVER]; } 1; __END__ =head1 NAME POE::Component::Client::DNS - non-blocking, concurrent DNS requests =head1 SYNOPSIS use POE qw(Component::Client::DNS); my $named = POE::Component::Client::DNS->spawn( Alias => "named" ); POE::Session->create( inline_states => { _start => \&start_tests, response => \&got_response, } ); POE::Kernel->run(); exit; sub start_tests { my $response = $named->resolve( event => "response", host => "localhost", context => { }, ); if ($response) { $_[KERNEL]->yield(response => $response); } } sub got_response { my $response = $_[ARG0]; my @answers = $response->{response}->answer(); foreach my $answer (@answers) { print( "$response->{host} = ", $answer->type(), " ", $answer->rdatastr(), "\n" ); } } =head1 DESCRIPTION POE::Component::Client::DNS provides a facility for non-blocking, concurrent DNS requests. Using POE, it allows other tasks to run while waiting for name servers to respond. =head1 PUBLIC METHODS =over 2 =item spawn A program must spawn at least one POE::Component::Client::DNS instance before it can perform background DNS lookups. Each instance represents a connection to a name server, or a pool of them. If a program only needs to request DNS lookups from one server, then you only need one POE::Component::Client::DNS instance. As of version 0.98 you can override the default timeout per request. From this point forward there is no need to spawn multiple instances o affect different timeouts for each request. PoCo::Client::DNS's C method takes a few named parameters: Alias sets the component's alias. Requests will be posted to this alias. The component's alias defaults to "resolver" if one is not provided. Programs spawning more than one DNS client component must specify aliases for N-1 of them, otherwise alias collisions will occur. Alias => $session_alias, # defaults to "resolver" Timeout sets the component's default timeout. The timeout may be overridden per request. See the "request" event, later on. If no Timeout is set, the component will wait 90 seconds per request by default. Timeouts may be set to real numbers. Timeouts are more accurate if you have Time::HiRes installed. POE (and thus this component) will use Time::HiRes automatically if it's available. Timeout => $seconds_to_wait, # defaults to 90 Nameservers holds a reference to a list of name servers to try. The list is passed directly to Net::DNS::Resolver's nameservers() method. By default, POE::Component::Client::DNS will query the name servers that appear in /etc/resolv.conf or its equivalent. Nameservers => \@name_servers, # defaults to /etc/resolv.conf's HostsFile (optional) holds the name of a specific hosts file to use for resolving hardcoded addresses. By default, it looks for a file named /etc/hosts. On Windows systems, it may look in the following other places: $ENV{SystemRoot}\System32\Drivers\Etc\hosts $ENV{SystemRoot}\System\Drivers\Etc\hosts $ENV{SystemRoot}\hosts =item resolve resolve() requests the component to resolve a host name. It will return a hash reference (described in RESPONSE MESSAGES, below) if it can honor the request immediately (perhaps from a cache). Otherwise it returns undef if a resolver must be consulted asynchronously. Requests are passed as a list of named fields. $resolver->resolve( class => $dns_record_class, # defaults to "IN" type => $dns_record_type, # defaults to "A" host => $request_host, # required context => $request_context, # required event => $response_event, # required timeout => $request_timeout, # defaults to spawn()'s Timeout ); The "class" and "type" fields specify what kind of information to return about a host. Most of the time internet addresses are requested for host names, so the class and type default to "IN" (internet) and "A" (address), respectively. The "host" field designates the host to look up. It is required. The "event" field tells the component which event to send back when a response is available. It is required, but it will not be used if resolve() can immediately return a cached response. "timeout" tells the component how long to wait for a response to this request. It defaults to the "Timeout" given at spawn() time. "context" includes some external data that links responses back to their requests. The context data is provided by the program that uses POE::Component::Client::DNS. The component will pass the context back to the program without modification. The "context" parameter is required, and may contain anything that fits in a scalar. =item shutdown shutdown() causes the component to terminate gracefully. It will finish serving pending requests then close down. =item get_resolver POE::Component::Client::DNS uses a Net::DNS::Resolver object internally. get_resolver() returns that object so it may be interrogated or modified. See L for options. Set the resolver to check on nonstandard port 1153: $poco_client_dns->resolver()->port(1153); =head1 RESPONSE MESSAGES POE::Component::Client::DNS responds in one of two ways. Its resolve() method will return a response immediately if it can be found in the component's cache. Otherwise the component posts the response back in $_[ARG0]. In either case, the response is a hash reference containing the same fields: host => $request_host, type => $request_type, class => $request_class, context => $request_context, response => $net_dns_packet, error => $net_dns_error, The "host", "type", "class", and "context" response fields are identical to those given in the request message. "response" contains a Net::DNS::Packet object on success or undef if the lookup failed. The Net::DNS::Packet object describes the response to the program's request. It may contain several DNS records. Please consult L and L for more information. "error" contains a description of any error that has occurred. It is only valid if "response" is undefined. =head1 SEE ALSO L - POE::Component::Client::DNS builds heavily on POE. L - This module uses Net::DNS internally. L - Responses are returned as Net::DNS::Packet objects. =head1 DEPRECATIONS The older, list-based interfaces are no longer documented as of version 0.98. They are being phased out. The method-based interface, first implementedin version 0.98, will replace the deprecated interfaces after a six-month phase-out period. Version 0.98 was released in October of 2004. The deprecated interfaces will continue to work without warnings until January 2005. As of January 2005, programs that use the deprecated interfaces will continue to work, but they will generate mandatory warnings. Those warnings will persist until April 2005. As of April 2005 the mandatory warnings will be upgraded to mandatory errors. Support for the deprecated interfaces will be removed entirely. =head1 BUG TRACKER https://rt.cpan.org/Dist/Display.html?Queue=POE-Component-Client-DNS =head1 REPOSITORY http://github.com/rcaputo/poe-component-client-dns =head1 OTHER RESOURCES http://search.cpan.org/dist/POE-Component-Client-DNS/ =head1 AUTHOR & COPYRIGHTS POE::Component::Client::DNS is Copyright 1999-2009 by Rocco Caputo. All rights are reserved. POE::Component::Client::DNS is free software; you may redistribute it and/or modify it under the same terms as Perl itself. Postback arguments were contributed by tag. =cut POE-Component-Client-DNS-1.051/Makefile.PL0000644000076500000240000000161411265273276016562 0ustar trocstaff#!/usr/bin/perl use ExtUtils::MakeMaker; # Touch CHANGES so it exists. open(CHANGES, ">>CHANGES") and close CHANGES; WriteMakefile( NAME => 'POE::Component::Client::DNS', AUTHOR => 'Rocco Caputo ', ABSTRACT => 'Non-blocking/concurrent DNS queries using Net::DNS and POE', LICENSE => 'perl', VERSION_FROM => 'lib/POE/Component/Client/DNS.pm', PREREQ_PM => { 'POE' => 1.280, 'Net::DNS' => 0.59, 'Test::More' => 0, 'Test::NoWarnings' => 0.084, }, META_ADD => { resources => { license => 'http://dev.perl.org/licenses/', repository => 'http://github.com/rcaputo/poe-component-client-dns', }, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', PREOP => ( 'git-log.pl | tee ./$(DISTNAME)-$(VERSION)/CHANGES > ./CHANGES' ), }, ); POE-Component-Client-DNS-1.051/MANIFEST0000644000076500000240000000036311265274413015733 0ustar trocstaffCHANGES MANIFEST Makefile.PL README lib/POE/Component/Client/DNS.pm t/00_info.t t/01_resolve.t t/02_tag_args.t t/03_api_3.t t/04_errors.t t/05_api_4.t t/06_hosts.t META.yml Module meta-data (added by MakeMaker) POE-Component-Client-DNS-1.051/META.yml0000600000076500000240000000144311265274412016042 0ustar trocstaff--- #YAML:1.0 name: POE-Component-Client-DNS version: 1.051 abstract: Non-blocking/concurrent DNS queries using Net::DNS and POE author: - Rocco Caputo license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Net::DNS: 0.59 POE: 1.28 Test::More: 0 Test::NoWarnings: 0.084 resources: license: http://dev.perl.org/licenses/ repository: http://github.com/rcaputo/poe-component-client-dns no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.54 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 POE-Component-Client-DNS-1.051/README0000644000076500000240000000362211253355471015464 0ustar trocstaff-------- Abstract -------- POE::Component::Client::DNS is an event driven wrapper for Net::DNS::Resolver. It accepts events containing Net::DNS::Resolver questions, and it emits events carrying Net::DNS::Packet responses. ------------ Requirements ------------ POE::Component::Client::DNS requires a functioning name server. Transient network problems (or testing the module from a disconnected machine) may cause it to fail. This module requires POE and Net::DNS. Installing it with the CPAN shell should cause it to do the right thing with regards to these dependencies. ------------------ Basic Installation ------------------ POE::Component::Client::DNS may be installed through the CPAN shell in the usual manner. Typically: $ perl -MCPAN -e 'intstall POE::Component::Client::DNS' You can also read this README from the CPAN shell: $ perl -MCPAN -e shell cpan> readme POE::Component::Client::DNS And you can install the component from the CPAN prompt as well: cpan> install POE::Component::Client::DNS ------------------- Manual Installation ------------------- This module may also be installed manually. Its distribution is available from the author's CPAN directory, , or a similarly named directory at your favorite CPAN mirror. Downloading and unpacking the distribution are left as exercises for the reader. To build and test it: perl Makefile.PL make test The test program, t/01_resolve.t, makes an excellent sample program. In fact, it was adapted from the sample program used to debug this component. If you would like to see more details about the test's operation, edit t/01_resolve.t and set the DEBUG constant to any value Perl considers "true". When you're ready to install the component: make install It should now be ready to use. Thanks for reading! -- Rocco Caputo / troc@netrus.net / poe.perl.org / poe.sourceforge.net POE-Component-Client-DNS-1.051/t/0000700000076500000240000000000011265274412015030 5ustar trocstaffPOE-Component-Client-DNS-1.051/t/00_info.t0000644000076500000240000000062111264775227016471 0ustar trocstaff#!/usr/bin/perl # vim: ts=2 sw=2 filetype=perl expandtab use warnings; use strict; use Test::More tests => 2; use_ok('POE'); use_ok('POE::Component::Client::DNS'); # idea from Test::Harness, thanks! diag("Testing Perl $], $^X on $^O"); diag("Testing POE $POE::VERSION"); diag("Testing Net::DNS $Net::DNS::VERSION"); diag("Testing POE::Component::Client::DNS $POE::Component::Client::DNS::VERSION"); POE-Component-Client-DNS-1.051/t/01_resolve.t0000644000076500000240000001172211253355475017217 0ustar trocstaff#!/usr/bin/perl -w use strict; use lib '/home/troc/perl/poe'; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE qw(Component::Client::DNS); use Test::More tests => 4; use Test::NoWarnings; sub DNS_TIMEOUT () { 3 }; sub DEBUG () { 0 }; #------------------------------------------------------------------------------ # A bunch of hostnames to resolve. my @hostnames = qw( altavista.com google.com yahoo.com 127.0.0.1 10.0.0.25 localhost poe.dynodns.net poe.perl.org poe.whee efnet.demon.co.uk efnet.telstra.net.au irc.Prison.NET irc.best.net irc.ced.chalmers.se irc.colorado.edu irc.concentric.net irc.core.com irc.du.se irc.east.gblx.net irc.ef.net irc.emory.edu irc.enitel.no irc.etsmtl.ca irc.exodus.net irc.fasti.net irc.freei.net irc.gigabell.de irc.homelien.no irc.ins.net.uk irc.inter.net.il irc.lagged.org irc.lightning.net irc.magic.ca irc.mcs.net irc.mindspring.com irc.mpl.net irc.plur.net irc.powersurfr.com irc.rt.ru irc.skynetweb.com irc.stanford.edu irc.total.net irc.umich.edu irc.umn.edu irc.west.gblx.net irc2.home.com poe.dynodns.net poe.perl.org ); #------------------------------------------------------------------------------ # This session uses the resolver component to resolve things. sub client_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; # We should not hang even if we have an alias. $kernel->alias_set("oh, something"); # Response types. $heap->{answers} = 0; $heap->{timeouts} = 0; $heap->{no_answers} = 0; $heap->{errors} = 0; # Response record types. $heap->{a_records} = 0; $heap->{mx_records} = 0; $heap->{cname_records} = 0; $heap->{other_records} = 0; # Post a bunch of requests all at once. I have seen this fail with # more than 16 requests. foreach my $hostname (@hostnames) { $kernel->post( 'resolver', # Post the request to the 'resolver'. 'resolve', # Ask it to 'resolve' an address. 'response', # Have it post a reply to my 'response' state. $hostname, # This is the host we are asking about. 'ANY', # This is the list of records we want. ); } DEBUG and warn "client started...\n"; # Start time to make sure the resolver's working in parallel. $heap->{start_time} = time(); } sub client_got_response { my $heap = $_[HEAP]; my $request_address = $_[ARG0]->[0]; my ($net_dns_packet, $net_dns_resolver_errorstring) = @{$_[ARG1]}; unless (defined $net_dns_packet) { DEBUG and warn sprintf( "%25s (%-10.10s) %s\n", $request_address, 'error', $net_dns_resolver_errorstring ); if ($net_dns_resolver_errorstring eq 'timeout') { $heap->{timeouts}++; } else { $heap->{errors}++; } return; } my @answers = $net_dns_packet->answer; unless (@answers) { DEBUG and warn sprintf( "%25s (%-10.10s) %s\n", $request_address, '...none...', 'no resolver response' ); $heap->{no_answers}++; return; } $heap->{answers}++; foreach (@answers) { my $response_data_string = $_->rdatastr; my $response_data_type = $_->type; DEBUG and warn sprintf( "%25s (%-10.10s) %-s\n", $request_address, $_->type, $response_data_string ); if ($response_data_type eq 'A') { $heap->{a_records}++; } elsif ($response_data_type eq 'MX') { $heap->{mx_records}++; } elsif ($response_data_type eq 'CNAME') { $heap->{cname_records}++; } else { $heap->{other_records}++; } } } sub client_stop { my $heap = $_[HEAP]; if (DEBUG) { warn "answers : $heap->{answers}\n"; warn "timeouts : $heap->{timeouts}\n"; warn "no answers : $heap->{no_answers}\n"; warn "errors : $heap->{errors}\n"; warn "a records : $heap->{a_records}\n"; warn "mx records : $heap->{mx_records}\n"; warn "cname records: $heap->{cname_records}\n"; warn "other records: $heap->{other_records}\n"; } is( $heap->{answers} + $heap->{no_answers} + $heap->{timeouts} + $heap->{errors}, scalar(@hostnames), "expected number of outcomes" ); ok( $heap->{a_records} + $heap->{mx_records} + $heap->{cname_records} + $heap->{other_records} >= $heap->{answers}, "got enough records" ); # Cut some slack for people running on really really slow systems. ok( time() - $heap->{start_time} < (DNS_TIMEOUT * @hostnames) / 2, "tests ran sufficiently quickly" ); DEBUG and warn "client stopped...\n"; } #------------------------------------------------------------------------------ # Create a resolver component. POE::Component::Client::DNS->spawn( Alias => 'resolver', # This is the name it'll be know by. Timeout => DNS_TIMEOUT, # This is the query timeout. ); # Create a session that will use the resolver. POE::Session->create( inline_states => { _start => \&client_start, _stop => \&client_stop, response => \&client_got_response, } ); # Run it all until done. $poe_kernel->run(); exit; POE-Component-Client-DNS-1.051/t/02_tag_args.t0000644000076500000240000000120411253354715017316 0ustar trocstaff#!/usr/bin/perl -w # tag@cpan.org use strict; use POE qw(Component::Client::DNS); use Data::Dumper; use Test::More tests => 5; use Test::NoWarnings; my $reverse = "127.0.0.1"; POE::Component::Client::DNS->spawn( Alias => 'named', Timeout => 5, ); POE::Session->create( inline_states => { _start => sub { for (1..4) { $_[KERNEL]->post( named => resolve => [ reverse => "TEST WORKED" ] => $reverse, 'PTR' ); } }, _stop => sub { }, # for asserts reverse => sub { is( $_[ARG0][3], "TEST WORKED", "test worked" ); }, } ); POE::Kernel->run; exit 0; POE-Component-Client-DNS-1.051/t/03_api_3.t0000644000076500000240000000266311253355503016531 0ustar trocstaff#!/usr/bin/perl -w # vim: filetype=perl # Test the version 3 API. use strict; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE qw(Component::Client::DNS); use Test::More tests => 5; use Test::NoWarnings; POE::Component::Client::DNS->spawn( Alias => 'named', Timeout => 5, ); POE::Session->create( inline_states => { _start => \&start_tests, response => \&got_response, _stop => sub { }, # avoid assert problems } ); POE::Kernel->run(); exit; sub start_tests { my $request = 1; # Default IN A. Override timeout. $_[KERNEL]->post( named => resolve => { event => "response", host => "localhost", context => $request++, timeout => 30, }, ); # Default IN A. Not found in /etc/hosts. $_[KERNEL]->post( named => resolve => { event => "response", host => "google.com", context => $request++, timeout => 30, }, ); # IN PTR $_[KERNEL]->post( named => resolve => { event => "response", host => "127.0.0.1", class => "IN", type => "PTR", context => $request++, }, ); # Small timeout. $_[KERNEL]->post( named => resolve => { event => "response", host => "google.com", context => $request++, timeout => 0.001, }, ); } sub got_response { my ($request, $response) = @_[ARG0, ARG1]; ok($request->{context}, "got response $request->{context}"); } POE-Component-Client-DNS-1.051/t/04_errors.t0000644000076500000240000000364311253355506017055 0ustar trocstaff#!/usr/bin/perl -w # vim: filetype=perl # Deliberately trigger errors. use strict; sub POE::Kernel::CATCH_EXCEPTIONS () { 0 } use POE qw(Component::Client::DNS); use Test::More tests => 10; use Test::NoWarnings; # Avoid a warning. POE::Kernel->run(); { eval { POE::Component::Client::DNS->spawn(1); }; my $err = $@; $err =~ s/ at \S+ line \d+.*//s; is( $err, "POE::Component::Client::DNS requires an even number of parameters" ); } { eval { POE::Component::Client::DNS->spawn(moo => "nope"); }; my $err = $@; $err =~ s/ at \S+ line \d+.*//s; is( $err, "POE::Component::Client::DNS doesn't know these parameters: moo" ); } my $resolver = POE::Component::Client::DNS->spawn(); { eval { $poe_kernel->call( "resolver", "resolve", { } ); }; my $err = $@; $err =~ s/ at \S+ line \d+.*//s; is($err, "Must include an 'event' in Client::DNS request"); } { eval { $poe_kernel->call( "resolver", "resolve", { event => "moo", } ); }; my $err = $@; $err =~ s/ at \S+ line \d+.*//s; is($err, "Must include a 'context' in Client::DNS request"); } { eval { $poe_kernel->call( "resolver", "resolve", { event => "moo", context => "bar", } ); }; my $err = $@; $err =~ s/ at \S+ line \d+.*//s; is($err, "Must include a 'host' in Client::DNS request"); } { eval { $resolver->resolve(1); }; my $err = $@; $err =~ s/ at \S+ line \d+.*//s; is($err, "resolve() needs an even number of parameters"); } { eval { $resolver->resolve(); }; my $err = $@; $err =~ s/ at \S+ line \d+.*//s; is($err, "resolve() must include an 'event'"); } { eval { $resolver->resolve( event => "moo", ); }; my $err = $@; $err =~ s/ at \S+ line \d+.*//s; is($err, "resolve() must include a 'context'"); } { eval { $resolver->resolve( event => "moo", context => "bar", ); }; my $err = $@; $err =~ s/ at \S+ line \d+.*//s; is($err, "resolve() must include a 'host'"); } exit; POE-Component-Client-DNS-1.051/t/05_api_4.t0000644000076500000240000000244411253355511016530 0ustar trocstaff#!/usr/bin/perl -w # vim: filetype=perl # Test the version 3 API. use strict; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE qw(Component::Client::DNS); use Test::More tests => 5; use Test::NoWarnings; my $resolver = POE::Component::Client::DNS->spawn( Alias => 'named', Timeout => 5, ); POE::Session->create( inline_states => { _start => \&start_tests, _stop => sub { }, # avoid assert problems response => \&got_response, } ); POE::Kernel->run(); exit; sub start_tests { my $request = 1; # Default IN A. Override timeout. $resolver->resolve( event => "response", host => "localhost", context => $request++, timeout => 30, ); # Default IN A. Not found in /etc/hosts. $resolver->resolve( event => "response", host => "google.com", context => $request++, timeout => 30, ); # IN PTR $resolver->resolve( event => "response", host => "127.0.0.1", class => "IN", type => "PTR", context => $request++, ); # Small timeout. $resolver->resolve( event => "response", host => "google.com", context => $request++, timeout => 0.001, ); } sub got_response { my ($request, $response) = @_[ARG0, ARG1]; ok($request->{context}, "got response $request->{context}"); } POE-Component-Client-DNS-1.051/t/06_hosts.t0000644000076500000240000000700011253355515016672 0ustar trocstaff#!/usr/bin/perl # vim: filetype=perl # Test the hosts file stuff. use warnings; use strict; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE qw(Component::Client::DNS); use Test::More tests => 5; use Test::NoWarnings; require Net::DNS; my $can_resolve = Net::DNS::Resolver->new->search("poe.perl.org"); my %target_address; if ($can_resolve) { foreach ($can_resolve->answer()) { $target_address{$_->address} = 1 if $_->type eq "A"; } } use constant HOSTS_FILE => "./test-hosts"; my $resolver = POE::Component::Client::DNS->spawn( Alias => 'named', Timeout => 15, HostsFile => HOSTS_FILE, ); POE::Session->create( inline_states => { _start => \&start_tests, _stop => sub { }, # avoid assert problems response_no_hosts => \&response_no_hosts, response_hosts_match_v4 => \&response_hosts_match_v4, response_hosts_match_v6 => \&response_hosts_match_v6, response_hosts_nomatch => \&response_hosts_nomatch, } ); POE::Kernel->run(); exit; sub start_tests { # 1. Test without a hosts file. unlink HOSTS_FILE; $resolver->resolve( event => "response_no_hosts", host => "poe.perl.org", context => "whatever", ); } sub response_no_hosts { my $response = $_[ARG0]; my $address = a_data($response); SKIP: { skip "Can't resolve with Net::DNS, network probably not available", 1 unless($can_resolve); ok( exists $target_address{$address}, "lookup with no hosts file ($address)" ); } # 2. Test with a hosts file that contains a host match. unlink HOSTS_FILE; # Changes inode! open(HF, ">" . HOSTS_FILE) or die "couldn't write hosts file: $!"; print HF "123.45.67.89 poe.perl.org\n"; print HF "::1 hocallost\n"; close HF; $resolver->resolve( event => "response_hosts_match_v4", host => "poe.perl.org", context => "whatever", ); } sub response_hosts_match_v4 { my $response = $_[ARG0]; my $address = a_data($response); ok( $address eq "123.45.67.89", "lookup when hosts file matches ($address)" ); $resolver->resolve( event => "response_hosts_match_v6", host => "hocallost", context => "whatever", type => "AAAA", ); } sub response_hosts_match_v6 { my $response = $_[ARG0]; my $address = aaaa_data($response); ok( ($address eq "0:0:0:0:0:0:0:1" or $address eq "::1"), "ipv6 lookup when hosts file matches ($address)" ); # 3. Test against a hosts file without a host match. unlink HOSTS_FILE; # Changes inode! open(HF, ">" . HOSTS_FILE) or die "couldn't write hosts file: $!"; print HF "123.456.789.012 narf.barf.warf\n"; close HF; $resolver->resolve( event => "response_hosts_nomatch", host => "poe.perl.org", context => "whatever", ); } sub response_hosts_nomatch { my $response = $_[ARG0]; my $address = a_data($response); SKIP: { skip "Can't resolve with Net::DNS, network probably not available", 1 unless($can_resolve); ok( exists $target_address{$address}, "lookup with hosts file but no match ($address)" ); } unlink HOSTS_FILE; } ### Not POE event handlers. sub a_data { my $response = shift; return "" unless defined $response->{response}; return ( grep { ref() eq "Net::DNS::RR::A" } $response->{response}->answer() )[0]->rdatastr(); } sub aaaa_data { my $response = shift; return "" unless defined $response->{response}; return ( grep { ref() eq "Net::DNS::RR::AAAA" } $response->{response}->answer() )[0]->rdatastr(); }