squeamish ossifrage - SHA failing [SOLVED::sort of]

[vnomad]

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/[e-mail]%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

[Anonymous Monk]

Could someone explain to me exactly what to change in perlshop.cgi to get the above to work please. Thank you

[Anonymous Monk]

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

[Anonymous Monk]

See the first reply, see Re: squeamish ossifrage - SHA failing, and copy/paste sub SHA