1package App::Netdisco::AnyEvent::Nbtstat;
2
3use strict;
4use warnings;
5
6use Socket qw(AF_INET SOCK_DGRAM inet_aton sockaddr_in);
7use List::Util ();
8use Carp       ();
9
10use AnyEvent (); BEGIN { AnyEvent::common_sense }
11use AnyEvent::Util ();
12
13sub new {
14    my ( $class, %args ) = @_;
15
16    my $interval = $args{interval};
17    # This default should generate ~ 50 requests per second
18    $interval = 0.2 unless defined $interval;
19
20    my $timeout = $args{timeout};
21
22    # Timeout should be 250ms according to RFC1002, but we're going to double
23    $timeout = 0.5 unless defined $timeout;
24
25    my $self = bless { interval => $interval, timeout => $timeout, %args },
26        $class;
27
28    Scalar::Util::weaken( my $wself = $self );
29
30    socket my $fh4, AF_INET, Socket::SOCK_DGRAM(), 0
31        or Carp::croak "Unable to create socket : $!";
32
33    AnyEvent::Util::fh_nonblocking $fh4, 1;
34    $self->{fh4} = $fh4;
35    $self->{rw4} = AE::io $fh4, 0, sub {
36        if ( my $peer = recv $fh4, my $resp, 2048, 0 ) {
37            $wself->_on_read( $resp, $peer );
38        }
39    };
40
41    # Nbtstat tasks
42    $self->{_tasks} = {};
43
44    return $self;
45}
46
47sub interval { @_ > 1 ? $_[0]->{interval} = $_[1] : $_[0]->{interval} }
48
49sub timeout { @_ > 1 ? $_[0]->{timeout} = $_[1] : $_[0]->{timeout} }
50
51sub nbtstat {
52    my ( $self, $host, $cb ) = @_;
53
54    my $ip   = inet_aton($host);
55    my $port = 137;
56
57    my $request = {
58        host        => $host,
59        results     => {},
60        cb          => $cb,
61        destination => scalar sockaddr_in( $port, $ip ),
62    };
63
64    $self->{_tasks}{ $request->{destination} } = $request;
65
66    my $delay = $self->interval * scalar keys %{ $self->{_tasks} || {} };
67
68    # There's probably a better way to throttle the sends
69    # but this will work for now since we currently don't support retries
70    my $w; $w = AE::timer $delay, 0, sub {
71        undef $w;
72        $self->_send_request($request);
73    };
74
75    return $self;
76}
77
78sub _on_read {
79    my ( $self, $resp, $peer ) = @_;
80
81    ($resp) = $resp =~ /^(.*)$/s
82        if AnyEvent::TAINT && $self->{untaint};
83
84    # Find our task
85    my $request = $self->{_tasks}{$peer};
86
87    return unless $request;
88
89    $self->_store_result( $request, 'OK', $resp );
90
91    return;
92}
93
94sub _store_result {
95    my ( $self, $request, $status, $resp ) = @_;
96
97    my $results = $request->{results};
98
99    my @rr          = ();
100    my $mac_address = "";
101
102    if ( $status eq 'OK' && length($resp) > 56 ) {
103        my $num_names = unpack( "C", substr( $resp, 56 ) );
104        my $name_data = substr( $resp, 57 );
105
106        for ( my $i = 0; $i < $num_names; $i++ ) {
107            my $rr_data = substr( $name_data, 18 * $i, 18 );
108            push @rr, _decode_rr($rr_data);
109        }
110
111        $mac_address = join "-",
112            map { sprintf "%02X", $_ }
113            unpack( "C*", substr( $name_data, 18 * $num_names, 6 ) );
114        $results = {
115            'status'      => 'OK',
116            'names'       => \@rr,
117            'mac_address' => $mac_address
118        };
119    }
120    elsif ( $status eq 'OK' ) {
121        $results = { 'status' => 'SHORT' };
122    }
123    else {
124        $results = { 'status' => $status };
125    }
126
127    # Clear request specific data
128    delete $request->{timer};
129
130    # Cleanup
131    delete $self->{_tasks}{ $request->{destination} };
132
133    # Done
134    $request->{cb}->($results);
135
136    undef $request;
137
138    return;
139}
140
141sub _send_request {
142    my ( $self, $request ) = @_;
143
144    my $msg = "";
145    # We use process id as identifier field, since don't have a need to
146    # unique responses beyond host / port queried
147    $msg .= pack( "n*", $$, 0, 1, 0, 0, 0 );
148    $msg .= _encode_name( "*", "\x00", 0 );
149    $msg .= pack( "n*", 0x21, 0x0001 );
150
151    $request->{start} = time;
152
153    $request->{timer} = AE::timer $self->timeout, 0, sub {
154        $self->_store_result( $request, 'TIMEOUT' );
155    };
156
157    my $fh = $self->{fh4};
158
159    send $fh, $msg, 0, $request->{destination}
160        or $self->_store_result( $request, 'ERROR' );
161
162    return;
163}
164
165sub _encode_name {
166    my $name   = uc(shift);
167    my $pad    = shift || "\x20";
168    my $suffix = shift || 0x00;
169
170    $name .= $pad x ( 16 - length($name) );
171    substr( $name, 15, 1, chr( $suffix & 0xFF ) );
172
173    my $encoded_name = "";
174    for my $c ( unpack( "C16", $name ) ) {
175        $encoded_name .= chr( ord('A') + ( ( $c & 0xF0 ) >> 4 ) );
176        $encoded_name .= chr( ord('A') + ( $c & 0xF ) );
177    }
178
179    # Note that the _encode_name function doesn't add any scope,
180    # nor does it calculate the length (32), it just prefixes it
181    return "\x20" . $encoded_name . "\x00";
182}
183
184sub _decode_rr {
185    my $rr_data = shift;
186
187    my @nodetypes = qw/B-node P-node M-node H-node/;
188    my ( $name, $suffix, $flags ) = unpack( "a15Cn", $rr_data );
189    $name =~ tr/\x00-\x19/\./;    # replace ctrl chars with "."
190    $name =~ s/\s+//g;
191
192    my $rr = {};
193    $rr->{'name'}   = $name;
194    $rr->{'suffix'} = $suffix;
195    $rr->{'G'}      = ( $flags & 2**15 ) ? "GROUP" : "UNIQUE";
196    $rr->{'ONT'}    = $nodetypes[ ( $flags >> 13 ) & 3 ];
197    $rr->{'DRG'}    = ( $flags & 2**12 ) ? "Deregistering" : "Registered";
198    $rr->{'CNF'}    = ( $flags & 2**11 ) ? "Conflict" : "";
199    $rr->{'ACT'}    = ( $flags & 2**10 ) ? "Active" : "Inactive";
200    $rr->{'PRM'}    = ( $flags & 2**9 ) ? "Permanent" : "";
201
202    return $rr;
203}
204
2051;
206__END__
207
208=head1 NAME
209
210App::Netdisco::AnyEvent::Nbtstat - Request NetBIOS node status with AnyEvent
211
212=head1 SYNOPSIS
213
214    use App::Netdisco::AnyEvent::Nbtstat;;
215
216    my $request = App::Netdisco::AnyEvent::Nbtstat->new();
217
218    my $cv = AE::cv;
219
220    $request->nbtstat(
221        '127.0.0.1',
222        sub {
223            my $result = shift;
224            print "MAC: ", $result->{'mac_address'} || '', " ";
225            print "Status: ", $result->{'status'}, "\n";
226            printf '%3s %-18s %4s %-18s', '', 'Name', '', 'Type'
227                if ( $result->{'status'} eq 'OK' );
228            print "\n";
229            for my $rr ( @{ $result->{'names'} } ) {
230                printf '%3s %-18s <%02s> %-18s', '', $rr->{'name'},
231                    $rr->{'suffix'},
232                    $rr->{'G'};
233                print "\n";
234            }
235            $cv->send;
236        }
237    );
238
239    $cv->recv;
240
241=head1 DESCRIPTION
242
243L<App::Netdisco::AnyEvent::Nbtstat> is an asynchronous AnyEvent NetBIOS node
244status requester.
245
246=head1 ATTRIBUTES
247
248L<App::Netdisco::AnyEvent::Nbtstat> implements the following attributes.
249
250=head2 C<interval>
251
252    my $interval = $request->interval;
253    $request->interval(1);
254
255Interval between requests, defaults to 0.02 seconds.
256
257=head2 C<timeout>
258
259    my $timeout = $request->timeout;
260    $request->timeout(2);
261
262Maximum request response time, defaults to 0.5 seconds.
263
264=head1 METHODS
265
266L<App::Netdisco::AnyEvent::Nbtstat> implements the following methods.
267
268=head2 C<nbtstat>
269
270    $request->nbtstat($ip, sub {
271        my $result = shift;
272    });
273
274Perform a NetBIOS node status request of $ip.
275
276=head1 SEE ALSO
277
278L<AnyEvent>
279
280=cut
281