view release on metacpan or  search on metacpan

lib/AptFetch.pm  view on Meta::CPAN

After processing input a pipe is B<close>d.
That B<close> failed with I<$!>.

=item ($method): (apt-config): timeouted

While processing a fair 120sec timeout is given
(it's reset after each I<$line>).
I<@$config_source> hanged for that time.

=item ($method): (apt-config) died: ($?)

I<@$config_source> has exited uncleanly.
More diagnostic is supposed to be on I<STDERR>.

=item ($method): (apt-config): failed to output anything

I<@$config_source> has exited cleanly,
but failed to provide any output to parse at all.

=back

=cut

sub _cache_configuration {
    my $self = shift;
    @apt_config                                                 and return '';
    $self->{me} = IO::Pipe->new;
    
    defined( $self->{pid} = fork )  or die qq|[fork] (apt-config) failed: $!|;

    unless( $self->{pid} )     {
        $self->{me}->writer;
        $self->{me}->autoflush( 1 );
        open STDIN, q|<|, q|/dev/null|   or die qq|[open] (STDIN) failed: $!|;
        open STDOUT, q|>&=|, $self->{me}->fileno                        or die
          qq|[dup] (STDOUT) failed: $!|;
        exec @{File::AptFetch::ConfigData->config( q|config_source| )}  or die
          qq|[exec] (apt-config) failed: $!| }

    local $SIG{PIPE} = q|IGNORE|;
    $self->{me}->reader;
    $self->{me}->autoflush( 1 );

    $self->_read;
    $self->{me}->close                                               or return
      qq|($self->{method}): [close] (apt-config) failed: $!|;
# FIXME: Do I need it?
    delete @$self{qw| me it |};
# FIXME: Should timeout B<waitpid>.
    waitpid delete $self->{pid}, 0                            if $self->{pid};
    $self->{ALRM_error}                                             and return
      qq|($self->{method}): (apt-config): timeouted|;
# XXX:201405122039:whynot: I<$CHLD_error> is C<0> here.  But we don't care.
    $self->{CHLD_error}                                             and return
      qq|($self->{method}): (apt-config) died: ($self->{CHLD_error})|;
    @{$self->{log}}                                                  or return
      qq|($self->{method}): (apt-config): failed to output anything|;
    my @cache;
    while( my $line = shift @{$self->{log}} ) {
        my( $name, $value ) = split m{ }, $line, 2;
        $name !~ m{^[\w/:.+-]+$}          ||
        $name =~ m{(?<!:)(?:::)*:(?!:)}   ||
        !$value || $value !~ m{^"([^"]*)";$}                        and return
          qq|($self->{method}): ($line): that's unparsable|;
        ($value = $1) eq ''                                          and next;
        undef                                     while $name =~ s{::::$}{::};
        $value =~ s{ }{%20}g;
        $value =~ s{=}{%3d}g;
        push @cache, qq|$name=$value|          }
    unless( File::AptFetch::ConfigData->config( q|lib_method| )) {
        foreach my $rec ( @cache ) {
            $rec =~ m{^Dir::Bin::methods=(.+)$}                       or next;
            File::AptFetch::ConfigData->set_config( lib_method => $1 );
                               last }                             }
    delete $self->{CHLD_error};
    @apt_config = ( @cache );
# FIXME:201403151954:whynot: Otherwise I<@apt_config> would be returned.  That's not going to change.
                       '' }

=item B<_uncache_configuration()>

    File::AptFetch::_uncache_configuration;
    # or
    $self->_uncache_configuration;
    # or
    $fetch->_uncache_configuration;

Internal.
That cleans APT's configuration cache.
That doesn't trigger recacheing.
That cacheing would happen whenever that cache would be required again
(subject to the natural control flow).

B<(caveat)>
B<_cache_configuration> sets I<$lib_method> (in B<File::AptFetch::ConfigData>)
(if it happens to be undefined).
B<&_uncache_configuration> untouches it.

=cut

sub _uncache_configuration () { @apt_config = ( ) }

=item B<_read()>

    $fetch->_read;
    $fetch->{ALRM_error} and
      die "internal error: requesting read while there shouldn't be any";
    $fetch->{CHLD_error} and
      die "external error: method has gone nuts and AWOLed";

Internal.  Refactored.
That attempts to read the log entry.
Whatever has been read is split in items, B<chomp>ed, and B<push>ed onto
I<@$log>.
Now, item consuming will be finished if:

=over

=item empty-line separator has been found

lib/AptFetch.pm  view on Meta::CPAN

If any callback returns TRUE then resets timeout counter and
goes for next I<$tick> long B<select>
(IOW, file transfer (whatever that means) is in progress).

=item +

If every callbacks return FALSE then advances to timeout and
goes for next I<$tick> long B<select>.

=item +

I<(not implemented)>
If any callback returns C<undef> then fails entirely.

=back

=back

=item child has exited

The child is B<waitpid>ed and then I<$CHLD_error> is set.
It's possible that's normal for child to exit --
it's up to caller to decide.
Anyway, after child has exited there's nothing to B<read> from.

=item unknown error has happened

(I<v.0.1.4>)
It used to be read-with-alarm-in-eval.
It's not anymore, thus any B<signal(7)> will kill a process.
Then it dies.

=back

=cut

