workbench/network/stacks/AROSTCP/dhcp/contrib/ms2isc/Registry.pm

   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;