Annotation of embedaddon/dhcp/contrib/ms2isc/Registry.pm, revision 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