Net-NBName-0.26/ 40777 0 0 0 10450056225 11436 5ustar usergroupNet-NBName-0.26/bin/ 40777 0 0 0 10450056224 12205 5ustar usergroupNet-NBName-0.26/bin/namequery.pl100666 0 0 1210 10011552336 14635 0ustar usergroupuse strict; use Net::NBName; my $nb = Net::NBName->new; my $param = shift; my $host = shift; if ($param =~ /^([\w-]+)\#(\w{1,2})$/) { my $name = $1; my $suffix = hex $2; my $nq; if (defined($host) && $host =~ /\d+\.\d+\.\d+\.\d+/) { printf "querying %s for %s<%02X>...\n", $host, $name, $suffix; $nq = $nb->name_query($host, $name, $suffix); } else { printf "broadcasting for %s<%02X>...\n", $name, $suffix; $nq = $nb->name_query(undef, $name, $suffix); } if ($nq) { print $nq->as_string; } } else { die "expected: # []\n"; } Net-NBName-0.26/bin/nodescan.pl100666 0 0 1416 10450054630 14432 0ustar usergroupuse Net::NBName; use Net::Netmask; $mask = shift or die "expected: \n"; $nb = Net::NBName->new; $subnet = Net::Netmask->new2($mask); for $ip ($subnet->enumerate) { print "$ip "; $ns = $nb->node_status($ip); if ($ns) { for my $rr ($ns->names) { if ($rr->suffix == 0 && $rr->G eq "GROUP") { $domain = $rr->name; } if ($rr->suffix == 3 && $rr->G eq "UNIQUE") { $user = $rr->name; } if ($rr->suffix == 0 && $rr->G eq "UNIQUE") { $machine = $rr->name unless $rr->name =~ /^IS~/; } } $mac_address = $ns->mac_address; print "$mac_address $domain\\$machine $user"; } print "\n"; } Net-NBName-0.26/bin/nodestat.pl100666 0 0 462 7601212356 14426 0ustar usergroupuse Net::NBName; my $nb = Net::NBName->new; my $host = shift; if (defined($host) && $host =~ /\d+\.\d+\.\d+\.\d+/) { my $ns = $nb->node_status($host); if ($ns) { print $ns->as_string; } else { print "no response\n"; } } else { die "expected: \n"; } Net-NBName-0.26/Changes100666 0 0 3546 10450055544 13041 0ustar usergroupRevision history for Net::NBName ================================ *** 0.26 2006-06-25 Updated the Net::NBName::NodeStatus constructor to handle truncated node status responses without generating warning messages. Thanks to both Stuart Kendrick and Max Baker for reporting this. I've added Max Baker's sample response packet to the 'decode.t' tests. Changed the "nodescan.pl" script to check that a mask has been supplied before attempting to create a Net::Netmask object. *** 0.25 2004-02-08 Added a timeout parameter to the node_status and name_query methods. Updated the documentation to describe the new parameter. Changed the example script "namequery.pl" to accept the - character in NetBIOS names. *** 0.24 2003-01-16 Changed the names of the example scripts "nbtstat.pl" and "nbtscan.pl" to "nodestat.pl" and "nodescan.pl". *** 0.23 2002-12-22 Changed the decoded Net::NBName::NameQuery flags to be 1 or 0, rather than just the masked value from the header word. Because the module is intended for querying NetBIOS hosts, a proper set of tests would require a known NetBIOS host. Unfortunately, there is no easy way of adding these to archives yet ;-) so I've added the 'decode.t' tests to check that Net::NBName::NodeStatus and Net::NBName::NameQuery decode sample responses correctly. *** 0.22 2002-12-21 Added the ->addresses accessor to Net::NBName::NameQuery and the ->address accessor to Net::NBName::NameQuery::RR. Fixed bug in Net::NBName::NameQuery::RR incorrectly decoding name query response resource records by changing unpack "nA4" to unpack "na4". Included the three example scripts in the documentation for installation in the scripts directory. *** 0.21 2002-12-09 Included a simple test so that 'make test' will work with this module. *** 0.20 2002-12-02 Public release. --- James Macfarlane Net-NBName-0.26/lib/ 40777 0 0 0 10450056224 12203 5ustar usergroupNet-NBName-0.26/lib/Net/ 40777 0 0 0 10450056224 12731 5ustar usergroupNet-NBName-0.26/lib/Net/NBName/ 40777 0 0 0 10450056224 14031 5ustar usergroupNet-NBName-0.26/lib/Net/NBName/NameQuery/ 40777 0 0 0 10450056224 15737 5ustar usergroupNet-NBName-0.26/lib/Net/NBName/NameQuery/RR.pm100666 0 0 3473 10447546006 16734 0ustar usergroupuse strict; use warnings; package Net::NBName::NameQuery::RR; use vars '$VERSION'; $VERSION = "0.26"; use vars '@nodetypes'; @nodetypes = qw/B-node P-node M-node H-node/; sub new { my $class = shift; my $nb_data = shift; my ($flags, $packed_address) = unpack("na4", $nb_data); my $address = join ".", unpack("C4", $packed_address); my $self = {}; $self->{'address'} = $address; $self->{'G'} = ($flags & 2**15) ? "GROUP" : "UNIQUE"; $self->{'ONT'} = $nodetypes[($flags >> 13) & 3]; bless $self, $class; return $self; } sub as_string { my $self = shift; return sprintf "%-15s %-6s %-6s\n", $self->{'address'}, $self->{'G'}, $self->{'ONT'}; } sub address { return $_[0]->{'address'}; } sub G { return $_[0]->{'G'}; } sub ONT { return $_[0]->{'ONT'}; } 1; __END__ =head1 NAME Net::NBName::NameQuery::RR - NetBIOS Name Query Response Resource Record =head1 DESCRIPTION Net::NBName::NameQuery::RR represents an ip address entry returned as part of a NetBIOS name query response. =head1 METHODS =over 4 =item $rr->address Returns the ip address as a dotted quad. =item $rr->G Group flag. Indicates whether the name is a unique or a group name. It is returned as a string: either "UNIQUE" or "GROUP" will be returned. =item $rr->ONT Owner Node Type flag. Indicates if the systems are B, P, H, or M-node. It will be returned as a string. =item $rr->as_string Returns the object's string representation. =back =head1 SEE ALSO L, L =head1 COPYRIGHT Copyright (c) 2002, 2003, 2004 James Macfarlane. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Net-NBName-0.26/lib/Net/NBName/NameQuery.pm100666 0 0 5344 10447545766 16424 0ustar usergroupuse strict; use warnings; package Net::NBName::NameQuery; use Net::NBName::NameQuery::RR; use vars '$VERSION'; $VERSION = '0.26'; sub new { my $class = shift; my $resp = shift; my @header = unpack("n6", $resp); my $rcode = $header[1] & 15; if ($rcode == 0x0) { # positive name query response my $results = substr($resp, 50); # skip original query data my ($ttl, $rdlength) = unpack("Nn", $results); my @rr = (); for (my $i = 0; $i < $rdlength / 6; $i++) { my $nb_data = substr($results, 6+6*$i, 6); push @rr, Net::NBName::NameQuery::RR->new($nb_data); } my $self = {'addresses' => \@rr, 'ttl' => $ttl, 'AA' => ($header[1] & 0x0400) ? 1 : 0, 'TC' => ($header[1] & 0x0200) ? 1 : 0, 'RD' => ($header[1] & 0x0100) ? 1 : 0, 'RA' => ($header[1] & 0x0080) ? 1 : 0, 'B' => ($header[1] & 0x0010) ? 1 : 0}; bless $self, $class; return $self; } else { # probably rcode = 0x3, a negative name query response return undef; } } sub as_string { my $self = shift; my $string = ""; for my $rr (@{$self->{addresses}}) { $string .= $rr->as_string; } $string .= "ttl = $self->{ttl} (default is 300000)\n"; $string .= "RA set, this was an NBNS server\n" if $self->{'RA'}; return $string; } sub addresses { return @{$_[0]->{'addresses'}}; } sub ttl { return $_[0]->{'ttl'}; } sub RA { return $_[0]->{'RA'}; } 1; __END__ =head1 NAME Net::NBName::NameQuery - NetBIOS Name Query Response =head1 DESCRIPTION Net::NBName::NameQuery represents a decoded NetBIOS name query response. =head1 METHODS =over 4 =item $nq->addresses Returns a list of ip addresses returned for the queried name. These are returned as a list of C records. Most name queries will only return one ip address, but you will get multiple ip addresses returned for names registered by multihomed hosts or for group name queries. =item $nq->ttl Time to live. This is the lifespan of the name registration. =item $nq->RA Recursion available. This flag is typically set if the responding host is an NBNS server, and can be used to determine if it was an NBNS server that responded. =item $nq->as_string Returns the object's string representation. =back =head1 SEE ALSO L =head1 COPYRIGHT Copyright (c) 2002, 2003, 2004 James Macfarlane. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Net-NBName-0.26/lib/Net/NBName/NodeStatus/ 40777 0 0 0 10450056224 16122 5ustar usergroupNet-NBName-0.26/lib/Net/NBName/NodeStatus/RR.pm100666 0 0 6532 10447546022 17114 0ustar usergroupuse strict; use warnings; package Net::NBName::NodeStatus::RR; use vars '$VERSION'; $VERSION = "0.26"; use vars '@nodetypes'; @nodetypes = qw/B-node P-node M-node H-node/; sub new { my $class = shift; my $rr_data = shift; my ($name, $suffix, $flags) = unpack("a15Cn", $rr_data); $name =~ tr/\x00-\x19/\./; # replace ctrl chars with "." $name =~ s/\s+//g; my $self = {}; $self->{'name'} = $name; $self->{'suffix'} = $suffix; $self->{'G'} = ($flags & 2**15) ? "GROUP" : "UNIQUE"; $self->{'ONT'} = $nodetypes[($flags >> 13) & 3]; $self->{'DRG'} = ($flags & 2**12) ? "Deregistering" : "Registered"; $self->{'CNF'} = ($flags & 2**11) ? "Conflict" : ""; $self->{'ACT'} = ($flags & 2**10) ? "Active" : "Inactive"; $self->{'PRM'} = ($flags & 2**9) ? "Permanent" : ""; bless $self, $class; return $self; } sub as_string { my $self = shift; return sprintf "%-15s<%02X> %-6s %-6s %-10s %-8s %-8s %-4s\n", $self->{'name'}, $self->{'suffix'}, $self->{'G'}, $self->{'ONT'}, $self->{'DRG'}, $self->{'ACT'}, $self->{'CNF'}, $self->{'PRM'}; } sub name { return $_[0]->{'name'}; } sub suffix { return $_[0]->{'suffix'}; } sub G { return $_[0]->{'G'}; } sub ONT { return $_[0]->{'ONT'}; } sub DRG { return $_[0]->{'DRG'}; } sub ACT { return $_[0]->{'ACT'}; } sub CNF { return $_[0]->{'CNF'}; } sub PRM { return $_[0]->{'PRM'}; } 1; __END__ =head1 NAME Net::NBName::NodeStatus::RR - NetBIOS Node Status Response Resource Record =head1 DESCRIPTION Net::NBName::NodeStatus::RR represents a name table entry returned as part of a NetBIOS node status response. =head1 METHODS =over 4 =item $rr->name Returns the registered name (a string of up to 15 characters). =item $rr->suffix The suffix of the registered name (the 16th character of the registered name). Some common suffixes include: 0x00 Redirector 0x00 Domain (Group) 0x03 Messenger 0x1B Domain Master Browser 0x1C Domain Controllers (Special Group) 0x1D Master Browser 0x1E Browser Elections (Group) 0x20 Server =item $rr->G Group flag. Indicates whether the name is a unique or a group name. It is returned as a string: either "UNIQUE" or "GROUP" will be returned. For example, the following name types are UNIQUE: 0x00 Redirector 0x03 Messenger 0x1B Domain Master Browser 0x1D Master Browser 0x20 Server And the following name types are GROUP: 0x00 Domain (Group) 0x1C Domain Controllers (Special Group) 0x1E Browser Elections (Group) =item $rr->ONT Owner Node Type flag. Indicates if the systems are B, P, H, or M-node. It will be returned as a string. =item $rr->DRG Deregistering flag. "Deregistering" will be returned if the name is not currently registered. =item $rr->ACT Active flag. =item $rr->CNF Conflict flag. =item $rr->PRM Permanent flag. =item $rr->as_string Returns the object's string representation. =back =head1 SEE ALSO L, L =head1 COPYRIGHT Copyright (c) 2002, 2003, 2004 James Macfarlane. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Net-NBName-0.26/lib/Net/NBName/NodeStatus.pm100666 0 0 4163 10447553234 16572 0ustar usergroupuse strict; use warnings; package Net::NBName::NodeStatus; use Net::NBName::NodeStatus::RR; use vars '$VERSION'; $VERSION = "0.26"; sub new { my $class = shift; my $resp = shift; my @rr = (); my $mac_address = ""; # Don't attempt to extract any names or the mac address # if the response is truncated if (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, Net::NBName::NodeStatus::RR->new($rr_data); } $mac_address = join "-", map { sprintf "%02X", $_ } unpack("C*", substr($name_data, 18 * $num_names, 6)); } my $self = {'names' => \@rr, 'mac_address' => $mac_address}; bless $self, $class; return $self; } sub as_string { my $self = shift; my $string = ""; for my $rr (@{$self->{names}}) { $string .= $rr->as_string; } $string .= "MAC Address = " . $self->{mac_address} . "\n"; return $string; } sub names { return @{$_[0]->{'names'}}; } sub mac_address { return $_[0]->{'mac_address'}; } 1; __END__ =head1 NAME Net::NBName::NodeStatus - NetBIOS Node Status Response =head1 DESCRIPTION Net::NBName::NodeStatus represents a decoded NetBIOS node status response. =head1 METHODS =over 4 =item $ns->names Returns a list of NetBIOS names registered on the responding host. These are returned as a list of C objects. =item $ns->mac_address Returns the MAC address of the responding host. Not all systems will respond with the correct MAC address, although all Windows-based systems did during testing. =item $ns->as_string Returns the object's string representation. =back =head1 SEE ALSO L =head1 COPYRIGHT Copyright (c) 2002, 2003, 2004 James Macfarlane. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Net-NBName-0.26/lib/Net/NBName.pm100666 0 0 31777 10450055445 14527 0ustar usergroupuse strict; use warnings; package Net::NBName; use Net::NBName::NodeStatus; use Net::NBName::NameQuery; use vars '$VERSION'; $VERSION = "0.26"; sub new { my $class = shift; my $self = {}; bless $self, $class; return $self; } sub node_status { my $self = shift; my $host = shift; my $timeout = shift; my $req = Net::NBName::Request->new; $req->data(0, "*", "\x00", 0, 0x21); my $resp = $req->unicast($host, $timeout); if ($resp) { my $ns = Net::NBName::NodeStatus->new($resp); return $ns; } else { return undef; } } sub name_query { my $self = shift; my $host = shift; my $name = shift; my $suffix = shift; my $flags = shift || 0x0100; my $timeout = shift; my $req = Net::NBName::Request->new; $req->data($flags, $name, ' ', $suffix, 0x20); my ($resp, $from_ip); if (defined($host)) { $resp = $req->unicast($host, $timeout); } else { ($resp, $from_ip) = $req->broadcast($timeout); } if ($resp) { my $nq = Net::NBName::NameQuery->new($resp); return $nq; } else { return undef; } } package Net::NBName::Request; use Socket; sub new { my $class = shift; my $self = {}; bless $self, $class; return $self; } sub data { my $self = shift; my ($flags, $name, $pad, $suffix, $qtype) = @_; my $data = ""; $data .= pack("n*", $$, $flags, 1, 0, 0, 0); $data .= _encode_name($name, $pad, $suffix); $data .= pack("n*", $qtype, 0x0001); $self->{data} = $data; } 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 unicast { my $self = shift; my $host = shift; # Timeout should be 250ms according to RFC1002 my $timeout = shift || 0.25; my $data = $self->{data}; my $protocol = getprotobyname('udp'); my $port = 137; socket(SOCK, AF_INET, SOCK_DGRAM, $protocol) or return undef; my $to_saddr = sockaddr_in($port, inet_aton($host)); send(SOCK, $data, 0, $to_saddr) or return undef; my $rin = ""; my $rout; vec($rin, fileno(SOCK), 1) = 1; my ($nfound, $timeleft) = select($rout = $rin, undef, undef, $timeout); if ($nfound) { my $resp; if (my $from_saddr = recv(SOCK, $resp, 2000, 0)) { my ($from_port, $from_ip) = sockaddr_in($from_saddr); close(SOCKET); return $resp; } else { # socket error #printf "Errno %d %s\n", $!, $^E; close(SOCKET); return undef; } } else { # timed out close(SOCKET); return undef; } } sub broadcast { my $self = shift; # Timeout should be 5s according to rfc1002 (but I've used 1s) my $timeout = shift || 1; my $host = "255.255.255.255"; my $data = $self->{data}; my $protocol = getprotobyname('udp'); my $port = 137; socket(SOCK, AF_INET, SOCK_DGRAM, $protocol) or return undef; setsockopt(SOCK, SOL_SOCKET, SO_BROADCAST, 1); my $to_saddr = sockaddr_in($port, inet_aton($host)); send(SOCK, $data, 0, $to_saddr) or return undef; my $rin = ""; my $rout; vec($rin, fileno(SOCK), 1) = 1; my ($nfound, $timeleft) = select($rout = $rin, undef, undef, $timeout); if ($nfound) { my $resp; if (my $from_saddr = recv(SOCK, $resp, 2000, 0)) { my ($from_port, $from_ip) = sockaddr_in($from_saddr); close(SOCKET); return $resp, inet_ntoa($from_ip); } else { # socket error #printf "Errno %d %s\n", $!, $^E; close(SOCKET); return undef; } } else { # timed out close(SOCKET); return undef; } } 1; __END__ =head1 NAME Net::NBName - NetBIOS Name Service Requests =head1 SYNOPSIS use Net::NBName; my $nb = Net::NBName->new; # a unicast node status request my $ns = $nb->node_status("10.0.0.1"); if ($ns) { print $ns->as_string; } # a unicast name query request my $nq = $nb->name_query("10.0.1.80", "SPARK", 0x00); if ($nq) { print $nq->as_string; } # a broadcast name query request my $nq = $nb->name_query(undef, "SPARK", 0x00); if ($nq) { print $nq->as_string; } =head1 DESCRIPTION Net::NBName is a class that allows you to perform simple NetBIOS Name Service Requests in your Perl code. It performs these NetBIOS operations over TCP/IP using Perl's built-in socket support. I've currently implemented two NBNS requests: the node status request and the name query request. =over 4 =item NetBIOS Node Status Request This allows you to determine the registered NetBIOS names for a specified remote host. The decoded response is returned as a C object. querying 192.168.0.10 for node status... SPARK <20> UNIQUE M-node Registered Active SPARK <00> UNIQUE M-node Registered Active PLAYGROUND <00> GROUP M-node Registered Active PLAYGROUND <1C> GROUP M-node Registered Active PLAYGROUND <1B> UNIQUE M-node Registered Active PLAYGROUND <1E> GROUP M-node Registered Active SPARK <03> UNIQUE M-node Registered Active PLAYGROUND <1D> UNIQUE M-node Registered Active ..__MSBROWSE__.<01> GROUP M-node Registered Active MAC Address = 00-1C-2B-3A-49-58 =item NetBIOS Name Query Request This allows you to resolve a name to an IP address using NetBIOS Name Resolution. These requests can either be unicast (e.g. if you are querying an NBNS server) or broadcast on the local subnet. In either case, the decoded response is returned as an C object. querying 192.168.0.10 for playground<00>... 255.255.255.255 GROUP B-node ttl = 0 (default is 300000) RA set, this was an NBNS server broadcasting for playground<1C>... 192.168.0.10 GROUP B-node ttl = 0 (default is 300000) RA set, this was an NBNS server broadcasting for spark<20>... 192.168.0.10 UNIQUE H-node ttl = 0 (default is 300000) RA set, this was an NBNS server =back =head1 CONSTRUCTOR =over 4 =item $nb = Net::NBName->new Creates a new C object. This can be used to perform NetBIOS Name Service requests. =back =head1 METHODS =over 4 =item $ns = $nb->node_status( $host [, $timeout] ) This will query the host for its node status. The response will be returned as a C object. If no response is received from the host, the method will return undef. You can also optionally specify the timeout in seconds for the node status request. The timeout defaults to .25 seconds. =item $nq = $nb->name_query( $host, $name, $suffix [, $flags [, $timeout] ] ) This will query the host for the specified name. The response will be returned as a C object. If $host is undef, then a broadcast name query will be performed; otherwise, a unicast name query will be performed. Broadcast name queries can sometimes receive multiple responses. Only the first positive response will be decoded and returned as a C object. If no response is received or a negative name query response is received, the method will return undef. You can override the flags in the NetBIOS name request, if you *really* want to. See the notes on Hacking Name Query Flags. You can also optionally specify the timeout in seconds for the name query request. It defaults to .25 seconds for unicast name queries and 1 second for broadcast name queries. =back =head1 EXAMPLES =head2 Querying NetBIOS Names You can use this example to query for a NetBIOS name. If you specify a host, it will perform a unicast query; if you don't specify a host, it will perform a broadcast query. I've used the shorthand of specifying the name as # where the suffix should be in hex. "namequery.pl spark#0" "namequery.pl spark#20 192.168.0.10" use strict; use Net::NBName; my $nb = Net::NBName->new; my $param = shift; my $host = shift; if ($param =~ /^([\w-]+)\#(\w{1,2})$/) { my $name = $1; my $suffix = hex $2; my $nq; if (defined($host) && $host =~ /\d+\.\d+\.\d+\.\d+/) { printf "querying %s for %s<%02X>...\n", $host, $name, $suffix; $nq = $nb->name_query($host, $name, $suffix); } else { printf "broadcasting for %s<%02X>...\n", $name, $suffix; $nq = $nb->name_query(undef, $name, $suffix); } if ($nq) { print $nq->as_string; } } else { die "expected: # []\n"; } =head2 Querying Remote Name Table This example emulates the windows nbtstat -A command. By specifying the ip address of the remote host, you can check its NetBIOS Name Table. "nodestat.pl 192.168.0.10" use Net::NBName; my $nb = Net::NBName->new; my $host = shift; if (defined($host) && $host =~ /\d+\.\d+\.\d+\.\d+/) { my $ns = $nb->node_status($host); if ($ns) { print $ns->as_string; } else { print "no response\n"; } } else { die "expected: \n"; } =head2 Scanning for NetBIOS hosts This example can be used to scan for NetBIOS hosts on a subnet. It uses Net::Netmask to parse the subnet parameter and enumerate the hosts in that subnet. "nodescan.pl 192.168.0.0/24" use Net::NBName; use Net::Netmask; $mask = shift or die "expected: \n"; $nb = Net::NBName->new; $subnet = Net::Netmask->new2($mask); for $ip ($subnet->enumerate) { print "$ip "; $ns = $nb->node_status($ip); if ($ns) { for my $rr ($ns->names) { if ($rr->suffix == 0 && $rr->G eq "GROUP") { $domain = $rr->name; } if ($rr->suffix == 3 && $rr->G eq "UNIQUE") { $user = $rr->name; } if ($rr->suffix == 0 && $rr->G eq "UNIQUE") { $machine = $rr->name unless $rr->name =~ /^IS~/; } } $mac_address = $ns->mac_address; print "$mac_address $domain\\$machine $user"; } print "\n"; } =head1 NOTES =head2 Microsoft's WINS Server Implementation When performing name queries, you should note that when Microsoft implemented their NBNS Name Server (Microsoft WINS Server) they mapped group names to the single IP address 255.255.255.255 (the limited broadcast address). In order to support I group names, Microsoft modified WINS to provide support for special groups. These groups appear differently in WINS. For example, the Domain Controllers (0x1C) group appears as "Domain Name" instead of "Group". The complete set of WINS mapping types is: Unique Group Domain Name Internet group Multihomed Unique and Group map to a single IP address. Domain Name, Internet group, and Multihomed are special groups that can include up to 25 IP addresses. =head2 Hacking Name Query Flags NetBIOS Name Service Requests have a number of flags associated with them. These are set to sensible defaults by the code when sending node status and name query requests. However, it is possible to override these settings by calling the name_query method of a C object with a fourth parameter: $nb->name_query( $host, $name, $suffix, $flags ); For a unicast name query, the flags default to 0x0100 which sets the RD (recursion desired) flag. For a broadcast name query, the flags default to 0x0010 which sets the B (broadcast) flag. Experimentation gave the following results: =over 4 =item * If B is set, the remote name table will be used. There will be no response if the queried name is not present. =item * If B is not set and the host is an NBNS server, the NBNS server will be used before the remote name table and you will get a negative response if the name is not present; if the host is not an NBNS server, you will get no response if the name is not present. =back =head1 COPYRIGHT Copyright (c) 2002, 2003, 2004 James Macfarlane. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Net-NBName-0.26/Makefile.PL100666 0 0 1143 10011305454 13476 0ustar usergroupuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Net::NBName', 'VERSION_FROM' => 'lib/Net/NBName.pm', # finds $VERSION 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT => 'NetBIOS Name Service Requests', AUTHOR => 'James Macfarlane') : ()), # *.pm files will be automatically picked up from . or ./lib 'EXE_FILES' => ['bin/namequery.pl', 'bin/nodestat.pl', 'bin/nodescan.pl'], ); Net-NBName-0.26/MANIFEST100666 0 0 520 10450056225 12641 0ustar usergroupChanges Makefile.PL MANIFEST lib/Net/NBName.pm lib/Net/NBName/NameQuery.pm lib/Net/NBName/NameQuery/RR.pm lib/Net/NBName/NodeStatus.pm lib/Net/NBName/NodeStatus/RR.pm README t/use.t t/decode.t bin/namequery.pl bin/nodestat.pl bin/nodescan.pl META.yml Module meta-data (added by MakeMaker) Net-NBName-0.26/META.yml100666 0 0 472 10450056225 12767 0ustar usergroup# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Net-NBName version: 0.26 version_from: lib/Net/NBName.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30 Net-NBName-0.26/README100666 0 0 1617 10447550354 12430 0ustar usergroupNet::NBName =========== DESCRIPTION Net::NBName is a class that allows you to perform simple NetBIOS Name Service Requests in your Perl code. It performs these NetBIOS operations over TCP/IP using Perl's built-in socket support. I've currently implemented two NBNS requests: the node status request and the name query request. The node status request can be used to query the NetBIOS name table of a remote host; the name query request can be used to establish the ip address of a NetBIOS name. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires only the standard Socket module. COPYRIGHT AND LICENCE Copyright (C) 2002, 2003, 2004, 2005, 2006 James Macfarlane This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-NBName-0.26/t/ 40777 0 0 0 10450056224 11700 5ustar usergroupNet-NBName-0.26/t/decode.t100666 0 0 6071 10447550240 13414 0ustar usergroupuse strict; use diagnostics; use Test; BEGIN { plan tests => 22 } # Test Net::NBName::NodeStatus my @data = qw(04 D4 84 00 00 00 00 01 00 00 00 00 20 43 4B 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 00 00 21 00 01 00 00 00 00 00 E3 0A 53 50 41 52 4B 20 20 20 20 20 20 20 20 20 20 20 44 00 53 50 41 52 4B 20 20 20 20 20 20 20 20 20 20 00 44 00 50 4C 41 59 47 52 4F 55 4E 44 20 20 20 20 20 00 C4 00 50 4C 41 59 47 52 4F 55 4E 44 20 20 20 20 20 1C C4 00 50 4C 41 59 47 52 4F 55 4E 44 20 20 20 20 20 1B 44 00 50 4C 41 59 47 52 4F 55 4E 44 20 20 20 20 20 1E C4 00 53 50 41 52 4B 20 20 20 20 20 20 20 20 20 20 03 44 00 50 4C 41 59 47 52 4F 55 4E 44 20 20 20 20 20 1D 44 00 01 02 5F 5F 4D 53 42 52 4F 57 53 45 5F 5F 02 01 C4 00 41 44 4D 49 4E 49 53 54 52 41 54 4F 52 20 20 03 44 00 00 1C 2B 3A 49 58 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 00 FF 03 1F 00 20 90 68 80 E0 52 F0 77 00); my $resp = pack "C*", map { hex } @data; my @names = (['SPARK', 0x20], ['SPARK', 0x00], ['PLAYGROUND', 0x00], ['PLAYGROUND', 0x1C], ['PLAYGROUND', 0x1B], ['PLAYGROUND', 0x1E], ['SPARK', 0x03], ['PLAYGROUND', 0x1D], ['..__MSBROWSE__.', 0x01], ['ADMINISTRATOR', 0x03], ); use Net::NBName::NodeStatus; ok(1); # loaded ok my $ns = Net::NBName::NodeStatus->new($resp); ok($ns); # $ns should be defined; undef indicates a problem decoding # check netbios names have been decoded correctly my $i = 0; for my $rr ($ns->names) { ok($rr->name, $names[$i][0]); $i++; } # check mac address decoded correctly ok($ns->mac_address, "00-1C-2B-3A-49-58"); # Test Net::NBName::NodeStatus 2 # Truncated response, as returned by HP LaserJet printers @data = qw(2b 5c 00 00 00 01 00 00 00 00 00 00 20 43 4b 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 00 00 21 00 01); $resp = pack "C*", map { hex } @data; $ns = Net::NBName::NodeStatus->new($resp); ok($ns); # $ns should be defined; undef indicates a problem decoding ok(scalar $ns->names, 0); # check names is an empty list ok($ns->mac_address, ""); # check the mac_address is an empty string # Test Net::NBName::NameQuery @data = qw(04 4C 85 80 00 00 00 01 00 00 00 00 20 45 4C 45 4A 45 4F 45 48 45 45 45 50 45 4E 43 41 43 41 43 41 43 41 43 41 43 41 43 41 43 41 42 4D 00 00 20 00 01 00 00 00 00 00 12 80 00 C0 A8 00 0A 80 00 C0 A8 00 0B 80 00 C0 A8 00 0C); my @addresses = qw(192.168.0.10 192.168.0.11 192.168.0.12); $resp = pack "C*", map { hex } @data; use Net::NBName::NameQuery; ok(1); # loaded ok my $nq = Net::NBName::NameQuery->new($resp); ok($nq); # $nq should be defined; undef indicates a problem decoding # check ip addresses have been decoded correctly $i = 0; for my $rr ($nq->addresses) { ok($rr->address, $addresses[$i]); $i++; } ok($nq->RA, 1); # check RA flag was detected Net-NBName-0.26/t/use.t100666 0 0 121 7575235266 12733 0ustar usergroupuse strict; use Test; BEGIN { plan tests => 1 } use Net::NBName; ok(1);