File Coverage

blib/lib/Digest/SRI.pm

Criterion	Covered	Total	%
statement	77	77	100.0
branch	30	30	100.0
condition	6	6	100.0
subroutine	18	18	100.0
pod	0	12	0.0
total	131	143	91.6

#!perl
package Digest::SRI;
use warnings;
use strict;
use Carp;
use Scalar::Util qw/blessed/;
require Digest;
require MIME::Base64;

# For AUTHOR, COPYRIGHT, AND LICENSE see the bottom of this file

our $VERSION = '0.02';

use Exporter 'import';
our @EXPORT_OK = qw/ sri verify_sri /;

my $DEFAULT_ALGO = 'sha512';
my %KNOWN_ALGOS = (
	sha512 => 'SHA-512',
	sha384 => 'SHA-384',
	sha256 => 'SHA-256',
	sha1   => 'SHA-1',
	md5    => 'MD5',
);
my ($KNOWN_ALGO_RE) = map { qr/$_/ } join '|', map {quotemeta}
	sort { length $b <=> length $a or $a cmp $b } keys %KNOWN_ALGOS;

## no critic (RequireArgUnpacking)

sub new {
	my $class = shift;
	if (ref $class) {
		croak "bad argument to new: must be ".__PACKAGE__." instance"
			unless blessed($class) && $class->isa(__PACKAGE__);
		$class->{dig}->reset;
		return $class;
	}
	my $param = @_ ? shift : $DEFAULT_ALGO;
	my ($algo,$expected);
	if ( $param =~ m{\A(${KNOWN_ALGO_RE})-([A-Za-z0-9+/=]+)\z} )
		{ $algo = $1; $expected = $2 }
	else {
		( $algo = lc $param ) =~ s/[\s\-]+//g;
		croak "unknown/unsupported algorithm '$param'"
			unless exists $KNOWN_ALGOS{$algo};
	}
	my $self = {
		algo => $algo,
		dig  => Digest->new( $KNOWN_ALGOS{$algo} ),
	};
	$self->{exp} = $algo.'-'.$expected if defined $expected;
	return bless $self, $class;
}
*reset = \&new;

sub clone {
	my $self = shift;
	my $new_self = {
		algo => $self->{algo},
		dig  => $self->{dig}->clone,
	};
	$new_self->{exp} = $self->{exp} if defined $self->{exp};
	return bless $new_self, ref $self;
}

sub _grokdata {
	my ($obj,$what) = @_;
	if ( my $r = ref $what ) {
		if ($r eq 'GLOB')
			{ return $obj->addfile($what) }
		elsif ($r eq 'SCALAR')
			{ return $obj->new(@_)->add($$what) }
		else
			{ croak "can't handle reference to $r" }
	} else
		{ return $obj->addfilename($what) }
}

sub sri {
	if ( blessed($_[0]) && $_[0]->isa(__PACKAGE__) ) { # method call
		my $self = shift;
		# Note: ->b64digest strips of the trailing padding
		return $self->{algo} . '-' . MIME::Base64::encode($self->{dig}->digest(@_), "");
	} # else, regular function call
	croak "not enough arguments to sri()" unless @_;
	croak "too many arguments to sri()" if @_>2;
	my $data = pop @_;
	return _grokdata(Digest::SRI->new(@_), $data)->sri;
}

sub verify_sri {
	croak "expected two arguments to verify_sri()" unless @_==2;
	my $data = pop @_;
	return _grokdata(Digest::SRI->new(@_), $data)->verify;
}

sub verify {
	my $self = shift;
	( my $l = $self->sri   ) =~ s/=+\z//;
	( my $r = $self->{exp} ) =~ s/=+\z//;
	return $l eq $r;
}

sub addfilename {
	my $self = shift;
	my $fn = shift;
	open my $fh, '<', $fn or croak "couldn't open $fn: $!";
	binmode $fh;
	$self->addfile($fh);
	close $fh;
	return $self;
}

# see Digest::base
sub add       { my $self = shift; $self->{dig}->add(@_);      return $self }
sub addfile   { my $self = shift; $self->{dig}->addfile(@_);  return $self }
sub add_bits  { my $self = shift; $self->{dig}->add_bits(@_); return $self }
sub digest    { my $self = shift; return $self->{dig}->digest(@_)    }
sub hexdigest { my $self = shift; return $self->{dig}->hexdigest(@_) }
sub b64digest { my $self = shift; return $self->{dig}->b64digest(@_) }

1;
__END__