relocate repo files so ND2 is the only code
This commit is contained in:
Oliver Gorwits
280
lib/App/Netdisco/AnyEvent/Nbtstat.pm
Normal file
280
lib/App/Netdisco/AnyEvent/Nbtstat.pm
Normal file
@@ -0,0 +1,280 @@
|
||||
package App::Netdisco::AnyEvent::Nbtstat;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Socket qw(AF_INET SOCK_DGRAM inet_aton sockaddr_in);
|
||||
use List::Util ();
|
||||
use Carp ();
|
||||
|
||||
use AnyEvent (); BEGIN { AnyEvent::common_sense }
|
||||
use AnyEvent::Util ();
|
||||
|
||||
sub new {
|
||||
my ( $class, %args ) = @_;
|
||||
|
||||
my $interval = $args{interval};
|
||||
# This default should generate ~ 50 requests per second
|
||||
$interval = 0.2 unless defined $interval;
|
||||
|
||||
my $timeout = $args{timeout};
|
||||
|
||||
# Timeout should be 250ms according to RFC1002, but we're going to double
|
||||
$timeout = 0.5 unless defined $timeout;
|
||||
|
||||
my $self = bless { interval => $interval, timeout => $timeout, %args },
|
||||
$class;
|
||||
|
||||
Scalar::Util::weaken( my $wself = $self );
|
||||
|
||||
socket my $fh4, AF_INET, Socket::SOCK_DGRAM(), 0
|
||||
or Carp::croak "Unable to create socket : $!";
|
||||
|
||||
AnyEvent::Util::fh_nonblocking $fh4, 1;
|
||||
$self->{fh4} = $fh4;
|
||||
$self->{rw4} = AE::io $fh4, 0, sub {
|
||||
if ( my $peer = recv $fh4, my $resp, 2048, 0 ) {
|
||||
$wself->_on_read( $resp, $peer );
|
||||
}
|
||||
};
|
||||
|
||||
# Nbtstat tasks
|
||||
$self->{_tasks} = {};
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub interval { @_ > 1 ? $_[0]->{interval} = $_[1] : $_[0]->{interval} }
|
||||
|
||||
sub timeout { @_ > 1 ? $_[0]->{timeout} = $_[1] : $_[0]->{timeout} }
|
||||
|
||||
sub nbtstat {
|
||||
my ( $self, $host, $cb ) = @_;
|
||||
|
||||
my $ip = inet_aton($host);
|
||||
my $port = 137;
|
||||
|
||||
my $request = {
|
||||
host => $host,
|
||||
results => {},
|
||||
cb => $cb,
|
||||
destination => scalar sockaddr_in( $port, $ip ),
|
||||
};
|
||||
|
||||
$self->{_tasks}{ $request->{destination} } = $request;
|
||||
|
||||
my $delay = $self->interval * scalar keys %{ $self->{_tasks} || {} };
|
||||
|
||||
# There's probably a better way to throttle the sends
|
||||
# but this will work for now since we currently don't support retries
|
||||
my $w; $w = AE::timer $delay, 0, sub {
|
||||
undef $w;
|
||||
$self->_send_request($request);
|
||||
};
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub _on_read {
|
||||
my ( $self, $resp, $peer ) = @_;
|
||||
|
||||
($resp) = $resp =~ /^(.*)$/s
|
||||
if AnyEvent::TAINT && $self->{untaint};
|
||||
|
||||
# Find our task
|
||||
my $request = $self->{_tasks}{$peer};
|
||||
|
||||
return unless $request;
|
||||
|
||||
$self->_store_result( $request, 'OK', $resp );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _store_result {
|
||||
my ( $self, $request, $status, $resp ) = @_;
|
||||
|
||||
my $results = $request->{results};
|
||||
|
||||
my @rr = ();
|
||||
my $mac_address = "";
|
||||
|
||||
if ( $status eq 'OK' && length($resp) > 56 ) {
|
||||
my $num_names = unpack( "C", substr( $resp, 56 ) );
|
||||
my $name_data = substr( $resp, 57 );
|
||||
|
||||
for ( my $i = 0; $i < $num_names; $i++ ) {
|
||||
my $rr_data = substr( $name_data, 18 * $i, 18 );
|
||||
push @rr, _decode_rr($rr_data);
|
||||
}
|
||||
|
||||
$mac_address = join "-",
|
||||
map { sprintf "%02X", $_ }
|
||||
unpack( "C*", substr( $name_data, 18 * $num_names, 6 ) );
|
||||
$results = {
|
||||
'status' => 'OK',
|
||||
'names' => \@rr,
|
||||
'mac_address' => $mac_address
|
||||
};
|
||||
}
|
||||
elsif ( $status eq 'OK' ) {
|
||||
$results = { 'status' => 'SHORT' };
|
||||
}
|
||||
else {
|
||||
$results = { 'status' => $status };
|
||||
}
|
||||
|
||||
# Clear request specific data
|
||||
delete $request->{timer};
|
||||
|
||||
# Cleanup
|
||||
delete $self->{_tasks}{ $request->{destination} };
|
||||
|
||||
# Done
|
||||
$request->{cb}->($results);
|
||||
|
||||
undef $request;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _send_request {
|
||||
my ( $self, $request ) = @_;
|
||||
|
||||
my $msg = "";
|
||||
# We use process id as identifier field, since don't have a need to
|
||||
# unique responses beyond host / port queried
|
||||
$msg .= pack( "n*", $$, 0, 1, 0, 0, 0 );
|
||||
$msg .= _encode_name( "*", "\x00", 0 );
|
||||
$msg .= pack( "n*", 0x21, 0x0001 );
|
||||
|
||||
$request->{start} = time;
|
||||
|
||||
$request->{timer} = AE::timer $self->timeout, 0, sub {
|
||||
$self->_store_result( $request, 'TIMEOUT' );
|
||||
};
|
||||
|
||||
my $fh = $self->{fh4};
|
||||
|
||||
send $fh, $msg, 0, $request->{destination}
|
||||
or $self->_store_result( $request, 'ERROR' );
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _encode_name {
|
||||
my $name = uc(shift);
|
||||
my $pad = shift || "\x20";
|
||||
my $suffix = shift || 0x00;
|
||||
|
||||
$name .= $pad x ( 16 - length($name) );
|
||||
substr( $name, 15, 1, chr( $suffix & 0xFF ) );
|
||||
|
||||
my $encoded_name = "";
|
||||
for my $c ( unpack( "C16", $name ) ) {
|
||||
$encoded_name .= chr( ord('A') + ( ( $c & 0xF0 ) >> 4 ) );
|
||||
$encoded_name .= chr( ord('A') + ( $c & 0xF ) );
|
||||
}
|
||||
|
||||
# Note that the _encode_name function doesn't add any scope,
|
||||
# nor does it calculate the length (32), it just prefixes it
|
||||
return "\x20" . $encoded_name . "\x00";
|
||||
}
|
||||
|
||||
sub _decode_rr {
|
||||
my $rr_data = shift;
|
||||
|
||||
my @nodetypes = qw/B-node P-node M-node H-node/;
|
||||
my ( $name, $suffix, $flags ) = unpack( "a15Cn", $rr_data );
|
||||
$name =~ tr/\x00-\x19/\./; # replace ctrl chars with "."
|
||||
$name =~ s/\s+//g;
|
||||
|
||||
my $rr = {};
|
||||
$rr->{'name'} = $name;
|
||||
$rr->{'suffix'} = $suffix;
|
||||
$rr->{'G'} = ( $flags & 2**15 ) ? "GROUP" : "UNIQUE";
|
||||
$rr->{'ONT'} = $nodetypes[ ( $flags >> 13 ) & 3 ];
|
||||
$rr->{'DRG'} = ( $flags & 2**12 ) ? "Deregistering" : "Registered";
|
||||
$rr->{'CNF'} = ( $flags & 2**11 ) ? "Conflict" : "";
|
||||
$rr->{'ACT'} = ( $flags & 2**10 ) ? "Active" : "Inactive";
|
||||
$rr->{'PRM'} = ( $flags & 2**9 ) ? "Permanent" : "";
|
||||
|
||||
return $rr;
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
App::Netdisco::AnyEvent::Nbtstat - Request NetBIOS node status with AnyEvent
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use App::Netdisco::AnyEvent::Nbtstat;;
|
||||
|
||||
my $request = App::Netdisco::AnyEvent::Nbtstat->new();
|
||||
|
||||
my $cv = AE::cv;
|
||||
|
||||
$request->nbtstat(
|
||||
'127.0.0.1',
|
||||
sub {
|
||||
my $result = shift;
|
||||
print "MAC: ", $result->{'mac_address'} || '', " ";
|
||||
print "Status: ", $result->{'status'}, "\n";
|
||||
printf '%3s %-18s %4s %-18s', '', 'Name', '', 'Type'
|
||||
if ( $result->{'status'} eq 'OK' );
|
||||
print "\n";
|
||||
for my $rr ( @{ $result->{'names'} } ) {
|
||||
printf '%3s %-18s <%02s> %-18s', '', $rr->{'name'},
|
||||
$rr->{'suffix'},
|
||||
$rr->{'G'};
|
||||
print "\n";
|
||||
}
|
||||
$cv->send;
|
||||
}
|
||||
);
|
||||
|
||||
$cv->recv;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
L<App::Netdisco::AnyEvent::Nbtstat> is an asynchronous AnyEvent NetBIOS node
|
||||
status requester.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
L<App::Netdisco::AnyEvent::Nbtstat> implements the following attributes.
|
||||
|
||||
=head2 C<interval>
|
||||
|
||||
my $interval = $request->interval;
|
||||
$request->interval(1);
|
||||
|
||||
Interval between requests, defaults to 0.02 seconds.
|
||||
|
||||
=head2 C<timeout>
|
||||
|
||||
my $timeout = $request->timeout;
|
||||
$request->timeout(2);
|
||||
|
||||
Maximum request response time, defaults to 0.5 seconds.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
L<App::Netdisco::AnyEvent::Nbtstat> implements the following methods.
|
||||
|
||||
=head2 C<nbtstat>
|
||||
|
||||
$request->nbtstat($ip, sub {
|
||||
my $result = shift;
|
||||
});
|
||||
|
||||
Perform a NetBIOS node status request of $ip.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<AnyEvent>
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user