File Coverage

blib/lib/Crypt/MagicSignatures/Envelope.pm

Criterion	Covered	Total	%
statement	229	237	96.6
branch	125	154	81.1
condition	36	41	87.8
subroutine	25	25	100.0
pod	14	14	100.0
total	429	471	91.0

package Crypt::MagicSignatures::Envelope;
use Crypt::MagicSignatures::Key qw/b64url_encode b64url_decode/;
use Carp 'carp';
use strict;
use warnings;
use Mojo::DOM;
use Mojo::JSON qw/encode_json decode_json/;
use Mojo::Util qw/trim/;

use v5.10.1;

our $VERSION = '0.15';

our @CARP_NOT;

# MagicEnvelope namespace
our $ME_NS = 'http://salmon-protocol.org/ns/magic-env';

sub _trim_all;

# Constructor
sub new {
  my $class = shift;

  my $self;

  # Bless object with parameters
  if (@_ > 1) {

    if (@_ % 2) {
      carp 'Wrong number of arguments';
      return;
    };

    my %param = @_;

    # Given algorithm is wrong
    if ($param{alg} &&
          uc($param{alg}) ne 'RSA-SHA256') {
      carp 'Algorithm is not supported';
      return;
    };

    # Given encoding is wrong
    if ($param{encoding} &&
          lc($param{encoding}) ne 'base64url') {
      carp 'Encoding is not supported';
      return;
    };

    # No payload is given
    unless (defined $param{data}) {
      carp 'No data payload defined';
      return;
    };

    # Create object
    $self = bless {}, $class;

    # Set data
    $self->data( delete $param{data} ) if $param{data};

    # Set data type if defined
    $self->data_type( delete $param{data_type} )
      if $param{data_type};

    # Append all defined signatures
    foreach ( @{$param{sigs}} ) {

      # No value is given
      next unless $_->{value};

      # Create new array reference if not already existing
      $self->{sigs} //= [];

      # Start new signature value
      my %sig = ( value => $_->{value} );
      $sig{key_id} = $_->{key_id} if exists $_->{key_id};

      # Add signature to signature array
      push(@{$self->{sigs}}, \%sig);
    };
  }

  # Envelope is defined as a string
  else {
    my $string = shift;

    # Construct object
    $self = bless { sigs => [] }, $class;

    # Create empty object
    return $self unless $string;

    $string = trim $string;

    # Message is me-xml
    if (index($string, '<') == 0) {

      # Parse xml string
      my $dom = Mojo::DOM->new(xml => 1)->parse($string);

      # Extract envelope from env or provenance
      my $env = $dom->at('env');
      $env = $dom->at('provenance') unless $env;

      # Envelope doesn't exist or is in wrong namespace
      if (!$env || $env->namespace ne $ME_NS) {
        carp 'Invalid envelope data';
        return;
      };

      # Retrieve and edit data
      my $data = $env->at('data');

      # The envelope is empty
      unless (defined $data) {
        carp 'No data payload defined';
        return;
      };

      my $temp;

      # Add data type if given
      $self->data_type( $temp ) if $temp = $data->attr->{type};

      # Add decoded data
      $self->data( b64url_decode( $data->text ) );

      # The envelope is empty
      unless ($self->data) {
        carp 'No data payload defined';
        return;
      };

      # Check algorithm
      if (($temp = $env->at('alg')) &&
            (uc $temp->text ne 'RSA-SHA256')) {
        carp 'Algorithm is not supported';
        return;
      };

      # Check encoding
      if (($temp = $env->at('encoding')) &&
            (lc $temp->text ne 'base64url')) {
        carp 'Encoding is not supported' and return;
      };

      # Find signatures
      $env->find('sig')->each(
        sub {
          my $sig_text = $_->text or return;

          my %sig = ( value => _trim_all $sig_text );

          if ($temp = $_->attr->{key_id}) {
            $sig{key_id} = $temp;
          };

          # Add sig to array
          push( @{ $self->{sigs} }, \%sig );
        });
    }

    # Message is me-json
    elsif (index($string, '{') == 0) {
      my $env;

      # Parse json object
      $env = decode_json $string;

      unless (defined $env) {
        return;
      };

      # Clone datastructure
      foreach (qw/data data_type encoding alg sigs/) {
        $self->{$_} = delete $env->{$_} if exists $env->{$_};
      };

      $self->data( b64url_decode( $self->data ));

      # Envelope is empty
      return unless $self->data;

      # Unknown parameters
      carp 'Unknown parameters: ' . join(',', %$env)
        if keys %$env;
    }

    # Message is me as a compact string
    elsif (index((my $me_c = _trim_all $string), '.YmFzZTY0dXJs.') > 0) {

      # Parse me compact string
      my $value = [];
      foreach (@$value = split(/\./, $me_c) ) {
        $_ = b64url_decode( $_ ) if $_;
      };

      # Given encoding is wrong
      unless (lc $value->[4] eq 'base64url') {
        carp 'Encoding is not supported' and return;
      };

      # Given algorithm is wrong
      unless (uc $value->[5] eq 'RSA-SHA256') {
        carp 'Algorithm is not supported' and return;
      };

      # Store sig to data structure
      for ($self->{sigs}->[0]) {
        next unless $value->[1];
        $_->{key_id} = $value->[0] if defined $value->[0];
        $_->{value}  = $value->[1];
      };

      # ME is empty
      return unless $value->[2];
      $self->data( $value->[2] );
      $self->data_type( $value->[3] ) if $value->[3];
    }

    # String is no valid envelope
    else {
      carp 'Invalid envelope data';
      return;
    };
  };

  # The envelope is signed
  $self->{signed} = 1 if $self->{sigs}->[0];

  return $self;
};


