pokinom

   1 #! /usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use File::Rsync;
   5 use Thread 'async';
   6 use threads::shared;
   7 use Curses;
   8
   9 my @pokinom_banner = (
  10  "    _/_/_/      _/_/    _/    _/  _/_/_/  _/      _/    _/_/    _/      _/",
  11  "   _/    _/  _/    _/  _/  _/      _/    _/_/    _/  _/    _/  _/_/  _/_/ ",
  12  "  _/_/_/    _/    _/  _/_/        _/    _/  _/  _/  _/    _/  _/  _/  _/  ",
  13  " _/        _/    _/  _/  _/      _/    _/    _/_/  _/    _/  _/      _/   ",
  14  "_/          _/_/    _/    _/  _/_/_/  _/      _/    _/_/    _/      _/    ",
  15     );
  16
  17 # Debug mode:
  18 # 0 = clean UI; 1 = lots of scrolling junk; anything else = both (pipe to file)
  19 my $debug = 0;
  20
  21 # Where to read local configuration:
  22 my $pokinom_config = '~/monikop/pokinom.config';
  23 if ($ARGV[0]) {
  24     $pokinom_config = $ARGV[0]
  25 }
  26
  27 ########################################
  28 # Settings
  29 ########################################
  30 # Possible mount points. Must be unique in their tails after rightmost /.
  31 my @usable_mount_points;
  32
  33 # Directory relative to a mount point where new data resides.
  34 # Must agree with Monikop's setting.
  35 my $path_under_mount_point;
  36
  37 # Directories of this name will be deleted.
  38 # Must agree with Monikop's setting.
  39 my $path_under_mount_point_backed_up;
  40
  41 # Directory name while being deleted by monikop.
  42 # Must agree with Monikop's setting.
  43 my $path_under_mount_point_being_deleted;
  44
  45 # Data destination.
  46 my $destination;
  47
  48 # Credentials of the remote rsync server. String, or 0 if not used.
  49 my $rsync_username;
  50 my $rsync_password;
  51
  52 # Full path to rsync's raw log
  53 my $rsync_log_prefix;
  54
  55 # Full path to a file to store list of rsync's incompletely
  56 # transferred files in:
  57 my $interrupted_prefix;
  58
  59 # Shut down when finished? (default); 1 = yes; 2 = stay on.
  60 my $shut_down_when_done :shared;
  61
  62 # How to turn off
  63 my $shut_down_action;
  64
  65 # Rsync's directory (relative to destination) for partially transferred files.
  66 # Must agree with Monikop's setting.
  67 my $rsync_partial_dir_name;
  68
  69 # Local changes to the above.
  70 eval `cat $pokinom_config`;
  71
  72 # Places for running rsyncs to put their runtime info in
  73 my %speeds :shared;
  74 my %progress_ratios :shared;
  75 my %done :shared;
  76
  77 sub debug_print { if ($debug) { print @_; } };
  78
  79 # Return sorted intersection of arrays which are supposed to have unique
  80 # elements.
  81 sub intersection {
  82     my @intersection = ();
  83     my %count = ();
  84     my $element;
  85     foreach $element (@_) { $count{$element}++ }
  86     foreach $element (keys %count) {
  87         push @intersection, $element if $count{$element} > 1;
  88     }
  89     sort @intersection;
  90 }
  91
  92 # Write @content to a file with name $filename.
  93 sub write_list {
  94     my ($filename, @content) = @_;
  95     open FILE, '>', $filename
  96         or die "[" . $$ . "] open $filename failed: $!\n";
  97     print FILE @content;
  98     close FILE;
  99 }
 100
 101 my %source_roots;
 102 my %rsync_outfun;
 103 my %rsync;
 104
 105 sub rsync_preparation_form {
 106     my ($source) = @_;
 107     $speeds{$source} = "-";
 108     join ( '',
 109            "\n",
 110 ##########  Capture rsync's status messages for use by UI
 111            '$rsync_outfun{\'', $source, '\'} = sub {',
 112            '    my ($outline, $outputchannel) = @_ ; ',
 113            '    my ($speed) = $outline =~ /\d+\s+\d+%\s+(\S+)/; ',
 114            '    my ($progress_ratio) = $outline =~ /.+to-check=(\d+\/\d+)\)$/; ',
 115            '    if ($speed and $outputchannel eq \'out\') {',
 116            '        $speeds{\'', $source, '\'} = $speed;',
 117            '    } else {',
 118            '        $speeds{\'', $source, '\'} = "-";',
 119            '    };',
 120            '    if ($progress_ratio and $outputchannel eq \'out\') {',
 121            '        $progress_ratios{\'', $source, '\'} = $progress_ratio;',
 122            '    } ;',
 123            '};',
 124            "\n",
 125 ##########  Run rsync
 126            '$rsync{\'', $source, '\'} = File::Rsync->new; ',
 127 ##########  Return fodder for another eval
 128            '$rsync_exec_form{\'', $source, '\'} = sub {',
 129            '    \'$rsync{\\\'', $source, '\\\'}->exec(',
 130            '        {',
 131            '            src => \\\'', $source_roots{$source}, '/', $path_under_mount_point, '/\\\', ',
 132            '            dest => \\\'' . $destination . '/\\\', ',
 133            '            outfun => $rsync_outfun{\\\'', $source, '\\\'}, ',
 134            '            progress => 1, debug => 0, verbose => 0, ',
 135            '            filter => [\\\'merge,- ', $interrupted_prefix, $source, '\\\'], ',
 136            '            literal => [\\\'--recursive\\\', \\\'--times\\\', ',
 137            '                        \\\'--partial-dir=', $rsync_partial_dir_name, '\\\', ',
 138            '                        \\\'--update\\\', ',
 139            '                        \\\'--prune-empty-dirs\\\', ',
 140            '                        \\\'--log-file-format=%i %b %n\\\', ',
 141            '                      , \\\'--log-file=', $rsync_log_prefix, $source, '\\\'] ',
 142            '        }',
 143            '    );\' ',
 144            '};',
 145            "\n",
 146         )};
 147
 148 sub act_on_keypress {
 149     my ($pressed_key) = @_;
 150     if ($pressed_key eq 267) { qx($shut_down_action); }
 151     elsif ($pressed_key eq 273) { # F9
 152         $shut_down_when_done = $shut_down_when_done ? 0 : 1; }
 153 }
 154
 155 $ENV{USER} = $rsync_username if ($rsync_username);
 156 $ENV{RSYNC_PASSWORD} = $rsync_password if ($rsync_password);
 157
 158 sub restore_terminal_and_die {
 159     endwin(); # Leave a usable terminal.
 160     die "Signal $_[0] caught";
 161 }
 162 $SIG{TERM} = 'restore_terminal_and_die';
 163
 164 # Preparations done; sleeves up!
 165
 166 # Find usable (i.e. mounted) sources
 167 my @raw_mount_points = grep (s/\S+ on (.*) type .*/$1/, qx/mount/);
 168 chomp @raw_mount_points;
 169 my @sources = intersection @raw_mount_points, @usable_mount_points;
 170 debug_print "SOURCES:\n";
 171 debug_print @sources;
 172
 173 # Turn a path into a legal perl identifier:
 174 sub make_key_from_path {
 175     my $path = shift;
 176     ($path) =~ s/\/?(.*)\/?/$1/g;
 177     ($path) =~ s/\W/_/g;
 178     $path;
 179 }
 180
 181 map {
 182     $source_roots{make_key_from_path $_} = $_
 183 } @sources;
 184
 185 my %being_deleted_thread;
 186 # Clean up sources if necessary
 187 map {
 188     my $p_i_d = $source_roots{$_} . '/' . $path_under_mount_point;
 189     my $p_i_d_being_deleted =
 190         $source_roots{$_} . '/' . $path_under_mount_point_being_deleted;
 191     $being_deleted_thread{$_} =
 192         async { qx(rm -rf $p_i_d_being_deleted 2> /dev/null); };
 193 } keys %source_roots;
 194
 195 # This could be more sophisticated:
 196
 197 print "\nWaiting for $destination to become reachable.\n";
 198 sleep 10;
 199
 200 my %rsync_worker_thread;
 201 my %rsync_exec_form;
 202
 203 # Set up and start things per source_root, in parallel:
 204 map {
 205     $progress_ratios{$_} = "?"; # Initialize for UI
 206     $done{$_} = 0;
 207     $rsync_worker_thread{$_} = async {
 208         my $rsync_log_name = $rsync_log_prefix . $_;
 209         debug_print 'rsync_preparation_form:' . rsync_preparation_form ($_). "\n";
 210         eval rsync_preparation_form $_;
 211         debug_print "EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
 212         my $complete_source = $source_roots{$_} . '/' . $path_under_mount_point;
 213         my $complete_source_backed_up = $source_roots{$_} . '/' . $path_under_mount_point_backed_up;
 214         my @interrupted = qx((cd $complete_source 2> /dev/null && find ./ -path *$rsync_partial_dir_name/*));
 215         # Write exclusion list: don't transfer files Monikop gave up upon.
 216         grep s/\.(.*\/)$rsync_partial_dir_name\/(.*)/$1$2/, @interrupted;
 217         write_list $interrupted_prefix . $_, @interrupted;
 218         debug_print "INTERRUPTED";
 219         debug_print @interrupted;
 220         if (-d $complete_source) {
 221             if (eval ($rsync_exec_form{$_}() )) {
 222                 debug_print "EVAL RSYNC_EXEC_FORM (successful) $complete_source: $@ \n";
 223             } else {
 224                 die "EVAL RSYNC_EXEC_FORM (failed) $complete_source: $@ \n";
 225             }
 226         }
 227         $progress_ratios{$_} = "Wait";
 228         $speeds{$_} = "-";
 229     }
 230 } keys %source_roots;
 231
 232 # Repeat rsync runs, this time sequentially, in order to get the newest of a file
 233 # which may exist in multiple versions on different sources:
 234 my $rsync_worker_thread = async {
 235     map {
 236         $rsync_worker_thread{$_}->join;
 237         debug_print "JOINED $_\n";
 238     } keys %source_roots;
 239     map {
 240         $progress_ratios{$_} = "?"; # Initialize for UI
 241         $done{$_} = 0;
 242         my $rsync_log_name = $rsync_log_prefix . $_;
 243         eval rsync_preparation_form $_;
 244         debug_print "EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
 245         my $complete_source = $source_roots{$_} . '/' . $path_under_mount_point;
 246         my $complete_source_backed_up = $source_roots{$_} . '/' . $path_under_mount_point_backed_up;
 247         my @interrupted = qx((cd $complete_source 2> /dev/null && find ./ -path *$rsync_partial_dir_name/*));
 248         # Write exclusion list: don't transfer files Monikop gave up upon.
 249         grep s/\.(.*\/)$rsync_partial_dir_name\/(.*)/$1$2/, @interrupted;
 250         write_list $interrupted_prefix . $_, @interrupted;
 251         if (-d $complete_source) {
 252             if (eval ($rsync_exec_form{$_}() )) {
 253                 debug_print "EVAL RSYNC_EXEC_FORM (successful) $complete_source: $@ \n";
 254                 qx(mv $complete_source $complete_source_backed_up);
 255             } else {
 256                 die "EVAL RSYNC_EXEC_FORM (failed) $complete_source: $@ \n";
 257             }
 258         }
 259         $progress_ratios{$_} = "Done";
 260         $speeds{$_} = "-";
 261         $done{$_} = 1;
 262         unless ($debug) {
 263             unlink $rsync_log_name;
 264             unlink $interrupted_prefix . $_;
 265         }
 266     } keys %source_roots;
 267 };
 268
 269 if ($debug == 1) {
 270 # Let the workers toil.
 271     sleep;
 272 } else {
 273 # Let the workers toil and talk to the user.
 274     my $redraw_window_count = 0;
 275     initscr();
 276     cbreak();
 277     noecho();
 278     curs_set(0);
 279     my $window_top = newwin(LINES() - 8, 79, 0, 0);
 280     my $window_center = newwin(5, 79, LINES() - 8, 0);
 281     my $window_bottom = newwin(3, 79, LINES() - 3, 0);
 282     $window_bottom->keypad(1);
 283     $window_bottom->nodelay(1);
 284     start_color;
 285     init_pair 1, COLOR_MAGENTA, COLOR_BLACK;
 286     init_pair 2, COLOR_RED, COLOR_BLACK;
 287     init_pair 3, COLOR_CYAN, COLOR_BLACK;
 288     init_pair 4, COLOR_YELLOW, COLOR_BLACK;
 289     my $MAGENTA = COLOR_PAIR(1);
 290     my $RED = COLOR_PAIR(2);
 291     my $CYAN = COLOR_PAIR(3);
 292     my $YELLOW = COLOR_PAIR(4);
 293     while (1) {
 294         $window_top->attron($CYAN);
 295         $window_top->box(0,0);
 296         $window_top->addstr(0, 30, " P r o g r e s s ");
 297         $window_top->attroff($CYAN);
 298         my $sources_format = "%-25s%-18s%-8s";
 299         $window_top->attron(A_BOLD);
 300         $window_top->addstr(1, 12,
 301                             sprintf ($sources_format,
 302                                      "Source Medium", "Speed", "To Do"));
 303         $window_top->attroff(A_BOLD);
 304         my $line_number = 2;
 305         map {
 306             my $source = $_;
 307             $window_top->attron($CYAN);
 308             $window_top->attron($RED) if $done{$source};
 309             $window_top->addstr($line_number, 12,
 310                                 sprintf($sources_format,
 311                                         substr($source_roots{$source}, 0, 24),
 312                                         substr($speeds{$source}, 0, 17),
 313                                         substr($progress_ratios{$source}, -8, 8)));
 314             ++ $line_number;
 315             $window_top->addstr($line_number, 1,
 316                                 sprintf($sources_format, "", "", "", ""));
 317             $window_top->attroff($RED);
 318             $window_top->attroff($CYAN);
 319         } sort (keys %source_roots);
 320         $line_number = 0;
 321         map {
 322             $window_center->addstr($line_number, 2, $_);
 323             ++ $line_number;
 324         } @pokinom_banner;
 325         $window_center->move(0, 0);
 326
 327         $window_bottom->box(0,0);
 328         $window_bottom->attron(A_BOLD);
 329         $window_bottom->addstr(1, 3,
 330                                sprintf ("[F3]: Turn off now.%54s",
 331                                         $shut_down_when_done ? "Turning off when done.  [F9]: Stay on."
 332                                         : "Staying on.  [F9]: Turn off when done."));
 333         $window_bottom->attroff(A_BOLD);
 334
 335         $window_top->noutrefresh();
 336         $window_bottom->noutrefresh();
 337         $window_center->noutrefresh(); # Last window gets the cursor.
 338         sleep 2;
 339         if (++ $redraw_window_count > 5) {
 340             $redraw_window_count = 0;
 341             clearok(1);
 342         }
 343         doupdate();
 344         act_on_keypress($window_bottom->getch());
 345         if (! grep(/0/, values %done) && $shut_down_when_done) {
 346             qx ($shut_down_action);
 347         }
 348     }
 349     endwin();
 350 }
 351
 352 # Tidy up. (Except we don't reach this.)
 353 map {
 354     $being_deleted_thread{$_}->join if $being_deleted_thread{$_};
 355 } keys %source_roots;
 356
 357 $rsync_worker_thread->join if $rsync_worker_thread{$_};