10 " _/_/_/ _/_/ _/ _/ _/_/_/ _/ _/ _/_/ _/ _/",
11 " _/ _/ _/ _/ _/ _/ _/ _/_/ _/ _/ _/ _/_/ _/_/ ",
12 " _/_/_/ _/ _/ _/_/ _/ _/ _/ _/ _/ _/ _/ _/ _/ ",
13 " _/ _/ _/ _/ _/ _/ _/ _/_/ _/ _/ _/ _/ ",
14 "_/ _/_/ _/ _/ _/_/_/ _/ _/ _/_/ _/ _/ ",
18 # 0 = clean UI; 1 = lots of scrolling junk; anything else = both (pipe to file)
21 # Where to read local configuration:
22 my $pokinom_config = '~/monikop/pokinom.config';
24 $pokinom_config = $ARGV[0]
27 ########################################
29 ########################################
30 # Possible mount points. Must be unique in their tails after rightmost /.
31 my @usable_mount_points;
33 # Directory relative to a mount point where new data resides.
34 # Must agree with Monikop's setting.
35 my $path_under_mount_point;
37 # Directories of this name will be deleted.
38 # Must agree with Monikop's setting.
39 my $path_under_mount_point_backed_up;
41 # Directory name while being deleted by monikop.
42 # Must agree with Monikop's setting.
43 my $path_under_mount_point_being_deleted;
48 # Credentials of the remote rsync server. String, or 0 if not used.
52 # Full path to rsync's raw log
55 # Full path to a file to store list of rsync's incompletely
56 # 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 =
190 $source_roots{$_} . '/' . $path_under_mount_point_being_deleted;
191 $being_deleted_thread{$_} =
192 async
{ qx(rm
-rf
$p_i_d_being_deleted 2> /dev/null
); };
193 } keys %source_roots;
195 # This could be more sophisticated:
197 print "\nWaiting for $destination to become reachable.\n";
200 my %rsync_worker_thread;
203 # Set up and start things per source_root, in parallel:
205 $progress_ratios{$_} = "?"; # Initialize for UI
207 $rsync_worker_thread{$_} = async
{
208 my $rsync_log_name = $rsync_log_prefix . $_;
209 debug_print
'rsync_preparation_form:' . rsync_preparation_form
($_). "\n";
210 eval rsync_preparation_form
$_;
211 debug_print
"EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
212 my $complete_source = $source_roots{$_} . '/' . $path_under_mount_point;
213 my $complete_source_backed_up = $source_roots{$_} . '/' . $path_under_mount_point_backed_up;
214 my @interrupted = qx((cd
$complete_source 2> /dev/null
&& find
./ -path *$rsync_partial_dir_name/*));
215 # Write exclusion list: don't transfer files Monikop gave up upon.
216 grep s/\.(.*\/)$rsync_partial_dir_name\/(.*)/$1$2/, @interrupted;
217 write_list
$interrupted_prefix . $_, @interrupted;
218 debug_print
"INTERRUPTED";
219 debug_print
@interrupted;
220 if (-d
$complete_source) {
221 if (eval ($rsync_exec_form{$_}() )) {
222 debug_print
"EVAL RSYNC_EXEC_FORM (successful) $complete_source: $@ \n";
224 die "EVAL RSYNC_EXEC_FORM (failed) $complete_source: $@ \n";
227 $progress_ratios{$_} = "Wait";
230 } keys %source_roots;
232 # Repeat rsync runs, this time sequentially, in order to get the newest of a file
233 # which may exist in multiple versions on different sources:
234 my $rsync_worker_thread = async
{
236 $rsync_worker_thread{$_}->join;
237 debug_print
"JOINED $_\n";
238 } keys %source_roots;
240 $progress_ratios{$_} = "?"; # Initialize for UI
242 my $rsync_log_name = $rsync_log_prefix . $_;
243 eval rsync_preparation_form
$_;
244 debug_print
"EVAL RSYNC_PREPARATION_FORM $_: $@ \n";
245 my $complete_source = $source_roots{$_} . '/' . $path_under_mount_point;
246 my $complete_source_backed_up = $source_roots{$_} . '/' . $path_under_mount_point_backed_up;
247 my @interrupted = qx((cd
$complete_source 2> /dev/null
&& find
./ -path *$rsync_partial_dir_name/*));
248 # Write exclusion list: don't transfer files Monikop gave up upon.
249 grep s/\.(.*\/)$rsync_partial_dir_name\/(.*)/$1$2/, @interrupted;
250 write_list
$interrupted_prefix . $_, @interrupted;
251 if (-d
$complete_source) {
252 if (eval ($rsync_exec_form{$_}() )) {
253 debug_print
"EVAL RSYNC_EXEC_FORM (successful) $complete_source: $@ \n";
254 qx(mv
$complete_source $complete_source_backed_up);
256 die "EVAL RSYNC_EXEC_FORM (failed) $complete_source: $@ \n";
259 $progress_ratios{$_} = "Done";
263 unlink $rsync_log_name;
264 unlink $interrupted_prefix . $_;
266 } keys %source_roots;
270 # Let the workers toil.
273 # Let the workers toil and talk to the user.
274 my $redraw_window_count = 0;
279 my $window_top = newwin
(LINES
() - 8, 79, 0, 0);
280 my $window_center = newwin
(5, 79, LINES
() - 8, 0);
281 my $window_bottom = newwin
(3, 79, LINES
() - 3, 0);
282 $window_bottom->keypad(1);
283 $window_bottom->nodelay(1);
285 init_pair
1, COLOR_MAGENTA
, COLOR_BLACK
;
286 init_pair
2, COLOR_RED
, COLOR_BLACK
;
287 init_pair
3, COLOR_CYAN
, COLOR_BLACK
;
288 init_pair
4, COLOR_YELLOW
, COLOR_BLACK
;
289 my $MAGENTA = COLOR_PAIR
(1);
290 my $RED = COLOR_PAIR
(2);
291 my $CYAN = COLOR_PAIR
(3);
292 my $YELLOW = COLOR_PAIR
(4);
294 $window_top->attron($CYAN);
295 $window_top->box(0,0);
296 $window_top->addstr(0, 30, " P r o g r e s s ");
297 $window_top->attroff($CYAN);
298 my $sources_format = "%-25s%-18s%-8s";
299 $window_top->attron(A_BOLD
);
300 $window_top->addstr(1, 12,
301 sprintf ($sources_format,
302 "Source Medium", "Speed", "To Do"));
303 $window_top->attroff(A_BOLD
);
307 $window_top->attron($CYAN);
308 $window_top->attron($RED) if $done{$source};
309 $window_top->addstr($line_number, 12,
310 sprintf($sources_format,
311 substr($source_roots{$source}, 0, 24),
312 substr($speeds{$source}, 0, 17),
313 substr($progress_ratios{$source}, -8, 8)));
315 $window_top->addstr($line_number, 1,
316 sprintf($sources_format, "", "", "", ""));
317 $window_top->attroff($RED);
318 $window_top->attroff($CYAN);
319 } sort (keys %source_roots);
322 $window_center->addstr($line_number, 2, $_);
325 $window_center->move(0, 0);
327 $window_bottom->box(0,0);
328 $window_bottom->attron(A_BOLD
);
329 $window_bottom->addstr(1, 3,
330 sprintf ("[F3]: Turn off now.%54s",
331 $shut_down_when_done ?
"Turning off when done. [F9]: Stay on."
332 : "Staying on. [F9]: Turn off when done."));
333 $window_bottom->attroff(A_BOLD
);
335 $window_top->noutrefresh();
336 $window_bottom->noutrefresh();
337 $window_center->noutrefresh(); # Last window gets the cursor.
339 if (++ $redraw_window_count > 5) {
340 $redraw_window_count = 0;
344 act_on_keypress
($window_bottom->getch());
345 if (! grep(/0/, values %done) && $shut_down_when_done) {
346 qx ($shut_down_action);
352 # Tidy up. (Except we don't reach this.)
354 $being_deleted_thread{$_}->join if $being_deleted_thread{$_};
355 } keys %source_roots;
357 $rsync_worker_thread->join if $rsync_worker_thread{$_};