lib/App/FileSync.pm

        start → end → jump
        

    1: package App::FileSync;
    2: 
    3: # The pieces shared by the client, the server and the admin tools:
    4: # byte-transparent JSON, path and id validation, conflict-copy naming, date
    5: # parsing and (re-exported from App::FileSync::IO) atomic file writes.
    6: 
    7: use App::FileSync::Platform;
    8: 
    9: use strict;
   10: use warnings;
   11: use autodie qw(:all);
   12: use feature 'current_sub';
   13: 
   14: use Exporter qw(import);
   15: use JSON::PP ();
   16: use Readonly;
   17: use Sub::Private { mode => 'enforce' };
   18: use Time::Local ();
   19: 
   20: use App::FileSync::Constants qw($MAX_ID_LENGTH $SECONDS_PER_DAY);
   21: use App::FileSync::I18N qw(message throw);
   22: use App::FileSync::IO qw(write_atomic read_text set_mtime);
   23: 
   24: use version; our $VERSION = version->declare('0.001.1');
   25: 
   26: our @EXPORT_OK = qw(
   27: 	json_encode json_decode
  Mutants (Total: 2, Killed: 2, Survived: 0)
   28: 	validate_relpath validate_repo_name validate_client_id
   29: 	conflict_name name_with_suffix split_name
   30: 	format_utc parse_since parse_until
   31: 	write_atomic read_text set_mtime
   32: );
  Mutants (Total: 2, Killed: 2, Survived: 0)
   33: 
   34: # Limits on paths as they travel on the wire.  Package variables rather than
   35: # Readonly because they document the protocol and tests read them.
   36: our $MAX_PATH_BYTES      = 4096;
   37: our $MAX_COMPONENT_BYTES = 255;
   38: 
   39: # A conflict-copy name is kept this far inside the common 255-byte limit, and
   40: # never trims the original stem below the minimum.
   41: Readonly my $CONFLICT_NAME_BYTES => 200;
  Mutants (Total: 1, Killed: 1, Survived: 0)
   42: Readonly my $MIN_STEM_BYTES      => 16;
   43: 
   44: # The alphabet of a repo or client id: it becomes a directory name.
   45: Readonly my $ID_PATTERN => qr/\A[A-Za-z0-9][A-Za-z0-9._-]*\z/;
   46: 
   47: # What an unusable client id is replaced with in a conflict-copy name.
   48: Readonly my $UNKNOWN_CLIENT => 'unknown';
   49: 

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_49_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_49_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
   50: # Deliberately utf8(0): paths are byte strings on the wire, and both ends of the
   51: # protocol are this implementation.
   52: my $JSON = JSON::PP->new->canonical->allow_nonref;
   53: 
   54: # JSON::PP returns UTF8-flagged strings even though paths are byte strings on
   55: # disk.  Left alone, the flag makes -e/stat encode the name a second time and
   56: # every non-ASCII file "disappears".  This downgrades back to the original
   57: # bytes; only a genuine wide-character string is encoded as UTF-8.
   58: #
   59: # A lexical coderef rather than a named sub: it runs once per JSON value (six
  Mutants (Total: 2, Killed: 2, Survived: 0)
   60: # times per manifest entry), and the Sub::Private enforce wrapper would cost
   61: # more than the work.  Being lexical, nothing outside this file can reach it.
   62: my $to_bytes = sub {
   63: 	# Work through @_ aliases: copying the scalar would rewrite the copy only.
   64: 	if (ref($_[0]) eq 'HASH') {
   65: 		__SUB__->($_) for values %{ $_[0] };
   66: 	} elsif (ref($_[0]) eq 'ARRAY') {
   67: 		__SUB__->($_) for @{ $_[0] };
   68: 	} elsif (defined($_[0]) && !ref($_[0]) && utf8::is_utf8($_[0])) {

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_68_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_68_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
   69: 		utf8::encode($_[0]) unless utf8::downgrade($_[0], 1);
   70: 	}

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_70_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_70_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
   71: 	return 1;
   72: };
   73: 
   74: =encoding utf8
   75: 
   76: =head1 NAME
   77: 
   78: App::FileSync - cron-driven file synchronisation without a daemon

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_78_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_78_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
   79: 
   80: =head1 VERSION
   81: 
   82: 0.001.1
   83: 
   84: =head1 SYNOPSIS
   85: 
   86: 	filesync init --repo documents --root ~/Documents \
   87: 		--transport local --server-root /srv/filesync --remote-repo documents
   88: 	filesync sync --repo documents --dry-run
   89: 	filesync sync --repo documents
   90: 
   91: =head1 DESCRIPTION
   92: 
   93: App::FileSync keeps one directory per client in step with a master copy on a server, and
   94: keeps a separate machine holding a replica of that master.  Every run is a short-lived CLI
   95: process suitable for cron or the Windows Task Scheduler: there is no daemon, no database
   96: and no web interface.
   97: 
   98: Only files whose content changed are transferred.  Data frames are deflated when that
   99: makes them smaller, and files of at least 64 KiB are sent as rsync-style block deltas
  100: when the other side already holds an older copy, so an edit moves the changed blocks
  101: rather than the whole file.  C<filesync sync --no-delta> forces whole files.  Each run
  102: reports the payload bytes it sent and received and how many files moved as a delta, and
  103: C<filesync log> repeats those figures for past runs.
  104: 
  105: Every message the tools print is looked up in a catalogue
  106: (L<App::FileSync::I18N>), so a translation is one new catalogue.

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_106_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_106_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  107: 
  108: This module holds the pieces shared by the client, the server and the admin tools:
  109: byte-transparent JSON, path validation, conflict-copy naming and atomic file writes.
  110: 
  111: =head1 FUNCTIONS
  112: 
  113: =head2 json_encode
  114: 
  115: Purpose: encode a structure as one line of canonical JSON.
  116: 
  117: Args: C<$data>, any JSON-encodable value.
  118: 
  119: Returns: the JSON text, keys sorted, with no trailing newline.
  120: 
  121: Side Effects: none.
  Mutants (Total: 3, Killed: 3, Survived: 0)
  122: 
  123: Usage:
  124: 
  125: 	print {$fh} json_encode($event), "\n";
  126: 
  127: =head3 EXAMPLE
  128: 
  129: 	print json_encode({ b => 1, a => [ 'x' ] }), "\n";	# {"a":["x"],"b":1}
  130: 
  131: =head3 API SPECIFICATION
  132: 
  133: =head4 INPUT
  Mutants (Total: 3, Killed: 3, Survived: 0)
  134: 
  135: 	[ { name => 'data', type => 'scalar', optional => 1 } ]
  136: 
  137: =head4 OUTPUT
  138: 
  139: 	{ type => 'string', min => 1 }
  140: 
  141: =head3 MESSAGES
  142: 
  143: JSON::PP's own error for a value it cannot encode (a code reference, say).
  144: 
  145: =head3 FORMAL SPECIFICATION
  146: 
  147: 	json_encode : VALUE → TEXT
  Mutants (Total: 3, Killed: 3, Survived: 0)
  148: 	json_decode(json_encode(v)) = v
  149: 
  150: =cut
  151: 
  152: sub json_encode {
  153: 	my ($data) = @_;
  154: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
  155: 	return $JSON->encode($data);

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_155_28: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_155_28: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  156: }
  157: 
  158: =head2 json_decode
  159: 
  160: Purpose: decode one JSON document, keeping strings as byte strings.
  161: 
  162: Args: C<$text>.
  163: 
  164: Returns: the decoded structure.  Strings that fit in bytes are downgraded, so a
  165: path read back from JSON names the same file as the bytes it was written from.
  Mutants (Total: 1, Killed: 1, Survived: 0)
  166: 
  167: Side Effects: none.
  168: 
  169: Usage:
  170: 
  171: 	my $config = json_decode(read_text($path));
  172: 
  173: =head3 EXAMPLE
  174: 
  175: 	my $entry = json_decode('{"p":"caf\u00e9.txt"}');
  176: 	print length($entry->{p}), "\n";	# 8 (bytes), not 9
  Mutants (Total: 2, Killed: 2, Survived: 0)
  177: 
  178: =head3 API SPECIFICATION
  179: 
  180: =head4 INPUT
  181: 
  182: 	[ { name => 'text', type => 'string' } ]
  183: 
  184: =head4 OUTPUT

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_184_5: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_184_5: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  185: 
  Mutants (Total: 2, Killed: 2, Survived: 0)
  186: 	{ type => 'scalar', optional => 1 }
  187: 
  188: =head3 MESSAGES
  189: 
  190: JSON::PP's own error for malformed JSON.
  191: 
  192: =head3 FORMAL SPECIFICATION
  Mutants (Total: 2, Killed: 2, Survived: 0)
  193: 
  194: 	json_decode : TEXT ↛ VALUE
  195: 	∀ s : STRING in result • ¬ utf8_flag(s) ∨ ∃ c ∈ s • ord c > 255
  196: 
  197: =cut
  198: 
  199: sub json_decode {
  200: 	my ($text) = @_;
  201: 
  202: 	my $data = $JSON->decode($text);
  Mutants (Total: 1, Killed: 1, Survived: 0)
  203: 	$to_bytes->($data);
  204: 
  205: 	return $data;
  206: }
  207: 
  Mutants (Total: 1, Killed: 1, Survived: 0)
  208: =head2 validate_relpath
  209: 
  210: Purpose: decide whether a path is safe to join to a sync root.
  211: 
  212: Args: C<$path>, a relative path as it travels on the wire.
  213: 
  214: Returns: a two-element list C<(1, undef)> for a usable path, or
  215: C<(0, $reason)> where C<$reason> is a translated explanation.  (A list rather
  216: than a reference because every caller destructures it at once, and it is
  217: called once per path in the tree.)
  218: 
  219: Side Effects: none.

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_219_25_>: Numeric boundary flip < to >
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_219_25_<=: Numeric boundary flip < to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_219_25_>=: Numeric boundary flip < to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
  220: 

					

					
