SHA-256: Difference between revisions
Content added Content deleted
(→{{header|Perl 6}}: [Z[m+]]= works now, so let's use it) |
(→{{header|Perl}}: Added longer implementation.) |
||
| Line 1,041: | Line 1,041: | ||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
The preferred way to do a task like this is to use an already written module, for example: |
|||
<lang Perl>#!/usr/bin/perl |
<lang Perl>#!/usr/bin/perl |
||
use strict ; |
use strict ; |
||
| Line 1,049: | Line 1,050: | ||
print "SHA-256('$phrase'): $digest\n" ; |
print "SHA-256('$phrase'): $digest\n" ; |
||
</lang> |
</lang> |
||
{{out}} |
|||
'''Output''' |
|||
<pre>SHA-256('Rosetta code'): 764faf5c61ac315f1497f9dfa542713965b785e5cc2f707d6468d7d1124cdfcf |
<pre>SHA-256('Rosetta code'): 764faf5c61ac315f1497f9dfa542713965b785e5cc2f707d6468d7d1124cdfcf |
||
</pre> |
|||
On the other hand, one of perl's mottos is There Is More Than One Way To Do It, so of course |
|||
you could write your own implementation if you wanted to. |
|||
<lang Perl> |
|||
package Digest::SHA256::PP; |
|||
use strict; |
|||
use warnings; |
|||
use constant WORD => 2**32; |
|||
use constant MASK => WORD - 1; |
|||
my @h; |
|||
my @k; |
|||
for my $p ( 2 .. 311 ) { |
|||
# Horrible primality test, but sufficient for this task. |
|||
next if ("1" x $p) =~ /^(11+?)\1+$/; |
|||
# The choice to generate h and k instead of hard coding |
|||
# them is inspired by the Perl 6 implementation. |
|||
my $c = $p ** ( 1/3 ); |
|||
push @k, int( ($c - int $c) * WORD ); |
|||
next if @h == 8; |
|||
my $s = $p ** ( 1/2 ); |
|||
push @h, int( ($s - int $s) * WORD ); |
|||
} |
|||
sub new { |
|||
my %self = ( state => [@h], str => "", len => 0 ); |
|||
bless \%self, shift; |
|||
} |
|||
my $rightrotate = sub { |
|||
my $lo = $_[0] >> $_[1]; |
|||
my $hi = $_[0] << (32 - $_[1]); |
|||
($hi | $lo); |
|||
}; |
|||
# This is adapted from the wikipedia entry on SHA2. |
|||
my $compress = sub { |
|||
my ($state, $bytes) = @_; |
|||
my @w = unpack 'N*', $bytes; |
|||
@w == 16 or die 'internal error'; |
|||
my ($a, $b, $c, $d, $e, $f, $g, $h) = @$state; |
|||
until( @w == 64 ) { |
|||
my $s0 = $w[-15] >> 3; |
|||
my $s1 = $w[-2] >> 10; |
|||
$s0 ^= $rightrotate->($w[-15], $_) for 7, 18; |
|||
$s1 ^= $rightrotate->($w[-2], $_) for 17, 19; |
|||
push @w, ($w[-16] + $s0 + $w[-7] + $s1) & MASK; |
|||
} |
|||
my $i = 0; |
|||
for my $w (@w) { |
|||
my $ch = ($e & $f) ^ ((~$e) & $g); |
|||
my $maj = ($a & $b) ^ ($a & $c) ^ ($b & $c); |
|||
my ($S0, $S1) = (0, 0); |
|||
$S1 ^= $rightrotate->( $e, $_ ) for 6, 11, 25; |
|||
$S0 ^= $rightrotate->( $a, $_ ) for 2, 13, 22; |
|||
my $temp1 = $h + $S1 + $ch + $k[$i++] + $w; |
|||
my $temp2 = $S0 + $maj; |
|||
($h, $g, $f, $e, $d, $c, $b, $a) = |
|||
($g, $f, $e, ($d+$temp1)&MASK, $c, $b, $a, ($temp1+$temp2)&MASK); |
|||
} |
|||
my $j = 0; |
|||
$state->[$j++] += $_ for $a, $b, $c, $d, $e, $f, $g, $h; |
|||
}; |
|||
use constant can_Q => eval { length pack 'Q>', 0 }; |
|||
sub add { |
|||
my ($self, $bytes) = @_; |
|||
$self->{len} += 8 * length $bytes; |
|||
if( !can_Q and $self->{len} >= WORD ) { |
|||
my $hi = int( $self->{len} / WORD ); |
|||
$self->{big} += $hi; |
|||
$self->{len} -= $hi * WORD; |
|||
} |
|||
my $len = length $self->{str}; |
|||
if( ($len + length $bytes) < 64 ) { |
|||
$self->{str} .= $bytes; |
|||
return $self; |
|||
} |
|||
my $off = 64 - $len; |
|||
$compress->( $self->{state}, $self->{str} . substr( $bytes, 0, $off ) ); |
|||
$len = length $_[0]; |
|||
while( $off+64 <= $len ) { |
|||
$compress->( $self->{state}, substr( $bytes, $off, 64 ) ); |
|||
$off += 64; |
|||
} |
|||
$self->{str} = substr( $bytes, $off ); |
|||
$self; |
|||
} |
|||
sub addfile { |
|||
my ($self, $fh) = @_; |
|||
my $s = ""; |
|||
while( read( $fh, $s, 2**13 ) ) { |
|||
$self->add( $s ); |
|||
} |
|||
$self; |
|||
} |
|||
sub digest { |
|||
my $self = shift; |
|||
my $final = $self->{str}; |
|||
$final .= chr 0x80; |
|||
while( ( 8+length $final ) % 64 ) { |
|||
$final .= chr 0; |
|||
} |
|||
if( can_Q ) { |
|||
$final .= pack 'Q>', $self->{len}; |
|||
} else { |
|||
$self->{big} ||= 0; |
|||
$final .= pack 'NN', $self->{big}, $self->{len}; |
|||
} |
|||
$compress->( $self->{state}, substr $final, 0, 64, "" ) while length $final; |
|||
if( wantarray ) { |
|||
map pack('N', $_), @{ $self->{state} }; |
|||
} else { |
|||
pack 'N*', @{ $self->{state} }; |
|||
} |
|||
} |
|||
sub hexdigest { |
|||
if( wantarray ) { |
|||
map unpack( 'H*', $_), &digest; |
|||
} else { |
|||
unpack 'H*', &digest; |
|||
} |
|||
} |
|||
unless( caller ) { |
|||
my @testwith = (@ARGV ? @ARGV : 'Rosetta code'); |
|||
for my $str (@testwith) { |
|||
my $digester = __PACKAGE__->new; |
|||
$digester->add($str); |
|||
print "'$str':\n"; |
|||
print join(" ", $digester->hexdigest), "\n"; |
|||
} |
|||
} |
|||
1; |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
'Rosetta code': |
|||
764faf5c 61ac315f 1497f9df a5427139 65b785e5 cc2f707d 6468d7d1 124cdfcf |
|||
</pre> |
</pre> |
||