ms2isc.pl revision 1.1 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