File Coverage

File:blib/lib/App/FileSync/CLI.pm
Coverage:99.7%

linestmtbrancondsubtimecode
1package App::FileSync::CLI;
2
3# The three command-line programs: filesync (client), filesync-admin and
4# filesync-server.  Each run_* parses arguments, calls the library and prints;
5# all text comes from the message catalogue, so this module holds no prose.
6
7
299
299
299
2792
228
3789
use App::FileSync::Platform;
8
9
299
299
299
443
186
2629
use strict;
10
299
299
299
578
273
5598
use warnings;
11
299
299
299
505
221
670
use autodie qw(:all);
12
13
299
299
299
786328
3613
11140
use Cwd qw(abs_path);
14
299
299
299
2689
182
4590
use File::Spec;
15
299
299
299
90896
1386307
558
use Getopt::Long qw(GetOptionsFromArray);
16
299
299
299
23042
231
7892
use List::Util qw(any first);
17
299
299
299
60437
495357
8335
use Readonly;
18
299
299
299
65082
8211737
1094
use Sub::Private { mode => 'enforce' };
19
299
299
299
82441
145256
4371
use Sys::Hostname ();
20
21
299
299
299
52733
514
12245
use App::FileSync qw(json_encode format_utc validate_repo_name validate_client_id parse_since parse_until write_atomic);
22
299
299
299
58487
657
5543
use App::FileSync::Admin;
23
299
299
299
73704
575
5911
use App::FileSync::Client;
24
299
299
299
698
259
4863
use App::FileSync::Config;
25
299
23877
use App::FileSync::Constants qw(
26        $EXIT_OK $EXIT_FATAL $EXIT_LOCKED $EXIT_WARNINGS $EXIT_DRIFT $EXIT_MAX
27        $DEFAULT_SERVER_ROOT $PROTOCOL_VERSION $ROLE_CLIENT @ROLES $ROOT_MARKER $MAX_ID_LENGTH $TYPE_FILE
28
299
299
558
230
);
29
299
299
299
626
257
7168
use App::FileSync::I18N qw(message throw strip_location);
30
299
299
299
538
220
4075
use App::FileSync::IO qw(ensure_dir);
31
299
299
299
486
242
2942
use App::FileSync::Protocol;
32
299
299
299
78282
472
5519
use App::FileSync::Server;
33
299
299
299
710
277
2413
use App::FileSync::Settings;
34
299
299
299
529
263
2665
use App::FileSync::Transport::SSH;
35
36
299
299
299
481
236
680
use version; our $VERSION = version->declare('0.001.1');
37
38# What the marker file says to anyone who finds it.  File content, not a
39# message: it must not change with the reader's language.
40Readonly my $MARKER_TEXT => "This directory is a filesync root; do not delete this file.\n";
41
42# The client's default local-trash retention, written by init.
43Readonly my $LOCAL_TRASH_DAYS => 30;
44
45# How many journal events "filesync-admin log" shows by default.
46Readonly my $ADMIN_LOG_LIMIT => 20;
47
48# Size units for human-readable byte counts.
49Readonly my $KIB => 1024;
50Readonly my @SIZE_UNITS => ([ $KIB ** 3, 'GB' ], [ $KIB ** 2, 'MB' ], [ $KIB, 'kB' ]);
51
52# The client commands and their handlers.
53Readonly my %CLIENT_COMMANDS => (
54        help     => '_client_help',
55        '--help' => '_client_help',
56        version  => '_client_version',
57        init     => '_client_init',
58        sync     => '_client_sync',
59        status   => '_client_status',
60        log      => '_client_log',
61        settings => '_client_settings',
62        verify   => '_client_verify',
63        restore  => '_client_restore',
64        snapshot => '_client_snapshot',
65);
66
67# The admin commands; a hashref value is a group of sub-commands.
68Readonly my %ADMIN_COMMANDS => (
69        repo    => { create => '_admin_repo_create', list => '_admin_repo_list', show => '_admin_repo_show' },
70        client  => { allow => '_admin_client_allow', list => '_admin_client_list', forget => '_admin_client_forget' },
71        log     => '_admin_log',
72        verify  => '_admin_verify',
73        reindex => '_admin_reindex',
74        restore => '_admin_restore',
75);
76
77# Settings whose empty value means "the transport's default", and what to
78# show instead of a blank column.
79Readonly my %BLANK_SETTING => (
80        log_file        => 'cli.settings.stderr',
81        ssh_identity    => 'cli.settings.ssh_default',
82        ssh_known_hosts => 'cli.settings.ssh_default',
83        server_command  => 'cli.settings.server_default',
84);
85
86# Journal fields "filesync-admin log" prints as key=value, in this order.
87Readonly my @EVENT_FIELDS   => qw(from winner loser_name exit trash sha256);
88Readonly my @EVENT_COUNTERS => qw(actions deletions conflicts pulled pushed deleted);
89Readonly my %EVENT_LABEL    => (loser_name => 'loser');
90
91=encoding utf8
92
93 - 173
=head1 NAME

App::FileSync::CLI - the filesync, filesync-admin and filesync-server commands

=head1 SYNOPSIS

        # bin/filesync
        use App::FileSync::CLI;
        exit App::FileSync::CLI::run_client(@ARGV);

=head1 DESCRIPTION

Each C<run_*> function runs one command line and returns the exit code; it
never dies.  Errors are reported through the logger (or standard error if the
settings that configure the logger are themselves broken), without Perl file
and line numbers.  Text output goes to standard output; C<--json> prints one
JSON document instead.

Client exit codes: 0 ok, 1 fatal, 2 another run holds the lock, 3 completed
with warnings, 4 verification found drift.  Admin: 0, 1 and 4.

=head1 FUNCTIONS

=head2 run_client

Documented with L</run_server> below.

=head2 run_admin

Documented with L</run_server> below.

=head2 run_server

Purpose: run C<filesync>, C<filesync-admin> or C<filesync-server>.

Args: the command line, without the program name.

Returns: the exit code.

Side Effects: whatever the command does; prints to standard output and logs
to standard error.  C<run_server> speaks the protocol on standard input and
output and refuses to run on a terminal unless C<FILESYNC_ALLOW_TTY> is set.

Usage:

        exit App::FileSync::CLI::run_client(@ARGV);

=head3 EXAMPLE

        my $code = App::FileSync::CLI::run_client('sync', '--repo', 'docs', '--json');
        my $code = App::FileSync::CLI::run_admin('--root', '/srv/filesync', 'repo', 'list');

=head3 API SPECIFICATION

=head4 INPUT

        [ { name => 'args', type => 'arrayref' } ]        # passed as a list

=head4 OUTPUT

        { type => 'integer', min => 0, max => 255 }

=head3 MESSAGES

        Key                 Meaning                                   Resolution
        cli.unknown_command the command is not known                  run "filesync help"
        cli.usage.*         the options could not be parsed           see the usage line
        cli.unexpected      extra arguments were given                remove them
        cli.required        a required argument is missing            supply it
        cli.no_repos        no repos are configured                   filesync init
        cli.no_repo         the named repo is not configured          check --repo
        cli.need_repo       several repos and no --repo               pass --repo
        cli.init.*          init was given an unusable value          see the message
        cli.server.*        the server was started wrongly            fix authorized_keys

=head3 FORMAL SPECIFICATION

        run(args) = dispatch(args)                  if dispatch succeeds
        run(args) = 1 ∧ log(strip_location(error))  if it raises

