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. Must be unique in their tails after rightmost /.
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 transferred files in:
57 my $interrupted_prefix;
59 # Shut down when finished? (default); 1 = yes; 2 = stay on.
60 my $shut_down_when_done :shared
;
65 # Rsync's directory (relative to destination) for partially transferred files.
66 # Must agree with Monikop's setting.
67 my $rsync_partial_dir_name;
69 # Local changes to the above.
70 eval `cat $pokinom_config`;
72 # Places for running rsyncs to put their runtime info in
74 my %progress_ratios :shared
;
77 sub debug_print
{ if ($debug) { print @_; } };
79 # Return sorted intersection of arrays which are supposed to have unique
82 my @intersection = ();
85 foreach $element (@_) { $count{$element}++ }
86 foreach $element (keys %count) {
87 push @intersection, $element if $count{$element} > 1;
92 # Write @content to a file with name $filename.
94 my ($filename, @content) = @_;
95 open FILE
, '>', $filename
96 or die "[" . $$ . "] open $filename failed: $!\n";
105 sub rsync_preparation_form
{
107 $speeds{$source} = "-";
110 ########## Capture rsync's status messages for use by UI
111 '$rsync_outfun{\'', $source, '\'} = sub {',
112 ' my ($outline, $outputchannel) = @_ ; ',
113 ' my ($speed) = $outline =~ /\d+\s+\d+%\s+(\S+)/; ',
114 ' my ($progress_ratio) = $outline =~ /.+to-check=(\d+\/\d+)\)$/; ',
115 ' if ($speed and $outputchannel eq \'out\') {',
116 ' $speeds{\'', $source, '\'} = $speed;',
118 ' $speeds{\'', $source, '\'} = "-";',
120 ' if ($progress_ratio and $outputchannel eq \'out\') {',
121 ' $progress_ratios{\'', $source, '\'} = $progress_ratio;',
126 '$rsync{\'', $source, '\'} = File::Rsync->new; ',
127 ########## Return fodder for another eval
128 '$rsync_exec_form{\'', $source, '\'} = sub {',
129 ' \'$rsync{\\\'', $source, '\\\'}->exec(',
131 ' src => \\\'', $source_roots{$source}, '/', $path_under_mount_point, '/\\\', ',
132 ' dest => \\\'' . $destination . '/\\\', ',
133 ' outfun => $rsync_outfun{\\\'', $source, '\\\'}, ',
134 ' progress => 1, debug => 0, verbose => 0, ',
135 ' filter => [\\\'merge,- ', $interrupted_prefix, $source, '\\\'], ',
136 ' literal => [\\\'--recursive\\\', \\\'--times\\\', ',
137 ' \\\'--partial-dir=', $rsync_partial_dir_name, '\\\', ',
138 ' \\\'--update\\\', ',
139 ' \\\'--prune-empty-dirs\\\', ',
140 ' \\\'--log-file-format=%i %b %n\\\', ',
141 ' , \\\'--log-file=', $rsync_log_prefix, $source, '\\\'] ',
148 sub act_on_keypress
{
149 my ($pressed_key) = @_;
150 if ($pressed_key eq 267) { qx($shut_down_action); }
151 elsif ($pressed_key eq 273) { # F9
152 $shut_down_when_done = $shut_down_when_done ?
0 : 1; }
155 $ENV{USER
} = $rsync_username if ($rsync_username);
156 $ENV{RSYNC_PASSWORD
} = $rsync_password if ($rsync_password);
158 sub restore_terminal_and_die
{
159 endwin
(); # Leave a usable terminal.
160 die "Signal $_[0] caught";
162 $SIG{TERM
} = 'restore_terminal_and_die';
164 # Preparations done; sleeves up!
166 # Find usable (i.e. mounted) sources
167 my @raw_mount_points = grep (s/\S+ on (.*) type .*/$1/, qx/mount/);
168 chomp @raw_mount_points;
169 my @sources = intersection
@raw_mount_points, @usable_mount_points;
170 debug_print
"SOURCES:\n";
171 debug_print
@sources;
173 # Turn a path into a legal perl identifier:
174 sub make_key_from_path
{
176 ($path) =~ s/\/?(.*)\/?
/$1/g;
182 $source_roots{make_key_from_path
$_} = $_
185 my %being_deleted_thread;
186 # Clean up sources if necessary
188 my $p_i_d = $source_roots{$_} . '/' . $path_under_mount_point;
189 my $p_i_d_being_deleted = $source_roots{$_} . '/' . $path_under_mount_point_being_deleted;
190 $being_deleted_thread{$_} = async
{ qx(rm
-rf
$p_i_d_being_deleted 2> /dev/null
); };
191 } keys %source_roots;
193 # This could be more sophisticated
194 print "Waiting for $destination to become reachable.\n";
197 my %rsync_worker_thread;
200 # Set up and start things per source_root, in parallel:
202 $progress_ratios{$_} = "?"; # Initialize for UI
204 $rsync_worker_thread{$_} = async
{
205 my $rsync_log_name = $rsync_log_prefix . $_;
206 debug_print
'rsync_preparation_form:' . rsync_preparation_form
($_). "\n";
207 eval rsync_preparation_form
$_;
208 debug_print
"EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
209 my $complete_source = $source_roots{$_} . '/' . $path_under_mount_point;
210 my $complete_source_backed_up = $source_roots{$_} . '/' . $path_under_mount_point_backed_up;
211 my @interrupted = qx((cd
$complete_source 2> /dev/null
&& find
./ -path *$rsync_partial_dir_name/*));
212 # Write exclusion list: don't transfer files Monikop gave up upon.
213 grep s/\.(.*\/)$rsync_partial_dir_name\/(.*)/$1$2/, @interrupted;
214 write_list
$interrupted_prefix . $_, @interrupted;
215 debug_print
"INTERRUPTED";
216 debug_print
@interrupted;
217 if (-d
$complete_source) {
218 if (eval ($rsync_exec_form{$_}() )) {
219 debug_print
"EVAL RSYNC_EXEC_FORM (successful) $complete_source: $@ \n";
221 die "EVAL RSYNC_EXEC_FORM (failed) $complete_source: $@ \n";
224 $progress_ratios{$_} = "Wait";
227 } keys %source_roots;
229 # Repeat rsync runs, this time sequentially, in order to get the newest of a file
230 # which may exist in multiple versions on different sources:
231 my $rsync_worker_thread = async
{
233 $rsync_worker_thread{$_}->join;
234 debug_print
"JOINED $_\n";
235 } keys %source_roots;
237 $progress_ratios{$_} = "?"; # Initialize for UI
239 my $rsync_log_name = $rsync_log_prefix . $_;
240 eval rsync_preparation_form
$_;
241 debug_print
"EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
242 my $complete_source = $source_roots{$_} . '/' . $path_under_mount_point;
243 my $complete_source_backed_up = $source_roots{$_} . '/' . $path_under_mount_point_backed_up;
244 my @interrupted = qx((cd
$complete_source 2> /dev/null
&& find
./ -path *$rsync_partial_dir_name/*));
245 # Write exclusion list: don't transfer files Monikop gave up upon.
246 grep s/\.(.*\/)$rsync_partial_dir_name\/(.*)/$1$2/, @interrupted;
247 write_list
$interrupted_prefix . $_, @interrupted;
248 if (-d
$complete_source) {
249 if (eval ($rsync_exec_form{$_}() )) {
250 debug_print
"EVAL RSYNC_EXEC_FORM (successful) $complete_source: $@ \n";
251 qx(mv
$complete_source $complete_source_backed_up);
253 die "EVAL RSYNC_EXEC_FORM (failed) $complete_source: $@ \n";
256 $progress_ratios{$_} = "Done";
260 unlink $rsync_log_name;
261 unlink $interrupted_prefix . $_;
263 } keys %source_roots;
267 # Let the workers toil.
270 # Let the workers toil and talk to the user.
271 my $redraw_window_count = 0;
276 my $window_top = newwin
(LINES
() - 8, 79, 0, 0);
277 my $window_center = newwin
(5, 79, LINES
() - 8, 0);
278 my $window_bottom = newwin
(3, 79, LINES
() - 3, 0);
279 $window_bottom->keypad(1);
280 $window_bottom->nodelay(1);
282 init_pair
1, COLOR_MAGENTA
, COLOR_BLACK
;
283 init_pair
2, COLOR_RED
, COLOR_BLACK
;
284 init_pair
3, COLOR_CYAN
, COLOR_BLACK
;
285 init_pair
4, COLOR_YELLOW
, COLOR_BLACK
;
286 my $MAGENTA = COLOR_PAIR
(1);
287 my $RED = COLOR_PAIR
(2);
288 my $CYAN = COLOR_PAIR
(3);
289 my $YELLOW = COLOR_PAIR
(4);
291 $window_top->attron($CYAN);
292 $window_top->box(0,0);
293 $window_top->addstr(0, 30, " P r o g r e s s ");
294 $window_top->attroff($CYAN);
295 my $sources_format = "%-25s%-18s%-8s";
296 $window_top->attron(A_BOLD
);
297 $window_top->addstr(1, 12,
298 sprintf ($sources_format,
299 "Source Medium", "Speed", "To Do"));
300 $window_top->attroff(A_BOLD
);
304 $window_top->attron($CYAN);
305 $window_top->attron($RED) if $done{$source};
306 $window_top->addstr($line_number, 12,
307 sprintf($sources_format,
308 substr($source_roots{$source}, 0, 24),
309 substr($speeds{$source}, 0, 17),
310 substr($progress_ratios{$source}, -8, 8)));
312 $window_top->addstr($line_number, 1,
313 sprintf($sources_format, "", "", "", ""));
314 $window_top->attroff($RED);
315 $window_top->attroff($CYAN);
316 } sort (keys %source_roots);
319 $window_center->addstr($line_number, 2, $_);
322 $window_center->move(0, 0);
324 $window_bottom->box(0,0);
325 $window_bottom->attron(A_BOLD
);
326 $window_bottom->addstr(1, 3,
327 sprintf ("[F3]: Turn off now.%54s",
328 $shut_down_when_done ?
"Turning off when done. [F9]: Stay on."
329 : "Staying on. [F9]: Turn off when done."));
330 $window_bottom->attroff(A_BOLD
);
332 $window_top->noutrefresh();
333 $window_bottom->noutrefresh();
334 $window_center->noutrefresh(); # Last window gets the cursor.
336 if (++ $redraw_window_count > 5) {
337 $redraw_window_count = 0;
341 act_on_keypress
($window_bottom->getch());
342 if (! grep(/0/, values %done) && $shut_down_when_done) {
343 qx ($shut_down_action);
349 # Tidy up. (Except we don't reach this.)
351 $being_deleted_thread{$_}->join if $being_deleted_thread{$_};
352 } keys %source_roots;
354 $rsync_worker_thread->join if $rsync_worker_thread{$_};