9 use Curses
; # Debian package libcurses-perl
11 my @monikop_banner = (
12 " _/ _/ _/_/ _/ _/ _/_/_/ _/ _/ _/_/ _/_/_/ ",
13 " _/_/ _/_/ _/ _/ _/_/ _/ _/ _/ _/ _/ _/ _/ _/",
14 " _/ _/ _/ _/ _/ _/ _/ _/ _/ _/_/ _/ _/ _/_/_/ ",
15 " _/ _/ _/ _/ _/ _/_/ _/ _/ _/ _/ _/ _/ ",
16 "_/ _/ _/_/ _/ _/ _/_/_/ _/ _/ _/_/ _/ ",
20 # 0 = clean UI; 1 = lots of scrolling junk; anything else = both (pipe to file)
22 $debug = $ARGV[1] if $ARGV[1];
24 # Where to read local configuration:
25 my $monikop_config = '~/monikop/monikop.config';
26 $monikop_config = $ARGV[0] if $ARGV[0];
28 ########################################
30 ########################################
31 # Possible data sources, and by what directory name to represent them in
33 # When the latter is not unique, care must be taken that all pathnames in the
34 # respective sources are unique.
37 # Possible mount points of data destinations. Must be unique.
38 my @usable_mount_points;
40 # Common directory (under a mount point) to put new data in.
41 # Must agree with Pokinom's setting.
42 my $path_in_destination;
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;
48 # Directory name (under a mount point) while being deleted.
49 # Must agree with Pokinom's setting.
50 my $path_in_destination_being_deleted;
52 # Path and file name prefix of rsync's raw logs:
55 # Path and file name prefix of the list of successfully rsynced files:
58 # How to suffix the name of the duplicate of a safe file:
59 my $safe_file_backup_suffix;
61 # How to suffix the name of an unfinished safe file:
62 my $safe_file_unfinished_suffix;
64 # What to do (shutdown) when F3 has been pressed:
67 # What to do (reboot) when F6 has been pressed:
70 # Rsyncs time (in seconds) to wait for a response:
73 # Rsyncs directory (relative to destination) for partially transferred files.
74 # Must agree with Pokinom's setting.
75 my $rsync_partial_dir_name;
77 # Put actual values into the above.
78 eval `cat $monikop_config`;
80 # Time in seconds before rsync is restarted and user information is
82 my $coffee_break = 10;
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
;
92 sub debug_print
{ if ($debug) { print @_; } };
94 # Return the hash referenced by argument, which is sorted if accessed as an
99 foreach my $key (sort keys %hash_table) {
100 push @sorted_hash, $key, $hash_table{$key};
105 # Turn a path into a legal perl identifier:
106 sub make_key_from_path
{
108 ($path) =~ s/\/?(.*)\/?
/$1/g;
115 $source_roots{make_key_from_path
$_} = $_
118 my %source_dirs_in_destination;
120 $source_dirs_in_destination{make_key_from_path
$_} = $sources{$_}
123 # Crudely turn date string(s) into a number. Chronological order is preserved.
125 my $date = join '', @_;
126 $date =~ tr/ \/:-//d
;
130 # Return sorted intersection of arrays which are supposed to have unique
133 my @intersection = ();
136 foreach $element (@_) { $count{$element}++ }
137 foreach $element (keys %count) {
138 push @intersection, $element if $count{$element} > 1;
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.
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);
160 # Put contents of $filename into an array:
164 open FILE
, '<', $filename
165 or warn "[" . $$ . "] open $filename failed: $!\n";
171 # Read a file written by safe_write
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 }
179 debug_print
"SAFE_READ: $filename";
183 my @destination_roots;
184 my %rsync_worker_thread;
189 my %rsync_dir_exec_form;
190 my %rsync_dir_err_form;
191 my %being_deleted_thread;
193 sub rsync_preparation_form
{
195 $speeds{$source} = "-";
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;',
206 ' $speeds{\'', $source, '\'} = "-";',
208 ' if ($progress_ratio and $outputchannel eq \'out\') {',
209 ' $progress_ratios{\'', $source, '\'} = $progress_ratio;',
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(',
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, '\\\'], ',
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, '\\\'] ',
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(',
246 ' src => \\\'', $source_roots{$source}, '/\\\', ',
247 ' literal => [ \\\'--recursive\\\', ',
248 ' \\\'--timeout=', $rsync_timeout, '\\\'] ',
253 ########## Return fodder for another eval: error code from last rsync call
254 '$rsync_dir_err_form{\'', $source, '\'} = sub {',
255 ' \'$rsync_dir{\\\'', $source, '\\\'}->err();\' ',
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); }
266 # Run rsync for one $source, try all destinations:
267 sub rsync_someplace
{
268 my ($source, @destinations) = @_;
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";
283 last; # unnecessary reruns would put empty dirs into otherwise unused destinations
285 debug_print
"EVAL RSYNC_EXEC_FORM (failed) $source, $complete_destination: $@ \n";
292 sub restore_terminal_and_die
{
293 endwin
(); # Leave a usable terminal.
294 die "Signal $_[0] caught";
296 $SIG{TERM
} = 'restore_terminal_and_die';
298 # Preparations done; sleeves up!
300 # Make sure we have dirs to put our logs in:
302 my ($filename, $directory) = fileparse
$_;
303 qx(mkdir -p
$directory);
304 } ( $rsync_log_prefix, $finished_prefix );
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;
313 # Clean up destinations:
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);
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;
326 if (scalar @destination_roots) {
327 # Set up and start things per source_root:
329 # rotate for crude load balancing:
330 push (@destination_roots, shift (@destination_roots));
331 $progress_ratios{$_} = "?"; # Initialize for UI
332 $rsync_worker_thread{$_} = async
{
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\
/:-]+) (.*)$/;
354 $old_finished{$filename . "\n"} =
355 "### " . $modification_time . " " .
359 safe_write
$finished_name, sort_hash
%old_finished;
360 unlink $rsync_log_name unless $debug;
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
:]+) (.*)/;
369 exists $old_finished{$ls_filename . "\n"}) {
370 my ($finished_modification_date, $finished_size) =
371 $old_finished{$ls_filename . "\n"} =~
373 if ( ($finished_size eq $ls_size)
375 ($finished_modification_date)
377 ($ls_modification_date,
378 $ls_modification_time)) )
380 $finished{$ls_filename . "\n"} =
381 $old_finished{$ls_filename . "\n"};
385 safe_write
$finished_name, %finished;
386 if (rsync_someplace
$_, @destination_roots) {
387 $progress_ratios{$_} = '0'; # Clean staleness for UI
393 } keys %source_roots;
396 # Provide some reassuring user information:
397 my $destinations_monitor_thread = async
{
400 my $destination_root = $_;
401 my $destination_usage = 0;
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;
421 # Let the workers toil.
424 # Let the workers toil; talk to the user.
425 my $redraw_window_count = 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);
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);
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;
463 if ($destination_usages{$_}) {
464 $window_left->attron($RED);
465 $destination_usage = "yes";
467 $window_left->attron($CYAN);
468 $destination_usage = "no";
470 $window_left->addstr($line_number, 1,
471 sprintf($destinations_format,
473 substr($destination_usage, -6, 6),
474 substr($destination_usage_ratios{$_} ?
475 $destination_usage_ratios{$_} :
479 $window_left->attroff($RED);
480 $window_left->attroff($CYAN);
481 } sort @destination_roots;
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
);
497 $window_right->attron($MAGENTA);
500 my $current_destination = '?';
501 if (exists $destination_source_is_writing_to{$source}) {
502 $current_destination =
503 $destination_source_is_writing_to{$source};
505 if ($reachable{$source}) {
506 $window_right->addstr($line_number, 1,
507 sprintf($sources_format,
508 substr($source_roots{$source},
510 substr($speeds{$source}, 0, 11),
511 substr($progress_ratios{$source},
513 substr($current_destination,
517 $window_right->addstr($line_number, 1,
518 sprintf($sources_format, "", "", "", ""));
519 } sort (keys %source_roots);
520 $window_right->attroff($MAGENTA);
524 $window_center->addstr($line_number, 2, $_);
527 $window_center->move(0, 0);
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
);
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());
540 if (++ $redraw_window_count > 5) {
541 $redraw_window_count = 0;
549 # Tidy up. (Except we don't reach this.)
551 $being_deleted_thread{$_}->join if $being_deleted_thread{$_};
552 } @destination_roots;
555 $rsync_worker_thread{$_}->join if $rsync_worker_thread{$_};
556 } keys %source_roots;
558 $destinations_monitor_thread->join if $destinations_monitor_thread;