File Coverage

blib/lib/Crypt/MagicSignatures/Envelope.pm

Criterion	Covered	Total	%
statement	192	219	87.6
branch	90	150	60.0
condition	28	44	63.6
subroutine	25	25	100.0
pod	14	14	100.0
total	349	452	77.2

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

use v5.10.1;

our $VERSION = '0.10';

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 && !(@_ % 2)) {

    my %self = @_;

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

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

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

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

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

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

    # Append all defined signatures
    foreach ( @{$self{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 = trim shift;

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

    # 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
      return if !$env || $env->namespace ne $ME_NS;

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

      # The envelope is empty
      return unless $data;

      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 ) );

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

      # Check algorithm
      if (($temp = $env->at('alg')) &&
	    (uc $temp->text ne 'RSA-SHA256')) {
	carp 'Algorithm is not supported' and 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];
    };
  };

  # 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 @_;

  # 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 is given
  if ($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;
  };

  return;
};


# 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} eq $_[1];
  };

  # Envelope is not signed
  return 0;
};


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

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

  return $self->{sig_base};
};


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

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

  # 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__