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

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