File Coverage

File:blib/lib/App/FileSync/Config.pm
Coverage:89.9%

linestmtbrancondsubtimecode
1package App::FileSync::Config;
2
3# Where configuration lives and what it holds: the client's repo list in
4# ~/.filesync/config.json, and each repo's policy under the server root.
5
6
314
314
314
314
765
261
4232
use App::FileSync::Platform;
7
8
314
314
314
314
538
237
2490
use strict;
9
314
314
314
314
423
226
5818
use warnings;
10
314
314
314
314
496
235
624
use autodie qw(:all);
11
12
314
314
314
314
662252
287
3645
use File::Spec;
13
314
314
314
314
510
263
3771
use JSON::PP ();
14
314
314
314
314
461
246
960
use Sub::Private { mode => 'enforce' };
15
16
314
314
314
314
30438
265
7673
use App::FileSync qw(json_encode json_decode read_text write_atomic);
17
314
314
314
314
576
252
5634
use App::FileSync::Args qw(positional);
18
314
20254
use App::FileSync::Constants qw(
19        $ROOT_MARKER $TEMP_PREFIX $SNAPSHOT_DIR
20        $TRASH_DAYS $MAX_DELETES $MAX_DELETE_PERCENT
21
314
314
314
507
224
);
22
314
314
314
314
633
271
6822
use App::FileSync::I18N qw(throw strip_location);
23
314
314
314
314
562
247
4931
use App::FileSync::IO qw(ensure_dir);
24
25
314
314
314
314
467
243
862
use version; our $VERSION = version->declare('0.001.1');
26
27# Patterns that must never enter a manifest; they are excluded on both sides.
28our @DEFAULT_IGNORE = (
29        $ROOT_MARKER,
30        "$TEMP_PREFIX*",
31        $SNAPSHOT_DIR,
32        '*.swp',
33        '*~',
34        '.#*',
35        '#*#',
36        '.DS_Store',
37        '._*',
38        'Thumbs.db',
39        'desktop.ini',
40        '*.crdownload',
41        '*.part',
42);
43
44# Schemas for the positional entry points.
45my %PATH_RULE = (type => 'string', min => 1);
46my %ROOT_REPO = (root => {%PATH_RULE}, repo => {%PATH_RULE});
47
48=encoding utf8
49
50 - 112
=head1 NAME

App::FileSync::Config - client and repo configuration files

=head1 SYNOPSIS

        my $client = App::FileSync::Config::load_client();
        $client->{repos}{docs}{root} = '/home/foo/Documents';
        App::FileSync::Config::save_client($client);

        my $repo = App::FileSync::Config::load_repo('/srv/filesync', 'docs');

=head1 DESCRIPTION

The client keeps one JSON file, F<~/.filesync/config.json> (or
C<FILESYNC_CONFIG>), listing its repos.  The server keeps one JSON file per
repo, F<ROOT/.filesync/repos/NAME/config.json>, holding its policy (trash
retention, deletion limits, ignore patterns) and the allowed clients.  Both are
written atomically.

=head1 FUNCTIONS

=head2 home_dir

Purpose: the client's state directory.

Args: none.

Returns: C<FILESYNC_HOME>, else F<~/.filesync> (using C<HOME>, then
C<USERPROFILE>).

Side Effects: none.

Usage:

        my $home = App::FileSync::Config::home_dir();

=head3 EXAMPLE

        print App::FileSync::Config::home_dir(), "\n";        # /home/foo/.filesync

=head3 API SPECIFICATION

=head4 INPUT

        []

=head4 OUTPUT

        { type => 'string', min => 1 }

=head3 MESSAGES

        Key                Meaning                       Resolution
        config.no_home     no home directory is known    set FILESYNC_HOME

=head3 FORMAL SPECIFICATION

        home_dir = ENV(FILESYNC_HOME)                   if non-empty
                 = (ENV(HOME) or ENV(USERPROFILE)) / ".filesync"   if one is non-empty
                 â†‘ config.no_home                        otherwise

=cut
113
114sub home_dir {
115
1066
1066
2183
        my $explicit = _env('FILESYNC_HOME');
116
1066
50
8780
        return $explicit if defined $explicit;
117
118
0
0
        my $home = _env('HOME');
119
0
0
0
        $home = _env('USERPROFILE') unless defined $home;
120
0
0
0
        throw('config.no_home') unless defined $home;
121
122
0
0
        return File::Spec->catdir($home, '.filesync');
123}
124
125 - 163
=head2 client_config_path

Purpose: where the client's repo list is stored.

Args: none.

Returns: C<FILESYNC_CONFIG>, else F<HOME_DIR/config.json>.

