| File: | blib/lib/App/FileSync/CLI.pm |
| Coverage: | 99.7% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package 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. | |||||
| 40 | Readonly 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. | |||||
| 43 | Readonly my $LOCAL_TRASH_DAYS => 30; | |||||
| 44 | ||||||
| 45 | # How many journal events "filesync-admin log" shows by default. | |||||
| 46 | Readonly my $ADMIN_LOG_LIMIT => 20; | |||||
| 47 | ||||||
| 48 | # Size units for human-readable byte counts. | |||||
| 49 | Readonly my $KIB => 1024; | |||||
| 50 | Readonly my @SIZE_UNITS => ([ $KIB ** 3, 'GB' ], [ $KIB ** 2, 'MB' ], [ $KIB, 'kB' ]); | |||||
| 51 | ||||||
| 52 | # The client commands and their handlers. | |||||
| 53 | Readonly 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. | |||||
| 68 | Readonly 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. | |||||
| 79 | Readonly 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. | |||||
| 87 | Readonly my @EVENT_FIELDS => qw(from winner loser_name exit trash sha256); | |||||
| 88 | Readonly my @EVENT_COUNTERS => qw(actions deletions conflicts pulled pushed deleted); | |||||
| 89 | Readonly 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 | ||||||
| 175 | sub 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 | ||||||
| 184 | sub run_admin { | |||||
| 185 | 44 | 103 | my (@args) = @_; | |||
| 186 | ||||||
| 187 | 44 | 144 | return _run(\&_admin_dispatch, @args); | |||
| 188 | } | |||||
| 189 | ||||||
| 190 | sub 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. | |||||
| 201 | sub _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. | |||||
| 218 | sub _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. | |||||
| 236 | sub _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. | |||||
| 249 | sub _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. | |||||
| 262 | sub _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. | |||||
| 274 | sub _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. | |||||
| 286 | sub _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. | |||||
| 299 | sub _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. | |||||
| 314 | sub _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. | |||||
| 331 | sub _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. | |||||
| 346 | sub _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. | |||||
| 394 | sub _client_help :Private { | |||||
| 395 | print message('cli.help.client'); | |||||
| 396 | return $EXIT_OK; | |||||
| 397 | 299 299 299 | 88611 314 2212 | } | |||
| 398 | ||||||
| 399 | sub _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. | |||||
| 412 | sub _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. | |||||
| 499 | sub _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. | |||||
| 514 | sub _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. | |||||
| 565 | sub _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. | |||||
| 592 | sub _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. | |||||
| 604 | sub _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. | |||||
| 655 | sub _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. | |||||
| 693 | sub _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. | |||||
| 726 | sub _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. | |||||
| 781 | sub _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 | ||||||
| 788 | sub _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 | ||||||
| 796 | sub _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). | |||||
| 809 | sub _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. | |||||
| 834 | sub _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. | |||||
| 860 | sub _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. | |||||
| 884 | sub _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. | |||||
| 906 | sub _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. | |||||
| 922 | sub _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. | |||||
| 957 | sub _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. | |||||
| 981 | sub _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. | |||||
| 1013 | sub _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. | |||||
| 1027 | sub _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. | |||||
| 1043 | sub _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. | |||||
| 1058 | sub _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. | |||||
| 1077 | sub _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 | ||||||
| 1084 | sub _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. | |||||
| 1100 | sub _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. | |||||
| 1118 | sub _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. | |||||
| 1151 | sub _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 | ||||||
| 1174 | sub _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 | ||||||
| 1184 | sub _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. | |||||
| 1206 | sub _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. | |||||
| 1263 | sub _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). | |||||
| 1284 | sub _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). | |||||
| 1314 | sub _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. | |||||
| 1334 | sub _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. | |||||
| 1361 | sub _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 | ||||||
| 1374 | sub _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 | ||||||
| 1388 | sub _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 | ||||||
| 1401 | 1; | |||||
| 1402 | ||||||