# Signature algorithm
sub alg { 'RSA-SHA256' };


# Encoding of the MagicEnvelope
sub encoding { 'base64url' };


# Data of the MagicEnvelope
sub data {

  # Return data
  return shift->{data} // '' unless defined $_[1];

  my $self = shift;

  # Delete calculated signature base string
  delete $self->{sig_base};

  # Delete DOM tree
  delete $self->{dom};

  return ($self->{data} = join ' ', map { $_ } @_);
};


# Datatype of the MagicEnvelope's content
sub data_type {

  # Return data type
  return shift->{data_type} // 'text/plain' unless defined $_[1];

  my $self = shift;

  # Delete calculated signature base string
  delete $self->{sig_base};

  # Delete DOM tree
  delete $self->{dom};

  return ($self->{data_type} = shift);
};


# Sign MagicEnvelope instance following the spec
sub sign {
  my $self = shift;

  return unless @_;

  return unless $self->data;

  # Get key and signature information
  my ($key_id, $mkey, $flag) = _key_array(@_);

  # Choose data to sign
  my $data = $flag eq '-data' ?
    b64url_encode($self->data) :
    $self->signature_base;

  # Regarding key id:
  # "If the signer does not maintain individual key_ids,
  #  it SHOULD output the base64url encoded representation
  #  of the SHA-256 hash of public key's application/magic-key
  #  representation."

  # A valid key needs to be available
  return unless $mkey;

  # No valid private key
  unless ($mkey->d) {
    carp 'Unable to sign without private exponent' and return;
  };

  # Compute signature for base string
  my $msig = $mkey->sign( $data );

  # No valid signature
  return unless $msig;

  # Sign envelope
  my %msig = ( value => $msig );
  $msig{key_id} = $key_id if defined $key_id;

  # Push signature
  push( @{ $self->{sigs} }, \%msig );

  # Declare envelope as signed
  $self->{signed} = 1;

  # Return envelope for piping
  return $self;
};


# Verify Signature
sub verify {
  my $self = shift;

  # Regarding key id:
  # "If the signer does not maintain individual key_ids,
  #  it SHOULD output the base64url encoded representation
  #  of the SHA-256 hash of public key's application/magic-key
  #  representation."

  # Not signed - not verifiable
  return unless $self->signed;

  my $verified = 0;
  foreach (@_) {

    my ($key_id, $mkey, $flag) = _key_array(
      ref $_ && ref $_ eq 'ARRAY' ? @$_ : $_
    );

    # No key given
    next unless $mkey;

    # Get signature
    my $sig = $self->signature($key_id);

    # Found key/sig pair
    if ($sig) {

      if ($flag ne '-data') {
        $verified = $mkey->verify($self->signature_base => $sig->{value});
        last if $verified;
      };

      # Verify against data
      if ($flag eq '-data' || $flag eq '-compatible') {

        # Verify with b64url data
        $verified = $mkey->verify(b64url_encode($self->data) => $sig->{value});
        last if $verified;
      };
    };
  };

  return $verified;
};


