Annotation of embedaddon/dhcp/contrib/ms2isc/Registry.pm, revision 1.1.1.1
1.1 misho 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:
32: package Registry;
33: use strict;
34: use Win32API::Registry 0.21 qw( :ALL );
35:
36:
37: ###############################################################################
38:
39: #-----------------------------------------
40: sub 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: #-----------------------------------------
112: sub 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:
187: sub 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:
217: sub 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:
252: sub 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:
290: sub 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:
326: sub 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:
341: sub 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: }
361: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to Registry.pm CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / dhcp / contrib / ms2isc