view release on metacpan or  search on metacpan

lib/AWS/Signature/V4/X509.pm  view on Meta::CPAN

   open my $fh, '<:raw', $file or fail 400, 'open(' . shown($file) . "): $!";
   local $/;
   my $data = <$fh>;
   close $fh;
   return $data;
}

sub _to_ders ($cert) {    # PEM bundles hold many certificates
   return _check_der($cert) unless $cert =~ m{-----BEGIN};
   my @ders = map { decode_base64($_) }
      $cert =~ m{-----BEGIN CERTIFICATE-----(.*?)-----END CERTIFICATE-----}sg;
   @ders or fail 400, 'no CERTIFICATE block in PEM';
   return map { _check_der($_) } @ders;
}

sub _to_der ($cert) {
   return _check_der($cert) unless $cert =~ m{-----BEGIN};
   $cert =~ m{-----BEGIN CERTIFICATE-----(.*?)-----END CERTIFICATE-----}s
      or fail 400, 'no CERTIFICATE block in PEM';
   return _check_der(decode_base64($1));
}

# a certificate is a DER SEQUENCE that fits exactly in the data
sub _check_der ($der) {
   my ($tag, undef, $end) = _tlv($der, 0);
   fail 400, 'not a DER-encoded certificate'
      unless $tag == 0x30 && $end == length $der;
   return $der;
}

# read one DER TLV at $off => (tag, content_start, content_end)
sub _tlv ($der, $off) {
   my $max = length $der;
   $off + 2 <= $max or fail 400, 'truncated certificate';
   my $tag = ord substr $der, $off++, 1;
   my $len = ord substr $der, $off++, 1;
   if ($len & 0x80) {    # long form, DER wants it minimal and definite
      my $n = $len & 0x7F;
      fail 400, 'not a DER-encoded certificate' if $n == 0 || $n > 4;
      $off + $n <= $max or fail 400, 'truncated certificate';
      $len = 0;
      $len = ($len << 8) | ord substr($der, $off++, 1) for 1 .. $n;
      fail 400, 'not a DER-encoded certificate'
         if $len < 0x80 || $len < 1 << 8 * ($n - 1);
   }
   $off + $len <= $max or fail 400, 'truncated certificate';
   return ($tag, $off, $off + $len);
}

# Certificate ::= SEQ { tbs SEQ { [0] version?, INTEGER serial, ... }, ... }
sub _certificate_serial ($der) {
   my (undef, $cs) = _tlv($der, 0);
   my (undef, $ts) = _tlv($der, $cs);
   my ($tag, $s, $e) = _tlv($der, $ts);
   ($tag, $s, $e) = _tlv($der, $e) if $tag == 0xA0;    # skip explicit version
   fail 400, 'cannot find certificate serial number' unless $tag == 0x02;
   return Math::BigInt->from_hex(unpack 'H*', substr $der, $s, $e - $s)
      ->bstr;   # DER integers here are positive; leading 0x00 is harmless
}

# The error of CryptX, without the location and the backtrace that Carp adds
# when verbose (the arguments in it may hold the password), escaped as caller
# input because it can hold the file name.
sub _clean_error ($e) {
   $e =~ s{\n\t.*}{}s;    # the backtrace lines start with a tab
   $e =~ s{\s+at \S+ line \d+\.?\s*\z}{};
   return shown($e =~ s{\A\s+|\s+\z}{}gr);
}

# $key is a file name or a scalar reference to the PEM text
sub _cryptx_signer ($algo, $key, $password = undef) {
   my $class = $algo eq 'RSA' ? 'Crypt::PK::RSA' : 'Crypt::PK::ECC';
   eval "require $class; 1" or fail 500, "cannot load $class";
   my @args = ($key, defined $password ? ($password) : ());
   my $pk = eval {
      # no backtrace, e.g. from -MCarp=verbose or Carp::Always, with the password
      local $Carp::Verbose = 0;
      local $Carp::MaxArgNums = -1;
      local $SIG{__DIE__};
      $class->new(@args);
   } // fail 400, "cannot load the private key: " . _clean_error($@);
   fail 400, 'the key is not a private key' unless $pk->is_private;
   return $algo eq 'RSA'
      ? sub ($bytes) { $pk->sign_message($bytes, 'SHA256', 'v1.5') }
      : sub ($bytes) { $pk->sign_message($bytes, 'SHA256') };
}

use namespace::clean;

# The certificate-based variant, as used by IAM Roles Anywhere. The options
# are the ones of the "x509" option of AWS::Signature::V4:
#   certificate / certificate_file: PEM or DER text, or path of a file with it;
#                only the first certificate of a PEM bundle is used
#   chain / chain_files: optional arrayref of PEM/DER intermediate certificates,
#                or of paths of files with them; a PEM item can be a bundle.
#                chain can also be a plain string: a PEM-encoded bundle, and
#                chain_files a plain string: the path of one file
#   key_type:    'RSA' or 'ECDSA'
#   serial:      the serial number of the certificate, if it cannot be found
#   signer:      sub ($bytes_to_sign) -> raw signature bytes (DER for ECDSA,
#                PKCS#1 v1.5 for RSA), computed with SHA-256; or, alternatively,
#   private_key_file / private_key: PEM or DER key (path or content, the
#                content wins), signed with CryptX; private_key_password if it
#                is encrypted
has [qw<
   key_type certificate certificate_file chain chain_files serial signer
   private_key_file
>] => (is => 'ro');

# the key text and its password are secrets, only needed to load the key:
# no public accessor, and they are dropped as soon as the key is loaded
has $_ => (is => 'ro', reader => "_$_", clearer => "_clear_$_")
   for qw< private_key private_key_password >;

# Derived from the options above. Lazy, so that each builder can use the
# others without depending on the order in which the constructor sets things
# up; BUILD forces them all, so that a bad certificate, chain or key is
# reported by new() and not by the first signature.
#
# **NOTE**: to add one, add its name here and write its builder.
my @DERIVED = qw< algorithm credential_id _chain _der _signer _type >;
has $_ => (is => 'lazy', init_arg => undef) for @DERIVED;

sub BUILD ($self, $args) {
   my %known = map { $_ => 1 } qw<
      key_type certificate certificate_file chain chain_files serial signer
      private_key_file private_key private_key_password
   >;
   if (my ($name) = sort(grep { !$known{$_} } keys $args->%*)) {
      fail 400, 'unknown option "' . shown($name) . '" in x509';
   }
   for my $name (@DERIVED) {    # not "for (...)": builders may use $_
      $self->$name;
   }

   # we don't need private key material past this point, so we get rid
   # of it immediately. Of course it may still linger in memory depending
   # on garbage collection.
   $self->_clear_private_key;
   $self->_clear_private_key_password;
   return;