bacula-backup/bacula-backup-lib.pl

   1 # Common functions for the bacula config file
   2 # XXX schedule chooser on IE
   3
   4 BEGIN { push(@INC, ".."); };
   5 use WebminCore;
   6 &init_config();
   7 use Time::Local;
   8 if (&foreign_check("node-groups")) {
   9         &foreign_require("node-groups", "node-groups-lib.pl");
  10         }
  11
  12 $dir_conf_file = "$config{'bacula_dir'}/bacula-dir.conf";
  13 $fd_conf_file = "$config{'bacula_dir'}/bacula-fd.conf";
  14 $sd_conf_file = "$config{'bacula_dir'}/bacula-sd.conf";
  15 $bconsole_conf_file = "$config{'bacula_dir'}/bconsole.conf";
  16 $console_conf_file = "$config{'bacula_dir'}/console.conf";
  17 $console_cmd = -r "$config{'bacula_dir'}/bconsole" ?
  18                 "$config{'bacula_dir'}/bconsole" :
  19                -r "$config{'bacula_dir'}/console" ?
  20                 "$config{'bacula_dir'}/console" :
  21                &has_command("bconsole");
  22 $bacula_cmd = -r "$config{'bacula_dir'}/bacula" ?
  23                 "$config{'bacula_dir'}/bacula" :
  24               &has_command("bacula");
  25
  26 @backup_levels = ( "Full", "Incremental", "Differential",
  27            "InitCatalog", "Catalog", "VolumeToCatalog", "DiskToCatalog" );
  28 @pool_types = ( "Backup",
  29                 "*Archive", "*Cloned", "*Migration", "*Copy", "*Save" );
  30
  31 $cron_cmd = "$module_config_directory/sync.pl";
  32
  33 # connect_to_database()
  34 # Connects to the Bacula database, and returns the DBI handle
  35 sub connect_to_database
  36 {
  37 local $drh;
  38 local $driver = $config{'driver'} || "mysql";
  39 eval <<EOF;
  40 use DBI;
  41 \$drh = DBI->install_driver(\$driver);
  42 EOF
  43 if ($@) {
  44         die &text('connect_emysql', "<tt>$driver</tt>");
  45         }
  46 local $dbistr = &make_dbistr($config{'driver'}, $config{'db'}, $config{'host'});
  47 local $dbh = $drh->connect($dbistr,
  48                            $config{'user'}, $config{'pass'}, { });
  49 $dbh || die &text('connect_elogin', "<tt>$config{'db'}</tt>",$drh->errstr)."\n";
  50 local $testcmd = $dbh->prepare("select count(*) from job");
  51 if (!$testcmd) {
  52         die &text('connect_equery', "<tt>$config{'db'}</tt>")."\n".
  53             ($config{'driver'} eq "SQLite" ? $text{'connect_equery2'} : "");
  54         }
  55 $testcmd->finish();
  56 return $dbh;
  57 }
  58
  59 # read_config_file(file)
  60 # Parses a bacula config file
  61 sub read_config_file
  62 {
  63 local ($file) = @_;
  64 if (!defined($config_file_cache{$file})) {
  65         local @rv = ( );
  66         local $parent = { 'members' => \@rv };
  67         local $lnum = 0;
  68         open(CONF, $_[0]) || return undef;
  69         local @lines = <CONF>;
  70         close(CONF);
  71         for(my $i=0; $i<@lines; $i++) {
  72                 $_ = $lines[$i];
  73                 s/\r|\n//g;
  74                 s/#.*$//;
  75                 if (/^\s*\@(.*\S)/) {
  76                         # An include file reference .. parse it
  77                         local $incfile = $1;
  78                         if ($incfile !~ /^\//) {
  79                                 $incfile = "$config{'bacula_dir'}/$incfile";
  80                                 }
  81                         if (-d $incfile) {
  82                                 # Read a whole directory of files
  83                                 opendir(INCDIR, $incfile);
  84                                 foreach my $f (readdir(INCDIR)) {
  85                                         next if ($f eq "." || $f eq "..");
  86                                         local $inc = &read_config_file(
  87                                                 "$incfile/$f");
  88                                         push(@{$parent->{'members'}}, @$inc);
  89                                         }
  90                                 closedir(INCDIR);
  91                                 }
  92                         else {
  93                                 # Read just one file
  94                                 local $inc = &read_config_file($incfile);
  95                                 push(@{$parent->{'members'}}, @$inc);
  96                                 }
  97                         }
  98                 elsif (/^\s*}\s*$/) {
  99                         # End of a section
 100                         $parent->{'eline'} = $lnum;
 101                         $parent = $parent->{'parent'};
 102                         $parent ||
 103                             die "Too many section ends at line ".($lnum+1);
 104                         }
 105                 elsif (/^\s*(\S+)\s*{\s*(\S[^=]*\S)\s*=\s*"(.*)"(.*)$/ ||
 106                        /^\s*(\S+)\s*{\s*(\S[^=]*\S)\s*=\s*([^\{]*\S)(.*)$/) {
 107                         # Start of a section, with a name=value record on
 108                         # the same line!
 109                         local $dir = { 'name' => $1,
 110                                        'parent' => $parent,
 111                                        'line' => $lnum,
 112                                        'eline' => $lnum,
 113                                        'file' => $file,
 114                                        'type' => 1,
 115                                        'members' => [ ] };
 116                         push(@{$parent->{'members'}}, $dir);
 117                         $parent = $dir;
 118                         local $dir = { 'name' => $2,
 119                                        'value' => $3,
 120                                        'line' => $lnum,
 121                                        'eline' => $lnum,
 122                                        'file' => $file,
 123                                        'type' => 0,
 124                                        'parent' => $parent };
 125                         push(@{$parent->{'members'}}, $dir);
 126                         }
 127                 elsif (/^\s*(\S[^=]*\S)\s*=\s*"(.*)"(.*)$/ ||
 128                     /^\s*(\S[^=]*\S)\s*=\s*([^\{]*\S)(.*)$/) {
 129                         # A name=value record
 130                         local $rest = $3;
 131                         local $dir = { 'name' => $1,
 132                                        'value' => $2,
 133                                        'line' => $lnum,
 134                                        'eline' => $lnum,
 135                                        'file' => $file,
 136                                        'type' => 0,
 137                                        'parent' => $parent };
 138                         push(@{$parent->{'members'}}, $dir);
 139
 140                         if ($rest =~ /\s*{\s*$/) {
 141                                 # Also start of a section!
 142                                 $dir->{'type'} = 2;
 143                                 $dir->{'members'} = [ ];
 144                                 $parent = $dir;
 145                                 }
 146                         }
 147                 elsif (/^\s*(\S[^=]*\S)\s*=\s*$/) {
 148                         # A name = with no value
 149                         local $rest = $3;
 150                         local $dir = { 'name' => $1,
 151                                        'value' => undef,
 152                                        'line' => $lnum,
 153                                        'eline' => $lnum,
 154                                        'file' => $file,
 155                                        'type' => 0,
 156                                        'parent' => $parent };
 157                         push(@{$parent->{'members'}}, $dir);
 158                         }
 159                 elsif (/^\s*(\S+)\s*{\s*$/) {
 160                         # Start of a section
 161                         local $dir = { 'name' => $1,
 162                                        'parent' => $parent,
 163                                        'line' => $lnum,
 164                                        'eline' => $lnum,
 165                                        'file' => $file,
 166                                        'type' => 1,
 167                                        'members' => [ ] };
 168                         push(@{$parent->{'members'}}, $dir);
 169                         $parent = $dir;
 170                         }
 171                 elsif (/^\s*(\S+)\s*$/) {
 172                         # Just a word by itself .. perhaps start of a section,
 173                         # if there is a { on the next line.
 174                         local $name = $1;
 175                         local $nextline = $lines[++$i];
 176                         if ($nextline =~ /^\s*\{\s*$/) {
 177                                 local $dir = { 'name' => $name,
 178                                                'parent' => $parent,
 179                                                'line' => $lnum,
 180                                                'eline' => $lnum,
 181                                                'file' => $file,
 182                                                'type' => 1,
 183                                                'members' => [ ] };
 184                                 push(@{$parent->{'members'}}, $dir);
 185                                 $parent = $dir;
 186                                 $lnum++;
 187                                 }
 188                         }
 189                 $lnum++;
 190                 }
 191         $config_file_cache{$file} = \@rv;
 192         }
 193 return $config_file_cache{$file};
 194 }
 195
 196 # read_config_file_parent(file)
 197 sub read_config_file_parent
 198 {
 199 local ($file) = @_;
 200 if (!$config_file_parent_cache{$file}) {
 201         local $conf = &read_config_file($file);
 202         return undef if (!$conf);
 203         local $lref = &read_file_lines($file);
 204         $config_file_parent_cache{$file} =
 205                { 'members' => $conf,
 206                  'type' => 2,
 207                  'file' => $file,
 208                  'line' => 0,
 209                  'eline' => scalar(@$lref) };
 210         }
 211 return $config_file_parent_cache{$file};
 212 }
 213
 214 # find(name, &conf)
 215 sub find
 216 {
 217 local ($name, $conf) = @_;
 218 local @rv = grep { lc($_->{'name'}) eq lc($name) } @$conf;
 219 return wantarray ? @rv : $rv[0];
 220 }
 221
 222 sub find_value
 223 {
 224 local ($name, $conf) = @_;
 225 local @rv = map { $_->{'value'} } &find(@_);
 226 return wantarray ? @rv : $rv[0];
 227 }
 228
 229 sub find_by
 230 {
 231 local ($field, $value, $conf) = @_;
 232 foreach my $f (@$conf) {
 233         my $name = &find_value($field, $f->{'members'});
 234         return $f if ($name eq $value);
 235         }
 236 return undef;
 237 }
 238
 239 sub get_director_config
 240 {
 241 return &read_config_file($dir_conf_file);
 242 }
 243
 244 sub get_director_config_parent
 245 {
 246 return &read_config_file_parent($dir_conf_file);
 247 }
 248
 249 sub get_storage_config
 250 {
 251 return &read_config_file($sd_conf_file);
 252 }
 253
 254 sub get_storage_config_parent
 255 {
 256 return &read_config_file_parent($sd_conf_file);
 257 }
 258
 259 sub get_file_config
 260 {
 261 return &read_config_file($fd_conf_file);
 262 }
 263
 264 sub get_file_config_parent
 265 {
 266 return &read_config_file_parent($fd_conf_file);
 267 }
 268
 269 sub get_bconsole_config
 270 {
 271 return &read_config_file($bconsole_conf_file);
 272 }
 273
 274 sub get_bconsole_config_parent
 275 {
 276 return &read_config_file_parent($bconsole_conf_file);
 277 }
 278
 279 # save_directive(&conf, &parent, name|&old, &new, indent)
 280 # Updates a section or value in the Bacula config file
 281 sub save_directive
 282 {
 283 local ($conf, $parent, $name, $new, $indent) = @_;
 284 local $old;
 285 if (ref($name)) {
 286         $old = $name;
 287         $name = $old->{'name'};
 288         }
 289 else {
 290         $old = &find($name, $parent->{'members'});
 291         }
 292 local $lref = $old && $old->{'file'} ? &read_file_lines($old->{'file'}) :
 293               $parent->{'file'} ? &read_file_lines($parent->{'file'}) : undef;
 294 if (defined($new) && !ref($new)) {
 295         $new = { 'name' => $name,
 296                  'value' => $new };
 297         }
 298
 299 local @lines = $new ? &directive_lines($new, $indent) : ( );
 300 local $len = $old ? $old->{'eline'} - $old->{'line'} + 1 : undef;
 301 if ($old && $new) {
 302         # Update this object
 303         if ($lref) {
 304                 splice(@$lref, $old->{'line'}, $len, @lines);
 305                 &renumber($conf, $old->{'line'}, scalar(@lines)-$len,
 306                           $old->{'file'});
 307                 }
 308         $old->{'value'} = $new->{'value'};
 309         $old->{'members'} = $new->{'members'};
 310         $old->{'type'} = $new->{'type'};
 311         $old->{'eline'} = $old->{'line'} + scalar(@lines) - 1;
 312         }
 313 elsif (!$old && $new) {
 314         # Add to the parent
 315         $new->{'line'} = $parent->{'eline'};
 316         $new->{'eline'} = $new->{'line'} + scalar(@lines) - 1;
 317         $new->{'file'} = $parent->{'file'};
 318         if ($lref) {
 319                 splice(@$lref, $parent->{'eline'}, 0, @lines);
 320                 &renumber($conf, $new->{'line'}-1, scalar(@lines),
 321                           $parent->{'file'});
 322                 }
 323         push(@{$parent->{'members'}}, $new);
 324         }
 325 elsif ($old && !$new) {
 326         # Delete from the parent
 327         if ($lref) {
 328                 splice(@$lref, $old->{'line'}, $len);
 329                 &renumber($conf, $old->{'line'}, -$len, $old->{'file'});
 330                 }
 331         @{$parent->{'members'}} = grep { $_ ne $old } @{$parent->{'members'}};
 332         }
 333 }
 334
 335 # save_directives(&conf, &parent, name, &newvalues, indent)
 336 # Updates multiple directives in a section
 337 sub save_directives
 338 {
 339 local ($conf, $parent, $name, $news, $indent) = @_;
 340 local @news = map { ref($_) ? $_ : { 'name' => $name, 'value' => $_ } } @$news;
 341 local @olds = &find($name, $parent->{'members'});
 342 for(my $i=0; $i<@news || $i<@olds; $i++) {
 343         &save_directive($conf, $parent, $olds[$i], $news[$i], $indent);
 344         }
 345 }
 346
 347 # renumber(&conf, start, offset, file)
 348 sub renumber
 349 {
 350 local ($conf, $line, $offset, $file) = @_;
 351 foreach my $c (@$conf) {
 352         $c->{'line'} += $offset if ($c->{'line'} > $line &&
 353                                     $c->{'file'} eq $file);
 354         $c->{'eline'} += $offset if ($c->{'eline'} > $line &&
 355                                      $c->{'file'} eq $file);
 356         if ($c->{'type'}) {
 357                 &renumber($c->{'members'}, $line, $offset, $file);
 358                 }
 359         }
 360 local $parent = $config_file_parent_cache{$file};
 361 if ($conf eq $parent->{'members'}) {
 362         # Update parent lines too
 363         $parent->{'line'} += $offset if ($parent->{'line'} > $line);
 364         $parent->{'eline'} += $offset if ($parent->{'eline'} > $line);
 365         }
 366 }
 367
 368 # directive_lines(&object, indent)
 369 # Returns the text lines of a Bacula directive
 370 sub directive_lines
 371 {
 372 local ($dir, $indent) = @_;
 373 local $istr = "  " x $indent;
 374 local @rv;
 375 if ($dir->{'type'}) {
 376         # A section
 377         push(@rv, $istr.$dir->{'name'}.
 378                   ($dir->{'value'} ? " $dir->{'value'}" : "")." {");
 379         foreach my $m (@{$dir->{'members'}}) {
 380                 push(@rv, &directive_lines($m, $indent+1));
 381                 }
 382         push(@rv, $istr."}");
 383         }
 384 else {
 385         # A single line
 386         local $qstr = $dir->{'value'} =~ /^\S+$/ ||
 387                        $dir->{'value'} =~ /^\d+\s+(secs|mins|hours|days|weeks|months|years)$/i ||
 388                        $dir->{'name'} eq 'Run' ? $dir->{'value'} :
 389                       $dir->{'value'} =~ /"/ ? "'$dir->{'value'}'" :
 390                                                "\"$dir->{'value'}\"";
 391         push(@rv, $istr.$dir->{'name'}." = ".$qstr);
 392         }
 393 return @rv;
 394 }
 395
 396 # bacula_file_button(filesfield, [jobfield], [volume])
 397 # Pops up a window for selecting multiple files, using a tree-like view
 398 sub bacula_file_button
 399 {
 400 return "<input type=button onClick='ifield = form.$_[0]; jfield = form.$_[1]; chooser = window.open(\"treechooser.cgi?volume=".&urlize($_[2])."&files=\"+escape(ifield.value)+\"&job=\"+escape(jfield.value), \"chooser\", \"toolbar=no,menubar=no,scrollbar=no,width=500,height=400\"); chooser.ifield = ifield; window.ifield = ifield' value=\"...\">\n";
 401 }
 402
 403 sub tape_select
 404 {
 405 local $t;
 406 print "<select name=tape>\n";
 407 foreach $t (split(/\s+/, $config{'tape_device'})) {
 408         print "<option>",&text('index_tapedev', $t),"\n";
 409         }
 410 print "<option value=''>$text{'index_other'}\n";
 411 print "</select>\n";
 412 print "<input name=other size=40> ",&file_chooser_button("other", 1),"\n";
 413 }
 414
 415 # job_select(&dbh, [volumne])
 416 # XXX needs value input?
 417 # XXX needs flag for use of 'any' field?
 418 sub job_select
 419 {
 420 local $cmd;
 421 if ($_[1]) {
 422         $cmd = $_[0]->prepare("select Job.JobId,Job.Name,Job.SchedTime ".
 423                               "from Job,JobMedia,Media ".
 424                               "where Job.JobId = JobMedia.JobId ".
 425                               "and Media.MediaId = JobMedia.MediaId ".
 426                               "and Media.VolumeName = '$_[1]'") ||
 427                 &error("prepare failed : ",$dbh->errstr);
 428         }
 429 else {
 430         $cmd = $_[0]->prepare("select JobId,Name,SchedTime from Job") ||
 431                 &error("prepare failed : ",$dbh->errstr);
 432         }
 433 $cmd->execute();
 434 print "<select name=job>\n";
 435 print "<option value=''>$text{'job_any'}\n";
 436 while(my ($id, $name, $when) = $cmd->fetchrow()) {
 437         $when =~ s/ .*$//;
 438         print "<option value=$id>$name ($id) ($when)\n";
 439         }
 440 print "</select>\n";
 441 }
 442
 443 # client_select(&dbh)
 444 sub client_select
 445 {
 446 local $cmd = $_[0]->prepare("select ClientId,Name from Client order by ClientId asc");
 447 $cmd->execute();
 448 print "<select name=client>\n";
 449 while(my ($id, $name) = $cmd->fetchrow()) {
 450         print "<option value=$name>$name ($id)\n";
 451         }
 452 print "</select>\n";
 453 }
 454
 455 sub unix_to_dos
 456 {
 457 local $rv = $_[0];
 458 $rv =~ s/^\/([a-zA-Z]):/$1:/;
 459 return $rv;
 460 }
 461
 462 sub dos_to_unix
 463 {
 464 local $rv = $_[0];
 465 $rv =~ s/^([a-zA-Z]):/\/$1:/;
 466 return $rv;
 467 }
 468
 469 # check_bacula()
 470 # Returns an error message if bacula is not installed, or undef if OK
 471 sub check_bacula
 472 {
 473 if (!-d $config{'bacula_dir'}) {
 474         return &text('check_edir', "<tt>$config{'bacula_dir'}</tt>");
 475         }
 476 local $got = 0;
 477 if (-r $dir_conf_file) {
 478         #if (!-x $bacula_cmd) {
 479         #       return &text('check_ebacula', "<tt>$bacula_cmd</tt>");
 480         #       }
 481         if (!-x $console_cmd) {
 482                 return &text('check_econsole', "<tt>$console_cmd</tt>");
 483                 }
 484         $got++;
 485         }
 486 elsif (-r $fd_conf_file) {
 487         $got++;
 488         }
 489 elsif (-r $sd_conf_file) {
 490         $got++;
 491         }
 492 return &text('check_econfigs', "<tt>$config{'bacula_dir'}</tt>") if (!$got);
 493 return undef;
 494 }
 495
 496 # Returns 1 if this system is a Bacula director
 497 sub has_bacula_dir
 498 {
 499 return -r $dir_conf_file;
 500 }
 501
 502 # Returns 1 if this system is a Bacula file daemon
 503 sub has_bacula_fd
 504 {
 505 return -r $fd_conf_file;
 506 }
 507
 508 # Returns 1 if this system is a Bacula storage daemon
 509 sub has_bacula_sd
 510 {
 511 return -r $sd_conf_file;
 512 }
 513
 514 # Names of the Bacula programs
 515 @bacula_processes = ( &has_bacula_dir() ? ( "bacula-dir" ) : ( ),
 516                       &has_bacula_sd() ? ( "bacula-sd" ) : ( ),
 517                       &has_bacula_fd() ? ( "bacula-fd" ) : ( ),
 518                     );
 519 if ($gconfig{'os_type'} eq 'windows') {
 520         # On Windows, the bootup action is just called Bacula (for the FD)
 521         @bacula_inits = ( "Bacula" );
 522         }
 523 else {
 524         # On Unix, each daemon has an action
 525         @bacula_inits = @bacula_processes;
 526         foreach my $i (@bacula_inits) {
 527                 if ($i eq "bacula-dir" && !-r "/etc/init.d/$i" &&
 528                     -r "/etc/init.d/bacula-director") {
 529                         # Different location on Ubuntu / Debian
 530                         $i = "bacula-director";
 531                         }
 532                 }
 533         }
 534
 535 # is_bacula_running(process)
 536 # Returns 1 if the specified Bacula process is running, 0 of not
 537 sub is_bacula_running
 538 {
 539 local ($proc) = @_;
 540 if (&has_command($bacula_cmd)) {
 541         # Get status from bacula status command
 542         $bacula_status_cache ||= `$bacula_cmd status 2>&1 </dev/null`;
 543         if ($bacula_status_cache =~ /\Q$proc\E\s+\(pid\s+([0-9 ]+)\)\s+is\s+running/i ||
 544             $bacula_status_cache =~ /\Q$proc\E\s+is\s+running/i) {
 545                 return 1;
 546                 }
 547         }
 548 # Look for running process
 549 local @pids = &find_byname($proc);
 550 return @pids ? 1 : 0;
 551 }
 552
 553 # start_bacula()
 554 # Attempts to start the Bacula processes, return undef on success or an
 555 # error message on failure
 556 sub start_bacula
 557 {
 558 undef($bacula_status_cache);
 559 if (&has_command($bacula_cmd)) {
 560         local $out = &backquote_logged("$bacula_cmd start 2>&1 </dev/null");
 561         return $? || $out =~ /failed|error/i ? "<pre>$out</pre>" : undef;
 562         }
 563 else {
 564         return &run_all_inits("start");
 565         }
 566 }
 567
 568 # stop_bacula()
 569 # Attempts to stop the Bacula processes, return undef on success or an
 570 # error message on failure
 571 sub stop_bacula
 572 {
 573 undef($bacula_status_cache);
 574 if (&has_command($bacula_cmd)) {
 575         local $out = &backquote_logged("$bacula_cmd stop 2>&1 </dev/null");
 576         return $? || $out =~ /failed|error/i ? "<pre>$out</pre>" : undef;
 577         }
 578 else {
 579         return &run_all_inits("stop");
 580         }
 581 }
 582
 583 # restart_bacula()
 584 # Attempts to re-start the Bacula processes, return undef on success or an
 585 # error message on failure
 586 sub restart_bacula
 587 {
 588 undef($bacula_status_cache);
 589 if (&has_command($bacula_cmd)) {
 590         local $out = &backquote_logged("$bacula_cmd restart 2>&1 </dev/null");
 591         return $? || $out =~ /failed|error/i ? "<pre>$out</pre>" : undef;
 592         }
 593 else {
 594         return &run_all_inits("restart");
 595         }
 596 }
 597
 598 # run_all_inits(action)
 599 # Runs all the Bacula init script with some action
 600 sub run_all_inits
 601 {
 602 local ($action) = @_;
 603 &foreign_require("init", "init-lib.pl");
 604 foreach my $i (@bacula_inits) {
 605         local $st = &init::action_status($i);
 606         return &text('start_einit', "<tt>$i</tt>") if (!$st);
 607         }
 608 foreach my $i (@bacula_inits) {
 609         local $func = $action eq "start" ? \&init::start_action :
 610                       $action eq "stop" ? \&init::stop_action :
 611                       $action eq "restart" ? \&init::restart_action :
 612                                              undef;
 613         $func || return "Unknown init action $action";
 614         local $err = &$func($i);
 615         if ($err) {
 616                 return &text('start_erun', "<tt>$i</tt>", "<pre>$err</pre>");
 617                 }
 618         }
 619 return undef;
 620 }
 621
 622 # apply_configuration()
 623 # Tells Bacula to re-read it's config files
 624 sub apply_configuration
 625 {
 626 if (&has_bacula_dir()) {
 627         # Call console reload
 628         local $h = &open_console();
 629         local $out = &console_cmd($h, "reload");
 630         &close_console($h);
 631         return defined($out) ? undef : $text{'apply_failed'}."<pre>$out</pre>";
 632         }
 633 else {
 634         # Need to do a restart
 635         return &restart_bacula();
 636         }
 637 }
 638
 639 # auto_apply_configuration()
 640 # Apply the configuration if automatic apply is enabled
 641 sub auto_apply_configuration
 642 {
 643 if ($config{'apply'} && &is_bacula_running($bacula_processes[0])) {
 644         local $err = &apply_configuration();
 645         &error(&text('apply_problem', $err)) if ($err);
 646         }
 647 }
 648
 649 # show_period_input(name, value)
 650 # Returns HTML for selection a retention period
 651 sub show_period_input
 652 {
 653 local ($name, $value) = @_;
 654 local ($t, $u) = split(/\s+/, $value);
 655 $u ||= "days";
 656 $u .= "s" if ($u !~ /s$/);
 657 return &ui_textbox($name."_t", $t, 5)." ".
 658        &ui_select($name."_u", $u,
 659           [ [ "seconds" ], [ "minutes" ], [ "hours" ], [ "days" ],
 660             [ "weeks" ], [ "months" ], [ "years" ] ], 1, 0, 1);
 661 }
 662
 663 # parse_period_input(name)
 664 sub parse_period_input
 665 {
 666 local ($name) = @_;
 667 $in{$name."_t"} =~ /^\d+$/ || return undef;
 668 return $in{$name."_t"}." ".$in{$name."_u"};
 669 }
 670
 671 # find_dependency(field, value, &types, &conf)
 672 # Checks if any of the given object types have the specified field, and returns
 673 # the name of the dependent object
 674 sub find_dependency
 675 {
 676 local ($field, $value, $types, $conf) = @_;
 677 foreach my $name (@$types) {
 678         local @children = &find($name, $conf);
 679         local $child = &find_by($field, $value, \@children);
 680         if ($child) {
 681                 local $cname = &find_value("Name", $child->{'members'});
 682                 return $cname;
 683                 }
 684         }
 685 return undef;
 686 }
 687
 688 # open_console()
 689 # Starts the Bacula console process, and returns a handle object for it
 690 sub open_console
 691 {
 692 ##&foreign_require("proc", "proc-lib.pl");
 693 #$ENV{'TERM'} = "dumb";
 694 #local ($fh, $fpid) = &proc::pty_process_exec($console_cmd);
 695 #&wait_for($fh, '\\*');         # skip first prompt
 696 #return { 'fh' => $fh,
 697 #        'fpid' => $fpid };
 698
 699 pipe(INr, INw);
 700 pipe(OUTr, OUTw);
 701 local $pid;
 702 if (!($pid = fork())) {
 703         untie(*STDIN);
 704         untie(*STDOUT);
 705         untie(*STDERR);
 706         close(STDIN);
 707         close(STDOUT);
 708         close(STDERR);
 709         open(STDIN, "<&INr");
 710         open(STDOUT, ">&OUTw");
 711         open(STDERR, ">&OUTw");
 712         $| = 1;
 713         close(INw);
 714         close(OUTr);
 715         chdir($config{'bacula_dir'});
 716         exec($console_cmd);
 717         print STDERR "exec failed : $!\n";
 718         exit(1);
 719         }
 720 close(INr);
 721 close(OUTw);
 722 local $infh = \*INw;
 723 local $outfh = \*OUTr;
 724 local $old = select($infh); $| = 1;
 725 select($outfh); $| = 1; select($old);
 726 return { 'infh' => $infh,
 727          'outfh' => $outfh,
 728          'fpid' => $pid };
 729 }
 730
 731 # console_cmd(&handle, command)
 732 # Runs one Bacula command, and returns the output
 733 sub console_cmd
 734 {
 735 local ($h, $cmd) = @_;
 736 &sysprint($h->{'infh'}, $cmd."\n");
 737 if ($cmd ne "quit") {
 738         &sysprint($h->{'infh'}, "time\n");
 739         }
 740 local $out;
 741 while(1) {
 742         local $rv = &wait_for($h->{'outfh'},
 743                         '^(\d+\-\S+\-\d+ \d+:\d+:\d+)\n',
 744                         'Unable to connect to Director',
 745                         '.*\n');
 746         return undef if ($rv == 1 || $rv < 0);
 747         $out .= $wait_for_input;
 748         last if ($rv == 0);
 749         }
 750 $out =~ s/time\n(\d+\-\S+\-\d+ \d+:\d+:\d+)\n//;
 751 $out =~ s/^\Q$cmd\E\n//;
 752 return $out;
 753 }
 754
 755 # close_console(&handle)
 756 sub close_console
 757 {
 758 local ($h) = @_;
 759 &console_cmd($h, "quit");
 760 close($h->{'infh'});
 761 close($h->{'outfh'});
 762 kill('TERM', $h->{'fpid'});
 763 waitpid($h->{'pid'}, -1);
 764 }
 765
 766 # get_bacula_version()
 767 # Get the Bacula version, either from one of the command-line programs, or
 768 # from the console
 769 sub get_bacula_version
 770 {
 771 foreach my $p (@bacula_processes) {
 772         if (&has_command($p)) {
 773                 local $out = `$p -\? 2>&1`;
 774                 if ($out =~ /Version:\s+(\S+)/) {
 775                         return $1;
 776                         }
 777                 }
 778         }
 779 local $h = &open_console();
 780 local $out = &console_cmd($h, "version");
 781 &close_console($h);
 782 if ($out =~ /Version:\s+(\S+)/) {
 783         &open_tempfile(CACHE, ">$module_config_directory/version");
 784         &print_tempfile(CACHE, $1,"\n");
 785         &close_tempfile(CACHE);
 786         return $1;
 787         }
 788 return undef;
 789 }
 790
 791 sub get_bacula_version_cached
 792 {
 793 open(CACHE, "$module_config_directory/version");
 794 chop($version = <CACHE>);
 795 close(CACHE);
 796 return $version || &get_bacula_version();
 797 }
 798
 799 # get_bacula_jobs()
 800 # Returns a list of all jobs known to Bacula
 801 sub get_bacula_jobs
 802 {
 803 local $h = &open_console();
 804 local $jobs = &console_cmd($h, "show jobs");
 805 &close_console($h);
 806 local @rv;
 807 local $job;
 808 foreach my $l (split(/\r?\n/, $jobs)) {
 809         if ($l =~ /^Job:\s+name=([^=]*\S)\s/) {
 810                 $job = { 'name' => $1 };
 811                 push(@rv, $job);
 812                 }
 813         elsif ($l =~ /Client:\s+name=([^=]*\S)\s/ && $job) {
 814                 $job->{'client'} = $1;
 815                 }
 816         elsif ($l =~ /FileSet:\s+name=([^=]*\S)\s/ && $job) {
 817                 $job->{'fileset'} = $1;
 818                 }
 819         }
 820 return @rv;
 821 }
 822
 823 # get_bacula_clients()
 824 # Returns a list of all clients known to Bacula
 825 sub get_bacula_clients
 826 {
 827 local $h = &open_console();
 828 local $clients = &console_cmd($h, "show clients");
 829 &close_console($h);
 830 local @rv;
 831 local $client;
 832 foreach my $l (split(/\r?\n/, $clients)) {
 833         if ($l =~ /^Client:\s+name=([^=]*\S)\s/) {
 834                 $client = { 'name' => $1 };
 835                 if ($l =~ /address=(\S+)/ && $client) {
 836                         $client->{'address'} = $1;
 837                         }
 838                 if ($l =~ /FDport=(\d+)/ && $client) {
 839                         $client->{'port'} = $1;
 840                         }
 841                 push(@rv, $client);
 842                 }
 843         }
 844 return @rv;
 845 }
 846
 847 # get_bacula_storages()
 848 # Returns a list of all storage daemons known to Bacula
 849 sub get_bacula_storages
 850 {
 851 local $h = &open_console();
 852 local $storages = &console_cmd($h, "show storages");
 853 &close_console($h);
 854 local @rv;
 855 local $storage;
 856 foreach my $l (split(/\r?\n/, $storages)) {
 857         if ($l =~ /^Storage:\s+name=([^=]*\S)\s/) {
 858                 $storage = { 'name' => $1 };
 859                 if ($l =~ /address=(\S+)/) {
 860                         $storage->{'address'} = $1;
 861                         }
 862                 if ($l =~ /SDport=(\d+)/) {
 863                         $storage->{'port'} = $1;
 864                         }
 865                 push(@rv, $storage);
 866                 }
 867         }
 868 return @rv;
 869 }
 870
 871 # get_bacula_pools()
 872 # Returns a list of all pools known to Bacula
 873 sub get_bacula_pools
 874 {
 875 local $h = &open_console();
 876 local $pools = &console_cmd($h, "show pools");
 877 &close_console($h);
 878 local @rv;
 879 local $pool;
 880 foreach my $l (split(/\r?\n/, $pools)) {
 881         if ($l =~ /^Pool:\s+name=([^=]*\S)\s/) {
 882                 $pool = { 'name' => $1 };
 883                 if ($l =~ /PoolType=(\S+)/) {
 884                         $pool->{'type'} = $1;
 885                         }
 886                 push(@rv, $pool);
 887                 }
 888         }
 889 return @rv;
 890 }
 891
 892 # get_director_status()
 893 # Returns three arrays, containing the status of scheduled, running and finished
 894 # jobs respectively
 895 sub get_director_status
 896 {
 897 local $h = &open_console();
 898 local $status = &console_cmd($h, "status dir");
 899 &close_console($h);
 900 local $sect = 0;
 901 local (@sched, @run, @done);
 902 foreach my $l (split(/\r?\n/, $status)) {
 903         if ($l =~ /^Scheduled\s+Jobs/i) { $sect = 1; }
 904         elsif ($l =~ /^Running\s+Jobs/i) { $sect = 2; }
 905         elsif ($l =~ /^Terminated\s+Jobs/i) { $sect = 3; }
 906
 907         if ($sect == 1 && $l =~ /^\s*(\S+)\s+(\S+)\s+(\d+)\s+(\S+\s+\S+)\s+(\S+)\s+(\S+)\s*$/) {
 908                 # Scheduled job
 909                 push(@sched, { 'level' => &full_level("$1"),
 910                                'type' => $2,
 911                                'pri' => $3,
 912                                'date' => $4,
 913                                'name' => $5,
 914                                'volume' => $6 });
 915                 }
 916         elsif ($sect == 2 && $l =~ /^\s*(\d+)\s+(\S+)\s+(\S+)\.(\d+\-\d+\-\S+)\s+(.*)/) {
 917                 # Running job
 918                 push(@run, { 'id' => $1,
 919                              'level' => &full_level("$2"),
 920                              'name' => &job_name("$3"),
 921                              'status' => $5 });
 922                 }
 923         elsif ($sect == 2 && $l =~ /^\s*(\d+)\s+(\S+)\.(\d+\-\d+\-\S+)\s+(.*)/) {
 924                 # Running job
 925                 push(@run, { 'id' => $1,
 926                              'level' => "Restore",
 927                              'name' => &job_name("$2"),
 928                              'status' => $4 });
 929                 }
 930         elsif ($sect == 3 && $l =~ /^\s*(\d+)\s+(\S+)\s+([0-9,]+)\s+([0-9,]+\.[0-9,]+\s+\S+|\d+)\s+(\S+)\s+(\S+\s+\S+)\s+(\S+)\s*$/){
 931                 # Terminated job
 932                 push(@done, { 'id' => $1,
 933                               'level' => &full_level("$2"),
 934                               'files' => &remove_comma("$3"),
 935                               'bytes' => &remove_comma("$4"),
 936                               'status' => $5,
 937                               'date' => $6,
 938                               'name' => &job_name("$7") });
 939                 }
 940         }
 941 return (\@sched, \@run, \@done);
 942 }
 943
 944 # get_client_status(client)
 945 # Returns a status message, OK flag, running jobs and done jobs for some client
 946 sub get_client_status
 947 {
 948 local ($client) = @_;
 949 local $h = &open_console();
 950 local $status = &console_cmd($h, "status client=$client");
 951 &close_console($h);
 952 local $msg;
 953 if ($status =~ /Connecting\s+to\s+Client.*\n(\n?)(.*)\n/i) {
 954         $msg = $2;
 955         $msg =~ s/^\s*$client\s//;
 956         }
 957 local $sect = 0;
 958 local (@run, @done);
 959 foreach my $l (split(/\r?\n/, $status)) {
 960         if ($l =~ /^Running\s+Jobs/i) { $sect = 2; }
 961         elsif ($l =~ /^Terminated\s+Jobs/i) { $sect = 3; }
 962
 963         if ($sect == 2 && $l =~ /^\s*JobID\s+(\d+)\s+Job\s+(\S+)\.(\d+\-\d+\-\S+)\s+(.*)/i) {
 964                 push(@run, { 'id' => $1,
 965                              'name' => &job_name("$2"),
 966                              'status' => $4 });
 967                 }
 968         elsif ($sect == 2 && $l =~ /^\s*Backup\s+Job\s+started:\s+(\S+\s+\S+)/) {
 969                 $run[$#run]->{'date'} = $1;
 970                 }
 971         elsif ($sect == 3 && $l =~ /^\s*(\d+)\s+(\S+)\s+([0-9,]+)\s+([0-9,]+\.[0-9,]+\s+\S+|\d+)\s+(\S+)\s+(\S+\s+\S+)\s+(\S+)\s*$/) {
 972                 push(@done, { 'id' => $1,
 973                               'level' => &full_level("$2"),
 974                               'files' => &remove_comma("$3"),
 975                               'bytes' => &remove_comma("$4"),
 976                               'status' => $5,
 977                               'date' => $6,
 978                               'name' => &job_name("$7") });
 979                 }
 980         }
 981 return ($msg, $msg =~ /failed|error/i ? 0 : 1, \@run, \@done);
 982 }
 983
 984 # get_storage_status(storage)
 985 # Returns a status message, OK flag, running jobs and done jobs for some
 986 # storage daemon
 987 sub get_storage_status
 988 {
 989 local ($storage) = @_;
 990 local $h = &open_console();
 991 local $status = &console_cmd($h, "status storage=$storage");
 992 &close_console($h);
 993 local $msg;
 994 if ($status =~ /Connecting\s+to\s+Storage.*\n(\n?)(.*)\n/i) {
 995         $msg = $2;
 996         }
 997 local $sect = 0;
 998 local (@run, @done);
 999 local $old_style = 0;
1000 foreach my $l (split(/\r?\n/, $status)) {
1001         if ($l =~ /^Running\s+Jobs/i) { $sect = 2; }
1002         elsif ($l =~ /^Terminated\s+Jobs/i) { $sect = 3; }
1003
1004         if ($sect == 2 && $l =~ /^\s*Backup\s+Job\s+(\S+)\.(\d+\-\d+\-\S+)\s+(.*)/) {
1005                 push(@run, { 'name' => &job_name("$1"),
1006                              'status' => $3 });
1007                 }
1008         elsif ($sect == 2 && $l =~ /^\s*(\S+)\s+Backup\s+job\s+(\S+)\s+JobId=(\d+)\s+Volume="(.*)"(\s+device="(.*)")?/i) {
1009                 if (!@run || $old_style) {
1010                         push(@run, { 'name' => $2 });
1011                         $old_style = 1;
1012                         }
1013                 $run[$#run]->{'level'} = $1;
1014                 $run[$#run]->{'id'} = $3;
1015                 $run[$#run]->{'volume'} = $4;
1016                 $run[$#run]->{'device'} = $6;
1017                 }
1018         elsif ($sect == 3 && $l =~ /^\s*(\d+)\s+(\S+)\s+([0-9,]+)\s+([0-9,]+\.[0-9,]+\s+\S+|\d+)\s+(\S+)\s+(\S+\s+\S+)\s+(\S+)\s*$/) {
1019                 push(@done, { 'id' => $1,
1020                               'level' => &full_level("$2"),
1021                               'files' => &remove_comma("$3"),
1022                               'bytes' => &remove_comma("$4"),
1023                               'status' => $5,
1024                               'date' => $6,
1025                               'name' => &job_name("$7") });
1026                 }
1027         }
1028 return ($msg, $msg =~ /failed|error/i ? 0 : 1, \@run, \@done);
1029 }
1030
1031 # get_pool_volumes(pool)
1032 # Returns a list of volumes in some pool
1033 sub get_pool_volumes
1034 {
1035 local ($pool) = @_;
1036 local $h = &open_console();
1037 local $volumes = &console_cmd($h, "llist volumes pool=$pool");
1038 &close_console($h);
1039 local @volumes;
1040 local $volume;
1041 foreach my $l (split(/\r?\n/, $volumes)) {
1042         if ($l =~ /^\s*(\S+):\s*(.*)/) {
1043                 # A setting in this volume
1044                 local ($n, $v) = (lc($1), $2);
1045                 $volume ||= { };
1046                 if ($v =~ /^[0-9,]+$/) {
1047                         $v = &remove_comma($v);
1048                         }
1049                 elsif ($v eq "0000-00-00 00:00:00") {
1050                         $v = undef;
1051                         }
1052                 $volume->{$n} = $v;
1053                 }
1054         elsif ($l =~ /^\s*$/) {
1055                 # End of this volume
1056                 push(@volumes, $volume);
1057                 $volume = undef;
1058                 }
1059         }
1060 push(@volumes, $volume) if ($volume && &indexof($volume, @volumes) < 0);
1061 return @volumes;
1062 }
1063
1064 # full_level(level)
1065 # Converts a shortened backup level to a long one
1066 sub full_level
1067 {
1068 local ($level) = @_;
1069 foreach my $l (@backup_levels) {
1070         return $l if ($l =~ /^\Q$level\E/i);
1071         }
1072 return $level;
1073 }
1074
1075 sub remove_comma
1076 {
1077 local ($n) = @_;
1078 $n =~ s/,//g;
1079 if ($n =~ /^([0-9\.]+)\s*k/i) {
1080         $n = $1*1024;
1081         }
1082 elsif ($n =~ /^([0-9\.]+)\s*M/i) {
1083         $n = $1*1024*1024;
1084         }
1085 elsif ($n =~ /^([0-9\.]+)\s*G/i) {
1086         $n = $1*1024*1024*1024;
1087         }
1088 elsif ($n =~ /^([0-9\.]+)\s*T/i) {
1089         $n = $1*1024*1024*1024*1024;
1090         }
1091 return $n;
1092 }
1093
1094 # job_name(name)
1095 # Converts a job name that has had spaces replaced with _ to the real name
1096 sub job_name
1097 {
1098 local ($name) = @_;
1099 $name =~ s/_/./g;
1100 local $conf = &get_director_config();
1101 foreach my $j (&find("Job", $conf)) {
1102         local $n = &find_value("Name", $j->{'members'});
1103         if ($n =~ /^$name$/) {
1104                 return $n;
1105                 }
1106         }
1107 return $name;
1108 }
1109
1110 sub bacula_yesno
1111 {
1112 local ($id, $name, $mems) = @_;
1113 local $v = &find_value($name, $mems);
1114 return &ui_radio($id, $v =~ /^yes/i ? "yes" : $v =~ /^no/i ? "no" : "",
1115                  [ [ "yes", $text{'yes'} ],
1116                    [ "no", $text{'no'} ],
1117                    [ "", $text{'default'} ] ]);
1118 }
1119
1120 # has_node_groups()
1121 # Returns 1 if the system supports OC-Manager node groups
1122 sub has_node_groups
1123 {
1124 return $config{'groupmode'} && &foreign_check("node-groups");
1125 }
1126
1127 # check_node_groups()
1128 # Returns an error message if the node group database could not be contacted
1129 sub check_node_groups
1130 {
1131 if ($config{'groupmode'} eq 'oc') {
1132         return $text{'check_engmod'} if (!&foreign_check("node-groups"));
1133         return &node_groups::check_node_groups();
1134         }
1135 elsif ($config{'groupmode'} eq 'webmin') {
1136         &foreign_require("servers", "servers-lib.pl");
1137         local @groups = &servers::list_all_groups();
1138         return @groups ? undef : $text{'check_eservers'};
1139         }
1140 else {
1141         return undef;
1142         }
1143 }
1144
1145 # list_node_groups()
1146 # Returns a list of groups, each of which is a hash containing a name and
1147 # a list of members
1148 sub list_node_groups
1149 {
1150 if ($config{'groupmode'} eq 'webmin') {
1151         # Get list of groups from Webmin
1152         &foreign_require("servers", "servers-lib.pl");
1153         return &servers::list_all_groups();
1154         }
1155 elsif ($config{'groupmode'} eq 'oc') {
1156         # Get list from OC database
1157         return &node_groups::list_node_groups();
1158         }
1159 else {
1160         &error("Node groups not enabled!");
1161         }
1162 }
1163
1164 sub make_dbistr
1165 {
1166 local ($driver, $db, $host) = @_;
1167 local $rv;
1168 if ($driver eq "mysql") {
1169         $rv = "database=$db";
1170         }
1171 elsif ($driver eq "Pg") {
1172         $rv = "dbname=$db";
1173         }
1174 else {
1175         $rv = $db;
1176         }
1177 if ($host) {
1178         $rv .= ";host=$host";
1179         }
1180 return $rv;
1181 }
1182
1183 # is_oc_object(&client|&job|name, [force-scalar])
1184 # Returns the group name if the given object is associated with an OC group.
1185 # In an array context, returns the job or client name too
1186 sub is_oc_object
1187 {
1188 local ($object, $scalar) = @_;
1189 local $name = ref($object) && defined($object->{'members'}) ?
1190                 &find_value("Name", $object->{'members'}) :
1191               ref($object) ? $object->{'name'}
1192                            : $object;
1193 local @rv = $name =~ /^ocgroup[_\.](.*)$/ ? ( $1 ) :
1194             $name =~ /^occlientjob[_\.]([^_\.]*)[_\.](.*)$/ ? ( $1, $2 ) :
1195             $name =~ /^ocjob[_\.](.*)$/ ? ( $1 ) :
1196             $name =~ /^occlient[_\.]([^_\.]*)[_\.](.*)$/ ? ( $1, $2 ) : ( );
1197 return wantarray && !$scalar ? @rv : $rv[0];
1198 }
1199
1200 # sync_group_clients(&nodegroup)
1201 # Update or delete all clients created from the given node group
1202 sub sync_group_clients
1203 {
1204 local ($group) = @_;
1205 local $conf = &get_director_config();
1206 local $parent = &get_director_config_parent();
1207
1208 # First delete old clients and jobs
1209 local $gclient;
1210 local %doneclient;
1211 foreach my $client (&find("Client", $conf)) {
1212         local ($g, $c) = &is_oc_object($client);
1213         if ($g eq $group->{'name'} && $c) {
1214                 # Delete this client which was generated from the group
1215                 &save_directive($conf, $parent, $client, undef);
1216                 $doneclient{$c} = 1;
1217                 }
1218         elsif ($g eq $group->{'name'} && !$c) {
1219                 # Found the special group definition client
1220                 $gclient = $client;
1221                 }
1222         }
1223 foreach my $job (&find("Job", $conf)) {
1224         local ($j, $c) = &is_oc_object($job);
1225         if ($j && $c && $doneclient{$c}) {
1226                 # Delete this job which is associated with a group's client
1227                 &save_directive($conf, $parent, $job, undef);
1228                 }
1229         }
1230
1231 if ($gclient) {
1232         # Create one client for each group
1233         foreach my $m (@{$group->{'members'}}) {
1234                 local $newclient = &clone_object($gclient);
1235                 &save_directive($conf, $newclient,
1236                         "Name", "occlient_".$group->{'name'}."_".$m);
1237                 &save_directive($conf, $newclient, "Address", $m);
1238                 &save_directive($conf, $parent, undef, $newclient, 0);
1239                 }
1240
1241         # Create one real job for each group job and for each client in it!
1242         foreach my $job (&find_by("Client", "ocgroup_".$group->{'name'}, $conf)) {
1243                 local $name = &is_oc_object($job);
1244                 next if (!$name);
1245                 foreach my $m (@{$group->{'members'}}) {
1246                         local $newjob = { 'name' => 'Job',
1247                                           'type' => 1,
1248                                           'members' => [
1249                                 { 'name' => 'Name',
1250                                   'value' => "occlientjob_".$name."_".$m },
1251                                 { 'name' => 'JobDefs',
1252                                   'value' => "ocjob_".$name },
1253                                 { 'name' => 'Client',
1254                                   'value' => "occlient_".
1255                                              $group->{'name'}."_".$m },
1256                                         ] };
1257                         &save_directive($conf, $parent, undef, $newjob, 0);
1258                         }
1259                 }
1260         }
1261 }
1262
1263 # clone_object(&object)
1264 # Deep-clones a Bacula object, minus any file or line details
1265 sub clone_object
1266 {
1267 local ($src) = @_;
1268 local %dest = %$src;
1269 delete($dest{'file'});
1270 delete($dest{'line'});
1271 delete($dest{'eline'});
1272 $dest{'members'} = [ ];
1273 foreach my $sm (@{$src->{'members'}}) {
1274         push(@{$dest{'members'}}, &clone_object($sm));
1275         }
1276 return \%dest;
1277 }
1278
1279 sub find_cron_job
1280 {
1281 &foreign_require("cron", "cron-lib.pl");
1282 local ($job) = grep { $_->{'command'} eq $cron_cmd } &cron::list_cron_jobs();
1283 return $job;
1284 }
1285
1286 # joblink(jobname)
1287 # Returns a link for editing some job, if possible
1288 sub joblink
1289 {
1290 if (!%joblink_jobs) {
1291         local $conf = &get_director_config();
1292         %joblink_jobs = map { $n=&find_value("Name", $_->{'members'}), 1 }
1293                         &find("Job", $conf);
1294         }
1295 local ($name) = @_;
1296 local $job = $joblink_jobs{$name};
1297 local ($j, $c) = &is_oc_object($name);
1298 if (!$job) {
1299         return $j ? "$j ($c)" : $name;
1300         }
1301 else {
1302         if ($j) {
1303                 return "<a href='edit_gjob.cgi?name=".&urlize($j)."'>$j ($c)</a>";
1304                 }
1305         else {
1306                 return "<a href='edit_job.cgi?name=".&urlize($name)."'>$name</a>";
1307                 }
1308         }
1309 }
1310
1311 sub sort_by_name
1312 {
1313 local ($list) = @_;
1314 @$list = sort { $na = &find_value("Name", $a->{'members'});
1315                 $nb = &find_value("Name", $b->{'members'});
1316                 return lc($na) cmp lc($nb) } @$list;
1317 }
1318
1319 # show_tls_directives(&object)
1320 # Print inputs for TLS directives for a director, client or storage
1321 sub show_tls_directives
1322 {
1323 local ($object) = @_;
1324 local $mems = $object->{'members'};
1325 return if (&get_bacula_version_cached() < 1.38);
1326 print &ui_table_hr();
1327
1328 print &ui_table_row($text{'tls_enable'},
1329                     &bacula_yesno("tls_enable", "TLS Enable", $mems));
1330
1331 print &ui_table_row($text{'tls_require'},
1332                     &bacula_yesno("tls_require", "TLS Require", $mems));
1333
1334 print &ui_table_row($text{'tls_verify'},
1335                     &bacula_yesno("tls_verify", "TLS Verify Peer", $mems));
1336
1337 local $cert = &find_value("TLS Certificate", $mems);
1338 print &ui_table_row($text{'tls_cert'},
1339             &ui_opt_textbox("tls_cert", $cert, 60, $text{'tls_none'})." ".
1340             &file_chooser_button("tls_cert", 0), 3);
1341
1342 local $key = &find_value("TLS Key", $mems);
1343 print &ui_table_row($text{'tls_key'},
1344             &ui_opt_textbox("tls_key", $key, 60, $text{'tls_none'})." ".
1345             &file_chooser_button("tls_key", 0), 3);
1346
1347 local $cacert = &find_value("TLS CA Certificate File", $mems);
1348 print &ui_table_row($text{'tls_cacert'},
1349             &ui_opt_textbox("tls_cacert", $cacert, 60, $text{'tls_none'})." ".
1350             &file_chooser_button("tls_cacert", 0), 3);
1351 }
1352
1353 # parse_tls_directives(&config, &object, indent)
1354 sub parse_tls_directives
1355 {
1356 local ($conf, $object, $indent) = @_;
1357 return if (&get_bacula_version_cached() < 1.38);
1358
1359 &save_directive($conf, $object, "TLS Enable", $in{'tls_enable'} || undef,
1360                 $indent);
1361 &save_directive($conf, $object, "TLS Require", $in{'tls_require'} || undef,
1362                 $indent);
1363 &save_directive($conf, $object, "TLS Verify Peer", $in{'tls_verify'} || undef,
1364                 $indent);
1365
1366 $in{'tls_cert_def'} || -r $in{'tls_cert'} || &error($text{'tls_ecert'});
1367 &save_directive($conf, $object, "TLS Certificate",
1368                 $text{'tls_ecert_def'} ? undef : $in{'tls_cert'}, $indent);
1369
1370 $in{'tls_key_def'} || -r $in{'tls_key'} || &error($text{'tls_ekey'});
1371 &save_directive($conf, $object, "TLS Key",
1372                 $text{'tls_ekey_def'} ? undef : $in{'tls_key'}, $indent);
1373
1374 $in{'tls_cacert_def'} || -r $in{'tls_cacert'} || &error($text{'tls_ecacert'});
1375 &save_directive($conf, $object, "TLS CA Certificate File",
1376                 $text{'tls_ecacert_def'} ? undef : $in{'tls_cacert'}, $indent);
1377
1378 if ($in{'tls_enable'} eq 'yes' &&
1379     ($in{'tls_cert_def'} || $in{'tls_key_def'} || $in{'tls_cacert_def'})) {
1380         &error($text{'tls_ecerts'});
1381         }
1382
1383 if (!$in{'tls_key_def'}) {
1384         &foreign_require("webmin", "webmin-lib.pl");
1385         &webmin::validate_key_cert($in{'tls_key'},
1386                         $in{'tls_cert_def'} ? undef : $in{'tls_cert'});
1387         }
1388
1389 }
1390
1391 # schedule_chooser_button(name)
1392 # Returns a button for choosing a Bacula schedule in a popup window
1393 sub schedule_chooser_button
1394 {
1395 local ($name) = @_;
1396 return "<input type=button onClick='ifield = form.$name; schedule = window.open(\"schedule_chooser.cgi?schedule=\"+escape(ifield.value), \"schedule\", \"toolbar=no,menubar=no,scrollbars=no,width=600,height=600\"); schedule.ifield = ifield; window.ifield = ifield;' value=\"...\">\n";
1397 }
1398
1399 # parse_schedule(string)
1400 # Returns an object containing details of a schedule, or undef if not parseable
1401 # XXX hourly at mins
1402 sub parse_schedule
1403 {
1404 local ($str) = @_;
1405 local @w = split(/\s+/, $str);
1406 local $rv = { };
1407
1408 # Look for month spec
1409 if ($w[0] eq "monthly") {
1410         # Monthyl
1411         $rv->{'months_all'} = 1;
1412         shift(@w);
1413         }
1414 elsif ($w[0] =~ /^(\S+)\-(\S+)$/ &&
1415        defined(&is_month($1)) && defined(&is_month($2))) {
1416         # A month range
1417         $rv->{'months'} = [ &is_month($1) .. &is_month($2) ];
1418         shift(@w);
1419         }
1420 elsif (defined(&is_month($w[0]))) {
1421         # One month
1422         $rv->{'months'} = [ &is_month($w[0]) ];
1423         shift(@w);
1424         }
1425 else {
1426         $rv->{'months_all'} = 2;
1427         }
1428
1429 # Look for days of month spec
1430 if ($w[0] eq "on") {
1431         shift(@w);
1432         }
1433 if ($w[0] =~ /^(\d+)\-(\d+)$/) {
1434         $rv->{'days'} = [ $1 .. $2 ];
1435         shift(@w);
1436         }
1437 elsif ($w[0] =~ /^\d+$/) {
1438         $rv->{'days'} = [ $w[0] ];
1439         shift(@w);
1440         }
1441 else {
1442         $rv->{'days_all'} = 1;
1443         }
1444
1445 # Look for days of week
1446 if ($w[0] =~ /^(\S+)\-(\S+)$/ &&
1447        defined(&is_nth($1)) && defined(&is_nth($2))) {
1448         # nth weekday range
1449         $rv->{'weekdaynums'} = [ &is_nth($1) .. &is_nth($2) ];
1450         shift(@w);
1451         }
1452 elsif (defined(&is_nth($w[0]))) {
1453         # nth weekday of month
1454         $rv->{'weekdaynums'} = [ &is_nth($w[0]) ];
1455         shift(@w);
1456         }
1457 else {
1458         # Any weekday num
1459         $rv->{'weekdaynums_all'} = 1;
1460         }
1461 if ($w[0] =~ /^(\S+)\-(\S+)$/ &&
1462     defined(&is_weekday($1)) && defined(&is_weekday($2))) {
1463         # Day or week range
1464         $rv->{'weekdays'} = [ &is_weekday($1) .. &is_weekday($2) ];
1465         shift(@w);
1466         }
1467 elsif (defined(&is_weekday($w[0]))) {
1468         # One day of week
1469         $rv->{'weekdays'} = [ &is_weekday($w[0]) ];
1470         shift(@w);
1471         }
1472 else {
1473         # Any weekday
1474         return "Missing weekday when weekday number was specified"
1475                 if (!$rv->{'weekdaynums_all'});
1476         $rv->{'weekdays_all'} = 1;
1477         }
1478
1479 # Look for time of day
1480 if ($w[0] eq "at") {
1481         shift(@w);
1482         }
1483 if ($w[0] =~ /^(\d+):(\d+)$/) {
1484         $rv->{'hour'} = $1;
1485         $rv->{'minute'} = $2;
1486         }
1487 elsif ($w[0] =~ /^(\d+):(\d+)(am|pm)$/i) {
1488         $rv->{'hour'} = $1;
1489         $rv->{'minute'} = $2;
1490         $rv->{'hour'} += 12 if (lc($3) eq 'pm');
1491         }
1492 else {
1493         return "Missing hour:minute spec";
1494         }
1495
1496 return $rv;
1497 }
1498
1499 sub is_month
1500 {
1501 local $m = lc(substr($_[0], 0, 3));
1502 return $month_to_number_map{$m};
1503 }
1504
1505 sub is_nth
1506 {
1507 local $n = lc($_[0]);
1508 return $n eq "1st" || $n eq "first" ? 1 :
1509        $n eq "2nd" || $n eq "second" ? 2 :
1510        $n eq "3rd" || $n eq "third" ? 3 :
1511        $n eq "4th" || $n eq "fourth" ? 4 :
1512        $n eq "5th" || $n eq "fifth" ? 5 : undef;
1513 }
1514
1515 sub is_weekday
1516 {
1517 local $w = lc(substr($_[0], 0, 3));
1518 return $w eq "sun" ? 0 :
1519        $w eq "mon" ? 1 :
1520        $w eq "tue" ? 2 :
1521        $w eq "wed" ? 3 :
1522        $w eq "thu" ? 4 :
1523        $w eq "fri" ? 5 :
1524        $w eq "sat" ? 6 : undef;
1525 }
1526
1527 # join_schedule(&sched)
1528 # Converts a schedule object into a string
1529 sub join_schedule
1530 {
1531 local ($sched) = @_;
1532 local @w;
1533
1534 if (!$sched->{'months_all'}) {
1535         local $r = &make_range($sched->{'months'}, \%number_to_month_map);
1536         defined($r) || &error($text{'chooser_emonthsrange'});
1537         push(@w, $r);
1538         }
1539
1540 if (!$sched->{'days_all'}) {
1541         local %days_map = map { $_, $_ } (1 .. 31);
1542         local $r = &make_range($sched->{'days'}, \%days_map);
1543         defined($r) || &error($text{'chooser_edaysrange'});
1544         push(@w, "on", $r);
1545         }
1546
1547 if (!$sched->{'weekdaynums_all'}) {
1548         local %weekdaynums_map = ( 1 => '1st', 2 => '2nd', 3 => '3rd',
1549                                    4 => '4th', 5 => '5th' );
1550         local $r = &make_range($sched->{'weekdaynums'}, \%weekdaynums_map);
1551         defined($r) || &error($text{'chooser_eweekdaynumsrange'});
1552         push(@w, $r);
1553         }
1554
1555 if (!$sched->{'weekdays_all'}) {
1556         local %weekdays_map = ( 0 => 'sun', 1 => 'mon', 2 => 'tue',
1557                            3 => 'wed', 4 => 'thu', 5 => 'fri', 6 => 'sat' );
1558         local $r = &make_range($sched->{'weekdays'}, \%weekdays_map);
1559         defined($r) || &error($text{'chooser_eweekdaysrange'});
1560         push(@w, $r);
1561         }
1562
1563 push(@w, "at");
1564 push(@w, $sched->{'hour'}.":".$sched->{'minute'});
1565
1566 return join(" ", @w);
1567 }
1568
1569 # make_range(&nums, &map)
1570 sub make_range
1571 {
1572 local ($nums, $map) = @_;
1573 if (scalar(@$nums) == 1) {
1574         return $map->{$nums->[0]};
1575         }
1576 @$nums = sort { $a <=> $b } @$nums;
1577 $prev = undef;
1578 foreach my $n (@$nums) {
1579         if (defined($prev) && $prev != $n-1) {
1580                 return undef;
1581                 }
1582         $prev = $n;
1583         }
1584 return $map->{$nums->[0]}."-".$map->{$nums->[@$nums-1]};
1585 }
1586
1587 # date_to_unix(string)
1588 # Converts a MySQL date string to a Unix time_t
1589 sub date_to_unix
1590 {
1591 local ($str) = @_;
1592 if ($str =~ /^(\d{4})\-(\d\d)\-(\d\d)\s+(\d\d):(\d\d):(\d\d)$/) {
1593         # MySQL time
1594         return timelocal($6, $5, $4, $3, $2-1, $1-1900);
1595         }
1596 return undef;
1597 }
1598
1599 # extract_schedule(run)
1600 # Given a schedule Run string like Level=Full Pool=Monthly 1st sat at 03:05,
1601 # returns a hash ref of the tags and the schedule.
1602 sub extract_schedule
1603 {
1604 local ($run) = @_;
1605 local %tags;
1606 while($run =~ s/^(\S+)=(\S+)\s+//) {
1607         $tags{$1} = $2;
1608         }
1609 if (!$tags{'Level'}) {
1610         $run =~ s/^(\S+)\s+//;
1611         $tags{'Level'} = $1;
1612         }
1613 return ( \%tags, $run );
1614 }
1615
1616 1;
1617