Troubleshooters.Com and Code Corner Present

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():

    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