Steve Litt's Perls of Wisdom:
Perl Hash Reference Examples
Copyright (C) 2000 by Steve Litt
Contents
Introduction
smb.conf Share Program
ifconfig Parser and Reporter
Creating a Browser Shell for Your Reports
Introduction
This page has a few examples using references to hashes, primarily to simulate
in-memory databases.
smb.conf Share Program
This program reads the Samba configuration file as arg0, and stores the
entire contents as a hash of anonomyous hashes, such that each share name
is a key name of the top level hash, and the share parameters are hash
key-value pairs contained in an anonomous hash which is the value associated
with the share name. Here's the program:
#!/usr/bin/perl -w
use strict;
sub usage() { print "\n\nProgram shares. Syntax:\n"; print "./shares conffile sharename # prints out params for sharename\n"; print "./shares conffile # prints out params for all shares\n"; print "Anything else prints out this message.\n\n"; }
sub newShare(\%$) { %{$_[0]} = ("sharename"=>$_[1]); }
sub parseSmbDotConf($) { open(CONFIGFILE, "<" . $_[0]) || die "Cannot read file $_[0]\n"; my(@configMemoryImage) = <CONFIGFILE>; close(CONFIGFILE);
my($state) = "init"; my(%allShares);
my(%share); my($configLine); foreach $configLine (@configMemoryImage) { if($configLine =~ /^\s*$/) {next;}; #Blow off blank lines chomp($configLine); $configLine =~ s/^\s+//; #Delete leading blanks $configLine =~ s/\s+$//; #Delete trailing blanks $configLine =~ s/;.*//; #Delete comments $configLine =~ s/#.*//; #Delete comments if($state eq "init") { newShare(%share, "GLOBAL"); #Leading params w/o share are [GLOBAL] $state = "init2"; }
if($configLine =~ /^\s*\[\s*(.+)\s*\]\s*$/) #if bracket line { if($state ne "init2") { ### RECORD PRIOR SHARE IN %allShares ### $allShares{$share{"sharename"}} = {%share}; } newShare(%share, uc($1)); $state = "brackets"; } elsif($configLine =~ /^\s*(.+?)\s*=\s*(.+)\s*$/) #if param line { my($key) = uc($1); my($value) = $2; $key =~ s/\s//g; $share{$key} = $value; $state = "param"; } } ### ADD FINAL SHARE TO %allShares ### $allShares{$share{"sharename"}} = {%share}; return(%allShares); }
sub displayOneShare(\%$) { my(%allShares) = %{(shift)}; my($shareName) = shift; my(%share) = %{$allShares{$shareName}}; my($key,$value); print "\n\n********** [$shareName] **********\n"; foreach $key (sort(keys(%share))) { print "$key=" . $share{$key} . "\n"; } }
sub displayAll(\%) { my(%allShares) = %{(shift)}; my($key,$value); foreach $key (sort(keys(%allShares))) { displayOneShare(%allShares, $key) } }
sub main() { my(%shares); if($#ARGV < 0) { usage(); } else { %shares = parseSmbDotConf($ARGV[0]); if($#ARGV == 0) { displayAll(%shares); } elsif($#ARGV == 1) { displayOneShare(%shares, uc($ARGV[1])); } else { usage(); } } }
main();
|
The usage() subroutine prints a syntax diagram, and the newShare(\%$)
subroutine empties its hash arg of all elements, and then adds an element
called "sharename" whose value is the second argument. This emptying is
done in preparation for the adding of elements gleaned from a parsing of
the Samba config file.
Subroutine parseSmbDotConf($) does that parsing and element adding.
It first declares an empty hash (%allShares) to hold all shares, and a
hash (%share) to hold all the parameters in the current share, then reads
through the file, ignoring blank lines and trimming space from the start
and end of each line. On encountering a string in brackets, which is the
beginning of a new share, it saves the prior share to %allShares, using
the share name as a key, and then "zeroes out" the new share with a call
to newShare(\%$). State indicator $state prevents an empty share from being
written the first time through, and also accommodates config files that
start with a share (typically but not necesssarily [global]), and those
that start with parameters, which by Samba specifications are part of the
[global] share. After all lines have been parsed the current share is saved
to %allShares, and %allShares is returned via the subroutine return. The
main routine assigns that hash to a variable called %shares, which is a
hash whose element values are themselves anonymous hashes. To summarize,
parseSmbDotConf($) parses the Samba config file into a hash of hashes suitable
for passing to other subroutines.
One of those routines is displayOneShare(\%$). This routine takes the
hash of hashes, and picks out the element whose share name is the second
argument. It then prints all keys and values for that share, in key-alpha
order.
Subroutine displayAll(\%) is passed the hash of hashes as an arg, loops
through the keys, and calls displayOneShare(\%$) for each. The main routine
checks command line syntax and determines whether to print a single share
or all shares.
Please spend some time acquainting yourself with the referencing and
dereferencing of the hashes. Note also that this program is written in
the new, prototyped syntax, and therefore the caller passes without the
backslash. Note also that all subroutine calls *must* be to subroutines
already defined, or non-obvious and hard to
troubleshoot runtime errors will result.
ifconfig Parser and Reporter
Given the existence of Samba's testparm program, the preceding example
was of academic interest only. The parsing task was trivial, and it basically
did nothing but regurgitate smb.conf, although a few modifications could
make it useful.
This program will be presented in two sections: Fixed Output and Configurable
Reports. The first section is academic like the preceding example, where
the ifconfig output is parsed into a hash of hashes, and that hash of hashes
is looped through to produce output. It's little more than a neater formatting
of the ifconfig command. The second section adds configurable reporting
capabilities, and as such is quite useful. Furthermore, such a program
can be written to parse and write configurable reports on anything.
Basic Fixed Output Program
In the Samba Config File parser, few parameters were common to several
shares. Contrast this to the ifconfig parser, where the hash of hashes
is very much like a database, where the elements of the containing hash
can be considered records (and because it's a hash it's indexed), while
the elements of the contained hashes can be considered the columns. Note
in this program all devices have an IP address, a netmask, and an interface
type. Packet and error counts are common to all primary interfaces (as
opposed to "virtual" interfaces like eth0:0).
All information can be defined by a list of fields. This is implemented
in the newInterface(\%$) routine. You can see the fields in its source
code. The isValidField(\%$) routine tests a given field name for existence
in the hash, and if it hasn't put there by newInterface(\%$) it's assumed
invalid. All recording of field values is done by the setField(\%$$) routine,
which prevents insertion of data in a key not already contained by the
hash created by newInterface(\%$). The result is that every hash serves
as a "record" or "row" for its interface, and each such hash has all the
same "fields". This is important in reporting, which is covered in the
section on Adding Configurable Report Capability.
The program starts by creating a memory image of the output of the ifconfig
command, using the ifconfig2list() subroutine to deliver a list whose each
element is a line from the ifconfig output. That list then forms the input
to sub parseIfconfig(\@), which parses the memory image into a hash of
hashes, which is returned to the main programming.
#!/usr/bin/perl -w
use strict;
sub ifconfig2list() { my(@configList) = `/sbin/ifconfig`; return(@configList); }
sub newInterface(\%$) { %{$_[0]} = (); %{$_[0]} = ( "a_bcast" => "", "a_inet" => "", "a_mask" => "", "hw_addr" => "", "hw_irq" => "", "i_mac" => "", "i_name" => $_[1], "i_type" => "", "n_collide" => "", "n_txqlen" => "", "rx_drop" => "", "rx_errs" => "", "rx_frame" => "", "rx_overrun" => "", "rx_packets" => "", "tx_carrier" => "", "tx_drop" => "", "tx_errs" => "", "tx_overrun" => "", "tx_packets" => "" ); }
sub isValidField(\%$) { return(defined(${$_[0]}{$_[1]})) }
sub setField(\%$$) { isValidField(%{$_[0]}, $_[1]) or die "\n\nInternal programming error, illegal field name >$_[1]<\n"; ${$_[0]}{$_[1]} = $_[2]; }
sub parseIfconfig(\@) { my(@ifconfigMemoryImage) = ifconfig2list();
my($state) = "init"; my(%allInterfaces);
my(%interface); my($ifconfigLine); foreach $ifconfigLine (@ifconfigMemoryImage) { if($ifconfigLine =~ /^\s*$/) {next;}; #Blow off blank lines chomp($ifconfigLine); $ifconfigLine =~ s/\s+$//; #Delete trailing blanks if($ifconfigLine =~ /^(\S+)/) #if new interface { my($newName) = $1; if($state ne "init") { ### RECORD PRIOR INTERFACE IN %allInterfaces ### $allInterfaces{$interface{"i_name"}} = {%interface}; } newInterface(%interface, $newName); newInterface(%interface, $newName); if($ifconfigLine =~ /Link encap:(.+)\s+HWaddr\s+(\S+)/) { setField(%interface, "i_type", $1); setField(%interface, "i_mac", $2); } elsif($ifconfigLine =~ /Link encap:(.+)/) { $interface{"i_type"} = $1; setField(%interface, "i_type", $1); } $state = "finishedfirstline"; } elsif($ifconfigLine =~ /^\s+inet addr:(\S+)/) { $interface{"a_inet"} = $1; setField(%interface, "a_inet", $1); if($ifconfigLine =~ /Bcast:(\S+)/) {setField(%interface, "a_bcast", $1);} if($ifconfigLine =~ /Mask:(\S+)/) {setField(%interface, "a_mask", $1);} $state = "finishedinetaddr"; } elsif($ifconfigLine =~ /^\s+RX packets:(\S+)/) { $interface{"rx_packets"} = $1; if($ifconfigLine =~ /\berrors:(\S+)/) {setField(%interface, "rx_errs", $1);} if($ifconfigLine =~ /\bdropped:(\S+)/) {setField(%interface, "rx_drop", $1);} if($ifconfigLine =~ /\boverruns:(\S+)/) {setField(%interface, "rx_overrun", $1);} if($ifconfigLine =~ /\bframe:(\S+)/) {setField(%interface, "rx_frame", $1);} $state = "finished_rx"; } elsif($ifconfigLine =~ /^\s+TX packets:(.+?)\s+/) { setField(%interface, "tx_packets", $1); if($ifconfigLine =~ /\berrors:(\S+)/) {setField(%interface, "tx_errs", $1);} if($ifconfigLine =~ /\bdropped:(\S+)/) {setField(%interface, "tx_drop", $1);} if($ifconfigLine =~ /\boverruns:(\S+)/) {setField(%interface, "tx_overrun", $1);} if($ifconfigLine =~ /\bcarrier:(\S+)/) {setField(%interface, "tx_carrier", $1);} $state = "finished_tx"; } elsif($ifconfigLine =~ /^\s+Metric:(.+?)\b/) { setField(%interface, "z_metric", $1); if($ifconfigLine =~ /^\bMTU:(.+?)\b/) {setField(%interface, "z_mtu", $1);} ## "UP BROADCAST RUNNING MULTICAST MTU:1500 Metric:1" unimplemented $state = "finished_state"; } else { if($ifconfigLine =~ /\bcollisions:(\S+)/) {setField(%interface, "n_collide", $1);} if($ifconfigLine =~ /\btxqueuelen:(\S+)/) {setField(%interface, "n_txqlen", $1);} if($ifconfigLine =~ /\bInterrupt:(\S+)/) {setField(%interface, "hw_irq", $1);} if($ifconfigLine =~ /\bBase address:(\S+)/) {setField(%interface, "hw_addr", $1);} $state = "finished_misc"; } } ### ADD FINAL INTERFACE TO %allInterfaces ### $allInterfaces{$interface{"i_name"}} = {%interface}; return(%allInterfaces); }
sub displayOneInterface(\%$) { my(%allInterfaces) = %{(shift)}; my($interfaceName) = shift; my(%interface) = %{$allInterfaces{$interfaceName}}; my($key,$value); print "\n\n[$interfaceName]======================================\n"; foreach $key (sort(keys(%interface))) { print "$key=" . $interface{$key} . "\n"; } }
sub displayAll(\%) { my(%allInterfaces) = %{(shift)}; my($key,$value); foreach $key (sort(keys(%allInterfaces))) { displayOneInterface(%allInterfaces, $key) } }
sub main() { my(@lines) = ifconfig2list(); my(%interfaces) = parseIfconfig(@lines); displayAll(%interfaces); }
main();
|
The parseIfconfig(\@) routine is a typical elsif type parser whose parsing
depends almost exclusively on the contents of the current line, without
regard to already read lines. However, it maintains a state variable ($state)
so that the algorithm can be used to parse a file whose actions depend
not only on the current line, but also on what's come before. The state
variable is also used to prevent writing an empty record the first shot
through the loop.
Break logic is accomplished by detecting a non-whitespace in column
1, which in the ifconfig output signifies a new interface. At that point
the present interface's hash is saved to the hash of hashes under that
interface's name, then the hash is initialized for the new interface. This
break logic requires saving the last interface to the hash of hashes after
the loop terminates.
The parseIfconfig(\@) routine returns a hash to the main routine. The
values of that hashes elements are hashes themselves, each of which represents
an interface. The displayAll(\%) routine takes the hash of hashes as an
argument, and prints each interface record by calling displayOneInterface(\%$)
for each key of the hash of hashes. As in the previous example, you should
note the dereferencing used in displayOneInterface(\%$).
This program is useful because it provides a more readable format for
the ifconfig program, but such a reformatting could certainly be accomplished
without hashes of hashes, etc. The real convenience comes when you add
routines to implement configurable reporting. Read on...
Adding Configurable Report Capability
What we want to do here is to produce a sorted columnar report showing
only the desired fields, in the order desired, sorted from the leftmost
field to the rightmost. The configuration is defined in a file whose format
looks something like the following:
rx_errs{8} tx_errs{8} i_name{12} a_inet{16} a_mask{16} a_bcast{16}
|
The preceding delivers a columnar report showing the fields from left
to right in the order shown in the report definition file, and sorted by
those fields. The numbers in the braces are the field widths. In all cases
one space is added at the end to facilitate field separation. If a field's
contents are longer than the width, it's truncated. If the field's contents
are shorter than the field width, the field is backpadded with space. Headings
are produced by a similar algorithm, except that it's the field names that
are compared, truncated or padded.
Part of the specification is to abort if a field in the report definition
file does not match the fields defined in newInterface(\%$), the program
is aborted with a meaningful error message. Case counts. This was decided
to facilitate interfacing with other systems where case counts. It's easy
enough to write down the right field names.
To further facilitate correct field names, a subroutine is defined whose
sole purpose is to output the field names. This subroutine, called showFieldNames(),
can have its output piped to a file for easy report configuration.
To make this program into a comfigurable reporting program, you need
to add several subroutines and replace the main() subroutine. Subroutine
definition order is important. Place the following routines, in this order,
below all other subroutines except main():
-
sub usage()
-
sub printFields()
-
sub acquireReportFieldList($)
-
sub makeReportString(\%\@)
-
sub makeHeadings(\@)
-
sub makeReport(\%$)
The explanations of these subroutines are given following the code listing.
sub usage() { print "\n\nProgram ifclook, to run ifconfig and report on interfaces. Syntax:\n"; print "ifclook {report reportfile|fields|full}\n\n"; print "report creates report with fields in reportfile, sorted\n"; print "fields lists the fields available to list\n"; print "full lists all info for all interfaces\n\n"; }
sub printFields() { my(%dummyInterface); newInterface(%dummyInterface, "dummy"); print "The reportable fields, in alpha order, are:\n"; print(join("\n", sort(keys(%dummyInterface)))); print "\n"; }
sub acquireReportFieldList($) { my($reportFormatFile) = shift; my(@fields); my(%dummyInterface); newInterface(%dummyInterface, "dummy"); open(REPORTFORMATFILE, "<" . $reportFormatFile) or die "Cannot open report definition file $reportFormatFile\n"; while(<REPORTFORMATFILE>) { my($line) = $_; chomp($line); push(@fields, $line); $line =~ m/^(.+)\{/; isValidField(%dummyInterface, $1) or die "Bad field name >$1< in report definition $reportFormatFile.\n"; } close(REPORTFORMATFILE); return(@fields); }
sub makeReportString(\%\@) { my(%record) = %{(shift)}; my(@fields) = @{(shift)}; my($recordString); my($lengthString) = "0"; my($blankString) = " "; $blankString = $blankString . $blankString . $blankString . $blankString; $blankString = $blankString . $blankString . $blankString . $blankString; my($field); foreach $field (@fields) { chomp($field); if($field =~ /(\S+)\{(.+)\}/) { my($fieldName) = $1; my($fieldValue) = $record{$fieldName}; if(!defined($fieldValue)) { $fieldValue = "|n/a$fieldName|"; } my($fieldLength) = length($fieldValue); $lengthString = $2; if($lengthString eq "n") { $lengthString = 1000; } elsif ($lengthString eq "") { $lengthString = 0; } elsif (!defined($lengthString)) { $lengthString = 0; } elsif($lengthString =~ /^\d+$/) {$lengthString = $lengthString; } else { $lengthString = 0; } if($lengthString == 0) { $recordString .= ($fieldValue . ", "); } elsif ($lengthString == 1000) { $recordString .= ($fieldValue . "\n"); } elsif ($lengthString > $fieldLength) { $recordString .= $fieldValue; $recordString .= substr($blankString, 0, 1 + $lengthString - $fieldLength); } else { $recordString .= substr($fieldValue, 0, $lengthString -1); $recordString .= " "; } } #end if regex } #end foreach return($recordString); }
sub makeHeadings(\@$) { my(@fields) = @{(shift)}; my($reportDefinitionFilename) = shift; my(%dummyInterface); newInterface(%dummyInterface, "dummy"); my($field); my($blankString) = " "; $blankString = $blankString . $blankString . $blankString . $blankString; my($dashString) = "-------------------"; $dashString = $dashString . $dashString . $dashString . $dashString; my($headingString) = "\nReport definition $reportDefinitionFilename, "; $headingString .= "run date "; $headingString .= `date +"%Y/%m/%d @ %H:%M:%S"`; $headingString .= "\n\n"; foreach $field (@fields) { chomp($field); if($field =~ /(\S+)\{(.+)\}/) { my($fieldName) = $1; my($fieldLength) = length($fieldName); my($lengthString) = $2; if($lengthString eq "n") { $lengthString = 1000; } elsif ($lengthString eq "") { $lengthString = 0; } elsif (!defined($lengthString)) { $lengthString = 0; } elsif($lengthString =~ /^\d+$/) {$lengthString = $lengthString; } else { $lengthString = 0; }
if($lengthString == 0) { $headingString .= ($fieldName . ", "); } elsif ($lengthString == 1000) { $headingString .= ($fieldName); last; } elsif ($lengthString > $fieldLength) { $headingString .= $fieldName; $headingString .= substr($blankString, 0, 1 + $lengthString - $fieldLength); } else { $headingString .= substr($fieldName, 0, $lengthString); $headingString .= " "; } } #end if regex } #end foreach $headingString .= "\n$dashString\n"; return($headingString); }
sub makeReport(\%$) { my($reportString); my(@reportStrings); my(%records) = %{(shift)}; my($reportFormatFile) = shift; my(@fields) = acquireReportFieldList($reportFormatFile);
print makeHeadings(@fields,$reportFormatFile); my($key); foreach $key (sort(keys(%records))) { my(%rec) = %{$records{$key}}; push(@reportStrings, makeReportString(%rec, @fields)); } print join("\n", sort(@reportStrings)); print "\n"; }
|
The usage() subroutine prints out how the program is used.
The printFields() subroutine prints out all field names, in alpha order.
These are the only field names acceptable in report definition files. Case
counts. The best way to use this functionality is to redirect it to a new
report definition file, after which formatting is a simple matter of reordering,
deleting unneeded fields, and appending field lengths in braces.
The acquireReportFieldList($) subroutine uses the filename contained
in its argument as the report definition file filename, reads the file,
and returns a list of field names and their lengths, in the same format
as in the file itself. It's the responsibility of subroutines using this
list to parse out the name and length.
Subroutine makeReportString(\%\@) takes two arguments, the first being
a hash defining all fields for a specific interface. The second argument
is a list of fields to be reported on, in the proper order, with field
lengths (the list returned by acquireReportFieldList($)). makeReportString(\%\@)
returns a properly spaced string containing the proper fields in the proper
order. This subroutine is called for each interface by sub makeReport(\%$).
It is called exclusively by makeReport(\%$).
Subroutine makeHeadings(\@) produces a properly spaced header including
field names, based on the field list in its argument. Once again, the field
list is the return from acquireReportFieldList($). Subroutine makeHeadings(\@)
is called exclusively by the makeReport(\%$) subroutine.
Subroutine makeReport(\%$) has total responsibility for making the report.
The first arg is a hash having an element for each interface. The key of
each element is the interface name, while the value is an anonymous hash
reference. This hash has all information about all interfaces. The second
argument is the name of the report definition file. Based on these two
arguments, a complete report can be made. This subroutine works its magic
by delegating the work to makeHeadings(\@), makeReportString(\%\@), and
acquireReportFieldList($).
sub main() { my(@lines) = ifconfig2list(); my(%interfaces) = parseIfconfig(@lines);
if($#ARGV < 0) { usage(); } elsif($ARGV[0] eq "report") { if($#ARGV == 1) { makeReport(%interfaces, $ARGV[1]); } else { usage(); } } elsif($ARGV[0] eq "full") { if($#ARGV == 0) { displayAll(%interfaces); } else { usage(); } } elsif($ARGV[0] eq "fields") { if($#ARGV == 0) { printFields(); } else { usage(); } } else { usage(); } }
main();
|
The preceding main routine is self-explanitory. According to your command
line, it calls either printFields(), makeReport(), displayAll(), or usage().
Be sure to include the call to main() at the bottom, or your program will
do nothing.
Creating a Browser Shell for Your Reports
Warning! As written here, this script is
a security risk for any production or Internet connected computer. Adopt
a level of security appropriate to your environment before implementing
this script!
The reports discussed earlier on this page work just fine on your Linux
desktop. It's likely that these reports, or something like them, need to
be accessed by clerical employees on their browsers -- possibly Windows
or Mac hosted browsers. Fortunately that's not difficult. You need to write
a CGI script to act as a shell to the reporting commands, and pass them
in after the question mark in the URL. The following is the CGI script
acting as a browser shell:
#!/usr/bin/perl -w # By Steve Litt # PUBLIC DOMAIN, NO WARRANTEE. USE AT YOUR OWN RISK # THIS SCRIPT IS A KNOWN SERIOUS SECURITY RISK # MODIFY AS NECESSARY TO PREVENT PROBLEMS AT YOUR SITE
use strict; sub decode($) { $_[0] =~ s/\+/ /g; ### Change + to space my(@parts) = split /%/, $_[0]; my($returnstring) = "";
(($_[0] =~ m/^\%/) ? (shift(@parts)) : ($returnstring = shift(@parts)));
my($part); foreach $part (@parts) { $returnstring .= chr(hex(substr($part,0,2))); my($tail) = substr($part,2); $returnstring .= $tail if (defined($tail)); } return($returnstring); }
sub printHeader() { print "Content-type: text/html\n\n<html><body><pre>\n"; }
sub printReport() { my($cmd) = decode($ENV{"QUERY_STRING"}) . " 2>&1"; my(@lines) = `$cmd`; my($line); foreach $line (@lines) { chomp($line); print $line . "\n"; } }
sub printFooter() { print "</pre></body></html>"; }
sub main() { printHeader(); printReport(); printFooter(); }
main();
|
Assume the script that reports on the ifconfig program is called ifclook,
and the CGI shell to make ifclook available on browsers is called showrpt.cgi.
In my case, my ifclook script is in /home/slitt/sample, while the showrpt.cgi
script, to be web accessible, must be in /home/slitt/public_html. Therefore,
I can web access the report, using report definition file inet.rpt in the
sample directory, with the following url:
http://mydesk.domain.cxm/~slitt/showrpt.cgi?../sample/ifclook+report+../sample/inet.rpt
|
Because Linux demands a full path to executables not on the path, you
must precede ifclook by ./ even if ifclook (or whatever other command you
want to run) is in the same directory as showrpt.cgi.
WARNING! Do not use the preceding showrpt.cgi
script in an environment requiring security. As is obvious, a simple change
of url can do anything the default Apache user is capable of, including
pulling up the /etc/passwd file or deleting files. Change the script as
appropriate to protect your environment.
You may wish to start by preventing commands outside
the current directory, and hardcoding the ./, and possibly hardcoding an
extension on the report script.
Do not use the showrpt.cgi script on a production or
Internet-connected box until you have fixed these security issues!!!
[ Troubleshooters.com
| Code Corner | Email
Steve Litt ]
Copyright
(C)1998 by Steve Litt --
Legal