pokinom

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