lib/App/FileSync/Transport/Local.pm — Duplicate Code Regions
◆ Amber lines duplicate code in another file — hover for location.
◆ Purple: duplicate of another region within this same file.
1: package App::FileSync::Transport::Local;
2:
3: # Runs filesync-server as a child process and speaks the wire protocol over
4: # its pipes. Used by the test suite, and for a server directory that is
5: # local to the client (a NAS mount, say).
6:
7: use App::FileSync::Platform;
8:
9: use strict;
10: use warnings;
11:
12: # Not :all - this class has a close method, and autodie replaces a package's
13: # subs named after the builtins it wraps.
14: use autodie qw(open);
15:
16: use File::Basename qw(dirname);
17: use File::Spec;
18: use IPC::Open3 ();
19: use Readonly;
20: use Sub::Private { mode => 'enforce' };
21:
22: use App::FileSync::Args qw(named);
23: use App::FileSync::Constants qw($ROLE_CLIENT $SERVER_PROGRAM);
24: use App::FileSync::I18N qw(throw);
25:
26: use version; our $VERSION = version->declare('0.001.1');
27:
28: # How far up from this file to look for a checkout's bin/filesync-server:
29: # lib/App/FileSync/Transport is four levels, blib/lib/... five.
30: Readonly my $SEARCH_DEPTH => 6;
31:
32: =encoding utf8
33:
34: =head1 NAME
35:
36: App::FileSync::Transport::Local - run the server as a local child process
37:
38: =head1 SYNOPSIS
39:
40: my $transport = App::FileSync::Transport::Local->new(
41: root => '/srv/filesync', repo => 'docs', client => 'laptop',
42: );
43: my $connection = App::FileSync::Protocol->new(in => $transport->reader, out => $transport->writer);
44: ...
45: $transport->close;
46:
47: =head1 METHODS
48:
49: =head2 new
50:
51: Purpose: start a server for one session.
52:
53: Args: C<root> (the server root), C<repo>, C<client>, optional C<role>
54: (default C<client>) and C<server_bin> (default C<FILESYNC_SERVER_BIN>, then a
55: F<bin/filesync-server> found above this module, then C<filesync-server> on
56: the PATH).
57:
58: Returns: the transport.
59:
60: Side Effects: starts C<$^X server_bin --root ... --repo ... --client ...
61: --role ...>. The child's standard error is the parent's, never the protocol
62: pipe: sharing it would put diagnostics into the protocol stream.
63:
64: Usage:
65:
66: my $transport = App::FileSync::Transport::Local->new(%args);
67:
68: =head3 EXAMPLE
69:
70: my $t = App::FileSync::Transport::Local->new(root => $root, repo => 'docs', client => 'test-1');
71: print {$t->writer} ...;
72:
73: =head3 API SPECIFICATION
74:
75: =head4 INPUT
76:
77: {
78: root => { type => 'string', min => 1 },
79: repo => { type => 'string', min => 1 },
80: client => { type => 'string', min => 1 },
81: role => { type => 'string', optional => 1 },
82: server_bin => { type => 'string', optional => 1 },
83: }
84:
85: =head4 OUTPUT
86:
87: { type => 'object', isa => 'App::FileSync::Transport::Local' }
88:
89: =head3 MESSAGES
90:
91: Key Meaning Resolution
92: transport.missing root, repo or client absent pass it
93:
94: =head3 FORMAL SPECIFICATION
95:
96: new(a) ⇒ ∃ child • argv(child) = ⟨perl, bin, --root, a.root, --repo, a.repo, --client, a.client, --role, role⟩
97:
98: =cut
99:
100: sub new {
101: my $class = shift;
102: my $args = named(\@_, {
103: map({ $_ => { type => 'string', optional => 1 } } qw(root repo client role server_bin)),
104: }, 'Transport::Local->new');
105:
106: for my $required (qw(root repo client)) {
107: throw('transport.missing', { transport => 'Local', what => $required })
108: unless defined $args->{$required} && length $args->{$required};
109: }
110:
111: my @command = (
112: $^X, $args->{server_bin} || _default_server_bin(),
113: '--root', $args->{root},
114: '--repo', $args->{repo},
115: '--client', $args->{client},
116: '--role', $args->{role} || $ROLE_CLIENT,
117: );
118:
119: # '>&STDERR' dups the parent's stderr. Passing a filehandle here would not
120: # redirect the child at all: it would write into an unread pipe, and the
121: # first log line would kill it with SIGPIPE.
122: my ($writer, $reader);
123: my $pid = IPC::Open3::open3($writer, $reader, '>&STDERR', @command);
124:
125: return bless { pid => $pid, writer => $writer, reader => $reader }, $class;
126: }
127:
128: =head2 reader
129:
130: Documented with L</writer> below.
131:
132: =head2 writer
133:
134: Purpose: the pipes to and from the server.
135:
136: Args: none.
137:
138: Returns: the read handle (server's stdout) or write handle (its stdin).
139:
140: Side Effects: none.
141:
142: Usage:
143:
144: my $in = $transport->reader;
145:
146: =head3 EXAMPLE
147:
148: App::FileSync::Protocol->new(in => $t->reader, out => $t->writer);
149:
150: =head3 API SPECIFICATION
151:
152: =head4 INPUT
153:
154: [ { name => 'self', type => 'object' } ]
155:
156: =head4 OUTPUT
157:
158: { type => 'object' }
159:
160: =head3 MESSAGES
161:
162: None.
163:
164: =head3 FORMAL SPECIFICATION
165:
166: reader = self.reader ; writer = self.writer
167:
168: =cut
169:
170: sub reader {
171: my ($self) = @_;
172:
173: return $self->{reader};
174: }
175:
176: sub writer {
177: my ($self) = @_;
178:
179: return $self->{writer};
180: }
181:
182: =head2 close
183:
184: Purpose: end the session's process.
185:
186: Args: none.
187:
188: Returns: 1. Repeated calls do nothing.
189:
190: Side Effects: closes both pipes (the server sees end of file) and reaps the
191: child.
192:
193: Usage:
194:
195: $transport->close;
196:
197: =head3 EXAMPLE
198:
199: $transport->close; # safe to call twice
200:
201: =head3 API SPECIFICATION
202:
203: =head4 INPUT
204:
205: [ { name => 'self', type => 'object' } ]
206:
207: =head4 OUTPUT
208:
209: { type => 'integer', memberof => [ 1 ] }
210:
211: =head3 MESSAGES
212:
213: None.
214:
215: =head3 FORMAL SPECIFICATION
216:
217: closed' = 1 ∧ child ∉ processes'
218:
219: =cut
220:
221: sub close { ## no critic (Subroutines::ProhibitBuiltinHomonyms, Subroutines::ProhibitAmbiguousNames) -- transport interface
222: my ($self) = @_;
223:
224: return 1 if $self->{closed}++;
225:
226: # Pipe close failures mean the child already went; reaping still matters.
227: for my $handle (grep { defined } @{$self}{qw(writer reader)}) {
228: CORE::close($handle);
229: }
230: waitpid($self->{pid}, 0) if $self->{pid};
231:
232: return 1;
233: }
234:
235: =head2 error_text
236:
237: Purpose: what the transport itself said, for when the protocol failed.
238:
239: Args: none.
240:
241: Returns: an empty string: the local server writes its diagnostics to this
242: process's own standard error, which the user already sees.
243:
244: Side Effects: none.
245:
246: Usage:
247:
248: my $text = $transport->error_text;
249:
250: =head3 EXAMPLE
251:
252: print $transport->error_text, "\n";
253:
254: =head3 API SPECIFICATION
255:
256: =head4 INPUT
257:
258: [ { name => 'self', type => 'object' } ]
259:
260: =head4 OUTPUT
261:
262: { type => 'string' }
263:
264: =head3 MESSAGES
265:
266: None.
267:
268: =head3 FORMAL SPECIFICATION
269:
270: error_text = ""
271:
272: =cut
273:
274: sub error_text {
275: return '';
276: }
277:
278: # _default_server_bin
279: # Purpose: find the server program when none is configured.
280: # Entry: none.
281: # Exit: returns FILESYNC_SERVER_BIN, a bin/filesync-server found by
282: # walking up from this file (a checkout, or blib under
283: # "make test"), or the bare name (installed, on the PATH).
284: # Side effects: none.
285: sub _default_server_bin :Private {
286: my $configured = $ENV{FILESYNC_SERVER_BIN};
287: return $configured if defined $configured && length $configured;
288:
289: my $directory = dirname(__FILE__);
290: for (1 .. $SEARCH_DEPTH) {
291: my $candidate = File::Spec->catfile($directory, 'bin', $SERVER_PROGRAM);
292: return $candidate if -f $candidate;
293: $directory = dirname($directory);
294: }
295:
296: return $SERVER_PROGRAM;
297: }
298:
299: 1;
300:
301: __END__
302:
303: =head1 LIMITATIONS
304:
305: =over 4
306:
307: =item * The child runs with this process's privileges: a local transport
308: cannot enforce the separation an SSH forced command gives, so anyone who can
309: run it can write the server root directly anyway.
310:
311: =back
312:
313: =head1 AUTHOR
314:
315: Nigel Horne, C<< <njh at nigelhorne.com> >>
316:
317: =head1 LICENCE AND COPYRIGHT
318:
319: Copyright 2026 Nigel Horne.
320:
321: Usage is subject to the GPL2 licence terms.
322: If you use it,
323: please let me know.
324:
325: =cut