pokinom

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