Annotation of embedaddon/dhcp/contrib/ms2isc/ms2isc.pl, revision 1.1.1.1

1.1       misho       1: #set ts=3
                      2: #
                      3: # ms2isc.pl
                      4: # MS NT4 DHCP to ISC DHCP Configuration Migration Tool
                      5: #
                      6: # Author: Shu-Min Chang
                      7: #
                      8: # Copyright(c) 2003 Intel Corporation.  All rights reserved
                      9: #
                     10: # Redistribution and use in source and binary forms, with or without
                     11: # modification, are permitted provided that the following conditions are met:
                     12: #
                     13: # 1. Redistributions of source code must retain the above copyright notice,
                     14: #    this list of conditions and the following disclaimer.
                     15: # 2. Redistributions in binary form must reproduce the above copyright notice
                     16: #    this list of conditions and the following disclaimer in the documentation
                     17: #    and/or other materials provided with the distribution
                     18: # 3. Neither the name of Intel Corporation nor the names of its contributors
                     19: #    may be used to endorse or promote products derived from this software
                     20: #    without specific prior written permission.
                     21: #
                     22: # THIS SOFTWARE IS PROVIDED BY THE INTEL CORPORATION AND CONTRIBUTORS "AS IS"
                     23: # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
                     24: # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 
                     25: # ARE DISCLAIMED.  IN NO EVENT SHALL THE INTEL CORPORATION OR CONTRIBUTORS BE
                     26: # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL EXEMPLARY, OR 
                     27: # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO PROCUREMENT OF SUBSTITUE
                     28: # GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 
                     29: # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 
                     30: # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
                     31: # OF THE USE OF THIS SOFTWARE, EVEN IF ADVICED OF THE POSSIBILITY OF SUCH 
                     32: # DAMAGE.
                     33: 
                     34: use strict;
                     35: use Socket;
                     36: use Getopt::Std;
                     37: use Filehandle;
                     38: use Registry; # Custom Perl Module to make Registry access easier.
                     39: 
                     40: my $usage = << 'ENDOFHELP';
                     41: 
                     42: Purpose: A Perl Script converting MS NT4 DHCP configuration to ISC DHCP3 
                     43: configuration file by reading NT4's registry.
                     44: 
                     45: Requires: Registry.pm and ActiveState 5.6.0
                     46: 
                     47: Usage: $ARGV -s <Srv> -o <Out> [-p <Pri> [-k <key>]] [-f <Fo>]
                     48: 
                     49:   <Srv>  Server IP or name for NT4 DHCP server to fetch the configuration from.
                     50:   <Out>  Output filename for the configuration file.
                     51:   <Pri>  Primary DNS server name for sending the dynamic DNS update to.
                     52:   <Key>  Key name for use in updating the dynamic DNS zone.
                     53:   <Fo>   Failover peer name shared with the DHCP partner.
                     54: 
                     55: Essentially the <Srv> needs to be an NT4 (3.x should work but not tested) which
                     56: you should have registry read access to.  You must run this script from a 
                     57: Windows machine because of the requirement to access the registry.
                     58: 
                     59: The <Pri> is optional parameter for desginating the dynamic DNS update if
                     60: missing then the "zone" section of the declaration will be skipped.  The <Key>
                     61: is needed if you've configured your DNS zone with a key, in addition, you'll
                     62: need to define that key in this DHCP configuration file elsewhere manually,
                     63: read the DHCP Handbook to figure out what you need to define.
                     64: 
                     65: The <Fo> specifies the fail-over peer name in the pool section, you'll need to
                     66: define additional detail elsewhere manually, again read the DHCP handbook.
                     67: 
                     68: NOTE: the program only knows of the following global and subnet options:
                     69:         3, 6, 15, 28, 44, and 46
                     70: 
                     71:       If it runs into options other than the known ones, it will quit.  You
                     72:       may fix this by modifying the following procedures:
                     73:         GetGlobalOptions
                     74:         GetScopes
                     75:         PrintSubnetConfig
                     76: 
                     77:       In addition, the resulting subnets configuration will have the "deny 
                     78:       dynamic bootp clients" you should take them out if that's not what you 
                     79:       want :).
                     80: 
                     81:       Finally, as the parameter structures implied, it is assumed that you
                     82:       want the same zone primary and update key for all zones and that the
                     83:       same failover is to be applied to all the pools.  Furthermore the
                     84:       subnet zones are all assumed to be class C delineated, but if you
                     85:       happend to be delegated at the class B level, this will work fine too.
                     86: 
                     87: Author: Shu-Min Chang <smchang@yahoo.com>
                     88: 
                     89: Copyright: Please read the top of the source code
                     90: 
                     91: Acknowledgement:
                     92:   Brian L. King for coding help, Douglas A. Darrah for testing, and James E.
                     93: Pressley for being the DHCP reference book :).
                     94: 
                     95: Usage: $ARGV -s <Srv> -o <Out> [-p <Pri> [-k <key>]] [-f <Fo>]
                     96: 
                     97: Version: 1.0.1
                     98: 
                     99: ENDOFHELP
                    100: 
                    101: ###################### Begin Main Program ####################################
                    102: 
                    103:   my (%opts, %GlobalOptions, %SuperScopes, %Scopes);
                    104: 
                    105:   ### Get parameters and make sure that they meet the require/optoinal criteria
                    106:   getopts('s:o:p:k:f:', \%opts) or die $usage;
                    107:   ($opts{s} and $opts{o}) or die $usage;
                    108:   if ($opts{k}) { $opts{p} or die $usage; }
                    109:   
                    110:   ### Read all the registry stuff into the memory
                    111:   %GlobalOptions = GetGlobalOptions($opts{s});
                    112:   %SuperScopes = GetSuperScope($opts{s});
                    113:   %Scopes = GetScopes ($opts{s});
                    114: 
                    115:   ### Process and print out to the output file
                    116:   my ($outfile, $i, $j, @Domains);
                    117: 
                    118:   $outfile = new FileHandle "> $opts{o}";
                    119:   if (!defined $outfile) {
                    120:      die "Can't open file: $opts{o}: $!";
                    121:   }
                    122: 
                    123:   for $i (keys %SuperScopes) {
                    124:      print $outfile "\n##############################################################\n";
                    125:      my ($Scopename) = $i;
                    126:      $Scopename =~ s/ //g;
                    127:      print $outfile "shared-network $Scopename {\n";
                    128:      foreach $j (@{$SuperScopes{$i}}) {
                    129:         PrintSubnetConfig($outfile, \%GlobalOptions, \%{$Scopes{$j}}, $j, "\t", $opts{f});
                    130:         InsertIfUnique (\@Domains, $Scopes{$j}{domain}) if exists $Scopes{$j}{domain};
                    131:         delete $Scopes{$j};
                    132:      }
                    133:      print $outfile "}\n";
                    134:      if ($opts{p} or $opts{k}) {
                    135:         foreach $j (@{$SuperScopes{$i}}) {
                    136:            PrintSubnetUpdate($outfile, $j, $opts{p}, $opts{k});
                    137:         }
                    138:      }
                    139:   }
                    140: 
                    141:   for $i (keys %Scopes) {
                    142:      print $outfile "\n##############################################################\n";
                    143:      PrintSubnetConfig($outfile, \%GlobalOptions, \%{$Scopes{$i}}, $i, "", $opts{f});
                    144:      if ($opts{p} or $opts{k}) { PrintSubnetUpdate($outfile, $i, $opts{p}, $opts{k}); }
                    145:      InsertIfUnique (\@Domains, $Scopes{$i}{domain}) if exists $Scopes{$i}{domain};
                    146:   }
                    147: 
                    148:   if ($opts{p} or $opts{k}) {
                    149:      InsertIfUnique (\@Domains, $GlobalOptions{domain}) if exists $GlobalOptions{domain};
                    150:      for $i (@Domains) {
                    151:         PrintDomainUpdate($outfile, $i, $opts{p}, $opts{k});
                    152:      }
                    153:   }
                    154: 
                    155:   undef ($outfile);
                    156:   print "Done.\n";
                    157:   exit();
                    158: 
                    159: ################################## End Main Program ###########################
                    160: 
                    161: 
                    162: 
                    163: 
                    164: 
                    165: ######################################################################
                    166: sub InsertIfUnique ($$) {
                    167:   my ($Array, $data) = @_;
                    168: # purpose: insert $data into array @{$Array} iff the data is not in there yet
                    169: # input:
                    170: #   $data: scalar data to be added to the @{$Array} if unique
                    171: #   $Array: reference of the Array to compare the uniqueness of the $data
                    172: # output:
                    173: #   $Array: reference of the array with the resulting array.
                    174: # return: none
                    175: 
                    176:   my ($i);
                    177: 
                    178:   for ($i=0; $i<=$#{$Array} && ${$Array}[$i] ne $data; $i++) { }
                    179: 
                    180:   if ($i > $#{$Array}) {
                    181:      ${$Array}[$i] = $data;
                    182:   }
                    183: }
                    184: ######################################################################
                    185: sub PrintDomainUpdate ($$$$) {
                    186:   my ($outfile, $Domain, $DDNSServer, $key) = @_;
                    187: # purpose: print out the foward domain zone update declaration
                    188: # input:
                    189: #   $outfile: filehandle of the file to write the output to
                    190: #   $Domain: a string representing the forward domain
                    191: #   $DDNSServer: a string of the DNS server accepting the DDNS update
                    192: #   $key: a string representing the key used to update the zone
                    193: # output: none
                    194: # return: none
                    195: #
                    196: 
                    197:   print $outfile "zone $Domain {\n";
                    198:   print $outfile "\tprimary $DDNSServer;\n";
                    199:   !$key or print $outfile "\tkey $key;\n";
                    200:   print $outfile "}\n";
                    201: 
                    202: }
                    203: ######################################################################
                    204: sub PrintSubnetUpdate ($$$$) {
                    205:   my ($outfile, $Subnet, $DDNSServer, $key) = @_;
                    206: # purpose: print out the reverse domain zone update declaration
                    207: # input:
                    208: #   $outfile: filehandle of the file to write the output to
                    209: #   $Subnet: a string representing the subnet in the form 1.2.3.4
                    210: #   $DDNSServer: a string of the DNS server accepting the DDNS update
                    211: #   $key: a string representing the key used to update the zone
                    212: # output: none
                    213: # return: none
                    214: #
                    215: 
                    216:   my ($Reverse);
                    217: 
                    218:   $_ = join (".", reverse(split(/\./, $Subnet)));
                    219:   m/\d*\.(.*)/;
                    220:   $Reverse = $1;
                    221:   print $outfile "zone $Reverse.in-addr.arpa. {\n";
                    222:   print $outfile "\tprimary $DDNSServer;\n";
                    223:   !$key or print $outfile "\tkey $key;\n";
                    224:   print $outfile "}\n";
                    225: 
                    226: }
                    227: ######################################################################
                    228: sub PrintSubnetConfig ($$$$$$) {
                    229:   my ($outfile, $GlobalOptions, $Scope, $Subnet, $prefix, $failover) = @_;
                    230: # purpose: print out the effective scope configuration for one subnet as
                    231: #          derived from the global and scope options.
                    232: # input:
                    233: #   $outfile: filehandle of the file to write the output to
                    234: #   $GlobalOptions: refernce to the hashed variable from GetGlobalOptions
                    235: #   $Scopes: reference to the hashed variable of the subnet in interest
                    236: #   $Subnet: string variable of the subnet being processed
                    237: #   $prefix: string to be printed before each line (designed for tab)
                    238: #   $failover: string to be used for the "failover peer" line
                    239: # output: none
                    240: # return: none
                    241: #
                    242:   my ($pound) = ( ${$Scope}{disable}? "#".$prefix : $prefix);
                    243:   print $outfile $pound, "subnet $Subnet netmask ${$Scope}{mask} {\n";
                    244:   print $outfile "$prefix# Name: ${$Scope}{name}\n";
                    245:   print $outfile "$prefix# Comment: ${$Scope}{comment}\n";
                    246:   if (exists ${$Scope}{routers}) {
                    247:      print $outfile $pound, "\toption routers @{${$Scope}{routers}};\n";
                    248:   } elsif (exists ${$GlobalOptions}{routers}) {
                    249:      print $outfile $pound, "\toption routers @{${$GlobalOptions}{routers}};\t# NOTE: obtained from global option, bad practice detected\n";
                    250:   } else {
                    251:      print $outfile "### WARNING: No router was found for this subnet!!! ##########\n";
                    252:   }
                    253:   
                    254:   if (exists ${$Scope}{dnses}) {
                    255:      print $outfile $pound, "\toption domain-name-servers ", join(",", @{${$Scope}{dnses}}), ";\n";
                    256:   } elsif (exists ${$GlobalOptions}{dnses}) {
                    257:      print $outfile $pound, "\toption domain-name-servers ", join(",", @{${$GlobalOptions}{dnses}}), ";\n";
                    258:   }
                    259: 
                    260:   if (exists ${$Scope}{domain}) {
                    261:      print $outfile $pound, "\toption domain-name \"${$Scope}{domain}\";\n";
                    262:   } elsif (exists ${$GlobalOptions}{domain}) {
                    263:      print $outfile $pound, "\toption domain-name \"${$GlobalOptions}{domain}\";\n";
                    264:   }
                    265: 
                    266:   if (exists ${$Scope}{broadcast}) {
                    267:      print $outfile $pound, "\toption broadcast-address ${$Scope}{broadcast};\n";
                    268:   } elsif (exists ${$GlobalOptions}{broadcast}) {
                    269:      print $outfile $pound, "\toption broadcast-address ${$GlobalOptions}{broadcast};\n";
                    270:   }
                    271: 
                    272:   if (exists ${$Scope}{winses}) {
                    273:      print $outfile $pound, "\toption netbios-name-servers ", join(",", @{${$Scope}{winses}}), ";\n";
                    274:   } elsif (exists ${$GlobalOptions}{winses}) {
                    275:      print $outfile $pound, "\toption netbios-name-servers ", join(",", @{${$GlobalOptions}{winses}}), ";\n";
                    276:   }
                    277: 
                    278:   if (exists ${$Scope}{winstype}) {
                    279:      print $outfile $pound, "\toption netbios-node-type ${$Scope}{winstype};\n";
                    280:   } elsif (exists ${$GlobalOptions}{winstype}) {
                    281:      print $outfile $pound, "\toption netbios-node-type ${$GlobalOptions}{winstype};\n"
                    282:   }
                    283: 
                    284:   print $outfile $pound, "\tdefault-lease-time ${$Scope}{leaseduration};\n";
                    285:   print $outfile $pound, "\tpool {\n";
                    286:   for (my $r=0; $r<=$#{${$Scope}{ranges}}; $r+=2) {
                    287:      print $outfile $pound, "\t\trange ${$Scope}{ranges}[$r] ${$Scope}{ranges}[$r+1];\n";
                    288:   }
                    289:   !$failover or print $outfile $pound, "\t\tfailover peer \"$failover\";\n";
                    290:   print $outfile $pound, "\t\tdeny dynamic bootp clients;\n";
                    291:   print $outfile $pound, "\t}\n";
                    292:   print $outfile $pound, "}\n";
                    293: }
                    294: 
                    295: ######################################################################
                    296: sub GetScopes ($) {
                    297:   my ($Server) = @_;
                    298:   my (%Scopes);
                    299: # purpose: to return NT4 server's scope configuration
                    300: # input:
                    301: #   $Server: string of the valid IP or name of the NT4 server
                    302: # output: none
                    303: # return:
                    304: #   %Scope: hash of hash of hash of various data types to be returned of the 
                    305: #           following data structure
                    306: #     $Scope{<subnet>}{disable} => boolean
                    307: #     $Scope{<subnet>}{mask} => string (e.g. "1.2.3.255")
                    308: #     $Scope{<subnet>}{name} => string (e.g "Office Subnet #1")
                    309: #     $Scope{<subnet>}{comment} => string (e.g. "This is a funny subnet")
                    310: #     $Scope{<subnet>}{ranges} => array of paired inclusion IP addresses
                    311: #                                 (e.g. "1.2.3.1 1.2.3.10 1.2.3.100 10.2.3.200
                    312: #                                  says that we have 2 inclusion ranges of
                    313: #                                  1-10 and 100-200)
                    314: #     $Scopes{<subnet>}{routers} => array of IP address strings
                    315: #     $Scopes{<subnet>}{dnses} => array of IP address/name string
                    316: #     $Scopes{<subnet>}{domain} > string
                    317: #     $Scopes{<subnet>}{broadcast} => string
                    318: #     $Scopes{<subnet>}{winses} => array of IP addresses/name string
                    319: #     $Scopes{<subnet>}{winstype} => integer
                    320: #     $Scopes{<subnet>}{leaseduration} => integer
                    321: 
                    322:   my ($RegVal, @Subnets, @Router, $SubnetName, $SubnetComment, @SubnetOptions, @SRouter, @SDNSServers, @SDomainname, @SWINSservers, @SNetBIOS, @SLeaseDuration, @SSubnetState, @SExclusionRanges, @SSubnetAddress, @SSubnetMask, @SFirstAddress, $SStartAddress, $SEndAddress, @InclusionRanges, @SBroadcastAddress);
                    323: 
                    324:   print "Getting list of subnets\n";
                    325:   if (Registry::GetRegSubkeyList ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\Subnets", \@Subnets)) {
                    326:      die "Unable to obtain a list of subnets from the server!\n";
                    327:   }
                    328: 
                    329:   for (my $i=0; $i<=$#Subnets; $i++) {
                    330:      print "\t Fetching Subnet $Subnets[$i] (",$i+1, "/", $#Subnets+1, "): ";
                    331: 
                    332:      print ".";
                    333:      if (!Registry::GetRegSubkeyList ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\Subnets\\$Subnets[$i]\\IpRanges", \@SFirstAddress)) {
                    334:         # Don't know why MS has a tree for this, but as far
                    335:         # as I can tell, only one subtree will ever come out of
                    336:         # this, so I'm skipping the 'for' loop
                    337:      
                    338:         print ".";
                    339:         if (!Registry::GetRegKeyVal ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\Subnets\\$Subnets[$i]\\IpRanges\\$SFirstAddress[0]\\StartAddress", \$RegVal)) {
                    340:            $SStartAddress = $RegVal;
                    341:         }
                    342:         print ".";
                    343:         if (!Registry::GetRegKeyVal ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\Subnets\\$Subnets[$i]\\IpRanges\\$SFirstAddress[0]\\EndAddress", \$RegVal)) {
                    344:            $SEndAddress = $RegVal;
                    345:         }
                    346: # print "\n\tInclusion Range: ", Registry::ExtractIp($SStartAddress), " - ", Registry::ExtractIp($SEndAddress),"\n";
                    347:   
                    348:      } else {
                    349:         die "\n\n# Error Getting Inclusion Range FirstAddress!!!\n\n";
                    350:      }
                    351: 
                    352:      if (!Registry::GetRegKeyVal ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\Subnets\\$Subnets[$i]\\ExcludedIpRanges", \$RegVal)) {
                    353:         @SExclusionRanges = Registry::ExtractExclusionRanges($RegVal);
                    354: 
                    355: #       for (my $j=2; $j<=$#SExclusionRanges; $j+=2) {
                    356: #          if (unpack("L",$SExclusionRanges[$j]) < unpack("L",$SExclusionRanges[$j-2])) {
                    357: #             print ("\n******** Subnet exclusion ranges out of order ********\n");
                    358: #          }
                    359: #       }
                    360: 
                    361:         @SExclusionRanges = sort(@SExclusionRanges);
                    362: 
                    363: #    print "\n\tExclusion Ranges: ";
                    364: #    for (my $j=0; $j<=$#SExclusionRanges; $j+=2) {
                    365: #       print "\n\t\t",Registry::ExtractIp($SExclusionRanges[$j])," - ",Registry::ExtractIp($SExclusionRanges[$j+1]);
                    366: #    }
                    367: 
                    368:      }
                    369:      @InclusionRanges = FindInclusionRanges ($SStartAddress, $SEndAddress, @SExclusionRanges);
                    370: 
                    371:      print ".";
                    372:      if (!Registry::GetRegKeyVal ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\Subnets\\$Subnets[$i]\\SubnetName", \$RegVal)) {
                    373:         $SubnetName = $RegVal;
                    374: #    print "\n\tSubnetName: $SubnetName";
                    375:      }
                    376: 
                    377:      print ".";
                    378:      if (!Registry::GetRegKeyVal ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\Subnets\\$Subnets[$i]\\SubnetComment", \$RegVal)) {
                    379:         $SubnetComment = $RegVal;
                    380: #    print "\n\tSubnetComment: $SubnetComment";
                    381:      }
                    382:      print ".";
                    383:      if (!Registry::GetRegKeyVal ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\Subnets\\$Subnets[$i]\\SubnetAddress", \$RegVal)) {
                    384:         @SSubnetAddress = Registry::ExtractIp($RegVal);
                    385: #    print "\n\tSubnetAddress: $SSubnetAddress[0]";
                    386:      }
                    387:      print ".";
                    388:      if (!Registry::GetRegKeyVal ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\Subnets\\$Subnets[$i]\\SubnetMask", \$RegVal)) {
                    389:         @SSubnetMask = Registry::ExtractIp($RegVal);
                    390: #    print "\n\tSubnetMask: $SSubnetMask[0]";
                    391:      }
                    392: 
                    393:      print ".";
                    394:      if (!Registry::GetRegKeyVal ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\Subnets\\$Subnets[$i]\\SubnetState", \$RegVal)) {
                    395:         @SSubnetState = Registry::ExtractHex ($RegVal);
                    396: #    print "\n\tSubnetState = $SSubnetState[0]";
                    397:      }
                    398: 
                    399:      $Scopes{$Subnets[$i]}{disable} = hex($SSubnetState[0]) ? 1 : 0;
                    400:      $Scopes{$Subnets[$i]}{mask} = $SSubnetMask[0];
                    401:      $Scopes{$Subnets[$i]}{name} = $SubnetName;
                    402:      $Scopes{$Subnets[$i]}{comment} = $SubnetComment;
                    403:      for (my $r=0; $r<=$#InclusionRanges; $r++) {
                    404:         $Scopes{$Subnets[$i]}{ranges}[$r] = Registry::ExtractIp($InclusionRanges[$r]);
                    405:      }
                    406: 
                    407: ################## Get scope options
                    408: 
                    409:      my (@SubnetOptionsList);
                    410: 
                    411:      print "\n\t\tOptions:";
                    412:      if (Registry::GetRegSubkeyList ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\Subnets\\$Subnets[$i]\\SubnetOptions", \@SubnetOptionsList)) {
                    413:         die "Unable to get subnet options list for $Subnets[$i]!\n";
                    414:      }
                    415: 
                    416:      for (my $j=0; $j<=$#SubnetOptionsList; $j++) {
                    417:         print ".";
                    418:         if (!Registry::GetRegKeyVal ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\Subnets\\$Subnets[$i]\\SubnetOptions\\$SubnetOptionsList[$j]\\OptionValue", \$RegVal)) {
                    419:            for ($SubnetOptionsList[$j]) {
                    420:               /003/ and do {
                    421: #                @SRouter = Registry::ExtractOptionIps($RegVal);
                    422:                  $Scopes{$Subnets[$i]}{routers} = [Registry::ExtractOptionIps($RegVal)];
                    423:                  last;
                    424:               };
                    425:               /006/ and do {
                    426:                  @SDNSServers = Registry::ExtractOptionIps($RegVal);
                    427:                  for (my $d=0; $d<=$#SDNSServers; $d++) {
                    428:                     my ($ipname, $rest) = gethostbyaddr(pack("C4", split(/\./, $SDNSServers[$d])), &AF_INET);
                    429:                     $Scopes{$Subnets[$i]}{dnses}[$d] = $ipname ? $ipname : $SDNSServers[$d];
                    430:      }
                    431:                  last;
                    432:               };
                    433:               /015/ and do { 
                    434:                  @SDomainname = Registry::ExtractOptionStrings($RegVal);
                    435:                  $Scopes{$Subnets[$i]}{domain} = $SDomainname[0];
                    436:                  last;
                    437:               };
                    438:               /028/ and do {
                    439:                  @SBroadcastAddress = Registry::ExtractOptionIps($RegVal);
                    440:                  $Scopes{$Subnets[$i]}{broadcast} = $SBroadcastAddress[0];
                    441:                  last;
                    442:               };
                    443:               /044/ and do {
                    444:                  @SWINSservers = Registry::ExtractOptionIps($RegVal);
                    445:                  for (my $w=0; $w<=$#SWINSservers; $w++) {
                    446:                     my ($ipname, $rest) = gethostbyaddr(pack("C4", split(/\./, $SWINSservers[$w])), &AF_INET);
                    447:                     $Scopes{$Subnets[$i]}{winses}[$w] = $ipname ? $ipname : $SWINSservers[$w];
                    448:                  }
                    449:                  last;
                    450:               };
                    451:               /046/ and do {
                    452:                  @SNetBIOS = Registry::ExtractOptionHex($RegVal);
                    453:                  $Scopes{$Subnets[$i]}{winstype} = hex($SNetBIOS[0]);
                    454:                  last;
                    455:               };
                    456:               /051/ and do {
                    457:                  @SLeaseDuration = Registry::ExtractOptionHex($RegVal);
                    458:                  $Scopes{$Subnets[$i]}{leaseduration} = hex($SLeaseDuration[0]);
                    459:                  last;
                    460:               };
                    461:               die "This program does not recognize subnet option \#$SubnetOptionsList[$j] yet!\n"
                    462:            }
                    463:         } else {
                    464:               die "Unable to obtain option SubnetOptionsList[$j] from $Subnets[$i], most likely a registry problem!\n"
                    465:         }
                    466:      }
                    467:      print "\n";
                    468:   }
                    469: 
                    470:   return %Scopes;
                    471: }
                    472: 
                    473: ######################################################################
                    474: sub FindInclusionRanges ($$@) {
                    475:   my ($StartAddress, $EndAddress, @ExclusionRanges) = @_;
                    476: # Purpose: to calculate and return the DHCP inclusion ranges out of
                    477: #          data provided by the NT4 DHCP server
                    478: # input:   $StartAddress:
                    479: #        $EndAddress:  
                    480: #        @ExclusionRanges
                    481: # output: none
                    482: # return: An arry of IP address pair representing the inclusion ranges
                    483: #         in the native registry format.
                    484: #
                    485: 
                    486:   my ($SA, $EA, @ER);
                    487:   $SA = unpack("L", $StartAddress);
                    488:   $EA = unpack("L", $EndAddress);
                    489:   @ER = @ExclusionRanges;
                    490:   for (my $i=0; $i<=$#ER; $i++) {
                    491:      $ER[$i] = unpack ("L", $ER[$i]);
                    492:   }
                    493: 
                    494:   my @InclusionRanges;
                    495: 
                    496: 
                    497:   $InclusionRanges[0] = $SA;
                    498:   $InclusionRanges[1] = $EA;
                    499: 
                    500:   for (my $i=0; $i<=$#ER; $i+=2) {
                    501:      if ($ER[$i] == $InclusionRanges[$#InclusionRanges-1]) {
                    502:         $InclusionRanges[$#InclusionRanges-1] = $ER[$i+1] + 1;
                    503:      }
                    504:      if ($ER[$i] > $InclusionRanges[$#InclusionRanges-1]) {
                    505:         $InclusionRanges[$#InclusionRanges] = $ER[$i]-1;
                    506:      }
                    507:      if (($ER[$i+1] > $InclusionRanges[$#InclusionRanges]) && 
                    508:          ($ER[$i+1] != $EA)) {
                    509:         $InclusionRanges[$#InclusionRanges+1] = $ER[$i+1] + 1;
                    510:         $InclusionRanges[$#InclusionRanges+1] = $EA;
                    511:      }
                    512:      if ($InclusionRanges[$#InclusionRanges] < $InclusionRanges[$#InclusionRanges-1]) {
                    513:         $#InclusionRanges -= 2;
                    514:      }
                    515:   }
                    516: 
                    517:   for (my $i=0; $i<=$#InclusionRanges; $i++) {
                    518:      $InclusionRanges[$i] = pack("L", $InclusionRanges[$i]);
                    519:   #  print "Inclusion: ", Registry::ExtractIp($InclusionRanges[$i]), "\n";
                    520:   }
                    521:   return @InclusionRanges;
                    522: }
                    523: 
                    524: ####################################################################
                    525: sub GetSuperScope ($) {
                    526:   my ($Server) = @_;
                    527:   my (%SuperScopes);
                    528: #
                    529: # purpose: gets the Superscope list from the given server
                    530: # input:
                    531: #   $Server:  string of the valid IP address or name of the NT4 server
                    532: # ouput: none
                    533: # return:
                    534: #   %SuperScopes: hash of array subnets with the following data structure
                    535: #          $SuperScopes{<SuperscopeName>} => array of sunbets
                    536: #
                    537:   my (@SuperScopeNames, @SCSubnetList);
                    538: 
                    539:   print "Getting Superscope list: ";
                    540:   if (!Registry::GetRegSubkeyList ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\SuperScope", \@SuperScopeNames)) {
                    541:      for (my $i=0; $i<=$#SuperScopeNames; $i++) {
                    542:         print ".";
                    543:         if (!Registry::GetRegSubkeyList ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\SuperScope\\$SuperScopeNames[$i]", \@SCSubnetList)) {
                    544:            $SuperScopes{$SuperScopeNames[$i]} = [@SCSubnetList];
                    545:         }
                    546:      }
                    547:      print "\n";
                    548:   }
                    549: 
                    550:   return %SuperScopes;
                    551: }
                    552: 
                    553: ####################################################################
                    554: sub GetGlobalOptions($) {
                    555:   my ($Server) = @_;
                    556:   my (%GlobalOptions);
                    557: # purpose: to return NT4 server's global scope configuration
                    558: # input:
                    559: #   $Server: string of the valid IP or name of the NT4 server
                    560: # output: none
                    561: # return:
                    562: #   %GlobalOptions: hash of hash of various data types to be returned of the 
                    563: #           following data structure
                    564: #     $GlobalOptions{routers} => array of IP address strings
                    565: #     $GlobalOptions{dnses} => array of IP address/name string
                    566: #     $GlobalOptions{domain} > string
                    567: #     $GlobalOptions{broadcast} => string
                    568: #     $GlobalOptions{winses} => array of IP addresses/name string
                    569: #     $GlobalOptions{winstype} => integer
                    570: 
                    571:   my ($RegVal, @temp, @GlobalOptionValues);
                    572: 
                    573:   print "Getting Global Options: ";
                    574:   if (Registry::GetRegSubkeyList ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\Configuration\\GlobalOptionValues", \@GlobalOptionValues)) { 
                    575:      die "Unable to obtain GlobalOptionValues"; 
                    576:   }
                    577:   
                    578:   for (my $i=0; $i<=$#GlobalOptionValues; $i++) {
                    579:      print ".";
                    580:      if (Registry::GetRegKeyVal ("\\\\$Server\\HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Services\\DHCPServer\\configuration\\globaloptionvalues\\$GlobalOptionValues[$i]\\optionvalue", \$RegVal)) { 
                    581:         die "Unable to retrive global option $GlobalOptionValues[$i]\n";
                    582:      }
                    583:   
                    584:   
                    585:      for ($GlobalOptionValues[$i]) {
                    586:         /003/ and do {
                    587:            @temp=Registry::ExtractOptionIps($RegVal);
                    588:            $GlobalOptions{routers} = [@temp];
                    589:            last;
                    590:         };
                    591:         /006/ and do {
                    592:            # DNS Servers
                    593:            @temp = Registry::ExtractOptionIps($RegVal);
                    594:            for (my $d=0; $d<=$#temp; $d++) {
                    595:               my ($ipname, $rest) = gethostbyaddr(pack("C4", split(/\./, $temp[$d])), &AF_INET);
                    596:               $GlobalOptions{dnses}[$d] = $ipname ? $ipname : $temp[$d];
                    597:            }
                    598:            last;
                    599:         };
                    600:         /015/ and do { 
                    601:            # Domain Name
                    602:            @temp = Registry::ExtractOptionStrings($RegVal);
                    603:            $GlobalOptions{domain} = $temp[0];
                    604:            last;
                    605:         };
                    606:         /028/ and do { 
                    607:            # broadcast address
                    608:            @temp = Registry::ExtractOptionIps($RegVal);
                    609:            $GlobalOptions{broadcast} = $temp[0];
                    610:            last;
                    611:         };
                    612:         /044/ and do {
                    613:            # WINS Servers
                    614:            @temp = Registry::ExtractOptionIps ($RegVal);
                    615:            $GlobalOptions{winses} = [@temp];
                    616:            for (my $w=0; $w<=$#temp; $w++) {
                    617:               my ($ipname, $rest) = gethostbyaddr(pack("C4", split(/\./, $temp[$w])), &AF_INET);
                    618:               $GlobalOptions{winses}[$w] = $ipname ? $ipname : $temp[$w];
                    619:            }
                    620:            last;
                    621:         };
                    622:         /046/ and do {
                    623:            # NETBIOS node type
                    624:            @temp = Registry::ExtractOptionHex($RegVal);
                    625:            $GlobalOptions{winstype} = hex($temp[0]);
                    626:            last;
                    627:         };
                    628:         die "This program does not recgonize global option \#$GlobalOptionValues[$i] yet!\n"
                    629:      }
                    630:   }
                    631:   print "\n";
                    632: 
                    633:   return %GlobalOptions;
                    634: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>