line
stmt
bran
cond
sub
pod
time
code
1
# $Id: AptFetch.pm 526 2017-04-15 01:52:05Z sync $
2
# Copyright 2009, 2010, 2014, 2017 Eric Pozharski
3
# GNU LGPLv3
4
# AS-IS, NO-WARRANTY, HOPE-TO-BE-USEFUL
5
6
101
101
7521088
use warnings;
101
169
101
3402
7
101
101
346
use strict;
101
137
101
2747
8
9
package File::AptFetch;
10
101
101
387
use version 0.77; our $VERSION = version->declare( v0.1.14 );
101
1918
101
665
11
12
101
101
34886
use File::AptFetch::ConfigData;
101
141
101
2599
13
101
101
425
use Carp;
101
79
101
4878
14
101
101
38317
use IO::Pipe;
101
98568
101
222680
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
4494838
my $cls = shift @_;
316
788
3087
my $self = { };
317
788
100
4890
$self->{method} = shift @_ or return q|($method) is unspecified|;
318
779
2313
$self->{log} = [ ];
319
779
2274
$self->{trace} = { };
320
779
7205
$self->{timeout} = File::AptFetch::ConfigData->config( q|timeout| );
321
779
2680
$self->{tick} = File::AptFetch::ConfigData->config( q|tick| );
322
779
1997
bless $self, $cls;
323
779
1123
my $rc;
324
779
100
5306
'' eq ($rc = $self->_cache_configuration) or return $rc;
325
246
100
706
File::AptFetch::ConfigData->config( q|lib_method| ) or return
326
qq|($self->{method}): (\$lib_method): neither preset nor found|;
327
245
2179
$self->{it} = IO::Pipe->new;
328
245
21325
$self->{me} = IO::Pipe->new;
329
330
245
50
185314
defined( $self->{pid} = fork ) or die qq|[fork] ($self->{method}): $!|;
331
332
245
100
1500
unless( $self->{pid} ) {
333
35
1526
$self->{me}->writer; $self->{me}->autoflush( 1 );
35
4560
334
35
3188
$self->{it}->reader; $self->{it}->autoflush( 1 );
35
1290
335
35
50
905
open STDOUT, q|>&=|, $self->{me}->fileno or die
336
qq|[dup] (STDOUT): $!|;
337
35
50
1997
open STDIN, q|<&=|, $self->{it}->fileno or die qq|[dup] (STDIN): $!|;
338
exec sprintf q|%s/%s|,
339
File::AptFetch::ConfigData->config( q|lib_method| ),
340
35
0
1956
$self->{method} or die qq|[exec] ($self->{method}): $!| }
341
342
# XXX:201402081601:whynot: It's B to B, right?
343
210
10275
local $SIG{PIPE} = q|IGNORE|;
344
210
8254
$self->{it}->writer; $self->{it}->autoflush( 1 );
210
25525
345
210
20912
$self->{me}->reader; $self->{me}->autoflush( 1 );
210
6854
346
210
5796
$self->{me}->blocking( 0 );
347
210
1680
$self->{diag} = [ ];
348
349
210
5771
$self->{it}->print( map qq|$_\n|,
350
q|601 Configuration|, map( qq|Config-Item: $_|, @apt_config ), '' );
351
352
210
6873
$rc = $self->_read;
353
208
50
1011
$self->{ALRM_error} and return qq|($self->{method}): timeouted|;
354
exists $self->{CHLD_error} and return
355
208
100
1765
qq|($self->{method}): ($self->{CHLD_error}): died without handshake|;
356
165
50
293
@{$self->{log}} or return
165
615
357
qq|($self->{method}): timeouted without handshake|;
358
359
# 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<>?
360
# XXX:201404072146:whynot: Or. Is it possible that B<_parse_status_code()> (or B<_parse_message()>), spontaneously, returns spcial C<'' or 0>?
361
# XXX:201404072148:whynot: Or. Is it B<_cache_configuration()>?
362
# http://www.cpantesters.org/cpan/report/a27fdb52-bce0-11e3-add5-ed1d4a243164
363
# because
364
# http://www.cpantesters.org/cpan/report/0f218626-bcc2-11e3-add5-ed1d4a243164
365
165
100
1063
if( '' ne ($rc = $self->_parse_status_code) ) {}
50
100
366
elsif( $self->{Status} != 100 ) {
367
0
0
$rc =
368
qq|($self->{method}): ($self->{Status}): | .
369
q|that's supposed to be (100 Capabilities)| }
370
elsif( '' ne ($rc = $self->_parse_message) ) {}
371
else {
372
29
61
$rc = $self }
373
165
2874
$rc }
374
375
=item B
376
377
undef $fetch;
378
# or leave the scope
379
380
Cleanups.
381
A method is Bed and Bed, pipes are explicitly closed.
382
I anything goes wrong then Bs, for obvious reasons.
383
B is unconditional and isn't timeout protected.
384
385
The actual signal sent for I<$pid> is configured with I<$signal> in
386
B.
387
However one can override (upon build time) or
388
explicitly set it to any desired name or number (upon runtime).
389
Refer to B for details.
390
391
=cut
392
393
sub DESTROY {
394
706
706
33989
my $self = shift;
395
# http://www.cpantesters.org/cpan/report/f55f934e-e292-11e3-84c4-fc77f9652e90 - 3
396
# http://www.cpantesters.org/cpan/report/2b538b74-e25f-11e3-84c4-fc77f9652e90 - 1
397
# http://www.cpantesters.org/cpan/report/685fd35c-e196-11e3-84c4-fc77f9652e90 - 2
398
# http://www.cpantesters.org/cpan/report/150e44ca-e166-11e3-84c4-fc77f9652e90 - 3
399
# http://www.cpantesters.org/cpan/report/8eca3532-e100-11e3-84c4-fc77f9652e90 - 6
400
# http://www.cpantesters.org/cpan/report/97267764-e0cd-11e3-84c4-fc77f9652e90 - 1
401
# http://www.cpantesters.org/cpan/report/857323ca-dff9-11e3-84c4-fc77f9652e90 - 6
402
# http://www.cpantesters.org/cpan/report/cc12e132-df4d-11e3-84c4-fc77f9652e90 - 1
403
706
6563
local $SIG{PIPE} = q|IGNORE|;
404
kill File::AptFetch::ConfigData->config( q|signal| ) => $self->{pid} or
405
706
100
33
4633
carp qq|[kill] ($self->{pid}): nothing to kill or $!| if $self->{pid};
406
706
100
33
42319
close $self->{me} or carp qq|[close] (reader): $!| if $self->{me};
407
706
100
33
3185
close $self->{it} or carp qq|[close] (writer): $!| if $self->{it};
408
706
100
35287
waitpid $self->{pid}, 0 if $self->{pid};
409
706
16109
delete @$self{qw| pid me it |} }
410
411
=item B
412
413
File::AptFetch::set_callback %callbacks;
414
415
(I)
416
Sets (whatever known) callbacks.
417
Semantics and procedures are documented where apropriate.
418
Keys of I<%callbacks> are tags
419
(subject to hash handling by perl, don't mess);
420
key must be among known (or else).
421
Values are either
422
423
=over
424
425
=item *
426
427
CODE -- whatever previous value was would be vanished;
428
429
=item *
430
431
C -- resets callback to default, if any;
432
433
=item *
434
435
anything else -- C.
436
437
=back
438
439
Known tags are:
440
441
=over
442
443
=item C
444
445
(I) L> has more.
446
447
=item C
448
449
L> has more.
450
451
=item C
452
453
(I) L> has more.
454
455
=back
456
457
=cut
458
459
my( $_gain_callback, $_read_callback, $_select_callback );
460
sub set_callback ( % ) {
461
142
142
1
184142
my %callbacks = @_;
462
142
810
while( my( $tag, $code ) = each %callbacks ) {
463
163
100
100
1609
ref $code eq q|CODE| || !defined $code or croak
464
qq|($tag): candidate to pass in is neither CODE nor (undef)|;
465
156
100
100
1012
if( $tag eq q|read| && $code ) {
100
100
100
466
116
421
$_read_callback = $code }
467
elsif( $tag eq q|read| ) {
468
5
85
$_read_callback = \&_read_callback }
469
elsif( $tag eq q|gain| ) {
470
16
111
$_gain_callback = $code }
471
elsif( $tag eq q|select| ) {
472
12
70
$_select_callback = $code }
473
else {
474
7
1400
croak qq|($tag): unknown callback| } }}
475
476
=item B
477
478
my $rc = $fetch->request(
479
$target0 => $source,
480
$target1 => { uri => $source } );
481
$rc and die $rc;
482
483
B<(bug)>
484
In that section abbreviation "URI" actually refers to "scheme-specific-part".
485
Beware.
486
487
That files requests for transfer.
488
Each request is a pair of I<$target> and either of
489
490
=over
491
492
=item I<$source>
493
494
Simple scalar;
495
It MUST NOT provide schema -- pure filename (either local or remote);
496
It MUST provide all (and no more than) needed leading slashes though
497
(double slash for remotes).
498
499
I<$source> is preprocessed -- I<$method> (with obvious colon) is prepended.
500
(That seems, APT's method become very nervous if being requested mismatching
501
method's name schema.)
502
B<(bug)> That requirement will be slightly relaxed in next release.
503
504
=item I<%$source> C ref
505
506
Such keys are known
507
508
=over
509
510
=item I<$uri>
511
512
The same requirements as for I<$source> apply.
513
514
=back
515
516
There're other keys yet that must be supported.
517
Right now I unaware of any
518
(pending real-life testing).
519
520
=back
521
522
(I)
523
If request list is empty then silently succeeds without doing anything.
524
525
Actual request is filed at once (subject to buffering though),
526
in one big (or not so) chunk (as requested by API).
527
I<@$diag> field is updated accordingly.
528
529
Give-up codes:
530
531
=over
532
533
=item ($method): ($filename): URI is undefined
534
535
Either I<$source> or I<$source{uri}> was evaluated to FALSE.
536
(What request is supposed to be?)
537
538
B<(caveat)> While C and empty string are invalid URIs,
539
is C<0> a valid URI?
540
No, URI is supposed to have at least one leading slash.
541
542
=back
543
544
B pretends to be atomic,
545
the request would happen only in case I<@_> has been parsed successfully.
546
547
=cut
548
549
sub request {
550
25
25
1
142103
my( $self, %request ) = @_;
551
25
42
my $log;
552
25
195
while( my( $filename, $source ) = each %request ) {
553
25
50
95
my $uri = ref $source ? $source->{uri} : $source;
554
25
50
74
$uri or return qq|($self->{method}): ($filename): URI is undefined|;
555
25
103
$uri = qq|$self->{method}:$uri|;
556
25
178
$self->{trace}{$uri} = { filename => $filename };
557
25
162
$log .= <<"END_OF_LOG" }
558
600 URI Acquire
559
URI: $uri
560
Filename: $filename
561
562
END_OF_LOG
563
25
50
52
$log or return '';
564
25
224
$self->{it}->print( $log );
565
25
391
push @{$self->{diag}}, split( qr{\n}s, $log ), q||;
25
482
566
25
135
'' }
567
568
=item B
569
570
$rc = $fetch->gain;
571
$rc and die $rc;
572
573
That gains something.
574
'Something' means it's unknown what kind of message APT's method would return.
575
It can be S<'URI Start'>, S<'URI Done'>, or S<'URI Failure'> messages.
576
Anyway, message is stored in I<@$diag> and I<%$message> fields of object;
577
I<$Status> and I<$status> are set too.
578
579
Give-up codes:
580
581
=over
582
583
=item ($method): ($CHLD_error): died
584
585
Something gone wrong, the APT's method has died;
586
More diagnostic might gone onto I.
587
Even if I<$CHLD_error> is C<0> the method still died on us --
588
it's not supposed to exit.
589
590
=item ($method): timeouted without responce
591
592
The APT's method has quit without properly terminating message with empty line
593
or failed to output anything at all.
594
Supposedly, shouldn't happen.
595
Otherwise, that's your fault -- you asked for entry without reason.
596
597
=item ($method): timeouted
598
599
The APT's method has sat silently all the time.
600
The possible cause would be you've run out of requests
601
(than the method has nothing to do at all
602
(they don't tick after all)).
603
604
=back
605
606
L and L can emit their own give-up
607
codes.
608
609
Unless any problems just before B C callback is tried (if any).
610
That CODE is given the object as an argument.
611
There's no default callback.
612
RV is ignored;
613
B<(note)> That might change in future, beter return TRUE.
614
615
=cut
616
617
sub gain {
618
31
31
1
139096
my $self = shift @_;
619
620
# XXX:201405110319:whynot: It looks excessive. It's not. There could be multiple unparsed entries.
621
31
66
64
until( @{$self->{log}} && grep $_ eq '', @{$self->{log}} ) {
41
305
10
74
622
31
143
$self->_read;
623
26
100
192
$self->{ALRM_error} and return qq|($self->{method}): timeouted|;
624
exists $self->{CHLD_error} and return
625
20
100
177
qq|($self->{method}): ($self->{CHLD_error}): died|;
626
10
50
29
@{$self->{log}} or return
10
53
627
qq|($self->{method}): timeouted without responce| }
628
629
10
33
43
my $rv = $self->_parse_status_code || $self->_parse_message;
630
10
100
66
66
$_gain_callback->( $self ) if ref $_gain_callback eq q|CODE| && !$rv;
631
6
22
$rv }
632
633
=item B<_parse_status_code()>
634
635
$rc = $self->_parse_status_code;
636
return $rc if $rc;
637
638
Internal.
639
Picks one item from I<@$log> and attempts to process it as a Status Code.
640
Consequent items are unaffected.
641
642
Give-up codes:
643
644
=over
645
646
=item ($method): ($log_item): that's not a Status Code
647
648
The $log_item must be C .
649
No luck this time.
650
651
=back
652
653
Sets apropriate fields
654
(I<$Status> with the Status Code, I<$status> with the informational string),
655
then backups the processed item.
656
657
=cut
658
659
sub _parse_status_code {
660
175
175
318
my $self = shift;
661
175
100
1673
$self->{log}[0] =~ m|^(\d{3})\s+(.+)| or return
662
qq|($self->{method}): ($self->{log}[0]): that's not a Status Code|;
663
136
1594
@$self{qw| Status status |} = ( $1, $2 );
664
136
264
push @{$self->{diag}}, shift @{$self->{log}};
136
356
136
420
665
136
1891
'' }
666
667
=item B<_parse_message()>
668
669
$rc = $self->_parse_message;
670
return $rc if $rc;
671
672
Internal.
673
Processes the log entry.
674
Atomically sets either I<%$capabilities> (if I<$Status> is C<100>)
675
or I<%$message> (any other).
676
Each key is lowercased.
677
(I)
678
Since L has been rewritten there could be multiple messages in
679
I<@$log>;
680
those are preserved for next turn.
681
682
(I)
683
Each hyphen (C<->) is replaced with an underscore (C<_>).
684
For convinience reasons
685
(compare S $time >>> with
686
S $time >>>.)
687
B<(bug)>
688
What if a method yelds C and C headers?
689
(C headers are anything but space and colon after all.)
690
Right now, B<_parse_message()> will fail if a message header gets reset.
691
But those headers are different and should be handled appropriately.
692
They aren't.
693
694
Give-up codes:
695
696
=over
697
698
=item ($method): ($log_item): message must be terminated by empty line
699
700
APT method API dictates that messages must be terminated by empty line.
701
This one is not.
702
Shouldn't happen.
703
704
=item ($method): ($log_item): that resets header ($header)
705
706
The leading message header (I<$header>) has been seen before.
707
That's a panic.
708
The offending and all consequent items are left on I<@$log>.
709
Shouldn't happen.
710
711
=item ($method): ($log_item): that's not a Message
712
713
The I<$log_item> must be C<< qr/^[0-9a-z-]+:(?>\s+).+/i >>.
714
It's not.
715
No luck this time.
716
The offending and all consequent items are left on I<@$log>.
717
718
=back
719
720
The I<$log_item>s are backed up and removed from I<@$log>.
721
722
B<(bug)> If the last item isn't an empty line,
723
then C will be pushed.
724
Beware and prevent before going for parsing.
725
726
=cut
727
728
sub _parse_message {
729
136
136
252
my $self = shift;
730
136
195
my %cache;
731
136
291
while( @{$self->{log}} ) {
232
572
732
232
100
598
if( $self->{log}[0] eq '' ) {
733
39
68
push @{$self->{diag}}, shift @{$self->{log}};
39
59
39
50
734
39
43
last }
735
my( $header, $field ) =
736
193
100
2055
$self->{log}[0] =~ m{^([0-9a-z-]+):(?>\s+)(.+)}i or return
737
qq|($self->{method}): ($self->{log}[0]): that's not a Message|;
738
96
158
$header =~ tr{A-Z-}{a-z_};
739
96
50
222
exists $cache{$header} and return
740
qq|($self->{method}): ($self->{log}[0]): | .
741
qq|that resets header ($header)|;
742
96
300
$cache{$header} = $field;
743
96
87
push @{$self->{diag}}, shift @{$self->{log}} }
96
125
96
156
744
39
50
101
$self->{diag}[-1] eq '' or return
745
qq|($self->{method}): ($self->{diag}[-1]): | .
746
q|message must be terminated by empty line|;
747
39
100
198
$self->{$self->{Status} == 100 ? q|capabilities| : q|message|} = \%cache;
748
39
213
'' }
749
750
=item B<_cache_configuration()>
751
752
$rc = $self->_cache_configuration;
753
return $rc if $rc;
754
755
Internal.
756
Bs.
757
Bs if B fails.
758
Bed child Bs an array set in I<@$config_source>
759
(from B).
760
If I<$ConfigData{lib_method}> is unset,
761
then parses prepared cache for I
762
item and (if finds) sets I<$lib_method>.
763
It doesn't complain if I<$lib_method> happens to be left unset.
764
If cache is set it Bs without any activity.
765
766
I<@$config_source> is subject to the build-time configuration.
767
It's preset with S>
768
(YMMV, refer to B to be sure).
769
I<@$config_source> must provide reasonable output -- that's the only
770
requirement
771
(look below for details).
772
773
B<(bug)>
774
While I<@$config_source> is configurable all give-up codes and
775
diagnostic messages refer
776
to C<'apt-config'>.
777
778
I<@$config_source>'s output is postprocessed --
779
configuration names and values are stored as equal (C<'='>) separated pairs in
780
scalars and pushed into intermediate array.
781
If everything finishes OK, then the package-wide cache is set.
782
That cache is lexical
783
(that's possible, I would find a reason to make some kind of iterator some time
784
later;
785
such iterator is missing right now).
786
787
(I)
788
Parsing cycle has suffered total rewrite.
789
First line is split on space into I<$name> and I<$value> (or else).
790
Then comes validation
791
(it woulnd't be needed if I<@{$ConfigData{config_source}}> would be
792
hardcoded, it's not):
793
* I<$name> must consist of alphanumerics, underscores, pluses, minuses,
794
dots, colons, and slashes (C) (or else);
795
* (that's an heuristic) colons come in pairs (or else);
796
* I<$value> must be double-quote (C<">) enclosed, with no double-quote
797
inside allowed (or else);
798
* there must be terminating semicolon (C<;>) (or else).
799
Then comes cooking (all cooking is found by observation, it mimics APT-talk
800
with methods):
801
* trailing double pair-of-colons in I<$name> is trimmed to single pair;
802
* every space in I<$value> is percent escaped (C<%20>);
803
* every equal sign in I<$value> is percent escaped (C<%3d>).
804
805
That last one, needs some explanation.
806
B clearly states:
807
"Values must not include backslashes or extra quotation marks".
808
809
apt-config dump | grep \\\\
810
811
disagrees on backslashes (if you're upgraded enough).
812
So does B: backslashes are passed through.
813
After some experiments double-quote handling looks, roughly, like this:
814
* double-quotes must come in pairs;
815
* those double-quotes are dropped from I<$value> withouth any visible effects
816
(double-quotes, not enclosed content;
817
it stays intact;
818
whatever content, empty string is content too);
819
* if there's any odd double-quote that fails parsing.
820
B doesn't need to do anything about it --
821
I<@{$ConfigData{config_source}}> is supposed to handle those itself.
822
823
B<(bug)>
824
What should be investigated:
825
* what if double-quote is explicitly percent-escaped in F?
826
* how percents in I<$value> are handled?
827
Pending.
828
829
Give-up codes:
830
831
=over
832
833
=item ($method): ($line): that's unparsable
834
835
Validation (described above) has failed.
836
837
=item ($method): [close] (apt-config) failed: $!
838
839
After processing input a pipe is Bd.
840
That B failed with I<$!>.
841
842
=item ($method): (apt-config): timeouted
843
844
While processing a fair 120sec timeout is given
845
(it's reset after each I<$line>).
846
I<@$config_source> hanged for that time.
847
848
=item ($method): (apt-config) died: ($?)
849
850
I<@$config_source> has exited uncleanly.
851
More diagnostic is supposed to be on I.
852
853
=item ($method): (apt-config): failed to output anything
854
855
I<@$config_source> has exited cleanly,
856
but failed to provide any output to parse at all.
857
858
=back
859
860
=cut
861
862
sub _cache_configuration {
863
779
779
1228
my $self = shift;
864
779
100
3947
@apt_config and return '';
865
578
4353
$self->{me} = IO::Pipe->new;
866
867
578
50
298400
defined( $self->{pid} = fork ) or die qq|[fork] (apt-config) failed: $!|;
868
869
578
100
3457
unless( $self->{pid} ) {
870
38
2130
$self->{me}->writer;
871
38
5278
$self->{me}->autoflush( 1 );
872
38
50
5214
open STDIN, q|<|, q|/dev/null| or die qq|[open] (STDIN) failed: $!|;
873
38
50
399
open STDOUT, q|>&=|, $self->{me}->fileno or die
874
qq|[dup] (STDOUT) failed: $!|;
875
38
0
1245
exec @{File::AptFetch::ConfigData->config( q|config_source| )} or die
38
1494
876
qq|[exec] (apt-config) failed: $!| }
877
878
540
27686
local $SIG{PIPE} = q|IGNORE|;
879
540
21343
$self->{me}->reader;
880
540
70088
$self->{me}->autoflush( 1 );
881
882
540
51777
$self->_read;
883
$self->{me}->close or return
884
540
50
3312
qq|($self->{method}): [close] (apt-config) failed: $!|;
885
# FIXME: Do I need it?
886
540
21231
delete @$self{qw| me it |};
887
# FIXME: Should timeout B.
888
540
100
298228973
waitpid delete $self->{pid}, 0 if $self->{pid};
889
$self->{ALRM_error} and return
890
540
100
3096
qq|($self->{method}): (apt-config): timeouted|;
891
# XXX:201405122039:whynot: I<$CHLD_error> is C<0> here. But we don't care.
892
$self->{CHLD_error} and return
893
511
100
2681
qq|($self->{method}): (apt-config) died: ($self->{CHLD_error})|;
894
480
100
788
@{$self->{log}} or return
480
2936
895
qq|($self->{method}): (apt-config): failed to output anything|;
896
450
839
my @cache;
897
450
792
while( my $line = shift @{$self->{log}} ) {
598
2215
898
553
2758
my( $name, $value ) = split m{ }, $line, 2;
899
553
100
100
17840
$name !~ m{^[\w/:.+-]+$} ||
100
100
900
$name =~ m{(?
901
!$value || $value !~ m{^"([^"]*)";$} and return
902
qq|($self->{method}): ($line): that's unparsable|;
903
148
100
423
($value = $1) eq '' and next;
904
144
334
undef while $name =~ s{::::$}{::};
905
144
174
$value =~ s{ }{%20}g;
906
144
201
$value =~ s{=}{%3d}g;
907
144
488
push @cache, qq|$name=$value| }
908
45
100
852
unless( File::AptFetch::ConfigData->config( q|lib_method| )) {
909
5
22
foreach my $rec ( @cache ) {
910
17
100
67
$rec =~ m{^Dir::Bin::methods=(.+)$} or next;
911
4
44
File::AptFetch::ConfigData->set_config( lib_method => $1 );
912
4
6
last } }
913
45
204
delete $self->{CHLD_error};
914
45
178
@apt_config = ( @cache );
915
# FIXME:201403151954:whynot: Otherwise I<@apt_config> would be returned. That's not going to change.
916
45
721
'' }
917
918
=item B<_uncache_configuration()>
919
920
File::AptFetch::_uncache_configuration;
921
# or
922
$self->_uncache_configuration;
923
# or
924
$fetch->_uncache_configuration;
925
926
Internal.
927
That cleans APT's configuration cache.
928
That doesn't trigger recacheing.
929
That cacheing would happen whenever that cache would be required again
930
(subject to the natural control flow).
931
932
B<(caveat)>
933
B<_cache_configuration> sets I<$lib_method> (in B)
934
(if it happens to be undefined).
935
B<&_uncache_configuration> untouches it.
936
937
=cut
938
939
3
3
3228
sub _uncache_configuration () { @apt_config = ( ) }
940
941
=item B<_read()>
942
943
$fetch->_read;
944
$fetch->{ALRM_error} and
945
die "internal error: requesting read while there shouldn't be any";
946
$fetch->{CHLD_error} and
947
die "external error: method has gone nuts and AWOLed";
948
949
Internal. Refactored.
950
That attempts to read the log entry.
951
Whatever has been read is split in items, Bed, and Bed onto
952
I<@$log>.
953
Now, item consuming will be finished if:
954
955
=over
956
957
=item empty-line separator has been found
958
959
(I there was major breakage at that point after I)
960
Somewhere in I<@$log> there's, at least one, empty-line separtor.
961
For technical reasons it doesn't have to be the last one.
962
For more confusion the last item might be unempty.
963
It's up to you would you consume everything in I<@$log>,
964
complete entries (with empty-line separtors), or
965
only first complete entry --
966
B<_read> doesn't care.
967
In either case, you may be sure if B<_read> returns clean (see below) there's
968
at least one compelte entry.
969
970
=item child has timeouted
971
972
If child timeouts, then I<$ALRM_error> is set
973
(to TRUE, otherwise meaningles).
974
Technically speaking a method just has nothing to say.
975
It's up to caller to decide what to do
976
(and it's caller's fault that there was attempt to get entry while there was
977
no reason to be any).
978
Anyway, I<$ALRM_error> is forced to be FALSE upon entering B loop.
979
980
(I)
981
And more about what timeout is.
982
It was believed, that methods pulse their progress.
983
That belief was in vain.
984
Thus for now:
985
986
=over
987
988
=item *
989
990
The timeout is configurable through I<$ConfigData{timeout}>
991
(120sec, by stock configuration;
992
no defaults.)
993
The timeout is cached in each instance of B object.
994
995
=item *
996
997
I<(v0.1.6)>
998
Target filenames are cached in the B object.
999
For each target there's a HASH.
1000
In the HASH a key I is set to target filename value.
1001
1002
=item *
1003
1004
I<(v0.1.4)>
1005
Timeout (the big one I<$timeout>) is made in supposedly small
1006
I<$ConfigData{tick}>s
1007
(5sec, by stock configuration;
1008
no defaults.)
1009
The small timeout is made with 4-arg B.
1010
1011
=item *
1012
1013
I<(v0.1.6)>
1014
If there's no input from method then routing is made as follows:
1015
1016
=over
1017
1018
=item +
1019
1020
Each target's cached HASH is passed to C callback
1021
(L has more).
1022
1023
=item +
1024
1025
If any callback returns TRUE then resets timeout counter and
1026
goes for next I<$tick> long B
1027
(IOW, file transfer (whatever that means) is in progress).
1028
1029
=item +
1030
1031
If every callbacks return FALSE then advances to timeout and
1032
goes for next I<$tick> long B.
1033
1034
=item +
1035
1036
I<(not implemented)>
1037
If any callback returns C then fails entirely.
1038
1039
=back
1040
1041
=back
1042
1043
=item child has exited
1044
1045
The child is Bed and then I<$CHLD_error> is set.
1046
It's possible that's normal for child to exit --
1047
it's up to caller to decide.
1048
Anyway, after child has exited there's nothing to B from.
1049
1050
=item unknown error has happened
1051
1052
(I)
1053
It used to be read-with-alarm-in-eval.
1054
It's not anymore, thus any B will kill a process.
1055
Then it dies.
1056
1057
=back
1058
1059
=cut
1060
1061
sub _read {
1062
781
781
1419
my $self = shift;
1063
1064
781
4252
$self->{ALRM_error} = 0;
1065
781
1285
my $timeout = $self->{timeout};
1066
781
966
while( 1 ) {
1067
1377
1636
my @line;
1068
1377
2850
$timeout -= $self->{tick};
1069
1377
3117
my $vec = '';
1070
1377
6893
vec( $vec, $self->{me}->fileno, 1 ) = 1;
1071
1377
100
18227
$_select_callback->( $self ) if $_select_callback;
1072
1375
50
911980781
unless( select $vec, undef, undef, $self->{tick} ) {
100
100
1073
176
1385
my $rc;
1074
$rc +=
1075
176
100
399
$_read_callback->( $_ ) || 0 foreach values %{$self->{trace}};
176
3291
1076
171
100
1752
if( $rc ) { $timeout = $self->{timeout} }
40
100
121
1077
35
308
elsif( $timeout < 0 ) { $self->{ALRM_error} = 1; last }}
35
483
1078
0
0
elsif( @line = $self->{me}->getlines ) {
1079
635
100301
chomp @line;
1080
635
1059
push @{$self->{log}}, @line;
635
3745
1081
# 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.
1082
# XXX:201404232106:whynot: That's F what does it, AAMF.
1083
# http://www.cpantesters.org/cpan/report/b19908e8-c870-11e3-aee5-9ca1c294a800
1084
635
100
5123
grep $_ eq '', @line and last }
1085
0
0
elsif( $self->{me}->eof ) {
1086
564
46620
waitpid delete $self->{pid}, 0;
1087
564
3710
$self->{CHLD_error} = $?; last }
564
1475
1088
else {
1089
0
0
die q|should not be here| }}
1090
1091
774
2553
'' }
1092
1093
=item B<_read_callback()>
1094
1095
I<(v0.1.6)>
1096
Internal.
1097
It's a default I callback
1098
(L> has more).
1099
It was supposed to be simple.
1100
In vain.
1101
1102
The primary objective is avoiding false negatives at all cost.
1103
Here comes list of avoided false negatives:
1104
1105
=over
1106
1107
=item *
1108
1109
Somewhere on C/C time-span APT methods have changed behaviour.
1110
In past they opened target for writing instantly.
1111
Now they create a temporal and upon finishing rename it to target.
1112
For obvious reasons methods do not communicate neither progress nor filename
1113
of temporal.
1114
If naming or handling of unfinished transfers would ever change there will be
1115
breakage.
1116
1117
=item *
1118
1119
Then.
1120
When transfer is finished *physically* it's not reported just yet
1121
(temporal has been renamed).
1122
A method calculates hashes.
1123
For obvious reasons methods do not coummunicate progress either.
1124
Naive approach would be to check size and then just wait forever.
1125
That's possible size isn't known beforehand.
1126
So B<_read_callback()> increases number of ticks before signaling timeout.
1127
That increase is function of tick length (I<$ConfigData{tick}>), current file
1128
size, and supposed IO speed.
1129
The IO speed is hardcoded to be 15MB/sec.
1130
So if media is realy slow (like a diskette or something) there's a possibility
1131
of breakage.
1132
However, those nitty-gritty manipulations won't result ever in timeout
1133
decrease.
1134
1135
=back
1136
1137
For now it's not clear if B<_read_callback()> ought to provide some
1138
diagnostics.
1139
Right now it doesn't.
1140
1141
=cut
1142
1143
sub _read_callback {
1144
130
130
129023
my $st = shift;
1145
130
100
732
defined $st->{filename} or return undef;
1146
$st->{tick} =
1147
128
100
891
File::AptFetch::ConfigData->config( q|tick| ) unless $st->{tick};
1148
128
100
593
$st->{flag} = 5 unless defined $st->{flag};
1149
128
100
5822
$st->{tmp} = ( glob qq|$st->{filename}*| )[0] unless defined $st->{tmp};
1150
128
100
4266
unless( defined $st->{tmp} ) {
100
1151
# TODO:201403040310:whynot: Here comes diagnostics.
1152
# warn sprintf qq|(%s) (%i): missing, ticks left\n|, ( split m{/}, $st->{filename} )[-1], $st->{flag} - 1
1153
}
1154
0
0
elsif( !-f $st->{tmp} ) {
1155
# TODO:201403040310:whynot: Here could be diagnostics too.
1156
# warn sprintf qq|(%s): disappeared, forcing sync\n|, ( split m{/}, $st->{filename} )[-1];
1157
9
42
undef $st->{tmp} }
1158
else {
1159
109
100
2134
@$st{qw| size back |} = ( -s $st->{tmp}, $st->{size} || 0 );
1160
109
550
$st->{factor} = $st->{size} / ( $st->{tick} * 15 * 1024 * 1024 );
1161
109
50
463
$st->{factor} = 1 if 1 > $st->{factor};
1162
109
100
475
$st->{flag} = 5 * $st->{factor} if $st->{size} - $st->{back} }
1163
128
1214
0 < $st->{flag}-- }
1164
1165
set_callback read => \&_read_callback;
1166
1167
=back
1168
1169
=cut
1170
1171
=head1 DIAGNOSTICS
1172
1173
Most error communication is done through give-up codes.
1174
However, some conditions aren't worth of keeping process alive -- those are
1175
marked as B<(fatal)>.
1176
Others are (mostly) in just Bed process that just couldn't boot
1177
properly -- those are communicated back (somehow).
1178
1179
=over
1180
1181
=item (%s): candiate to pass is neither CODE nor (undef)
1182
1183
B<(fatal)>
1184
In L.
1185
Tag C<%s> (may be unknown) tries to set something for callback.
1186
That must be either CODE or C.
1187
It's not.
1188
1189
=item (%s): unknown callback
1190
1191
B<(fatal)>
1192
In L.
1193
Tag C<%s> is unknown.
1194
Nothing to do with it but B.
1195
1196
=item [close] (reader): $!
1197
1198
In L (that's why it's not fatal).
1199
Closing I of child has failed.
1200
Nothing to do with it except blast ahead
1201
(probably, would stuck in B then).
1202
1203
=item [close] (writer): $!
1204
1205
In L (that's why it's not fatal).
1206
Closing I of child has failed.
1207
Nothing to do with it except blast ahead
1208
(probably, would stuck in B then).
1209
1210
=item [dup] (STDIN): $!
1211
1212
In L.
1213
Turning reader pipe into I has failed.
1214
Parent will express it with S<($method): ($?): died without handshake> give-up
1215
code.
1216
1217
=item [dup] (STDOUT): $!
1218
1219
In L or L.
1220
Turning writer pipe into I has failed.
1221
Parent will express it with S<($method): ($?): died without handshake> or
1222
S<($method): (apt-config) died: ($?)> give-up code.
1223
1224
=item [exec] ($method): $!
1225
1226
In L.
1227
Executing requested I<$method> has failed.
1228
Parent will express it with S<($method): ($?): died without handshake> give-up
1229
code.
1230
1231
=item [fork] ($method): $!
1232
1233
=item [fork] (apt-config): $!
1234
1235
B<(fatal)>
1236
In L (or L if talks about C).
1237
B has failed.
1238
Nothing can be done about it.
1239
1240
=item [kill] ($pid): nothing to kill or $!
1241
1242
In L (that's why it's not fatal).
1243
Child has been reaped somehow already.
1244
Probably OK for *nix of yours.
1245
1246
=item [open] (STDIN): failed: $!
1247
1248
In L.
1249
Turning I of upcoming I<$config_source>
1250
(in B) into F has failed.
1251
Parent will express it with S<($method): (apt-config) died: ($?)> give-up
1252
code.
1253
1254
=item should not be here at .../File/AptFetch.pm line %i
1255
1256
B<(fatal)>
1257
In L.
1258
Per implementetaion there's a chain of if-elsif-else.
1259
That B covers a routes I haven't think of.
1260
Purely my fault.
1261
1262
=back
1263
1264
=head1 SEE ALSO
1265
1266
L,
1267
S<"APT Method Itnerface"> in B package,
1268
B,
1269
B
1270
1271
=head1 AUTHOR
1272
1273
Eric Pozharski,
1274
1275
=head1 COPYRIGHT & LICENSE
1276
1277
Copyright 2009, 2010, 2014 by Eric Pozharski
1278
1279
This library is free in sense: AS-IS, NO-WARANRTY, HOPE-TO-BE-USEFUL.
1280
This library is released under GNU LGPLv3.
1281
1282
=cut
1283
1284
1;