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