monikop

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