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_worker_thread;
 185 my %rsync_outfun;
 186 my %rsync;
 187 my %rsync_exec_form;
 188 my %rsync_dir;
 189 my %rsync_dir_exec_form;
 190 my %rsync_dir_err_form;
 191 my %being_deleted_thread;
 192
 193 sub rsync_preparation_form {
 194     my ($source) = @_;
 195     $speeds{$source} = "-";
 196     join ( '',
 197            "\n",
 198 ##########  Capture rsync's status messages for use by UI
 199            '$rsync_outfun{\'', $source, '\'} = sub {',
 200            '    my ($outline, $outputchannel) = @_ ; ',
 201            '    my ($speed) = $outline =~ /\d+\s+\d+%\s+(\S+)/; ',
 202            '    my ($progress_ratio) = $outline =~ /.+to-check=(\d+\/\d+)\)$/; ',
 203            '    if ($speed and $outputchannel eq \'out\') {',
 204            '        $speeds{\'', $source, '\'} = $speed;',
 205            '    } else {',
 206            '        $speeds{\'', $source, '\'} = "-";',
 207            '    };',
 208            '    if ($progress_ratio and $outputchannel eq \'out\') {',
 209            '        $progress_ratios{\'', $source, '\'} = $progress_ratio;',
 210            '    } ;',
 211            '};',
 212            "\n",
 213 ##########  Run rsync: main worker
 214            '$rsync{\'', $source, '\'} = File::Rsync->new; ',
 215 ##########  Return fodder for another eval
 216            '$rsync_exec_form{\'', $source, '\'} = sub {',
 217            '    my ($complete_destination) = @_;',
 218            '    \'$rsync{\\\'', $source, '\\\'}->exec(',
 219            '        {',
 220            '            src => \\\'', $source_roots{$source}, '/\\\', ',
 221            '            dest => \\\'\' . $complete_destination . \'/\\\', ',
 222            '            outfun => $rsync_outfun{\\\'', $source, '\\\'}, ',
 223            '            progress => 1, debug => 0, verbose => 0, ',
 224            '            filter => [\\\'merge,- ', $finished_prefix, $source, '\\\'], ',
 225            '            literal => [',
 226            '                        \\\'--recursive\\\', \\\'--times\\\', ',
 227            '                        \\\'--partial-dir=', $rsync_partial_dir_name, '\\\', ',
 228            '                        \\\'--timeout=', $rsync_timeout, '\\\', ',
 229            '                        \\\'--prune-empty-dirs\\\', ',
 230            '                        \\\'--log-file-format=%i %b %l %M %n\\\', ',
 231                             join (', ', map { '\\\'--compare-dest=' .  $_ . '/'
 232                                                   . $path_in_destination . '/'
 233                                                   . $source_dirs_in_destination{$source} . '/\\\'' }
 234                                   ( @destination_roots )),
 235            '                      , \\\'--log-file=', $rsync_log_prefix, $source, '\\\'] ',
 236            '        }',
 237            '    );\' ',
 238            '};',
 239            "\n",
 240 ##########  Run rsync: get directory from source
 241            '$rsync_dir{\'', $source, '\'} = File::Rsync->new; ',
 242 ##########  Return fodder for another eval: dir
 243            '$rsync_dir_exec_form{\'', $source, '\'} = sub {',
 244            '    \'$rsync_dir{\\\'', $source, '\\\'}->list(',
 245            '        {',
 246            '            src => \\\'', $source_roots{$source}, '/\\\', ',
 247            '            literal => [ \\\'--recursive\\\', ',
 248            '                         \\\'--timeout=', $rsync_timeout, '\\\'] ',
 249            '        }',
 250            '    );\' ',
 251            '};',
 252            "\n",
 253 ##########  Return fodder for another eval: error code from last rsync call
 254            '$rsync_dir_err_form{\'', $source, '\'} = sub {',
 255            '    \'$rsync_dir{\\\'', $source, '\\\'}->err();\' ',
 256            '}',
 257            "\n"
 258         )};
 259
 260 sub act_on_keypress {
 261     my ($pressed_key) = @_;
 262     if ($pressed_key eq 267) { qx($key_f3_action) }
 263     elsif ($pressed_key eq 270) { qx($key_f6_action); }
 264 }
 265
 266 # Run rsync for one $source, try all destinations:
 267 sub rsync_someplace {
 268     my ($source, @destinations) = @_;
 269     my $success;
 270
 271     my $rsync_log_name = $rsync_log_prefix . $source;
 272     my $finished_name = $finished_prefix . $source;
 273     foreach (@destinations) {
 274         $destination_source_is_writing_to{$source} = $_;
 275         my $common_destination = $_ . '/' . $path_in_destination;
 276         my $complete_destination = $common_destination . '/'
 277             . $source_dirs_in_destination{$source};
 278         qx(mkdir -p $common_destination);
 279         if ($?) { die "Fatal: $common_destination is not writable."}
 280         if (eval ($rsync_exec_form{$source} ($complete_destination))) {
 281             debug_print "EVAL RSYNC_EXEC_FORM (successful) $source, $complete_destination: $@ \n";
 282             $success = 1;
 283             last; # unnecessary reruns would put empty dirs into otherwise unused destinations
 284         } else {
 285             debug_print "EVAL RSYNC_EXEC_FORM (failed) $source, $complete_destination: $@ \n";
 286             $success = 0;
 287         }
 288     }
 289     $success;
 290 }
 291
 292 my $display_thread;
 293
 294 $SIG{TERM} = sub {
 295     $display_thread->kill('TERM')->join;
 296     die "Caught signal $_[0]";
 297 };
 298
 299
 300 # Preparations done; sleeves up!
 301
 302 # Make sure we have dirs to put our logs in:
 303 map {
 304     my ($filename, $directory) = fileparse $_;
 305     qx(mkdir -p $directory);
 306 } ( $rsync_log_prefix, $finished_prefix );
 307
 308 # Find usable destinations:
 309 my @raw_mount_points = grep (s/\S+ on (.*) type .*/$1/, qx/mount/);
 310 chomp @raw_mount_points;
 311 @destination_roots = intersection @raw_mount_points, @usable_mount_points;
 312 debug_print "DESTINATION_ROOTS:\n";
 313 debug_print @destination_roots;
 314
 315 # Clean up destinations:
 316 map {
 317     my $p_i_d = $_ . '/' . $path_in_destination;
 318     my $p_i_d_backed_up =  $_ . '/' . $path_in_destination_backed_up;
 319     my $p_i_d_being_deleted =  $_ . '/' . $path_in_destination_being_deleted;
 320     if (-d $p_i_d_backed_up and -d $p_i_d_being_deleted) {
 321         warn "[" . $$ . "] Both $p_i_d_backed_up and $ p_i_d_being_deleted exist. This does not normally happen. I'm deleting $p_i_d_being_deleted. Be patient.\n";
 322         qx(rm -rf $p_i_d_being_deleted);
 323     }
 324     qx(mv -f $p_i_d_backed_up $p_i_d_being_deleted 2> /dev/null);
 325     $being_deleted_thread{$_} = async { qx(rm -rf $p_i_d_being_deleted); };
 326 } @destination_roots;
 327
 328 if (scalar @destination_roots) {
 329 # Set up and start things per source_root:
 330     map {
 331         # rotate for crude load balancing:
 332         push (@destination_roots, shift (@destination_roots));
 333         $progress_ratios{$_} = "?"; # Initialize for UI
 334         $rsync_worker_thread{$_} = async {
 335             while (1) {
 336                 my $rsync_log_name = $rsync_log_prefix . $_;
 337                 my $finished_name = $finished_prefix . $_;
 338                 debug_print 'rsync_preparation_form:' .
 339                     rsync_preparation_form ($_). "\n";
 340                 eval rsync_preparation_form $_;
 341                 debug_print "EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
 342                 debug_print 'rsync_dir_exec_form $_:'.
 343                     $rsync_dir_exec_form{$_} () . "\n";
 344                 my @rsync_ls = eval $rsync_dir_exec_form{$_}();
 345                 eval $rsync_dir_err_form{$_}();
 346                 $reachable{$_} = eval $rsync_dir_err_form{$_}() ? 0 : 1;
 347                 debug_print "REACHABLE: $reachable{$_}\n";
 348                 if ($reachable{$_}) {
 349                     my %old_finished = safe_read $finished_name;
 350                     if (-f $rsync_log_name) {
 351                         my @rsync_log = read_list $rsync_log_name;
 352                         foreach (@rsync_log) {
 353                             my ($file_length, $modification_time, $filename) =
 354                                 /[\d\/\s:\[\]]+ [>c\.][fd]\S{9} \d+ (\d+) ([\d\/:-]+) (.*)$/;
 355                             if ($filename) {
 356                                 $old_finished{$filename . "\n"} =
 357                                     "### " . $modification_time . " " .
 358                                     $file_length . "\n";
 359                             }
 360                         }
 361                         safe_write $finished_name, sort_hash %old_finished;
 362                         unlink $rsync_log_name unless $debug;
 363                     }
 364                     my %finished = ();
 365                     # Delete from %old_finished what has to be re-rsynced.
 366                     foreach (@rsync_ls) {
 367                         my ($ls_size, $ls_modification_date,
 368                             $ls_modification_time, $ls_filename) =
 369                                 /[drwx-]+\s+(\d+) ([\d\/]+) ([\d:]+) (.*)/;
 370                         if ($ls_filename &&
 371                             exists $old_finished{$ls_filename . "\n"}) {
 372                             my ($finished_modification_date, $finished_size) =
 373                                 $old_finished{$ls_filename . "\n"} =~
 374                                 /### (\S+) (\d+)$/;
 375                             if ( ($finished_size eq $ls_size)
 376                                  && (normalize_date
 377                                      ($finished_modification_date)
 378                                      eq normalize_date
 379                                      ($ls_modification_date,
 380                                       $ls_modification_time)) )
 381                             {
 382                                 $finished{$ls_filename . "\n"} =
 383                                     $old_finished{$ls_filename . "\n"};
 384                             }
 385                         }
 386                     }
 387                     safe_write $finished_name, %finished;
 388                     if (rsync_someplace $_, @destination_roots) {
 389                         $progress_ratios{$_} = '0'; # Clean staleness for UI
 390                     }
 391                     sleep $coffee_break;
 392                 }
 393             }
 394         }
 395     } keys %source_roots;
 396 }
 397
 398 # Provide some reassuring user information:
 399 my $destinations_monitor_thread = async {
 400     while () {
 401         map {
 402             my $destination_root = $_;
 403             my $destination_usage = 0;
 404             map {
 405                 my $source_root = $_;
 406                 my $complete_destination = $destination_root . '/'
 407                     . $path_in_destination . '/'
 408                     . $source_dirs_in_destination{$source_root};
 409                 my @dir = qx(ls -A $complete_destination/ 2> /dev/null);
 410                 $destination_usage = 1 if scalar @dir; # 0 = no new data
 411             } keys %source_roots;
 412             $destination_usages{$destination_root} = $destination_usage;
 413             my @destination_usage_ratio =
 414                 grep s/\S+\s+\S+\s+\S+\s+\S+\s+(\d*)%\s+\S+/$1/, qx(df -P $_);
 415             chomp @destination_usage_ratio;
 416             ($destination_usage_ratios{$_}) = @destination_usage_ratio;
 417         } @destination_roots;
 418         sleep $coffee_break;
 419     }
 420 };
 421
 422 if ($debug == 1) {
 423 # Let the workers toil.
 424     sleep;
 425 } else {
 426 # Let the workers toil; talk to the user.
 427
 428     $display_thread = async {
 429         $SIG{TERM} = sub {
 430             endwin(); # Leave a usable terminal.
 431             threads->exit()
 432         };
 433
 434         my $redraw_window_count = 0;
 435         initscr();
 436         cbreak();
 437         noecho();
 438         curs_set(0);
 439         my $window_left = newwin(LINES() -8, 29, 0, 0);
 440         my $window_right = newwin(LINES() - 8, 50, 0, 29);
 441         my $window_center = newwin(5, 79, LINES() - 8, 0);
 442         my $window_bottom = newwin(3, 79, LINES() - 3, 0);
 443         $window_bottom->keypad(1);
 444         $window_bottom->nodelay(1);
 445         start_color;
 446         init_pair 1, COLOR_MAGENTA, COLOR_BLACK;
 447         init_pair 2, COLOR_RED, COLOR_BLACK;
 448         init_pair 3, COLOR_CYAN, COLOR_BLACK;
 449         init_pair 4, COLOR_YELLOW, COLOR_BLACK;
 450         my $MAGENTA = COLOR_PAIR(1);
 451         my $RED = COLOR_PAIR(2);
 452         my $CYAN = COLOR_PAIR(3);
 453         my $YELLOW = COLOR_PAIR(4);
 454
 455         while (1) {
 456             $window_left->attron($CYAN);
 457             $window_left->box(0, 0);
 458             $window_left->addstr(0, 6, "Data Destinations");
 459             $window_left->attroff($CYAN);
 460             my $destinations_format = "%-18s%-6s%-3s";
 461             $window_left->attron(A_BOLD);
 462             $window_left->addstr(1, 1,
 463                                  sprintf($destinations_format,
 464                                          "Removable", "Fresh", "Usg"));
 465             $window_left->addstr(2, 1,
 466                                  sprintf($destinations_format,
 467                                          "Disk", "Data?", "%"));
 468             $window_left->attroff(A_BOLD);
 469             my $destination_usage;
 470             my $line_number = 3;
 471             map {
 472                 if ($destination_usages{$_}) {
 473                     $window_left->attron($RED);
 474                     $destination_usage = "yes";
 475                 } else {
 476                     $window_left->attron($CYAN);
 477                     $destination_usage = "no";
 478                 }
 479                 $window_left->addstr($line_number, 1,
 480                                      sprintf($destinations_format,
 481                                              substr($_, -17, 17),
 482                                              substr($destination_usage, -6, 6),
 483                                              substr($destination_usage_ratios{$_} ?
 484                                                     $destination_usage_ratios{$_} :
 485                                                     "?",
 486                                                     -3, 3)));
 487                 ++ $line_number;
 488                 $window_left->attroff($RED);
 489                 $window_left->attroff($CYAN);
 490             } sort @destination_roots;
 491
 492             $window_right->attron($MAGENTA);
 493             $window_right->box(0,0);
 494             $window_right->addstr(0, 19, "Data Sources");
 495             $window_right->attroff($MAGENTA);
 496             my $sources_format = "%-15s%-11s%-9s%-13s";
 497             $window_right->attron(A_BOLD);
 498             $window_right->addstr(1, 1,
 499                                   sprintf ($sources_format,
 500                                            "Data", "", "To", "Writing"));
 501             $window_right->addstr(2, 1,
 502                                   sprintf ($sources_format,
 503                                            "Source", "Speed", "Do", "To"));
 504             $window_right->attroff(A_BOLD);
 505             $line_number = 3;
 506             $window_right->attron($MAGENTA);
 507             map {
 508                 my $source = $_;
 509                 my $current_destination = '?';
 510                 if (exists $destination_source_is_writing_to{$source}) {
 511                     $current_destination =
 512                         $destination_source_is_writing_to{$source};
 513                 }
 514                 if ($reachable{$source}) {
 515                     $window_right->addstr($line_number, 1,
 516                                           sprintf($sources_format,
 517                                                   substr($source_roots{$source},
 518                                                          0, 15),
 519                                                   substr($speeds{$source}, 0, 11),
 520                                                   substr($progress_ratios{$source},
 521                                                          -9, 9),
 522                                                   substr($current_destination,
 523                                                          -13, 13)));
 524                     ++ $line_number;
 525                 }
 526                 $window_right->addstr($line_number, 1,
 527                                       sprintf($sources_format, "", "", "", ""));
 528             } sort (keys %source_roots);
 529             $window_right->attroff($MAGENTA);
 530
 531             $line_number = 0;
 532             map {
 533                 $window_center->addstr($line_number, 2, $_);
 534                 ++ $line_number;
 535             } @monikop_banner;
 536             $window_center->move(0, 0);
 537
 538             $window_bottom->box(0,0);
 539             $window_bottom->attron(A_BOLD);
 540             $window_bottom->addstr(1, 3, "[F3]: Turn off computer.                         [F6]: Restart computer.");
 541             $window_bottom->attroff(A_BOLD);
 542
 543             $window_left->noutrefresh();
 544             $window_right->noutrefresh();
 545             $window_bottom->noutrefresh();
 546             $window_center->noutrefresh(); # Last window gets the cursor.
 547             act_on_keypress($window_bottom->getch());
 548             sleep 2;
 549             if (++ $redraw_window_count > 5) {
 550                 $redraw_window_count = 0;
 551             redrawwin();
 552             }
 553             doupdate();
 554         }
 555     endwin();
 556     };
 557 }
 558
 559 sleep;
 560
 561 # Tidy up. (Except we don't reach this.)
 562 map {
 563     $being_deleted_thread{$_}->join if $being_deleted_thread{$_};
 564 } @destination_roots;
 565
 566 map {
 567     $rsync_worker_thread{$_}->join if $rsync_worker_thread{$_};
 568 } keys %source_roots;
 569
 570 $destinations_monitor_thread->join if $destinations_monitor_thread;
 571
 572 $display_thread->join if $display_thread;
 573
 574 __END__