|
|
|
8.4 Programming with PerlAhhh, Perl![8] Once upon a time, its power and entertainment value were reserved solely for Unix administrators. A long line of Windows programmers have labored to bring the Perl toolset to Win32; in doing so, they've added some nifty features not present in other platforms' Perl implementations. ActiveState Perl is an implementation of Perl for Win32 platforms and is available at http://www.activestate.com . In addition to the Perl core, ActiveState Perl also includes complete support for the Registry, COM, OLE, and Win32 security.
Throughout the rest of this section, I'm going to assume that you're familiar with Perl syntax and semantics, particularly the Perl implementation of objects and modules. (If you're not, I highly recommend Learning Perl On Win32 Systems by Randal L. Schwartz, Erik Olson, and Tom Christiansen from O'Reilly & Associates.) Even if you don't use the Win32-specific extensions, you can write plain-vanilla Perl and it works fine, but the extensions let you use Perl's expressive power to make short work of tasks such as creating batches of user accounts (as described in Windows NT User Administration by Ashley J. Meggitt and Timothy D. Ritchey; O'Reilly & Associates). Note that all the examples in this section were developed under and tested with ActivePerl Version 5.6.0. Before Perl Version 5 hit the streets, when people wanted to extend Perl, they actually had to change the core language itself. This resulted in products such as oraperl, which is Perl plus Oracle connectivity. Version 5 included a general extension mechanism developers could use to extend and change Perl without having to change the core. Developers can write extensions in Perl or other languages such as C or C++ (see the documentation on Perl's extension mechanism--called XS--in the perlxs and perlxstut sections of the Perl manual). This is how ActivePerl makes the Registry API available. 8.4.1 The Win32API::RegXXX FunctionsThe Win32 Perl module includes definitions that correspond to each of the standard C function definitions described in Section 8.3, earlier in this chapter. You can use them as you would the C or Visual Basic equivalents; the one difference is that you should qualify the routine names by specifying they come from the Win32 module. Example 8.8 shows what the program from Example 8.1 looks like when rewritten in Perl with the standard Win32 module's calls. Example 8.8. "Hello, World" from Example 8.1, Rewritten in Perluse Win32API::Registry 0.13 qw( :ALL );
RegOpenKeyEx ( HKEY_LOCAL_MACHINE,
"SYSTEM\\CurrentControlSet\\Control\\ComputerName\\ActiveComputerName",
0, KEY_READ, $theKey ) or die
("Couldn't open name key!$^E");
RegQueryValueEx($theKey, 'ComputerName',
[], # our friend lpReserved
REG_SZ,
$who, []);
print "This computer is named $who\n";
RegCloseKey($theKey);
The first line imports the Win32 module definitions themselves. The real fun starts with the call to RegOpenKeyEx. The most unusual feature of this call is that the constant parameters are passed by reference; other than that (and the call to die) it looks much like the C calls discussed in other sections of this chapter. Likewise, the call to RegQueryValueEx looks almost like the other languages' equivalents. One difference is that the value is returned in $who; since Perl doesn't need the length of the data in $who, there's no parameter for it. There is a parameter that can return the value's type, but in this case it's useless so I passed in [] instead of a variable reference. (Note that you can pass &NULL or [] to indicate a NULL value.) The special value $^E tells the Perl interpreter to call the Win32 GetLastError( ) routine and turn the returned error code into a text string. This is optional, but helpful. Finally, once the computer name's been printed, RegCloseKey closes the key just opened. This is just as necessary in Perl as anywhere else; when you open an HKEY, the OS needs to be told when you're finished with it. 8.4.1.1 When to use themIf you're already comfortable with the C/C++ interfaces, the Perl equivalents will seem familiar, because they are; they're just Perl transliterations of the existing C++ idioms from the Win32 API definitions. However, if you're going to program in Perl, you should do that instead of using what Perl hackers disparagingly call "C-in-Perl." The next section tells you how to do just that. 8.4.2 The Win32::TieRegistry ModuleA large part of Perl's popularity is the fact that Perl takes care of many fussy details for the programmer. Larry Wall, Perl's creator, describes this design philosophy as "making easy things easy and hard things possible." Compare the original Perl "Hello, World" program in Example 8.7 to the version shown in Example 8.9. Example 8.9. Perl "Hello, World" Rewritten with the Win32::TieRegistry Moduleuse Win32::TieRegistry Delimiter => '/';
my $name = join '/',
qw/ LMachine SYSTEM CurrentControlSet Control
ComputerName ActiveComputerName /;
my $key = $Registry->{$name}
or die "$0: can't open $name: $^E\n";
print "This computer is named $key->{'/ComputerName'}\n";
There are some things in this code that will probably look pretty odd to people who aren't used to Perl. If you're comfortable with Perl, skip the next section; otherwise, read on for some interpretation of all that funny-looking stuff. 8.4.2.1 A few Perl-ismsLike practically every other computer language ever invented, Perl supports arrays. Perl also supports a special type of array called a hash. You may be familiar with the underlying concept under another name, such as "associative array" or "dictionary list." A hash is just a data structure that maps a key to some data; it's like an array, but instead of being indexed by positive integers it's indexed by values.[9] The join operator concatenates values, and the qw operator quotes strings (so that qw/Hello/ is equivalent to "hello" in a C program). qw also replaces spaces with the appropriate delimiter.
Win32::TieRegistry also uses shorter names for the root keys: HKLM, HKU, HKCU, and HKCR are LMachine, Users, CUser, and Classes, respectively. I've used the TieRegistry abbreviations instead of the more standard C/C++-style names because that's what you're likely to see in other Perl code. 8.4.2.2 The code in detailLet's start with line 1: instead of importing the entire Win32 module, the code uses only the TieRegistry module. Notice that we're separating keys and subkeys with slashes instead of a backslashes (that's what we meant by Delimiter => '/' in the use directive). The next line creates the key name we want to open. The big surprise starts on the next line: instead of calling RegOpenKeyEx, the code accesses the registry key of interest by inspecting the $Registry hash, using the key name fabricated with qw as an index into the hash. Perl uses the arrow operator (->) familiar to C and C++ programmers. $Registry is actually a reference to a hash. Perl's references are analogous to a safe implementation of C's pointers. If you have a reference to something, then that reference is guaranteed to be valid; there's no such thing as a NULL reference. Think of $Registry->{$name} as being equivalent to, but safer than, p->field in C. The hash behind $Registry is very special: it's a tied hash. Tied hashes in Perl link the name of a hash entry to code that fetches the corresponding value when you need it. In this case, asking for a key from the $Registry hash actually causes TieRegistry to read the corresponding key with RegOpenKeyEx. Another example of tied hashes is Perl's magic %ENV hash that lets you read and set environment variables by reading from and writing to what appears to be a Perl hash. (See the perltie section of the Perl manual for more details on tied hashes.) One more difference: instead of returning an HKEY, extracting a value from a hash returns another reference to a tied hash that represents the HKEY. It's possible to continue to extract values from the new reference, as the example demonstrates. This is a very nice property, because you can then traverse the registry as a splay tree using the usual recursive algorithm.
8.4.2.3 Opening and closing keys and retrieving valuesBefore you can do anything to a key or value, you must have an open key. You open keys by accessing the value associated with a particular key name. The key name can be the full path of the key you want or a relative path from a key that you already opened. The return value is a new registry object for subkeys or the corresponding value for values: $newobj = $RegObj->{$subkeyname};
$value = $RegObj->{$valuename};
# retrieve type also
$RegObj->ArrayValues(1);
($value, $type) = @{ $RegObj->{$keyname} };
Notice you don't have to explicitly close Registry keys. 8.4.2.4 Creating, adding, and modifying keys and valuesYou can create, add, or modify a subkey or value beneath an open key simply by assigning to a key of the registry object: $RegObj->{$subkeyname} = $newvalue;
As the following example from the Win32::TieRegistry documentation demonstrates, you can also insert arbitrarily nested data: $Registry->ArrayValues(1);
$Registry->{"LMachine/Software/FooCorp/"} = {
"FooWriter/" => {
"/Version" => "4.032",
"Startup/" => {
"/Title" => "Foo Writer Deluxe ][",
"/WindowSize" => [ pack("LL",$wid,$ht), "REG_BINARY" ],
"/TaskBarIcon" => [ "0x0001", "REG_DWORD" ],
},
"Compatibility/" => {
"/AutoConvert" => "Always",
"/Default Palette" => "Windows Colors",
},
},
"/License", => "0123-9C8EF1-09-FC",
};
8.4.2.5 Enumerating keys and valuesTo list a hash's keys, use Perl's keys operator. Note that Win32::TieRegistry uses a special naming convention under which value names start with the delimiter and subkeys end with the delimiter. Enumerate the keys and values using the for operator, like this: my(@keys,@vals);
$RegObj->Delimiter('/');
for (keys %$RegObj) {
if (m<^/(.*)$>s) {
push @vals, $1;
}
elsif (m<^(.*)/$>s) {
push @keys, $1;
}
}
As you'd expect, enumerating the keys doesn't recurse down the tree, so the subkeys in its array represent only the first level beneath the requested key. Example 8.10 illustrates a possible application of key and value enumeration. After opening the key of interest, it enumerates the subkeys and values. Once it has the two lists, it iterates over them with the foreach operator to print each key in the array. Example 8.10. Iterating Through Keys and Values with GetKeys and GetValuesuse Win32::TieRegistry Delimiter => '/';
my $name = join '/',
qw/ LMachine System CurrentControlSet
Services LanmanServer /;
my $key = $Registry->{$name}
or die "$0: can't open $name: $^E\n";
my(@subs,@vals);
for (keys %$key) {
if (m<^/(.*)$>s) {
push @vals, $1;
}
elsif (m<^(.*)/$>s) {
push @subs, $1;
}
}
print "Subkeys of $name:\n",
map( "$_\n", @subs),
"Values of $name:\n",
map( "$_=$key->{$_}\n", @vals);
8.4.2.6 Deleting keys and valuesIn keeping with the theme of functioning just like hashes, use Perl's delete operator to delete keys and values: $old = delete $regObj->{$key_or_value_name};
8.4.2.7 Saving and loading keysWin32::TieRegistry has versions of RegSaveKey and RegLoadKey from the Win32API::Registry module: $regObj->AllowSave(1); $regObj->RegSaveKey($filename, $security); $regObj->AllowLoad(1); $regObj->RegLoadKey($keyname, $filename); The $security argument to RegSaveKey contains a SECURITY_ATTRIBUTES structure that specifies the permissions to be set on $filename. This is typically [], a reference to an empty array. 8.4.2.8 Mixing Win32API::Registry and Win32::TieRegistryThe Win32::TieRegistry module provides an object-oriented interface also. Many of these methods' names are the same as or similar to their Win32API::Registry counterparts (e.g., RegLoadKey and RegSaveKey). Read the Win32::TieRegistry documentation for all the gory details. 8.4.3 Example: Walking the RegistryPerl excels at processing, formatting, searching, and generally handling textual information. Since the Registry is really one big binary blob, you might not think Perl would be a useful language for working with the Registry. However, as any true Perl hacker knows, Perl is useful for everything! In his upcoming book (alas, at the time of this writing, it still doesn't have a title) on functional programming for Perl hackers published by Morgan Kaufmann, Mark Dominus develops a parameterized directory tree walker that takes as arguments two callbacks for processing files and directories. Realizing that directory tree structure and registry structure are practically identical, we can develop a similar tool and put it to use for whatever purpose you wish. Despite its power, the code looks deceptively simple: package RegWalk;
use strict;
use Win32::TieRegistry ArrayValues => 1;
sub import {
no strict 'refs';
my($pkg) = caller;
*{ $pkg . '::' . 'reg_walk' } = \®_walk;
}
sub reg_walk {
my($key, $valfunc, $keyfunc) = @_;
my $info = $Registry->{$key};
if (not defined $info) {
warn "$0: couldn't open registry key:\n" .
" $key ($^E)\n";
return;
}
elsif (ref($info) eq 'Win32::TieRegistry') {
my @results;
foreach my $k (keys %$info) {
push @results,
reg_walk($key . $k, $valfunc, $keyfunc);
}
return $keyfunc->($key, $info, @results)
if $keyfunc;
}
else {
return $valfunc->($key, $info)
if $valfunc;
}
}
1;
To use the RegWalk module, put it somewhere that Perl can find it (one of the directories in the @INC section of the output of perl -V is a good place). Don't worry if you don't understand the import subroutine; it works some behind-the-scenes magic to make reg_walk appear to be defined in the calling package (this particular spell is called exporting). reg_walk takes as arguments a key name, a callback for registry values, and a callback for registry subkeys. It opens the specified key and decides whether it has a subkey or a value. If it has a subkey, it gathers the results from a recursive call to itself (think of it as "drilling" all the way to the bottom in RegEdit) and passes the key name, a reference to a tied hash representing the open key, and the gathered list of results to the registry subkey callback that you provided. (If you want to impress your computer-scientist friends, you can say that it's performing a depth-first search of the registry.) If it sees that it has a value, it passes the key name and a reference to an array of the form: [ $value, $type ] to the Registry value callback that you provided. Not impressed yet? What if I told you that you can use this module to do any possible Registry management task that you could think up? Any task, from deleting everything in your Registry (which I wouldn't recommend) to looking for values that match some regular expression to sending a copy of your Registry to your buddies hiding behind Comet Hale-Bopp (assuming, of course, that you have Net::SubSpace::Transmit installed). The trick is to provide callbacks that do what you want. Philippe Le Berre wrote a small Perl utility, dumpreg.pl, which dumps a specified key (and its subkeys and values) in a nice formatted list. I've updated his code to take advantage of Win32::TieRegistry and RegWalk. The main section of the code (shown in Example 8.11) gets the user's command-line input, validates it (filling in defaults where appropriate), connects to a remote machine if requested (Win32::TieRegistry handles this transparently when it sees key names that look like \\machinename\...), opens the key to be traversed, and opens the output file. If any step fails, the program stops; if they all succeed, the process_key routine gets called. Example 8.11. The Main Section of dumpreg.pluse strict;
use Win32::TieRegistry qw/ :REG_ /;
use RegWalk;
sub usage { "Usage: $0 key [ output-file ]\n" }
my %type = (
REG_SZ( ) => 'REG_SZ',
REG_EXPAND_SZ( ) => 'REG_EXPAND_SZ',
REG_BINARY( ) => 'REG_BINARY',
REG_MULTI_SZ( ) => 'REG_MULTI_SZ',
REG_DWORD( ) => 'REG_DWORD',
);
die usage unless @ARGV >= 1;
my $key = shift;
my $out = shift || 'Hive.key';
my $box;
my $root;
# e.g., \\machine\HKEY_LOCAL_MACHINE..
if ($key =~ /^(?:\\\\(.+?)\\)?(HKEY_[^\\]+)?\\?(.*)/) {
$box = $1 || '';
$root = $2 || '';
$key = $3 || '';
}
my %root = (
HKEY_CLASSES_ROOT => 'Classes',
HKEY_CURRENT_USER => 'CUser',
HKEY_LOCAL_MACHINE => 'LMachine',
HKEY_USERS => 'Users',
HKEY_PERFORMANCE_DATA => 'PerfData',
HKEY_CURRENT_CONFIG => 'CConfig',
HKEY_DYN_DATA => 'DynData',
);
if ($root) {
if (exists $root{$root}) {
$root = $root{$root};
}
else {
die "$0: unknown registry root key: '$root'\n";
}
}
else {
$root = $root{HKEY_LOCAL_MACHINE};
}
$key = $root . '\\' . $key;
$key =~ s/([^\\])$/$1\\/;
print "Dumping:\n",
"'$key'\n";
print "from machine $box...\n" if $box;
open my $file, ">$out" or die "$0: open >$out: $!\n";
process_key $key, $file;
close $file;
process_key itself is shown in Example 8.12. Example 8.12. process_key Does All the Hard Worksub process_key {
my $key = shift;
my $file = shift;
my $total = 0;
my $valfunc = sub {
my $k = shift;
my($val,$type) = @{ shift @_ };
if ($k =~ /^(.+?)\\\\(.*)$/) {
my $parent = $1;
my $name = $2 || '(Default)';
my $depth = $parent =~ tr/\\//;
my $indent = ' ' x $depth;
printf "%03d)$indent$name\n", ++$total;
$val ||= '[empty]';
return "$indent$name\n" .
"$indent $name = $type{$type}\n" .
"$indent $val";
}
else {
warn "$0: unexpected key name: '$k'\n";
}
};
my $keyfunc = sub {
my $k = shift;
my $info = shift;
my @result = @_;
if ($k =~ /^(.+\\)?(.+)\\$/ ) {
my $parent = $1 || '';
my $name = $2;
my $depth = $parent =~ tr/\\//;
my $indent = ' ' x $depth;
printf "%03d)$indent$name\n", ++$total;
unshift @result, "$indent$name";
}
else {
warn "$0: unexpected key name: '$k'\n";
}
return @result;
};
for (reg_walk $key, $valfunc, $keyfunc) {
next unless $_;
print $file $_, "\n";
}
}
The two callbacks, stored in $valfunc and $keyfunc, are the meat of the subroutine. Remember that reg_walk calls the appropriate callback for each subkey and value that it encounters in its traversal. Both callbacks determine the parent key name and the current key name. They then count backslashes in the parent using the tr/// operator to determine the current depth in the tree (i.e., how many levels reg_walk has "drilled down"). Once reg_walk has assembled all the nformation from the callbacks, the code iterates over the resulting list, printing each non-empty result to the output file. Example 8.13 shows another Registry walker that searches case-insensitively for key names containing a particular substring:. Example 8.13. Keyword Searchuse strict;
use RegWalk;
sub findkey {
my $goal = shift;
my $names = shift;
my $val = sub {
my $key = shift;
my($info) = @{ shift @_ };
if ($key =~ /^.*?\\\\(.*)$/) {
my $name = $1 || '(Default)';
if ( index( lc($name), $goal ) >= 0 ) {
return "$key - $info";
}
}
};
my $key = sub {
my $k = shift;
my $info = shift;
my @result = @_;
if ($k =~ /^.*\\(.+)\\$/) {
my $name = $1;
if ( index( lc($name), $goal ) >= 0 ) {
unshift @result, $k;
}
}
return @result;
};
foreach my $root (@$names) {
for (reg_walk $root, $val, $key) {
next unless $_;
print $_, "\n";
}
}
}
## main
my %root = (
HKEY_CLASSES_ROOT => 'Classes',
Classes => 'Classes',
HKEY_CURRENT_USER => 'CUser',
CUser => 'CUser',
HKEY_LOCAL_MACHINE => 'LMachine',
LMachine => 'LMachine',
HKEY_USERS => 'Users',
Users => 'Users',
HKEY_PERFORMANCE_DATA => 'PerfData',
PerfData => 'PerfData',
HKEY_CURRENT_CONFIG => 'CConfig',
CConfig => 'CConfig',
HKEY_DYN_DATA => 'DynData',
DynData => 'DynData',
);
my $goal = shift;
die "Usage: $0 <goal> search...\n" unless $goal;
my @roots;
for (@ARGV) {
unless (exists $root{$_}) {
warn "$0: unknown root key '$_'\n";
next;
}
push @roots, "$root{$_}\\";
}
die "$0: nothing to search!\n" unless @roots;
findkey lc($goal), \@roots;
You might call it like so: findkey perl HKEY_CURRENT_USER |
|
|
|
