1# Registry.pm
2#   A perl module provided easy Windows Registry access
3#
4# Author: Shu-Min Chang
5#
6# Copyright(c) 2002 Intel Corporation.  All rights reserved
7#
8# Redistribution and use in source and binary forms, with or without
9# modification, are permitted provided that the following conditions are met:
10#
11# 1. Redistributions of source code must retain the above copyright notice,
12#    this list of conditions and the following disclaimer.
13# 2. Redistributions in binary form must reproduce the above copyright notice
14#    this list of conditions and the following disclaimer in the documentation
15#    and/or other materials provided with the distribution
16# 3. Neither the name of Intel Corporation nor the names of its contributors
17#    may be used to endorse or promote products derived from this software
18#    without specific prior written permission.
19#
20# THIS SOFTWARE IS PROVIDED BY THE INTEL CORPORATION AND CONTRIBUTORS "AS IS"
21# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23# ARE DISCLAIMED.  IN NO EVENT SHALL THE INTEL CORPORATION OR CONTRIBUTORS BE
24# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL EXEMPLARY, OR
25# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO PROCUREMENT OF SUBSTITUE
26# GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
27# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
28# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
29# OF THE USE OF THIS SOFTWARE, EVEN IF ADVICED OF THE POSSIBILITY OF SUCH
30# DAMAGE.
31
32package Registry;
33use strict;
34use Win32API::Registry 0.21 qw( :ALL );
35
36
37###############################################################################
38
39#-----------------------------------------
40sub GetRegKeyVal($*) {
41	my ($FullRegPath, $value) = @_;
42#-----------------------------------------
43# Purpose: uses Win32API to get registry information from a given server
44#
45# WARNING: this procedure is VERY Win32 specific, you'll need a Win32 manual
46#          to figure out why something is done.
47# input: $FullRegPath: a MS specific way of fully qualifying a registry path
48#                     \\Server\RootKey\Path\ValueName
49# output: *value: the value of the registry key of $FullRegPath
50#
51
52	my ($RemoteMachine, $RootKey, $RegPath, $KeyName, $i);
53
54#print "in sub:GetRegKeyVal:Parameters:", @_, "\n";
55
56	# Check the for valid fully qualified registry path
57	return -1 if (! ($FullRegPath =~ /\\.+\\.+/)) && (!($FullRegPath =~ /\\\\.+\\.+\\.+/));
58
59
60	$RemoteMachine = (index($FullRegPath, "\\\\") == $[ ? substr($FullRegPath, $[+2, index($FullRegPath, "\\", $[+2)-2):0);
61
62#print "RemoteMachine = $RemoteMachine\n";
63
64	$i = $RemoteMachine ? $[+3+length($RemoteMachine) : $[+1;
65	$RootKey = substr ($FullRegPath, $i, index($FullRegPath, "\\", $i)-$i);
66
67	$KeyName = $FullRegPath;
68	$KeyName =~ s/.*\\(.+)/$1/;
69#print "KeyName = $KeyName\n";
70
71	$i = index($FullRegPath, $RootKey, $[+length($RemoteMachine)) + $[ + length($RootKey)+1;
72	$RegPath = substr ($FullRegPath, $i, length($FullRegPath) - length($KeyName) -$i - 1);
73#print "RegPath = $RegPath\n";
74
75	my ($RootKeyHandle, $handle, $key, $type);
76
77  if ($RemoteMachine) {
78		$RootKeyHandle = regConstant($RootKey);
79
80		if (!RegConnectRegistry ($RemoteMachine, $RootKeyHandle, $handle)) {
81			$$value = regLastError();
82			return -2;
83		}
84	} else { # not valid actually because I can't find the mapping table of default
85            # local handle mapping.  Should always pass in the Machine name to use for now
86		$handle = $RootKey;
87	}
88
89	if (!RegOpenKeyEx ($handle, $RegPath, 0, KEY_READ, $key)) {
90		$$value = regLastError();
91#print "regLastError = $$value\n";
92		return -3;
93	}
94	if (!RegQueryValueEx( $key, $KeyName, [], $type, $$value, [] )) {
95		$$value = regLastError();
96#print "regLastError = $$value\n";
97		return -4;
98	}
99
100#print "RegType=$type\n";	# Perl doesn't fetch type, at this in this
101				# ActiveState 5.6.0 that I'm using
102#print "RegValue=$$value\n";
103	RegCloseKey ($key);
104	RegCloseKey ($handle);
105
106	return 0;
107}
108
109###############################################################################
110
111#-----------------------------------------
112sub GetRegSubkeyList($*) {
113	my ($FullKeyRegPath, $Subkeys) = @_;
114#-----------------------------------------
115# Purpose: uses Win32API to get registry subkey list from a given server
116#
117# WARNING: this procedure is VERY Win32 specific, you'll need a Win32 manual
118#          to figure out why something is done.
119# input: $FullKeyRegPath: a MS specific way of fully qualifying a registry path
120#                     \\Server\RootKey\Path\KeyName
121# output: *Subkeys: the list of subkeys in array of the registry key of
122#                   $FullKeyRegPath
123#
124
125	my ($RemoteMachine, $RootKey, $RegPath, $KeyName, $i);
126
127#print "in sub:GetRegSubkeyList:Parameters:", @_, "\n";
128
129	# Check the for valid registry key path
130	return -1 if (! ($FullKeyRegPath =~ /\\.+\\.+/)) && (!($FullKeyRegPath =~ /\\\\.+\\.+\\.+/));
131
132
133	$RemoteMachine = (index($FullKeyRegPath, "\\\\") == $[ ? substr($FullKeyRegPath, $[+2, index($FullKeyRegPath, "\\", $[+2)-2):0);
134
135#print "RemoteMachine = $RemoteMachine\n";
136
137	$i = $RemoteMachine ? $[+3+length($RemoteMachine) : $[+1;
138	$RootKey = substr ($FullKeyRegPath, $i, index($FullKeyRegPath, "\\", $i)-$i);
139
140	$i = index($FullKeyRegPath, $RootKey, $[+length($RemoteMachine)) + $[ + length($RootKey)+1;
141	$RegPath = substr ($FullKeyRegPath, $i);
142
143#print "RegPath = $RegPath\n";
144
145	my ($RootKeyHandle, $handle, $key, $type);
146
147	if ($RemoteMachine) {
148		$RootKeyHandle = regConstant($RootKey);
149
150		if (!RegConnectRegistry ($RemoteMachine, $RootKeyHandle, $handle)) {
151			@$Subkeys[0]= regLastError();
152			return -2;
153		}
154	} else { # not valid actually because I can't find the mapping table of default
155            # local handle mapping.  Should always pass in the Machine name to use for now
156		$handle = $RootKey;
157	}
158
159	if (!RegOpenKeyEx ($handle, $RegPath, 0, KEY_READ, $key)) {
160		@$Subkeys[0] = regLastError();
161#print "regLastError = @$Subkeys[0]\n";
162		return -3;
163	}
164
165	my $tmp;
166	# For some reason, the regLastError() stays at ERROR_NO_MORE_ITEMS
167	# in occasional call sequence, so I'm resetting the error code
168	# before entering the loop
169	regLastError(0);
170	for ($i=0; regLastError()==regConstant("ERROR_NO_MORE_ITEMS"); $i++) {
171#print "\nERROR: error enumumerating reg\n";
172		if (RegEnumKeyEx ($key, $i, $tmp, [], [], [], [], [])) {
173			@$Subkeys[$i] = $tmp;
174		}
175	}
176
177#print "RegType=$type\n";
178#print "RegValue=@$Subkeys\n";
179	RegCloseKey ($key);
180	RegCloseKey ($handle);
181
182	return 0;
183}
184
185#####################################################
186
187sub ExtractOptionIps ($) {
188	my ($MSDHCPOption6Value) = @_;
189	my @ip;
190# purpose: DHCP registry specific; to return the extracted IP addresses from
191#          the input variable
192# input:
193#   $MSDHCPOption6Value: Option 6 was used to develop, but it works for any
194#                        other options of the same datatype.
195# output: none
196# return:
197#   @ip: an arry of IP addresses in human readable format.
198
199
200	# First extract the size of the option
201	my ($byte, $size, $ind1, $ind2, @octet) = unpack("VVVV", $MSDHCPOption6Value);
202# print "byte = $byte\nsize=$size\nind1=$ind1\nind2=$ind2\n";
203
204	# Calculate total number of bytes that IP addresses occupy
205	my $number = $size * $ind1;
206	($byte, $size, $ind1, $ind2, @octet) = unpack("VVVVC$number", $MSDHCPOption6Value);
207
208	for (my $i=0; $i<$#octet; $i=$i+4) {
209		$ip[$i/4] = "$octet[$i+3]\.$octet[$i+2]\.$octet[$i+1]\.$octet[$i]";
210	}
211
212	return @ip;
213}
214
215#####################################################
216
217sub ExtractOptionStrings ($) {
218	my ($MSDHCPOption15Value) = @_;
219	my @string;
220# purpose: DHCP registry specific; to return the extracted string from
221#          the input variable
222# input:
223#   $MSDHCPOption15Value: Option 15 was used to develop, but it works for any
224#                         other options of the same datatype.
225# output: none
226# return:
227#   @string: an arry of strings in human readable format.
228
229
230	# First extract the size of the option
231	my ($byte, $start, $ind1, $ind2, $size, @data) = unpack("VVVVV", $MSDHCPOption15Value);
232# print "byte = $byte\nstart=$start\nind1=$ind1\nind2=$ind2\nsize=$size\n";
233
234	# Calculate total number of bytes that IP addresses occupy
235	my $number = $size * $ind1;
236	($byte, $start, $ind1, $ind2, $size, @data) = unpack("VVVVVC$number", $MSDHCPOption15Value);
237
238	for (my $i=0; $i<$ind1; $i++) {
239	# actually this is only programmed to do one string, until I see
240	# example of how the multiple strings are represented, I don't have a
241	# guess to how to program them properly.
242		for (my $j=0; $j<$#data & $data[$j]!=0; $j+=2) {
243			$string[$i] = $string[$i].chr($data[$j]);
244		}
245	}
246
247	return @string;
248}
249
250#####################################################
251
252sub ExtractOptionHex ($) {
253	my ($MSDHCPOption46Value) = @_;
254	my @Hex;
255# purpose: DHCP registry specific; to return the extracted hex from the input
256#          variable
257# input:
258#   $MSDHCPOption46Value: Option 46 was used to develop, but it works for any
259#                         other options of the same datatype.
260# output: none
261# return:
262#   @Hex: an arry of hex strings in human readable format.
263	my $Temp;
264
265
266	# First extract the size of the option
267	my ($byte, $unknown, $ind1, $ind2, @data) = unpack("VVVV", $MSDHCPOption46Value);
268# print "byte=$byte\nunknown=$unknown\nind1=$ind1\nind2=$ind2\n";
269
270	# Calculate total number of bytes that IP addresses occupy
271	my $number = $byte - 15;
272	($byte, $unknown, $ind1, $ind2, @data) = unpack("VVVVC$number", $MSDHCPOption46Value);
273
274# printf "data=%4x\n", $data[0];
275
276	for (my $i=0; $i<$ind1; $i++) {
277	# actually this is only programmed to do one Hex, until I see
278	# example of how the multiple Hexes are represented, I don't have a
279	# guess to how to program them properly.
280		for (my $j=3; $j>=0; $j--) {
281			$Hex[$i] = $Hex[$i].sprintf ("%x", $data[$j+$i*4]);
282		}
283	}
284
285	return @Hex;
286}
287
288#####################################################
289
290sub ExtractExclusionRanges ($) {
291	my ($MSDHCPExclusionRanges) = @_;
292	my @RangeList;
293# purpose: DHCP registry specific; to return the extracted exclusion ranges
294#          from the input variable
295# input:
296#   $MSDHCPExclusionRanges: Exclusion range as DHCP server returns them
297# output: none
298# return:
299#   @RangeList: an arry of paird IP addresses strings in human readable format.
300
301
302	# First extract the size of the option
303	my ($paircount, @data) = unpack("V", $MSDHCPExclusionRanges);
304# print "paircount = $paircount\n";
305
306	# Calculate total number of bytes that IP addresses occupy
307#	my $number = $paircount * 4*2;
308#	($paircount, @data) = unpack("VC$number", $MSDHCPExclusionRanges);
309#
310#	for (my $i=0; $i<$#data; $i=$i+4) {
311#		$ip[$i/4] = "$data[$i+3]\.$data[$i+2]\.$data[$i+1]\.$data[$i]";
312#	}
313#
314	my $number = $paircount * 2;
315	($paircount, @data) = unpack("VL$number", $MSDHCPExclusionRanges);
316
317	for (my $i=0; $i<=$#data; $i++) {
318		$RangeList[$i] = pack ("L", $data[$i]);
319# print "extracted", ExtractIp ($RangeList[$i]), "\n";
320	}
321
322	return @RangeList;
323}
324#####################################################
325
326sub ExtractIp ($) {
327	my ($octet) = @_;
328# purpose: to return the registry saved IP address in a readable form
329# input:
330#   $octet: a 4 byte data storing the IP address as the registry save it as
331# output: none
332# return: anonymous variable of a string of IP address
333
334	my (@data) = unpack ("C4", $octet);
335
336	return "$data[3]\.$data[2]\.$data[1]\.$data[0]";
337
338}
339#####################################################
340
341sub ExtractHex ($) {
342	my ($HexVal) = @_;
343	my @Hex;
344# purpose: to return the registry saved hex number in a readable form
345# input:
346#   $octet: a 4 byte data storing the hex number as the registry save it as
347# output: none
348# return:
349#   $Hex: string of hex digit
350
351
352	# First extract the size of the option
353	my (@data) = unpack("C4", $HexVal);
354
355	for (my $i=3; $i>=0; $i--) {
356		$Hex[0] = $Hex[0] . sprintf ("%x", $data[$i]);
357	}
358
359	return @Hex;
360}
3611;
362