sub _read {
    my $self = shift;

    $self->{ALRM_error} = 0;
    my $timeout = $self->{timeout};
# XXX:202301072158:whynot: Otherwise unfinished line would be lost.  Still no proper testing.
    my $leftover = \$self->{leftover};
    while( 1 )                                                     {
        $timeout -= $self->{tick};
        my $vec = '';
        vec( $vec, $self->{me}->fileno, 1 ) = 1;
        $_select_callback->( $self )                     if $_select_callback;
        unless( select $vec, undef, undef, $self->{tick} )        {
            my $rc;
            $rc +=
              $_read_callback->( $_ ) || 0   foreach values %{$self->{trace}};
            if( $rc             ) {   $timeout = $self->{timeout} }
            elsif( $timeout < 0 ) { $self->{ALRM_error} = 1; last }}
        elsif( not defined( my $flag =
          $self->{me}->sysread( my $buffer, 4096 ))      )        {
                            die qq|[sysread] ($self->{method}) $!| }
        elsif( $flag                                     )        {
            $buffer = $$leftover . $buffer;
            my @prelog = split m{\n}, $buffer, -1;
# WORKAROUND:202301052252:whynot: If C<chop $buffer> is C<\n> then B<split()> spews in one more trailing empty string (that empty string will break fscking everything).
## XXX:202301062317:whynot: Correctness of log entry processing lacks explicit testing.  Sorry about that.
# XXX:202301070412:whynot: Here's the deal.  If C<chop $buffer> is C<\n> then surprise empty string resets I<$leftover>.  If C<chop> isn't then I<$leftover> is refilled.  Neat :)
            $$leftover = pop @prelog;
            push @{$self->{log}}, @prelog;
# 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.
# XXX:201404232106:whynot: That's F<t/v-method> what does it, AAMF.
# http://www.cpantesters.org/cpan/report/b19908e8-c870-11e3-aee5-9ca1c294a800
            grep $_ eq '', @prelog                        and last }
        elsif( !$flag                                    )        {
            waitpid delete $self->{pid}, 0;
            $self->{CHLD_error} = $?;                         last }
        else                                                      {
                                         die q|should not be here| }}

        '' }

=item B<_read_callback()>

I<(v0.1.6)>
Internal.
It's a default I<read> callback
(L</B<_read()>> has more).
It was supposed to be simple.
In vain.

The primary objective is avoiding false negatives at all cost.
Here comes list of avoided false negatives:

=over

=item *

Somewhere on C<lenny>/C<squeeze> time-span APT methods have changed behaviour.
In past they opened target for writing instantly.
Now they create a temporal and upon finishing rename it to target.
For obvious reasons methods do not communicate neither progress nor filename
of temporal.
If naming or handling of unfinished transfers would ever change there will be
breakage.

=item *

Then.
When transfer is finished *physically* it's not reported just yet
(temporal has been renamed).
A method calculates hashes.
For obvious reasons methods do not coummunicate progress either.
Naive approach would be to check size and then just wait forever.
That's possible size isn't known beforehand.
So B<_read_callback()> increases number of ticks before signaling timeout.
That increase is function of tick length (I<$ConfigData{tick}>), current file
size, and supposed IO speed.
The IO speed is hardcoded to be 15MB/sec.
So if media is realy slow (like a diskette or something) there's a possibility
of breakage.
However, those nitty-gritty manipulations won't result ever in timeout
decrease.

=back

For now it's not clear if B<_read_callback()> ought to provide some
diagnostics.
Right now it doesn't.

=cut

sub _read_callback   {
    my $st = shift;
    defined $st->{filename}                                   or return undef;
    $st->{tick} =
      File::AptFetch::ConfigData->config( q|tick| )        unless $st->{tick};
    $st->{flag} = 5                                unless defined $st->{flag};
    $st->{tmp} = ( glob qq|$st->{filename}*| )[0]   unless defined $st->{tmp};
    unless( defined $st->{tmp} )                                    {
# TODO:201403040310:whynot: Here comes diagnostics.
# warn sprintf qq|(%s) (%i): missing, ticks left\n|, ( split m{/}, $st->{filename} )[-1], $st->{flag} - 1
                                                                     }
    elsif( !-f $st->{tmp}      )                                    {
# TODO:201403040310:whynot: Here could be diagnostics too.
# warn sprintf qq|(%s): disappeared, forcing sync\n|, ( split m{/}, $st->{filename} )[-1];
        undef $st->{tmp}                                             }
    else                                                            {
        @$st{qw| size back |} = ( -s $st->{tmp}, $st->{size} || 0 );
        $st->{factor} = $st->{size} / ( $st->{tick} * 15 * 1024 * 1024 );
        $st->{factor} = 1                                if 1 > $st->{factor};
        $st->{flag} = 5 * $st->{factor} if $st->{size} - $st->{back} }
    0 < $st->{flag}-- }

set_callback read => \&_read_callback;

=back

=cut

=head1 DIAGNOSTICS

Most error communication is done through give-up codes.
However, some conditions aren't worth of keeping process alive -- those are
marked as B<(fatal)>.
Others are (mostly) in just B<fork>ed process that just couldn't boot
properly -- those are communicated back (somehow).

=over

=item (%s): candiate to pass is neither CODE nor (undef)

B<(fatal)>
In L</set_callback()>.
Tag C<%s> (may be unknown) tries to set something for callback.
That must be either CODE or C<undef>.
It's not.

=item (%s): unknown callback

B<(fatal)>
In L</set_callback()>.
Tag C<%s> is unknown.
Nothing to do with it but B<croak>.

=item [close] (reader): $!

In L</DESTROY()> (that's why it's not fatal).
Closing I<STDIN> of child has failed.
Nothing to do with it except blast ahead
(probably, would stuck in B<waitpid> then).

=item [close] (writer): $!

In L</DESTROY()> (that's why it's not fatal).
Closing I<STDOUT> of child has failed.
Nothing to do with it except blast ahead
(probably, would stuck in B<waitpid> then).

=item [dup] (STDIN): $!

In L</init()>.
Turning reader pipe into I<STDIN> has failed.
Parent will express it with S<($method): ($?): died without handshake> give-up
code.