Side Effects: none.

Usage:

        my $path = App::FileSync::Config::client_config_path();

=head3 EXAMPLE

        local $ENV{FILESYNC_CONFIG} = '/tmp/test.json';
        print App::FileSync::Config::client_config_path(), "\n";      # /tmp/test.json

=head3 API SPECIFICATION

=head4 INPUT

        []

=head4 OUTPUT

        { type => 'string', min => 1 }

=head3 MESSAGES

        Key                Meaning                       Resolution
        config.no_home     no home directory is known    set FILESYNC_HOME

=head3 FORMAL SPECIFICATION

        client_config_path = ENV(FILESYNC_CONFIG) if non-empty, else home_dir / "config.json"

=cut
164
165sub client_config_path {
166
75
75
351
        my $explicit = _env('FILESYNC_CONFIG');
167
168
75
50
179
        return defined $explicit ? $explicit : File::Spec->catfile(home_dir(), 'config.json');
169}
170
171 - 215
=head2 default_client_config

Purpose: the configuration of a client that has no repos yet.

Args: none.

Returns: a new hashref C<{ version, ssh =E<gt> { command, extra_args }, repos =E<gt> {} }>.

Side Effects: none.

Usage:

        my $config = App::FileSync::Config::default_client_config();

=head3 EXAMPLE

        my $config = App::FileSync::Config::default_client_config();
        $config->{client_id} = 'laptop-1';

=head3 API SPECIFICATION

=head4 INPUT

        []

=head4 OUTPUT

        {
                type => 'hashref',
                schema => {
                        version => { type => 'integer' },
                        ssh     => { type => 'hashref' },
                        repos   => { type => 'hashref' },
                },
        }

=head3 MESSAGES

None.

=head3 FORMAL SPECIFICATION

        default_client_config = ⟨version ↦ 1, ssh ↦ default_ssh, repos ↦ ∅⟩

=cut
216
217sub default_client_config {
218        return {
219
75
75
395
                version => 1,
220                ssh     => _default_ssh(),
221                repos   => {},
222        };
223}
224
225 - 267
=head2 load_client

Purpose: read the client's repo list.

Args: optional C<$path> (default L</client_config_path>).

Returns: the configuration hashref; a missing file gives
L</default_client_config>.  C<repos> and C<ssh> are always hashes.

Side Effects: none.

Usage:

        my $config = App::FileSync::Config::load_client($opts{config});

=head3 EXAMPLE

        my $config = App::FileSync::Config::load_client();
        print join(', ', sort keys %{ $config->{repos} }), "\n";

=head3 API SPECIFICATION

=head4 INPUT

        [ { name => 'path', type => 'string', optional => 1 } ]

=head4 OUTPUT

        { type => 'hashref' }

=head3 MESSAGES

        Key                  Meaning                       Resolution
        config.parse         the file is not valid JSON    fix or remove it
        config.not_object    the JSON is not an object     fix or remove it
        io.read              the file cannot be read       check permissions

=head3 FORMAL SPECIFICATION

        load_client(p) = normalise(json(FS(p)))   if p ∈ dom FS
                       = default_client_config    otherwise

=cut
268
269sub load_client {
270
281
281
9493456
        my $args = positional(\@_, ['path'], { path => { type => 'string', optional => 1 } }, 'load_client');
271
281
1339
        my $path = _or_default($args->{path}, \&client_config_path);
272
273
281
50
2487
        my $config = -e $path ? _load_object($path) : default_client_config();
274
275        # Older or hand-edited files may lack either section.
276
281
50
606
        $config->{repos} = {} unless ref($config->{repos}) eq 'HASH';
277
281
100
580
        $config->{ssh} = _default_ssh() unless ref($config->{ssh}) eq 'HASH';
278
279
281
550
        return $config;
280}
281
282 - 323
=head2 save_client

Purpose: write the client's repo list.

Args: C<\%config>, optional C<$path>.

Returns: the path written.

Side Effects: replaces the file atomically, creating its directory.

Usage:

        App::FileSync::Config::save_client($config, $path);

=head3 EXAMPLE

        my $written = App::FileSync::Config::save_client(App::FileSync::Config::default_client_config());

=head3 API SPECIFICATION

=head4 INPUT

        [
                { name => 'config', type => 'hashref' },
                { name => 'path',   type => 'string', optional => 1 },
        ]

=head4 OUTPUT

        { type => 'string', min => 1 }

=head3 MESSAGES

        Key        Meaning                       Resolution
        io.write   the file cannot be written    check permissions and space

