libkeccak.fs 4.94 KB
Newer Older
bernd's avatar
bernd committed
1 2
\ keccak wrapper

bernd's avatar
bernd committed
3
require unix/mmap.fs
bernd's avatar
bernd committed
4 5
require unix/pthread.fs
require 64bit.fs
bernd's avatar
bernd committed
6
require crypto-api.fs
bernd's avatar
bernd committed
7 8
require net2o-err.fs
require kregion.fs
bernd's avatar
bernd committed
9

bernd's avatar
bernd committed
10
\ dummy load for Android
bernd's avatar
bernd committed
11 12 13
[IFDEF] android
    s" /data/data/gnu.gforth/lib/libkeccak.so" open-lib drop
[THEN]
bernd's avatar
bernd committed
14 15

c-library keccak
bernd's avatar
bernd committed
16
    \    s" keccak/.libs" add-libpath
bernd's avatar
bernd committed
17
    s" keccak" add-lib
bernd's avatar
bernd committed
18 19 20
    [IFDEF] android
	s" ./keccak" add-libpath
    [THEN]
bernd's avatar
bernd committed
21
    \c #include <KeccakF-1600.h>
bernd's avatar
bernd committed
22 23 24 25 26
    \c UINT64* KeccakEncryptLoop(keccak_state state, UINT64 * data, unsigned int n)
    \c {
    \c   while(n>0) {
    \c     unsigned int p = n >= 128 ? 128 : n;
    \c     KeccakF(state);
bernd's avatar
bernd committed
27 28
    \c     KeccakEncrypt(state, data, p);
    \c     data = (UINT64*)(((char*)data)+p); n-=p;
bernd's avatar
bernd committed
29 30 31 32 33 34 35 36
    \c   }
    \c   return data;
    \c }
    \c UINT64* KeccakDecryptLoop(keccak_state state, UINT64 * data, unsigned int n)
    \c {
    \c   while(n>0) {
    \c     unsigned int p = n >= 128 ? 128 : n;
    \c     KeccakF(state);
bernd's avatar
bernd committed
37 38
    \c     KeccakDecrypt(state, data, p);
    \c     data = (UINT64*)(((char*)data)+p); n-=p;
bernd's avatar
bernd committed
39 40 41 42 43 44 45 46 47 48 49 50 51 52
    \c   }
    \c   return data;
    \c }

\ ------===< functions >===-------
c-function KeccakInitialize KeccakInitialize  -- void
c-function KeccakF KeccakF a -- void
c-function KeccakInitializeState KeccakInitializeState a -- void
c-function KeccakExtract KeccakExtract a a n -- void
c-function KeccakAbsorb KeccakAbsorb a a n -- void
c-function KeccakEncrypt KeccakEncrypt a a n -- void
c-function KeccakDecrypt KeccakDecrypt a a n -- void
c-function KeccakEncryptLoop KeccakEncryptLoop a a n -- a
c-function KeccakDecryptLoop KeccakDecryptLoop a a n -- a
bernd's avatar
bernd committed
53 54 55 56 57

end-c-library

25 8 * Constant keccak#
128 Constant keccak#max
58
128 Constant keccak#cks
bernd's avatar
bernd committed
59

bernd's avatar
bernd committed
60
UValue @keccak
bernd's avatar
bernd committed
61 62 63 64

: keccak0 ( -- ) @keccak KeccakInitializeState ;

: keccak* ( -- ) @keccak KeccakF ;
bernd's avatar
bernd committed
65 66 67 68
: >keccak ( addr u -- )  @keccak -rot KeccakAbsorb ;
: +keccak ( addr u -- )  @keccak -rot KeccakEncrypt ;
: -keccak ( addr u -- )  @keccak -rot KeccakDecrypt ;
: keccak> ( addr u -- )  @keccak -rot KeccakExtract ;
bernd's avatar
bernd committed
69 70 71

\ crypto api integration

bernd's avatar
bernd committed
72 73 74
crypto class
    keccak# uvar keccak-state
    keccak#cks uvar keccak-checksums
bernd's avatar
bernd committed
75
    keccak#max uvar keccak-padded
bernd's avatar
bernd committed
76 77 78 79
    cell uvar keccak-up
end-class keccak

: keccak-init crypto-o @ IF  keccak-up @ next-task = ?EXIT  THEN
bernd's avatar
bernd committed
80 81
    [: keccak new crypto-o ! ;] crypto-a with-allocater
    next-task keccak-up ! keccak-state to @keccak ;
bernd's avatar
bernd committed
82

83
: keccak-free crypto-o @ ?dup-IF  .dispose  THEN
bernd's avatar
bernd committed
84 85
    0 to @keccak crypto-o off ;

bernd's avatar
bernd committed
86
keccak-init
bernd's avatar
bernd committed
87

