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