=cut
174
175sub run_client {
176
78
188
        my (@args) = @_;
177
178        return _run(sub {
179
78
133
                my ($command, @rest) = @_;
180
78
283
                return _dispatch(\%CLIENT_COMMANDS, 'filesync', $command // 'help', @rest);
181
78
388
        }, @args);
182}
183
184sub run_admin {
185
44
103
        my (@args) = @_;
186
187
44
144
        return _run(\&_admin_dispatch, @args);
188}
189
190sub run_server {
191
175
463
        my (@args) = @_;
192
193
175
600
        return _run(\&_server_main, @args);
194}
195
196# _run
197# Purpose:     run a dispatcher, turning any error into exit code 1.
198# Entry:       $code takes the arguments and returns an exit code.
199# Exit:        returns the exit code.
200# Side effects: reports the error without its Perl location.
201sub _run :Private {
202        my ($code, @args) = @_;
203
204        my $exit = eval { $code->(@args) };
205        return $exit if defined $exit;
206
207        _report_error(strip_location($@));
208        return $EXIT_FATAL;
209
299
299
299
69664
294
3665
}
210
211# _report_error
212# Purpose:     show an error to the user.
213# Entry:       $error is the text.
214# Exit:        returns 1 if logged, 0 if printed directly.
215# Side effects: logs it; if the logger cannot be built (an unusable settings
216#              file), prints to standard error, so the error that says so is
217#              never hidden.
218sub _report_error :Private {
219        my ($error) = @_;
220
221        my $logger = eval { App::FileSync::Settings::logger() };
222        if ($logger) {
223                $logger->error($error);
224                return 1;
225        }
226
227        print STDERR "$error\n";
228        return 0;
229
299
299
299
100892
283
2349
}
230
231# _dispatch
232# Purpose:     run one command from a table.
233# Entry:       $table maps command names to handler names.
234# Exit:        returns the handler's exit code.
235# Side effects: raises cli.unknown_command.
236sub _dispatch :Private {
237        my ($table, $program, $command, @args) = @_;
238
239        my $handler = $table->{$command} or throw('cli.unknown_command', { command => $command, program => $program });
240        my $code = __PACKAGE__->can($handler);
241        return $code->(@args);
242
299
299
299
90075
319
2287
}
243
244# _say
245# Purpose:     print one catalogued line.
246# Entry:       $key and its arguments.
247# Exit:        returns 1.
248# Side effects: prints to standard output.
249sub _say :Private {
250        my ($key, $args) = @_;
251
252        print message($key, $args), "\n";
253        return 1;
254
299
299
299
86817
296
2198
}
255
256# _options
257# Purpose:     parse options for a command, with its usage line on failure.
258# Entry:       $args is the argument list (consumed); $spec is the
259#              Getopt::Long specification; $command names the usage key.
260# Exit:        returns 1.
261# Side effects: removes the options from @$args; raises cli.usage.
262sub _options :Private {
263        my ($args, $spec, $command) = @_;
264
265        GetOptionsFromArray($args, %{$spec}) or throw('cli.usage', { usage => message("cli.usage.$command") });
266        return 1;
267
299
299
299
93202
298
2391
}
268
269# _no_more
270# Purpose:     refuse arguments a command does not take.
271# Entry:       $args holds what is left after parsing.
272# Exit:        returns 1.
273# Side effects: raises cli.unexpected.
274sub _no_more :Private {
275        my ($args, $command) = @_;
276
277        throw('cli.unexpected', { command => $command, args => "@{$args}" }) if @{$args};
278        return 1;
279
299
299
299
89456
287
2336
}
280
281# _require
282# Purpose:     insist on a non-empty value.
283# Entry:       $what names it in the message.
284# Exit:        returns the value.
285# Side effects: raises cli.required.
286sub _require :Private {
287        my ($value, $command, $what) = @_;
288
289        throw('cli.required', { command => $command, what => $what }) unless defined $value && length $value;
290        return $value;
291
299
299
299
89702
278
2122
}
292
293# _repos
294# Purpose:     the repos a multi-repo command works on.
295# Entry:       $given are --repo values (maybe none); $require_any says
296#              whether an empty configuration is an error.
297# Exit:        returns an arrayref of names: the given ones, or all, sorted.
298# Side effects: raises cli.no_repos or cli.no_repo.
299sub _repos :Private {
300        my ($config, $given, $require_any) = @_;
301
302        throw('cli.no_repos') if $require_any && !%{ $config->{repos} };
303        my @names = @{$given} ? @{$given} : sort keys %{ $config->{repos} };
304        $config->{repos}{$_} or throw('cli.no_repo', { repo => $_ }) for @names;
305
306        return \@names;
307
299
299
299
97235
280
2306
}
308
309# _one_repo
310# Purpose:     the repo a single-repo command works on.
311# Entry:       $name is --repo, maybe undef.
312# Exit:        returns the name; the only repo when there is just one.
313# Side effects: raises cli.no_repos, cli.need_repo or cli.no_repo.
314sub _one_repo :Private {
315        my ($config, $name, $command) = @_;
316
317        my @names = sort keys %{ $config->{repos} };
318        throw('cli.no_repos') unless @names;
319        $name //= $names[0] if @names == 1;
320        throw('cli.need_repo', { command => $command }) unless defined $name;
321        throw('cli.no_repo', { repo => $name }) unless $config->{repos}{$name};
322
323        return $name;
324
299
299
299
96089
322
2223
}
325
326# _client
327# Purpose:     a Client for one configured repo.
328# Entry:       %extra is passed to Client->new.
329# Exit:        returns the client.
330# Side effects: none.
331sub _client :Private {
332        my ($config, $name, %extra) = @_;
333
334        return App::FileSync::Client->new(config => $config, name => $name, %extra);
335
299
299
299
85675
276
2097
}
336
337# ------------------------------------------------------------------ server
338
339# _server_main
340# Purpose:     filesync-server: serve one session on stdin/stdout.
341# Entry:       @args is the forced command's arguments.
342# Exit:        returns 0 when the session finished, 1 when it failed.
343# Side effects: runs the session.  Under sshd the root comes from the
344#              forced command (or FILESYNC_ROOT), never from the client,
345#              and SSH_ORIGINAL_COMMAND must agree with the pinned values.
346sub _server_main :Private {
347        my (@args) = @_;
348
349        # --forced is accepted (older authorized_keys lines carry it) but implies
350        # nothing: SSH_ORIGINAL_COMMAND is checked whenever sshd sets it.
351        my %opt;
352        _options(\@args, {
353                'root=s'   => \$opt{root},
354                'repo=s'   => \$opt{repo},
355                'client=s' => \$opt{client},
356                'role=s'   => \$opt{role},
357                'proto=i'  => \$opt{proto},
358                'forced'   => \$opt{forced},
359        }, 'server');
360        _no_more(\@args, 'filesync-server');
361
362        my $root = first { defined && length } $opt{root}, $ENV{FILESYNC_ROOT}, $DEFAULT_SERVER_ROOT;
363        _require($opt{$_}, 'filesync-server', "--$_") for qw(repo client role);
364        throw('cli.server.bad_role', { role => $opt{role} }) unless any { $_ eq $opt{role} } @ROLES;
365        throw('cli.server.proto', { proto => $opt{proto} }) if defined $opt{proto} && $opt{proto} != $PROTOCOL_VERSION;
366
367        my $original = $ENV{SSH_ORIGINAL_COMMAND};
368        if (defined $original && length $original) {
369                my ($ok, $reason) = App::FileSync::Server::validate_forced_command(
370                        $original, { map({ $_ => $opt{$_} } qw(repo client role)), root => $root },
371                );
372                throw('cli.server.forced', { reason => $reason }) unless $ok;
373        }
374
375        throw('cli.server.tty') if -t STDIN && !$ENV{FILESYNC_ALLOW_TTY};
376
377        my $server = App::FileSync::Server->new(
378                root       => $root,
379                (map { $_ => $opt{$_} } qw(repo client role)),
380                connection => App::FileSync::Protocol->new(in => \*STDIN, out => \*STDOUT),
381                logger     => App::FileSync::Settings::logger(),
382        );
383
384        return $server->run() ? $EXIT_OK : $EXIT_FATAL;
385
299
299
299
137794
282
2653
}
386
387# ------------------------------------------------------------------ client
388
389# _client_help / _client_version
390# Purpose:     print the usage summary, or the version.
391# Entry:       none.
392# Exit:        returns 0.
393# Side effects: prints.
394sub _client_help :Private {
395        print message('cli.help.client');
396        return $EXIT_OK;
397
299
299
299
88611
314
2212
}
398
399sub _client_version :Private {
400        _say('cli.version', { version => $App::FileSync::VERSION, proto => $PROTOCOL_VERSION });
401        return $EXIT_OK;
402
299
299
299
85957
281
2075
}
403
404# _client_init
405# Purpose:     filesync init: register a repo in the client configuration.
406# Entry:       @args are init's options.
407# Exit:        returns 0.
408# Side effects: creates the sync root and its marker (and a local server
409#              root); writes the client configuration.  Every id that will
410#              reach the server is checked here, so a bad one is reported
411#              at init rather than as a refusal at the first sync.
412sub _client_init :Private {
413        my (@args) = @_;
414
415        my %opt;
416        _options(\@args, {
417                (map { ("$_=s" => \$opt{$_}) } qw(repo root server remote-repo id identity role transport server-root config known-hosts server-command snapshot-mode)),
418                'port=i'          => \$opt{port},
419                'accept-host-key' => \$opt{accept},
420        }, 'init');
421
422        my $repo = _require($opt{repo}, 'init', '--repo');
423        my $root = _require($opt{root}, 'init', '--root');
424        _check_id(\&validate_repo_name, $repo);
425        _check_id(\&validate_repo_name, $opt{'remote-repo'}) if defined $opt{'remote-repo'} && length $opt{'remote-repo'};
426        _check_id(\&validate_client_id, $opt{id}) if defined $opt{id} && length $opt{id};
427
428        my $role = $opt{role} // $ROLE_CLIENT;
429        throw('cli.init.bad_role', { role => $role }) unless any { $_ eq $role } @ROLES;
430
431        my $mode = $opt{'snapshot-mode'};
432        throw('cli.init.bad_mode', { mode => $mode })
433                if defined $mode && length $mode && $mode ne 'hardlink' && $mode ne 'copy';
434
435        my ($server, $server_root, $known) = @opt{qw(server server-root known-hosts)};
436        my $use = $opt{transport} || ($server_root ? 'local' : 'ssh');
437        throw('cli.init.bad_transport', { transport => $use }) unless $use eq 'local' || $use eq 'ssh';
438        throw('cli.init.need_server_root') if $use eq 'local' && !(defined $server_root && length $server_root);
439        throw('cli.init.need_server') if $use eq 'ssh' && !(defined $server && length $server);
440        throw('cli.init.bad_server', { server => $server }) if $use eq 'ssh' && !App::FileSync::Transport::SSH::valid_server($server);
441        throw('cli.init.no_known_hosts', { path => $known }) if defined $known && length $known && !-f $known;
442        throw('cli.init.accept_ssh_only') if $opt{accept} && $use ne 'ssh';
443
444        ensure_dir($root);
445        throw('cli.init.bad_root', { root => $root }) unless -d $root;
446        $root = abs_path($root);
447
448        my $marker = File::Spec->catfile($root, $ROOT_MARKER);
449        write_atomic($marker, $MARKER_TEXT) unless -e $marker;
450
451        if (defined $server_root) {
452                ensure_dir($server_root);
453                $server_root = abs_path($server_root);
454        }
455
456        my $config = App::FileSync::Config::load_client($opt{config});
457        $config->{client_id} = _default_client_id() unless defined $config->{client_id} && length $config->{client_id};
458        $config->{client_id} = $opt{id} if defined $opt{id} && length $opt{id};
459
460        my %optional = (
461                server_root       => $server_root,
462                server            => $server,
463                port              => $opt{port},
464                identity          => $opt{identity},
465                known_hosts       => $known,
466                host_key_checking => $opt{accept} ? 'accept-new' : undef,
467                server_command    => $opt{'server-command'},
468                snapshot_mode     => $mode,
469        );
470        $config->{repos}{$repo} = {
471                root             => $root,
472                remote_repo      => (defined $opt{'remote-repo'} && length $opt{'remote-repo'}) ? $opt{'remote-repo'} : $repo,
473                role             => $role,
474                transport        => $use,
475                local_trash_days => $LOCAL_TRASH_DAYS,
476                map { $_ => $optional{$_} } grep { defined $optional{$_} && length $optional{$_} } keys %optional,
477        };
478
479        my $path = App::FileSync::Config::save_client($config, $opt{config});
480
481        _say('cli.init.done', { repo => $repo });
482        _say('cli.init.client_id', { id => $config->{client_id} });
483        _say('cli.init.root', { root => $root });
484        _say('cli.init.transport', { transport => $use });
485        if ($use eq 'ssh') {
486                _say('cli.init.server', { server => $server });
487                _say($opt{accept} ? 'cli.init.host_key_tofu' : 'cli.init.host_key_strict');
488        }
489        _say('cli.init.config', { path => $path });
490
491        return $EXIT_OK;
492
299
299
299
182611
267
2685
}
493
494# _check_id
495# Purpose:     validate an id given to init.
496# Entry:       $validate is validate_repo_name or validate_client_id.
497# Exit:        returns 1.
498# Side effects: raises cli.init.bad_id with the validator's reason.
499sub _check_id :Private {
500        my ($validate, $value) = @_;
501
502        my ($ok, $reason) = $validate->($value);
503        throw('cli.init.bad_id', { reason => $reason }) unless $ok;
504        return 1;
505
299
299
299
100095
268
2288
}
506
507# _client_sync
508# Purpose:     filesync sync: sync each selected repo.
509# Entry:       @args are sync's options.
510# Exit:        returns 1 if any repo failed, else 3 if any warned, else 2 if
511#              any was locked, else 0.
512# Side effects: syncs; prints a summary per repo (or JSON); logs errors.
513#              One repo failing does not stop the others.
514sub _client_sync :Private {
515        my (@args) = @_;
516
517        my (%opt, @given);
518        _options(\@args, {
519                'repo=s@' => \@given,
520                (map { ($_ => \$opt{$_}) } qw(dry-run force verbose quiet json no-prune no-delta)),
521                'config=s' => \$opt{config},
522        }, 'sync');
523
524        my $config = App::FileSync::Config::load_client($opt{config});
525        my $names = _repos($config, \@given, 1);
526        my $logger = App::FileSync::Settings::logger(verbose => $opt{verbose}, quiet => $opt{quiet});
527        my $client_opts = { map { (my $key = $_) =~ tr/-/_/; $key => $opt{$_} } qw(dry-run force no-prune no-delta verbose) };
528
529        my (@results, @errors, %seen);
530        for my $name (@{$names}) {
531                my $result = eval { _client($config, $name, opts => $client_opts, logger => $logger)->sync() };
532                unless ($result) {
533                        my $error = strip_location($@);
534                        push @errors, { repo => $name, error => $error };
535                        $logger->error(message('cli.repo_error', { repo => $name, error => $error })) unless $opt{json};
536                        $seen{$EXIT_FATAL} = 1;
537                        next;
538                }
539
540                push @results, $result;
541                my $exit = $result->{exit} || $EXIT_OK;
542                $seen{$exit} = 1;
543                if ($exit == $EXIT_LOCKED) {
544                        $logger->warn(message('cli.repo_error', { repo => $name, error => $result->{error} })) unless $opt{json} || $opt{quiet};
545                        next;
546                }
547
548                _print_sync($name, $result, \%opt) unless $opt{json};
549        }
550
551        print json_encode({ results => \@results, errors => \@errors }), "\n" if $opt{json};
552
553        # Severity order, not numeric order: a failure outranks warnings, which
554        # outrank a lock refusal (nothing went wrong; it just did not run).
555        return (first { $seen{$_} } $EXIT_FATAL, $EXIT_WARNINGS, $EXIT_LOCKED) // $EXIT_OK;
556
299
299
299
148127
267
2564
}
557
558# _print_sync
559# Purpose:     the text report of one repo's sync.
560# Entry:       $result is a sync result; $opt the parsed options.
561# Exit:        returns 1.
562# Side effects: prints the planned actions (dry run), the counts, the
563#              transfer accounting (a dry run sends no payloads, so it has
564#              none) and, unless --quiet, the warnings.
565sub _print_sync :Private {
566        my ($name, $result, $opt) = @_;
567
568        if ($opt->{'dry-run'}) {
569                for my $action (@{ $result->{actions} || [] }) {
570                        (my $verb = $action->{a}) =~ tr/_/ /;
571                        _say('cli.sync.would', { verb => $verb, path => $action->{p} });
572                }
573        }
574
575        my $summary = $result->{summary} || {};
576        _say('cli.sync.summary', {
577                repo => $name,
578                dry  => $opt->{'dry-run'} ? message('cli.sync.dry_tag') : '',
579                map { $_ => $summary->{$_} || 0 } qw(pulled pushed deleted conflicts),
580        });
581        _say('cli.sync.transfer', { report => _transfer_report($summary) }) unless $opt->{'dry-run'};
582
583        _print_warnings($result->{warnings}) unless $opt->{quiet};
584        return 1;
585
299
299
299
119843
282
2431
}
586
587# _print_warnings
588# Purpose:     print warnings, one per line.
589# Entry:       $warnings is an arrayref or undef.
590# Exit:        returns 1.
591# Side effects: prints.
592sub _print_warnings :Private {
593        my ($warnings) = @_;
594
595        _say('cli.warning', { warning => $_ }) for @{ $warnings || [] };
596        return 1;
597
299
299
299
93236
286
2244
}
598
599# _client_status
600# Purpose:     filesync status: when each repo last synced, and how big it is.
601# Entry:       @args are status's options.
602# Exit:        returns 0.
603# Side effects: reads each repo's cache; prints.
604sub _client_status :Private {
605        my (@args) = @_;
606
607        my (@given, %opt);
608        _options(\@args, { 'repo=s@' => \@given, json => \$opt{json}, 'config=s' => \$opt{config} }, 'status');
609
610        my $config = App::FileSync::Config::load_client($opt{config});
611        my @status;
612        for my $name (@{ _repos($config, \@given, 0) }) {
613                my $repo = $config->{repos}{$name};
614                my $cache = _client($config, $name)->cache();
615                my $last = ref($cache->{last_run}) eq 'HASH' ? $cache->{last_run} : undef;
616
617                push @status, {
618                        repo         => $name,
619                        root         => $repo->{root},
620                        transport    => $repo->{transport} || 'ssh',
621                        last_run     => $last ? scalar(gmtime($last->{ts})) . ' UTC' : 'never',
622                        last_summary => $last ? $last->{summary} : undef,
623                        files        => scalar(grep { ($_->{t} || $TYPE_FILE) eq $TYPE_FILE } values %{ $cache->{entries} }),
624                };
625        }
626
627        if ($opt{json}) {
628                print json_encode({ repos => \@status }), "\n";
629                return $EXIT_OK;
630        }
631
632        for my $entry (@status) {
633                _say('cli.status.repo', $entry);
634                _say('cli.status.transport', $entry);
635                # JSON keeps the literal 'never' (it is data); the text is translated.
636                _say('cli.status.last_run', { last_run => $entry->{last_run} eq 'never' ? message('cli.never') : $entry->{last_run} });
637
638                # Caches written before the byte counters existed have no transfer
639                # figures; skip the line rather than invent zeros.
640                my $summary = $entry->{last_summary};
641                _say('cli.status.transfer', { report => _transfer_report($summary) })
642                        if ref($summary) eq 'HASH' && defined $summary->{bytes_sent};
643                _say('cli.status.files', $entry);
644        }
645
646        return $EXIT_OK;
647
299
299
299
144091
265
2568
}
648
649# _client_log
650# Purpose:     filesync log: recent run attempts per repo.
651# Entry:       @args are log's options.
652# Exit:        returns 0.
653# Side effects: reads the run logs; prints (or JSON).  Bad dates are
654#              reported before any repo is touched.
655sub _client_log :Private {
656        my (@args) = @_;
657
658        my (@given, @exits, %opt);
659        _options(\@args, {
660                'repo=s@' => \@given,
661                'n=i'     => \$opt{limit},
662                'exit=i@' => \@exits,
663                (map { ("$_=s" => \$opt{$_}) } qw(since until config)),
664                (map { ($_ => \$opt{$_}) } qw(warnings json)),
665        }, 'log');
666        _no_more(\@args, 'log');
667        throw('cli.positive', { command => 'log', option => '-n' }) if defined $opt{limit} && $opt{limit} < 1;
668        _check_exits(\@exits);
669        _check_window(@opt{qw(since until)});
670
671        my $config = App::FileSync::Config::load_client($opt{config});
672        my @results;
673        for my $name (@{ _repos($config, \@given, 1) }) {
674                my $result = _client($config, $name)->log(
675                        limit => $opt{limit}, since => $opt{since}, until => $opt{until}, exits => \@exits, warnings => $opt{warnings},
676                );
677                push @results, $result;
678                _print_runs($name, $result->{runs}) unless $opt{json};
679        }
680
681        print json_encode({ results => \@results }), "\n" if $opt{json};
682        return $EXIT_OK;
683
299
299
299
130224
264
2533
}
684
685# _print_runs
686# Purpose:     the text form of one repo's run log.
687# Entry:       $runs is from Client->log.
688# Exit:        returns 1.
689# Side effects: prints one line per run (and its warnings).  A failed or
690#              lock-refused attempt has no counts worth printing: its
691#              message explains it.  Entries older than the byte counters
692#              keep the shorter line.
693sub _print_runs :Private {
694        my ($name, $runs) = @_;
695
696        return _say('cli.log.none', { repo => $name }) unless @{$runs};
697
698        for my $run (@{$runs}) {
699                my %line = (repo => $name, ts => format_utc($run->{ts}), exit => $run->{exit} || 0);
700
701                if (defined $run->{error} && length $run->{error}) {
702                        (my $text = $run->{error}) =~ s/\s+/ /g;
703                        _say('cli.log.error', { %line, message => $text });
704                        next;
705                }
706
707                my $summary = $run->{summary} || {};
708                _say('cli.log.run', {
709                        %line,
710                        (map { $_ => $summary->{$_} || 0 } qw(pulled pushed deleted conflicts)),
711                        skipped  => $summary->{skipped} ? message('cli.log.skipped', { count => $summary->{skipped} }) : '',
712                        transfer => (!$run->{dry_run} && defined $summary->{bytes_sent}) ? ', ' . _transfer_report($summary) : '',
713                        dry      => $run->{dry_run} ? message('cli.log.dry_tag') : '',
714                });
715                _print_warnings($run->{warnings});
716        }
717
718        return 1;
719
299
299
299
133012
272
2607
}
720
721# _client_settings
722# Purpose:     filesync settings: effective settings and where each came from.
723# Entry:       @args are settings's options.
724# Exit:        returns 0.
725# Side effects: reads the settings and the client configuration; prints.
726sub _client_settings :Private {
727        my (@args) = @_;
728
729        my %opt;
730        _options(\@args, { json => \$opt{json}, 'config=s' => \$opt{config} }, 'settings');
731        _no_more(\@args, 'settings');
732
733        my $report = App::FileSync::Settings::explain();
734        my $client_file = (defined $opt{config} && length $opt{config}) ? $opt{config} : App::FileSync::Config::client_config_path();
735        $report->{config_file} = $client_file;
736        $report->{repos} = App::FileSync::Settings::explain_repos(
737                config      => App::FileSync::Config::load_client($opt{config}),
738                report      => $report,
739                config_file => $client_file,
740        );
741
742        if ($opt{json}) {
743                print json_encode($report), "\n";
744                return $EXIT_OK;
745        }
746
747        my $file = $report->{settings_file};
748        _say('cli.settings.file', { file => (defined $file && length $file) ? $file : message('cli.settings.no_file') });
749        print "\n";
750        _say('cli.settings.row', { key => $_->{key}, value => _display_setting($_), source => _describe_source($_) })
751                for @{ $report->{settings} };
752        print "\n";
753        _say('cli.settings.note');
754
755        my @repos = @{ $report->{repos} || [] };
756        return $EXIT_OK unless @repos;
757
758        print "\n";
759        _say('cli.settings.repos');
760        for my $repo (@repos) {
761                _say('cli.settings.repo', { %{$repo}, server => defined $repo->{server} ? ", $repo->{server}" : '' });
762                unless (defined $repo->{ssh}) {
763                        _say('cli.settings.local');
764                        next;
765                }
766                _say('cli.settings.repo_row', { key => $_->{key}, value => _display_setting($_), source => _describe_repo_source($_) })
767                        for @{ $repo->{ssh} };
768        }
769
770        return $EXIT_OK;
771
299
299
299
152109
272
2587
}
772
773# _describe_repo_source / _describe_source / _display_setting
774# Purpose:     the text columns of "filesync settings".
775# Entry:       $row is a row from Settings::explain or explain_repos.
776# Exit:        returns the text.
777# Side effects: none.  Port and host-key checking have no process-wide
778#              fallback, so their rows say [repo only]; a blank value that
779#              means "the transport's default" is named rather than shown
780#              as an empty column.
781sub _describe_repo_source :Private {
782        my ($row) = @_;
783
784        my $description = message("cli.repo_source.$row->{source}", $row);
785        return $row->{repo_only} ? message('cli.source.repo_only', { description => $description }) : $description;
786
299
299
299
101572
282
2343
}
787
788sub _describe_source :Private {
789        my ($row) = @_;
790
791        # Config::Abstraction reports file-like sources under several names.
792        my $source = $row->{source} =~ /\A(?:default|merged|env)\z/ ? $row->{source} : 'file';
793        return message("cli.source.$source", $row);
794
299
299
299
106414
290
2516
}
795
796sub _display_setting :Private {
797        my ($row) = @_;
798
799        my $value = $row->{value};
800        my $blank = $BLANK_SETTING{ $row->{key} };
801        return (!(defined $value && length $value) && $blank) ? message($blank) : $value // '';
802
299
299
299
99354
295
2188
}
803
804# _client_verify
805# Purpose:     filesync verify: compare each repo's tree with its base.
806# Entry:       @args are verify's options.
807# Exit:        returns 4 if any repo drifted, else 0.
808# Side effects: reads the trees; prints (or JSON).
809sub _client_verify :Private {
810        my (@args) = @_;
811
812        my (@given, %opt);
813        _options(\@args, { 'repo=s@' => \@given, (map { ($_ => \$opt{$_}) } qw(deep json)), 'config=s' => \$opt{config} }, 'verify');
814        _no_more(\@args, 'verify');
815
816        my $config = App::FileSync::Config::load_client($opt{config});
817        my @reports = map { _client($config, $_)->verify(deep => $opt{deep}) } @{ _repos($config, \@given, 1) };
818
819        if ($opt{json}) {
820                print json_encode({ results => \@reports }), "\n";
821        } else {
822                _print_verify($_, 1) for @reports;
823        }
824
825        return (any { !$_->{ok} } @reports) ? $EXIT_DRIFT : $EXIT_OK;
826
299
299
299
126949
287
2482
}
827
828# _print_verify
829# Purpose:     the text form of a verify report (client or admin).
830# Entry:       $report is from Verify; $base_note says whether to mention a
831#              missing base (client only: the admin always has an index).
832# Exit:        returns 1.
833# Side effects: prints.
834sub _print_verify :Private {
835        my ($report, $base_note) = @_;
836
837        _say('cli.verify.summary', {
838                repo     => $report->{repo},
839                state    => message($report->{ok} ? 'cli.verify.clean' : 'cli.verify.drift'),
840                files    => message('word.file', { count => $report->{files} || 0 }),
841                rehashed => $report->{rehashed},
842                trusted  => $report->{trusted},
843        });
844        _say('cli.verify.no_base') if $base_note && !$report->{known};
845
846        for my $entry (@{ $report->{modified} }) {
847                _say('cli.verify.modified', { path => $entry->{p}, reason => defined $entry->{reason} ? " ($entry->{reason})" : '' });
848        }
849        _say('cli.verify.missing', { path => $_->{p} }) for @{ $report->{missing} };
850        _say('cli.verify.extra', { path => $_->{p} }) for @{ $report->{extra} };
851
852        return 1;
853
299
299
299
120288
291
2428
}
854
855# _client_restore
856# Purpose:     filesync restore: put a path back from the local trash.
857# Entry:       @args are PATH and options.
858# Exit:        returns 0.
859# Side effects: copies the version out, or lists versions.
860sub _client_restore :Private {
861        my (@args) = @_;
862
863        my %opt;
864        _options(\@args, { (map { ("$_=s" => \$opt{$_}) } qw(repo to config)), list => \$opt{list} }, 'restore');
865        my $path = _require(shift @args, 'restore', 'PATH');
866        _no_more(\@args, 'restore');
867
868        my $config = App::FileSync::Config::load_client($opt{config});
869        my $name = _one_repo($config, $opt{repo}, 'restore');
870        my $result = _client($config, $name)->restore(path => $path, to => $opt{to}, list => $opt{list});
871
872        return _print_versions($result->{versions}, 'cli.restore.no_versions', { path => $path }) if $opt{list};
873
874        _say('cli.restore.done', { path => $path, to => $result->{to} });
875        return $EXIT_OK;
876
299
299
299
117986
272
2417
}
877
878# _print_versions
879# Purpose:     list trashed versions (client or admin).
880# Entry:       $versions are Trash::version_info rows; $empty_key and
881#              $empty_args say what to print when there are none.
882# Exit:        returns 0.
883# Side effects: prints.
884sub _print_versions :Private {
885        my ($versions, $empty_key, $empty_args) = @_;
886
887        return _say($empty_key, $empty_args) && $EXIT_OK unless @{$versions};
888
889        for my $version (@{$versions}) {
890                _say('cli.restore.version', {
891                        date  => $version->{date} // '-',
892                        size  => defined $version->{size} ? _format_bytes($version->{size}) : '-',
893                        mtime => defined $version->{mtime} ? scalar(gmtime($version->{mtime})) . ' UTC' : '-',
894                        path  => $version->{path},
895                });
896        }
897
898        return $EXIT_OK;
899
299
299
299
111119
314
2364
}
900
901# _client_snapshot
902# Purpose:     filesync snapshot [create|take|list|restore].
903# Entry:       @args start with the verb, or an option (meaning create).
904# Exit:        returns the sub-command's exit code.
905# Side effects: raises cli.unknown_snapshot.
906sub _client_snapshot :Private {
907        my (@args) = @_;
908
909        my $verb = (@args && $args[0] !~ /\A-/) ? shift @args : 'create';
910        my %verbs = (create => '_client_snapshot_create', take => '_client_snapshot_create',
911                list => '_client_snapshot_list', restore => '_client_snapshot_restore');
912        my $handler = $verbs{$verb} or throw('cli.unknown_snapshot', { verb => $verb });
913
914        return __PACKAGE__->can($handler)->(@args);
915
299
299
299
105927
293
2425
}
916
917# _client_snapshot_create
918# Purpose:     take today's snapshot of a replica, pruning old ones.
919# Entry:       @args are the options.
920# Exit:        returns 0, or 2 when another run holds the lock.
921# Side effects: creates and prunes snapshots; prints.
922sub _client_snapshot_create :Private {
923        my (@args) = @_;
924
925        my %opt;
926        _options(\@args, { 'repo=s' => \$opt{repo}, 'keep=i' => \$opt{keep}, 'config=s' => \$opt{config} }, 'snapshot');
927        _no_more(\@args, 'snapshot');
928        throw('cli.positive', { command => 'snapshot', option => '--keep' }) if defined $opt{keep} && $opt{keep} < 1;
929
930        my $config = App::FileSync::Config::load_client($opt{config});
931        my $name = _one_repo($config, $opt{repo}, 'snapshot');
932        my $result = _client($config, $name)->snapshot_create(keep => $opt{keep});
933        return _warn_locked($name, $result) if ($result->{exit} || 0) == $EXIT_LOCKED;
934
935        return _say('cli.snapshot.exists', { repo => $name, date => $result->{date} }) && $EXIT_OK unless $result->{created};
936
937        _say('cli.snapshot.taken', {
938                repo  => $name,
939                date  => $result->{date},
940                files => message('word.file', { count => $result->{files} }),
941                size  => _format_bytes($result->{bytes}),
942                path  => $result->{path},
943        });
944
945        my @pruned = @{ $result->{pruned} || [] };
946        _say('cli.snapshot.pruned', { repo => $name, count => scalar @pruned, kept => scalar @{ $result->{older} || [] }, dates => "@pruned" })
947                if @pruned;
948
949        return $EXIT_OK;
950
299
299
299
140155
269
2475
}
951
952# _client_snapshot_list
953# Purpose:     list a replica's snapshots.
954# Entry:       @args are the options.
955# Exit:        returns 0.
956# Side effects: prints.
957sub _client_snapshot_list :Private {
958        my (@args) = @_;
959
960        my %opt;
961        _options(\@args, { 'repo=s' => \$opt{repo}, 'config=s' => \$opt{config} }, 'snapshot_list');
962        _no_more(\@args, 'snapshot list');
963
964        my $config = App::FileSync::Config::load_client($opt{config});
965        my $name = _one_repo($config, $opt{repo}, 'snapshot list');
966        my $snapshots = _client($config, $name)->snapshot_list()->{snapshots};
967
968        return _say('cli.snapshot.none', { repo => $name }) && $EXIT_OK unless @{$snapshots};
969
970        _say('cli.snapshot.header', { map { $_ => message("cli.snapshot.column.$_") } qw(date files size path) });
971        _say('cli.snapshot.row', { %{$_}, size => _format_bytes($_->{bytes}) }) for @{$snapshots};
972        return $EXIT_OK;
973
299
299
299
128710
321
2415
}
974
975# _client_snapshot_restore
976# Purpose:     copy a snapshot (or one path) back.
977# Entry:       @args are DATE [PATH] and options.
978# Exit:        returns 0, or 2 when another run holds the lock.
979# Side effects: replaces files; prints, with a reminder that a replica is
980#              mirrored again on its next sync.
981sub _client_snapshot_restore :Private {
982        my (@args) = @_;
983
984        my %opt;
985        _options(\@args, { map { ("$_=s" => \$opt{$_}) } qw(repo to config) }, 'snapshot_restore');
986        my $date = _require(shift @args, 'snapshot restore', 'DATE');
987        my $path = shift @args;
988        _no_more(\@args, 'snapshot restore');
989
990        my $config = App::FileSync::Config::load_client($opt{config});
991        my $name = _one_repo($config, $opt{repo}, 'snapshot restore');
992        my $result = _client($config, $name)->snapshot_restore(date => $date, path => $path, to => $opt{to});
993        return _warn_locked($name, $result) if ($result->{exit} || 0) == $EXIT_LOCKED;
994
995        _say('cli.snapshot.restored', {
996                repo  => $name,
997                what  => @{ $result->{paths} } ? "@{ $result->{paths} }" : message('cli.snapshot.whole_tree'),
998                date  => $result->{date},
999                files => message('word.file', { count => $result->{files} }),
1000                size  => _format_bytes($result->{bytes}),
1001                to    => $result->{to},
1002        });
1003        _say('cli.snapshot.into_root') if $result->{into_root};
1004
1005        return $EXIT_OK;
1006
299
299
299
134933
276
2417
}
1007
1008# _warn_locked
1009# Purpose:     report a lock refusal from a snapshot command.
1010# Entry:       $result has error.
1011# Exit:        returns 2.
1012# Side effects: logs a warning.
1013sub _warn_locked :Private {
1014        my ($name, $result) = @_;
1015
1016        App::FileSync::Settings::logger()->warn(message('cli.repo_error', { repo => $name, error => $result->{error} }));
1017        return $EXIT_LOCKED;
1018
299
299
299
107665
313
2299
}
1019
1020# ------------------------------------------------------------ formatting
1021
1022# _format_bytes
1023# Purpose:     a byte count for people: B, kB, MB or GB with one decimal.
1024# Entry:       $bytes may be undef (shown as 0).
1025# Exit:        returns the text.
1026# Side effects: none.
1027sub _format_bytes :Private {
1028        my ($bytes) = @_;
1029
1030        $bytes //= 0;
1031        my $unit = first { $bytes >= $_->[0] } @SIZE_UNITS;
1032        return $unit
1033                ? message('cli.size.scaled', { value => $bytes / $unit->[0], unit => $unit->[1] })
1034                : message('cli.size.bytes', { value => $bytes });
1035
299
299
299
107392
293
2301
}
1036
1037# _bytes_exact
1038# Purpose:     an exact byte count with thousands separators.
1039# Entry:       $bytes may be undef or junk (shown as 0).
1040# Exit:        returns the text.
1041# Side effects: none.  Transfer accounting is exact: these bytes are what
1042#              the peer actually read, so rounding them would defeat it.
1043sub _bytes_exact :Private {
1044        my ($bytes) = @_;
1045
1046        $bytes = 0 unless defined $bytes && $bytes =~ /\A\d+\z/;
1047        1 while $bytes =~ s/(\d)(\d{3})(?!\d)/$1,$2/;
1048        return message('cli.size.exact', { value => $bytes });
1049
299
299
299
115449
283
2589
}
1050
1051# _transfer_report
1052# Purpose:     one line of per-run accounting.
1053# Entry:       $summary has bytes_sent, bytes_received, delta_pulled,
1054#              delta_pushed.
1055# Exit:        returns the text: bytes each way, then how many files moved
1056#              as a delta rather than whole.
1057# Side effects: none.
1058sub _transfer_report :Private {
1059        my ($summary) = @_;
1060
1061        my %delta = map { $_ => $summary->{"delta_$_"} || 0 } qw(pulled pushed);
1062        my @parts = map { message("cli.transfer.$_", { count => $delta{$_} }) } grep { $delta{$_} } qw(pulled pushed);
1063
1064        return message('cli.transfer.report', {
1065                sent     => _bytes_exact($summary->{bytes_sent}),
1066                received => _bytes_exact($summary->{bytes_received}),
1067                files    => message('word.file', { count => $delta{pulled} + $delta{pushed} }),
1068                detail   => @parts ? ' (' . join(', ', @parts) . ')' : '',
1069        });
1070
299
299
299
124677
337
2561
}
1071
1072# _check_exits / _check_window
1073# Purpose:     validate log filters before anything is read.
1074# Entry:       exit codes; since and until (maybe undef).
1075# Exit:        returns 1.
1076# Side effects: raises cli.exit_range or when.bad.
1077sub _check_exits :Private {
1078        my ($exits) = @_;
1079
1080        throw('cli.exit_range', { max => $EXIT_MAX }) if any { $_ < 0 || $_ > $EXIT_MAX } @{$exits};
1081        return 1;
1082
299
299
299
110093
329
2332
}
1083
1084sub _check_window :Private {
1085        my ($since, $until) = @_;
1086
1087        parse_since($since) if defined $since;
1088        parse_until($until) if defined $until;
1089        return 1;
1090
299
299
299
100252
273
2482
}
1091
1092# _default_client_id
1093# Purpose:     a client id derived from the host name.
1094# Entry:       none.
1095# Exit:        returns a valid client id: the short host name, lower-cased,
1096#              with anything else replaced by '-', starting with a letter
1097#              or digit and at most 64 characters; "client" if nothing is
1098#              left.
1099# Side effects: none.
1100sub _default_client_id :Private {
1101        my $name = lc Sys::Hostname::hostname();
1102        $name =~ s/\..*//s;
1103        $name =~ s/[^a-z0-9._-]+/-/g;
1104        $name =~ s/\A[^a-z0-9]+//;
1105        $name = substr($name, 0, $MAX_ID_LENGTH);
1106        $name =~ s/-+\z//;
1107
1108        return length $name ? $name : $ROLE_CLIENT;
1109
299
299
299
119760
284
2539
}
1110
1111# ------------------------------------------------------------------- admin
1112
1113# _admin_dispatch
1114# Purpose:     filesync-admin: parse --root, then run the command.
1115# Entry:       @args is the command line.
1116# Exit:        returns the command's exit code.
1117# Side effects: raises cli.admin.* for an unknown command or verb.
1118sub _admin_dispatch :Private {
1119        my (@args) = @_;
1120
1121        my $root = $ENV{FILESYNC_ROOT};
1122        while (@args && $args[0] =~ /\A--root(?:=(.*))?\z/s) {
1123                shift @args;
1124                $root = defined $1 ? $1 : shift @args;
1125                throw('cli.admin.root_value') unless defined $root;
1126        }
1127
1128        my $group = shift(@args) // 'help';
1129        if ($group eq 'help' || $group eq '--help') {
1130                print message('cli.help.admin');
1131                return $EXIT_OK;
1132        }
1133
1134        my $admin = App::FileSync::Admin->new(root => $root);
1135        my $entry = $ADMIN_COMMANDS{$group} or throw('cli.unknown_command', { command => $group, program => 'filesync-admin' });
1136
1137        unless (ref $entry) {
1138                return __PACKAGE__->can($entry)->($admin, @args);
1139        }
1140
1141        my $verb = shift(@args) // '';
1142        my $handler = $entry->{$verb} or throw('cli.admin.unknown_verb', { group => $group, verb => $verb });
1143        return __PACKAGE__->can($handler)->($admin, @args);
1144
299
299
299
139384
302
2610
}
1145
1146# _admin_repo_create / _admin_repo_list / _admin_repo_show
1147# Purpose:     filesync-admin repo create|list|show.
1148# Entry:       $admin, then the command's arguments.
1149# Exit:        returns 0.
1150# Side effects: create makes the repo; all print.
1151sub _admin_repo_create :Private {
1152        my ($admin, @args) = @_;
1153
1154        my (%opt, @ignore);
1155        _options(\@args, {
1156                (map { ("$_=i" => \$opt{$_}) } qw(trash-days max-deletes max-delete-percent)),
1157                'ignore=s' => \@ignore,
1158        }, 'repo_create');
1159        my $name = _require(shift @args, 'repo create', 'NAME');
1160        _no_more(\@args, 'repo create');
1161
1162        my $result = $admin->repo_create(
1163                name               => $name,
1164                trash_days         => $opt{'trash-days'},
1165                max_deletes        => $opt{'max-deletes'},
1166                max_delete_percent => $opt{'max-delete-percent'},
1167                ignore             => \@ignore,
1168        );
1169
1170        _say("cli.repo.created.$_", { %{$result}, repo => $result->{name} }) for qw(name master config);
1171        return $EXIT_OK;
1172
299
299
299
129613
281
2558
}
1173
1174sub _admin_repo_list :Private {
1175        my ($admin) = @_;
1176
1177        my $repos = $admin->repo_list();
1178        return _say('cli.repo.none', { root => $admin->root }) && $EXIT_OK unless @{$repos};
1179
1180        print "$_\n" for @{$repos};
1181        return $EXIT_OK;
1182
299
299
299
113973
293
2420
}
1183
1184sub _admin_repo_show :Private {
1185        my ($admin, @args) = @_;
1186
1187        my $info = $admin->repo_show(_require(shift @args, 'repo show', 'NAME'));
1188        my $config = $info->{config};
1189        _say('cli.repo.show', {
1190                %{$config},
1191                master  => $info->{master},
1192                meta    => $info->{meta},
1193                clients => @{ $info->{clients} } ? join(', ', @{ $info->{clients} }) : message('cli.repo.no_clients'),
1194        });
1195
1196        return $EXIT_OK;
1197
299
299
299
116983
274
2404
}
1198
1199# _admin_log
1200# Purpose:     filesync-admin log: journal events for one or more repos.
1201# Entry:       $admin, then NAME... and options.
1202# Exit:        returns 0.
1203# Side effects: reads journals; prints (or JSON).  Every name is checked
1204#              before anything is printed, so text mode never shows a
1205#              partial answer before failing on a later repo.
1206sub _admin_log :Private {
1207        my ($admin, @args) = @_;
1208
1209        my (@exits, %opt);
1210        _options(\@args, {
1211                'n=i'     => \$opt{limit},
1212                'exit=i@' => \@exits,
1213                (map { ("$_=s" => \$opt{$_}) } qw(client since until)),
1214                (map { ($_ => \$opt{$_}) } qw(warnings json)),
1215        }, 'admin_log');
1216        _check_exits(\@exits);
1217        _check_window(@opt{qw(since until)});
1218
1219        my @names = @args;
1220        throw('cli.required', { command => 'log', what => 'NAME' }) unless @names;
1221        throw('cli.admin.empty_name') if any { !defined $_ || !length $_ } @names;
1222        App::FileSync::Config::load_repo($admin->root, $_) for @names;
1223
1224        my $multiple = @names > 1;
1225        my @results;
1226        for my $name (@names) {
1227                my %filters = (
1228                        (defined $opt{client} && length $opt{client} ? (client => $opt{client}) : ()),
1229                        (defined $opt{since} ? (since => parse_since($opt{since})) : ()),
1230                        (defined $opt{until} ? (until => parse_until($opt{until})) : ()),
1231                        (@exits ? (exits => [ map { $_ + 0 } @exits ]) : ()),
1232                        ($opt{warnings} ? (warnings => 1) : ()),
1233                );
1234                my $events = $admin->journal_read(
1235                        repo => $name, limit => $opt{limit} // $ADMIN_LOG_LIMIT, client => $opt{client},
1236                        since => $opt{since}, until => $opt{until}, exits => \@exits, warnings => $opt{warnings},
1237                );
1238                push @results, { repo => $name, path => $admin->journal_dir($name), events => $events, %filters };
1239                next if $opt{json};
1240
1241                # With one repo the lines stand alone; with several, head each group.
1242                _say('cli.log.heading', { repo => $name }) if $multiple;
1243                _say('cli.log.no_events', { repo => $name }) unless @{$events};
1244                _say('cli.log.event', {
1245                        indent => $multiple ? '  ' : '',
1246                        ts     => format_utc($_->{ts}),
1247                        client => $_->{client} // '-',
1248                        action => $_->{action} // '?',
1249                        detail => _event_detail($_),
1250                }) for @{$events};
1251        }
1252
1253        print json_encode({ results => \@results }), "\n" if $opt{json};
1254        return $EXIT_OK;
1255
299
299
299
171018
357
2655
}
1256
1257# _event_detail
1258# Purpose:     the free-form tail of a journal line.
1259# Entry:       $event is a journal event.
1260# Exit:        returns the text: path, key=value fields, counters, flags,
1261#              then the error with its white space flattened.
1262# Side effects: none.
1263sub _event_detail :Private {
1264        my ($event) = @_;
1265
1266        my @detail = grep { defined } $event->{path};
1267        push @detail, map { ($EVENT_LABEL{$_} // $_) . "=$event->{$_}" } grep { defined $event->{$_} } @EVENT_FIELDS, @EVENT_COUNTERS;
1268        push @detail, 'dry-run' if $event->{dry_run};
1269        push @detail, 'locked' if $event->{locked};
1270
1271        if (defined $event->{error} && length $event->{error}) {
1272                (my $text = $event->{error}) =~ s/\s+/ /g;
1273                push @detail, $text;
1274        }
1275
1276        return join(' ', @detail);
1277
299
299
299
134083
305
2589
}
1278
1279# _admin_reindex
1280# Purpose:     filesync-admin reindex: rebuild the master index.
1281# Entry:       $admin, then NAME and options.
1282# Exit:        returns 0.
1283# Side effects: rewrites the index (unless --dry-run); prints (or JSON).
1284sub _admin_reindex :Private {
1285        my ($admin, @args) = @_;
1286
1287        my %opt;
1288        _options(\@args, { (map { ($_ => \$opt{$_}) } qw(dry-run json)) }, 'reindex');
1289        my $name = _require(shift @args, 'reindex', 'NAME');
1290        _no_more(\@args, 'reindex');
1291
1292        my $result = $admin->reindex(repo => $name, dry_run => $opt{'dry-run'});
1293        if ($opt{json}) {
1294                print json_encode($result), "\n";
1295                return $EXIT_OK;
1296        }
1297
1298        _say($opt{'dry-run'} ? 'cli.reindex.would' : 'cli.reindex.done', {
1299                repo  => $name,
1300                files => message('word.file', { count => $result->{files} }),
1301                dirs  => message('word.empty_dir', { count => $result->{dirs} }),
1302                size  => _format_bytes($result->{bytes}),
1303        });
1304        _say('cli.reindex.skipped', { path => $_, reason => $result->{skipped}{$_} }) for sort keys %{ $result->{skipped} || {} };
1305
1306        return $EXIT_OK;
1307
299
299
299
131619
321
2545
}
1308
1309# _admin_verify
1310# Purpose:     filesync-admin verify: rehash the master against its index.
1311# Entry:       $admin, then NAME and options.
1312# Exit:        returns 4 on drift, else 0.
1313# Side effects: reads the master; prints (or JSON).
1314sub _admin_verify :Private {
1315        my ($admin, @args) = @_;
1316
1317        my %opt;
1318        _options(\@args, { deep => \$opt{deep}, 'sample=i' => \$opt{sample}, json => \$opt{json} }, 'admin_verify');
1319        my $name = _require(shift @args, 'verify', 'NAME');
1320        _no_more(\@args, 'verify');
1321        throw('cli.positive', { command => 'verify', option => '--sample' }) if defined $opt{sample} && $opt{sample} < 1;
1322
1323        my $report = $admin->verify(repo => $name, deep => $opt{deep}, sample => $opt{sample});
1324        $opt{json} ? print(json_encode($report), "\n") : _print_verify($report, 0);
1325
1326        return $report->{ok} ? $EXIT_OK : $EXIT_DRIFT;
1327
299
299
299
129493
317
2455
}
1328
1329# _admin_restore
1330# Purpose:     filesync-admin restore: put a path back from the server trash.
1331# Entry:       $admin, then NAME PATH and options.
1332# Exit:        returns 0.
1333# Side effects: restores into the master or --to; or lists versions.
1334sub _admin_restore :Private {
1335        my ($admin, @args) = @_;
1336
1337        my %opt;
1338        _options(\@args, { 'to=s' => \$opt{to}, list => \$opt{list}, 'date=s' => \$opt{date} }, 'admin_restore');
1339        my ($name, $path) = splice(@args, 0, 2);
1340        throw('cli.required', { command => 'restore', what => 'NAME and PATH' })
1341                unless defined $name && length $name && defined $path && length $path;
1342        _no_more(\@args, 'restore');
1343
1344        my $result = $admin->restore(repo => $name, path => $path, %opt);
1345        return _print_versions($result->{versions}, 'cli.restore.no_versions_in', { path => $path, repo => $name }) if $opt{list};
1346
1347        _say('cli.restore.admin_done', {
1348                repo => $name,
1349                path => $path,
1350                from => $result->{date} // message('cli.restore.the_trash'),
1351                to   => $result->{to},
1352        });
1353        return $EXIT_OK;
1354
299
299
299
126430
283
2416
}
1355
1356# _admin_client_allow / _admin_client_list / _admin_client_forget
1357# Purpose:     filesync-admin client allow|list|forget.
1358# Entry:       $admin, then the command's arguments.
1359# Exit:        returns 0.
1360# Side effects: allow and forget change the repo; all print.
1361sub _admin_client_allow :Private {
1362        my ($admin, @args) = @_;
1363
1364        my %opt;
1365        _options(\@args, { 'repo=s' => \$opt{repo}, 'role=s' => \$opt{role} }, 'client_allow');
1366        my $client = _require(shift @args, 'client allow', 'ID');
1367        my $repo = _require($opt{repo}, 'client allow', '--repo');
1368
1369        my $result = $admin->client_allow(repo => $repo, client => $client, role => $opt{role});
1370        _say('cli.client.allowed', { %{$result}, repo => $repo });
1371        return $EXIT_OK;
1372
299
299
299
121332
309
2344
}
1373
1374sub _admin_client_list :Private {
1375        my ($admin, @args) = @_;
1376
1377        my %opt;
1378        _options(\@args, { 'repo=s' => \$opt{repo} }, 'client_list');
1379        my $repo = _require($opt{repo}, 'client list', '--repo');
1380
1381        my $clients = $admin->client_list($repo);
1382        return _say('cli.client.none', { repo => $repo }) && $EXIT_OK unless @{$clients};
1383
1384        _say('cli.client.row', { %{$_}, state => message($_->{base} ? 'cli.client.synced' : 'cli.client.never') }) for @{$clients};
1385        return $EXIT_OK;
1386
299
299
299
129929
296
2369
}
1387
1388sub _admin_client_forget :Private {
1389        my ($admin, @args) = @_;
1390
1391        my %opt;
1392        _options(\@args, { 'repo=s' => \$opt{repo} }, 'client_forget');
1393        my $repo = _require($opt{repo}, 'client forget', '--repo');
1394        my $client = _require(shift @args, 'client forget', 'ID');
1395
1396        my $result = $admin->client_forget(repo => $repo, client => $client);
1397        _say($result->{removed} ? 'cli.client.forgot' : 'cli.client.nothing', { client => $client, path => $result->{path} });
1398        return $EXIT_OK;
1399
299
299
299
122315
326
2349
}
1400
14011;
1402