10 my @pokinom_banner = (
11 " _/_/_/ _/_/ _/ _/ _/_/_/ _/ _/ _/_/ _/ _/",
12 " _/ _/ _/ _/ _/ _/ _/ _/_/ _/ _/ _/ _/_/ _/_/ ",
13 " _/_/_/ _/ _/ _/_/ _/ _/ _/ _/ _/ _/ _/ _/ _/ ",
14 " _/ _/ _/ _/ _/ _/ _/ _/_/ _/ _/ _/ _/ ",
15 "_/ _/_/ _/ _/ _/_/_/ _/ _/ _/_/ _/ _/ ",
19 # 0 = clean UI; 1 = lots of scrolling junk; anything else = both (pipe to file)
22 # Where to read local configuration:
23 my $pokinom_config = '~/monikop/pokinom.config';
25 $pokinom_config = $ARGV[0]
28 ########################################
30 ########################################
31 # Possible mount points.
32 my @usable_mount_points;
34 # Directory relative to a mount point where new data resides.
35 # Must agree with Monikop's setting.
36 my $path_under_mount_point;
38 # Directories of this name will be deleted.
39 # Must agree with Monikop's setting.
40 my $path_under_mount_point_backed_up;
42 # Directory name while being deleted by monikop.
43 # Must agree with Monikop's setting.
44 my $path_under_mount_point_being_deleted;
49 # Credentials of the remote rsync server. String, or 0 if not used.
53 # Full path to rsync's raw log
56 # Full path to a file to store list of rsync's incompletely
57 # transferred files in:
58 my $interrupted_prefix;
60 # Shut down when finished? (default); 1 = yes; 2 = stay on.
61 my $shut_down_when_done :shared
;
66 # Rsync's directory (relative to destination) for partially transferred files.
67 # Must agree with Monikop's setting.
68 my $rsync_partial_dir_name;
70 # Local changes to the above.
71 eval `cat $pokinom_config`;
73 # Places for running rsyncs to put their runtime info in
75 my %progress_ratios :shared
;
78 sub debug_print
{ if ($debug) { print @_; } };
80 # Return sorted intersection of arrays which are supposed to have unique
83 my @intersection = ();
86 foreach $element (@_) { $count{$element}++ }
87 foreach $element (keys %count) {
88 push @intersection, $element if $count{$element} > 1;
93 # Write @content to a file with name $filename.
95 my ($filename, @content) = @_;
96 open FILE
, '>', $filename
97 or die "[" . $$ . "] open $filename failed: $!\n";
106 sub rsync_preparation_form
{
108 $speeds{$source} = "-";
111 ########## Capture rsync's status messages for use by UI
112 '$rsync_outfun{\'', $source, '\'} = sub {',
113 ' my ($outline, $outputchannel) = @_ ; ',
114 ' my ($speed) = $outline =~ /\d+\s+\d+%\s+(\S+)/; ',
115 ' my ($progress_ratio) = $outline =~ /.+to-check=(\d+\/\d+)\)$/; ',
116 ' if ($speed and $outputchannel eq \'out\') {',
117 ' $speeds{\'', $source, '\'} = $speed;',
119 ' $speeds{\'', $source, '\'} = "-";',
121 ' if ($progress_ratio and $outputchannel eq \'out\') {',
122 ' $progress_ratios{\'', $source, '\'} = $progress_ratio;',
127 '$rsync{\'', $source, '\'} = File::Rsync->new; ',
128 ########## Return fodder for another eval
129 '$rsync_exec_form{\'', $source, '\'} = sub {',
130 ' \'$rsync{\\\'', $source, '\\\'}->exec(',
132 ' src => \\\'', $source_roots{$source}, '/', $path_under_mount_point, '/\\\', ',
133 ' dest => \\\'' . $destination . '/\\\', ',
134 ' outfun => $rsync_outfun{\\\'', $source, '\\\'}, ',
135 ' progress => 1, debug => 0, verbose => 0, ',
136 ' filter => [\\\'merge,- ', $interrupted_prefix, $source, '\\\'], ',
137 ' literal => [\\\'--recursive\\\', \\\'--times\\\', ',
138 ' \\\'--partial-dir=', $rsync_partial_dir_name, '\\\', ',
139 ' \\\'--update\\\', ',
140 ' \\\'--prune-empty-dirs\\\', ',
141 ' \\\'--log-file-format=%i %b %n\\\', ',
142 ' , \\\'--log-file=', $rsync_log_prefix, $source, '\\\'] ',
149 sub act_on_keypress
{
150 my ($pressed_key) = @_;
151 if ($pressed_key eq 267) { qx($shut_down_action); }
152 elsif ($pressed_key eq 273) { # F9
153 $shut_down_when_done = $shut_down_when_done ?
0 : 1; }
156 my %being_deleted_thread;
157 my %rsync_worker_thread;
160 $ENV{USER
} = $rsync_username if ($rsync_username);
161 $ENV{RSYNC_PASSWORD
} = $rsync_password if ($rsync_password);
164 $display_thread->kill('TERM')->join;
165 die "Caught signal $_[0]";
168 # Preparations done; sleeves up!
170 # Make sure we have dirs to put our logs in:
172 my ($filename, $directory) = fileparse
$_;
173 qx(mkdir -p
$directory);
174 } ( $rsync_log_prefix, $interrupted_prefix );
176 # Find usable (i.e. mounted) sources
177 my @raw_mount_points = grep (s/\S+ on (.*) type .*/$1/, qx/mount/);
178 chomp @raw_mount_points;
179 my @sources = intersection
@raw_mount_points, @usable_mount_points;
180 debug_print
"SOURCES:\n";
181 debug_print
@sources;
183 # Turn a path into a legal perl identifier:
184 sub make_key_from_path
{
186 ($path) =~ s/\/?(.*)\/?
/$1/g;
192 $source_roots{make_key_from_path
$_} = $_
195 # Clean up sources if necessary:
197 my $p_i_d = $source_roots{$_} . '/' . $path_under_mount_point;
198 my $p_i_d_being_deleted =
199 $source_roots{$_} . '/' . $path_under_mount_point_being_deleted;
200 $being_deleted_thread{$_} =
201 async
{ qx(rm
-rf
$p_i_d_being_deleted 2> /dev/null
); };
202 } keys %source_roots;
204 # Wait for $destination if necessary:
205 my $rsync_ping = File
::Rsync
->new;
206 my $empty_directory = dirname
($rsync_log_prefix) . "/empty_directory";
207 qx(rm
-rf
$empty_directory; mkdir -p
$empty_directory);
210 print "Waiting for $destination to become writable.\n";
212 $rsync_ping->exec({ src
=> $empty_directory, dest
=> $destination});
219 # Set up and start things per source_root, in parallel:
221 $progress_ratios{$_} = "?"; # Initialize for UI
223 $rsync_worker_thread{$_} = async
{
224 my $rsync_log_name = $rsync_log_prefix . $_;
225 debug_print
'rsync_preparation_form:' . rsync_preparation_form
($_). "\n";
226 eval rsync_preparation_form
$_;
227 debug_print
"EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
228 my $complete_source =
229 $source_roots{$_} . '/' . $path_under_mount_point;
230 my $complete_source_backed_up =
231 $source_roots{$_} . '/' . $path_under_mount_point_backed_up;
233 qx((cd
$complete_source 2> /dev/null
&& find
./ -path *$rsync_partial_dir_name/*));
234 # Write exclusion list: don't transfer files Monikop gave up upon.
235 grep s/\.(.*\/)$rsync_partial_dir_name\/(.*)/$1$2/, @interrupted;
236 write_list
$interrupted_prefix . $_, @interrupted;
237 debug_print
"INTERRUPTED";
238 debug_print
@interrupted;
239 if (-d
$complete_source) {
240 if (eval ($rsync_exec_form{$_}() )) {
241 debug_print
"EVAL RSYNC_EXEC_FORM (successful) $complete_source: $@ \n";
243 $display_thread->kill('TERM')->join if $display_thread;
244 # TODO: in case of overfull destination, warn nicer
245 warn "EVAL RSYNC_EXEC_FORM (failed) $complete_source: $@ \n";
249 $progress_ratios{$_} = "Wait";
252 } keys %source_roots;
254 # Repeat rsync runs, this time sequentially, in order to get the newest of a
255 # file which may exist in multiple versions on different sources:
256 my $rsync_worker_thread = async
{
259 $rsync_worker_thread{$_}->join;
260 debug_print
"JOINED $_\n";
261 } keys %source_roots;
263 $progress_ratios{$_} = "?"; # Initialize for UI
265 my $rsync_log_name = $rsync_log_prefix . $_;
266 eval rsync_preparation_form
$_;
267 debug_print
"EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
268 my $complete_source =
269 $source_roots{$_} . '/' . $path_under_mount_point;
270 my $complete_source_backed_up =
271 $source_roots{$_} . '/' . $path_under_mount_point_backed_up;
273 qx((cd
$complete_source 2> /dev/null
&& find
./ -path *$rsync_partial_dir_name/*));
274 # Write exclusion list: don't transfer files Monikop gave up upon.
275 grep s/\.(.*\/)$rsync_partial_dir_name\/(.*)/$1$2/, @interrupted;
276 write_list
$interrupted_prefix . $_, @interrupted;
277 if (-d
$complete_source) {
278 if (eval ($rsync_exec_form{$_}() )) {
279 debug_print
"EVAL RSYNC_EXEC_FORM (successful) $complete_source: $@ \n";
280 qx(mv
$complete_source $complete_source_backed_up);
282 $display_thread->kill('TERM')->join if $display_thread;
283 # TODO: in case of overfull destination, warn nicer
284 warn "EVAL RSYNC_EXEC_FORM (failed) $complete_source: $@ \n";
288 $progress_ratios{$_} = "Done";
292 unlink $rsync_log_name;
293 unlink $interrupted_prefix . $_;
295 } keys %source_roots;
298 unless ($debug == 1) {
300 $display_thread = async
{
302 endwin
(); # Leave a usable terminal.
306 my $redraw_window_count = 0;
311 my $window_top = newwin
(LINES
() - 8, 79, 0, 0);
312 my $window_center = newwin
(5, 79, LINES
() - 8, 0);
313 my $window_bottom = newwin
(3, 79, LINES
() - 3, 0);
314 $window_bottom->keypad(1);
315 $window_bottom->nodelay(1);
317 init_pair
1, COLOR_MAGENTA
, COLOR_BLACK
;
318 init_pair
2, COLOR_RED
, COLOR_BLACK
;
319 init_pair
3, COLOR_CYAN
, COLOR_BLACK
;
320 init_pair
4, COLOR_YELLOW
, COLOR_BLACK
;
321 my $MAGENTA = COLOR_PAIR
(1);
322 my $RED = COLOR_PAIR
(2);
323 my $CYAN = COLOR_PAIR
(3);
324 my $YELLOW = COLOR_PAIR
(4);
326 $window_top->attron($CYAN);
327 $window_top->box(0,0);
328 $window_top->addstr(0, 30, " P r o g r e s s ");
329 $window_top->attroff($CYAN);
330 my $sources_format = "%-25s%-18s%-8s";
331 $window_top->attron(A_BOLD
);
332 $window_top->addstr(1, 12,
333 sprintf ($sources_format,
334 "Source Medium", "Speed", "To Do"));
335 $window_top->attroff(A_BOLD
);
339 $window_top->attron($CYAN);
340 $window_top->attron($RED) if $done{$source};
342 addstr
($line_number, 12,
343 sprintf($sources_format,
344 substr($source_roots{$source}, 0, 24),
345 substr($speeds{$source}, 0, 17),
346 substr($progress_ratios{$source}, -8, 8)));
348 $window_top->addstr($line_number, 1,
349 sprintf($sources_format, "", "", "", ""));
350 $window_top->attroff($RED);
351 $window_top->attroff($CYAN);
352 } sort (keys %source_roots);
355 $window_center->addstr($line_number, 2, $_);
358 $window_center->move(0, 0);
360 $window_bottom->box(0,0);
361 $window_bottom->attron(A_BOLD
);
364 sprintf ("[F3]: Turn off now.%54s",
365 $shut_down_when_done ?
"Turning off when done. [F9]: Stay on."
366 : "Staying on. [F9]: Turn off when done."));
367 $window_bottom->attroff(A_BOLD
);
369 $window_top->noutrefresh();
370 $window_bottom->noutrefresh();
371 $window_center->noutrefresh(); # Last window gets the cursor.
373 if (++ $redraw_window_count > 5) {
374 $redraw_window_count = 0;
378 act_on_keypress
($window_bottom->getch());
379 if (! grep(/0/, values %done) && $shut_down_when_done) {
380 qx ($shut_down_action);
389 # Tidy up. (Except we don't reach this.)
391 $being_deleted_thread{$_}->join if $being_deleted_thread{$_};
392 } keys %source_roots;
394 $rsync_worker_thread->join if $rsync_worker_thread;
395 $display_thread->join if $display_thread;