Beefy Boxes and Bandwidth Generously Provided by pair Networks kudra
Problems? Is your data what you think it is?
 
PerlMonks  

lmhosts.pl

by DaveRoberts (Novice)
on Jan 21, 2002 at 17:08 UTC ( #140380=sourcecode: print w/ replies, xml ) Need Help??

Category: NT Admin
Author/Contact Info DaveRoberts@iname.com
Description: This script is used to improve the reliability of trusts between NT domains. The lmhosts file is used to identify domain controllers, and is referred to by the NT operating system when building and maintaining trusts - using computers by order of occurance in the lmhosts file. This script takes a distributed copy of a standard lmhosts file and re-writes this to the normal lmhosts location (%SystemRoot%/system32/drivers/etc) re-ordering the entries in approximate order of network responsiveness. The intended effect of this is to ensure that trusts are maintained with computers that are i) alive on the network and ii) relativly close
use Net::hostent;
use Net::Ping;
use Socket;
use Win32;
use Win32::TieRegistry (Delimiter=>"/", ArrayValues=>0,
  qw(REG_DWORD REG_SZ REG_MULTI_SZ));

use constant TRUE     => 1;
use constant FALSE     => 0;

my($p) = Net::Ping->new("icmp");

# Identify OS directories

$Etc = Win32::ExpandEnvironmentStrings("%SystemRoot%/System32/Drivers/
+Etc");
chmod(0666,"$Etc/Lmhosts") || print "failed to make $Etc/Lmhosts write
+able\n";

my($lmhOrig)="c:/tmp/lmhosts";
my($myname)=uc(Win32::NodeName());
my($timeout) = 6;
my($timestep) = 0.1;

my(%ip,%pl,$myip,$mynm);
open(LMH,"$lmhOrig")||die("Unable to open $lmhOrig\n");
foreach (<LMH>) {
  chop;
#  print "LMH: $_\n";
  if ( /(\d+\.\d+\.\d+\.\d+)\s+([\da-z]+)\s(.*)?/i ) {
    
    my($cip)   = $1;
    my($cname) = uc($2);
    my($preld) = $3;
    $preld =~ s/^\s+//;
    #printf "** %-20s %-20s %s\n",$cip,$cname,$preld;
    $ip{$cname}=$cip;  # Array of network addresses indexed by compute
+r name
    $pl{$cname}=$preld;
    if ( $cname eq $myname ) {
      $myip = $cip;
    }
  }
}
close LMH;

unless ($myip) {
  unless ($h = gethost($me)) {
    warn "$0: no such host: $me\n";
    exit;
  }
  if ( @{$h->addr_list} > 1 ) {
    printf "\taddress is [%s]\n", inet_ntoa($h->addr);
    $myip = inet_ntoa($h->addr);
    warn "$0 - this computer has multiple addresses - using $myip\n";
    } else {
    $myip = inet_ntoa($h->addr);
  }
}

print "\nComputer Name  : $myname\n";
print "Network Address: $myip\n\n";

# Identify local host address and netmask
unless ($h = gethost($myname)) {
  warn "$0: no such host: $myname\n";
  exit;
}

# Open registry

$NetBTKey = $Registry->{"//" . $me . "/LMachine/SYSTEM/CurrentControlS
+et/Services/NetBT/"} ||
die "\n  Failed to connect to registry on $me\n\n";

$SvcKey = $Registry->{"//" . $me . "/LMachine/SYSTEM/CurrentControlSet
+/Services/"} ||
die "\n  Failed to connect to registry on $me\n\n";


# *********************************************
# Get network adapters
# *********************************************
@Adapters = grep(!/^Ndis/i, keys %{$NetBTKey->{"Adapters/"}});
$AdapterCount = @Adapters;
# Sort adapters by Bind order
foreach $ServiceName (split(/\000/, $NetBindKey->{"Tcpip/Linkage/Bind"
+})) {
  $ServiceName =~ s/^\\device\\NetBT_//i;
  push(@AdaptersByBind, $ServiceName) if grep { /^$ServiceName\/$/ } @
+Adapters;
}
# Add non-bound adapters
foreach $ServiceName (@Adapters) {
  $ServiceName =~ s/\/$//;  # Remove trailing '/'s
  push(@AdaptersByBind, $ServiceName) if !grep { /^$ServiceName$/ } @A
+daptersByBind;
}

print "Network Adapters Identified   : @Adapters\n";
print "Network Adapters In Bind Order: @AdaptersByBind\n\n";

foreach $ServiceName (@AdaptersByBind) {

  #print "Adapter: $ServiceName\n";
  $NetBTaKey = "Adapters/" . $ServiceName . "/";
  $iFaceKey  = $ServiceName . "/Parameters/TCPIP/";
  $pEnableDHCP = hex($SvcKey->{$iFaceKey . "EnableDHCP"});
  print "EnableDHCP: $pEnableDHCP\n";
  if (! $pEnableDHCP) {
    $pIPAddress  = $SvcKey->{$iFaceKey  . "IPAddress"       };
    $pSubnetMask = $SvcKey->{$iFaceKey  . "SubnetMask"      };
    $pGateway    = $SvcKey->{$iFaceKey  . "DefaultGateway"  };
    $pWserverA   = $NetBTKey->{$NetBTaKey . "NameServer"      };
    $pWserverB   = $NetBTKey->{$NetBTaKey . "NameServerBackup"};
  }else{
    $pIPAddress  = $SvcKey->{$iFaceKey . "DhcpIPAddress"} ?         $S
+vcKey->{$iFaceKey . "DhcpIPAddress"} : "";
    $pSubnetMask = $SvcKey->{$iFaceKey . "DhcpSubnetMask"} ?        $S
+vcKey->{$iFaceKey . "DhcpSubnetMask"} : "";
    $pGateway    = $SvcKey->{$iFaceKey . "DhcpDefaultGateway"} ?    $S
+vcKey->{$iFaceKey . "DhcpDefaultGateway"} : "";
    $pWserverA   = $NetBTKey->{$NetBTaKey . "DhcpNameServer"} ?       
+$NetBTKey->{$NetBTaKey . "DhcpNameServer"} : "";
    $pWserverB   = $NetBTKey->{$NetBTaKey . "DhcpNameServerBackup"} ? 
+$NetBTKey->{$NetBTaKey . "DhcpNameServerBackup"} : "";
  }

  $pIPAddress  =~ s/([\.0-9]+)/$1/;
  if ($pIPAddress =~ /$myip/) {
    $mynm = $pSubnetMask;
    $mygw = $pGateway;
    $DNShostname   = $SvcKey->{"Tcpip/Parameters/Hostname"};
    $DNSdomain     = $SvcKey->{"Tcpip/Parameters/Domain"};
    $DNSnamservers = $SvcKey->{"Tcpip/Parameters/NameServer"};
    $DNSsearchlist = $SvcKey->{"Tcpip/Parameters/SearchList"};
    $WINSusedns    = hex($NetBTKey->{"Parameters/EnableDNS"});
    $WINSuselmhosts= hex($NetBTKey->{"Parameters/EnableLMHOSTS"});
    print " ********************************************\n";
    print " Adapter Selected:  $ServiceName\n";
    if ( $SvcKey->{"Tcpip/Linkage/Bind"} =~ /$ServiceName/i ) {
      print " ********************************************\n";
      print "   TCPIP EnableDHCP          = $pEnableDHCP\n";
      print "   TCPIP IPAddress           = $pIPAddress\n";
      print "   TCPIP SubnetMask          = $pSubnetMask\n";
      print "   TCPIP DefaultGateway      = $pGateway\n";
      print "\n";
      print "   DNS Hostname              = $DNShostname\n";
      print "   DNS Domain                = $DNSdomain\n";
      print "   DNS NameServer            = $DNSnameservers\n";
      print "   DNS SearchList            = $DNSsearchlist\n";
      print "\n";
      print "   WINS NameServer           = $pWserverA\n";
      print "   WINS NameServerBackup     = $pWserverB\n";
      print "   WINS EnableDNS            = $WINSusedns\n";
      print "   WINS EnableLMHOSTS        = $WINSuselmhosts\n";
      print " ********************************************\n";
      }else{
      print "Disabled in BIND\n";
    }
  }
}
#  Find the network number from local ip and netmask
my($ipa,$ipb,$ipc,$ipd) = split(/\./,$myip);
my $ip32 = ($ipa << 24) + ($ipb << 16) + ($ipc << 8) + $ipd;
my($nma,$nmb,$nmc,$nmd) = split(/\./,$mynm);
my $nm32 = ($nma << 24) + ($nmb << 16) + ($nmc << 8) + $nmd;
$mynw = ($ip32 & $nm32);
$MyNw = ($mynw & 0xFF);
$mynw=$mynw >> 8;
$MyNw = ($mynw & 0xFF) . '.' . $MyNw;
$mynw=$mynw >> 8;
$MyNw = ($mynw & 0xFF) . '.' . $MyNw;
$mynw=$mynw >> 8;
$MyNw = ($mynw & 0xFF) . '.' . $MyNw;

print "\nNetwork Address: $MyNw\n";
print "        Netmask: $mynm\n\n";

# Verify local default gateway is reachable within 3 seconds

unless ( $p->ping($mygw,3)){
  print "Local gateway $mygw is unreachable - quitting\n";
  exit;
}

my(@lm,@un); # Init output arrays
push (@lm,"# Local hosts");
# Put all hosts in local network first in the new lmhosts file
while (($name,$ip)=each %ip) {
  push (@lm,sprintf "%-15s %-12s %s",$ip{$name},$name,$pl{$name})
    if ( CheckIPSubnet($ip,$MyNw,$mynm) );
}

# Find unreachable hosts - and don't test again (makes iterative proce
+ss faster)
print "Identifying any unreachable hosts\n";
push (@un,"#");
push (@un,"# Hosts with a response over $timeout seconds");
while (($name,$ip)=each %ip) {
  next if ( grep {/$name/} @lm);  # Ignore any local hosts (alive or n
+ot)
  print "Testing $name ($ip)\n";
  push (@un,sprintf "%-15s %-12s %s",$ip{$name},$name,$pl{$name}) unle
+ss ( $p->ping($ip,$timeout) );
}

# Determine hosts in order of response time
for($t=$timestep;$t<=$timeout;$t+=$timestep) {
  print "# Testing network response with $t secs\n";
  my($no)=0;
  while (($name,$ip)=each %ip) {
    next if ( grep {/$name/} @lm);  # Ignore if host is already in the
+ new lmhosts file (@lm)
    next if ( grep {/$name/} @un);  # Ignore if host is already in the
+ unreachable lmhosts file (@un)
    print "Testing $name ($ip)\n";
    if ( $p->ping($ip,$t)) {
      push (@lm,"#") if ($no == 0);
      push (@lm,sprintf "# Hosts with a response under %.1f seconds",$
+t) if ($no == 0);
      push (@lm,sprintf "%-15s %-12s %s",$ip{$name},$name,$pl{$name});
      $no++;
    }
  }
}

push (@lm,@un); # Add unreachable lmhosts to end of new lmhosts file
      
open (LMH,">$Etc/Lmhosts")||die "Failed to open $Etc/Lmhosts for writi
+ng\n";
foreach (@lm){
  print "$_\n";
  print LMH "$_\n";
}
close LMH;
      
exit;
#*********************************************************************
+****************************
# CheckIPSubnet - Check if IP address is within entity subnet range
#*********************************************************************
+****************************
      sub CheckIPSubnet($$$) {
        my($ip, $nw, $sn)       = @_;
        my($ipa,$ipb,$ipc,$ipd) = split(/\./,$ip);
        my $ip32 = ($ipa << 24) + ($ipb << 16) + ($ipc << 8) + $ipd;
        my ($sn32);
        if ( $sn =~ /\d+\.\d+\.\d+\.\d+/ ) {
          my($sna,$snb,$snc,$snd) = split(/\./,$sn);
          $sn32 = ($sna << 24) + ($snb << 16) + ($snc << 8) + $snd;
          }elsif ( $sn =~ /^\d+$/ ) {
          $sn32=0;
          for($i=0;$i<$sn;$i++) {
            $sn32 = $sn32 | 1;
            $sn32 = $sn32 << 1;
          }
          $sn32 = $sn32 << (31-$sn);
        }
        my($nwa,$nwb,$nwc,$nwd) = split(/\./,$nw);
        my $nb32 = ($nwa << 24) + ($nwb << 16) + ($nwc << 8) + $nwd;
        my $nt32 = $nb32 | ($sn32 ^ "11111111111111111111111111111111"
+);
        return TRUE if (($ip32 > $nb32) && ($nt32 gt $ip32));
        return FALSE;
      }
      

Comment on lmhosts.pl
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://140380]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (18)
As of 2014-04-24 13:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (566 votes), past polls