=head3 FORMAL SPECIFICATION

        Î”FS
        FS'(path) = json(config) ⁀ "\n"

=cut
324
325sub save_client {
326
82
82
2259
        my $args = positional(\@_, [qw(config path)], {
327                config => { type => 'hashref' },
328                path   => { type => 'string', optional => 1 },
329        }, 'save_client');
330
331
82
355
        my $path = _or_default($args->{path}, \&client_config_path);
332
82
203
        write_atomic($path, json_encode($args->{config}) . "\n");
333
334
82
206
        return $path;
335}
336
337 - 381
=head2 repo_meta_dir

Documented with L</repo_config_path> below.

=head2 repo_config_path

Purpose: where a repo's metadata (and its config file) lives on the server.

Args: C<$root>, C<$repo>.

Returns: F<ROOT/.filesync/repos/REPO> and F<.../config.json>.

Side Effects: none.

Usage:

        my $meta = App::FileSync::Config::repo_meta_dir($root, $repo);

=head3 EXAMPLE

        print App::FileSync::Config::repo_config_path('/srv/filesync', 'docs'), "\n";

=head3 API SPECIFICATION

=head4 INPUT

        [
                { name => 'root', type => 'string', min => 1 },
                { name => 'repo', type => 'string', min => 1 },
        ]

=head4 OUTPUT

        { type => 'string', min => 1 }

=head3 MESSAGES

None.

=head3 FORMAL SPECIFICATION

        repo_meta_dir(r, n) = r / ".filesync" / "repos" / n
        repo_config_path(r, n) = repo_meta_dir(r, n) / "config.json"

=cut
382
383sub repo_meta_dir {
384
2612
2612
2630
        my ($root, $repo) = @_;
385
386
2612
23122
        return File::Spec->catdir($root, '.filesync', 'repos', $repo);
387}
388
389sub repo_config_path {
390
645
645
1848
        my ($root, $repo) = @_;
391
392
645
1075
        return File::Spec->catfile(repo_meta_dir($root, $repo), 'config.json');
393}
394
395 - 436
=head2 default_repo_config

Purpose: the policy of a newly created repo.

Args: C<$name>.

Returns: a new hashref: 30 days of trash, at most 200 or 10% of known files
deleted per session, inline conflict copies, modes preserved, symlinks not
followed, no clients, the default ignore list.

Side Effects: none.

Usage:

        my $config = App::FileSync::Config::default_repo_config('docs');

=head3 EXAMPLE

        my $config = App::FileSync::Config::default_repo_config('photos');
        $config->{trash_days} = 90;

=head3 API SPECIFICATION

=head4 INPUT

        [ { name => 'name', type => 'string', min => 1 } ]

=head4 OUTPUT

        { type => 'hashref' }

=head3 MESSAGES

        Key            Meaning                 Resolution
        args.invalid   no name was given       pass the repo name

=head3 FORMAL SPECIFICATION

        default_repo_config(n) = ⟨name ↦ n, trash_days ↦ 30, max_deletes ↦ 200,
                                  max_delete_percent ↦ 10, clients ↦ ∅, ignore ↦ DEFAULT_IGNORE, ...⟩

=cut
437
438sub default_repo_config {
439
77
77
426
        my $args = positional(\@_, ['name'], { name => {%PATH_RULE} }, 'default_repo_config');
440
441        return {
442                version            => 1,
443                name               => $args->{name},
444
77
751
                created            => scalar(gmtime()) . ' UTC',
445                trash_days         => $TRASH_DAYS,
446                max_deletes        => $MAX_DELETES,
447                max_delete_percent => $MAX_DELETE_PERCENT,
448                conflicts          => 'inline',
449                preserve_mode      => JSON::PP::true,
450                allow_symlinks     => JSON::PP::false,
451                clients            => {},
452                ignore             => [ @DEFAULT_IGNORE ],
453        };
454}
455
456 - 501
=head2 load_repo

Purpose: read a repo's policy from the server root.

Args: C<$root>, C<$repo>.

Returns: the configuration hashref; C<ignore> is always an array and
C<clients> always a hash.

Side Effects: none.

Usage:

        my $config = App::FileSync::Config::load_repo($root, 'docs');

=head3 EXAMPLE

        my $config = App::FileSync::Config::load_repo('/srv/filesync', 'docs');
        print "$config->{trash_days} days of trash\n";

=head3 API SPECIFICATION

=head4 INPUT

        [
                { name => 'root', type => 'string', min => 1 },
                { name => 'repo', type => 'string', min => 1 },
        ]

=head4 OUTPUT

        { type => 'hashref' }

