in reply to squeamish ossifrage - SHA failing

Personally, I suggest Digest::SHA rather than SHA1. SHA-1 will be superceded by 2010 at the latest, so you may want to be ready to implement SHA-256 or better with Digest::SHA. You may also want to look at the test data available at http://www.nsrl.nist.gov/testdata/

Replies are listed 'Best First'.
squeamish ossifrage - SHA failing [SOLVED::sort of]
by vnomad (Novice) on Nov 27, 2006 at 21:30 UTC
    Thanks to all! It's working good now.

    I found an evolved version of my SHA subroutine at: http://mail-archives.apache.org/mod_mbox/spamassassin-commits/200407.mbox/%3C20040701190945.25657.qmail@minotaur.apache.org%3E This one will also use Digest::SHA1 optionally if I read correctly, with 40X higher speed (!?).

    I played around with Perlshop 3.2 in the late nineties, customizing it for selling aerial photos searchable on maps, or in tables. This museum piece sleeps at: http://afoto.com/hildebilde/index.htm

    Had a lot of fun making it bilingual.

    Development of Perlshop continues at a good clip in version 4, with some nice features added while remaining effable for a neophyte like myself. This is the one that gave me the SHA error initially, but seems stable with the alternative routine.

    It would be interesting to compare the speed with, and without Digest::SHA1 under load.

    Thanks again for pointing me in the right direction!

    Dagfinn
      Could someone explain to me exactly what to change in perlshop.cgi to get the above to work please. Thank you
        10 years later, this one works correctly and is more readable.
        sub SHA() { ## 5/19/22 - lifted from ## https://www.floodgap.com/software/ttytter/dist2/2.0.00.txt ## slightly modified to return the string formatted like the old ## sha routine and to condense some variable assignments. I ## also corrected the lack of zero padding by changing ## '%8x 'x4 . '%8x' to sprintf '%0.8x 'x4 . '%.8x'. my $string = shift; my $showwork = 0; if ($showwork) {print "string length: @{[ length($string) ]}\n"} my $constant = 'D9T4C`>_-JXF8NMS^$#)4=L/2X?!:@GF9;MGKH8\;O-S*8L\'6 +'; my @A = unpack('N*', unpack('u', $constant)); my @K = splice(@A, 5, 4); my $M = sub { # 64-bit warning my $x; my $m; ($x = pop @_) - ($m=4294967296) * int($x / $m); }; my $L = sub { # 64-bit warning my $n = pop @_; my $x; ((($x = pop @_) << $n) | ((2 ** $n - 1) & ($x >> 32 - $n))) & 4294967295; }; my ($l, $p) = ('', 0); my ($r, $a, $b, $c, $d, $e, $us, @nuA); $string = unpack("H*", $string); do { my $i; $us = substr($string, 0, 128); $string = substr($string, 128); $l += $r = (length($us) / 2); if ($showwork) {print "pad length: $r\n"} ($r++, $us .= "80") if ($r < 64 && !$p++); my @W = unpack('N16', pack("H*", $us) . "\000" x 7); $W[15] = $l * 8 if ($r < 57); foreach $i (16 .. 79) { push(@W, &$L($W[$i - 3] ^ $W[$i - 8] ^ $W[$i - 14] ^ $W[$i - 16], 1)); } ($a, $b, $c, $d, $e) = @A; foreach $i (0 .. 79) { my $qq = ($i < 20) ? ($b & ($c ^ $d) ^ $d) : ($i < 40) ? ($b ^ $c ^ $d) : ($i < 60) ? (($b | $c) & $d | $b & $c) : ($b ^ $c ^ $d); $t = &$M($qq + $e + $W[$i] + $K[$i / 20] + &$L($a, 5)); $e = $d; $d = $c; $c = &$L($b, 30); $b = $a; $a = $t; } @nuA = ($a, $b, $c, $d, $e); if ($showwork) {print "$a $b $c $d $e\n"} $i = 0; @A = map({ &$M($_ + $nuA[$i++]); } @A); } while ($r > 56); my $x = sprintf '%.8x 'x4 . '%.8x',@A; if ($showwork) {print $x,"\n"} return $x; }