monikop

   1 #! /usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use integer;
   5 use File::Rsync;
   6 use File::Basename;
   7 use Thread 'async';
   8 use threads::shared;
   9 use Curses;
  10
  11 my @monikop_banner = (
  12   "    _/      _/    _/_/    _/      _/  _/_/_/  _/    _/    _/_/    _/_/_/ ",
  13   "   _/_/  _/_/  _/    _/  _/_/    _/    _/    _/  _/    _/    _/  _/    _/",
  14   "  _/  _/  _/  _/    _/  _/  _/  _/    _/    _/_/      _/    _/  _/_/_/   ",
  15   " _/      _/  _/    _/  _/    _/_/    _/    _/  _/    _/    _/  _/        ",
  16   "_/      _/    _/_/    _/      _/  _/_/_/  _/    _/    _/_/    _/         ",
  17   );
  18
  19 # Debug mode:
  20 # 0 = clean UI; 1 = lots of scrolling junk; anything else = both (pipe to file)
  21 my $debug = 0;
  22 $debug = $ARGV[1] if $ARGV[1];
  23
  24 # Where to read local configuration:
  25 my $monikop_config = '~/monikop/monikop.config';
  26 $monikop_config = $ARGV[0] if $ARGV[0];
  27
  28 ########################################
  29 # Settings
  30 ########################################
  31 # Possible data sources, and by what directory name to represent them in
  32 # destination.
  33 # When the latter is not unique, care must be taken that all pathnames in the
  34 # respective sources are unique.
  35 my %sources;
  36
  37 # Possible mount points of data destinations. Must be unique.
  38 my @usable_mount_points;
  39
  40 # Common directory (under a mount point) to put new data in.
  41 # Must agree with Pokinom's setting.
  42 my $path_in_destination;
  43
  44 # Directories (under any mount point) of this name will be deleted
  45 # Must agree with Pokinom's setting.
  46 my $path_in_destination_backed_up;
  47
  48 # Directory name (under a mount point) while being deleted.
  49 # Must agree with Pokinom's setting.
  50 my $path_in_destination_being_deleted;
  51
  52 # Path and file name prefix of rsync's raw logs:
  53 my $rsync_log_prefix;
  54
  55 # Path and file name prefix of the list of successfully rsynced files:
  56 my $finished_prefix;
  57
  58 # How to suffix the name of the duplicate of a safe file:
  59 my $safe_file_backup_suffix;
  60
  61 # How to suffix the name of an unfinished safe file:
  62 my $safe_file_unfinished_suffix;
  63
  64 # What to do (shutdown) when F3 has been pressed:
  65 my $key_f3_action;
  66
  67 # What to do (reboot) when F6 has been pressed:
  68 my $key_f6_action;
  69
  70 # Rsyncs time (in seconds) to wait for a response:
  71 my $rsync_timeout;
  72
  73 # Rsyncs directory (relative to destination) for partially transferred files.
  74 # Must agree with Pokinom's setting.
  75 my $rsync_partial_dir_name;
  76
  77 # Put actual values into the above.
  78 eval `cat $monikop_config`;
  79
  80 # Time in seconds before rsync is restarted and user information is
  81 # recalculated:
  82 my $coffee_break = 10;
  83
  84 # Places to store run-time information to share between threads:
  85 my %speeds :shared; # rsync output
  86 my %progress_ratios :shared; # rsync output
  87 my %destination_usages :shared; # i.e. used/unused
  88 my %destination_usage_ratios :shared;
  89 my %destination_source_is_writing_to :shared;
  90 my %reachable :shared;
  91
  92 sub debug_print { if ($debug) { print @_; } };
  93
  94 # Return the hash referenced by argument, which is sorted if accessed as an
  95 # array:
  96 sub sort_hash {
  97     my %hash_table = @_;
  98     my @sorted_hash = ();
  99     foreach my $key (sort keys %hash_table) {
 100         push @sorted_hash, $key, $hash_table{$key};
 101     }
 102     @sorted_hash;
 103 }
 104
 105 # Turn a path into a legal perl identifier:
 106 sub make_key_from_path {
 107     my $path = shift;
 108     ($path) =~ s/\/?(.*)\/?/$1/g;
 109     ($path) =~ s/\W/_/g;
 110     $path;
 111 }
 112
 113 my %source_roots;
 114 map {
 115     $source_roots{make_key_from_path $_} = $_
 116 } keys %sources;
 117
 118 my %source_dirs_in_destination;
 119 map {
 120     $source_dirs_in_destination{make_key_from_path $_} = $sources{$_}
 121 } keys %sources;
 122
 123 # Crudely turn date string(s) into a number. Chronological order is preserved.
 124 sub normalize_date {
 125     my $date = join '', @_;
 126     $date =~  tr/ \/:-//d;
 127     $date;
 128 }
 129
 130 # Return sorted intersection of arrays which are supposed to have unique
 131 # elements:
 132 sub intersection {
 133     my @intersection = ();
 134     my %count = ();
 135     my $element;
 136     foreach $element (@_) { $count{$element}++ }
 137     foreach $element (keys %count) {
 138         push @intersection, $element if $count{$element} > 1;
 139     }
 140     sort @intersection;
 141 }
 142
 143 # Write @content to a file with name $filename or a name starting with
 144 # $filename and ending with $safe_file_backup_suffix. Leave at least one such
 145 # file, even if interrupted.
 146 sub safe_write {
 147     my ($filename, @content) = @_;
 148     my $filename_a = $filename;
 149     my $filename_b = $filename . $safe_file_backup_suffix;
 150     my $filename_unfinished = $filename . $safe_file_unfinished_suffix;
 151     local (*FILE_UNFINISHED);
 152     open FILE_UNFINISHED, '>', $filename_unfinished
 153         or die "[" . $$ . "] open $filename_unfinished failed: $!\n";
 154     print FILE_UNFINISHED @content;
 155     close FILE_UNFINISHED;
 156     qx(cp $filename_unfinished $filename_b);
 157     qx(mv $filename_unfinished $filename_a);
 158 }
 159
 160 # Put contents of $filename into an array:
 161 sub read_list {
 162     my ($filename) = @_;
 163     local (*FILE);
 164     open FILE, '<', $filename
 165         or warn "[" . $$ . "] open $filename failed: $!\n";
 166     my @value = <FILE>;
 167     close FILE;
 168     @value;
 169 }
 170
 171 # Read a file written by safe_write
 172 sub safe_read {
 173     my ($filename) = @_;
 174     my $filename_a = $filename;
 175     my $filename_b = $filename . $safe_file_backup_suffix;
 176     if (stat $filename_a) { my $filename = $filename_a }
 177     elsif (stat $filename_b) { my $filename = $filename_b }
 178     else { return () }
 179     debug_print "SAFE_READ: $filename";
 180     read_list $filename;
 181 }
 182
 183 my @destination_roots;
 184 my %rsync_outfun;
 185 my %rsync;
 186 my %rsync_exec_form;
 187 my %rsync_dir;
 188 my %rsync_dir_exec_form;
 189 my %rsync_dir_err_form;
 190 my %rsync_worker_thread;
 191 my %being_deleted_thread;
 192 my $destinations_monitor_thread;
 193 my $display_thread;
 194
 195 sub rsync_preparation_form {
 196     my ($source) = @_;
 197     $speeds{$source} = "-";
 198     join ( '',
 199            "\n",
 200 ##########  Capture rsync's status messages for use by UI
 201            '$rsync_outfun{\'', $source, '\'} = sub {',
 202            '    my ($outline, $outputchannel) = @_ ; ',
 203            '    my ($speed) = $outline =~ /\d+\s+\d+%\s+(\S+)/; ',
 204            '    my ($progress_ratio) = ',
 205            '        $outline =~ /.+to-check=(\d+\/\d+)\)$/; ',
 206            '    if ($speed and $outputchannel eq \'out\') {',
 207            '        $speeds{\'', $source, '\'} = $speed;',
 208            '    } else {',
 209            '        $speeds{\'', $source, '\'} = "-";',
 210            '    };',
 211            '    if ($progress_ratio and $outputchannel eq \'out\') {',
 212            '        $progress_ratios{\'', $source, '\'} = $progress_ratio;',
 213            '    } ;',
 214            '};',
 215            "\n",
 216 ##########  Run rsync: main worker
 217            '$rsync{\'', $source, '\'} = File::Rsync->new; ',
 218 ##########  Return fodder for another eval
 219            '$rsync_exec_form{\'', $source, '\'} = sub {',
 220            '    my ($complete_destination) = @_;',
 221            '    \'$rsync{\\\'', $source, '\\\'}->exec(',
 222            '        {',
 223            '            src => \\\'', $source_roots{$source}, '/\\\', ',
 224            '            dest => \\\'\' . $complete_destination . \'/\\\', ',
 225            '            outfun => $rsync_outfun{\\\'', $source, '\\\'}, ',
 226            '            progress => 1, debug => 0, verbose => 0, ',
 227            '            filter => [\\\'merge,- ', $finished_prefix, $source,
 228            '\\\'], ',
 229            '            literal => [',
 230            '                        \\\'--recursive\\\', \\\'--times\\\', ',
 231            '                        \\\'--partial-dir=',
 232            $rsync_partial_dir_name, '\\\', ',
 233            '                        \\\'--timeout=', $rsync_timeout, '\\\', ',
 234            '                        \\\'--prune-empty-dirs\\\', ',
 235            '                        \\\'--log-file-format=%i %b %l %M %n\\\', ',
 236                             join (', ',
 237                                   map {
 238                                       '\\\'--compare-dest=' . $_ . '/'
 239                                           . $path_in_destination . '/'.
 240                                           $source_dirs_in_destination{$source}
 241                                       . '/\\\''
 242                                   }
 243                                   ( @destination_roots )),
 244            '                      , \\\'--log-file=', $rsync_log_prefix, $source, '\\\'] ',
 245            '        }',
 246            '    );\' ',
 247            '};',
 248            "\n",
 249 ##########  Run rsync: get directory from source
 250            '$rsync_dir{\'', $source, '\'} = File::Rsync->new; ',
 251 ##########  Return fodder for another eval: dir
 252            '$rsync_dir_exec_form{\'', $source, '\'} = sub {',
 253            '    \'$rsync_dir{\\\'', $source, '\\\'}->list(',
 254            '        {',
 255            '            src => \\\'', $source_roots{$source}, '/\\\', ',
 256            '            literal => [ \\\'--recursive\\\', ',
 257            '                         \\\'--timeout=', $rsync_timeout, '\\\'] ',
 258            '        }',
 259            '    );\' ',
 260            '};',
 261            "\n",
 262 ##########  Return fodder for another eval: error code from last rsync call
 263            '$rsync_dir_err_form{\'', $source, '\'} = sub {',
 264            '    \'$rsync_dir{\\\'', $source, '\\\'}->err();\' ',
 265            '}',
 266            "\n"
 267         )};
 268
 269 sub act_on_keypress {
 270     my ($pressed_key) = @_;
 271     if ($pressed_key eq 267) { qx($key_f3_action) }
 272     elsif ($pressed_key eq 270) { qx($key_f6_action); }
 273 }
 274
 275 # Run rsync for one $source, try all destinations:
 276 sub rsync_someplace {
 277     my ($source, @destinations) = @_;
 278     my $success;
 279
 280     my $rsync_log_name = $rsync_log_prefix . $source;
 281     my $finished_name = $finished_prefix . $source;
 282     foreach (@destinations) {
 283         $destination_source_is_writing_to{$source} = $_;
 284         my $common_destination = $_ . '/' . $path_in_destination;
 285         my $complete_destination = $common_destination . '/'
 286             . $source_dirs_in_destination{$source};
 287         qx(mkdir -p $common_destination);
 288         if ($?) { die "Fatal: $common_destination is not writable."}
 289         if (eval ($rsync_exec_form{$source} ($complete_destination))) {
 290             debug_print "EVAL RSYNC_EXEC_FORM (successful) $source,\ $complete_destination: $@ \n";
 291             $success = 1;
 292             last; # unnecessary reruns would put empty
 293             #       dirs into otherwise unused destinations
 294         } else {
 295             debug_print "EVAL RSYNC_EXEC_FORM (failed) $source, $complete_destination: $@ \n";
 296             $success = 0;
 297         }
 298     }
 299     $success;
 300 }
 301
 302 $SIG{TERM} = sub {
 303     $display_thread->kill('TERM')->join;
 304     die "Caught signal $_[0]";
 305 };
 306
 307
 308 # Preparations done; sleeves up!
 309
 310 # Make sure we have dirs to put our logs in:
 311 map {
 312     my ($filename, $directory) = fileparse $_;
 313     qx(mkdir -p $directory);
 314 } ( $rsync_log_prefix, $finished_prefix );
 315
 316 # Find usable destinations:
 317 my @raw_mount_points = grep (s/\S+ on (.*) type .*/$1/, qx/mount/);
 318 chomp @raw_mount_points;
 319 @destination_roots = intersection @raw_mount_points, @usable_mount_points;
 320 debug_print "DESTINATION_ROOTS:\n";
 321 debug_print @destination_roots;
 322
 323 # Clean up destinations:
 324 map {
 325     my $p_i_d = $_ . '/' . $path_in_destination;
 326     my $p_i_d_backed_up =  $_ . '/' . $path_in_destination_backed_up;
 327     my $p_i_d_being_deleted =  $_ . '/' . $path_in_destination_being_deleted;
 328     if (-d $p_i_d_backed_up and -d $p_i_d_being_deleted) {
 329         warn "[" . $$ . "] " .
 330             "Both $p_i_d_backed_up and $ p_i_d_being_deleted exist.\n" .
 331             "This does not normally happen.\n" .
 332             "I'm deleting $p_i_d_being_deleted. Be patient.\n";
 333         qx(rm -rf $p_i_d_being_deleted);
 334     }
 335     qx(mv -f $p_i_d_backed_up $p_i_d_being_deleted 2> /dev/null);
 336     $being_deleted_thread{$_} = async {
 337         $SIG{TERM} = sub { threads->exit() };
 338         qx(rm -rf $p_i_d_being_deleted); };
 339 } @destination_roots;
 340
 341 if (scalar @destination_roots) {
 342 # Set up and start things per source_root:
 343     map {
 344         # rotate for crude load balancing:
 345         push (@destination_roots, shift (@destination_roots));
 346         $progress_ratios{$_} = "?"; # Initialize for UI
 347         $rsync_worker_thread{$_} = async {
 348             $SIG{TERM} = sub { threads->exit() };
 349             while (1) {
 350                 my $rsync_log_name = $rsync_log_prefix . $_;
 351                 my $finished_name = $finished_prefix . $_;
 352                 debug_print 'rsync_preparation_form:' .
 353                     rsync_preparation_form ($_). "\n";
 354                 eval rsync_preparation_form $_;
 355                 debug_print "EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
 356                 debug_print 'rsync_dir_exec_form $_:'.
 357                     $rsync_dir_exec_form{$_} () . "\n";
 358                 my @rsync_ls = eval $rsync_dir_exec_form{$_}();
 359                 eval $rsync_dir_err_form{$_}();
 360                 $reachable{$_} = eval $rsync_dir_err_form{$_}() ? 0 : 1;
 361                 debug_print "REACHABLE: $reachable{$_}\n";
 362                 if ($reachable{$_}) {
 363                     my %old_finished = safe_read $finished_name;
 364                     if (-f $rsync_log_name) {
 365                         my @rsync_log = read_list $rsync_log_name;
 366                         foreach (@rsync_log) {
 367                             my ($file_length, $modification_time, $filename) =
 368                                 /[\d\/\s:\[\]]+ [>c\.][fd]\S{9} \d+ (\d+) ([\d\/:-]+) (.*)$/;
 369                             if ($filename) {
 370                                 $old_finished{$filename . "\n"} =
 371                                     "### " . $modification_time . " " .
 372                                     $file_length . "\n";
 373                             }
 374                         }
 375                         safe_write $finished_name, sort_hash %old_finished;
 376                         unlink $rsync_log_name unless $debug;
 377                     }
 378                     my %finished = ();
 379                     # Delete from %old_finished what has to be re-rsynced.
 380                     foreach (@rsync_ls) {
 381                         my ($ls_size, $ls_modification_date,
 382                             $ls_modification_time, $ls_filename) =
 383                                 /[drwx-]+\s+(\d+) ([\d\/]+) ([\d:]+) (.*)/;
 384                         if ($ls_filename &&
 385                             exists $old_finished{$ls_filename . "\n"}) {
 386                             my ($finished_modification_date, $finished_size) =
 387                                 $old_finished{$ls_filename . "\n"} =~
 388                                 /### (\S+) (\d+)$/;
 389                             if ( ($finished_size eq $ls_size)
 390                                  && (normalize_date
 391                                      ($finished_modification_date)
 392                                      eq normalize_date
 393                                      ($ls_modification_date,
 394                                       $ls_modification_time)) )
 395                             {
 396                                 $finished{$ls_filename . "\n"} =
 397                                     $old_finished{$ls_filename . "\n"};
 398                             }
 399                         }
 400                     }
 401                     safe_write $finished_name, %finished;
 402                     if (rsync_someplace $_, @destination_roots) {
 403                         $progress_ratios{$_} = '0'; # Clean staleness for UI
 404                     }
 405                     sleep $coffee_break;
 406                 }
 407             }
 408         }
 409     } keys %source_roots;
 410 }
 411
 412 # Provide some reassuring user information:
 413 $destinations_monitor_thread = async {
 414     $SIG{TERM} = sub { threads->exit() };
 415     while () {
 416         map {
 417             my $destination_root = $_;
 418             my $destination_usage = 0;
 419             map {
 420                 my $source_root = $_;
 421                 my $complete_destination = $destination_root . '/'
 422                     . $path_in_destination . '/'
 423                     . $source_dirs_in_destination{$source_root};
 424                 my @dir = qx(ls -A $complete_destination/ 2> /dev/null);
 425                 $destination_usage = 1 if scalar @dir; # 0 = no new data
 426             } keys %source_roots;
 427             $destination_usages{$destination_root} = $destination_usage;
 428             my @destination_usage_ratio =
 429                 grep s/\S+\s+\S+\s+\S+\s+\S+\s+(\d*)%\s+\S+/$1/, qx(df -P $_);
 430             chomp @destination_usage_ratio;
 431             ($destination_usage_ratios{$_}) = @destination_usage_ratio;
 432         } @destination_roots;
 433         sleep $coffee_break;
 434     }
 435 };
 436
 437 if ($debug == 1) {
 438 # Let the workers toil.
 439     sleep;
 440 } else {
 441 # Let the workers toil; talk to the user.
 442
 443     $display_thread = async {
 444         $SIG{TERM} = sub {
 445             endwin(); # Leave a usable terminal.
 446             threads->exit()
 447         };
 448
 449         my $redraw_window_count = 0;
 450         initscr();
 451         cbreak();
 452         noecho();
 453         curs_set(0);
 454         my $window_left = newwin(LINES() -8, 29, 0, 0);
 455         my $window_right = newwin(LINES() - 8, 50, 0, 29);
 456         my $window_center = newwin(5, 79, LINES() - 8, 0);
 457         my $window_bottom = newwin(3, 79, LINES() - 3, 0);
 458         $window_bottom->keypad(1);
 459         $window_bottom->nodelay(1);
 460         start_color;
 461         init_pair 1, COLOR_MAGENTA, COLOR_BLACK;
 462         init_pair 2, COLOR_RED, COLOR_BLACK;
 463         init_pair 3, COLOR_CYAN, COLOR_BLACK;
 464         init_pair 4, COLOR_YELLOW, COLOR_BLACK;
 465         my $MAGENTA = COLOR_PAIR(1);
 466         my $RED = COLOR_PAIR(2);
 467         my $CYAN = COLOR_PAIR(3);
 468         my $YELLOW = COLOR_PAIR(4);
 469
 470         while (1) {
 471             $window_left->attron($CYAN);
 472             $window_left->box(0, 0);
 473             $window_left->addstr(0, 6, "Data Destinations");
 474             $window_left->attroff($CYAN);
 475             my $destinations_format = "%-18s%-6s%-3s";
 476             $window_left->attron(A_BOLD);
 477             $window_left->addstr(1, 1, sprintf($destinations_format,
 478                                                "Removable", "Fresh", "Usg"));
 479             $window_left->addstr(2, 1, sprintf($destinations_format,
 480                                                "Disk", "Data?", "%"));
 481             $window_left->attroff(A_BOLD);
 482             my $destination_usage;
 483             my $line_number = 3;
 484             map {
 485                 if ($destination_usages{$_}) {
 486                     $window_left->attron($RED);
 487                     $destination_usage = "yes";
 488                 } else {
 489                     $window_left->attron($CYAN);
 490                     $destination_usage = "no";
 491                 }
 492                 $window_left->
 493                     addstr($line_number, 1,
 494                            sprintf($destinations_format,
 495                                    substr($_, -17, 17),
 496                                    substr($destination_usage, -6, 6),
 497                                    substr($destination_usage_ratios{$_}
 498                                           ? $destination_usage_ratios{$_}
 499                                           : "?",
 500                                           -3, 3)));
 501                 ++ $line_number;
 502                 $window_left->attroff($RED);
 503                 $window_left->attroff($CYAN);
 504             } sort @destination_roots;
 505
 506             $window_right->attron($MAGENTA);
 507             $window_right->box(0,0);
 508             $window_right->addstr(0, 19, "Data Sources");
 509             $window_right->attroff($MAGENTA);
 510             my $sources_format = "%-15s%-11s%-9s%-13s";
 511             $window_right->attron(A_BOLD);
 512             $window_right->
 513                 addstr(1, 1, sprintf ($sources_format,
 514                                       "Data", "", "Files", " Writing"));
 515             $window_right->
 516                 addstr(2, 1, sprintf ($sources_format,
 517                                       "Source", "Speed", "To Copy", " To"));
 518             $window_right->attroff(A_BOLD);
 519             $line_number = 3;
 520             $window_right->attron($MAGENTA);
 521             map {
 522                 my $source = $_;
 523                 my $current_destination = '?';
 524                 if (exists $destination_source_is_writing_to{$source}) {
 525                     $current_destination =
 526                         $destination_source_is_writing_to{$source};
 527                 }
 528                 if ($reachable{$source}) {
 529                     $window_right->
 530                         addstr($line_number, 1,
 531                                sprintf($sources_format,
 532                                        substr($source_roots{$source}, 0, 14),
 533                                        substr($speeds{$source}, 0, 11),
 534                                        substr($progress_ratios{$source},
 535                                               -9, 9),
 536                                        substr($current_destination, -13, 13)));
 537                     ++ $line_number;
 538                 }
 539                 $window_right->
 540                     addstr($line_number, 1,
 541                            sprintf($sources_format, "", "", "", ""));
 542             } sort (keys %source_roots);
 543             $window_right->attroff($MAGENTA);
 544
 545             $line_number = 0;
 546             map {
 547                 $window_center->addstr($line_number, 2, $_);
 548                 ++ $line_number;
 549             } @monikop_banner;
 550             $window_center->move(0, 0);
 551
 552             $window_bottom->box(0,0);
 553             $window_bottom->attron(A_BOLD);
 554             $window_bottom->addstr(1, 3, "[F3]: Turn off computer.");
 555             $window_bottom->addstr(1, 53, "[F6]: Restart computer.");
 556             $window_bottom->attroff(A_BOLD);
 557
 558             $window_left->noutrefresh();
 559             $window_right->noutrefresh();
 560             $window_bottom->noutrefresh();
 561             $window_center->noutrefresh(); # Last window gets the cursor.
 562             act_on_keypress($window_bottom->getch());
 563             sleep 2;
 564             if (++ $redraw_window_count > 5) {
 565                 $redraw_window_count = 0;
 566             redrawwin();
 567             }
 568             doupdate();
 569         }
 570     endwin();
 571     };
 572 }
 573
 574 sleep;
 575
 576 # Tidy up. (Except we don't reach this.)
 577 map {
 578     $being_deleted_thread{$_}->join if $being_deleted_thread{$_};
 579 } @destination_roots;
 580
 581 map {
 582     $rsync_worker_thread{$_}->join if $rsync_worker_thread{$_};
 583 } keys %source_roots;
 584
 585 $destinations_monitor_thread->join if $destinations_monitor_thread;
 586
 587 $display_thread->join if $display_thread;
 588
 589 __END__