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_under_mount_point;
44 # Directories (under any mount point) of this name will be deleted
45 # Must agree with Pokinom's setting.
46 my $path_under_mount_point_backed_up;
48 # Directory name (under a mount point) while being deleted.
49 # Must agree with Pokinom's setting.
50 my $path_under_mount_point_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;
188 my %rsync_dir_exec_form;
189 my %rsync_dir_err_form;
190 my %rsync_worker_thread;
191 my %being_deleted_thread;
192 my $destinations_monitor_thread;
195 sub rsync_preparation_form
{
197 $speeds{$source} = "-";
200 ########## Capture rsync's status messages for use by UI
201 '$rsync_outfun{\'', $source, '\'} = sub {',
202 ' my ($outline, $outputchannel) = @_ ; ',
203 ' my ($speed) = $outline =~ /\d+\s+\d+%\s+(\S+)/; ',
204 ' my ($progress_ratio) = ',
205 ' $outline =~ /.+to-check=(\d+\/\d+)\)$/; ',
206 ' if ($speed and $outputchannel eq \'out\') {',
207 ' $speeds{\'', $source, '\'} = $speed;',
209 ' $speeds{\'', $source, '\'} = "-";',
211 ' if ($progress_ratio and $outputchannel eq \'out\') {',
212 ' $progress_ratios{\'', $source, '\'} = $progress_ratio;',
216 ########## Run rsync: main worker
217 '$rsync{\'', $source, '\'} = File::Rsync->new; ',
218 ########## Return fodder for another eval
219 '$rsync_exec_form{\'', $source, '\'} = sub {',
220 ' my ($complete_destination) = @_;',
221 ' \'$rsync{\\\'', $source, '\\\'}->exec(',
223 ' src => \\\'', $source_roots{$source}, '/\\\', ',
224 ' dest => \\\'\' . $complete_destination . \'/\\\', ',
225 ' outfun => $rsync_outfun{\\\'', $source, '\\\'}, ',
226 ' progress => 1, debug => 0, verbose => 0, ',
227 ' filter => [\\\'merge,- ', $finished_prefix, $source,
230 ' \\\'--recursive\\\', \\\'--times\\\', ',
231 ' \\\'--partial-dir=',
232 $rsync_partial_dir_name, '\\\', ',
233 ' \\\'--timeout=', $rsync_timeout, '\\\', ',
234 ' \\\'--prune-empty-dirs\\\', ',
235 ' \\\'--log-file-format=%i %b %l %M %n\\\', ',
238 '\\\'--compare-dest=' . $_ . '/'
239 . $path_under_mount_point . '/'.
240 $source_dirs_in_destination{$source}
243 ( @destination_roots )),
244 ' , \\\'--log-file=', $rsync_log_prefix, $source, '\\\'] ',
249 ########## Run rsync: get directory from source
250 '$rsync_dir{\'', $source, '\'} = File::Rsync->new; ',
251 ########## Return fodder for another eval: dir
252 '$rsync_dir_exec_form{\'', $source, '\'} = sub {',
253 ' \'$rsync_dir{\\\'', $source, '\\\'}->list(',
255 ' src => \\\'', $source_roots{$source}, '/\\\', ',
256 ' literal => [ \\\'--recursive\\\', ',
257 ' \\\'--timeout=', $rsync_timeout, '\\\'] ',
262 ########## Return fodder for another eval: error code from last rsync call
263 '$rsync_dir_err_form{\'', $source, '\'} = sub {',
264 ' \'$rsync_dir{\\\'', $source, '\\\'}->err();\' ',
269 sub act_on_keypress
{
270 my ($pressed_key) = @_;
271 if ($pressed_key eq 267) { qx($key_f3_action) }
272 elsif ($pressed_key eq 270) { qx($key_f6_action); }
275 # Run rsync for one $source, try all destinations:
276 sub rsync_someplace
{
277 my ($source, @destinations) = @_;
280 my $rsync_log_name = $rsync_log_prefix . $source;
281 my $finished_name = $finished_prefix . $source;
282 foreach (@destinations) {
283 $destination_source_is_writing_to{$source} = $_;
284 my $common_destination = $_ . '/' . $path_under_mount_point;
285 my $complete_destination = $common_destination . '/'
286 . $source_dirs_in_destination{$source};
287 qx(mkdir -p
$common_destination);
288 if ($?
) { die "Fatal: $common_destination is not writable."}
289 if (eval ($rsync_exec_form{$source} ($complete_destination))) {
290 debug_print
"EVAL RSYNC_EXEC_FORM (successful) $source,\ $complete_destination: $@ \n";
292 last; # unnecessary reruns would put empty
293 # dirs into otherwise unused destinations
295 debug_print
"EVAL RSYNC_EXEC_FORM (failed) $source, $complete_destination: $@ \n";
303 $display_thread->kill('TERM')->join;
304 die "Caught signal $_[0]";
308 # Preparations done; sleeves up!
310 # Make sure we have dirs to put our logs in:
312 my ($filename, $directory) = fileparse
$_;
313 qx(mkdir -p
$directory);
314 } ( $rsync_log_prefix, $finished_prefix );
316 # Find usable destinations:
317 my @raw_mount_points = grep (s/\S+ on (.*) type .*/$1/, qx/mount/);
318 chomp @raw_mount_points;
319 @destination_roots = intersection
@raw_mount_points, @usable_mount_points;
320 debug_print
"DESTINATION_ROOTS:\n";
321 debug_print
@destination_roots;
323 # Clean up destinations:
325 my $p_i_d = $_ . '/' . $path_under_mount_point;
326 my $p_i_d_backed_up = $_ . '/' . $path_under_mount_point_backed_up;
327 my $p_i_d_being_deleted = $_ . '/' . $path_under_mount_point_being_deleted;
328 if (-d
$p_i_d_backed_up and -d
$p_i_d_being_deleted) {
329 warn "[" . $$ . "] " .
330 "Both $p_i_d_backed_up and $ p_i_d_being_deleted exist.\n" .
331 "This does not normally happen.\n" .
332 "I'm deleting $p_i_d_being_deleted. Be patient.\n";
333 qx(rm
-rf
$p_i_d_being_deleted);
335 qx(mv
-f
$p_i_d_backed_up $p_i_d_being_deleted 2> /dev/null
);
336 $being_deleted_thread{$_} = async
{
337 $SIG{TERM
} = sub { threads
->exit() };
338 qx(rm
-rf
$p_i_d_being_deleted); };
339 } @destination_roots;
341 if (scalar @destination_roots) {
342 # Set up and start things per source_root:
344 # rotate for crude load balancing:
345 push (@destination_roots, shift (@destination_roots));
346 $progress_ratios{$_} = "?"; # Initialize for UI
347 $rsync_worker_thread{$_} = async
{
348 $SIG{TERM
} = sub { threads
->exit() };
350 my $rsync_log_name = $rsync_log_prefix . $_;
351 my $finished_name = $finished_prefix . $_;
352 debug_print
'rsync_preparation_form:' .
353 rsync_preparation_form
($_). "\n";
354 eval rsync_preparation_form
$_;
355 debug_print
"EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
356 debug_print
'rsync_dir_exec_form $_:'.
357 $rsync_dir_exec_form{$_} () . "\n";
358 my @rsync_ls = eval $rsync_dir_exec_form{$_}();
359 eval $rsync_dir_err_form{$_}();
360 $reachable{$_} = eval $rsync_dir_err_form{$_}() ?
0 : 1;
361 debug_print
"REACHABLE: $reachable{$_}\n";
362 if ($reachable{$_}) {
363 my %old_finished = safe_read
$finished_name;
364 if (-f
$rsync_log_name) {
365 my @rsync_log = read_list
$rsync_log_name;
366 foreach (@rsync_log) {
367 my ($file_length, $modification_time, $filename) =
368 /[\d\/\s
:\
[\
]]+ [>c\
.][fd
]\S
{9} \d
+ (\d
+) ([\d\
/:-]+) (.*)$/;
370 $old_finished{$filename . "\n"} =
371 "### " . $modification_time . " " .
375 safe_write
$finished_name, sort_hash
%old_finished;
376 unlink $rsync_log_name unless $debug;
379 # Delete from %old_finished what has to be re-rsynced.
380 foreach (@rsync_ls) {
381 my ($ls_size, $ls_modification_date,
382 $ls_modification_time, $ls_filename) =
383 /[drwx-]+\s+(\d+) ([\d\/]+) ([\d
:]+) (.*)/;
385 exists $old_finished{$ls_filename . "\n"}) {
386 my ($finished_modification_date, $finished_size) =
387 $old_finished{$ls_filename . "\n"} =~
389 if ( ($finished_size eq $ls_size)
391 ($finished_modification_date)
393 ($ls_modification_date,
394 $ls_modification_time)) )
396 $finished{$ls_filename . "\n"} =
397 $old_finished{$ls_filename . "\n"};
401 safe_write
$finished_name, %finished;
402 if (rsync_someplace
$_, @destination_roots) {
403 $progress_ratios{$_} = '0'; # Clean staleness for UI
409 } keys %source_roots;
412 # Provide some reassuring user information:
413 $destinations_monitor_thread = async
{
414 $SIG{TERM
} = sub { threads
->exit() };
417 my $destination_root = $_;
418 my $destination_usage = 0;
420 my $source_root = $_;
421 my $complete_destination = $destination_root . '/'
422 . $path_under_mount_point . '/'
423 . $source_dirs_in_destination{$source_root};
424 my @dir = qx(ls
-A
$complete_destination/ 2> /dev
/null
);
425 $destination_usage = 1 if scalar @dir; # 0 = no new data
426 } keys %source_roots;
427 $destination_usages{$destination_root} = $destination_usage;
428 my @destination_usage_ratio =
429 grep s/\S+\s+\S+\s+\S+\s+\S+\s+(\d*)%\s+\S+/$1/, qx(df
-P
$_);
430 chomp @destination_usage_ratio;
431 ($destination_usage_ratios{$_}) = @destination_usage_ratio;
432 } @destination_roots;
437 unless ($debug == 1) {
440 $display_thread = async
{
442 endwin
(); # Leave a usable terminal.
446 my $redraw_window_count = 0;
451 my $window_left = newwin
(LINES
() -8, 29, 0, 0);
452 my $window_right = newwin
(LINES
() - 8, 50, 0, 29);
453 my $window_center = newwin
(5, 79, LINES
() - 8, 0);
454 my $window_bottom = newwin
(3, 79, LINES
() - 3, 0);
455 $window_bottom->keypad(1);
456 $window_bottom->nodelay(1);
458 init_pair
1, COLOR_MAGENTA
, COLOR_BLACK
;
459 init_pair
2, COLOR_RED
, COLOR_BLACK
;
460 init_pair
3, COLOR_CYAN
, COLOR_BLACK
;
461 init_pair
4, COLOR_YELLOW
, COLOR_BLACK
;
462 my $MAGENTA = COLOR_PAIR
(1);
463 my $RED = COLOR_PAIR
(2);
464 my $CYAN = COLOR_PAIR
(3);
465 my $YELLOW = COLOR_PAIR
(4);
468 $window_left->attron($CYAN);
469 $window_left->box(0, 0);
470 $window_left->addstr(0, 6, "Data Destinations");
471 $window_left->attroff($CYAN);
472 my $destinations_format = "%-18s%-6s%-3s";
473 $window_left->attron(A_BOLD
);
474 $window_left->addstr(1, 1, sprintf($destinations_format,
475 "Removable", "Fresh", "Usg"));
476 $window_left->addstr(2, 1, sprintf($destinations_format,
477 "Disk", "Data?", "%"));
478 $window_left->attroff(A_BOLD
);
479 my $destination_usage;
482 if ($destination_usages{$_}) {
483 $window_left->attron($RED);
484 $destination_usage = "yes";
486 $window_left->attron($CYAN);
487 $destination_usage = "no";
490 addstr
($line_number, 1,
491 sprintf($destinations_format,
493 substr($destination_usage, -6, 6),
494 substr($destination_usage_ratios{$_}
495 ?
$destination_usage_ratios{$_}
499 $window_left->attroff($RED);
500 $window_left->attroff($CYAN);
501 } sort @destination_roots;
503 $window_right->attron($MAGENTA);
504 $window_right->box(0,0);
505 $window_right->addstr(0, 19, "Data Sources");
506 $window_right->attroff($MAGENTA);
507 my $sources_format = "%-15s%-11s%-9s%-13s";
508 $window_right->attron(A_BOLD
);
510 addstr
(1, 1, sprintf ($sources_format,
511 "Data", "", "Files", " Writing"));
513 addstr
(2, 1, sprintf ($sources_format,
514 "Source", "Speed", "To Copy", " To"));
515 $window_right->attroff(A_BOLD
);
517 $window_right->attron($MAGENTA);
520 my $current_destination = '?';
521 if (exists $destination_source_is_writing_to{$source}) {
522 $current_destination =
523 $destination_source_is_writing_to{$source};
525 if ($reachable{$source}) {
527 addstr
($line_number, 1,
528 sprintf($sources_format,
529 substr($source_roots{$source}, 0, 14),
530 substr($speeds{$source}, 0, 11),
531 substr($progress_ratios{$source},
533 substr($current_destination, -13, 13)));
537 addstr
($line_number, 1,
538 sprintf($sources_format, "", "", "", ""));
539 } sort (keys %source_roots);
540 $window_right->attroff($MAGENTA);
544 $window_center->addstr($line_number, 2, $_);
547 $window_center->move(0, 0);
549 $window_bottom->box(0,0);
550 $window_bottom->attron(A_BOLD
);
551 $window_bottom->addstr(1, 3, "[F3]: Turn off computer.");
552 $window_bottom->addstr(1, 53, "[F6]: Restart computer.");
553 $window_bottom->attroff(A_BOLD
);
555 $window_left->noutrefresh();
556 $window_right->noutrefresh();
557 $window_bottom->noutrefresh();
558 $window_center->noutrefresh(); # Last window gets the cursor.
559 act_on_keypress
($window_bottom->getch());
561 if (++ $redraw_window_count > 5) {
562 $redraw_window_count = 0;
573 # Tidy up. (Except we don't reach this.)
575 $being_deleted_thread{$_}->join if $being_deleted_thread{$_};
576 } @destination_roots;
579 $rsync_worker_thread{$_}->join if $rsync_worker_thread{$_};
580 } keys %source_roots;
582 $destinations_monitor_thread->join if $destinations_monitor_thread;
584 $display_thread->join if $display_thread;