view release on metacpan or  search on metacpan

lib/Crypt/Age/Primitives.pm  view on Meta::CPAN

    return hmac('SHA256', $mac_key, $header_bytes);
}


sub encrypt_payload {
    my ($class, $payload_key, $plaintext) = @_;

    # Perl's own test for the in-memory open below, hoisted so the failure
    # names its cause instead of arriving as EINVAL from the open. Why
    # utf8::downgrade rather than utf8::is_utf8 or a /[^\x00-\xff]/ scan, and
    # why mutating this copy is safe, is written out over the same check in
    # Crypt::Age::encrypt.
    utf8::downgrade($plaintext, 1)
        or croak 'plaintext must be a byte string: it holds a code point '
            .'above 0xFF, encode it before passing it in';

    open my $ifh, '<:raw', \$plaintext or croak "Cannot open input string: $!";

    my $output = '';
    open my $ofh, '>:raw', \$output or croak "Cannot open output string: $!";

    $class->encrypt_payload_fh($payload_key, $ifh, $ofh);

    close $ofh or croak "Cannot close output string: $!";
    close $ifh  or croak "Cannot close input string: $!";

    return $output;
}


sub encrypt_payload_fh {
    my ($class, $payload_key, $ifh, $ofh) = @_;

    my $counter = 0;
    my $is_final = 0;
    while (! $is_final) {
        my $chunk = $class->paranoid_read($ifh, CHUNK_SIZE);
        $is_final = eof($ifh);

        my $nonce = $class->_make_nonce($counter, $is_final);
        my $ae = Crypt::AuthEnc::ChaCha20Poly1305->new($payload_key, $nonce);

        my $ciphertext = $ae->encrypt_add($chunk);
        my $tag = $ae->encrypt_done;

        print {$ofh} $ciphertext, $tag;

        $counter++;
    }

    return;
}


sub decrypt_payload {
    my ($class, $payload_key, $ciphertext) = @_;

    # Same test, same reasons as in encrypt_payload above; the advice differs
    # because an age payload is binary, so a wide character in it means the
    # caller decoded bytes that were never text.
    utf8::downgrade($ciphertext, 1)
        or croak 'ciphertext must be a byte string: it holds a code point '
            .'above 0xFF, read it with :raw rather than decoding it';

    open my $ifh, '<:raw', \$ciphertext or croak "Cannot open input string: $!";

    my $output = '';
    open my $ofh, '>:raw', \$output or croak "Cannot open output string: $!";

    $class->decrypt_payload_fh($payload_key, $ifh, $ofh);

    close $ofh or croak "Cannot close output string: $!";
    close $ifh  or croak "Cannot close input string: $!";

    return $output;
}


sub decrypt_payload_fh {
    my ($class, $payload_key, $ifh, $ofh) = @_;

    my $max_encrypted_chunk = CHUNK_SIZE + TAG_SIZE;
    my $counter = 0;
    while (1) {
        # Each encrypted chunk is plaintext + 16 byte tag
        my $ct = $class->paranoid_read($ifh, $max_encrypted_chunk);

        # paranoid_read only comes back short at end of file, so a short read
        # is how this loop learns the file ends here. A *full* read says
        # nothing either way: more chunks may follow, or this may be the final
        # chunk sitting flush against the end of the file.
        my $short_read = length($ct) < $max_encrypted_chunk;

        if ($short_read) {
            # Spec: "Streaming decryption MUST signal an error if the end of
            # file is reached without successfully decrypting a final chunk."
            croak 'Payload authentication failed at chunk '.$counter
                . ': end of file reached without a final chunk'
                if length($ct) == 0;
            croak 'Payload authentication failed at chunk '.$counter
                . ': chunk is shorter than its authentication tag'
                if length($ct) < TAG_SIZE;
            # Spec: "The final chunk MAY be shorter than 64 KiB but MUST NOT
            # be empty unless the whole payload is empty."
            croak 'Payload authentication failed at chunk '.$counter
                . ': final chunk is empty and is not the only chunk'
                if length($ct) == TAG_SIZE && $counter > 0;
        }

        my $tag = substr($ct, -TAG_SIZE, TAG_SIZE, '');

        # The final-chunk flag lives in the nonce, so the only way to learn
        # which nonce the writer used is to authenticate under it -- the
        # file's length cannot answer it. A short chunk can only be the final
        # one. A full chunk is tried as non-final first and, failing that, as
        # a full-length final chunk. No ciphertext can authenticate under both
        # nonces, so the second attempt cannot accept a chunk the writer did
        # not mark that way: it is a second verification, not a second chance.
        my $is_final = $short_read ? 1 : 0;
        my $plaintext = $class->_open_chunk($payload_key, $counter, $is_final, $ct, $tag);