lib/BackupPC/Config/Db.pm

   1 package BackupPC::Config::Db;
   2
   3 use base 'BackupPC::Config';
   4 use warnings;
   5 use strict;
   6
   7 use DBI;
   8
   9 sub GetDbConnInfo
  10 {
  11     my($self, $dbi) = @_;
  12     my($ret, $mesg, $dbConfig);
  13
  14     $dbConfig = "$self->{TopDir}/conf/db.pl";
  15
  16     our %Db;
  17
  18     if ( !defined($ret = do $dbConfig) && ($! || $@) ) {
  19         $mesg = "Couldn't open $dbConfig: $!" if ( $! );
  20         $mesg = "Couldn't execute $dbConfig: $@" if ( $@ );
  21         $mesg =~ s/[\n\r]+//;
  22
  23         $self->{errstr} = $mesg;
  24         return undef;
  25     }
  26
  27     $Db{passwd} = $ENV{BPC_DBPASSWD} if !exists $Db{passwd};
  28
  29     my %parm = %Db;
  30     undef %Db;
  31
  32     return %parm;
  33 }
  34
  35 sub BackupInfoRead
  36 {
  37     my($self, $client) = @_;
  38
  39     # ORDER BY is important! BackupPC_dump expects list to be sorted
  40     my $cmd = "SELECT " . join(', ', @{ $self->{BackupFields} })
  41         . " FROM Backup WHERE client = '$client' ORDER BY num";
  42     my $sth = $self->{dbh}->prepare($cmd);
  43
  44     $sth->execute;
  45     my($row, @backups);
  46
  47 NUM:
  48     while ($row = $sth->fetchrow_hashref) {
  49         $backups[@backups] = { %$row };
  50     }
  51
  52     return @backups;
  53 }
  54
  55 sub BackupInfoWrite
  56 {
  57     my($self, $client, @backups) = @_;
  58
  59     #BackupPC_dump passes an array containing all backup records, so we must
  60     #1) figure out which ones aren't in the database and add them; then
  61     #2) delete records in the database that weren't passed
  62
  63     # get a hash of currently existing backup nums from database
  64     my %current = map {$_, 1}
  65         @{ $self->{dbh}->selectcol_arrayref("SELECT num FROM Backup") };
  66
  67     my %textFields = map {$_, 1} 'client', @{ $self->{BackupTextFields} };
  68
  69     my($num, $cmd, $sth);
  70
  71 NUM:
  72     foreach my $backup (@backups) {
  73         $num = $backup->{num};
  74
  75         if (defined $current{$num}) {
  76             #it's in the database as well as @backups; delete it from hash
  77             delete $current{$num};
  78
  79         } else {
  80             #it's not in database yet, so add it
  81             $cmd = "INSERT Backup (client, " . join(', ', @{ $self->{BackupFields} })
  82                 . ") VALUES ('$client', " . join(', ',
  83                 map {(defined $textFields{$_})? "'$backup->{$_}'" : $backup->{$_}}
  84                 @{ $self->{BackupFields} }) . ")";
  85
  86             $self->{dbh}->prepare($cmd)->execute;
  87         }
  88
  89     }
  90
  91     # any remaining items in %current should be discarded
  92     if (%current) {
  93         $cmd = "DELETE FROM Backup WHERE num IN (" . join(', ', sort keys %current)
  94             . ")";
  95         $self->{dbh}->prepare($cmd)->execute;
  96     }
  97
  98 }
  99
 100
 101 # See comments in "Backup" subs, above
 102 sub RestoreInfoRead
 103 {
 104     my($self, $client) = @_;
 105
 106     # ORDER BY is important! BackupPC_dump expects list to be sorted
 107     my $cmd = "SELECT " . join(', ', @{ $self->{RestoreFields} })
 108         . " FROM Restore WHERE client = '$client' ORDER BY num";
 109     my $sth = $self->{dbh}->prepare($cmd);
 110
 111     $sth->execute;
 112     my($row, @restores);
 113
 114 NUM:
 115     while ($row = $sth->fetchrow_hashref) {
 116         $restores[@restores] = { %$row };
 117     }
 118
 119     return @restores;
 120 }
 121
 122
 123 # See comments in "Backup" subs, above
 124 sub RestoreInfoWrite
 125 {
 126     my($self, $client, @restores) = @_;
 127
 128     my %current = map {$_, 1}
 129         @{ $self->{dbh}->selectcol_arrayref("SELECT num FROM Restore") };
 130
 131     my %textFields = map {$_, 1} 'client', @{ $self->{RestoreTextFields} };
 132
 133     my($num, $cmd, $sth);
 134
 135 NUM:
 136     foreach my $restore (@restores) {
 137         $num = $restore->{num};
 138
 139         if (defined $current{$num}) {
 140             delete $current{$num};
 141
 142         } else {
 143             $cmd = "INSERT Restore (client, " . join(', ', @{ $self->{RestoreFields} })
 144                 . ") VALUES ('$client', " . join(', ',
 145                 map {(defined $textFields{$_})? "'$restore->{$_}'" : $restore->{$_}}
 146                 @{ $self->{RestoreFields} }) . ")";
 147
 148             $self->{dbh}->prepare($cmd)->execute;
 149         }
 150
 151     }
 152
 153     if (%current) {
 154         $cmd = "DELETE FROM Restore WHERE num IN (" . join(', ', sort keys %current)
 155             . ")";
 156         $self->{dbh}->prepare($cmd)->execute;
 157     }
 158
 159 }
 160
 161 sub HostInfoRead {
 162     my($self, $oneClient) = @_;
 163
 164     my $cmd = "SELECT client AS host, dhcp, user, moreUsers FROM Client";
 165     my $sth = $self->{dbh}->prepare($cmd);
 166
 167     $sth->execute;
 168     my($row, $client, %clients);
 169
 170 CLIENT:
 171     while ($row = $sth->fetchrow_hashref) {
 172         $client = $row->{host};
 173
 174         if (defined $oneClient) {
 175             next CLIENT unless $oneClient eq $client;
 176             $clients{$client} = {%$row};
 177             return \%clients;
 178         }
 179
 180         $clients{$client} = {%$row};
 181     }
 182
 183     return \%clients;
 184
 185 }
 186
 187
 188 #TODO: Replace w/ Db version!!
 189 sub ConfigRead
 190 {
 191     my($self, $host) = @_;
 192     my($ret, $mesg, $config, @configs);
 193
 194     our %Conf;
 195
 196     $self->{Conf} = ();
 197     push(@configs, "$self->{TopDir}/conf/config.pl");
 198     push(@configs, "$self->{TopDir}/pc/$host/config.pl")
 199             if ( defined($host) && -f "$self->{TopDir}/pc/$host/config.pl" );
 200     foreach $config ( @configs ) {
 201         %Conf = ();
 202         if ( !defined($ret = do $config) && ($! || $@) ) {
 203             $mesg = "Couldn't open $config: $!" if ( $! );
 204             $mesg = "Couldn't execute $config: $@" if ( $@ );
 205             $mesg =~ s/[\n\r]+//;
 206             return $mesg;
 207         }
 208         %{$self->{Conf}} = ( %{$self->{Conf} || {}}, %Conf );
 209     }
 210
 211     #$mesg = $self->CheckConfigInfo;
 212     #return $mesg if $mesg;
 213
 214     return if ( !defined($self->{Conf}{Language}) );
 215
 216     my $langFile = "$self->{LibDir}/BackupPC/Lang/$self->{Conf}{Language}.pm";
 217
 218     if ( !defined($ret = do $langFile) && ($! || $@) ) {
 219         $mesg = "Couldn't open language file $langFile: $!" if ( $! );
 220         $mesg = "Couldn't execute language file $langFile: $@" if ( $@ );
 221         $mesg =~ s/[\n\r]+//;
 222         return $mesg;
 223     }
 224
 225     our %Lang;
 226     $self->{Lang} = \%Lang;
 227
 228     return;
 229 }
 230
 231 our %gConfigWriteHandler = (SCALAR      => \&_ConfigWriteScalar,
 232                             ARRAY       => \&_ConfigWriteArray,
 233                             HASH        => \&_ConfigWriteHash,
 234                             ARRAYOFHASH => \&_ConfigWriteArrayOfHash,
 235                             HASHOFARRAY => \&_ConfigWriteHashOfArray,
 236                            );
 237
 238 our %gConfigTypeField; # will be defined by database-specific Config module
 239
 240 sub ConfigWrite {
 241     my($self, $client) = @_;
 242     my $dbh = $self->{dbh};
 243
 244     $dbh->{RaiseError} = 0;
 245     my($cmd, $sth);
 246
 247     $cmd = "DELETE FROM Config WHERE client = '~~$client'";
 248     $sth = $dbh->prepare($cmd) or return "$cmd\n". $dbh->errstr;
 249     $sth->execute or return "$cmd\n". $dbh->errstr;
 250
 251     $cmd = "UPDATE Config SET client = '~~$client' WHERE client = '$client'";
 252     $sth = $dbh->prepare($cmd) or return "$cmd\n". $dbh->errstr;
 253     $sth->execute or return "$cmd\n". $dbh->errstr;
 254
 255     my($attr, $val, $def, $handler, $mesg);
 256
 257     foreach $attr (sort keys %{ $self->{Conf} }) {
 258         $val = $self->{Conf}->{$attr};
 259         $def = $self->{ConfigDef}->{$attr};
 260
 261         $handler = $gConfigWriteHandler{$def->{struct}};
 262         $mesg = &$handler($dbh, $def, $client, $attr, $val);
 263         return $mesg if $mesg;
 264     }
 265
 266
 267     $cmd = "DELETE FROM Config WHERE client = '~~$client'";
 268     $sth = $dbh->prepare($cmd) or return "$cmd\n". $dbh->errstr;
 269     $sth->execute or return "$cmd\n". $dbh->errstr;
 270
 271     $self->{dbh}->{RaiseError} = 1;
 272
 273     return;
 274 }
 275
 276 sub _ConfigWriteScalar {
 277     my($dbh, $def, $client, $attr, $val) = @_;
 278     return if !defined $val;
 279
 280     my $ref = ref $val;
 281
 282     if ($ref) {
 283         return "Expected $attr to be SCALAR, but got $ref";
 284     }
 285
 286     &_WriteConfigRow($dbh, $client, $attr, -1, '', $def->{type}, $val)
 287 }
 288
 289 sub _ConfigWriteArray {
 290     my($dbh, $def, $client, $attr, $val, $key) = @_;
 291     return if !defined $val;
 292
 293     $key = '' unless defined $key;
 294     my $ref = ref $val;
 295
 296     if (!$ref) {
 297         #expecting ARRAY, got string -- implicit convert
 298         $val = [ $val ];
 299     } elsif ($ref ne 'ARRAY') {
 300         $attr = "$attr\{$key}" if $key ne '';
 301         return "Expected $attr to be ARRAY, but got $ref";
 302     }
 303
 304     my $subscript = 0;
 305     my $item;
 306     my $type = $def->{type};
 307
 308     foreach $item (@$val) {
 309         &_WriteConfigRow($dbh, $client, $attr, $subscript++,
 310                          $key, $type, $item)
 311     }
 312 }
 313
 314 sub _ConfigWriteHash {
 315     my($dbh, $def, $client, $attr, $val, $subscript) = @_;
 316     return if !defined $val;
 317
 318     $subscript = -1 unless defined $subscript;
 319     my $ref = ref $val;
 320
 321     if (!$ref) {
 322         #expecting HASH, got string -- implicit convert
 323         $val = { '*' => $val };
 324     } elsif ($ref ne 'HASH') {
 325         $attr = "$attr\[$subscript]" if $subscript != -1;
 326         return "Expected $attr to be HASH, but got $ref";
 327     }
 328
 329     my($key, $item);
 330     my $type = $def->{type};
 331
 332     # If 'type' is a hash ref, this means the attribute's subvalue type
 333     # depends on what its corresponding key is. In that case, we set
 334     # $thisType for each iteration; otherwise, we leave it set to 'type'
 335     my $typeByKey = ref $type;
 336     my $thisType = $type;
 337
 338     foreach $key (sort keys %$val) {
 339         $item = $val->{$key};
 340
 341         if ($typeByKey) {
 342             $thisType = $type->{$key};
 343
 344             if (!defined $thisType) {
 345                 return "Don't know how to handle subvalue $key for $attr";
 346             }
 347         }
 348
 349         &_WriteConfigRow($dbh, $client, $attr, $subscript,
 350                          $key, $thisType, $item)
 351     }
 352 }
 353
 354 sub _ConfigWriteArrayOfHash {
 355     my($dbh, $def, $client, $attr, $val) = @_;
 356     return if !defined $val;
 357
 358     my $ref = ref $val;
 359
 360     if (!$ref) {
 361         #expecting ARRAY, got string -- implicit convert
 362         $val = [ $val ];
 363     } elsif ($ref ne 'ARRAY') {
 364         return "Expected $attr to be ARRAY, but got $ref";
 365     }
 366
 367     my $subscript = 0;
 368     my $item;
 369
 370     foreach $item (@$val) {
 371         &_ConfigWriteHash($dbh, $def, $client, $attr,
 372                           $item, $subscript++);
 373     }
 374 }
 375
 376 sub _ConfigWriteHashOfArray {
 377     my($dbh, $def, $client, $attr, $val) = @_;
 378     return if !defined $val;
 379
 380     my $ref = ref $val;
 381
 382     if (!$ref) {
 383         #expecting HASH, got string -- implicit convert
 384         $val = { '*' => $val };
 385     } elsif ($ref ne 'HASH') {
 386         return "Expected $attr to be HASH, but got $ref";
 387     }
 388
 389     my($key, $item);
 390
 391     foreach $key (sort keys %$val) {
 392         $item = $val->{$key};
 393         &_ConfigWriteArray($dbh, $def, $client, $attr,
 394                            $item, $key);
 395     }
 396
 397 }
 398
 399 sub _WriteConfigRow {
 400     my($dbh, $client, $attr, $subscript, $key, $type, $val) = @_;
 401
 402     defined $gConfigTypeField{$type}
 403         or return "Unknown ConfigDef type '$type' ($attr); aborting";
 404
 405     my($confType, $field, %fields);
 406
 407     while(($confType, $field) = each %gConfigTypeField) {
 408         if ($confType eq $type) {
 409             # this is the correct field for value of interest,
 410             # so copy and format it
 411             $fields{$field} = ($confType =~ /^(STRING|MEMO)$/)?
 412                 $dbh->quote($val) : $val;
 413         } else {
 414             $fields{$field} = 'NULL';
 415         }
 416     }
 417
 418     $fields{'client'} = $dbh->quote($client);
 419     $fields{'clientGroup'} = "''"; #TODO: add group logic
 420     $fields{'attribute'} = $dbh->quote($attr);
 421     $fields{'subscript'} = $subscript;
 422     $fields{'hashKey'} = $dbh->quote($key);
 423
 424     my @fields = sort keys %fields;
 425     my @values = map { $fields{ $_ } } @fields;
 426
 427     my $cmd = "INSERT Config (" . join(', ', @fields) . ")\nVALUES ("
 428         . join(', ', @values) . ")";
 429
 430     my $sth = $dbh->prepare($cmd) or return "$cmd\n\n" . $dbh->errstr;
 431     $sth->execute or return "$cmd\n\n". $dbh->errstr;
 432
 433     return;
 434 }
 435
 436 #TODO: Replace w/ Db version!!
 437 #
 438 # Return the mtime of the config file
 439 #
 440 sub ConfigMTime
 441 {
 442     my($self) = @_;
 443     return (stat("$self->{TopDir}/conf/config.pl"))[9];
 444 }
 445
 446
 447
 448 sub DESTROY {
 449     my($self) = @_;
 450
 451     $self->{dbh}->disconnect if defined $self->{dbh};
 452 }
 453
 454
 455 1;