Mutants (Total: 3, Killed: 0, Survived: 3)
					

				
NUM_BOUNDARY_220_54_<: Numeric boundary flip > to <
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_220_54_>=: Numeric boundary flip > to >=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
NUM_BOUNDARY_220_54_<=: Numeric boundary flip > to <=
HIGH: Likely missing edge-case test (boundary value)

								

								
🧪 Suggested Test
								
# Boundary test suggestion
is( func(VALUE_AT_BOUNDARY), EXPECTED, 'Test boundary behaviour' );

								
							
  221: Usage:
  222: 
  223: 	my ($ok, $reason) = validate_relpath($path);
  Mutants (Total: 2, Killed: 2, Survived: 0)
  224: 
  225: =head3 EXAMPLE
  226: 
  227: 	my ($ok, $why) = validate_relpath('notes/../secret');
  228: 	print "$why\n" unless $ok;	# parent path component
  229: 
  230: =head3 API SPECIFICATION
  231: 
  232: =head4 INPUT
  233: 
  234: 	[ { name => 'path', type => 'scalar', optional => 1 } ]
  235: 
  236: =head4 OUTPUT
  237: 
  238: 	{ type => 'arrayref', min => 2, max => 2 }
  239: 
  240: =head3 MESSAGES
  241: 
  242: 	Key                       Meaning
  243: 	path.missing              no path was given
  244: 	path.not_text             the path is a reference
  245: 	path.empty                the path is empty
  246: 	path.too_long             longer than 4096 bytes
  247: 	path.absolute             starts with /
  248: 	path.drive                starts with a drive letter
  249: 	path.backslash            contains a backslash
  250: 	path.nul                  contains a NUL byte
  251: 	path.control              contains a control character
  252: 	path.empty_component      contains //, or starts or ends with /
  253: 	path.dot_component        has a . component
  254: 	path.parent_component     has a .. component
  255: 	path.component_too_long   a component is longer than 255 bytes
  256: 
  257: Resolution: rename the file on the side that holds it.
  258: 
  259: =head3 FORMAL SPECIFICATION
  260: 
  261: 	SafePath == { p : seq BYTE |
  262: 		0 < #p ≤ 4096 ∧ head p ≠ '/' ∧ ¬ drive(p) ∧
  263: 		'\' ∉ ran p ∧ ran p ∩ CONTROL = ∅ ∧
  264: 		∀ c : split('/', p) • c ∉ {⟨⟩, ".", ".."} ∧ #c ≤ 255 }
  265: 	validate_relpath(p) = (1, ⊥)        if p ∈ SafePath
  266: 	                    = (0, reason)   otherwise
  267: 
  268: =head3 PSEUDOCODE
  269: 
  270: 	reject undef, references and empty strings
  271: 	reject paths over 4096 bytes
  272: 	reject absolute, drive-relative, backslash, NUL and control characters
  273: 	for each "/"-separated component:
  274: 		reject empty, ".", ".." and components over 255 bytes
  275: 	accept
  276: 
  277: =cut
  278: 
  279: sub validate_relpath {
●280 → 297 → 309  280: 	my ($path) = @_;
  281: 
  282: 	# One key per rejection, checked in order: the first problem found is
  283: 	# the one reported.
  284: 	my $problem =
  285: 		  !defined $path                       ? 'path.missing'
  286: 		: ref $path                            ? 'path.not_text'
  287: 		: !length $path                        ? 'path.empty'
  288: 		: length($path) > $MAX_PATH_BYTES      ? 'path.too_long'
  289: 		: $path =~ m{\A/}                      ? 'path.absolute'
  290: 		: $path =~ /\A[A-Za-z]:/               ? 'path.drive'
  291: 		: $path =~ /\\/                        ? 'path.backslash'
  292: 		: $path =~ /\0/                        ? 'path.nul'
  293: 		: $path =~ /[\x01-\x1f\x7f]/           ? 'path.control'
  294: 		: undef;
  295: 
  296: 	# Components are only worth checking once the whole path is plausible.
  297: 	unless (defined $problem) {
  298: 		for my $part (split m{/}, $path, -1) {
  299: 			$problem =
  300: 				  $part eq ''                             ? 'path.empty_component'
  301: 				: $part eq '.'                            ? 'path.dot_component'
  302: 				: $part eq '..'                           ? 'path.parent_component'
  303: 				: length($part) > $MAX_COMPONENT_BYTES    ? 'path.component_too_long'
  304: 				: undef;
  305: 			last if defined $problem;
  306: 		}
  307: 	}
  308: 
  309: 	return defined $problem ? (0, message($problem)) : (1, undef);
  310: }
  311: 
  312: =head2 validate_repo_name
  313: 
  314: Documented with L</validate_client_id> below.
  315: 
  316: =head2 validate_client_id
  317: 
  318: Purpose: decide whether a repo name or client id is usable as a directory name.
  319: 
  320: Args: C<$value>.
  321: 
  322: Returns: C<(1, undef)>, or C<(0, $reason)> with a translated reason.  The
  323: alphabet is C<[A-Za-z0-9][A-Za-z0-9._-]*>, at most 64 characters.
  324: 
  325: Side Effects: none.
  326: 
  327: Usage:
  328: 
  329: 	my ($ok, $reason) = validate_client_id($id);
  330: 
  331: =head3 EXAMPLE
  332: 
  333: 	my ($ok, $why) = validate_repo_name('../etc');
  334: 	print "$why\n";	# bad repo name '../etc'
  335: 
  336: =head3 API SPECIFICATION
  337: 
  338: =head4 INPUT
  339: 
  340: 	[ { name => 'value', type => 'scalar', optional => 1 } ]
  341: 
  342: =head4 OUTPUT
  343: 
  344: 	{ type => 'arrayref', min => 2, max => 2 }
  345: 
  346: =head3 MESSAGES
  347: 
  348: 	Key           Meaning                         Resolution
  349: 	id.missing    no value was given              supply one
  350: 	id.not_text   the value is a reference        pass a string
  351: 	id.empty      the value is empty              supply one
  352: 	id.too_long   longer than 64 characters       shorten it
  353: 	id.bad        outside the allowed alphabet    use letters, digits, . _ -
  354: 
  355: =head3 FORMAL SPECIFICATION
  356: 
  357: 	Id == { s : seq CHAR | 0 < #s ≤ 64 ∧ head s ∈ ALNUM ∧ ran s ⊆ ALNUM ∪ {'.','_','-'} }
  358: 	validate(s) = (1, ⊥) if s ∈ Id, (0, reason) otherwise
  359: 
  360: =cut
  361: 
  362: sub validate_repo_name {
  363: 	my ($value) = @_;
  364: 
  365: 	return _validate_id('id.repo_name', $value);
  366: }
  367: 
  368: sub validate_client_id {
  369: 	my ($value) = @_;
  370: 
  371: 	return _validate_id('id.client_id', $value);
  372: }
  373: 
  374: # _validate_id
  375: # Purpose:     shared check for repo names and client ids.
  376: # Entry:       $what_key is the catalogue key naming the kind of id;
  377: #              $value is the candidate.
  378: # Exit:        returns (1, undef) or (0, translated reason).
  379: # Side effects: none.
  380: sub _validate_id :Private {
  381: 	my ($what_key, $value) = @_;
  382: 
  383: 	my $problem =
  384: 		  !defined $value                    ? 'id.missing'
  385: 		: ref $value                         ? 'id.not_text'
  386: 		: !length $value                     ? 'id.empty'
  387: 		: length($value) > $MAX_ID_LENGTH    ? 'id.too_long'
  388: 		: $value !~ $ID_PATTERN              ? 'id.bad'
  389: 		: undef;
  390: 
  391: 	return defined $problem
  392: 		? (0, message($problem, { what => message($what_key), value => $value }))
  393: 		: (1, undef);
  394: }
  395: 
  396: =head2 parse_since
  397: 
  398: Purpose: the start of a time window.
  399: 
  400: Args: C<$value> (C<YYYY-MM-DD> or an epoch), optional C<$option> naming the
  401: command-line option for the error message (default C<--since>).
  402: 
  403: Returns: the epoch, or C<undef> when C<$value> is undef.  A date means
  404: midnight UTC that day.
  405: 
  406: Side Effects: none.
  407: 
  408: Usage:
  409: 
  410: 	my $since = parse_since($opts{since});
  411: 
  412: =head3 EXAMPLE
  413: 
  414: 	print parse_since('2026-10-22'), "\n";	# 1792627200
  415: 
  416: =head3 API SPECIFICATION
  417: 
  418: =head4 INPUT
  419: 
  420: 	[
  421: 		{ name => 'value',  type => 'string', optional => 1 },
  422: 		{ name => 'option', type => 'string', optional => 1 },
  423: 	]
  424: 
  425: =head4 OUTPUT
  426: 
  427: 	{ type => 'integer', optional => 1, min => 0 }
  428: 
  429: =head3 MESSAGES
  430: 
  431: 	Key        Meaning                              Resolution
  432: 	when.bad   neither a date nor an epoch          use YYYY-MM-DD or digits
  433: 
  434: =head3 FORMAL SPECIFICATION
  435: 
  436: 	parse_since : (DATE ∪ ℕ ∪ {⊥}) ↛ ℕ ∪ {⊥}
  437: 	parse_since(n) = n ; parse_since(d) = midnight_utc(d) ; parse_since(⊥) = ⊥
  438: 
  439: =cut
  440: 
  441: sub parse_since {
  442: 	my ($value, $option) = @_;
  443: 
  444: 	my ($epoch) = @{ _parse_when($value, $option || '--since') };
  445: 	return $epoch;
  446: }
  447: 
  448: =head2 parse_until
  449: 
  450: Purpose: the end of a time window.
  451: 
  452: Args: as for L</parse_since> (default option name C<--until>).
  453: 
  454: Returns: the epoch, or C<undef>.  A date means the last second of that day, so
  455: C<--until 2026-10-22> includes that day's runs.
  456: 
  457: Side Effects: none.
  458: 
  459: Usage:
  460: 
  461: 	my $until = parse_until($opts{until});
  462: 
  463: =head3 EXAMPLE
  464: 
  465: 	print parse_until('2026-10-22'), "\n";	# 1792713599
  466: 
  467: =head3 API SPECIFICATION
  468: 
  469: =head4 INPUT
  470: 
  471: 	[
  472: 		{ name => 'value',  type => 'string', optional => 1 },
  473: 		{ name => 'option', type => 'string', optional => 1 },
  474: 	]
  475: 
  476: =head4 OUTPUT
  477: 
  478: 	{ type => 'integer', optional => 1, min => 0 }
  479: 
  480: =head3 MESSAGES
  481: 
  482: 	Key        Meaning                              Resolution
  483: 	when.bad   neither a date nor an epoch          use YYYY-MM-DD or digits
  484: 
  485: =head3 FORMAL SPECIFICATION
  486: 
  487: 	parse_until(n) = n ; parse_until(d) = midnight_utc(d) + 86399 ; parse_until(⊥) = ⊥
  488: 
  489: =cut
  490: 
  491: sub parse_until {
  492: 	my ($value, $option) = @_;
  493: 
  494: 	my ($epoch, $is_date) = @{ _parse_when($value, $option || '--until') };
  495: 	return (defined $epoch && $is_date) ? $epoch + $SECONDS_PER_DAY - 1 : $epoch;
  496: }
  497: 
  498: # _parse_when
  499: # Purpose:     parse "YYYY-MM-DD" or an epoch.
  500: # Entry:       $value may be undef; $option names the option for errors.
  501: # Exit:        returns [ $epoch_or_undef, $is_date ]; a date cutoff means a
  502: #              different instant at each end of a range, hence the flag.
  503: # Side effects: raises when.bad for anything else.
  504: sub _parse_when :Private {
  505: 	my ($value, $option) = @_;
  506: 
  507: 	my $parsed =
  508: 		  !defined $value                          ? [ undef, 0 ]
  509: 		: $value =~ /\A\d+\z/                      ? [ $value + 0, 0 ]
  510: 		: $value =~ /\A(\d{4})-(\d{2})-(\d{2})\z/  ? [ Time::Local::timegm(0, 0, 0, $3, $2 - 1, $1), 1 ]
  511: 		: undef;
  512: 
  513: 	throw('when.bad', { option => $option, value => $value }) unless $parsed;
  514: 	return $parsed;
  515: }
  516: 
  517: =head2 format_utc
  518: 
  519: Purpose: a compact UTC timestamp.
  520: 
  521: Args: optional C<$epoch> (default now).
  522: 
  523: Returns: C<YYYYMMDDTHHMMSSZ>.
  524: 
  525: Side Effects: none.
  526: 
  527: Usage:
  528: 
  529: 	my $stamp = format_utc($run->{ts});
  530: 
  531: =head3 EXAMPLE
  532: 
  533: 	print format_utc(0), "\n";	# 19700101T000000Z
  534: 
  535: =head3 API SPECIFICATION
  536: 
  537: =head4 INPUT
  538: 
  539: 	[ { name => 'epoch', type => 'number', optional => 1 } ]
  540: 
  541: =head4 OUTPUT
  542: 
  543: 	{ type => 'string', matches => qr/\A\d{8}T\d{6}Z\z/ }
  544: 
  545: =head3 MESSAGES
  546: 
  547: None.
  548: 
  549: =head3 FORMAL SPECIFICATION
  550: 
  551: 	format_utc : ℕ → STAMP
  552: 	format_utc(e) = yyyy mm dd 'T' HH MM SS 'Z' of gmtime(e)
  553: 
  554: =cut
  555: 
  556: sub format_utc {
  557: 	my ($epoch) = @_;
  558: 
  559: 	my @t = gmtime(defined $epoch ? $epoch : time);
  560: 	return sprintf('%04d%02d%02dT%02d%02d%02dZ',
  561: 		$t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0]);
  562: }
  563: 
  564: =head2 split_name
  565: 
  566: Purpose: split a relative path into directory, stem and extension.
  567: 
  568: Args: C<$path>.
  569: 
  570: Returns: an arrayref C<[ $dir, $stem, $ext ]>; C<$dir> has no trailing slash
  571: and is empty at the top level, C<$ext> includes its dot and is empty when there
  572: is none.  A leading dot (C<.profile>) is part of the stem.
  573: 
  574: Side Effects: none.
  575: 
  576: Usage:
  577: 
  578: 	my ($dir, $stem, $ext) = @{ split_name('a/b/report.txt') };
  579: 
  580: =head3 EXAMPLE
  581: 
  582: 	my $parts = split_name('notes/plan.v2.txt');	# ['notes', 'plan.v2', '.txt']
  583: 
  584: =head3 API SPECIFICATION
  585: 
  586: =head4 INPUT
  587: 
  588: 	[ { name => 'path', type => 'string', min => 1 } ]
  589: 
  590: =head4 OUTPUT
  591: 
  592: 	{ type => 'arrayref', min => 3, max => 3 }
  593: 
  594: =head3 MESSAGES
  595: 
  596: None.
  597: 
  598: =head3 FORMAL SPECIFICATION
  599: 
  600: 	split_name(p) = (d, s, e) where p = d ⁀ "/" ⁀ s ⁀ e ∨ (d = ⟨⟩ ∧ p = s ⁀ e)
  601: 	                e = ⟨⟩ ∨ (head e = '.' ∧ '.' ∉ ran(tail e)) ; s ≠ ⟨⟩
  602: 
  603: =cut
  604: 
  605: sub split_name {
  606: 	my ($path) = @_;
  607: 
  608: 	my ($dir, $base) = $path =~ m{\A(.*)/([^/]+)\z} ? ($1, $2) : ('', $path);
  609: 	my ($stem, $ext) = $base =~ /\A(.+)(\.[^.]+)\z/ ? ($1, $2) : ($base, '');
  610: 
  611: 	return [ $dir, $stem, $ext ];
  612: }
  613: 
  614: =head2 name_with_suffix
  615: 
  616: Purpose: make a name unique by numbering it before its extension.
  617: 
  618: Args: C<$path>, C<$suffix> (a number).
  619: 
  620: Returns: C<report-2.txt> for C<report.txt> and 2, keeping the directory.
  621: 
  622: Side Effects: none.
  623: 
  624: Usage:
  625: 
  626: 	my $candidate = name_with_suffix($loser_name, $n);
  627: 
  628: =head3 EXAMPLE
  629: 
  630: 	print name_with_suffix('a/b.txt', 3), "\n";	# a/b-3.txt
  631: 
  632: =head3 API SPECIFICATION
  633: 
  634: =head4 INPUT
  635: 
  636: 	[
  637: 		{ name => 'path',   type => 'string', min => 1 },
  638: 		{ name => 'suffix', type => 'integer', min => 1 },
  639: 	]
  640: 
  641: =head4 OUTPUT
  642: 
  643: 	{ type => 'string', min => 1 }
  644: 
  645: =head3 MESSAGES
  646: 
  647: None.
  648: 
  649: =head3 FORMAL SPECIFICATION
  650: 
  651: 	let (d, s, e) = split_name(p)
  652: 	name_with_suffix(p, n) = join(d, s ⁀ "-" ⁀ n ⁀ e)
  653: 
  654: =cut
  655: 
  656: sub name_with_suffix {
  657: 	my ($path, $suffix) = @_;
  658: 
  659: 	my ($dir, $stem, $ext) = @{ split_name($path) };
  660: 	return _join_dir($dir, "$stem-$suffix$ext");
  661: }
  662: 
  663: =head2 conflict_name
  664: 
  665: Purpose: the name a losing version is kept under.
  666: 
  667: Args: C<$path>, C<$client_id> (may be undef), C<$epoch> (default now).
  668: 
  669: Returns: the original name with C<.conflict-CLIENT-TIMESTAMP> inserted before
  670: the extension, kept within 200 bytes so it fits common filesystems.
  671: 
  672: Side Effects: none.
  673: 
  674: Usage:
  675: 
  676: 	my $name = conflict_name('notes.txt', 'laptop-1', time);
  677: 
  678: =head3 EXAMPLE
  679: 
  680: 	print conflict_name('report.txt', 'laptop-1', 1_792_664_100), "\n";
  681: 	# report.conflict-laptop-1-20261022T101500Z.txt
  682: 
  683: =head3 API SPECIFICATION
  684: 
  685: =head4 INPUT
  686: 
  687: 	[
  688: 		{ name => 'path',      type => 'string', min => 1 },
  689: 		{ name => 'client_id', type => 'string', optional => 1 },
  690: 		{ name => 'epoch',     type => 'number', optional => 1 },
  691: 	]
  692: 
  693: =head4 OUTPUT
  694: 
  695: 	{ type => 'string', min => 1 }
  696: 
  697: =head3 MESSAGES
  698: 
  699: None.
  700: 
  701: =head3 FORMAL SPECIFICATION
  702: 
  703: 	let (d, s, e) = split_name(p) ; id = sanitise(c) ; t = format_utc(when)
  704: 	let room = max(16, 200 − #(".conflict-" ⁀ id ⁀ "-" ⁀ t ⁀ e))
  705: 	conflict_name(p, c, when) = join(d, s[1..room] ⁀ ".conflict-" ⁀ id ⁀ "-" ⁀ t ⁀ e)
  706: 
  707: =cut
  708: 
  709: sub conflict_name {
  710: 	my ($path, $client_id, $epoch) = @_;
  711: 
  712: 	my ($dir, $stem, $ext) = @{ split_name($path) };
  713: 
  714: 	# The id lands in a file name, so anything outside the id alphabet is
  715: 	# flattened rather than trusted.
  716: 	my $id = defined $client_id ? $client_id : $UNKNOWN_CLIENT;
  717: 	$id =~ s/[^A-Za-z0-9._-]+/_/g;
  718: 	$id = $UNKNOWN_CLIENT unless length $id;
  719: 
  720: 	my $tail = ".conflict-$id-" . format_utc($epoch) . $ext;
  721: 
  722: 	# Keep the whole name inside the 255-byte limit of common filesystems.
  723: 	my $room = $CONFLICT_NAME_BYTES - length($tail);
  724: 	$room = $MIN_STEM_BYTES if $room < $MIN_STEM_BYTES;
  725: 	$stem = substr($stem, 0, $room) if length($stem) > $room;
  726: 
  727: 	return _join_dir($dir, $stem . $tail);
  728: }
  729: 
  730: # _join_dir
  731: # Purpose:     put a relative directory and a name back together.
  732: # Entry:       $dir may be empty (top level).
  733: # Exit:        returns "dir/name" or "name".
  734: # Side effects: none.
  735: sub _join_dir :Private {
  736: 	my ($dir, $name) = @_;
  737: 
  738: 	return length($dir) ? "$dir/$name" : $name;
  739: }
  740: 
  741: =head2 write_atomic
  742: 
  743: Documented with L</set_mtime> below.
  744: 
  745: =head2 read_text
  746: 
  747: Documented with L</set_mtime> below.
  748: 
  749: =head2 set_mtime
  750: 
  751: Re-exported from L<App::FileSync::IO>, where they are documented.
  752: 
  753: =cut
  754: 
  755: 1;
  756: 
  757: __END__
  758: 
  759: =head1 EXAMPLES
  760: 
  761: On the server, create the master copy and allow the client once.  Then, on each
  762: client, register the directory and add a cron entry that runs every minute:
  763: 
  764: 	# once, on the client
  765: 	filesync init --repo documents --root /home/foo/Documents --server srv
  766: 
  767: 	# crontab -e, for foo on each client
  768: 	* * * * * /usr/local/bin/filesync sync --repo documents --quiet >/dev/null
  769: 
  770: The summary line is dropped so cron does not mail on every successful run;
  771: diagnostics still go to standard error, so a failure is mailed.  Every attempt,
  772: successful or not, is also appended to F<~/.filesync/logs/documents.jsonl>, and
  773: C<filesync log --repo documents --exit 1> lists the ones that failed.
  774: 
  775: Windows clients use a scheduled task rather than cron.  With the script in
  776: F<C:\filesync> and Strawberry Perl installed, the same job is set up from a
  777: command prompt:
  778: 
  779: 	REM once, on the client
  780: 	C:\Strawberry\perl\bin\perl.exe C:\filesync\bin\filesync init ^
  781: 	  --repo documents --root C:\Users\foo\Documents --server srv
  782: 
  783: 	REM then create the task; it runs every minute as the current user
  784: 	schtasks /Create /SC MINUTE /MO 1 /TN FileSync /F ^
  785: 	  /TR "C:\Strawberry\perl\bin\perl.exe C:\filesync\bin\filesync sync --repo documents --quiet"
  786: 
  787: The task runs only while that user is logged on, which suits a Documents
  788: folder; its run log is still written under F<%USERPROFILE%\.filesync\logs>, so
  789: C<filesync log --repo documents --warnings> works there too.
  790: 
  791: The master copy on the server is an ordinary directory tree, so it can be
  792: mirrored to a backup directory from the same crontab:
  793: 
  794: 	# crontab -e, for foo on the server
  795: 	* * * * * rsync -a --delete --exclude '.filesync-tmp-*' \
  796: 	    /home/foo/FileSync/ /home/foo/backups/FileSync/
  797: 
  798: Filesync writes each file to a temporary name and renames it into place, so the
  799: mirror never catches a half-written upload; the exclusion keeps the temporary
  800: files themselves out of the backup.  C<--delete> makes the copy a mirror: a
  801: deletion that reaches the master also removes the backed-up file.
  802: 
  803: To restore the master from that backup, stop the client jobs (comment out their
  804: cron lines, or disable the scheduled task) and the server's backup job, so the
  805: backup job cannot copy a half-restored tree back into the backup.  Let any
  806: running sync finish, then mirror the backup back:
  807: 
  808: 	rsync -a --delete --checksum /home/foo/backups/FileSync/ /home/foo/FileSync/
  809: 
  810: C<--checksum> compares the contents, so a restored file is not skipped just
  811: because its size and modification time happen to match the newer copy.  This is
  812: a rollback rather than a merge: files created after the backup was taken
  813: disappear from the master, and the next sync propagates that to the clients, so
  814: copy anything you need to keep out of the tree first.  The server
  815: would rehash the restored files on the next session anyway, but
  816: C<filesync-admin reindex> rebuilds the index immediately, before any client
  817: reconnects; clients then pull the restored versions, merging edits they have not
  818: synced as usual.
  819: 
  820: Before re-enabling the jobs, check that the copy is exact with a read-only
  821: comparison against the backup:
  822: 
  823: 	rsync -a --delete --checksum --dry-run --itemize-changes \
  824: 	    /home/foo/backups/FileSync/ /home/foo/FileSync/
  825: 
  826: No output and exit 0 mean the master matches the backup.  Any line beginning
  827: C<< >f >> names a path that still differs, and C<*deleting> names one the
  828: rollback should have removed.  The index still describes the pre-rollback tree,
  829: so C<filesync-admin verify> may report drift at this point; that is expected.
  830: Rebuild it and check it:
  831: 
  832: 	sudo -u filesync filesync-admin reindex documents
  833: 	sudo -u filesync filesync-admin verify documents --deep
  834: 
  835: C<reindex> hashes every file in the master and replaces the index atomically; it
  836: refuses to run while a sync session holds the repo lock, and it names any paths
  837: it could not index.  C<clean> and exit 0 from C<verify> confirm that the master
  838: and its index agree.  Re-enable the jobs once that check passes.
  839: 
  840: To restore just one file or directory, copy that path back instead of mirroring
  841: the whole tree, with the jobs paused as above so nothing changes the tree while
  842: the copy runs:
  843: 
  844: 	rsync -a --checksum /home/foo/backups/FileSync/notes/plan.txt /home/foo/FileSync/notes/
  845: 	rsync -a --checksum /home/foo/backups/FileSync/photos/ /home/foo/FileSync/photos/
  846: 
  847: The trailing slash on the second source copies the directory's contents; without
  848: it rsync would put the directory itself inside the destination.  Add C<--delete>
  849: only when that directory should match the backup exactly, since it removes files
  850: created after the backup was taken.  Everything outside the restored paths is
  851: left alone; refresh the index with C<reindex> as above, or let the next session
  852: do it, and clients pull the restored versions.  Check the restored paths with the
  853: matching C<rsync --dry-run --itemize-changes> comparison before re-enabling the
  854: jobs; no output means they match the backup.
  855: 
  856: Adjust F</usr/local/bin/filesync> to where the script was installed, because
  857: cron's default PATH rarely includes a per-user Perl bin directory.
  858: 
  859: =head1 LIMITATIONS
  860: 
  861: These are the design weaknesses a reviewer should weigh before relying on the
  862: tool.  None of them loses data silently; most cost time or space.
  863: 
  864: =over 4
  865: 
  866: =item * B<One master.>  The topology is a star around one server.  The replica
  867: is a pull-only mirror, not a failover: if the server is lost, clients stop
  868: until an administrator points them at a rebuilt master.
  869: 
  870: =item * B<Every run exchanges the whole manifest.>  The client sends one entry
  871: per file and the server answers with the whole plan as a single JSON line, so
  872: a run costs O(files) in time, memory and bandwidth even when nothing changed.
  873: A tree of a million files means a plan message of the order of a hundred
  874: megabytes.  A change journal or Merkle summary would remove that, at the cost
  875: of the "everything is inspectable with cat" property.
  876: 
  877: =item * B<No line-length cap on the wire.>  Because of the previous point, a
  878: control message cannot be bounded without breaking large trees.  The peer is
  879: authenticated by ssh and pinned by the forced command, so this is a resource
  880: risk from a misbehaving client, not from the network.
  881: 
  882: =item * B<Lock-step protocol.>  One request is in flight at a time and each
  883: 256 KiB chunk waits for its acknowledgement, so throughput is bound by the
  884: round-trip time on a high-latency link.
  885: 
  886: =item * B<Clock-dependent tie-breaks.>  When both sides changed a file, the
  887: newer mtime wins (the master wins ties within 2 seconds).  A client with a
  888: wrong clock picks the wrong winner; the loser is still kept as a conflict copy.
  889: 
  890: =item * B<No fsync.>  Renames are atomic between processes but not durable
  891: across a power cut; see L<App::FileSync::IO/LIMITATIONS>.
  892: 
  893: =item * B<Pure-Perl deltas are bounded.>  Only the first 8 MiB after the
  894: unchanged prefix are scanned for moved blocks; later changes go as literals.
  895: See L<App::FileSync::Delta>.
  896: 
  897: =item * B<What is not synced.>  Symlinks, devices, sockets, extended attributes,
  898: ACLs and ownership.  Permission bits are carried only between POSIX systems.
  899: 
  900: =item * B<Names.>  Unicode normalisation is not reconciled, so the same name
  901: in NFC (Linux) and NFD (older macOS) is two different files.  A
  902: case-insensitive client cannot hold two master paths that differ only in case.
  903: 
  904: =item * B<Encapsulation costs.>  Private methods use L<Sub::Private> in
  905: C<enforce> mode, which costs about 1.4 microseconds per call (measured on
  906: 5.40).  Helpers that run per file or per JSON value (the merge comparisons,
  907: the JSON byte downgrade, the rolling checksum) are therefore lexical code
  908: references: private by scope, with no wrapper.  Both Sub::Private and
  909: L<Sub::Protected> are bypassed while C<HARNESS_ACTIVE> is set.
  910: 
  911: =item * B<Validation costs.>  L<Params::Validate::Strict> costs about 11
  912: microseconds per call, so it guards the public entry points that run a few
  913: times per command (constructors, admin and client operations).  Functions that
  914: run per path or per protocol frame (L</validate_relpath>, the protocol
  915: methods, the scanner) check their arguments by hand.
  916: 
  917: =item * B<Errors carry locations.>  Library errors are raised with C<croak> and
  918: so end with C<at FILE line N.>; the commands strip that before printing, and
  919: C<FILESYNC_TRACE=1> turns every error into a full stack trace instead.
  920: 
  921: =item * B<English only.>  The catalogue mechanism supports other languages,
  922: plural forms and gender, but only the English catalogue ships.
  923: 
  924: =back
  925: 
  926: =head1 SEE ALSO
  927: 
  928: =over 4
  929: 
  930: =item * L<App::FileSync::I18N> - the message catalogue
  931: 
  932: =item * L<Test Dashboard|https://nigelhorne.github.io/App-FileSync/coverage/>
  933: 
  934: =back
  935: 
  936: =head1 AUTHOR
  937: 
  938: Nigel Horne, C<< <njh at nigelhorne.com> >>
  939: 
  940: =head1 LICENCE AND COPYRIGHT
  941: 
  942: Copyright 2026 Nigel Horne.
  943: 
  944: Usage is subject to the GPL2 licence terms.
  945: If you use it,
  946: please let me know.
  947: 
  948: =cut