File Coverage

blib/lib/File/AptFetch.pm
Criterion Covered Total %
statement 204 211 96.6
branch 111 134 82.8
condition 27 37 72.9
subroutine 17 17 100.0
pod 4 4 100.0
total 363 403 90.0


line stmt bran cond sub pod time code
1             # $Id: AptFetch.pm 562 2023-01-07 23:31:53Z whynot $
2             # Copyright 2009, 2010, 2014, 2017, 2023 Eric Pozharski
3             # GNU LGPLv3
4             # AS-IS, NO-WARRANTY, HOPE-TO-BE-USEFUL
5              
6 101     101   11442647 use warnings;
  101         1082  
  101         3368  
7 101     101   509 use strict;
  101         163  
  101         4039  
8              
9             package File::AptFetch;
10 101     101   814 use version 0.77; our $VERSION = version->declare( v0.1.15 );
  101         2077  
  101         795  
11              
12 101     101   48864 use File::AptFetch::ConfigData;
  101         234  
  101         3353  
13 101     101   617 use Carp;
  101         290  
  101         5773  
14 101     101   55681 use IO::Pipe;
  101         136687  
  101         325871  
15              
16             =head1 NAME
17              
18             File::AptFetch - perl interface onto APT-Methods
19              
20             =head1 SYNOPSIS
21              
22             use File::AptFetch::Simple; # No, seriously.
23              
24             =head1 DESCRIPTION
25              
26             Shortly:
27              
28             =over
29              
30             =item *
31              
32             Methods are usual executables.
33             Hence B forks.
34              
35             =item *
36              
37             There's no command-line interface for methods.
38             The IPC is two pipes (I and I from method's POV).
39              
40             =item *
41              
42             Each portion of communication (named B) consists of numerical code
43             with explaining text and a sequence of colon (C<':'>) separated lines.
44             A message is terminated with empty line.
45              
46             =item *
47              
48             L has more.
49              
50             =back
51              
52             I<(disclaimer)>
53             Right now, B is in "proof-of-concept" state.
54             It surely works with local methods (F and F);
55             I hope it will work with trivial cases of remote methods
56             (I I've left to hope, it totally does;
57             no manual interaction (credentials and/or tray closing) provided).
58             (B has no means to accept (not talking about to pass along)
59             authentication credentials;
60             So if your upstream needs authentication, B is of no help here.)
61             And one more warning:
62             you're supposed to do all the dirty work of managing --
63             B is only for comunication.
64             Hopefully, there will be someday a kind of super-module what would simplify all
65             this.
66              
67             I<(warning)>
68             You should understand one potential tension with B:
69             B, B, various FTP clients, or whatever else that constitutes
70             B are (I hope so) thoroughly tested against monkey-wrench on the other
71             side of connection.
72             APT methods are B.
73             APT talks to repositories;
74             those repositories are mostly mirrors.
75             Administrators of mirrors and mirror-net roots have at least a basic clue.
76             Pending discovery of APT methods behaviour when they face idiots on the other
77             side of connection.
78              
79             There's a list of known bugs, caveats, and deficiencies.
80              
81             =over
82              
83             =item *
84              
85             (I)
86             There were some concerns about signals.
87             Surprisingly, they're gone now.
88             The only corner left to try is a child ignoring signals at all
89             (stuck in syscall?).
90              
91             =item *
92              
93             That seems that upon normal operation there're no zombies left.
94             However, I'm not sure if B would work as expected.
95             (What if some method would take lots of time to die after being signaled?)
96              
97             =item *
98              
99             Methods are supposed (or not?) to write extra diagnostic at its I.
100             It stays the same as of your process.
101             However, I still haven't seen any output.
102             So, (first) I (and you) have nothing to worry about
103             and (second) I have nothing to work with.
104             That's possible that issue will stay as caveat.
105              
106             =item *
107              
108             I<@$log> is fragile.
109             Don't touch it.
110             However, there's a possibility of I<@$log> corruption, like this.
111             If method goes insane and outputs unparsable messages, then L will
112             give
113             up immedately leaving I<@$log> unempty.
114             In that case you're supposed to recreate B object (or give up).
115             If you don't then strange things can happen (mostly -- give-ups again).
116             So, please, do.
117              
118             =item *
119              
120             I<@$diag> grows.
121             In next release there will be some means to maintain that.
122             Right now, clean I<@$diag> yourself, if that becomes an issue.
123              
124             =item *
125              
126             You're supposed to maintain a balance of requests and fetches.
127             If you try L when there's no unfinished requests,
128             then method will timeout.
129             There's nothing to worry about actually except hanging for 120sec.
130              
131             =back
132              
133             B<(note)>
134             Documentation of this library must maintain 4 namespaces:
135              
136             =over
137              
138             =item Function/method parameter list (I<@_>)
139              
140             Within a section they always refer to parameter names and keys
141             (if I<@_> is hash)
142             mentioned in nearest synopsis.
143              
144             =item Explicit values in descriptive codes
145              
146             They always refer to some value in nearest code.
147             C<$method>, C<$?> etc means that
148             there would be some value that has some relation with named something.
149             POD markup in descriptions means exactly that.
150              
151             =item Keys of B Bed object
152              
153             Whatever missing in nearest synopsis fits here.
154             Each key has explicit content dereference attached.
155             So I<@$log> means that key named C has value of C reference,
156             I<%$message> has value of C reference,
157             and I<$status> has value of plain scalar
158             (it's not reference to C, or it would be I<$$status>).
159              
160             =item Keys of B configuration module
161              
162             Within each section upon introducing they are explicitly mentioned as such.
163             The above explanation about explicit dereference applies here too.
164              
165             =back
166              
167             B<(note)>
168             B are refered as keys of some fake global I<%$message>.
169             So C becomes I<$message{filename}>,
170             and C -- I<$message{last_modified}>.
171             I hope it's clear from context is that B
down- or up-stream.
172              
173             B<(note)> Through out this POD "log item" means one line in I<@$log>;
174             "log entry" means sequence of log items including terminating empty item.
175              
176             B<(note)>
177             Through out this POD "120sec timeout" means: "I<$timeout> in
178             B being left as set in stock distribution,
179             overriden while pre-build configuring, or set at run-time".
180              
181             =head1 IMPORTANT NOTE ON B
182              
183             It's neither bug nor caveat.
184             And it's out of my hands, really.
185             B exits application code differently if compared with
186             B (unbelievable?).
187             My understanding is that B closes handles first, then Bs.
188             Sometimes that filehandle closing happens in right order.
189             But most probably application is killed with I<$SIG{CHLD}>.
190             B doesn't help --- that filehandle masacre happens before those blocks
191             are run.
192             I believe, whatever tinkering with the global I<$SIG{CHLD}> is a bad idea.
193             And terminating every method just after transfers have finished is same
194             stupid.
195             Thus, if you run B (probably any earlier too) destroy the
196             B object explicitly before Bing app, if you care about
197             to be not I<$SIG{CHLD}>ed.
198              
199             B<(note)>
200             Some believe that since I it ain't no issue anymore.
201              
202             =head1 IMPORTANT NOTE ON B
203              
204             Your script (or, more probably, one-liner) could exit with I<$CHILD_ERROR>
205             equal to I<$SIG{TERM}> (or whatever signal was configured
206             (I<$F::AF::ConfigData{signal}>).
207             It would look like your script was Bed.
208             It's not.
209             I've strace'd, I don't see an incoming signal.
210              
211             My understanding is that B of linux is too thready.
212             Then when an object (it has to be global) is Bed a method (what is a
213             child) indeed is Bed.
214             And it's I<$CHILD_ERROR> somehow propagates up to the parent.
215             However that propagation isn't reliable;
216             in some combinations of kernel, libc, and/or perl
217             and (that's important) *your* code probability of propagation reaches to ~1;
218             for other combinations it goes down to ~0.
219             E.g. comparse these, the only diffence is size of I:
220             L|http://www.cpantesters.org/cpan/report/a747458a-03c1-11e4-99f1-ef7f0a370852>
221             and
222             L|http://www.cpantesters.org/cpan/report/ecc8ed5a-0666-11e4-a7dd-06790a370852>,
223             version of B and definition of I<$ENV{LANG}>.
224             But there're failures with IC too.
225              
226             If that's ever a problem you should apply a simple work-around:
227              
228             $faf = File::AptFetch->init( ... );
229             ...
230             undef $faf;
231             $faf = '';
232              
233             The last assignment is essential.
234             I don't suggest that B would be optimized away;
235             it just sneaks into final destroy-everything phase then.
236             From what the propagation raises.
237              
238             =head1 METHODS
239              
240             =over
241              
242             =cut
243              
244             =item B
245              
246             ref( my $fetch = File::AptFetch->init( $method )) or die $fetch;
247              
248             That's an initialization stuff.
249             APT-Methods are userspace executables, you know, hence it Bs.
250             If B fails, then it dies.
251             If all preparations succeede, then it returns B Bed
252             object;
253             Otherwise a string describing issue is returned.
254             Any diagnostic from Bed instance and, later, Bed I<$method> goes
255             through C.
256             (And see L.)
257              
258             An idea behind this ridiculous construct is that someday, in some future, there
259             will be a lots of concurency.
260             Hence it's impossible to maintain one package-wide store for fail description.
261             All methods of B return descriptive strings in case of errors.
262             B just follows them.
263              
264             I<$method> is saved in same named key for reuse.
265              
266             Give-up codes:
267              
268             =over
269              
270             =item ($method): (lib_method): neither preset nor found
271              
272             I<$lib_method> (in B) points to a directory where
273             APT-Methods reside.
274             Without that knowledge B has nothing to do.
275             It's either picked from configuration (build-time) or from B output
276             (run-time) (in that order).
277             It wasn't found in either place -- fairly strange APT you have.
278              
279             =item ($method) is unspecified
280              
281             I<$method> is required argument,
282             so, please, provide.
283              
284             =item ($method): ($?): died without handshake
285              
286             Start-up configuration is essential.
287             If I<$method> disconnects early, than that makes a problem.
288             The exit code (no postprocessing at all) is provided in braces.
289              
290             =item ($method): timeouted without handshake
291              
292             I<$method> failed to configure within time frame provided.
293             (I)
294             L has more about timeouts.
295              
296             =item ($method): ($Status): that's supposed to be (100 Capabilities)
297              
298             As described in "APT Method Interface", Section 2.2, I<$method> starts with
299             S> Status Code.
300             I<$method> didn't.
301             Thus that's not an APT-Method.
302             B has given up.
303              
304             =back
305              
306             Yet refer to L, L, and
307             L -- those can emit their own give-up codes
308             (they are passed up immediately by B without postprocessing).
309              
310             =cut
311              
312             my @apt_config;
313              
314             sub init {
315 788     788 1 8472164 my $cls = shift @_;
316 788         9414 my $self = { };
317 788 100       15599 $self->{method} = shift @_ or return q|($method) is unspecified|;
318 779         6833 $self->{log} = [ ];
319 779         5886 $self->{trace} = { };
320 779         21923 $self->{timeout} = File::AptFetch::ConfigData->config( q|timeout| );
321 779         4983 $self->{tick} = File::AptFetch::ConfigData->config( q|tick| );
322 779         7969 $self->{leftover} = '';
323 779         5363 bless $self, $cls;
324 779         2330 my $rc;
325 779 100       14769 '' eq ($rc = $self->_cache_configuration) or return $rc;
326 246 100       1726 File::AptFetch::ConfigData->config( q|lib_method| ) or return
327             qq|($self->{method}): (\$lib_method): neither preset nor found|;
328 245         4266 $self->{it} = IO::Pipe->new;
329 245         63307 $self->{me} = IO::Pipe->new;
330              
331 245 50       308368 defined( $self->{pid} = fork ) or die qq|[fork] ($self->{method}): $!|;
332              
333 245 100       6182 unless( $self->{pid} ) {
334 35         4208 $self->{me}->writer; $self->{me}->autoflush( 1 );
  35         9981  
335 35         8674 $self->{it}->reader; $self->{it}->autoflush( 1 );
  35         3794  
336 35 50       2161 open STDOUT, q|>&=|, $self->{me}->fileno or die
337             qq|[dup] (STDOUT): $!|;
338 35 50       5571 open STDIN, q|<&=|, $self->{it}->fileno or die qq|[dup] (STDIN): $!|;
339             exec sprintf q|%s/%s|,
340             File::AptFetch::ConfigData->config( q|lib_method| ),
341 35 0       5058 $self->{method} or die qq|[exec] ($self->{method}): $!| }
342              
343             # XXX:201402081601:whynot: It's B to B, right?
344 210         27913 local $SIG{PIPE} = q|IGNORE|;
345 210         18934 $self->{it}->writer; $self->{it}->autoflush( 1 );
  210         61407  
346 210         54026 $self->{me}->reader; $self->{me}->autoflush( 1 );
  210         20216  
347 210         16655 $self->{me}->blocking( 0 );
348 210         4816 $self->{diag} = [ ];
349              
350 210         16889 $self->{it}->print( map qq|$_\n|,
351             q|601 Configuration|, map( qq|Config-Item: $_|, @apt_config ), '' );
352              
353 210         17626 $rc = $self->_read;
354 208 50       2012 $self->{ALRM_error} and return qq|($self->{method}): timeouted|;
355             exists $self->{CHLD_error} and return
356 208 100       4676 qq|($self->{method}): ($self->{CHLD_error}): died without handshake|;
357 165 50       626 @{$self->{log}} or return
  165         1941  
358             qq|($self->{method}): timeouted without handshake|;
359              
360             # XXX:201404072118:whynot: Is it possible that in case of C that assignment (and next one) is, spontaneously, treated as num-eq; What results in C<'' == ''> (with no warnings(sic!)) and then B that C<>?
361             # XXX:201404072146:whynot: Or. Is it possible that B<_parse_status_code()> (or B<_parse_message()>), spontaneously, returns spcial C<'' or 0>?
362             # XXX:201404072148:whynot: Or. Is it B<_cache_configuration()>?
363             # http://www.cpantesters.org/cpan/report/a27fdb52-bce0-11e3-add5-ed1d4a243164
364             # because
365             # http://www.cpantesters.org/cpan/report/0f218626-bcc2-11e3-add5-ed1d4a243164
366 165 100       2645 if( '' ne ($rc = $self->_parse_status_code) ) {}
    50          
    100          
367             elsif( $self->{Status} != 100 ) {
368 0         0 $rc =
369             qq|($self->{method}): ($self->{Status}): | .
370             q|that's supposed to be (100 Capabilities)| }
371             elsif( '' ne ($rc = $self->_parse_message) ) {}
372             else {
373 29         141 $rc = $self }
374 165         8541 $rc }
375              
376             =item B
377              
378             undef $fetch;
379             # or leave the scope
380              
381             Cleanups.
382             A method is Bed and Bed, pipes are explicitly closed.
383             I anything goes wrong then Bs, for obvious reasons.
384             B is unconditional and isn't timeout protected.
385              
386             The actual signal sent for I<$pid> is configured with I<$signal> in
387             B.
388             However one can override (upon build time) or
389             explicitly set it to any desired name or number (upon runtime).
390             Refer to B for details.
391              
392             =cut
393              
394             sub DESTROY {
395 706     706   76225 my $self = shift;
396             # http://www.cpantesters.org/cpan/report/f55f934e-e292-11e3-84c4-fc77f9652e90 - 3
397             # http://www.cpantesters.org/cpan/report/2b538b74-e25f-11e3-84c4-fc77f9652e90 - 1
398             # http://www.cpantesters.org/cpan/report/685fd35c-e196-11e3-84c4-fc77f9652e90 - 2
399             # http://www.cpantesters.org/cpan/report/150e44ca-e166-11e3-84c4-fc77f9652e90 - 3
400             # http://www.cpantesters.org/cpan/report/8eca3532-e100-11e3-84c4-fc77f9652e90 - 6
401             # http://www.cpantesters.org/cpan/report/97267764-e0cd-11e3-84c4-fc77f9652e90 - 1
402             # http://www.cpantesters.org/cpan/report/857323ca-dff9-11e3-84c4-fc77f9652e90 - 6
403             # http://www.cpantesters.org/cpan/report/cc12e132-df4d-11e3-84c4-fc77f9652e90 - 1
404 706         22201 local $SIG{PIPE} = q|IGNORE|;
405             kill File::AptFetch::ConfigData->config( q|signal| ) => $self->{pid} or
406 706 100 33     11010 carp qq|[kill] ($self->{pid}): nothing to kill or $!| if $self->{pid};
407 706 100 33     9362 close $self->{me} or carp qq|[close] (reader): $!| if $self->{me};
408 706 100 33     6779 close $self->{it} or carp qq|[close] (writer): $!| if $self->{it};
409 706 100       84291 waitpid $self->{pid}, 0 if $self->{pid};
410 706         52373 delete @$self{qw| pid me it |} }
411              
412             =item B
413              
414             File::AptFetch::set_callback %callbacks;
415              
416             (I)
417             Sets (whatever known) callbacks.
418             Semantics and procedures are documented where apropriate.
419             Keys of I<%callbacks> are tags
420             (subject to hash handling by perl, don't mess);
421             key must be among known (or else).
422             Values are either
423              
424             =over
425              
426             =item *
427              
428             CODE -- whatever previous value was would be vanished;
429              
430             =item *
431              
432             C -- resets callback to default, if any;
433              
434             =item *
435              
436             anything else -- C.
437              
438             =back
439              
440             Known tags are:
441              
442             =over
443              
444             =item C
445              
446             (I) L> has more.
447              
448             =item C
449              
450             L> has more.
451              
452             =item C
453              
454             (I) L> has more.
455              
456             =back
457              
458             =cut
459              
460             my( $_gain_callback, $_read_callback, $_select_callback );
461             sub set_callback ( % ) {
462 142     142 1 432798 my %callbacks = @_;
463 142         1616 while( my( $tag, $code ) = each %callbacks ) {
464 163 100 100     3195 ref $code eq q|CODE| || !defined $code or croak
465             qq|($tag): candidate to pass in is neither CODE nor (undef)|;
466 156 100 100     1752 if( $tag eq q|read| && $code ) {
    100          
    100          
    100          
467 116         803 $_read_callback = $code }
468             elsif( $tag eq q|read| ) {
469 5         265 $_read_callback = \&_read_callback }
470             elsif( $tag eq q|gain| ) {
471 16         291 $_gain_callback = $code }
472             elsif( $tag eq q|select| ) {
473 12         164 $_select_callback = $code }
474             else {
475 7         3808 croak qq|($tag): unknown callback| } }}
476              
477             =item B
478              
479             my $rc = $fetch->request(
480             $target0 => $source,
481             $target1 => { uri => $source } );
482             $rc and die $rc;
483              
484             B<(bug)>
485             In that section abbreviation "URI" actually refers to "scheme-specific-part".
486             Beware.
487              
488             That files requests for transfer.
489             Each request is a pair of I<$target> and either of
490              
491             =over
492              
493             =item I<$source>
494              
495             Simple scalar;
496             It MUST NOT provide schema -- pure filename (either local or remote);
497             It MUST provide all (and no more than) needed leading slashes though
498             (double slash for remotes).
499              
500             I<$source> is preprocessed -- I<$method> (with obvious colon) is prepended.
501             (That seems, APT's method become very nervous if being requested mismatching
502             method's name schema.)
503             B<(bug)> That requirement will be slightly relaxed in next release.
504              
505             =item I<%$source> C ref
506              
507             Such keys are known
508              
509             =over
510              
511             =item I<$uri>
512              
513             The same requirements as for I<$source> apply.
514              
515             =back
516              
517             There're other keys yet that must be supported.
518             Right now I unaware of any
519             (pending real-life testing).
520              
521             =back
522              
523             (I)
524             If request list is empty then silently succeeds without doing anything.
525              
526             Actual request is filed at once (subject to buffering though),
527             in one big (or not so) chunk (as requested by API).
528             I<@$diag> field is updated accordingly.
529              
530             Give-up codes:
531              
532             =over
533              
534             =item ($method): ($filename): URI is undefined
535              
536             Either I<$source> or I<$source{uri}> was evaluated to FALSE.
537             (What request is supposed to be?)
538              
539             B<(caveat)> While C and empty string are invalid URIs,
540             is C<0> a valid URI?
541             No, URI is supposed to have at least one leading slash.
542              
543             =back
544              
545             B pretends to be atomic,
546             the request would happen only in case I<@_> has been parsed successfully.
547              
548             =cut
549              
550             sub request {
551 25     25 1 357079 my( $self, %request ) = @_;
552 25         136 my $log;
553 25         373 while( my( $filename, $source ) = each %request ) {
554 25 50       233 my $uri = ref $source ? $source->{uri} : $source;
555 25 50       136 $uri or return qq|($self->{method}): ($filename): URI is undefined|;
556 25         224 $uri = qq|$self->{method}:$uri|;
557 25         554 $self->{trace}{$uri} = { filename => $filename };
558 25         434 $log .= <<"END_OF_LOG" }
559             600 URI Acquire
560             URI: $uri
561             Filename: $filename
562              
563             END_OF_LOG
564 25 50       150 $log or return '';
565 25         656 $self->{it}->print( $log );
566 25         1964 push @{$self->{diag}}, split( qr{\n}s, $log ), q||;
  25         1140  
567 25         734 '' }
568              
569             =item B
570              
571             $rc = $fetch->gain;
572             $rc and die $rc;
573              
574             That gains something.
575             'Something' means it's unknown what kind of message APT's method would return.
576             It can be S<'URI Start'>, S<'URI Done'>, or S<'URI Failure'> messages.
577             Anyway, message is stored in I<@$diag> and I<%$message> fields of object;
578             I<$Status> and I<$status> are set too.
579              
580             Give-up codes:
581              
582             =over
583              
584             =item ($method): ($CHLD_error): died
585              
586             Something gone wrong, the APT's method has died;
587             More diagnostic might gone onto I.
588             Even if I<$CHLD_error> is C<0> the method still died on us --
589             it's not supposed to exit.
590              
591             =item ($method): timeouted without responce
592              
593             The APT's method has quit without properly terminating message with empty line
594             or failed to output anything at all.
595             Supposedly, shouldn't happen.
596             Otherwise, that's your fault -- you asked for entry without reason.
597              
598             =item ($method): timeouted
599              
600             The APT's method has sat silently all the time.
601             The possible cause would be you've run out of requests
602             (than the method has nothing to do at all
603             (they don't tick after all)).
604              
605             =back
606              
607             L and L can emit their own give-up
608             codes.
609              
610             Unless any problems just before B C callback is tried (if any).
611             That CODE is given the object as an argument.
612             There's no default callback.
613             RV is ignored;
614             B<(note)> That might change in future, beter return TRUE.
615              
616             =cut
617              
618             sub gain {
619 31     31 1 323861 my $self = shift @_;
620              
621             # XXX:201405110319:whynot: It looks excessive. It's not. There could be multiple unparsed entries.
622 31   66     168 until( @{$self->{log}} && grep $_ eq '', @{$self->{log}} ) {
  41         863  
  10         169  
623 31         668 $self->_read;
624 26 100       427 $self->{ALRM_error} and return qq|($self->{method}): timeouted|;
625             exists $self->{CHLD_error} and return
626 20 100       361 qq|($self->{method}): ($self->{CHLD_error}): died|;
627 10 50       61 @{$self->{log}} or return
  10         93  
628             qq|($self->{method}): timeouted without responce| }
629              
630 10   33     275 my $rv = $self->_parse_status_code || $self->_parse_message;
631 10 100 66     265 $_gain_callback->( $self ) if ref $_gain_callback eq q|CODE| && !$rv;
632 6         51 $rv }
633              
634             =item B<_parse_status_code()>
635              
636             $rc = $self->_parse_status_code;
637             return $rc if $rc;
638              
639             Internal.
640             Picks one item from I<@$log> and attempts to process it as a Status Code.
641             Consequent items are unaffected.
642              
643             Give-up codes:
644              
645             =over
646              
647             =item ($method): ($log_item): that's not a Status Code
648              
649             The $log_item must be C.
650             No luck this time.
651              
652             =back
653              
654             Sets apropriate fields
655             (I<$Status> with the Status Code, I<$status> with the informational string),
656             then backups the processed item.
657              
658             =cut
659              
660             sub _parse_status_code {
661 175     175   1201 my $self = shift;
662 175 100       6875 $self->{log}[0] =~ m|^(\d{3})\s+(.+)| or return
663             qq|($self->{method}): ($self->{log}[0]): that's not a Status Code|;
664 123         5935 @$self{qw| Status status |} = ( $1, $2 );
665 123         670 push @{$self->{diag}}, shift @{$self->{log}};
  123         652  
  123         825  
666 123         3684 '' }
667              
668             =item B<_parse_message()>
669              
670             $rc = $self->_parse_message;
671             return $rc if $rc;
672              
673             Internal.
674             Processes the log entry.
675             Atomically sets either I<%$capabilities> (if I<$Status> is C<100>)
676             or I<%$message> (any other).
677             Each key is lowercased.
678             (I)
679             Since L has been rewritten there could be multiple messages in
680             I<@$log>;
681             those are preserved for next turn.
682              
683             (I)
684             Each hyphen (C<->) is replaced with an underscore (C<_>).
685             For convinience reasons
686             (compare S $time >>> with
687             S $time >>>.)
688             B<(bug)>
689             What if a method yelds C and C headers?
690             (C headers are anything but space and colon after all.)
691             Right now, B<_parse_message()> will fail if a message header gets reset.
692             But those headers are different and should be handled appropriately.
693             They aren't.
694              
695             Give-up codes:
696              
697             =over
698              
699             =item ($method): ($log_item): message must be terminated by empty line
700              
701             APT method API dictates that messages must be terminated by empty line.
702             This one is not.
703             Shouldn't happen.
704              
705             =item ($method): ($log_item): that resets header ($header)
706              
707             The leading message header (I<$header>) has been seen before.
708             That's a panic.
709             The offending and all consequent items are left on I<@$log>.
710             Shouldn't happen.
711              
712             =item ($method): ($log_item): that's not a Message
713              
714             The I<$log_item> must be C<< qr/^[0-9a-z-]+:(?>\s+).+/i >>.
715             It's not.
716             No luck this time.
717             The offending and all consequent items are left on I<@$log>.
718              
719             =back
720              
721             The I<$log_item>s are backed up and removed from I<@$log>.
722              
723             B<(bug)> If the last item isn't an empty line,
724             then C will be pushed.
725             Beware and prevent before going for parsing.
726              
727             =cut
728              
729             sub _parse_message {
730 123     123   673 my $self = shift;
731 123         745 my %cache;
732 123         392 while( @{$self->{log}} ) {
  219         1495  
733 219 100       1307 if( $self->{log}[0] eq '' ) {
734 39         132 push @{$self->{diag}}, shift @{$self->{log}};
  39         195  
  39         152  
735 39         187 last }
736             my( $header, $field ) =
737 180 100       4953 $self->{log}[0] =~ m{^([0-9a-z-]+):(?>\s+)(.+)}i or return
738             qq|($self->{method}): ($self->{log}[0]): that's not a Message|;
739 96         551 $header =~ tr{A-Z-}{a-z_};
740 96 50       340 exists $cache{$header} and return
741             qq|($self->{method}): ($self->{log}[0]): | .
742             qq|that resets header ($header)|;
743 96         908 $cache{$header} = $field;
744 96         226 push @{$self->{diag}}, shift @{$self->{log}} }
  96         295  
  96         341  
745 39 50       229 $self->{diag}[-1] eq '' or return
746             qq|($self->{method}): ($self->{diag}[-1]): | .
747             q|message must be terminated by empty line|;
748 39 100       417 $self->{$self->{Status} == 100 ? q|capabilities| : q|message|} = \%cache;
749 39         649 '' }
750              
751             =item B<_cache_configuration()>
752              
753             $rc = $self->_cache_configuration;
754             return $rc if $rc;
755              
756             Internal.
757             Bs.
758             Bs if B fails.
759             Bed child Bs an array set in I<@$config_source>
760             (from B).
761             If I<$ConfigData{lib_method}> is unset,
762             then parses prepared cache for I
763             item and (if finds) sets I<$lib_method>.
764             It doesn't complain if I<$lib_method> happens to be left unset.
765             If cache is set it Bs without any activity.
766              
767             I<@$config_source> is subject to the build-time configuration.
768             It's preset with S>
769             (YMMV, refer to B to be sure).
770             I<@$config_source> must provide reasonable output -- that's the only
771             requirement
772             (look below for details).
773              
774             B<(bug)>
775             While I<@$config_source> is configurable all give-up codes and
776             diagnostic messages refer
777             to C<'apt-config'>.
778              
779             I<@$config_source>'s output is postprocessed --
780             configuration names and values are stored as equal (C<'='>) separated pairs in
781             scalars and pushed into intermediate array.
782             If everything finishes OK, then the package-wide cache is set.
783             That cache is lexical
784             (that's possible, I would find a reason to make some kind of iterator some time
785             later;
786             such iterator is missing right now).
787              
788             (I)
789             Parsing cycle has suffered total rewrite.
790             First line is split on space into I<$name> and I<$value> (or else).
791             Then comes validation
792             (it woulnd't be needed if I<@{$ConfigData{config_source}}> would be
793             hardcoded, it's not):
794             * I<$name> must consist of alphanumerics, underscores, pluses, minuses,
795             dots, colons, and slashes (C) (or else);
796             * (that's an heuristic) colons come in pairs (or else);
797             * I<$value> must be double-quote (C<">) enclosed, with no double-quote
798             inside allowed (or else);
799             * there must be terminating semicolon (C<;>) (or else).
800             Then comes cooking (all cooking is found by observation, it mimics APT-talk
801             with methods):
802             * trailing double pair-of-colons in I<$name> is trimmed to single pair;
803             * every space in I<$value> is percent escaped (C<%20>);
804             * every equal sign in I<$value> is percent escaped (C<%3d>).
805              
806             That last one, needs some explanation.
807             B clearly states:
808             "Values must not include backslashes or extra quotation marks".
809              
810             apt-config dump | grep \\\\
811              
812             disagrees on backslashes (if you're upgraded enough).
813             So does B: backslashes are passed through.
814             After some experiments double-quote handling looks, roughly, like this:
815             * double-quotes must come in pairs;
816             * those double-quotes are dropped from I<$value> withouth any visible effects
817             (double-quotes, not enclosed content;
818             it stays intact;
819             whatever content, empty string is content too);
820             * if there's any odd double-quote that fails parsing.
821             B doesn't need to do anything about it --
822             I<@{$ConfigData{config_source}}> is supposed to handle those itself.
823              
824             B<(bug)>
825             What should be investigated:
826             * what if double-quote is explicitly percent-escaped in F?
827             * how percents in I<$value> are handled?
828             Pending.
829              
830             Give-up codes:
831              
832             =over
833              
834             =item ($method): ($line): that's unparsable
835              
836             Validation (described above) has failed.
837              
838             =item ($method): [close] (apt-config) failed: $!
839              
840             After processing input a pipe is Bd.
841             That B failed with I<$!>.
842              
843             =item ($method): (apt-config): timeouted
844              
845             While processing a fair 120sec timeout is given
846             (it's reset after each I<$line>).
847             I<@$config_source> hanged for that time.
848              
849             =item ($method): (apt-config) died: ($?)
850              
851             I<@$config_source> has exited uncleanly.
852             More diagnostic is supposed to be on I.
853              
854             =item ($method): (apt-config): failed to output anything
855              
856             I<@$config_source> has exited cleanly,
857             but failed to provide any output to parse at all.
858              
859             =back
860              
861             =cut
862              
863             sub _cache_configuration {
864 779     779   4343 my $self = shift;
865 779 100       7717 @apt_config and return '';
866 578         11151 $self->{me} = IO::Pipe->new;
867            
868 578 50       691855 defined( $self->{pid} = fork ) or die qq|[fork] (apt-config) failed: $!|;
869              
870 578 100       9720 unless( $self->{pid} ) {
871 38         3665 $self->{me}->writer;
872 38         10523 $self->{me}->autoflush( 1 );
873 38 50       10786 open STDIN, q|<|, q|/dev/null| or die qq|[open] (STDIN) failed: $!|;
874 38 50       1135 open STDOUT, q|>&=|, $self->{me}->fileno or die
875             qq|[dup] (STDOUT) failed: $!|;
876 38 0       3394 exec @{File::AptFetch::ConfigData->config( q|config_source| )} or die
  38         2850  
877             qq|[exec] (apt-config) failed: $!| }
878              
879 540         57756 local $SIG{PIPE} = q|IGNORE|;
880 540         45755 $self->{me}->reader;
881 540         151268 $self->{me}->autoflush( 1 );
882              
883 540         135479 $self->_read;
884             $self->{me}->close or return
885 540 50       6712 qq|($self->{method}): [close] (apt-config) failed: $!|;
886             # FIXME: Do I need it?
887 540         51580 delete @$self{qw| me it |};
888             # FIXME: Should timeout B.
889 540 100       301489608 waitpid delete $self->{pid}, 0 if $self->{pid};
890             $self->{ALRM_error} and return
891 540 100       9624 qq|($self->{method}): (apt-config): timeouted|;
892             # XXX:201405122039:whynot: I<$CHLD_error> is C<0> here. But we don't care.
893             $self->{CHLD_error} and return
894 511 100       6222 qq|($self->{method}): (apt-config) died: ($self->{CHLD_error})|;
895 480 100       1748 @{$self->{log}} or return
  480         7358  
896             qq|($self->{method}): (apt-config): failed to output anything|;
897 450         2091 my @cache;
898 450         1491 while( my $line = shift @{$self->{log}} ) {
  598         6593  
899 553         6245 my( $name, $value ) = split m{ }, $line, 2;
900 553 100 100     53463 $name !~ m{^[\w/:.+-]+$} ||
      100        
      100        
901             $name =~ m{(?
902             !$value || $value !~ m{^"([^"]*)";$} and return
903             qq|($self->{method}): ($line): that's unparsable|;
904 148 100       1747 ($value = $1) eq '' and next;
905 144         1449 undef while $name =~ s{::::$}{::};
906 144         448 $value =~ s{ }{%20}g;
907 144         575 $value =~ s{=}{%3d}g;
908 144         1170 push @cache, qq|$name=$value| }
909 45 100       2135 unless( File::AptFetch::ConfigData->config( q|lib_method| )) {
910 5         60 foreach my $rec ( @cache ) {
911 17 100       199 $rec =~ m{^Dir::Bin::methods=(.+)$} or next;
912 4         112 File::AptFetch::ConfigData->set_config( lib_method => $1 );
913 4         14 last } }
914 45         298 delete $self->{CHLD_error};
915 45         626 @apt_config = ( @cache );
916             # FIXME:201403151954:whynot: Otherwise I<@apt_config> would be returned. That's not going to change.
917 45         1925 '' }
918              
919             =item B<_uncache_configuration()>
920              
921             File::AptFetch::_uncache_configuration;
922             # or
923             $self->_uncache_configuration;
924             # or
925             $fetch->_uncache_configuration;
926              
927             Internal.
928             That cleans APT's configuration cache.
929             That doesn't trigger recacheing.
930             That cacheing would happen whenever that cache would be required again
931             (subject to the natural control flow).
932              
933             B<(caveat)>
934             B<_cache_configuration> sets I<$lib_method> (in B)
935             (if it happens to be undefined).
936             B<&_uncache_configuration> untouches it.
937              
938             =cut
939              
940 3     3   13179 sub _uncache_configuration () { @apt_config = ( ) }
941              
942             =item B<_read()>
943              
944             $fetch->_read;
945             $fetch->{ALRM_error} and
946             die "internal error: requesting read while there shouldn't be any";
947             $fetch->{CHLD_error} and
948             die "external error: method has gone nuts and AWOLed";
949              
950             Internal. Refactored.
951             That attempts to read the log entry.
952             Whatever has been read is split in items, Bed, and Bed onto
953             I<@$log>.
954             Now, item consuming will be finished if:
955              
956             =over
957              
958             =item empty-line separator has been found
959              
960             (I there was major breakage at that point after I)
961             Somewhere in I<@$log> there's, at least one, empty-line separtor.
962             For technical reasons it doesn't have to be the last one.
963             For more confusion the last item might be unempty.
964             It's up to you would you consume everything in I<@$log>,
965             complete entries (with empty-line separtors), or
966             only first complete entry --
967             B<_read> doesn't care.
968             In either case, you may be sure if B<_read> returns clean (see below) there's
969             at least one compelte entry.
970              
971             =item child has timeouted
972              
973             If child timeouts, then I<$ALRM_error> is set
974             (to TRUE, otherwise meaningles).
975             Technically speaking a method just has nothing to say.
976             It's up to caller to decide what to do
977             (and it's caller's fault that there was attempt to get entry while there was
978             no reason to be any).
979             Anyway, I<$ALRM_error> is forced to be FALSE upon entering B
980              
981             (I)
982             And more about what timeout is.
983             It was believed, that methods pulse their progress.
984             That belief was in vain.
985             Thus for now:
986              
987             =over
988              
989             =item *
990              
991             The timeout is configurable through I<$ConfigData{timeout}>
992             (120sec, by stock configuration;
993             no defaults.)
994             The timeout is cached in each instance of B object.
995              
996             =item *
997              
998             I<(v0.1.6)>
999             Target filenames are cached in the B object.
1000             For each target there's a HASH.
1001             In the HASH a key I is set to target filename value.
1002              
1003             =item *
1004              
1005             I<(v0.1.4)>
1006             Timeout (the big one I<$timeout>) is made in supposedly small
1007             I<$ConfigData{tick}>s
1008             (5sec, by stock configuration;
1009             no defaults.)
1010             The small timeout is made with 4-arg B
1011              
1012             =item *
1013              
1014             I<(v0.1.6)>
1015             If there's no input from method then routing is made as follows:
1016              
1017             =over
1018              
1019             =item +
1020              
1021             Each target's cached HASH is passed to C callback
1022             (L has more).
1023              
1024             =item +
1025              
1026             If any callback returns TRUE then resets timeout counter and
1027             goes for next I<$tick> long B
1028             (IOW, file transfer (whatever that means) is in progress).
1029              
1030             =item +
1031              
1032             If every callbacks return FALSE then advances to timeout and
1033             goes for next I<$tick> long B
1034              
1035             =item +
1036              
1037             I<(not implemented)>
1038             If any callback returns C then fails entirely.
1039              
1040             =back
1041              
1042             =back
1043              
1044             =item child has exited
1045              
1046             The child is Bed and then I<$CHLD_error> is set.
1047             It's possible that's normal for child to exit --
1048             it's up to caller to decide.
1049             Anyway, after child has exited there's nothing to B from.
1050              
1051             =item unknown error has happened
1052              
1053             (I)
1054             It used to be read-with-alarm-in-eval.
1055             It's not anymore, thus any B will kill a process.
1056             Then it dies.
1057              
1058             =back
1059              
1060             =cut
1061              
1062             sub _read {
1063 781     781   4360 my $self = shift;
1064              
1065 781         8964 $self->{ALRM_error} = 0;
1066 781         2621 my $timeout = $self->{timeout};
1067             # XXX:202301072158:whynot: Otherwise unfinished line would be lost. Still no proper testing.
1068 781         2612 my $leftover = \$self->{leftover};
1069 781         1902 while( 1 ) {
1070 1390         5865 $timeout -= $self->{tick};
1071 1390         10731 my $vec = '';
1072 1390         10393 vec( $vec, $self->{me}->fileno, 1 ) = 1;
1073 1390 100       36126 $_select_callback->( $self ) if $_select_callback;
1074 1388 50       1007343342 unless( select $vec, undef, undef, $self->{tick} ) {
    100          
    50          
    100          
1075 176         4548 my $rc;
1076             $rc +=
1077 176   100     1063 $_read_callback->( $_ ) || 0 foreach values %{$self->{trace}};
  176         4122  
1078 171 100       2348 if( $rc ) { $timeout = $self->{timeout} }
  40 100       171  
1079 35         962 elsif( $timeout < 0 ) { $self->{ALRM_error} = 1; last }}
  35         318  
1080 0         0 elsif( not defined( my $flag =
1081             $self->{me}->sysread( my $buffer, 4096 )) ) {
1082 0         0 die qq|[sysread] ($self->{method}) $!| }
1083 0         0 elsif( $flag ) {
1084 648         44498 $buffer = $$leftover . $buffer;
1085 648         14074 my @prelog = split m{\n}, $buffer, -1;
1086             # WORKAROUND:202301052252:whynot: If C is C<\n> then B spews in one more trailing empty string (that empty string will break fscking everything).
1087             ## XXX:202301062317:whynot: Correctness of log entry processing lacks explicit testing. Sorry about that.
1088             # XXX:202301070412:whynot: Here's the deal. If C is C<\n> then surprise empty string resets I<$leftover>. If C isn't then I<$leftover> is refilled. Neat :)
1089 648         6997 $$leftover = pop @prelog;
1090 648         2643 push @{$self->{log}}, @prelog;
  648         7720  
1091             # WORKAROUND:201404232105:whynot: If method goes insane and bursts in one+ properly empty line separated messages then the separating empty line could got lost between.
1092             # XXX:201404232106:whynot: That's F what does it, AAMF.
1093             # http://www.cpantesters.org/cpan/report/b19908e8-c870-11e3-aee5-9ca1c294a800
1094 648 100       14988 grep $_ eq '', @prelog and last }
1095 0         0 elsif( !$flag ) {
1096 564         54528 waitpid delete $self->{pid}, 0;
1097 564         15041 $self->{CHLD_error} = $?; last }
  564         3884  
1098             else {
1099 0         0 die q|should not be here| }}
1100              
1101 774         6881 '' }
1102              
1103             =item B<_read_callback()>
1104              
1105             I<(v0.1.6)>
1106             Internal.
1107             It's a default I callback
1108             (L> has more).
1109             It was supposed to be simple.
1110             In vain.
1111              
1112             The primary objective is avoiding false negatives at all cost.
1113             Here comes list of avoided false negatives:
1114              
1115             =over
1116              
1117             =item *
1118              
1119             Somewhere on C/C time-span APT methods have changed behaviour.
1120             In past they opened target for writing instantly.
1121             Now they create a temporal and upon finishing rename it to target.
1122             For obvious reasons methods do not communicate neither progress nor filename
1123             of temporal.
1124             If naming or handling of unfinished transfers would ever change there will be
1125             breakage.
1126              
1127             =item *
1128              
1129             Then.
1130             When transfer is finished *physically* it's not reported just yet
1131             (temporal has been renamed).
1132             A method calculates hashes.
1133             For obvious reasons methods do not coummunicate progress either.
1134             Naive approach would be to check size and then just wait forever.
1135             That's possible size isn't known beforehand.
1136             So B<_read_callback()> increases number of ticks before signaling timeout.
1137             That increase is function of tick length (I<$ConfigData{tick}>), current file
1138             size, and supposed IO speed.
1139             The IO speed is hardcoded to be 15MB/sec.
1140             So if media is realy slow (like a diskette or something) there's a possibility
1141             of breakage.
1142             However, those nitty-gritty manipulations won't result ever in timeout
1143             decrease.
1144              
1145             =back
1146              
1147             For now it's not clear if B<_read_callback()> ought to provide some
1148             diagnostics.
1149             Right now it doesn't.
1150              
1151             =cut
1152              
1153             sub _read_callback {
1154 130     130   207684 my $st = shift;
1155 130 100       1421 defined $st->{filename} or return undef;
1156             $st->{tick} =
1157 128 100       2223 File::AptFetch::ConfigData->config( q|tick| ) unless $st->{tick};
1158 128 100       1060 $st->{flag} = 5 unless defined $st->{flag};
1159 128 100       9568 $st->{tmp} = ( glob qq|$st->{filename}*| )[0] unless defined $st->{tmp};
1160 128 100       6072 unless( defined $st->{tmp} ) {
    100          
1161             # TODO:201403040310:whynot: Here comes diagnostics.
1162             # warn sprintf qq|(%s) (%i): missing, ticks left\n|, ( split m{/}, $st->{filename} )[-1], $st->{flag} - 1
1163             }
1164 0         0 elsif( !-f $st->{tmp} ) {
1165             # TODO:201403040310:whynot: Here could be diagnostics too.
1166             # warn sprintf qq|(%s): disappeared, forcing sync\n|, ( split m{/}, $st->{filename} )[-1];
1167 9         92 undef $st->{tmp} }
1168             else {
1169 109   100     3911 @$st{qw| size back |} = ( -s $st->{tmp}, $st->{size} || 0 );
1170 109         1137 $st->{factor} = $st->{size} / ( $st->{tick} * 15 * 1024 * 1024 );
1171 109 50       841 $st->{factor} = 1 if 1 > $st->{factor};
1172 109 100       740 $st->{flag} = 5 * $st->{factor} if $st->{size} - $st->{back} }
1173 128         1956 0 < $st->{flag}-- }
1174              
1175             set_callback read => \&_read_callback;
1176              
1177             =back
1178              
1179             =cut
1180              
1181             =head1 DIAGNOSTICS
1182              
1183             Most error communication is done through give-up codes.
1184             However, some conditions aren't worth of keeping process alive -- those are
1185             marked as B<(fatal)>.
1186             Others are (mostly) in just Bed process that just couldn't boot
1187             properly -- those are communicated back (somehow).
1188              
1189             =over
1190              
1191             =item (%s): candiate to pass is neither CODE nor (undef)
1192              
1193             B<(fatal)>
1194             In L.
1195             Tag C<%s> (may be unknown) tries to set something for callback.
1196             That must be either CODE or C.
1197             It's not.
1198              
1199             =item (%s): unknown callback
1200              
1201             B<(fatal)>
1202             In L.
1203             Tag C<%s> is unknown.
1204             Nothing to do with it but B.
1205              
1206             =item [close] (reader): $!
1207              
1208             In L (that's why it's not fatal).
1209             Closing I of child has failed.
1210             Nothing to do with it except blast ahead
1211             (probably, would stuck in B then).
1212              
1213             =item [close] (writer): $!
1214              
1215             In L (that's why it's not fatal).
1216             Closing I of child has failed.
1217             Nothing to do with it except blast ahead
1218             (probably, would stuck in B then).
1219              
1220             =item [dup] (STDIN): $!
1221              
1222             In L.
1223             Turning reader pipe into I has failed.
1224             Parent will express it with S<($method): ($?): died without handshake> give-up
1225             code.
1226              
1227             =item [dup] (STDOUT): $!
1228              
1229             In L or L.
1230             Turning writer pipe into I has failed.
1231             Parent will express it with S<($method): ($?): died without handshake> or
1232             S<($method): (apt-config) died: ($?)> give-up code.
1233              
1234             =item [exec] ($method): $!
1235              
1236             In L.
1237             Executing requested I<$method> has failed.
1238             Parent will express it with S<($method): ($?): died without handshake> give-up
1239             code.
1240              
1241             =item [fork] ($method): $!
1242              
1243             =item [fork] (apt-config): $!
1244              
1245             B<(fatal)>
1246             In L (or L if talks about C).
1247             B has failed.
1248             Nothing can be done about it.
1249              
1250             =item [kill] ($pid): nothing to kill or $!
1251              
1252             In L (that's why it's not fatal).
1253             Child has been reaped somehow already.
1254             Probably OK for *nix of yours.
1255              
1256             =item [open] (STDIN): failed: $!
1257              
1258             In L.
1259             Turning I of upcoming I<$config_source>
1260             (in B) into F has failed.
1261             Parent will express it with S<($method): (apt-config) died: ($?)> give-up
1262             code.
1263              
1264             =item should not be here at .../File/AptFetch.pm line %i
1265              
1266             B<(fatal)>
1267             In L.
1268             Per implementetaion there's a chain of if-elsif-else.
1269             That B covers a routes I haven't think of.
1270             Purely my fault.
1271              
1272             =item [sysread] ($method): $!
1273              
1274             In L.
1275             That's what has happened -- B has failed for reasons.
1276              
1277             =back
1278              
1279             =head1 SEE ALSO
1280              
1281             L,
1282             S<"APT Method Itnerface"> in B package,
1283             B,
1284             B
1285              
1286             =head1 AUTHOR
1287              
1288             Eric Pozharski,
1289              
1290             =head1 COPYRIGHT & LICENSE
1291              
1292             Copyright 2009, 2010, 2014 by Eric Pozharski
1293              
1294             This library is free in sense: AS-IS, NO-WARANRTY, HOPE-TO-BE-USEFUL.
1295             This library is released under GNU LGPLv3.
1296              
1297             =cut
1298              
1299             1;