OberonCore

(* adler32 - хеш функция Марко Адлера. Вычи
             сляет значение контрольной сум
             мы в соответствии с RFC 1950
             для массива из байт          *)

PROCEDURE adler32*(buf : PtrCHAR;
                   len : INTEGER) : INTEGER;
   VAR s1,s2, ii  : INTEGER;
BEGIN
   s1 := 1;
   s2 := 0;
   FOR ii := 0 TO len-1 DO
       s1 := (s1 + ORD(buf[ii]) ) MOD 65521;
       s2 := (s1 + s2) MOD 65521;
   END;
   RETURN s1 + LSH(s2, 16);
END adler32;


(* sha_1  -  алгоритм криптографического хе
             ширования в соответствии с RFC
             3174 для массива из байт     *)

PROCEDURE sha_1   (buf : PtrCHAR;
                   len : INTEGER) : shaCHAR;
   VAR h0,h1,h2,h3,h4  : INTEGER;
       r0,r1,r2,r3,r4  : INTEGER;
       nm,cn,ii,ff,kk  : INTEGER;
       ws : ARRAY 080 OF INTEGER;
   VAR rs : shaCHAR;
BEGIN
   (* начальная инициализация             *)
   h0 := 067452301H;
   h1 := 0EFCDAB89H;
   h2 := 098BADCFEH;
   h3 := 010325476H;
   h4 := 0C3D2E1F0H;
   rs := nul;
   cn := len;

   (* дополнение до кратности 512 битам   *)
   buf[cn] := 80X; INC(cn);
   buf[cn] := 00X; INC(cn);
   buf[cn] := 00X; INC(cn);
   buf[cn] := 00X; INC(cn);
   buf[cn] := 00X; INC(cn);
   nm := 64 - cn  MOD 64  ;
   nm := nm + 64* ORD(nm < 4);
   FOR ii := 0 TO nm - 5 DO
                 buf[cn] := 0X; INC(cn) END;

   (* пишем длину в обратном порядке      *)
   len := len * 8;
   buf[cn] := CHR( LSH(len, -24) ); INC(cn);
   buf[cn] := CHR( LSH(len, -16) ); INC(cn);
   buf[cn] := CHR( LSH(len, -08) ); INC(cn);
   buf[cn] := CHR(     len       ); INC(cn);

   (* разбиваем на части по 512 бит       *)
   FOR ii := 0 TO cn DIV 64 - 1 DO

       (* инициализация хеш этой части    *)
       kk := ii * 64;
       r0 := h0;
       r1 := h1;
       r2 := h2;
       r3 := h3;
       r4 := h4;
       FOR nm := 00 TO 15 DO
           ws[nm] := LSH(ORD(buf[kk+0]),24)
                   + LSH(ORD(buf[kk+1]),16)
                   + LSH(ORD(buf[kk+2]),08)
                   +     ORD(buf[kk+3]    );
           kk := kk + 4;
       END;
       FOR nm := 16 TO 79 DO
           ws[nm] := RSH(ORD(BIT(ws[nm-03])
                           / BIT(ws[nm-08])
                           / BIT(ws[nm-14])
                           / BIT(ws[nm-16])
                                    ), 01 );
       END;

       (* цикл вычисления хеш этой части  *)
       FOR nm := 00 TO 79 DO
           IF nm < 20 THEN kk := 05A827999H;
              ff := ORD((BIT(r1) * BIT(r2))
                     + ((
                        -BIT(r1)
                               ) * BIT(r3))
                       );
           EI nm < 40 THEN kk := 06ED9EBA1H;
              ff := ORD(BIT(r1) / BIT(r2)
                                / BIT(r3) );
           EI nm < 60 THEN kk := 08F1BBCDCH;
              ff := ORD((BIT(r1) * BIT(r2))
                     +  (BIT(r1) * BIT(r3))
                     +  (BIT(r2) * BIT(r3))
                       );
                      ELSE kk := 0CA62C1D6H;
              ff := ORD(BIT(r1) / BIT(r2)
                                / BIT(r3) );
           END;

           ff := RSH(r0, 05)
                    + ff + r4 + kk + ws[nm];
           r4 := r3;
           r3 := r2;
           r2 := RSH(r1, 30);
           r1 := r0;
           r0 := ff;
       END;

       (* добавляем хеш части результату  *)
       h0 := h0 + r0;
       h1 := h1 + r1;
       h2 := h2 + r2;
       h3 := h3 + r3;
       h4 := h4 + r4;
   END;

   (* пишем результат big endian -------- *)
   rs[00] := CHR(LSH(h0, -24));
   rs[01] := CHR(LSH(h0, -16));
   rs[02] := CHR(LSH(h0, -08));
   rs[03] := CHR(    h0      );

   rs[04] := CHR(LSH(h1, -24));
   rs[05] := CHR(LSH(h1, -16));
   rs[06] := CHR(LSH(h1, -08));
   rs[07] := CHR(    h1      );

   rs[08] := CHR(LSH(h2, -24));
   rs[09] := CHR(LSH(h2, -16));
   rs[10] := CHR(LSH(h2, -08));
   rs[11] := CHR(    h2      );

   rs[12] := CHR(LSH(h3, -24));
   rs[13] := CHR(LSH(h3, -16));
   rs[14] := CHR(LSH(h3, -08));
   rs[15] := CHR(    h3      );

   rs[16] := CHR(LSH(h4, -24));
   rs[17] := CHR(LSH(h4, -16));
   rs[18] := CHR(LSH(h4, -08));
   rs[19] := CHR(    h4      );   RETURN rs;
END sha_1;