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; # Debian package libcurses-perl
  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 sub restore_terminal_and_die {
 293     endwin(); # Leave a usable terminal.
 294     die "Signal $_[0] caught";
 295 }
 296 $SIG{TERM} = 'restore_terminal_and_die';
 297
 298 # Preparations done; sleeves up!
 299
 300 # Make sure we have dirs to put our logs in:
 301 map {
 302     my ($filename, $directory) = fileparse $_;
 303     qx(mkdir -p $directory);
 304 } ( $rsync_log_prefix, $finished_prefix );
 305
 306 # Find usable destinations:
 307 my @raw_mount_points = grep (s/\S+ on (.*) type .*/$1/, qx/mount/);
 308 chomp @raw_mount_points;
 309 @destination_roots = intersection @raw_mount_points, @usable_mount_points;
 310 debug_print "DESTINATION_ROOTS:\n";
 311 debug_print @destination_roots;
 312
 313 # Clean up destinations:
 314 map {
 315     my $p_i_d = $_ . '/' . $path_in_destination;
 316     my $p_i_d_backed_up =  $_ . '/' . $path_in_destination_backed_up;
 317     my $p_i_d_being_deleted =  $_ . '/' . $path_in_destination_being_deleted;
 318     if (-d $p_i_d_backed_up and -d $p_i_d_being_deleted) {
 319         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";
 320         qx(rm -rf $p_i_d_being_deleted);
 321     }
 322     qx(mv -f $p_i_d_backed_up $p_i_d_being_deleted 2> /dev/null);
 323     $being_deleted_thread{$_} = async { qx(rm -rf $p_i_d_being_deleted); };
 324 } @destination_roots;
 325
 326 if (scalar @destination_roots) {
 327 # Set up and start things per source_root:
 328     map {
 329         # rotate for crude load balancing:
 330         push (@destination_roots, shift (@destination_roots));
 331         $progress_ratios{$_} = "?"; # Initialize for UI
 332         $rsync_worker_thread{$_} = async {
 333             while (1) {
 334                 my $rsync_log_name = $rsync_log_prefix . $_;
 335                 my $finished_name = $finished_prefix . $_;
 336                 debug_print 'rsync_preparation_form:' .
 337                     rsync_preparation_form ($_). "\n";
 338                 eval rsync_preparation_form $_;
 339                 debug_print "EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
 340                 debug_print 'rsync_dir_exec_form $_:'.
 341                     $rsync_dir_exec_form{$_} () . "\n";
 342                 my @rsync_ls = eval $rsync_dir_exec_form{$_}();
 343                 eval $rsync_dir_err_form{$_}();
 344                 $reachable{$_} = eval $rsync_dir_err_form{$_}() ? 0 : 1;
 345                 debug_print "REACHABLE: $reachable{$_}\n";
 346                 if ($reachable{$_}) {
 347                     my %old_finished = safe_read $finished_name;
 348                     if (-f $rsync_log_name) {
 349                         my @rsync_log = read_list $rsync_log_name;
 350                         foreach (@rsync_log) {
 351                             my ($file_length, $modification_time, $filename) =
 352                                 /[\d\/\s:\[\]]+ [>c\.][fd]\S{9} \d+ (\d+) ([\d\/:-]+) (.*)$/;
 353                             if ($filename) {
 354                                 $old_finished{$filename . "\n"} =
 355                                     "### " . $modification_time . " " .
 356                                     $file_length . "\n";
 357                             }
 358                         }
 359                         safe_write $finished_name, sort_hash %old_finished;
 360                         unlink $rsync_log_name unless $debug;
 361                     }
 362                     my %finished = ();
 363                     # Delete from %old_finished what has to be re-rsynced.
 364                     foreach (@rsync_ls) {
 365                         my ($ls_size, $ls_modification_date,
 366                             $ls_modification_time, $ls_filename) =
 367                                 /[drwx-]+\s+(\d+) ([\d\/]+) ([\d:]+) (.*)/;
 368                         if ($ls_filename &&
 369                             exists $old_finished{$ls_filename . "\n"}) {
 370                             my ($finished_modification_date, $finished_size) =
 371                                 $old_finished{$ls_filename . "\n"} =~
 372                                 /### (\S+) (\d+)$/;
 373                             if ( ($finished_size eq $ls_size)
 374                                  && (normalize_date
 375                                      ($finished_modification_date)
 376                                      eq normalize_date
 377                                      ($ls_modification_date,
 378                                       $ls_modification_time)) )
 379                             {
 380                                 $finished{$ls_filename . "\n"} =
 381                                     $old_finished{$ls_filename . "\n"};
 382                             }
 383                         }
 384                     }
 385                     safe_write $finished_name, %finished;
 386                     if (rsync_someplace $_, @destination_roots) {
 387                         $progress_ratios{$_} = '0'; # Clean staleness for UI
 388                     }
 389                     sleep $coffee_break;
 390                 }
 391             }
 392         }
 393     } keys %source_roots;
 394 }
 395
 396 # Provide some reassuring user information:
 397 my $destinations_monitor_thread = async {
 398     while () {
 399         map {
 400             my $destination_root = $_;
 401             my $destination_usage = 0;
 402             map {
 403                 my $source_root = $_;
 404                 my $complete_destination = $destination_root . '/'
 405                     . $path_in_destination . '/'
 406                     . $source_dirs_in_destination{$source_root};
 407                 my @dir = qx(ls -A $complete_destination/ 2> /dev/null);
 408                 $destination_usage = 1 if scalar @dir; # 0 = no new data
 409             } keys %source_roots;
 410             $destination_usages{$destination_root} = $destination_usage;
 411             my @destination_usage_ratio =
 412                 grep s/\S+\s+\S+\s+\S+\s+\S+\s+(\d*)%\s+\S+/$1/, qx(df -P $_);
 413             chomp @destination_usage_ratio;
 414             ($destination_usage_ratios{$_}) = @destination_usage_ratio;
 415         } @destination_roots;
 416         sleep $coffee_break;
 417     }
 418 };
 419
 420 if ($debug == 1) {
 421 # Let the workers toil.
 422     sleep;
 423 } else {
 424 # Let the workers toil; talk to the user.
 425     my $redraw_window_count = 0;
 426     initscr();
 427     cbreak();
 428     noecho();
 429     curs_set(0);
 430     my $window_left = newwin(LINES() -8, 29, 0, 0);
 431     my $window_right = newwin(LINES() - 8, 50, 0, 29);
 432     my $window_center = newwin(5, 79, LINES() - 8, 0);
 433     my $window_bottom = newwin(3, 79, LINES() - 3, 0);
 434     $window_bottom->keypad(1);
 435     $window_bottom->nodelay(1);
 436     start_color;
 437     init_pair 1, COLOR_MAGENTA, COLOR_BLACK;
 438     init_pair 2, COLOR_RED, COLOR_BLACK;
 439     init_pair 3, COLOR_CYAN, COLOR_BLACK;
 440     init_pair 4, COLOR_YELLOW, COLOR_BLACK;
 441     my $MAGENTA = COLOR_PAIR(1);
 442     my $RED = COLOR_PAIR(2);
 443     my $CYAN = COLOR_PAIR(3);
 444     my $YELLOW = COLOR_PAIR(4);
 445
 446     while (1) {
 447         $window_left->attron($CYAN);
 448         $window_left->box(0, 0);
 449         $window_left->addstr(0, 6, "Data Destinations");
 450         $window_left->attroff($CYAN);
 451         my $destinations_format = "%-18s%-6s%-3s";
 452         $window_left->attron(A_BOLD);
 453         $window_left->addstr(1, 1,
 454                              sprintf($destinations_format,
 455                                      "Removable", "Fresh", "Usg"));
 456         $window_left->addstr(2, 1,
 457                              sprintf($destinations_format,
 458                                      "Disk", "Data?", "%"));
 459         $window_left->attroff(A_BOLD);
 460         my $destination_usage;
 461         my $line_number = 3;
 462         map {
 463             if ($destination_usages{$_}) {
 464                 $window_left->attron($RED);
 465                 $destination_usage = "yes";
 466             } else {
 467                 $window_left->attron($CYAN);
 468                 $destination_usage = "no";
 469             }
 470             $window_left->addstr($line_number, 1,
 471                                  sprintf($destinations_format,
 472                                          substr($_, -17, 17),
 473                                          substr($destination_usage, -6, 6),
 474                                          substr($destination_usage_ratios{$_} ?
 475                                                 $destination_usage_ratios{$_} :
 476                                                 "?",
 477                                                 -3, 3)));
 478             ++ $line_number;
 479             $window_left->attroff($RED);
 480             $window_left->attroff($CYAN);
 481         } sort @destination_roots;
 482
 483         $window_right->attron($MAGENTA);
 484         $window_right->box(0,0);
 485         $window_right->addstr(0, 19, "Data Sources");
 486         $window_right->attroff($MAGENTA);
 487         my $sources_format = "%-15s%-11s%-9s%-13s";
 488         $window_right->attron(A_BOLD);
 489         $window_right->addstr(1, 1,
 490                               sprintf ($sources_format,
 491                                        "Data", "", "To", "Writing"));
 492         $window_right->addstr(2, 1,
 493                               sprintf ($sources_format,
 494                                        "Source", "Speed", "Do", "To"));
 495         $window_right->attroff(A_BOLD);
 496         $line_number = 3;
 497         $window_right->attron($MAGENTA);
 498         map {
 499             my $source = $_;
 500             my $current_destination = '?';
 501             if (exists $destination_source_is_writing_to{$source}) {
 502                 $current_destination =
 503                     $destination_source_is_writing_to{$source};
 504             }
 505             if ($reachable{$source}) {
 506                 $window_right->addstr($line_number, 1,
 507                                       sprintf($sources_format,
 508                                               substr($source_roots{$source},
 509                                                      0, 15),
 510                                               substr($speeds{$source}, 0, 11),
 511                                               substr($progress_ratios{$source},
 512                                                      -9, 9),
 513                                               substr($current_destination,
 514                                                      -13, 13)));
 515                 ++ $line_number;
 516             }
 517             $window_right->addstr($line_number, 1,
 518                                   sprintf($sources_format, "", "", "", ""));
 519         } sort (keys %source_roots);
 520         $window_right->attroff($MAGENTA);
 521
 522         $line_number = 0;
 523         map {
 524             $window_center->addstr($line_number, 2, $_);
 525             ++ $line_number;
 526         } @monikop_banner;
 527         $window_center->move(0, 0);
 528
 529         $window_bottom->box(0,0);
 530         $window_bottom->attron(A_BOLD);
 531         $window_bottom->addstr(1, 3, "[F3]: Turn off computer.                         [F6]: Restart computer.");
 532         $window_bottom->attroff(A_BOLD);
 533
 534         $window_left->noutrefresh();
 535         $window_right->noutrefresh();
 536         $window_bottom->noutrefresh();
 537         $window_center->noutrefresh(); # Last window gets the cursor.
 538         act_on_keypress($window_bottom->getch());
 539         sleep 2;
 540         if (++ $redraw_window_count > 5) {
 541             $redraw_window_count = 0;
 542             clearok(1);
 543         }
 544         doupdate();
 545     }
 546     endwin();
 547 }
 548
 549 # Tidy up. (Except we don't reach this.)
 550 map {
 551     $being_deleted_thread{$_}->join if $being_deleted_thread{$_};
 552 } @destination_roots;
 553
 554 map {
 555     $rsync_worker_thread{$_}->join if $rsync_worker_thread{$_};
 556 } keys %source_roots;
 557
 558 $destinations_monitor_thread->join if $destinations_monitor_thread;
 559
 560 __END__