=head3 MESSAGES

        Key                 Meaning                        Resolution
        config.no_repo      no such repo under the root    filesync-admin repo create
        config.parse        the file is not valid JSON     fix it by hand
        config.not_object   the JSON is not an object      fix it by hand

=head3 FORMAL SPECIFICATION

        load_repo(r, n) = normalise(json(FS(repo_config_path(r, n))))
        pre repo_config_path(r, n) ∈ dom FS

=cut
502
503sub load_repo {
504
413
413
1740
        my $args = positional(\@_, [qw(root repo)], {%ROOT_REPO}, 'load_repo');
505
413
413
817
707
        my ($root, $repo) = @{$args}{qw(root repo)};
506
507
413
894
        my $path = repo_config_path($root, $repo);
508
413
100
3474
        throw('config.no_repo', { repo => $repo, root => $root }) unless -e $path;
509
510
411
949
        my $config = _load_object($path);
511
411
50
796
        $config->{ignore} = [ @DEFAULT_IGNORE ] unless ref($config->{ignore}) eq 'ARRAY';
512
411
50
779
        $config->{clients} = {} unless ref($config->{clients}) eq 'HASH';
513
514
411
1236
        return $config;
515}
516
517 - 563
=head2 save_repo

Purpose: write a repo's policy.

Args: C<$root>, C<$repo>, C<\%config>.

Returns: the path written.

Side Effects: creates the repo's metadata directory; replaces the file
atomically.

Usage:

        App::FileSync::Config::save_repo($root, 'docs', $config);

=head3 EXAMPLE

        my $config = App::FileSync::Config::load_repo($root, 'docs');
        $config->{trash_days} = 60;
        App::FileSync::Config::save_repo($root, 'docs', $config);

=head3 API SPECIFICATION

=head4 INPUT

        [
                { name => 'root',   type => 'string', min => 1 },
                { name => 'repo',   type => 'string', min => 1 },
                { name => 'config', type => 'hashref' },
        ]

=head4 OUTPUT

        { type => 'string', min => 1 }

=head3 MESSAGES

        Key        Meaning                       Resolution
        io.mkdir   the directory cannot be made  check permissions
        io.write   the file cannot be written    check permissions and space

=head3 FORMAL SPECIFICATION

        Î”FS
        FS'(repo_config_path(r, n)) = json(config) ⁀ "\n"

=cut
564
565sub save_repo {
566
154
154
904
        my $args = positional(\@_, [qw(root repo config)], {
567                %ROOT_REPO,
568                config => { type => 'hashref' },
569        }, 'save_repo');
570
154
154
313
235
        my ($root, $repo) = @{$args}{qw(root repo)};
571
572
154
183
        ensure_dir(repo_meta_dir($root, $repo));
573
154
201
        my $path = repo_config_path($root, $repo);
574
154
327
        write_atomic($path, json_encode($args->{config}) . "\n");
575
576
154
382
        return $path;
577}
578
579# _load_object
580# Purpose:     read a JSON file that must hold an object.
581# Entry:       $path exists.
582# Exit:        returns the decoded hashref.
583# Side effects: raises config.parse or config.not_object.
584sub _load_object :Private {
585        my ($path) = @_;
586
587        my $text = read_text($path);
588        my $data = eval { json_decode($text) };
589        throw('config.parse', { path => $path, error => strip_location($@) }) if $@;
590        throw('config.not_object', { path => $path }) unless ref($data) eq 'HASH';
591
592        return $data;
593
314
314
314
314
158543
337
4742
}
594
595# _default_ssh
596# Purpose:     the ssh section of a client config that has none.
597# Entry:       none.
598# Exit:        returns a new hashref.
599# Side effects: none.
600sub _default_ssh :Private {
601        return { command => 'ssh', extra_args => [] };
602
314
314
314
314
84606
301
2518
}
603
604# _env
605# Purpose:     an environment variable, treating empty as unset.
606# Entry:       $name is the variable's name.
607# Exit:        returns the value, or undef when unset or empty.
608# Side effects: none.
609sub _env :Private {
610        my ($name) = @_;
611
612        my $value = $ENV{$name};
613        return (defined $value && length $value) ? $value : undef;
614
314
314
314
314
82435
276
2321
}
615
616# _or_default
617# Purpose:     use a given path, or compute the default one.
618# Entry:       $given may be undef or empty; $default is a coderef.
619# Exit:        returns the path to use.
620# Side effects: whatever $default does (reads %ENV).
621sub _or_default :Private {
622        my ($given, $default) = @_;
623
624        return (defined $given && length $given) ? $given : $default->();
625
314
314
314
314
85344
280
2256
}
626
6271;
628