crypto/heimdal-0.6.3/lib/des/shifts.pl

   1 #/usr/local/bin/perl
   2
   3 sub lab_shift
   4         {
   5         local(*a,$n)=@_;
   6         local(@r,$i,$j,$k,$d,@z);
   7
   8         @r=&shift(*a,$n);
   9         foreach $i (0 .. 31)
  10                 {
  11                 @z=split(/\^/,$r[$i]);
  12                 for ($j=0; $j <= $#z; $j++)
  13                         {
  14                         ($d)=($z[$j] =~ /^(..)/);
  15                         ($k)=($z[$j] =~ /\[(.*)\]$/);
  16                         $k.=",$n" if ($k ne "");
  17                         $k="$n"   if ($k eq "");
  18                         $d="$d[$k]";
  19                         $z[$j]=$d;
  20                         }
  21                 $r[$i]=join('^',@z);
  22                 }
  23         return(@r);
  24         }
  25
  26 sub shift
  27         {
  28         local(*a,$n)=@_;
  29         local(@f);
  30
  31         if ($n > 0)
  32                 {
  33                 @f=&shiftl(*a,$n);
  34                 }
  35         else
  36                 {
  37                 @f=&shiftr(*a,-$n);
  38                 }
  39         return(@f);
  40         }
  41
  42 sub rotate
  43         {
  44         local(*a,$n)=@_;
  45         local(@f);
  46
  47         if ($n > 0)
  48                 { @f=&rotatel(*a,$n); }
  49         else
  50                 { @f=&rotater(*a,-$n); }
  51         return(@f);
  52         }
  53
  54 sub rotater
  55         {
  56         local(*a,$n)=@_;
  57         local(@f,@g);
  58
  59         @f=&shiftr(*a,$n);
  60         @g=&shiftl(*a,32-$n);
  61         $#f=31;
  62         $#g=31;
  63         return(&or(*f,*g));
  64         }
  65
  66 sub rotatel
  67         {
  68         local(*a,$n)=@_;
  69         local(@f,@g);
  70
  71         @f=&shiftl(*a,$n);
  72         @g=&shiftr(*a,32-$n);
  73         $#f=31;
  74         $#g=31;
  75         return(&or(*f,*g));
  76         }
  77
  78 sub shiftr
  79         {
  80         local(*a,$n)=@_;
  81         local(@r,$i);
  82
  83         $#r=31;
  84         foreach $i (0 .. 31)
  85                 {
  86                 if (($i+$n) > 31)
  87                         {
  88                         $r[$i]="--";
  89                         }
  90                 else
  91                         {
  92                         $r[$i]=$a[$i+$n];
  93                         }
  94                 }
  95         return(@r);
  96         }
  97
  98 sub shiftl
  99         {
 100         local(*a,$n)=@_;
 101         local(@r,$i);
 102
 103         $#r=31;
 104         foreach $i (0 .. 31)
 105                 {
 106                 if ($i < $n)
 107                         {
 108                         $r[$i]="--";
 109                         }
 110                 else
 111                         {
 112                         $r[$i]=$a[$i-$n];
 113                         }
 114                 }
 115         return(@r);
 116         }
 117
 118 sub printit
 119         {
 120         local(@a)=@_;
 121         local($i);
 122
 123         foreach $i (0 .. 31)
 124                 {
 125                 printf "%2s  ",$a[$i];
 126                 print "\n" if (($i%8) == 7);
 127                 }
 128         print "\n";
 129         }
 130
 131 sub xor
 132         {
 133         local(*a,*b)=@_;
 134         local(@r,$i);
 135
 136         $#r=31;
 137         foreach $i (0 .. 31)
 138                 {
 139                 $r[$i]=&compress($a[$i].'^'.$b[$i]);
 140 #               $r[$i]=$a[$i]."^".$b[$i];
 141                 }
 142         return(@r);
 143         }
 144
 145 sub and
 146         {
 147         local(*a,$m)=@_;
 148         local(@r,$i);
 149
 150         $#r=31;
 151         foreach $i (0 .. 31)
 152                 {
 153                 $r[$i]=(($m & (1<<$i))?($a[$i]):('--'));
 154                 }
 155         return(@r);
 156         }
 157
 158 sub or
 159         {
 160         local(*a,*b)=@_;
 161         local(@r,$i);
 162
 163         $#r=31;
 164         foreach $i (0 .. 31)
 165                 {
 166                 $r[$i]='--'   if (($a[$i] eq '--') && ($b[$i] eq '--'));
 167                 $r[$i]=$a[$i] if (($a[$i] ne '--') && ($b[$i] eq '--'));
 168                 $r[$i]=$b[$i] if (($a[$i] eq '--') && ($b[$i] ne '--'));
 169                 $r[$i]='++'   if (($a[$i] ne '--') && ($b[$i] ne '--'));
 170                 }
 171         return(@r);
 172         }
 173
 174 sub compress
 175         {
 176         local($s)=@_;
 177         local($_,$i,@a,%a,$r);
 178
 179         $s =~ s/\^\^/\^/g;
 180         $s =~ s/^\^//;
 181         $s =~ s/\^$//;
 182         @a=split(/\^/,$s);
 183
 184         while ($#a >= 0)
 185                 {
 186                 $_=shift(@a);
 187                 next unless /\d/;
 188                 $a{$_}++;
 189                 }
 190         foreach $i (sort keys %a)
 191                 {
 192                 next if ($a{$i}%2 == 0);
 193                 $r.="$i^";
 194                 }
 195         chop($r);
 196         return($r);
 197         }
 198 1;