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