view release on metacpan or  search on metacpan

lib/Dist/Zilla/Plugin/Docker/API/Client.pm  view on Meta::CPAN

# engine's business: build_image passes that as its own dockerfile option.
sub _create_tar {
    my ($self, $dir) = @_;

    my $root = Path::Tiny::path($dir);
    my $tar  = Archive::Tar->new;

    for my $entry ($self->_collect_files($root, $root)) {
        my $name = $entry->relative($root)->stringify;
        my @stat = lstat $entry->stringify;
        my %opt  = ( mode => $stat[2] & 07777, mtime => $stat[9] );

        if (-l $entry->stringify) {
            $tar->add_data($name, '', {
                %opt, type => Archive::Tar::Constant::SYMLINK(),
                linkname => readlink($entry->stringify),
            });
        }
        elsif (-d _) {
            $tar->add_data($name, '', { %opt, type => Archive::Tar::Constant::DIR() });
        }
        else {
            $tar->add_data($name, $entry->slurp_raw, \%opt);
        }
    }

    my $tarball;
    open my $fh, '>', \$tarball;
    $tar->write($fh, 1);
    close $fh;

    return \$tarball;
}

# Regular files, symlinks (never followed) and empty directories below $dir.
sub _collect_files {
    my ($self, $root, $dir) = @_;

    my @files;
    for my $entry ($dir->children) {
        if (-l $entry->stringify) {
            push @files, $entry;
        }
        elsif ($entry->is_dir) {
            my @below = $self->_collect_files($root, $entry);
            push @files, @below ? @below : $entry;
        }
        else {
            push @files, $entry;
        }
    }
    return @files;
}

sub auth_for_image_ref {
    my ($self, $image_ref) = @_;
    my $registry = $self->_registry_for_image_ref($image_ref);
    # Walk the parsed auth files in order and run the per-file registry
    # selection against each. The first file with a usable entry for this
    # registry wins; a file that has none falls through to the next, so a
    # docker config.json and a podman auth.json can each supply credentials
    # for different registries.
    for my $config (@{ $self->_auth_configs }) {
        my $auth = $self->_auth_for_registry($registry, $config);
        return $auth if defined $auth;
    }
    return undef;
}

sub _registry_for_image_ref {
    my ($self, $image_ref) = @_;

    # Strip ":tag" or "@sha256:..." suffix from the image part.
    my $name = $image_ref;
    $name =~ s/\@sha256:.*$//;
    my @parts = split m{/}, $name;

    # If the first component does NOT look like a registry host
    # (no dot, no colon, not "localhost"), it's an implicit Docker Hub repo.
    if (@parts < 2 || ($parts[0] !~ /[.:]/ && $parts[0] ne 'localhost')) {
        return 'https://index.docker.io/v1/';
    }
    return $parts[0];
}

sub _auth_for_registry {
    my ($self, $registry, $config) = @_;

    my $auths = $config->{auths} // {};

    my @candidates = ($registry);
    if ($registry eq 'https://index.docker.io/v1/'
        || $registry eq 'index.docker.io'
        || $registry eq 'docker.io') {
        push @candidates,
            'https://index.docker.io/v1/',
            'https://index.docker.io/v2/',
            'index.docker.io',
            'docker.io';
    }

    my $entry;
    for my $key (@candidates) {
        if (exists $auths->{$key}) {
            $entry = $auths->{$key};
            last;
        }
    }
    return undef unless $entry;

    my %auth = (serveraddress => $registry);

    if ($entry->{identitytoken}) {
        $auth{identitytoken} = $entry->{identitytoken};
        return \%auth;
    }

    if ($entry->{auth}) {
        my $decoded = eval { decode_base64($entry->{auth}) };
        if (defined $decoded && $decoded =~ /^([^:]+):(.*)$/s) {
            $auth{username} = $1;

lib/Dist/Zilla/Plugin/Docker/API/Client.pm  view on Meta::CPAN

    my $auth = exists $arg{auth} ? $arg{auth} : $self->auth_for_image_ref($image_ref);

    my $events;
    eval {
        $events = $self->docker->images->push($image_ref, auth => $auth);
    };

    if (my $err = $@) {
        # API::Docker 0.004 croaks on a push failure instead of handing back the
        # errorDetail event in the returned array (against Docker an
        # API::Docker::Error::Stream with ->events, on Podman it may be a plain
        # HTTP error). Pull the message off the stream event when it is there,
        # otherwise report the exception itself (api-docker #12).
        my $message = "$err";
        if (ref $err && $err->can('events')) {
            for my $event (@{ $err->events }) {
                next unless $event->{errorDetail};
                $message = $event->{errorDetail}{message};
                last;
            }
        }
        $self->logger_fatal->("Push error: " . $message);
    }

    # A success still returns the raw array; keep scanning it, defensively, in
    # case an engine reports a failure inside a 200 stream.
    for my $event (@{$events // []}) {
        if ($event->{errorDetail}) {
            $self->logger_fatal->("Push error: " . $event->{errorDetail}{message});
        }
    }
}

sub inspect_image {
    my ($self, $image_ref) = @_;

    return $self->docker->images->inspect($image_ref);
}

# Ask the *registry* whether a reference is already published, through the
# engine's GET /distribution/{name}/json. Credentials are optional: without
# any, the lookup is anonymous, which is what a public image needs.
#
# API::Docker's exists() croaks instead of answering "no" when the engine has
# no /distribution route -- rootless Podman has none, measured -- and that
# croak is deliberately not caught here. "This engine cannot answer" is not
# the same as "the tag is free", and only the caller can decide what to do
# about the difference.
sub remote_tag_exists {
    my ($self, $image_ref) = @_;

    my $auth = $self->auth_for_image_ref($image_ref);

    return $self->docker->distribution->exists(
        $image_ref,
        defined $auth ? ( auth => $auth ) : (),
    ) ? 1 : 0;
}

# Pre-flight for the release push: hand the engine, through POST /auth, the
# very credentials push_image would use for this reference and let the
# registry judge them. A rejected credential croaks; the caller is meant to
# make that fatal before anything is built.
#
# Returns undef when no credential could be resolved for the reference. That
# is not a failure -- an anonymous push to a public registry is a legal thing
# to do, and system->auth croaks on an empty AuthConfig, so there would be
# nothing to ask about.
sub verify_auth_for_image_ref {
    my ($self, $image_ref) = @_;

    my $auth = $self->auth_for_image_ref($image_ref);
    return undef unless $auth;

    return $self->docker->system->auth(auth => $auth);
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Dist::Zilla::Plugin::Docker::API::Client - Thin adapter around API::Docker

=head1 VERSION

version 0.105

=head1 SUPPORT

=head2 Issues

Please report bugs and feature requests at
L<https://github.com/Getty/p5-dist-zilla-plugin-docker-api/issues>.

=head1 CONTRIBUTING

Contributions are welcome! Please fork the repository and submit a pull request.

=head1 AUTHOR

Torsten Raudssus <getty@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut