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
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 loop.
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;