net2o: Hex Artifact Content

Artifact 61756da0d45bcf5157bf081e1f387ff2748787b2:

File keccak.fs — part of check-in [5b2c3a4f20] at 2018-01-15 22:02:50 on branch trunk — stubs for payment system (user: bernd size: 4378)
0000: 5c 20 6b 65 63 63 61 6b 20 77 72 61 70 70 65 72  \ keccak wrapper
0010: 0a 0a 5c 20 43 6f 70 79 72 69 67 68 74 20 28 43  ..\ Copyright (C
0020: 29 20 32 30 31 32 2d 32 30 31 35 20 20 20 42 65  ) 2012-2015   Be
0030: 72 6e 64 20 50 61 79 73 61 6e 0a 0a 5c 20 54 68  rnd Paysan..\ Th
0040: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 66 72  is program is fr
0050: 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f 75  ee software: you
0060: 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 74   can redistribut
0070: 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 69  e it and/or modi
0080: 66 79 0a 5c 20 69 74 20 75 6e 64 65 72 20 74 68  fy.\ it under th
0090: 65 20 74 65 72 6d 73 20 6f 66 20 74 68 65 20 47  e terms of the G
00a0: 4e 55 20 41 66 66 65 72 6f 20 47 65 6e 65 72 61  NU Affero Genera
00b0: 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65  l Public License
00c0: 20 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79   as published by
00d0: 0a 5c 20 74 68 65 20 46 72 65 65 20 53 6f 66 74  .\ the Free Soft
00e0: 77 61 72 65 20 46 6f 75 6e 64 61 74 69 6f 6e 2c  ware Foundation,
00f0: 20 65 69 74 68 65 72 20 76 65 72 73 69 6f 6e 20   either version 
0100: 33 20 6f 66 20 74 68 65 20 4c 69 63 65 6e 73 65  3 of the License
0110: 2c 20 6f 72 0a 5c 20 28 61 74 20 79 6f 75 72 20  , or.\ (at your 
0120: 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 65  option) any late
0130: 72 20 76 65 72 73 69 6f 6e 2e 0a 0a 5c 20 54 68  r version...\ Th
0140: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69  is program is di
0150: 73 74 72 69 62 75 74 65 64 20 69 6e 20 74 68 65  stributed in the
0160: 20 68 6f 70 65 20 74 68 61 74 20 69 74 20 77 69   hope that it wi
0170: 6c 6c 20 62 65 20 75 73 65 66 75 6c 2c 0a 5c 20  ll be useful,.\ 
0180: 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e 59 20  but WITHOUT ANY 
0190: 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75  WARRANTY; withou
01a0: 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 6c 69  t even the impli
01b0: 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 0a 5c  ed warranty of.\
01c0: 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59   MERCHANTABILITY
01d0: 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20   or FITNESS FOR 
01e0: 41 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 52  A PARTICULAR PUR
01f0: 50 4f 53 45 2e 20 20 53 65 65 20 74 68 65 0a 5c  POSE.  See the.\
0200: 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e 65   GNU Affero Gene
0210: 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e  ral Public Licen
0220: 73 65 20 66 6f 72 20 6d 6f 72 65 20 64 65 74 61  se for more deta
0230: 69 6c 73 2e 0a 0a 5c 20 59 6f 75 20 73 68 6f 75  ils...\ You shou
0240: 6c 64 20 68 61 76 65 20 72 65 63 65 69 76 65 64  ld have received
0250: 20 61 20 63 6f 70 79 20 6f 66 20 74 68 65 20 47   a copy of the G
0260: 4e 55 20 41 66 66 65 72 6f 20 47 65 6e 65 72 61  NU Affero Genera
0270: 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65  l Public License
0280: 0a 5c 20 61 6c 6f 6e 67 20 77 69 74 68 20 74 68  .\ along with th
0290: 69 73 20 70 72 6f 67 72 61 6d 2e 20 20 49 66 20  is program.  If 
02a0: 6e 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f  not, see <http:/
02b0: 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63  /www.gnu.org/lic
02c0: 65 6e 73 65 73 2f 3e 2e 0a 0a 72 65 71 75 69 72  enses/>...requir
02d0: 65 20 72 65 63 2d 73 63 6f 70 65 2e 66 73 0a 72  e rec-scope.fs.r
02e0: 65 71 75 69 72 65 20 75 6e 69 78 2f 63 70 75 2e  equire unix/cpu.
02f0: 66 73 0a 0a 66 61 73 74 2d 6c 69 62 20 5b 49 46  fs..fast-lib [IF
0300: 5d 0a 20 20 20 20 72 65 71 75 69 72 65 20 6b 65  ].    require ke
0310: 63 63 61 6b 66 61 73 74 2e 66 73 20 66 61 6c 73  ccakfast.fs fals
0320: 65 0a 5b 45 4c 53 45 5d 0a 20 20 20 20 5b 49 46  e.[ELSE].    [IF
0330: 44 45 46 5d 20 61 6e 64 72 6f 69 64 0a 09 73 22  DEF] android..s"
0340: 20 6c 69 62 6b 65 63 63 61 6b 2e 73 6f 22 20 63   libkeccak.so" c
0350: 2d 6c 69 62 3a 6f 70 65 6e 2d 70 61 74 68 2d 6c  -lib:open-path-l
0360: 69 62 20 64 72 6f 70 0a 20 20 20 20 5b 54 48 45  ib drop.    [THE
0370: 4e 5d 20 74 72 75 65 0a 5b 54 48 45 4e 5d 0a 5b  N] true.[THEN].[
0380: 49 46 5d 0a 20 20 20 20 63 2d 6c 69 62 72 61 72  IF].    c-librar
0390: 79 20 6b 65 63 63 61 6b 0a 09 73 22 20 6b 65 63  y keccak..s" kec
03a0: 63 61 6b 22 20 61 64 64 2d 6c 69 62 0a 09 69 6e  cak" add-lib..in
03b0: 63 6c 75 64 65 20 6b 65 63 63 61 6b 6c 69 62 2e  clude keccaklib.
03c0: 66 73 0a 20 20 20 20 65 6e 64 2d 63 2d 6c 69 62  fs.    end-c-lib
03d0: 72 61 72 79 0a 5b 54 48 45 4e 5d 0a 0a 5b 49 46  rary.[THEN]..[IF
03e0: 55 4e 44 45 46 5d 20 63 72 79 70 74 6f 20 62 79  UNDEF] crypto by
03f0: 65 20 5b 54 48 45 4e 5d 20 5c 20 73 74 6f 70 20  e [THEN] \ stop 
0400: 68 65 72 65 20 69 66 20 6c 69 62 63 6f 6d 70 69  here if libcompi
0410: 6c 65 20 6f 6e 6c 79 0a 0a 32 35 20 38 20 2a 20  le only..25 8 * 
0420: 43 6f 6e 73 74 61 6e 74 20 6b 65 63 63 61 6b 23  Constant keccak#
0430: 0a 31 32 38 20 43 6f 6e 73 74 61 6e 74 20 6b 65  .128 Constant ke
0440: 63 63 61 6b 23 6d 61 78 0a 31 32 38 20 43 6f 6e  ccak#max.128 Con
0450: 73 74 61 6e 74 20 6b 65 63 63 61 6b 23 63 6b 73  stant keccak#cks
0460: 0a 0a 55 56 61 6c 75 65 20 40 6b 65 63 63 61 6b  ..UValue @keccak
0470: 0a 32 34 20 56 61 6c 75 65 20 72 6f 75 6e 64 73  .24 Value rounds
0480: 0a 0a 3a 20 6b 65 63 63 61 6b 30 20 28 20 2d 2d  ..: keccak0 ( --
0490: 20 29 20 40 6b 65 63 63 61 6b 20 4b 65 63 63 61   ) @keccak Kecca
04a0: 6b 49 6e 69 74 69 61 6c 69 7a 65 53 74 61 74 65  kInitializeState
04b0: 20 3b 0a 0a 3a 20 6b 65 63 63 61 6b 2a 20 28 20   ;..: keccak* ( 
04c0: 2d 2d 20 29 20 40 6b 65 63 63 61 6b 20 72 6f 75  -- ) @keccak rou
04d0: 6e 64 73 20 4b 65 63 63 61 6b 46 20 3b 0a 3a 20  nds KeccakF ;.: 
04e0: 3e 6b 65 63 63 61 6b 20 28 20 61 64 64 72 20 75  >keccak ( addr u
04f0: 20 2d 2d 20 29 20 20 40 6b 65 63 63 61 6b 20 2d   -- )  @keccak -
0500: 72 6f 74 20 4b 65 63 63 61 6b 41 62 73 6f 72 62  rot KeccakAbsorb
0510: 20 3b 0a 3a 20 2b 6b 65 63 63 61 6b 20 28 20 61   ;.: +keccak ( a
0520: 64 64 72 20 75 20 2d 2d 20 29 20 20 40 6b 65 63  ddr u -- )  @kec
0530: 63 61 6b 20 2d 72 6f 74 20 4b 65 63 63 61 6b 45  cak -rot KeccakE
0540: 6e 63 72 79 70 74 20 3b 0a 3a 20 2d 6b 65 63 63  ncrypt ;.: -kecc
0550: 61 6b 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29  ak ( addr u -- )
0560: 20 20 40 6b 65 63 63 61 6b 20 2d 72 6f 74 20 4b    @keccak -rot K
0570: 65 63 63 61 6b 44 65 63 72 79 70 74 20 3b 0a 3a  eccakDecrypt ;.:
0580: 20 6b 65 63 63 61 6b 3e 20 28 20 61 64 64 72 20   keccak> ( addr 
0590: 75 20 2d 2d 20 29 20 20 40 6b 65 63 63 61 6b 20  u -- )  @keccak 
05a0: 2d 72 6f 74 20 4b 65 63 63 61 6b 45 78 74 72 61  -rot KeccakExtra
05b0: 63 74 20 3b 0a 0a 3a 20 6d 6f 76 65 2d 72 65 70  ct ;..: move-rep
05c0: 20 28 20 73 72 63 61 64 64 72 20 75 31 20 64 65   ( srcaddr u1 de
05d0: 73 74 61 64 64 72 20 75 32 20 2d 2d 20 29 0a 20  staddr u2 -- ). 
05e0: 20 20 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49     bounds ?DO..I
05f0: 27 20 49 20 2d 20 75 6d 69 6e 20 32 64 75 70 20  ' I - umin 2dup 
0600: 49 20 73 77 61 70 20 6d 6f 76 65 0a 20 20 20 20  I swap move.    
0610: 64 75 70 20 2b 4c 4f 4f 50 20 20 32 64 72 6f 70  dup +LOOP  2drop
0620: 20 3b 0a 0a 5c 20 63 72 79 70 74 6f 20 61 70 69   ;..\ crypto api
0630: 20 69 6e 74 65 67 72 61 74 69 6f 6e 0a 0a 63 72   integration..cr
0640: 79 70 74 6f 20 63 6c 61 73 73 0a 20 20 20 20 6b  ypto class.    k
0650: 65 63 63 61 6b 23 20 75 76 61 72 20 6b 65 63 63  eccak# uvar kecc
0660: 61 6b 2d 73 74 61 74 65 0a 20 20 20 20 6b 65 63  ak-state.    kec
0670: 63 61 6b 23 63 6b 73 20 75 76 61 72 20 6b 65 63  cak#cks uvar kec
0680: 63 61 6b 2d 63 68 65 63 6b 73 75 6d 73 0a 20 20  cak-checksums.  
0690: 20 20 6b 65 63 63 61 6b 23 6d 61 78 20 75 76 61    keccak#max uva
06a0: 72 20 6b 65 63 63 61 6b 2d 70 61 64 64 65 64 0a  r keccak-padded.
06b0: 65 6e 64 2d 63 6c 61 73 73 20 6b 65 63 63 61 6b  end-class keccak
06c0: 0a 0a 55 73 65 72 20 6b 65 63 63 61 6b 2d 74 0a  ..User keccak-t.
06d0: 0a 3a 20 6b 65 63 63 61 6b 2d 69 6e 69 74 20 28  .: keccak-init (
06e0: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 63 63 61 6b   -- ).    keccak
06f0: 2d 74 20 40 20 64 75 70 20 63 72 79 70 74 6f 2d  -t @ dup crypto-
0700: 6f 20 21 20 49 46 20 20 63 72 79 70 74 6f 2d 75  o ! IF  crypto-u
0710: 70 20 40 20 75 70 40 20 3d 20 3f 45 58 49 54 20  p @ up@ = ?EXIT 
0720: 20 54 48 45 4e 0a 20 20 20 20 5b 3a 20 6b 65 63   THEN.    [: kec
0730: 63 61 6b 20 6e 65 77 20 64 75 70 20 63 72 79 70  cak new dup cryp
0740: 74 6f 2d 6f 20 21 20 6b 65 63 63 61 6b 2d 74 20  to-o ! keccak-t 
0750: 21 20 3b 5d 20 63 72 79 70 74 6f 2d 61 20 77 69  ! ;] crypto-a wi
0760: 74 68 2d 61 6c 6c 6f 63 61 74 65 72 0a 20 20 20  th-allocater.   
0770: 20 75 70 40 20 63 72 79 70 74 6f 2d 75 70 20 21   up@ crypto-up !
0780: 20 6b 65 63 63 61 6b 2d 73 74 61 74 65 20 74 6f   keccak-state to
0790: 20 40 6b 65 63 63 61 6b 20 3b 0a 0a 3a 20 6b 65   @keccak ;..: ke
07a0: 63 63 61 6b 2d 66 72 65 65 20 63 72 79 70 74 6f  ccak-free crypto
07b0: 2d 6f 20 40 20 3f 64 75 70 2d 49 46 20 20 5b 3a  -o @ ?dup-IF  [:
07c0: 20 2e 64 69 73 70 6f 73 65 20 3b 5d 20 63 72 79   .dispose ;] cry
07d0: 70 74 6f 2d 61 20 77 69 74 68 2d 61 6c 6c 6f 63  pto-a with-alloc
07e0: 61 74 65 72 20 20 54 48 45 4e 0a 20 20 20 20 30  ater  THEN.    0
07f0: 20 74 6f 20 40 6b 65 63 63 61 6b 20 63 72 79 70   to @keccak cryp
0800: 74 6f 2d 6f 20 6f 66 66 20 3b 0a 0a 6b 65 63 63  to-o off ;..kecc
0810: 61 6b 2d 69 6e 69 74 0a 0a 3a 6e 6f 6e 61 6d 65  ak-init..:noname
0820: 20 64 65 66 65 72 73 20 27 63 6f 6c 64 20 6b 65   defers 'cold ke
0830: 63 63 61 6b 2d 69 6e 69 74 20 3b 20 69 73 20 27  ccak-init ; is '
0840: 63 6f 6c 64 0a 3a 6e 6f 6e 61 6d 65 20 64 65 66  cold.:noname def
0850: 65 72 73 20 27 69 6d 61 67 65 20 63 72 79 70 74  ers 'image crypt
0860: 6f 2d 6f 20 6f 66 66 20 20 6b 65 63 63 61 6b 2d  o-o off  keccak-
0870: 74 20 6f 66 66 20 3b 20 69 73 20 27 69 6d 61 67  t off ; is 'imag
0880: 65 0a 0a 27 20 6b 65 63 63 61 6b 2d 69 6e 69 74  e..' keccak-init
0890: 20 74 6f 20 63 3a 69 6e 69 74 0a 27 20 6b 65 63   to c:init.' kec
08a0: 63 61 6b 2d 66 72 65 65 20 74 6f 20 63 3a 66 72  cak-free to c:fr
08b0: 65 65 0a 3a 6e 6f 6e 61 6d 65 20 74 6f 20 40 6b  ee.:noname to @k
08c0: 65 63 63 61 6b 20 3b 20 74 6f 20 63 3a 6b 65 79  eccak ; to c:key
08d0: 21 20 28 20 61 64 64 72 20 2d 2d 20 29 0a 5c 47  ! ( addr -- ).\G
08e0: 20 75 73 65 20 61 64 64 72 20 61 73 20 6b 65 79   use addr as key
08f0: 20 73 74 6f 72 61 67 65 0a 27 20 40 6b 65 63 63   storage.' @kecc
0900: 61 6b 20 74 6f 20 63 3a 6b 65 79 40 20 28 20 2d  ak to c:key@ ( -
0910: 2d 20 61 64 64 72 20 29 0a 5c 47 20 6f 62 74 61  - addr ).\G obta
0920: 69 6e 20 74 68 65 20 6b 65 79 20 73 74 6f 72 61  in the key stora
0930: 67 65 0a 27 20 6b 65 63 63 61 6b 23 20 74 6f 20  ge.' keccak# to 
0940: 63 3a 6b 65 79 23 20 28 20 2d 2d 20 6e 20 29 0a  c:key# ( -- n ).
0950: 5c 47 20 6f 62 74 61 69 6e 20 6b 65 79 20 73 74  \G obtain key st
0960: 6f 72 61 67 65 20 73 69 7a 65 0a 27 20 6b 65 63  orage size.' kec
0970: 63 61 6b 30 20 74 6f 20 63 3a 30 6b 65 79 20 28  cak0 to c:0key (
0980: 20 2d 2d 20 29 0a 5c 47 20 73 65 74 20 7a 65 72   -- ).\G set zer
0990: 6f 20 6b 65 79 0a 3a 6e 6f 6e 61 6d 65 20 6b 65  o key.:noname ke
09a0: 63 63 61 6b 30 20 6b 65 63 63 61 6b 23 6d 61 78  ccak0 keccak#max
09b0: 20 3e 6b 65 63 63 61 6b 20 3b 20 74 6f 20 3e 63   >keccak ; to >c
09c0: 3a 6b 65 79 20 28 20 61 64 64 72 20 2d 2d 20 29  :key ( addr -- )
09d0: 0a 5c 47 20 6d 6f 76 65 20 31 32 38 20 62 79 74  .\G move 128 byt
09e0: 65 73 20 66 72 6f 6d 20 61 64 64 72 20 74 6f 20  es from addr to 
09f0: 74 68 65 20 73 74 61 74 65 0a 3a 6e 6f 6e 61 6d  the state.:nonam
0a00: 65 20 6b 65 63 63 61 6b 23 6d 61 78 20 6b 65 63  e keccak#max kec
0a10: 63 61 6b 3e 20 3b 20 74 6f 20 63 3a 6b 65 79 3e  cak> ; to c:key>
0a20: 20 28 20 61 64 64 72 20 2d 2d 20 29 0a 5c 47 20   ( addr -- ).\G 
0a30: 67 65 74 20 31 32 38 20 62 79 74 65 73 20 66 72  get 128 bytes fr
0a40: 6f 6d 20 74 68 65 20 73 74 61 74 65 20 74 6f 20  om the state to 
0a50: 61 64 64 72 0a 27 20 6b 65 63 63 61 6b 2a 20 74  addr.' keccak* t
0a60: 6f 20 63 3a 64 69 66 66 75 73 65 20 28 20 2d 2d  o c:diffuse ( --
0a70: 20 29 0a 5c 47 20 70 65 72 66 6f 72 6d 20 61 20   ).\G perform a 
0a80: 64 69 66 66 75 73 65 20 72 6f 75 6e 64 0a 3a 6e  diffuse round.:n
0a90: 6f 6e 61 6d 65 20 28 20 61 64 64 72 20 75 20 2d  oname ( addr u -
0aa0: 2d 20 29 0a 20 20 20 20 5c 47 20 45 6e 63 72 79  - ).    \G Encry
0ab0: 70 74 20 6d 65 73 73 61 67 65 20 69 6e 20 62 75  pt message in bu
0ac0: 66 66 65 72 20 61 64 64 72 20 75 0a 20 20 20 20  ffer addr u.    
0ad0: 40 6b 65 63 63 61 6b 20 2d 72 6f 74 20 72 6f 75  @keccak -rot rou
0ae0: 6e 64 73 20 4b 65 63 63 61 6b 45 6e 63 72 79 70  nds KeccakEncryp
0af0: 74 4c 6f 6f 70 20 20 64 72 6f 70 0a 3b 20 74 6f  tLoop  drop.; to
0b00: 20 63 3a 65 6e 63 72 79 70 74 0a 3a 6e 6f 6e 61   c:encrypt.:nona
0b10: 6d 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29  me ( addr u -- )
0b20: 0a 20 20 20 20 5c 47 20 44 65 63 72 79 70 74 20  .    \G Decrypt 
0b30: 6d 65 73 73 61 67 65 20 69 6e 20 62 75 66 66 65  message in buffe
0b40: 72 20 61 64 64 72 20 75 0a 20 20 20 20 40 6b 65  r addr u.    @ke
0b50: 63 63 61 6b 20 2d 72 6f 74 20 72 6f 75 6e 64 73  ccak -rot rounds
0b60: 20 4b 65 63 63 61 6b 44 65 63 72 79 70 74 4c 6f   KeccakDecryptLo
0b70: 6f 70 20 20 64 72 6f 70 0a 3b 20 74 6f 20 63 3a  op  drop.; to c:
0b80: 64 65 63 72 79 70 74 20 28 20 61 64 64 72 20 75  decrypt ( addr u
0b90: 20 2d 2d 20 29 0a 3a 6e 6f 6e 61 6d 65 20 28 20   -- ).:noname ( 
0ba0: 61 64 64 72 20 75 20 74 61 67 20 2d 2d 20 29 0a  addr u tag -- ).
0bb0: 20 20 20 20 5c 47 20 45 6e 63 72 79 70 74 20 6d      \G Encrypt m
0bc0: 65 73 73 61 67 65 20 69 6e 20 62 75 66 66 65 72  essage in buffer
0bd0: 20 61 64 64 72 20 75 20 77 69 74 68 20 61 75 74   addr u with aut
0be0: 68 0a 20 20 20 20 7b 20 74 61 67 20 7d 20 40 6b  h.    { tag } @k
0bf0: 65 63 63 61 6b 20 2d 72 6f 74 20 72 6f 75 6e 64  eccak -rot round
0c00: 73 20 4b 65 63 63 61 6b 45 6e 63 72 79 70 74 4c  s KeccakEncryptL
0c10: 6f 6f 70 0a 20 20 20 20 6b 65 63 63 61 6b 2a 0a  oop.    keccak*.
0c20: 20 20 20 20 3e 72 20 6b 65 63 63 61 6b 2d 63 68      >r keccak-ch
0c30: 65 63 6b 73 75 6d 73 20 6b 65 63 63 61 6b 23 63  ecksums keccak#c
0c40: 6b 73 20 6b 65 63 63 61 6b 3e 0a 20 20 20 20 6b  ks keccak>.    k
0c50: 65 63 63 61 6b 2d 63 68 65 63 6b 73 75 6d 73 20  eccak-checksums 
0c60: 74 61 67 20 37 20 61 6e 64 20 34 20 6c 73 68 69  tag 7 and 4 lshi
0c70: 66 74 20 2b 20 72 3e 20 24 31 30 20 6d 6f 76 65  ft + r> $10 move
0c80: 0a 3b 20 74 6f 20 63 3a 65 6e 63 72 79 70 74 2b  .; to c:encrypt+
0c90: 61 75 74 68 20 28 20 61 64 64 72 20 75 20 74 61  auth ( addr u ta
0ca0: 67 20 2d 2d 20 29 0a 3a 6e 6f 6e 61 6d 65 20 28  g -- ).:noname (
0cb0: 20 61 64 64 72 20 75 20 74 61 67 20 2d 2d 20 66   addr u tag -- f
0cc0: 6c 61 67 20 29 0a 20 20 20 20 5c 47 20 44 65 63  lag ).    \G Dec
0cd0: 72 79 70 74 20 6d 65 73 73 61 67 65 20 69 6e 20  rypt message in 
0ce0: 62 75 66 66 65 72 20 61 64 64 72 20 75 2c 20 77  buffer addr u, w
0cf0: 69 74 68 20 61 75 74 68 20 63 68 65 63 6b 0a 20  ith auth check. 
0d00: 20 20 20 7b 20 74 61 67 20 7d 20 40 6b 65 63 63     { tag } @kecc
0d10: 61 6b 20 2d 72 6f 74 20 72 6f 75 6e 64 73 20 4b  ak -rot rounds K
0d20: 65 63 63 61 6b 44 65 63 72 79 70 74 4c 6f 6f 70  eccakDecryptLoop
0d30: 0a 20 20 20 20 6b 65 63 63 61 6b 2a 0a 20 20 20  .    keccak*.   
0d40: 20 6b 65 63 63 61 6b 2d 63 68 65 63 6b 73 75 6d   keccak-checksum
0d50: 73 20 6b 65 63 63 61 6b 23 63 6b 73 20 6b 65 63  s keccak#cks kec
0d60: 63 61 6b 3e 0a 20 20 20 20 6b 65 63 63 61 6b 2d  cak>.    keccak-
0d70: 63 68 65 63 6b 73 75 6d 73 20 74 61 67 20 37 20  checksums tag 7 
0d80: 61 6e 64 20 34 20 6c 73 68 69 66 74 20 2b 20 24  and 4 lshift + $
0d90: 31 30 20 74 75 63 6b 20 73 74 72 3d 0a 3b 20 74  10 tuck str=.; t
0da0: 6f 20 63 3a 64 65 63 72 79 70 74 2b 61 75 74 68  o c:decrypt+auth
0db0: 20 28 20 61 64 64 72 20 75 20 74 61 67 20 2d 2d   ( addr u tag --
0dc0: 20 66 6c 61 67 20 29 0a 3a 6e 6f 6e 61 6d 65 20   flag ).:noname 
0dd0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 5c 47  ( addr u -- ).\G
0de0: 20 48 61 73 68 20 6d 65 73 73 61 67 65 20 69 6e   Hash message in
0df0: 20 62 75 66 66 65 72 20 61 64 64 72 20 75 0a 20   buffer addr u. 
0e00: 20 20 20 42 45 47 49 4e 20 20 32 64 75 70 20 6b     BEGIN  2dup k
0e10: 65 63 63 61 6b 23 6d 61 78 20 75 6d 69 6e 20 74  eccak#max umin t
0e20: 75 63 6b 0a 09 64 75 70 20 6b 65 63 63 61 6b 23  uck..dup keccak#
0e30: 6d 61 78 20 75 3c 20 49 46 0a 09 20 20 20 20 6b  max u< IF..    k
0e40: 65 63 63 61 6b 2d 70 61 64 64 65 64 20 6b 65 63  eccak-padded kec
0e50: 63 61 6b 23 6d 61 78 20 3e 70 61 64 64 65 64 0a  cak#max >padded.
0e60: 09 20 20 20 20 6b 65 63 63 61 6b 2d 70 61 64 64  .    keccak-padd
0e70: 65 64 20 6b 65 63 63 61 6b 23 6d 61 78 0a 09 54  ed keccak#max..T
0e80: 48 45 4e 20 20 3e 6b 65 63 63 61 6b 20 20 6b 65  HEN  >keccak  ke
0e90: 63 63 61 6b 2a 0a 20 20 20 20 2f 73 74 72 69 6e  ccak*.    /strin
0ea0: 67 20 64 75 70 20 30 3d 20 55 4e 54 49 4c 20 20  g dup 0= UNTIL  
0eb0: 32 64 72 6f 70 0a 3b 20 74 6f 20 63 3a 68 61 73  2drop.; to c:has
0ec0: 68 0a 3a 6e 6f 6e 61 6d 65 20 28 20 61 64 64 72  h.:noname ( addr
0ed0: 20 75 20 2d 2d 20 29 0a 5c 47 20 46 69 6c 6c 20   u -- ).\G Fill 
0ee0: 62 75 66 66 65 72 20 61 64 64 72 20 75 20 77 69  buffer addr u wi
0ef0: 74 68 20 50 52 4e 47 20 73 65 71 75 65 6e 63 65  th PRNG sequence
0f00: 0a 20 20 20 20 32 64 75 70 20 65 72 61 73 65 20  .    2dup erase 
0f10: 40 6b 65 63 63 61 6b 20 2d 72 6f 74 20 72 6f 75  @keccak -rot rou
0f20: 6e 64 73 20 4b 65 63 63 61 6b 45 6e 63 72 79 70  nds KeccakEncryp
0f30: 74 4c 6f 6f 70 20 64 72 6f 70 0a 3b 20 74 6f 20  tLoop drop.; to 
0f40: 63 3a 70 72 6e 67 0a 3a 6e 6f 6e 61 6d 65 20 28  c:prng.:noname (
0f50: 20 61 64 64 72 20 75 20 2d 2d 20 29 20 3e 6b 65   addr u -- ) >ke
0f60: 63 63 61 6b 20 6b 65 63 63 61 6b 2a 20 3b 0a 5c  ccak keccak* ;.\
0f70: 47 20 61 62 73 6f 72 62 20 2b 20 68 61 73 68 20  G absorb + hash 
0f80: 66 6f 72 20 61 20 6d 65 73 73 61 67 65 20 3c 3d  for a message <=
0f90: 20 36 34 20 62 79 74 65 73 0a 74 6f 20 63 3a 73   64 bytes.to c:s
0fa0: 68 6f 72 74 68 61 73 68 0a 27 20 6b 65 63 63 61  horthash.' kecca
0fb0: 6b 3e 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29  k> ( addr u -- )
0fc0: 0a 20 20 20 20 5c 47 20 65 78 74 72 61 63 74 20  .    \G extract 
0fd0: 73 68 6f 72 74 20 68 61 73 68 20 28 75 70 20 74  short hash (up t
0fe0: 6f 20 36 34 20 62 79 74 65 73 29 0a 74 6f 20 63  o 64 bytes).to c
0ff0: 3a 68 61 73 68 40 0a 3a 6e 6f 6e 61 6d 65 20 28  :hash@.:noname (
1000: 20 78 31 32 38 20 61 64 64 72 20 75 20 2d 2d 20   x128 addr u -- 
1010: 29 0a 20 20 20 20 5c 47 20 73 65 74 20 6b 65 79  ).    \G set key
1020: 20 70 6c 75 73 20 74 77 65 61 6b 0a 20 20 20 20   plus tweak.    
1030: 6b 65 63 63 61 6b 2d 70 61 64 64 65 64 20 6b 65  keccak-padded ke
1040: 63 63 61 6b 23 6d 61 78 20 64 75 70 20 32 2f 20  ccak#max dup 2/ 
1050: 2f 73 74 72 69 6e 67 20 6d 6f 76 65 2d 72 65 70  /string move-rep
1060: 0a 20 20 20 20 6b 65 63 63 61 6b 2d 70 61 64 64  .    keccak-padd
1070: 65 64 20 6b 65 63 63 61 6b 23 6d 61 78 20 32 2f  ed keccak#max 2/
1080: 20 62 6f 75 6e 64 73 20 44 4f 0a 09 36 34 6f 76   bounds DO..64ov
1090: 65 72 20 36 34 6f 76 65 72 20 49 20 6c 65 2d 31  er 64over I le-1
10a0: 32 38 21 20 20 24 31 30 20 2b 4c 4f 4f 50 20 20  28!  $10 +LOOP  
10b0: 36 34 64 72 6f 70 20 36 34 64 72 6f 70 0a 20 20  64drop 64drop.  
10c0: 20 20 6b 65 63 63 61 6b 30 20 6b 65 63 63 61 6b    keccak0 keccak
10d0: 2d 70 61 64 64 65 64 20 6b 65 63 63 61 6b 23 6d  -padded keccak#m
10e0: 61 78 20 3e 6b 65 63 63 61 6b 20 3b 0a 74 6f 20  ax >keccak ;.to 
10f0: 63 3a 74 77 65 61 6b 6b 65 79 21 0a 0a 63 72 79  c:tweakkey!..cry
1100: 70 74 6f 2d 6f 20 40 20 43 6f 6e 73 74 61 6e 74  pto-o @ Constant
1110: 20 6b 65 63 63 61 6b 2d 6f 0a                     keccak-o.