# Retrieve MagicEnvelope signatures
sub signature {
  my $self = shift;
  my $key_id = shift;

  # MagicEnvelope has no signature
  return unless $self->signed;

  my @sigs = @{ $self->{sigs} };

  # No key_id given
  unless ($key_id) {

    # Search sigs for necessary default key
    foreach (@sigs) {
      return $_ unless exists $_->{key_id};
    };

    # Return first sig
    return $sigs[0];
  }

  # Key is given
  else {
    my $default;

    # Search sigs for necessary specific key
    foreach (@sigs) {

      # sig specifies key
      if (defined $_->{key_id}) {

        # Found wanted key
        return $_ if $_->{key_id} eq $key_id;
      }

      # sig needs default key
      else {
        $default = $_;
      };
    };

    # Return sig for default key
    return $default;
  };

  # No matching sig found
  return;
};


# Is the MagicEnvelope signed?
sub signed {

  # There is no specific key_id requested
  return $_[0]->{signed} unless defined $_[1];

  # Check for specific key_id
  foreach my $sig (@{ $_[0]->{sigs} }) {
    return 1 if $sig->{key_id} && $sig->{key_id} eq $_[1];
  };

  # Envelope is not signed
  return 0;
};


# Generate and return signature base
sub signature_base {
  my $self = shift;

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

  return $self->{sig_base} =
    join('.',
         b64url_encode( $self->data, 0 ),
         b64url_encode( $self->data_type ),
         b64url_encode( $self->encoding ),
         b64url_encode( $self->alg )
       );
};


# Return the data as a Mojo::DOM if it is xml
sub dom {
  my $self = shift;

  # Already computed
  return $self->{dom} if $self->{dom};

  # No data defined to parse
  return unless $self->{data};

  # Create new DOM instantiation
  if (index($self->data_type, 'xml') >= 0) {
    my $dom = Mojo::DOM->new(xml => 1);
    $dom->parse( $self->{data} );

    # Return DOM instantiation (Maybe empty)
    return ($self->{dom} = $dom);
  };

  return;
};


# Return em-xml string
sub to_xml {
  my $self = shift;
  my $embed = shift;

  my $xml = '';

  my $start_tag = 'env';

  # Is a provenance me
  if ($embed) {
    $start_tag = 'provenance';
  }

  # Is a full document
  else {
    $xml = qq{\n};
  };

  # Start document
  $xml .= qq{\n};

  # Data payload
  $xml .= '
  $xml .= ' type="' . $self->data_type . '"' if exists $self->{data_type};
  $xml .= ">" . b64url_encode($self->data, 0) . "\n";

  # Encoding
  $xml .= '  ' . $self->encoding . "\n";

  # Algorithm
  $xml .= '  ' . $self->alg . "\n";

  # Signatures
  foreach my $sig (@{$self->{sigs}}) {
    $xml .= '
    $xml .= ' key_id="' . $sig->{key_id} . '"' if $sig->{key_id};
    $xml .= '>' . b64url_encode($sig->{value}) . "\n"
  };

  # End document
  $xml .= "";

  return $xml;
};


# Return em-compact string
sub to_compact {
  my $self = shift;

  # The me has to be signed
  return unless $self->signed;

  # Use default signature for serialization
  my $sig = $self->signature;

  return
    join(
      '.',
      b64url_encode( $sig->{key_id} ) || '',
      b64url_encode( $sig->{value} ),
      $self->signature_base
    );
};


# Return em-json string
sub to_json {
  my $self = shift;

  # Empty envelope
  return '{}' unless $self->data;

  # Create new datastructure
  my %new_em = (
    alg       => $self->alg,
    encoding  => $self->encoding,
    data_type => $self->data_type,
    data      => b64url_encode( $self->data, 0),
    sigs      => []
  );

  # Loop through signatures
  foreach my $sig ( @{ $self->{sigs} } ) {
    my %msig = ( value => b64url_encode( $sig->{value} ) );
    $msig{key_id} = $sig->{key_id} if defined $sig->{key_id};
    push( @{ $new_em{sigs} }, \%msig );
  };

  # Return json-string
  return encode_json \%new_em;
};


# Delete all whitespaces
sub _trim_all {
  my $string = shift;
  $string =~ tr{\t-\x0d }{}d;
  $string;
};


sub _key_array {
  return () unless @_;

  my $flag = '-base';

  if ($_[-1] eq '-data' || $_[-1] eq '-compatible' || $_[-1] eq '-base') {
    $flag = pop;
  };

  my $key  = pop;
  my $key_id = shift;

  return () unless $key;

  my @param;

  # Hash reference
  if (ref $key && $key eq 'HASH') {
    return () unless $key->{n};
    @param = %$key;
  }

  # String or object
  else {
    @param = ($key);
  };

  # Create MagicKey from parameter
  my $mkey = Crypt::MagicSignatures::Key->new(@param);

  return ($key_id, $mkey, $flag);
};


1;


__END__