bernd's avatar
bernd committed
88
' keccak-init to c:init
89
' keccak-free to c:free
bernd's avatar
bernd committed
90
:noname to @keccak ; to c:key! ( addr -- )
bernd's avatar
bernd committed
91
\G use addr as key storage
bernd's avatar
bernd committed
92
' @keccak to c:key@ ( -- addr )
bernd's avatar
bernd committed
93
\G obtain the key storage
bernd's avatar
bernd committed
94
' keccak# to c:key# ( -- n )
bernd's avatar
bernd committed
95
\G obtain key storage size
bernd's avatar
bernd committed
96 97
' keccak0 to c:0key ( -- )
\G set zero key
bernd's avatar
bernd committed
98
:noname keccak0 keccak#max >keccak ; to >c:key ( addr -- )
bernd's avatar
bernd committed
99
\G move 128 bytes from addr to the state
bernd's avatar
bernd committed
100
:noname keccak#max keccak> ; to c:key> ( addr -- )
bernd's avatar
bernd committed
101
\G get 128 bytes from the state to addr
bernd's avatar
bernd committed
102
' keccak* to c:diffuse ( -- )
bernd's avatar
bernd committed
103 104 105
\G perform a diffuse round
:noname ( addr u -- )
    \G Encrypt message in buffer addr u
bernd's avatar
bernd committed
106 107 108
    @keccak -rot KeccakEncryptLoop  drop
\    BEGIN  @keccak KeccakF  2dup keccak#max umin tuck +keccak
\    /string dup 0= UNTIL  2drop
bernd's avatar
bernd committed
109
; to c:encrypt
bernd's avatar
bernd committed
110 111
:noname ( addr u -- )
    \G Decrypt message in buffer addr u
bernd's avatar
bernd committed
112 113 114
    @keccak -rot KeccakDecryptLoop  drop
\    BEGIN  @keccak KeccakF  2dup keccak#max umin tuck -keccak
\    /string dup 0= UNTIL  2drop
bernd's avatar
bernd committed
115
; to c:decrypt ( addr u -- )
116
:noname ( addr u tag -- )
bernd's avatar
bernd committed
117
    \G Encrypt message in buffer addr u with auth
bernd's avatar
bernd committed
118 119
\    BEGIN  @keccak KeccakF  2dup keccak#max umin tuck +keccak
\    /string dup 0= UNTIL  drop
120
    { tag } @keccak -rot KeccakEncryptLoop
bernd's avatar
bernd committed
121
    @keccak KeccakF
122 123
    >r keccak-checksums keccak#cks keccak>
    keccak-checksums tag 7 and 4 lshift + 128@ r> 128!
124 125
; to c:encrypt+auth ( addr u tag -- )
:noname ( addr u tag -- flag )
bernd's avatar
bernd committed
126
    \G Decrypt message in buffer addr u, with auth check
bernd's avatar
bernd committed
127 128
\    BEGIN  @keccak KeccakF  2dup keccak#max umin tuck -keccak
\    /string dup 0= UNTIL  drop
129
    { tag } @keccak -rot KeccakDecryptLoop
bernd's avatar
bernd committed
130
    @keccak KeccakF
131 132
    128@ keccak-checksums keccak#cks keccak>
    keccak-checksums tag 7 and 4 lshift + 128@ 128=
133
; to c:decrypt+auth ( addr u tag -- flag )
bernd's avatar
bernd committed
134 135
:noname ( addr u -- )
\G Hash message in buffer addr u
bernd's avatar
bernd committed
136
    BEGIN  2dup keccak#max umin tuck
bernd's avatar
bernd committed
137 138 139 140
	dup keccak#max u< IF
	    keccak-padded keccak#max >padded
	    keccak-padded keccak#max
	THEN  >keccak  @keccak KeccakF
bernd's avatar
bernd committed
141
    /string dup 0= UNTIL  2drop
bernd's avatar
bernd committed
142
; to c:hash
bernd's avatar
bernd committed
143
:noname ( addr u -- )
bernd's avatar
bernd committed
144 145
    BEGIN  @keccak KeccakF  2dup keccak#max umin tuck keccak>
    /string dup 0= UNTIL  2drop
bernd's avatar
bernd committed
146
; to c:prng
bernd's avatar
bernd committed
147 148
\G Fill buffer addr u with PRNG sequence
:noname @keccak KeccakF
149 150
    keccak-checksums keccak#cks keccak>
    7 and 4 lshift keccak-checksums + 128@ ; to c:checksum ( tag -- xd )
bernd's avatar
bernd committed
151
\G compute a 128 bit checksum
152 153 154 155
:noname keccak-checksums keccak#cks keccak>
    64#0 keccak-checksums keccak#cks bounds ?DO
	I 64@ 64xor  8 +LOOP ; to c:cookie ( -- x )
\G obtain a 64 bit checksum
bernd's avatar
bernd committed
156 157 158 159 160
:noname @keccak keccak#max + dup >r 128@ 128xor r> 128! ;
to c:tweak! ( xd -- )
\G set 128 bit tweek
    
crypto-o @ Constant keccak-o