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