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