view release on metacpan or  search on metacpan

t/09_checksums.t  view on Meta::CPAN

  my $payload = shift;
  return join '',
    "0&&<<''; # this PGP-signed message is also valid perl\n",
    "-----BEGIN PGP SIGNED MESSAGE-----\n",
    "Hash: SHA256\n",
    "\n",
    $payload,
    "-----BEGIN PGP SIGNATURE-----\n",
    "\n",
    "iQEcBAEBCAAGBQJfFAKEMINOTAREALSIGNATUREBASE64==\n",
    "=AAAA\n",
    "-----END PGP SIGNATURE-----\n";
}

sub run_verify_for_success
{
  my $body = shift;

  local $@;
  my $result = eval { App::MechaCPAN::_verify_checksums_body($body) };
  my $err    = $@;

  isnt( $result, '', 'run_verify_for_success did produce a result' );
  is( $err, '', 'run_verify_for_success did not have an error' );

  diag($err)
    if $err;

  return $result;
}

sub run_verify_for_error
{
  my $body = shift;

  local $@;
  my $result = eval { App::MechaCPAN::_verify_checksums_body($body) };
  my $err    = $@;

  is( $result, undef, 'run_verify_for_error did not have a result' );
  isnt( $err, undef, 'run_verify_for_error did have an error' );

  return $err;
}

# happy path: a properly clearsigned CHECKSUMS file
{
  my $text   = clearsign($basic_dd);
  my $result = run_verify_for_success($text);
  isnt( $result, undef, 'accepts a well-formed clearsigned CHECKSUMS document' );
}

# rejects: empty/undef input
{
  my $err = run_verify_for_error('');
  like( $err, qr/header-line mismatch/, 'rejects empty body' );
  $err = run_verify_for_error(undef);
  like( $err, qr/header-line mismatch/, 'rejects undef body' );
}

# tolerates extra whitespace / trailing newlines around the PGP frame
{
  my $text   = "\n\n" . clearsign($basic_dd) . "\n\n";
  my $result = run_verify_for_success($text);
  isnt( $result, undef, 'tolerates surrounding whitespace' );
}

my $verify = sub {die};

# rejects: not a clearsigned message at all
{
  my $text = $basic_dd;
  my $err  = run_verify_for_error($text);
  like( $err, qr/header-line mismatch/, 'rejects bare body with no perl prologue' );

  $text = "0&&<<''; # this PGP-signed message is also valid perl\n$text";
  $err  = run_verify_for_error($text);
  like( $err, qr/PGP header mismatch/, 'rejects bare body with no PGP wrapper' );
}

# rejects: prologue altered so the heredoc terminator is non-empty
# (a hostile mirror might leave the PGP frame intact but break the
# "also valid perl" invariant, causing a naive eval to fail)
{
  my $text = clearsign($basic_dd);
  $text =~ s/^0\&\&<<''/0\&\&<<'NOPE'/xms;
  my $err = run_verify_for_error($text);
  like( $err, qr/header-line mismatch/, 'rejects tampered prologue with non-empty heredoc terminator' );
}

# rejects: signed-message header present but no signature block
{
  my $text = "-----BEGIN PGP SIGNED MESSAGE-----\nHash: SHA256\n\n" . $basic_dd;
  my $err  = run_verify_for_error($text);
  like( $err, qr/header-line mismatch/, 'rejects truncated CHECKSUMS missing the signature block' );
}

# rejects: signature block present but no signed-message header
{
  my $text = $basic_dd . "-----BEGIN PGP SIGNATURE-----\nVersion: GnuPG v2\n\nAAAA\n-----END PGP SIGNATURE-----\n";
  my $err  = run_verify_for_error($text);
  like( $err, qr/header-line mismatch/, 'rejects truncated CHECKSUMS missing the signature block' );
}

# rejects: payload doesn't define $cksum at all
{
  my $text = clearsign("# nothing interesting here\n__END__\n");
  my $err  = run_verify_for_error($text);
  like( $err, qr/Unexpected perl code/, 'rejects payload with no $cksum assignment' );
}

# rejects: payload defines something other than a hashref
{
  my $text = clearsign("\$cksum = 'not a hashref';\n__END__\n");
  my $err  = run_verify_for_error($text);
  like( $err, qr/Unexpected perl code/, 'rejects payload where $cksum is not a hashref' );
}

# rejects: payload tries to do something dangerous (eval should be sandboxed)
{
  my $bad = <<'EOF';
$cksum = {
  'pwned' => {
  }
};
system("touch /tmp/mechacpan_pwned_$$");
__END__
EOF
  my $text = clearsign($bad);
  my $err  = run_verify_for_error($text);
  like( $err, qr/Unexpected footer/, 'rejects payload where $cksum is not a hashref' );
  is( -e "/tmp/mechacpan_pwned_$$", undef, 'sandboxed payload cannot reach system()' );

  unlink "/tmp/mechacpan_pwned_$$"
    if -e "/tmp/mechacpan_pwned_$$";
}

# tolerates CRLF line endings end-to-end
{
  my $text = clearsign($basic_dd);
  $text =~ s/\n/\r\n/g;
  my $result = run_verify_for_success($text);