git.gag.com Git - debian/amanda/blob - installcheck/Installcheck/Config.pm

   1 # vim:ft=perl
   2 # Copyright (c) 2005-2008 Zmanda Inc.  All Rights Reserved.
   3 #
   4 # This program is free software; you can redistribute it and/or modify it
   5 # under the terms of the GNU General Public License version 2 as published
   6 # by the Free Software Foundation.
   7 #
   8 # This program is distributed in the hope that it will be useful, but
   9 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  10 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  11 # for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License along
  14 # with this program; if not, write to the Free Software Foundation, Inc.,
  15 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  16 #
  17 # Contact information: Zmanda Inc, 465 S Mathlida Ave, Suite 300
  18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  19
  20 package Installcheck::Config;
  21 use Amanda::Paths;
  22 use Amanda::Constants;
  23 use File::Path;
  24 use Carp;
  25
  26 =head1 NAME
  27
  28 Installcheck::Config - set up amanda configurations for installcheck testing
  29
  30 =head1 SYNOPSIS
  31
  32   use Installcheck::Config;
  33
  34   my $testconf = Installcheck::Config->new();
  35   $testconf->add_param("runtapes", "5");
  36   $testconf->add_subsec("tapetype", "DUCKTAPE", { length => "10G", filemark => "4096k" });
  37   # ...
  38   $testconf->write();
  39
  40 The resulting configuration is always named "TESTCONF".  The basic
  41 configuration contains only a few parameters that are necessary
  42 just to run Amanda applications in the test environment.  It also
  43 contains a tapetype, C<TEST-TAPE>.  To change tapetype parameters,
  44 call C<$cf->add_tapetype> with a new definition of C<TEST-TAPE>.
  45
  46 Note that it's quite possible to produce an invalid configuration with this
  47 package (and, in fact, some of the tests do just that).
  48
  49 =head1 WARNING
  50
  51 Using this module I<will> destroy any existing configuration named
  52 TESTDIR.  I<Please> do not use this on a production machine!
  53
  54 =head1 FUNCTIONS
  55
  56 =over
  57
  58 =item C<new()>
  59
  60 Create a new configuration object
  61
  62 =cut
  63
  64 sub new {
  65     my $class = shift;
  66
  67     # An instance is a blessed hash containing parameters.  Start with
  68     # some defaults to make sure things run.
  69     my $infofile = "$CONFIG_DIR/TESTCONF/curinfo";
  70     my $logdir = "$CONFIG_DIR/TESTCONF/log";
  71     my $indexdir = "$CONFIG_DIR/TESTCONF/index";
  72
  73     my $self = {
  74         'infofile' => $infofile,
  75         'logdir' => $logdir,
  76         'indexdir' => $indexdir,
  77
  78         # Global params are stored as an arrayref, so that the same declaration
  79         # can appear multiple times
  80         'params' => [
  81             'dumpuser' => '"' . (getpwuid($<))[0] . '"', # current username
  82
  83             # These dirs are under CONFIG_DIR just for ease of destruction.
  84             # This is not a recommended layout!
  85             'infofile' => "\"$infofile\"",
  86             'logdir' => "\"$logdir\"",
  87             'indexdir' => "\"$indexdir\"",
  88
  89             # (this is actually added while writing the config file, if not
  90             # overridden by the caller)
  91             # 'tapetype' => '"TEST-TAPE"',
  92         ],
  93
  94         # global client config
  95         'client_params' => [
  96             'amandates' => "\"$AMANDA_TMPDIR/TESTCONF/amandates\"",
  97             'gnutar_list_dir' => "\"$AMANDA_TMPDIR/TESTCONF/gnutar_listdir\"",
  98         ],
  99
 100         # config-specific client config
 101         'client_config_params' => [
 102         ],
 103
 104         # Subsections are stored as a hashref of arrayrefs, keyed by
 105         # subsection name
 106
 107         'tapetypes' => [ ],
 108         'dumptypes' => [ ],
 109         'interfaces' => [ ],
 110         'holdingdisks' => [ ],
 111         'application-tool' => [ ],
 112         'script-tool' => [ ],
 113         'devices' => [ ],
 114         'changers' => [ ],
 115
 116         'dles' => [ ],
 117     };
 118     bless($self, $class);
 119
 120     $self->add_tapetype('TEST-TAPE', [
 121         'length' => '50 mbytes',
 122         'filemark' => '4 kbytes'
 123     ]);
 124     return $self;
 125 }
 126
 127 =item C<add_param($param, $value)>
 128
 129 Add the given parameter to the configuration file, overriding any
 130 previous value.  Note that strings which should be quoted in the configuration
 131 file itself must be double-quoted here, e.g.,
 132
 133   $testconf->add_param('org' => '"MyOrganization"');
 134
 135 =cut
 136
 137 sub add_param {
 138     my $self = shift;
 139     my ($param, $value) = @_;
 140
 141     push @{$self->{'params'}}, $param, $value;
 142 }
 143
 144 =item C<add_client_param($param, $value)>, C<add_client_config_param($param, $value)>
 145
 146 Add the given parameter to the client configuration file, overriding any
 147 previous value, as C<add_param> does for the server configuration file.
 148 C<add_client_param> addresses the global client configuration file, while
 149 C<add_client_config_param> inserts parmeters into
 150 C<TESTCONF/amanda-client.conf>.
 151
 152   $testconf->add_client_param('auth' => '"krb2"');
 153   $testconf->add_client_config_param('client_username' => '"freddy"');
 154
 155 =cut
 156
 157 sub add_client_param {
 158     my $self = shift;
 159     my ($param, $value) = @_;
 160
 161     push @{$self->{'client_params'}}, $param, $value;
 162 }
 163
 164 sub add_client_config_param {
 165     my $self = shift;
 166     my ($param, $value) = @_;
 167
 168     push @{$self->{'client_config_params'}}, $param, $value;
 169 }
 170
 171 =item C<add_tapetype($name, $values_arrayref)>
 172 =item C<add_dumptype($name, $values_arrayref)>
 173 =item C<add_holdingdisk($name, $values_arrayref)>
 174 =item C<add_interface($name, $values_arrayref)>
 175 =item C<add_application($name, $values_arrayref)>
 176 =item C<add_script($name, $values_arrayref)>
 177 =item C<add_device($name, $values_arrayref)>
 178 =item C<add_changer($name, $values_arrayref)>
 179
 180 Add the given subsection to the configuration file, including all
 181 values in the arrayref.  The values should be specified as alternating
 182 key/value pairs.
 183
 184 =cut
 185
 186 sub _add_subsec {
 187     my $self = shift;
 188     my ($subsec, $name, $values_arrayref) = @_;
 189
 190     # first delete any existing subsections with that name
 191     @{$self->{$subsec}} = grep { $_->[0] ne $name } @{$self->{$subsec}};
 192
 193     # and now push the new subsection definition on the end
 194     push @{$self->{$subsec}}, [$name, @$values_arrayref];
 195 }
 196
 197 sub add_tapetype {
 198     my $self = shift;
 199     $self->_add_subsec("tapetypes", @_);
 200 }
 201
 202 sub add_dumptype {
 203     my $self = shift;
 204     $self->_add_subsec("dumptypes", @_);
 205 }
 206
 207 sub add_holdingdisk {
 208     my $self = shift;
 209     $self->_add_subsec("holdingdisks", @_);
 210 }
 211
 212 sub add_interface {
 213     my $self = shift;
 214     $self->_add_subsec("interfaces", @_);
 215 }
 216
 217 sub add_application {
 218     my $self = shift;
 219     $self->_add_subsec("application-tool", @_);
 220 }
 221
 222 sub add_script {
 223     my $self = shift;
 224     $self->_add_subsec("script-tool", @_);
 225 }
 226
 227 sub add_device {
 228     my $self = shift;
 229     $self->_add_subsec("devices", @_);
 230 }
 231
 232 sub add_changer {
 233     my $self = shift;
 234     $self->_add_subsec("changers", @_);
 235 }
 236
 237 =item C<add_dle($line)>
 238
 239 Add a disklist entry; C<$line> is inserted verbatim into the disklist.
 240
 241 =cut
 242
 243 sub add_dle {
 244     my $self = shift;
 245     my ($line) = @_;
 246     push @{$self->{'dles'}}, $line;
 247 }
 248
 249 =item C<write()>
 250
 251 Write out the accumulated configuration file, along with any other
 252 files necessary to run Amanda.
 253
 254 =cut
 255
 256 sub write {
 257     my $self = shift;
 258
 259     my $testconf_dir = "$CONFIG_DIR/TESTCONF";
 260     if (-e $testconf_dir) {
 261         rmtree($testconf_dir) or die("Could not remove '$testconf_dir'");
 262     }
 263     mkpath($testconf_dir);
 264
 265     # set up curinfo dir, etc.
 266     mkpath($self->{'infofile'}) or die("Could not create infofile directory");
 267     mkpath($self->{'logdir'}) or die("Could not create logdir directory");
 268     mkpath($self->{'indexdir'}) or die("Could not create indexdir directory");
 269     my $amandates = $AMANDA_TMPDIR . "/TESTCONF/amandates";
 270     my $gnutar_listdir = $AMANDA_TMPDIR . "/TESTCONF/gnutar_listdir";
 271     if (! -d $gnutar_listdir) {
 272         mkpath($gnutar_listdir)
 273             or die("Could not create '$gnutar_listdir'");
 274     }
 275
 276     $self->_write_tapelist("$testconf_dir/tapelist");
 277     $self->_write_disklist("$testconf_dir/disklist");
 278     $self->_write_amanda_conf("$testconf_dir/amanda.conf");
 279     $self->_write_amandates($amandates);
 280     $self->_write_amanda_client_conf("$CONFIG_DIR/amanda-client.conf");
 281     $self->_write_amanda_client_config_conf("$testconf_dir/amanda-client.conf");
 282 }
 283
 284 sub _write_tapelist {
 285     my $self = shift;
 286     my ($filename) = @_;
 287
 288     # create an empty tapelist
 289     open(my $tapelist, ">", $filename);
 290     close($tapelist);
 291 }
 292
 293 sub _write_disklist {
 294     my $self = shift;
 295     my ($filename) = @_;
 296
 297     # don't bother writing a disklist if there are no dle's
 298     return unless $self->{'dles'};
 299
 300     open(my $disklist, ">", $filename);
 301
 302     for my $dle_line (@{$self->{'dles'}}) {
 303         print $disklist "$dle_line\n";
 304     }
 305
 306     close($disklist);
 307 }
 308
 309 sub _write_amanda_conf {
 310     my $self = shift;
 311     my ($filename) = @_;
 312
 313     open my $amanda_conf, ">", $filename
 314         or croak("Could not open '$filename'");
 315
 316     # write key/value pairs
 317     my @params = @{$self->{'params'}};
 318     my $saw_tapetype = 0;
 319     while (@params) {
 320         $param = shift @params;
 321         $value = shift @params;
 322         print $amanda_conf "$param $value\n";
 323         $saw_tapetype = 1 if ($param eq "tapetype");
 324     }
 325
 326     # tapetype is special-cased: if the user has not specified a tapetype, use "TEST-TAPE".
 327     if (!$saw_tapetype) {
 328         print $amanda_conf "tapetype \"TEST-TAPE\"\n";
 329     }
 330
 331     # write out subsections
 332     $self->_write_amanda_conf_subsection($amanda_conf, "tapetype", $self->{"tapetypes"});
 333     $self->_write_amanda_conf_subsection($amanda_conf, "application-tool", $self->{"application-tool"});
 334     $self->_write_amanda_conf_subsection($amanda_conf, "script-tool", $self->{"script-tool"});
 335     $self->_write_amanda_conf_subsection($amanda_conf, "dumptype", $self->{"dumptypes"});
 336     $self->_write_amanda_conf_subsection($amanda_conf, "interface", $self->{"interfaces"});
 337     $self->_write_amanda_conf_subsection($amanda_conf, "holdingdisk", $self->{"holdingdisks"});
 338     $self->_write_amanda_conf_subsection($amanda_conf, "device", $self->{"devices"});
 339     $self->_write_amanda_conf_subsection($amanda_conf, "changer", $self->{"changers"});
 340
 341     close($amanda_conf);
 342 }
 343
 344 sub _write_amanda_conf_subsection {
 345     my $self = shift;
 346     my ($amanda_conf, $subsec_type, $subsec_ref) = @_;
 347
 348     for my $subsec_info (@$subsec_ref) {
 349         my ($subsec_name, @values) = @$subsec_info;
 350
 351         if ($subsec_type eq "holdingdisk") {
 352             print $amanda_conf "\nholdingdisk $subsec_name {\n";
 353         } else {
 354             print $amanda_conf "\ndefine $subsec_type $subsec_name {\n";
 355         }
 356
 357         while (@values) {
 358             $param = shift @values;
 359             $value = shift @values;
 360             print $amanda_conf "$param $value\n";
 361         }
 362         print $amanda_conf "}\n";
 363     }
 364 }
 365
 366 sub _write_amandates {
 367     my $self = shift;
 368     my ($filename) = @_;
 369
 370     # make sure the containing directory exists
 371     mkpath($filename =~ /(^.*)\/amandates/);
 372
 373     # truncate the file to eliminate any interference from previous runs
 374     open(my $amandates, ">", $filename) or die("Could not write to '$filename'");
 375     close($amandates);
 376 }
 377
 378 sub _write_amanda_client_conf {
 379     my $self = shift;
 380     my ($filename, $amandates, $gnutar_listdir) = @_;
 381
 382     # just an empty file for now
 383     open(my $amanda_client_conf, ">", $filename)
 384         or croak("Could not write to '$filename'");
 385
 386     # write key/value pairs
 387     my @params = @{$self->{'client_params'}};
 388     while (@params) {
 389         $param = shift @params;
 390         $value = shift @params;
 391         print $amanda_client_conf "$param $value\n";
 392     }
 393
 394     close($amanda_client_conf);
 395 }
 396
 397 sub _write_amanda_client_config_conf {
 398     my $self = shift;
 399     my ($filename, $amandates, $gnutar_listdir) = @_;
 400
 401     # just an empty file for now
 402     open(my $amanda_client_conf, ">", $filename)
 403         or croak("Could not write to '$filename'");
 404
 405     # write key/value pairs
 406     my @params = @{$self->{'client_config_params'}};
 407     while (@params) {
 408         $param = shift @params;
 409         $value = shift @params;
 410         print $amanda_client_conf "$param $value\n";
 411     }
 412
 413     close($amanda_client_conf);
 414 }
 415
 416 1;