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