view release on metacpan or  search on metacpan

lib/Authen/NZRealMe/XMLEnc.pm  view on Meta::CPAN

    $xc->registerNs( NS_PAIR('xenc') );
    $xc->registerNs( NS_PAIR('ds') );

    while(@namespaces) {
        my $prefix = shift @namespaces;
        my $uri    = shift @namespaces;
        $xc->registerNs($prefix, $uri);
    }

    return $xc;
}


sub _decrypt_one_encrypted_data_element {
    my($self, $xc, $ed_node) = @_;

    my $algorithm_uri = $xc->findvalue(
        './xenc:EncryptionMethod/@Algorithm', $ed_node
    );
    my $algorithm = $self->_find_enc_alg($algorithm_uri);

    my $key = eval {
        $self->_extract_encrypted_key($xc, $ed_node);
    } or do {
        die "Error decrypting <KeyInfo> for"
          . " algorithm=$algorithm->{name} error: $@";
    };

    my $b64_value = $xc->findvalue(
        './xenc:CipherData/xenc:CipherValue', $ed_node
    ) or die "Unable to find <CipherData><CipherValue> for <EncryptedData>";
    my $ciphertext = decode_base64($b64_value);
    my $plaintext = eval {
        $self->_decrypt($algorithm, $key, $ciphertext);
    } or do {
        die "Error decrypting <EncryptedData> using"
          . " algorithm=$algorithm->{name} error: $@";
    };
    return $plaintext;
}


sub _extract_encrypted_key {
    my($self, $xc, $ed_node) = @_;

    my($key_info) = $xc->findnodes('./ds:KeyInfo', $ed_node)
        or die "Unable to find <KeyInfo> in <EncryptedData> element";
    my($encrypted_key) = $xc->findnodes('./xenc:EncryptedKey', $key_info)
        or die "Unable to find <EncryptedKey> in <KeyInfo> element";

    my $algorithm_ns = $xc->findvalue(
        './xenc:EncryptionMethod/@Algorithm', $encrypted_key
    ) or die "Unable to find Algorithm in <EncryptedKey>";
    my $algorithm = $self->_find_enc_alg($algorithm_ns);

    my $b64_value = $xc->findvalue(
        './xenc:CipherData/xenc:CipherValue', $encrypted_key
    ) or die "Unable to find <CipherData><CipherValue> for <EncryptedKey>";
    my $ciphertext = decode_base64($b64_value);

    return $self->_decrypt($algorithm, $self->rsa_private_key, $ciphertext);
}


sub _encrypt_bytes {
    my($self, $algorithm, @args) = @_;

    my $method = $algorithm->{encrypt_method}
        or die "no encrypt_method for $algorithm->{name}";

    $self->$method(@args);
}


sub rsa_private_key {
    my($self) = @_;

    return Crypt::OpenSSL::RSA->new_private_key($self->key_text);
}


sub rsa_public_key {
    my($self) = @_;

    return Crypt::OpenSSL::RSA->new_public_key($self->pub_key_text);
}


sub pub_key_text {
    my($self) = @_;

    return $self->{pub_key_text} if $self->{pub_key_text};

    my $cert_text = $self->pub_cert_text();
    my $x509 = Crypt::OpenSSL::X509->new_from_string($cert_text);
    $self->{pub_key_text} = $x509->pubkey();

    return $self->{pub_key_text};
}


sub pub_cert_text {
    my($self) = @_;

    return $self->{pub_cert_text} if $self->{pub_cert_text};
    my $path = $self->{pub_cert_file}
        or croak "signing cert must be set with 'pub_cert_file' or 'pub_cert_text'";

    $self->{pub_cert_text} = $self->_slurp_file($path);

    return $self->{pub_cert_text};
}


sub key_text {
    my($self) = @_;

    return $self->{key_text} if $self->{key_text};

    my $path = $self->{key_file}
        or croak "signing key must be set with 'key_file' or 'key_text'";

    $self->{key_text} = $self->_slurp_file($path);

    return $self->{key_text};
}


sub _slurp_file {
    my($self, $path) = @_;

    local($/) = undef;
    open my $fh, '<', $path or die "open($path): $!";
    my $text = <$fh>;

    return $text;
}

lib/Authen/NZRealMe/XMLEnc.pm  view on Meta::CPAN

sub _key_gen_aes128cbc {
    my($self) = @_;

    my $aes128_key  = random_bytes(Crypt::Cipher::keysize('AES'));
    my $iv          = random_bytes(Crypt::Cipher::blocksize('AES'));
    return {
        key   => $aes128_key,
        iv    => $iv,
    };
}


sub _decrypt_aes256cbc {
    my($self, $aes256_key, $ciphertext) = @_;

    my $cipher    = 'AES';
    my $padding   = 0; # no padding - we handle that below
    my $blocksize = Crypt::Cipher::blocksize($cipher);
    my $iv        = substr($ciphertext, 0, $blocksize, '');
    my $cbc = Crypt::Mode::CBC->new($cipher, $padding);
    my $plaintext = $cbc->decrypt($ciphertext, $aes256_key, $iv);
    return $self->_strip_padding($plaintext, $blocksize);
}


