line
stmt
bran
cond
sub
pod
time
code
1
# $Id: AptFetch.pm 510 2014-08-11 13:26:00Z whynot $
2
# Copyright 2009, 2010, 2014 Eric Pozharski
3
# GNU LGPLv3
4
# AS-IS, NO-WARRANTY, HOPE-TO-BE-USEFUL
5
6
142
142
24553705
use warnings;
142
427
142
5460
7
142
142
827
use strict;
142
324
142
6380
8
9
package File::AptFetch;
10
142
142
766
use version 0.77; our $VERSION = version->declare( v0.1.13 );
142
3754
142
3281
11
12
142
142
80421
use File::AptFetch::ConfigData;
142
382
142
10048
13
142
142
826
use Carp;
142
256
142
10224
14
142
142
129589
use IO::Pipe;
142
200796
142
883500
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
877
877
1
105000852
my $cls = shift @_;
316
877
11895
my $self = { };
317
877
100
13394
$self->{method} = shift @_ or return q|($method) is unspecified|;
318
868
14438
$self->{log} = [ ];
319
868
16638
$self->{trace} = { };
320
868
23325
$self->{timeout} = File::AptFetch::ConfigData->config( q|timeout| );
321
868
5789
$self->{tick} = File::AptFetch::ConfigData->config( q|tick| );
322
868
7261
bless $self, $cls;
323
868
2455
my $rc;
324
868
100
19200
'' eq ($rc = $self->_cache_configuration) or return $rc;
325
320
100
2776
File::AptFetch::ConfigData->config( q|lib_method| ) or return
326
qq|($self->{method}): (\$lib_method): neither preset nor found|;
327
319
5783
$self->{it} = IO::Pipe->new;
328
319
122770
$self->{me} = IO::Pipe->new;
329
330
319
50
775460
defined( $self->{pid} = fork ) or die qq|[fork] ($self->{method}): $!|;
331
332
319
100
12913
unless( $self->{pid} ) {
333
61
8681
$self->{me}->writer; $self->{me}->autoflush( 1 );
61
26830
334
61
17956
$self->{it}->reader; $self->{it}->autoflush( 1 );
61
8969
335
61
50
3761
open STDOUT, q|>&=|, $self->{me}->fileno or die
336
qq|[dup] (STDOUT): $!|;
337
61
50
13169
open STDIN, q|<&=|, $self->{it}->fileno or die qq|[dup] (STDIN): $!|;
338
61
0
9459
exec sprintf q|%s/%s|,
339
File::AptFetch::ConfigData->config( q|lib_method| ),
340
$self->{method} or die qq|[exec] ($self->{method}): $!| }
341
342
# XXX:201402081601:whynot: It's B to B, right?
343
258
33503
local $SIG{PIPE} = q|IGNORE|;
344
258
22959
$self->{it}->writer; $self->{it}->autoflush( 1 );
258
84738
345
258
59029
$self->{me}->reader; $self->{me}->autoflush( 1 );
258
22635
346
258
15663
$self->{me}->blocking( 0 );
347
258
4175
$self->{diag} = [ ];
348
349
258
70187
$self->{it}->print( map qq|$_\n|,
350
q|601 Configuration|, map( qq|Config-Item: $_|, @apt_config ), '' );
351
352
258
25454
$rc = $self->_read;
353
256
100
2203
$self->{ALRM_error} and return qq|($self->{method}): timeouted|;
354
255
100
3079
exists $self->{CHLD_error} and return
355
qq|($self->{method}): ($self->{CHLD_error}): died without handshake|;
356
212
50
783
@{$self->{log}} or return
212
1623
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
212
100
2742
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
76
183
$rc = $self }
373
212
12266
$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
743
743
526571
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
743
18189
local $SIG{PIPE} = q|IGNORE|;
404
743
100
33
15356
kill File::AptFetch::ConfigData->config( q|signal| ) => $self->{pid} or
405
carp qq|[kill] ($self->{pid}): nothing to kill or $!| if $self->{pid};
406
743
100
33
8693
close $self->{me} or carp qq|[close] (reader): $!| if $self->{me};
407
743
100
33
5944
close $self->{it} or carp qq|[close] (writer): $!| if $self->{it};
408
743
100
260966
waitpid $self->{pid}, 0 if $self->{pid};
409
743
55780
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
202
202
1
11556796
my %callbacks = @_;
462
202
2288
while( my( $tag, $code ) = each %callbacks ) {
463
261
100
100
5518
ref $code eq q|CODE| || !defined $code or croak
464
qq|($tag): candidate to pass in is neither CODE nor (undef)|;
465
254
100
100
2488
if( $tag eq q|read| && $code ) {
100
100
100
466
176
1167
$_read_callback = $code }
467
elsif( $tag eq q|read| ) {
468
5
705
$_read_callback = \&_read_callback }
469
elsif( $tag eq q|gain| ) {
470
35
414
$_gain_callback = $code }
471
elsif( $tag eq q|select| ) {
472
31
296
$_select_callback = $code }
473
else {
474
7
7399
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
200
200
1
19686279
my( $self, %request ) = @_;
551
200
745
my $log;
552
200
1519
while( my( $filename, $source ) = each %request ) {
553
190
100
1147
my $uri = ref $source ? $source->{uri} : $source;
554
190
50
1059
$uri or return qq|($self->{method}): ($filename): URI is undefined|;
555
190
1320
$uri = qq|$self->{method}:$uri|;
556
190
3546
$self->{trace}{$uri} = { filename => $filename };
557
190
2095
$log .= <<"END_OF_LOG" }
558
600 URI Acquire
559
URI: $uri
560
Filename: $filename
561
562
END_OF_LOG
563
200
100
1049
$log or return '';
564
157
4357
$self->{it}->print( $log );
565
157
105105
push @{$self->{diag}}, split( qr{\n}s, $log ), q||;
157
11326
566
157
2304
'' }
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
285
285
1
2234081
my $self = shift @_;
619
620
# XXX:201405110319:whynot: It looks excessive. It's not. There could be multiple unparsed entries.
621
285
66
1189
until( @{$self->{log}} && grep $_ eq '', @{$self->{log}} ) {
432
4818
262
2754
622
170
2644
$self->_read;
623
165
100
1131
$self->{ALRM_error} and return qq|($self->{method}): timeouted|;
624
157
100
982
exists $self->{CHLD_error} and return
625
qq|($self->{method}): ($self->{CHLD_error}): died|;
626
147
50
347
@{$self->{log}} or return
147
1201
627
qq|($self->{method}): timeouted without responce| }
628
629
262
33
1728
my $rv = $self->_parse_status_code || $self->_parse_message;
630
262
100
66
2592
$_gain_callback->( $self ) if ref $_gain_callback eq q|CODE| && !$rv;
631
258
2000
$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
474
474
1322
my $self = shift;
661
474
100
8090
$self->{log}[0] =~ m|^(\d{3})\s+(.+)| or return
662
qq|($self->{method}): ($self->{log}[0]): that's not a Status Code|;
663
424
5593
@$self{qw| Status status |} = ( $1, $2 );
664
424
1044
push @{$self->{diag}}, shift @{$self->{log}};
424
4063
424
1904
665
424
11523
'' }
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
424
424
1136
my $self = shift;
730
424
873
my %cache;
731
424
1054
while( @{$self->{log}} ) {
2289
6815
732
2289
100
6982
if( $self->{log}[0] eq '' ) {
733
338
574
push @{$self->{diag}}, shift @{$self->{log}};
338
655
338
960
734
338
755
last }
735
1951
100
17350
my( $header, $field ) =
736
$self->{log}[0] =~ m{^([0-9a-z-]+):(?>\s+)(.+)}i or return
737
qq|($self->{method}): ($self->{log}[0]): that's not a Message|;
738
1865
5201
$header =~ tr{A-Z-}{a-z_};
739
1865
50
5625
exists $cache{$header} and return
740
qq|($self->{method}): ($self->{log}[0]): | .
741
qq|that resets header ($header)|;
742
1865
15400
$cache{$header} = $field;
743
1865
2539
push @{$self->{diag}}, shift @{$self->{log}} }
1865
3951
1865
6280
744
338
50
1625
$self->{diag}[-1] eq '' or return
745
qq|($self->{method}): ($self->{diag}[-1]): | .
746
q|message must be terminated by empty line|;
747
338
100
4586
$self->{$self->{Status} == 100 ? q|capabilities| : q|message|} = \%cache;
748
338
4826
'' }
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
868
868
7720
my $self = shift;
864
868
100
9534
@apt_config and return '';
865
634
18593
$self->{me} = IO::Pipe->new;
866
867
634
50
2219275
defined( $self->{pid} = fork ) or die qq|[fork] (apt-config) failed: $!|;
868
869
634
100
20828
unless( $self->{pid} ) {
870
53
1425504
$self->{me}->writer;
871
53
22919
$self->{me}->autoflush( 1 );
872
53
50
31758
open STDIN, q|<|, q|/dev/null| or die qq|[open] (STDIN) failed: $!|;
873
53
50
2190
open STDOUT, q|>&=|, $self->{me}->fileno or die
874
qq|[dup] (STDOUT) failed: $!|;
875
53
0
21150
exec @{File::AptFetch::ConfigData->config( q|config_source| )} or die
53
5257
876
qq|[exec] (apt-config) failed: $!| }
877
878
581
142088
local $SIG{PIPE} = q|IGNORE|;
879
581
60122
$self->{me}->reader;
880
581
53515533
$self->{me}->autoflush( 1 );
881
882
581
247654
$self->_read;
883
581
50
5044
$self->{me}->close or return
884
qq|($self->{method}): [close] (apt-config) failed: $!|;
885
# FIXME: Do I need it?
886
581
60012
delete @$self{qw| me it |};
887
# FIXME: Should timeout B.
888
581
100
335642656
waitpid delete $self->{pid}, 0 if $self->{pid};
889
581
100
5186
$self->{ALRM_error} and return
890
qq|($self->{method}): (apt-config): timeouted|;
891
# XXX:201405122039:whynot: I<$CHLD_error> is C<0> here. But we don't care.
892
552
100
4152
$self->{CHLD_error} and return
893
qq|($self->{method}): (apt-config) died: ($self->{CHLD_error})|;
894
521
100
1466
@{$self->{log}} or return
521
7552
895
qq|($self->{method}): (apt-config): failed to output anything|;
896
491
1281
my @cache;
897
491
2296
while( my $line = shift @{$self->{log}} ) {
13458
44526
898
13372
40231
my( $name, $value ) = split m{ }, $line, 2;
899
13372
100
100
284123
$name !~ m{^[\w/:.+-]+$} ||
100
100
900
$name =~ m{(?
901
!$value || $value !~ m{^"([^"]*)";$} and return
902
qq|($self->{method}): ($line): that's unparsable|;
903
12967
100
47939
($value = $1) eq '' and next;
904
9477
27705
undef while $name =~ s{::::$}{::};
905
9477
17844
$value =~ s{ }{%20}g;
906
9477
15116
$value =~ s{=}{%3d}g;
907
9477
28078
push @cache, qq|$name=$value| }
908
86
100
2919
unless( File::AptFetch::ConfigData->config( q|lib_method| )) {
909
46
306
foreach my $rec ( @cache ) {
910
4014
100
15023
$rec =~ m{^Dir::Bin::methods=(.+)$} or next;
911
45
692
File::AptFetch::ConfigData->set_config( lib_method => $1 );
912
45
132
last } }
913
86
385
delete $self->{CHLD_error};
914
86
2285
@apt_config = ( @cache );
915
# FIXME:201403151954:whynot: Otherwise I<@apt_config> would be returned. That's not going to change.
916
86
3244
'' }
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
6021
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
1009
1009
6309
my $self = shift;
1063
1064
1009
11656
$self->{ALRM_error} = 0;
1065
1009
6465
my $timeout = $self->{timeout};
1066
1009
4595
while( 1 ) {
1067
1876
5991
my @line;
1068
1876
7544
$timeout -= $self->{tick};
1069
1876
15659
my $vec = '';
1070
1876
17036
vec( $vec, $self->{me}->fileno, 1 ) = 1;
1071
1876
100
87982
$_select_callback->( $self ) if $_select_callback;
1072
1874
100
1742826202
unless( select $vec, undef, undef, $self->{tick} ) {
100
50
1073
391
2920
my $rc;
1074
391
9076
$rc +=
1075
391
100
1335
$_read_callback->( $_ ) || 0 foreach values %{$self->{trace}};
1076
386
100
5747
if( $rc ) { $timeout = $self->{timeout} }
50
100
235
1077
38
417
elsif( $timeout < 0 ) { $self->{ALRM_error} = 1; last }}
38
321
1078
elsif( @line = $self->{me}->getlines ) {
1079
878
329202
chomp @line;
1080
878
3534
push @{$self->{log}}, @line;
878
12222
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
878
100
14698
grep $_ eq '', @line and last }
1085
elsif( $self->{me}->eof ) {
1086
605
94975
waitpid delete $self->{pid}, 0;
1087
605
7351
$self->{CHLD_error} = $?; last }
605
2517
1088
else {
1089
0
0
die q|should not be here| }}
1090
1091
1002
6550
'' }
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
210
210
1906908
my $st = shift;
1145
210
100
1569
defined $st->{filename} or return undef;
1146
208
100
2645
$st->{tick} =
1147
File::AptFetch::ConfigData->config( q|tick| ) unless $st->{tick};
1148
208
100
1134
$st->{flag} = 5 unless defined $st->{flag};
1149
208
100
11279
$st->{tmp} = ( glob qq|$st->{filename}*| )[0] unless defined $st->{tmp};
1150
208
100
11076
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
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
63
undef $st->{tmp} }
1158
else {
1159
189
100
6819
@$st{qw| size back |} = ( -s $st->{tmp}, $st->{size} || 0 );
1160
189
1328
$st->{factor} = $st->{size} / ( $st->{tick} * 15 * 1024 * 1024 );
1161
189
50
1033
$st->{factor} = 1 if 1 > $st->{factor};
1162
189
100
1946
$st->{flag} = 5 * $st->{factor} if $st->{size} - $st->{back} }
1163
208
2396
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;