1 files changed, 198 insertions, 0 deletions

diff --git a/src/lib/libcrypto/des/shifts.pl b/src/lib/libcrypto/des/shifts.pl
new file mode 100644
index 0000000000..d8a240c1ba
--- /dev/null
+++ b/src/lib/libcrypto/des/shifts.pl
@@ -0,0 +1,198 @@
+#!/usr/bin/perl
+
+sub lab_shift
+        {
+        local(*a,$n)=@_;
+        local(@r,$i,$j,$k,$d,@z);
+
+        @r=&shift(*a,$n);
+        foreach $i (0 .. 31)
+                {
+                @z=split(/\^/,$r[$i]);
+                for ($j=0; $j <= $#z; $j++)
+                        {
+                        ($d)=($z[$j] =~ /^(..)/);
+                        ($k)=($z[$j] =~ /\[(.*)\]$/);
+                        $k.=",$n" if ($k ne "");
+                        $k="$n"   if ($k eq "");
+                        $d="$d[$k]";
+                        $z[$j]=$d;
+                        }
+                $r[$i]=join('^',@z);
+                }
+        return(@r);
+        }
+
+sub shift
+        {
+        local(*a,$n)=@_;
+        local(@f);
+
+        if ($n > 0)
+                {
+                @f=&shiftl(*a,$n);
+                }
+        else
+                {
+                @f=&shiftr(*a,-$n);
+                }
+        return(@f);
+        }
+
+sub rotate
+        {
+        local(*a,$n)=@_;
+        local(@f);
+
+        if ($n > 0)
+                { @f=&rotatel(*a,$n); }
+        else
+                { @f=&rotater(*a,-$n); }
+        return(@f);
+        }
+
+sub rotater
+        {
+        local(*a,$n)=@_;
+        local(@f,@g);
+
+        @f=&shiftr(*a,$n);
+        @g=&shiftl(*a,32-$n);
+        $#f=31;
+        $#g=31;
+        return(&or(*f,*g));
+        }
+
+sub rotatel
+        {
+        local(*a,$n)=@_;
+        local(@f,@g);
+
+        @f=&shiftl(*a,$n);
+        @g=&shiftr(*a,32-$n);
+        $#f=31;
+        $#g=31;
+        return(&or(*f,*g));
+        }
+
+sub shiftr
+        {
+        local(*a,$n)=@_;
+        local(@r,$i);
+
+        $#r=31;
+        foreach $i (0 .. 31)
+                {
+                if (($i+$n) > 31)
+                        {
+                        $r[$i]="--";
+                        }
+                else
+                        {
+                        $r[$i]=$a[$i+$n];
+                        }
+                }
+        return(@r);
+        }
+
+sub shiftl
+        {
+        local(*a,$n)=@_;
+        local(@r,$i);
+
+        $#r=31;
+        foreach $i (0 .. 31)
+                {
+                if ($i < $n)
+                        {
+                        $r[$i]="--";
+                        }
+                else
+                        {
+                        $r[$i]=$a[$i-$n];
+                        }
+                }
+        return(@r);
+        }
+
+sub printit
+        {
+        local(@a)=@_;
+        local($i);
+
+        foreach $i (0 .. 31)
+                {
+                printf "%2s  ",$a[$i];
+                print "\n" if (($i%8) == 7);
+                }
+        print "\n";
+        }
+
+sub xor
+        {
+        local(*a,*b)=@_;
+        local(@r,$i);
+
+        $#r=31;
+        foreach $i (0 .. 31)
+                {
+                $r[$i]=&compress($a[$i].'^'.$b[$i]);
+#               $r[$i]=$a[$i]."^".$b[$i];
+                }
+        return(@r);
+        }
+
+sub and
+        {
+        local(*a,$m)=@_;
+        local(@r,$i);
+
+        $#r=31;
+        foreach $i (0 .. 31)
+                {
+                $r[$i]=(($m & (1<<$i))?($a[$i]):('--'));
+                }
+        return(@r);
+        }
+
+sub or
+        {
+        local(*a,*b)=@_;
+        local(@r,$i);
+
+        $#r=31;
+        foreach $i (0 .. 31)
+                {
+                $r[$i]='--'   if (($a[$i] eq '--') && ($b[$i] eq '--'));
+                $r[$i]=$a[$i] if (($a[$i] ne '--') && ($b[$i] eq '--'));
+                $r[$i]=$b[$i] if (($a[$i] eq '--') && ($b[$i] ne '--'));
+                $r[$i]='++'   if (($a[$i] ne '--') && ($b[$i] ne '--'));
+                }
+        return(@r);
+        }
+
+sub compress
+        {
+        local($s)=@_;
+        local($_,$i,@a,%a,$r);
+
+        $s =~ s/\^\^/\^/g;
+        $s =~ s/^\^//;
+        $s =~ s/\^$//;
+        @a=split(/\^/,$s);
+
+        while ($#a >= 0)
+                {
+                $_=shift(@a);
+                next unless /\d/;
+                $a{$_}++;
+                }
+        foreach $i (sort keys %a)
+                {
+                next if ($a{$i}%2 == 0);
+                $r.="$i^";
+                }
+        chop($r);
+        return($r);
+        }
+1;