build

#!/usr/bin/env perl

use strict;
use warnings;
use Scalar::Util ();
use autodie;
use Getopt::Long;
use Path::Tiny;
use Digest::SHA;
use POSIX ();

sub usage {
  die "Usage: $0 [--push] [--filter=s] [--check] [--emit-matrix]\n";
}

my %cfg = (repo => 'melopt/perl-alt');
GetOptions(\%cfg, 'help|?', 'push', 'filter=s', 'repo=s', 'multiplatform', 'check', 'debug', 'emit-matrix')
  or usage();
usage() if $cfg{help};

my $repo = $cfg{repo};

## Image provenance: derive the git origin URL and commit so every build is
## labelled (OCI image-spec annotations). Applied via --label below, so they
## land on all targets/bases without touching any Dockerfile.
my %git = git_provenance();
$git{created} = POSIX::strftime('%Y-%m-%dT%H:%M:%SZ', gmtime);    # RFC 3339 UTC
## to STDERR so it never pollutes machine-readable stdout (e.g. --emit-matrix)
print STDERR ">>>> provenance: source=$git{source} revision=$git{revision} created=$git{created}\n\n";

sub git_provenance {
  chomp(my $sha    = qx{git rev-parse HEAD 2>/dev/null});
  chomp(my $dirty  = qx{git status --porcelain 2>/dev/null});
  chomp(my $remote = qx{git config --get remote.origin.url 2>/dev/null});

  $sha = 'unknown' unless length $sha;
  $sha .= '-dirty' if length $dirty;

  ## normalize the origin to an https browse URL:
  ##   git@github.com:melo/foo.git      -> https://github.com/melo/foo
  ##   ssh://git@github.com/melo/foo.git -> https://github.com/melo/foo
  if (length $remote) {
    $remote =~ s{^git\@([^:]+):}{https://$1/};
    $remote =~ s{^ssh://git\@([^/]+)/}{https://$1/};
    $remote =~ s{\.git$}{};
  }
  else {
    $remote = 'unknown';
  }

  return (source => $remote, revision => $sha);
}

my @versions = (
  ['perl',       'latest', '5.44-slim', 1],
  ['perl',       'full',   '5.44'],
  ['alpine',     'latest', '3.24'],
  ['alpine',     'next',   'edge'],
  ['alpine',     'edge',   'edge'],
  ['chainguard', 'latest', 'latest', undef, 'cgr.dev/chainguard/wolfi-base'],
);

## (family, target) pairs we deliberately do NOT build. Currently none: devel/reply
## build on every base. (They previously failed on threaded perl >= 5.42 because
## Perl::LanguageServer dragged in Coro 6.57, which does not compile there; we dropped
## Perl::LanguageServer from the devel layer, so the whole class of failure is gone.)
my %skip = ();
sub is_skipped { my ($f, $target) = @_; return $skip{$f} && $skip{$f}{$target} }

## Single source of truth for what gets built and how it is tagged. Returns a list of
## image specs, each with the registry-agnostic tag suffixes (CI prefixes them with each
## registry/repo; the local build loop prefixes with "$repo:"). Both the local build and
## `--emit-matrix` consume this, so tags never drift between them.
sub image_matrix {
  my @out;
  for my $spec (@versions) {
    my ($f, $t, $v, $x, $bi) = @$spec;
    $bi = $f unless $bi;

    my $baset = "$f-$t";
    my $basev = "$f-$v";

    for my $target (qw( devel build runtime runtime-lambda reply )) {
      next if is_skipped($f, $target);

      my $tagx = $x                         ? $target  : '';
      my $tagl = $x && $target eq 'runtime' ? 'latest'  : '';

      my @suffixes = ("$baset-$target", "$basev-$target");
      push @suffixes, $tagx  if $tagx;
      push @suffixes, $tagl  if $tagl;
      push @suffixes, $baset if $target eq 'devel';

      ## dedupe, preserving order: when moniker == version (alpine-edge,
      ## chainguard-latest) the -t and -v suffixes collapse to the same string.
      my %seen;
      @suffixes = grep { !$seen{$_}++ } @suffixes;

      push @out,
        { family     => $f,
          moniker    => $t,
          version    => $v,
          target     => $target,
          base       => "$bi:$v",
          dockerfile => "Dockerfile.$f",
          tags       => \@suffixes,
        };
    }
  }
  return @out;
}

## cpm installer (fatpacked skaji/cpm) - single source of truth, passed to all Dockerfiles
my %cpm = (
  url  => 'https://raw.githubusercontent.com/skaji/cpm/main/cpm',
  sha1 => 'c6a592f4a77e0dcdde64fb29b23a3c12ef5a27dc',
);

## Lambda
my %lambda_runtime_versions = (
  aarch64 => [
    'https://github.com/aws/aws-lambda-runtime-interface-emulator/releases/download/v1.35/aws-lambda-rie-arm64',
    '8159172a2dc2ce5bf434ba94d7241f2252d1ac30b58410c7e30a4b8afefd7cca',
  ],
  x86_64 => [
    'https://github.com/aws/aws-lambda-runtime-interface-emulator/releases/download/v1.35/aws-lambda-rie-x86_64',
    '3a3494331c212c14366c1073fdc4f0078f58a927da64479413879b0d84e21f20',
  ],
);
if ($cfg{check}) {
  ## cpm installer (SHA-1)
  check_hash('cpm', $cpm{url}, 1, $cpm{sha1});

  ## Lambda RIE (SHA-256)
  for my $arch (sort keys %lambda_runtime_versions) {
    my ($url, $wanted) = $lambda_runtime_versions{$arch}->@*;
    check_hash($arch, $url, 256, $wanted);
  }
  exit(0);
}

## Emit the build plan as JSON for the GitHub Actions pipeline (see
## .github/workflows/publish.yml). This is the single source of truth: CI never
## hard-codes versions, tags, or build-args - it reads them from here.
if ($cfg{'emit-matrix'}) {
  require JSON::PP;
  my $plan = {
    buildargs => {
      CPM_URL                    => $cpm{url},
      CPM_SHA1                   => $cpm{sha1},
      AWS_LAMBDA_RIE_URL_aarch64 => $lambda_runtime_versions{aarch64}[0],
      AWS_LAMBDA_RIE_SIG_aarch64 => $lambda_runtime_versions{aarch64}[1],
      AWS_LAMBDA_RIE_URL_x86_64  => $lambda_runtime_versions{x86_64}[0],
      AWS_LAMBDA_RIE_SIG_x86_64  => $lambda_runtime_versions{x86_64}[1],
    },
    images => [image_matrix()],
  };
  print JSON::PP->new->canonical->encode($plan), "\n";
  exit(0);
}

sub check_hash {
  my ($label, $url, $algo, $wanted) = @_;

  my $tmp = Path::Tiny->tempfile;
  unless (fetch_url($url, $tmp)) {
    print "download-failed: $label $url\n\t(could not fetch after retries)\n";
    return;
  }

  my $d = Digest::SHA->new($algo);
  $d->addfile($tmp->stringify);
  my $got = $d->hexdigest;

  my $status = $wanted eq $got ? 'ok' : 'out-of-date';
  print "$status: $label $url\n\twanted $wanted\n\tactual $got\n\tfile $tmp\n";
}

## Download $url into $dest. Detects GitHub rate-limits (HTTP 429, and 403 for
## secondary limits) and retries them - plus 5xx and transport errors - with
## increasing back-off, up to 5 attempts. A 2xx download hashes the real payload
## instead of a rate-limit error page. Non-retryable errors (e.g. 404) fail fast.
sub fetch_url {
  my ($url, $dest) = @_;

  my $max = 5;
  for my $attempt (1 .. $max) {
    ## No -f: we want the HTTP status even on error, via -w, to tell rate-limits apart.
    open(my $fh, '-|', '/usr/bin/curl', '-sSL', '-o', "$dest", '-w', '%{http_code}', $url)
      or die "FATAL: cannot run curl: $!\n";
    my $code = do { local $/; <$fh> };
    close($fh);
    my $curl_err = $? >> 8;
    ($code) = (($code // '') =~ /(\d+)/);
    $code //= 0;

    return 1 if !$curl_err && $code >= 200 && $code < 300;

    my $rate_limited = ($code == 429 || $code == 403);
    my $retryable    = $rate_limited || $code >= 500 || $curl_err;
    last if !$retryable || $attempt == $max;

    my $sleep = 2**$attempt;    # 2, 4, 8, 16 seconds - increasing back-off
    my $why =
        $rate_limited ? "GitHub rate-limit (HTTP $code)"
      : $code         ? "HTTP $code"
      :                 "curl error $curl_err";
    warn ">>>> $why fetching $url; retry $attempt/$max after ${sleep}s\n";
    sleep($sleep);
  }
  return 0;
}

## Multiplatform support
my @plats;
my $docker_cmd = 'docker';
if ($cfg{multiplatform}) {
  $docker_cmd = 'nerdctl';
  push @plats, '--platform', 'linux/arm64,linux/amd64';
  print ">>>>>>>>>>> MULTIPLATFORM Build detected: @plats\n";
  sleep(5);
}

for my $img (image_matrix()) {
  my ($f, $target, $v) = @{$img}{qw( family target version )};
  my @itags = map {"$repo:$_"} @{ $img->{tags} };
  my $tagt  = $itags[0];

  if ($cfg{filter} and $tagt !~ m/$cfg{filter}/) {
    print ">>>>>>>> Skipped via filter '$cfg{filter}': $tagt\n";
    next;
  }

  print ">>>> target $target, base $v: $_\n" for @itags;
  print "\n";

  my @cmd = ($docker_cmd, 'build');
  push @cmd, '--progress', 'plain' if $cfg{debug};
  push @cmd, @plats if @plats;
  push @cmd, '--target' => $target;
  push @cmd, '--file'   => $img->{dockerfile};
  push @cmd, map { ('--tag', $_) } @itags;
  push @cmd,
    '--label' => 'maintainer=Pedro Melo <melo@simplicidade.org>',
    '--label' => "org.opencontainers.image.source=$git{source}",
    '--label' => "org.opencontainers.image.url=$git{source}",
    '--label' => "org.opencontainers.image.revision=$git{revision}",
    '--label' => "org.opencontainers.image.created=$git{created}";
  push @cmd,
    '--build-arg' => "BASE=$img->{base}",
    '--build-arg' => "CPM_URL=$cpm{url}",
    '--build-arg' => "CPM_SHA1=$cpm{sha1}",
    '--build-arg' => "AWS_LAMBDA_RIE_URL_aarch64=$lambda_runtime_versions{aarch64}[0]",
    '--build-arg' => "AWS_LAMBDA_RIE_SIG_aarch64=$lambda_runtime_versions{aarch64}[1]",
    '--build-arg' => "AWS_LAMBDA_RIE_URL_x86_64=$lambda_runtime_versions{x86_64}[0]",
    '--build-arg' => "AWS_LAMBDA_RIE_SIG_x86_64=$lambda_runtime_versions{x86_64}[1]";
  push @cmd, '.';

  my $err = my_system(@cmd);
  die "FATAL: failed to build Docker image for target $target, base $v: $tagt\n" if $err;

  if ($cfg{push}) {
    my_system($docker_cmd, 'push', @plats, $_) for @itags;
  }
}


print "\n\n>>> DONE\n\n";

sub my_system {
  print "\n\n>>>>>>>> Cmd: @_\n\n";
  return system(@_);
}