The CGI script below allows a system administrator to dynamically update a configuration file through a web interface. This script, combined with the code we have just seen to reload the modified files, gives us a system that is dynamically reconfigurable without having to restart the server. Configuration can be performed from any machine that has a browser.

Let's say we have a configuration file like the one in Example 6-25.

Example 6-25. Book/MainConfig.pm

package Book::MainConfig;

use strict;
use vars qw(%c);

%c = (
      name     => "Larry Wall",
      release  => "5.000",
      comments => "Adding more ways to do the same thing :)",

      other    => "More config values",

      colors   => { foreground => "black",
                    background => "white",
                  },

      machines => [qw( primary secondary tertiary )],

);

We want to make the variables name, release, and comments dynamically configurable. We'll need a web interface with an input form that allows modifications to these variables. We'll also need to update the configuration file and propagate the changes to all the currently running processes.

Let's look at the main stages of the implementation:

  1. Create a form with preset current values of the variables.

  2. Let the administrator modify the variables and submit the changes.

  3. Validate the submitted information (numeric fields should hold numbers within a given range, etc.).

  4. Update the configuration file.

  5. Update the modified value in the current process's memory.

  6. Display the form as before with the (possibly changed) current values.

The only part that seems hard to implement is a configuration file update, for a couple of reasons. If updating the file breaks it, the whole service won't work. If the file is very big and includes comments and complex data structures, parsing the file can be quite a challenge.

So let's simplify the task. If all we want is to update a few variables, why don't we create a tiny configuration file containing just those variables? It can be modified through the web interface and overwritten each time there is something to be changed, so that we don't have to parse the file before updating it. If the main configuration file is changed, we don't care, because we don't depend on it any more.

The dynamically updated variables will be duplicated in the main file and the dynamic file. We do this to simplify maintenance. When a new release is installed, the dynamic configuration file won't exist—it will be created only after the first update. As we just saw, the only change in the main code is to add a snippet to load this file if it exists and was changed.

This additional code must be executed after the main configuration file has been loaded. That way, the updated variables will override the default values in the main file. See Example 6-26.

Example 6-26. manage_conf.pl

# remember to run this code in taint mode
use strict;
use vars qw($q %c $dynamic_config_file %vars_to_change %validation_rules);

use CGI ( );

use lib qw(.);
use Book::MainConfig ( );
*c = \%Book::MainConfig::c;

$dynamic_config_file = "./config.pl";

# load the dynamic configuration file if it exists, and override the
# default values from the main configuration file
do $dynamic_config_file if -e $dynamic_config_file and -r _;

# fields that can be changed and their captions
%vars_to_change =
  (
   'name'     => "Patch Pumpkin's Name",
   'release'  => "Current Perl Release",
   'comments' => "Release Comments",
  );

# each field has an associated regular expression
# used to validate the field's content when the
# form is submitted
%validation_rules =
  (
   'name'     => sub { $_[0] =~ /^[\w\s\.]+$/;   },
   'release'  => sub { $_[0] =~ /^\d+\.[\d_]+$/; },
   'comments' => sub { 1;                        },
  );

# create the CGI object, and print the HTTP and HTML headers
$q = CGI->new;
print $q->header(-type=>'text/html'), 
      $q->start_html( );

# We always rewrite the dynamic config file, so we want all the
# variables to be passed, but to save time we will only check
# those variables that were changed.  The rest will be retrieved from
# the 'prev_*' values.
my %updates = ( );
foreach (keys %vars_to_change) {
    # copy var so we can modify it
    my $new_val = $q->param($_) || '';

    # strip a possible ^M char (Win32)
    $new_val =~ s/\cM//g;

    # push to hash if it was changed
    $updates{$_} = $new_val
        if defined $q->param("prev_" . $_)
           and $new_val ne $q->param("prev_" . $_);
}

# Note that we cannot trust the previous values of the variables
# since they were presented to the user as hidden form variables,
# and the user could have mangled them. We don't care: this can't do
# any damage, as we verify each variable by rules that we define.

# Process if there is something to process. Will not be called if
# it's invoked the first time to display the form or when the form
# was submitted but the values weren't modified (we'll know by
# comparing with the previous values of the variables, which are
# the hidden fields in the form).

process_changed_config(%updates) if %updates;

show_modification_form( );
 
# update the config file, but first validate that the values are
# acceptable
sub process_changed_config {
    my %updates = @_;

    # we will list here all variables that don't validate
    my %malformed = ( );

    print $q->b("Trying to validate these values<br>");
    foreach (keys %updates) {
        print "<dt><b>$_</b> => <pre>$updates{$_}</pre>";

        # now we have to handle each var to be changed very carefully,
        # since this file goes immediately into production!
        $malformed{$_} = delete $updates{$_}
            unless $validation_rules{$_}->($updates{$_});

    }   

    if (%malformed) {
        print $q->hr,
            $q->p($q->b(qq{Warning! These variables were changed
                           to invalid values. The original
                           values will be kept.})
                 ),
            join ",<br>",
                 map { $q->b($vars_to_change{$_}) . " : $malformed{$_}\n"
                     } keys %malformed;
    }

    # Now complete the vars that weren't changed from the
    # $q->param('prev_var') values
    map { $updates{$_} = $q->param('prev_' . $_)
              unless exists $updates{$_} } keys %vars_to_change;

    # Now we have all the data that should be written into the dynamic
    # config file

    # escape single quotes "'" while creating a file
    my $content = join "\n",
        map { $updates{$_} =~ s/(['\\])/\\$1/g;
              '$c{' . $_ . "} = '" . $updates{$_} . "';\n"
            } keys %updates;

    # add '1;' to make require( ) happy
    $content .= "\n1;";

    # keep the dummy result in $res so it won't complain
    eval {my $res = $content};
    if ($@) {
        print qq{Warning! Something went wrong with config file
                 generation!<p> The error was :</p> <br><pre>$@</pre>};
        return;
    }

    print $q->hr;

    # overwrite the dynamic config file
    my $fh = Apache::gensym( );
    open $fh, ">$dynamic_config_file.bak"
        or die "Can't open $dynamic_config_file.bak for writing: $!";
    flock $fh, 2; # exclusive lock
    seek $fh, 0, 0; # rewind to the start
    truncate $fh, 0; # the file might shrink!
    print $fh $content;
    close $fh;

    # OK, now we make a real file
    rename "$dynamic_config_file.bak", $dynamic_config_file
        or die "Failed to rename: $!";

    # rerun it to update variables in the current process! Note that
    # it won't update the variables in other processes. Special
    # code that watches the timestamps on the config file will do this
    # work for each process. Since the next invocation will update the
    # configuration anyway, why do we need to load it here? The reason
    # is simple: we are going to fill the form's input fields with
    # the updated data.
    do $dynamic_config_file;

}

sub show_modification_form {

    print $q->center($q->h3("Update Form"));
  
    print $q->hr,
        $q->p(qq{This form allows you to dynamically update the current
           configuration. You don't need to restart the server in
           order for changes to take an effect}
             );
  
    # set the previous settings in the form's hidden fields, so we
    # know whether we have to do some changes or not
    $q->param("prev_$_", $c{$_}) for keys %vars_to_change;
  
    # rows for the table, go into the form
    my @configs = ( );
  
    # prepare text field entries
    push @configs,
        map {
          $q->td( $q->b("$vars_to_change{$_}:") ),
          $q->td(
           $q->textfield(
                 -name      => $_,
                 -default   => $c{$_},
                 -override  => 1,
                 -size      => 20,
                 -maxlength => 50,
                )
          ),
        } qw(name release);
  
    # prepare multiline textarea entries
    push @configs,
        map {
          $q->td( $q->b("$vars_to_change{$_}:") ),
          $q->td(
           $q->textarea(
                -name     => $_,
                -default  => $c{$_},
                -override => 1,
                -rows     => 10,
                -columns  => 50,
                -wrap     => "HARD",
                )
          ),
        } qw(comments);
  
    print $q->startform(POST => $q->url), "\n",
          $q->center(
              $q->table(map {$q->Tr($_), "\n",} @configs),
              $q->submit('', 'Update!'), "\n",
          ),
          map ({$q->hidden("prev_" . $_, $q->param("prev_".$_)) . "\n" }
               keys %vars_to_change), # hidden previous values
          $q->br, "\n",
          $q->endform, "\n",
          $q->hr, "\n",
          $q->end_html;
  
}

For example, on July 19 2002, Perl 5.8.0 was released. On that date, Jarkko Hietaniemi exclaimed:

The pumpking is dead! Long live the pumpking!

Hugo van der Sanden is the new pumpking for Perl 5.10. Therefore, we run manage_conf.pl and update the data. Once updated, the script overwrites the previous config.pl file with the following content:

$c{release}  =  '5.10';

$c{name}  =  'Hugo van der Sanden';

$c{comments}  =  'Perl rules the world!';

1;

Instead of crafting your own code, you can use the CGI::QuickForm module from CPAN to make the coding less tedious. See Example 6-27.

Example 6-27. manage_conf.pl

use strict;
use CGI qw( :standard :html3 ) ;
use CGI::QuickForm;
use lib qw(.);
use Book::MainConfig ( );
*c = \%Book::MainConfig::c;

my $TITLE = 'Update Configuration';
show_form(
    -HEADER => header . start_html( $TITLE ) . h3( $TITLE ),
    -ACCEPT => \&on_valid_form,
    -FIELDS => [
        {
            -LABEL      => "Patch Pumpkin's Name",
            -VALIDATE   => sub { $_[0] =~ /^[\w\s\.]+$/;   },
            -default    => $c{name},
        },
        {
            -LABEL      => "Current Perl Release",
            -VALIDATE   => sub { $_[0] =~ /^\d+\.[\d_]+$/; },
            -default    => $c{release},
        },
        {
            -LABEL      => "Release Comments",
            -default    => $c{comments},
        },
        ],
    );

sub on_valid_form {
    # save the form's values
}

That's it. show_form( ) creates and displays a form with a submit button. When the user submits, the values are checked. If all the fields are valid, on_valid_form( ) is called; otherwise, the form is re-presented with the errors highlighted.