sub _encrypt_aes256cbc {
    my($self, $key_info, $plaintext) = @_;

    my $cipher     = 'AES';
    my $padding    = 0; # no padding - we handle that below
    my $blocksize  = Crypt::Cipher::blocksize($cipher);
    my $aes256_key = $key_info->{key} or die "No key in key_info";
    my $iv         = $key_info->{iv}  or die "No iv in key_info";
    $plaintext     = $self->_add_padding($plaintext, $blocksize);
    my $cbc = Crypt::Mode::CBC->new($cipher, $padding);
    my $ciphertext = $cbc->encrypt($plaintext, $aes256_key, $iv);
    return $ciphertext;
}


sub _key_gen_aes256cbc {
    my($self) = @_;

    my $aes256_key  = random_bytes(Crypt::Cipher::keysize('AES'));
    my $iv          = random_bytes(Crypt::Cipher::blocksize('AES'));
    return {
        key   => $aes256_key,
        iv    => $iv,
    };
}

1;

__END__

=head1 SYNOPSIS

  my $decrypter = Authen::NZRealMe->class_for('xml_encrypter')->new(
      pub_cert_file => $self->signing_cert_pathname,
      key_file      => $path_to_private_key_file,
  );

  my $xml = $decrypter->decrypt_encrypted_data_elements($xml);

=head1 METHODS

=head2 new( )

Constructor.  Generally called indirectly via the
L<Authen::NZRealMe::ServiceProvider/resolve_posted_assertion> method, which
does so like this:

  Authen::NZRealMe->class_for('xml_encrypter')->new( options );

Options are passed in as key => value pairs.

For decryption, the Service Provider's RSA signing private key must be passed
to the constructor using either the C<key_text> or the C<key_file> option.
This key is used to decrypt the random key used by the block cipher to encrypt
the assertion.

In normal use (consuming assertions from the RealMe service), this module is
never called upon to perform encryption.  It does include an implementation of
encryption for use by the test suite.  When creating an encrypted assertion,
two rounds of encryption are performed.  First, an AES key is generated at
random and used by the block cipher to encrypt the assertion.  Next, the AES
key is encrypted using the Service Provider's RSA public key and the result is
included along with the encrypted assertion.  See the test suite for more
details.

=head2 decrypt_encrypted_data_elements( $xml )

Takes an XML document (as a string) and returns a modified version (also as a
string) in which all C<< <EncryptedData> >> elements are replaced with the
unencrypted document fragment.

=head2 encrypt_one_element

Currently only needed by the test suite, which calls it like this:

  my $encrypted_xml = $encrypter->encrypt_one_element($signed_xml,
      algorithm => 'xenc_aes128cbc',
      target_id => $target_id,
  );

Returns a new XML string in which one element from the supplied XML document
has been replaced with an C<< <EncryptedData> >> element.

=head2 id_attr

An accessor method for the attribute name used by C<encrypt_one_element> to
find the target element to be encrypted.  The default name is 'ID', and can be
overriden by passing a new value for the 'id_attr' option to the constructor.

=head2 key_text

An accessor for the PEM-encoded text used to instantiate an RSA private key
object for decryption.  The value can be supplied directly using the
'key_text' argument to the constructor, or indirectly with the 'key_file'
argument.

=head2 pub_cert_text

An accessor for the PEM-encoded text used to instantiate an X509 certificate
which in turn is used to create an RSA public key object for encryption.  The
value can be supplied directly using the 'pub_cert_text' argument to the
constructor, or indirectly with the 'pub_cert_file' argument.

=head2 pub_key_text

An accessor for the PEM-encoded text used to instantiate an RSA public key
object for encryption.  The value can be supplied directly using the
'pub_key_text' argument to the constructor, or indirectly with the
'pub_cert_text' or 'pub_cert_file' arguments.

=head2 register_encryption_algorithm

Used at module-load-time to register handler methods for each supported
encryption algorithm - i.e.: the method is called once per algorithm.  A
sub-class which added support for addition algorithms would need to ensure that
this routine is called for each.

=head2 rsa_private_key

Accessor method which returns a L<Crypt::OpenSSL::RSA> private key object
using the C<key_text> method.

=head2 rsa_public_key

Accessor method which returns a L<Crypt::OpenSSL::RSA> public key object
using the C<pub_key_text> method.

=head1 SUPPORTED ALGORITHMS

=head2 rsa15 - RSAES-PKCS1-v1_5

Used only to encrypt/decrypt the random key which in turn is used by the block
cipher to encrypt the XML element data. This is used by the old RealMe service to
encrypt the random key.

=head2 aes128cbc - AES128-CBC

This is the oold supported block cipher used for the encryption/decryption of
XML elements.  Whilst it is recognised that use of this cipher is not
recommended due to concerns about its security, it is the cipher used by the
RealMe service to encrypt SAML assertions.

=head2 rsa_oaep_mgf1p - RSA-OAEP-MGF1P

Used only to encrypt/decrypt the random key which in turn is used by the block
cipher to encrypt the XML element data. This is used by the new RealMe service to
encrypt the random key.

=head2 aes256cbc - AES256-CBC

This is the supported block cipher used for the encryption/decryption
of XML elements.  This is the cipher used by the new RealMe service to
encrypt SAML assertions.

=head1 SEE ALSO

See L<Authen::NZRealMe> for documentation index.


=head1 LICENSE AND COPYRIGHT

Copyright (c) 2010-2022 Enrolment Services, New Zealand Electoral Commission

Written by Grant McLean E<lt>grant@catalyst.net.nzE<gt>

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut