1package POE::Filter::DNS::TCP; 2$POE::Filter::DNS::TCP::VERSION = '0.06'; 3#ABSTRACT: A POE Filter to handle DNS over TCP connections 4 5use strict; 6use warnings; 7use Net::DNS; 8use Net::DNS::Packet; 9 10use base 'POE::Filter'; 11 12use bytes; 13 14sub FRAMING_BUFFER () { 0 } 15sub EXPECTED_SIZE () { 1 } 16sub INT16SZ () { 2 } 17 18sub new { 19 my $class = shift; 20 my $self = bless [ 21 '', # FRAMING_BUFFER 22 undef, # EXPECTED_SIZE 23 ], $class; 24 return $self; 25} 26 27sub get_one_start { 28 my ($self, $stream) = @_; 29 $self->[FRAMING_BUFFER] .= join '', @$stream; 30} 31 32sub get_one { 33 my $self = shift; 34 35 if ( 36 defined($self->[EXPECTED_SIZE]) || 37 defined( 38 $self->[EXPECTED_SIZE] = _decoder(\$self->[FRAMING_BUFFER]) 39 ) 40 ) { 41 return [ ] if length($self->[FRAMING_BUFFER]) < $self->[EXPECTED_SIZE]; 42 43 # Four-arg substr() would be better here, but it's not compatible 44 # with Perl as far back as we support. 45 my $block = substr($self->[FRAMING_BUFFER], 0, $self->[EXPECTED_SIZE]); 46 substr($self->[FRAMING_BUFFER], 0, $self->[EXPECTED_SIZE]) = ''; 47 $self->[EXPECTED_SIZE] = undef; 48 49 if ( my $packet = Net::DNS::Packet->new( \$block ) ) { 50 return [ $packet ]; 51 } 52 warn "Could not parse DNS packet\n"; 53 } 54 55 return []; 56} 57 58sub _decoder { 59 my $data = shift; 60 my $buf = substr $$data, 0, INT16SZ; 61 return unless length $buf; 62 my ($len) = unpack 'n', $buf; 63 return unless $len; 64 substr $$data, 0, INT16SZ, ''; 65 return $len; 66} 67 68sub get_pending { 69 my $self = shift; 70 return $self->[FRAMING_BUFFER]; 71} 72 73sub put { 74 my $self = shift; 75 my $packets = shift; 76 my @blocks; 77 foreach my $packet (@$packets) { 78 next unless eval { $packet->isa('Net::DNS::Packet'); }; 79 $packet->{buffer} = ''; 80 my $packet_data = $packet->data; 81 my $lenmsg = pack( 'n', length $packet_data ); 82 push @blocks, $lenmsg . $packet_data; 83 } 84 return \@blocks; 85} 86 87q[You know like, in'it]; 88 89__END__ 90 91=pod 92 93=encoding UTF-8 94 95=head1 NAME 96 97POE::Filter::DNS::TCP - A POE Filter to handle DNS over TCP connections 98 99=head1 VERSION 100 101version 0.06 102 103=head1 SYNOPSIS 104 105 use POE::Filter::DNS::TCP; 106 107 my $filter = POE::Filter::DNS::TCP->new(); 108 my $arrayref_of_net_dns_objects = $filter->get( [ $dns_stream ] ); 109 my $arrayref_of_streamed_dns_pckts = $filter->put( $arrayref_of_net_dns_objects ); 110 111=head1 DESCRIPTION 112 113POE::Filter::DNS::TCP is a L<POE::Filter> for parsing and generating DNS messages 114received from or transmitted (respectively) over TCP as per RFC 1035. 115 116=for Pod::Coverage FRAMING_BUFFER 117 EXPECTED_SIZE 118 INT16SZ 119 120=head1 CONSTRUCTOR 121 122=over 123 124=item C<new> 125 126Creates a new POE::Filter::DNS::TCP object. 127 128=back 129 130=head1 METHODS 131 132=over 133 134=item C<get> 135 136=item C<get_one_start> 137 138=item C<get_one> 139 140Takes an arrayref which is contains streams of raw TCP DNS packets. 141Returns an arrayref of L<Net::DNS::Packet> objects. 142 143=item C<put> 144 145Takes an arrayref of L<Net::DNS::Packet> objects. 146Returns an arrayref of raw TCP DNS packets. 147 148=item C<clone> 149 150Makes a copy of the filter, and clears the copy's buffer. 151 152=back 153 154=head1 AUTHORS 155 156=over 4 157 158=item * 159 160Chris Williams <chris@bingosnet.co.uk> 161 162=item * 163 164Hans Dieter Pearcey <hdp@cpan.org> 165 166=item * 167 168Rocco Caputo <rcaputo@cpan.org> 169 170=back 171 172=head1 COPYRIGHT AND LICENSE 173 174This software is copyright (c) 2014 by Chris Williams, Hans Dieter Pearcey and Rocco Caputo. 175 176This is free software; you can redistribute it and/or modify it under 177the same terms as the Perl 5 programming language system itself. 178 179=cut 180