\ Wurstkessel data from www.random.org 26jan09py
require 64bit.fs
require crypto-api.fs
8 64s Constant state#
2 2* Constant state#32
1 Constant state#16
crypto-o next-task - class-o !
crypto class
state# uvar wurst-source
state# uvar wurst-state
state# uvar nextstate
state# 8 * uvar message
cell uvar wurst-up
end-class wurstkessel
: .16 ( u[d] -- )
[ cell 8 = ] [IF] 0 [THEN]
base @ >r hex <<# 16 0 DO # LOOP #> type #>> r> base ! ;
: .nnb ( addr n -- ) bounds ?DO I 64@ .16 space 1 64s +LOOP ;
: .64b ( addr -- ) 64 .nnb ;
: .state ( -- ) wurst-state .64b ;
: .source ( -- ) wurst-source .64b ;
align here
$6C5F6F6CBE627172. 64, $7164C30603661C2E. 64, $CE5009401B441346. 64, $454FA335A6E63AD2. 64,
$ABE9D0D648C15F6E. 64, $B90FD4060D7935D6. 64, $F7EDA8E2E8D6CB32. 64, $6230D90DBE8E061B. 64,
here
$20799FEC4B2E86C7. 64, $9F5454CDBDF51F76. 64, $EE1905FFF4B24C3D. 64, $9841F78BA1E0A3B7. 64,
$B6C33E39C326A161. 64, $FD4E8C0EAA7C4362. 64, $839E0910FFD9401A. 64, $2785F5C10D610C68. 64,
here
$FEC967C32E46440F. 64, $3F63157E14F89982. 64, $F7364A7F8083EFFA. 64, $FC62572A44559951. 64,
$9915714DB7397949. 64, $AE4180D53650E38C. 64, $C53813781DFF0C2E. 64, $A579435502F22741. 64,
here
$39A157A31F7D62BC. 64, $51C3BD3BA4F4F803. 64, $21D7D0ED16A5243A. 64, $3C80195D8D80874F. 64,
$6DF5EF6205D55E03. 64, $8859C59812F47028. 64, $F7795F00874ACED7. 64, $5FBE66944DBECB7F. 64,
here
$FEC967C32E46440F. 64, $3F63157E14F89982. 64, $F7364A7F8083EFFA. 64, $FC62572A44559951. 64,
$9915714DB7397949. 64, $AE4180D53650E38C. 64, $C53813781DFF0C2E. 64, $A579435502F22741. 64,
Constant state-init
Constant wurst-salt \ for testing only! This is salt, should not be guessable!
Constant rnd-init \ for testing only! This is salt, should not be guessable!
Constant wurst-key \ default key
Constant source-init
Create 'rngs \ this is essentially Wurstkessel's S-box
$EA576B15A7AFBA08. 64, $BF4888DC02131EF7. 64, $5F49A40B1DAAF5FD. 64, $7798975E5233C89D. 64,
$A70A1BD518B3FBC6. 64, $8E31D54ECB7BCDF9. 64, $949D107029F94EAA. 64, $7B40261F6B3E0763. 64,
$E845F90477A30AC5. 64, $6BF5CDC094B7A657. 64, $B0796C9F61F990F9. 64, $C149FABA50014BFC. 64,
$626377228BC762EF. 64, $639BFE93094E7B84. 64, $0B61140C13513E15. 64, $ADB800460D8B7A3F. 64,
$20D3873110880D43. 64, $144B862F4755D8EF. 64, $69C127F350ECD709. 64, $4A92511FAD31D465. 64,
$34EB0EF8ED8230B2. 64, $477BF466E332DDB8. 64, $086B6F20DC2F1B33. 64, $E020C8012E1EBC4A. 64,
$C4A5BEF939044AFC. 64, $C5C5B03F80FAF739. 64, $AD46EFBA6E4EEFB2. 64, $EAD04EEF21AD5CCA. 64,
$68516345F32E582E. 64, $FEDE2067A335B1F6. 64, $96611D13172BA044. 64, $1DDBC3F36257DF96. 64,
$4BFE75A91B582D07. 64, $82DF3A7D4205D9B4. 64, $CDC7C2C769B10163. 64, $2B9EFB3A406C1C22. 64,
$DA732F17BB5FA819. 64, $14DA2D994B88EBFB. 64, $E9E8DA371866818E. 64, $6AAFEAAB80D72758. 64,
$E2453ACEA74719DB. 64, $62CAB78E82137E78. 64, $4B60E6778A84C82B. 64, $41BF2417B0070764. 64,
$F3865ADEBF337A99. 64, $A1EC36C696492BE0. 64, $7C884B32080C649F. 64, $AAE99BDADC37685A. 64,
$DCA4C59D98BEEC6C. 64, $DD8886FED8B82090. 64, $F894AA6994EFDB8A. 64, $FB954EA7107B1BF3. 64,
$80E569581773CF5F. 64, $F418E1F97E601D94. 64, $7A9B9F9033A40820. 64, $00E06D7C4F50726B. 64,
$19C205C7F461EB65. 64, $DB610A36DE40AE7C. 64, $0FCD201AF3E65F5F. 64, $5840910FC1902224. 64,
$1210975240BE1829. 64, $71B97307E8E903F9. 64, $DF85C6C346DF4FF2. 64, $BB26F835FD3711F1. 64,
$4DE8E6DC008BD249. 64, $8C11D5A647CA6231. 64, $B10D0F66EC07A251. 64, $D2D4C7BD608AACDE. 64,
$17C7560D621E6D62. 64, $A182591BC53D7C8A. 64, $8FBF7260C16058D7. 64, $D20C1AA47AD280FD. 64,
$4C34ABC646276D3E. 64, $DF9328222B555885. 64, $5FCEAC68B91AA75F. 64, $B662C4D84F7135C6. 64,
$418DBD3C45D7E67C. 64, $5E07DB97A28D2A3A. 64, $D5D7B024C7E148A3. 64, $3F3023639E4ED91D. 64,
$75590580D18BDCF7. 64, $2936C445A8CCE5D3. 64, $1C9B51352A9B38AA. 64, $1EC67B0E63EA6B9C. 64,
$30AA42F444DD8D77. 64, $5490C75F1A50B3D4. 64, $8A62DC6866149DC6. 64, $45E71CA58A3A1A03. 64,
$44C35A60CA62EF4C. 64, $8A8D10F67904F203. 64, $73FB47C99A789E27. 64, $F6DA264C5EC58834. 64,
$7DE707AB941A68B1. 64, $8E5FC15AB1B82D42. 64, $169F270E31E118B9. 64, $89D77D2CA228F1A1. 64,
$F73BFCD076EA4593. 64, $3FC2594EA868AA6B. 64, $7E712B3826BF940B. 64, $C5E47523F2ED72D3. 64,
$B17D5E2B40D91CB7. 64, $7A46CA989B6B545C. 64, $DF53963473D8A028. 64, $1C2B05E95B6A2361. 64,
$2A8CE6CC8AA46240. 64, $7E56673B8467B2D4. 64, $5CC08986DD1643D2. 64, $34BEC26C10A8A0F7. 64,
$5A1065508344D9BF. 64, $964CD691C7514A54. 64, $DA6642E206D8EEC0. 64, $FE50640EACC57736. 64,
$4FD775BEEC03E00C. 64, $2ED51322FA648470. 64, $D126396FE346FD82. 64, $321F8E62660A5358. 64,
$B18AC0415120A970. 64, $AE66E8D0D89BDEA2. 64, $8FF3907042113713. 64, $3ED1A5AF45B9BD21. 64,
$CD93C5A7676F9B80. 64, $B6390A3D94DAEF11. 64, $868976715C5CCA68. 64, $AD886AA064B5DDC5. 64,
$DCD8A0CCB0EE4F42. 64, $5E825B5AF2696B48. 64, $C6AD2848B1BD2AFE. 64, $4DE5A20AD330B6E4. 64,
$121DA3E4428AA27D. 64, $AD734AF69BB658E8. 64, $A239809834B66FEC. 64, $4E0AFF25C162024C. 64,
$12ADAB1B8CDBAA49. 64, $7EFD205B8A2D7142. 64, $1100D36951CC6ACD. 64, $56D7D5D9087D42DC. 64,
$19BE8F3D1D7A103F. 64, $587697A07337E076. 64, $F134983D796333BF. 64, $8A67B4F38C5624C5. 64,
$5D8A9736AD2EEDE3. 64, $5C32F0C1D2E26BED. 64, $029AD86080A1960A. 64, $ED5F76D1DB276ED9. 64,
$33CB581061805DFD. 64, $A5DF2522A0F691C7. 64, $A4ADEDF782FD6BD2. 64, $FE384FF0D371C964. 64,
$F5CFEF9E4A4CD273. 64, $85CBBAC869401C81. 64, $D511B713FED7005B. 64, $A7611177D696F186. 64,
$CB2BE1FFA608F675. 64, $25031046C85C4651. 64, $607171BC4577D270. 64, $A7BD8884299863A6. 64,
$BB09FB728099A1E0. 64, $257145E566C8698F. 64, $656BDB6B9184535F. 64, $2682AAE2CA83AE91. 64,
$F7A44CC4003AAEE0. 64, $888A9A9370DA460A. 64, $6DE1F7FCFF64A895. 64, $B998294B6E631726. 64,
$DD10FD0E373DE174. 64, $A4A1C99E1EDFF788. 64, $ABF89C5C23965C8C. 64, $519FCEACDB50A42E. 64,
$C87EE06B04A3EE27. 64, $B3B84836F52EFE4A. 64, $6771855FC5488FF2. 64, $029F27357BF79A7B. 64,
$864E931EC02D2201. 64, $9DFA41C069A2BEEE. 64, $22A5DB4B50464091. 64, $B0D2E299A7808724. 64,
$FFC352ACC4E06CD6. 64, $9578BEBB4DB8FC2F. 64, $DC6E349B2D6DA548. 64, $2094DAB6C646C2D7. 64,
$3B0AF3D2FD8EF1D0. 64, $63FDE78F2E0FB634. 64, $1C99503BC604F097. 64, $1C1EF3E82C9FC053. 64,
$6BDB8E76017C181A. 64, $26D88404B8CBAFAE. 64, $187366AF04471F8D. 64, $76A2778F66E512B8. 64,
$E5BA2951AF211F80. 64, $86B065507B33F205. 64, $75E3B0DFDD17BE98. 64, $09EDA77B60ABFE0A. 64,
$97BEA04E8FA350FC. 64, $BC6E641D8A5D1A28. 64, $46D6377D5FB77C8D. 64, $3F97A7C23285D9E4. 64,
$BA50164CA926C25D. 64, $CCDB57813E220451. 64, $1C967F121B63DDDF. 64, $A2A840B2E56CA3BD. 64,
$00787A81DB69A851. 64, $AB7BE835BFC19FE8. 64, $C35A18B6E11A9F05. 64, $F4FAD3C269CEA995. 64,
$C52B4F9FB5F7EB87. 64, $BF066890B494DF0E. 64, $E665E54BD57BF07D. 64, $9F662650E1CAA8B3. 64,
$B60FCBB205E1B3D4. 64, $21D47F05B16CEE46. 64, $A7706D9DA4D36B31. 64, $23028D1C88657839. 64,
$E0F3BE98C0D8E92E. 64, $9DA5D5CDED8C4DA2. 64, $827109BFA754CEA4. 64, $435571F88E42BC1F. 64,
$3CE06094CBB9EFCB. 64, $2C03447D95B00977. 64, $D3E63B65D96A3686. 64, $A50C72D7437BC7FE. 64,
$5737E476389CA9FD. 64, $3C8F8495ED9FB6BB. 64, $7E66BF01BDDE8AC9. 64, $42FF650C947F1B73. 64,
$831AD4C01A37458A. 64, $AB86296924F9D44E. 64, $D04534934527FE11. 64, $AD67B18D326BA056. 64,
$CDC85BC218E596C3. 64, $97536CD65082A588. 64, $41838111A37C89B5. 64, $1E670AC7A5905648. 64,
$7EB67D2636ADEDF6. 64, $0560514F780DD13E. 64, $8B78A94B6C990708. 64, $7C15977BA8EA6213. 64,
$8C8E898D35F895FE. 64, $1A2CA8EE917F324B. 64, $2CD3067B1262A84D. 64, $169C0956D6011241. 64,
$3213F9193BDB3C69. 64, $7BC2F0864E7C480E. 64, $539F82006AB05B2C. 64, $D684DD5C69A76F73. 64,
$168A44E4E0FA0504. 64, $42A75FDDE3BA8C01. 64, $FB48A92AE2DAD4D1. 64, $86121899DC7429C7. 64,
$10F72AA5B40A344A. 64, $E4926B1781F8C90C. 64, $4F4C3F28EDAD7518. 64, $744C57C4DB14A013. 64,
$450FC24B306136AE. 64, $DBE8614B7E18115C. 64, $A4CD66811B0F87FC. 64, $31984500099D06F5. 64,
here 'rngs -
constant rng-size
\ wurstkessel primitives
cell 8 = [IF]
: wurst ( u1 u2 -- u3 ) >r dup 2* swap 0< - r> xor ;
: rngs 64s 'rngs + 64@ ;
[ELSE]
s" bigFORTH" environment? [IF] 2drop
Code wurst ( ud1 ud2 -- ud3 )
DX pop CX pop SP ) BX xchg
BX BX add CX CX adc
0 # BX adc DX BX xor CX AX xor
SP ) BX xchg
Next end-code macro
Code rngs 'rngs AX *8 I#) push 'rngs cell+ AX *8 I#) AX mov
Next end-code macro
[ELSE]
: rngs 64s 'rngs + 64@ ;
: wurst ( ud1 ud2 -- ud3 ) 2>r
dup 0< >r d2* r> dup d- 2r>
64xor ;
[THEN]
[THEN]
\ permutation generation
0 [IF]
Create permut# 0 , 1 , 2 , 3 , 4 , 5 , 6 , 7 ,
permut#
DOES> swap 7 and cells + @ ;
Constant 'permut
create state1 0 , 1 , 2 , 3 , 4 , 5 , 6 , 7 ,
create state2 8 cells allot
: permut 8 0 DO state1 I permut# cells + @ state2 I cells + ! LOOP
state2 state1 8 cells move ;
: permut@ 0 8 0 DO 3 lshift state1 I cells + @ or LOOP ;
permut@ Constant init-permut
: permut-count ( -- n )
0 BEGIN 1+ permut permut@ init-permut = UNTIL ;
: (permut-counts { n }
n 0= IF permut-count . 8 0 DO I permut# . LOOP cr EXIT THEN
8 0 DO
'permut I cells + dup @ 0= IF
n swap ! n 1- recurse 'permut I cells + off
ELSE drop THEN
LOOP ;
: permut-counts 'permut 8 cells erase 7 (permut-counts ;
[THEN]
\ wurstkessel algorithm
: mix2bytes ( index n k -- b1 .. b8 index' n ) wurst-state + 8 0 DO
>r over wurst-source + c@ r@ c@ xor -rot dup >r + $3F and r> r> 8 + LOOP
drop ;
: bytes2sum ( ud b1 .. b8 -- ud' ) >r >r >r >r >r >r >r >r
r> rngs wurst r> rngs wurst r> rngs wurst r> rngs wurst
r> rngs wurst r> rngs wurst r> rngs wurst r> rngs wurst ;
Create round# 13 , 29 , 19 , 23 , 31 , 47 , 17 , 37 ,
DOES> swap 7 and cells + @ ;
Create permut# 2 , 6 , 1 , 4 , 7 , 0 , 5 , 3 , \ permut length 15
DOES> swap 7 and cells + @ ;
: xors ( addr1 addr2 n -- ) bounds ?DO
dup @ I @ xor I ! cell+ cell +LOOP drop ;
: +!s ( addr1 addr2 n -- ) bounds ?DO
dup 64@ I 64@ 64+ I 64! 64'+ 1 64s +LOOP drop ;
: update-state ( -- )
wurst-state wurst-source state# xors
nextstate wurst-state state# +!s ;
: round ( n -- ) dup 1- swap 8 0 DO
wurst-state I permut# 64s + 64@ -64rot
I mix2bytes 2>r bytes2sum 2r> 64rot nextstate I 64s + 64!
LOOP 2drop update-state ;
\ fast mixing
[IFUNDEF] ]]
: [[ ; \ token to end bulk-postponing
: ]] BEGIN >in @ ' ['] [[ <> WHILE >in ! postpone postpone REPEAT
drop ; immediate
[THEN]
s" bigFORTH" environment? [IF] 2drop
$F487 Constant [s~r]
: S: ( -- ) lastdes c@ dup :r =
IF drop [s~r] w,
ELSE :s = 0= IF -2 allot THEN THEN :s lastdes c! ;
: wurst-mix ( a1 a2 -- ) S: [ also assembler ]
AX push .b A#) AX movzx A#) AL xor
[ previous ] [s~r] w, ]] rngs wurst [[ ; immediate
[ELSE]
: wurst-mix ]] Literal c@ Literal c@ xor rngs wurst [[ ; immediate
[THEN]
: mix2bytes, ( index n k -- index' n ) wurst-state + 8 0 DO
>r over wurst-source + r@ ]] wurst-mix [[
dup >r + $3F and r> r> 8 + LOOP
drop ;
: round, ( n -- ) dup 1- swap 8 0 DO
wurst-state I permut# 64s + ]] Literal 64@ [[
I mix2bytes, nextstate I 64s + ]] Literal 64! [[
LOOP 2drop ]] update-state [[ ;
s" gforth" environment? [IF] 2drop
also c-lib
: \c, ( addr u -- ) save-c-prefix-line ;
previous
Variable %string s" " %string $!
: %> ( -- )
BEGIN source >in @ /string s" <%" search 0= WHILE
postpone sliteral postpone %string postpone $+!
refill 0= UNTIL EXIT THEN
nip source >in @ /string rot - dup 2 + >in +!
postpone sliteral postpone %string postpone $+! ; immediate
: %c, ( -- ) %string $@ \c, s" " %string $! ;
: #$ ( n -- ) 0 <<# #S #> %string $+! #>> ;
: mix2bytes_ind, ( index n k i -- index n ) >r
>r over r@ 64 +
%> a<% r@ 7 and #$ %> ^=ROL(rnds[states[<% swap #$ %> ]^(0xff&(t>><%
$7 and 8 * #$ %> ))],<% r> 7 r@ - #$ >r %> );<% %c,
rdrop rdrop ;
: round_ind, ( n -- )
%> static inline void round<% dup #$
%> _ind(unsigned char * states, uint64_t * rnds) {<% %c,
%> uint64_t a0, a1, a2, a3, a4, a5, a6, a7, t;<% %c,
round# dup 1- swap 8 0 DO
%> a<% I #$ %> =ROL(*((uint64_t*)(states+<%
I permut# 8 + 64s #$ %> )),8);<% %c,
LOOP
8 0 DO
[ 0 ] [IF]
%> asm volatile("# line break" : : "g" (a0), "g" (a1), "g" (a2), "g" (a3), "g" (a4), "g" (a5), "g" (a6), "g" (a7));<% %c,
[THEN] \ seems to be a bad idea - let the compiler decide
%> t=*((uint64_t*)(states+<% I 8 * 64 + #$ %> ));<% %c,
8 0 DO I J 8 * + J mix2bytes_ind,
dup >r 8 * + $3F and r>
LOOP dup >r + $3F and r>
LOOP
2drop
8 0 DO
%> *((uint64_t *)(states+<% I 64s #$ %> )) ^= *((uint64_t *)(states+<% I 8 + 64s #$ %> ));<%
%c,
LOOP
8 0 DO
%> *((uint64_t *)(states+<% I 8 + 64s #$ %> )) += a<% I #$ %> ;<% %c,
LOOP
%> }<% %c, ;
c-library wurstkessel
\c #include <stdint.h>
\c #include <string.h>
\c #define ROL(x, n) (n==0)?x:((x << n) | (x >> (64-n)))
\c #define COMBINE(x0,a1,a2,a3,a4,a5,a6,a7,a8) (ROL(x0,8)^ROL(a1,7)^ROL(a2,6)^ROL(a3,5)^ROL(a4,4)^ROL(a5,3)^ROL(a6,2)^ROL(a7,1)^a8)
0 round_ind,
1 round_ind,
2 round_ind,
3 round_ind,
4 round_ind,
5 round_ind,
6 round_ind,
7 round_ind,
\c static inline void add_entropy(uint64_t * m, uint64_t * s) {
\c int i;
\c for(i=0; i<8; i++) { s[i] ^= m[i]; m[i] ^= s[i+8]; }
\c }
\c static inline void set_entropy(uint64_t * m, uint64_t * s) {
\c int i;
\c for(i=0; i<8; i++) { m[i] ^= s[i+8]; s[i] ^= m[i]; }
\c }
\c void rounds_encrypt(unsigned char* message, unsigned int n, unsigned char * states, uint64_t * rnds) {
\c if((n&15)>=1) { round0_ind(states, rnds);
\c if(n&0x10) add_entropy((uint64_t *)(message+64*0),(uint64_t *)(states));
\c } if((n&15)>=2) { round1_ind(states, rnds);
\c if(n&0x10) add_entropy((uint64_t *)(message+64*1),(uint64_t *)(states));
\c if(n&0x20) add_entropy((uint64_t *)(message+64*0),(uint64_t *)(states));
\c } if((n&15)>=3) { round2_ind(states, rnds);
\c if(n&0x10) add_entropy((uint64_t *)(message+64*2),(uint64_t *)(states));
\c } if((n&15)>=4) { round3_ind(states, rnds);
\c if(n&0x10) add_entropy((uint64_t *)(message+64*3),(uint64_t *)(states));
\c if(n&0x20) add_entropy((uint64_t *)(message+64*1),(uint64_t *)(states));
\c if(n&0x40) add_entropy((uint64_t *)(message+64*0),(uint64_t *)(states));
\c } if((n&15)>=5) { round4_ind(states, rnds);
\c if(n&0x10) add_entropy((uint64_t *)(message+64*4),(uint64_t *)(states));
\c } if((n&15)>=6) { round5_ind(states, rnds);
\c if(n&0x10) add_entropy((uint64_t *)(message+64*5),(uint64_t *)(states));
\c if(n&0x20) add_entropy((uint64_t *)(message+64*2),(uint64_t *)(states));
\c } if((n&15)>=7) { round6_ind(states, rnds);
\c if(n&0x10) add_entropy((uint64_t *)(message+64*6),(uint64_t *)(states));
\c } if((n&15)>=8) { round7_ind(states, rnds);
\c if(n&0x10) add_entropy((uint64_t *)(message+64*7),(uint64_t *)(states));
\c if(n&0x20) add_entropy((uint64_t *)(message+64*3),(uint64_t *)(states));
\c if(n&0x40) add_entropy((uint64_t *)(message+64*1),(uint64_t *)(states));
\c if(n&0x80) add_entropy((uint64_t *)(message+64*0),(uint64_t *)(states));
\c } }
\c void rounds_decrypt(unsigned char* message, unsigned int n, unsigned char * states, uint64_t * rnds) {
\c if((n&15)>=1) { round0_ind(states, rnds);
\c if(n&0x10) set_entropy((uint64_t *)(message+64*0),(uint64_t *)(states));
\c } if((n&15)>=2) { round1_ind(states, rnds);
\c if(n&0x10) set_entropy((uint64_t *)(message+64*1),(uint64_t *)(states));
\c if(n&0x20) set_entropy((uint64_t *)(message+64*0),(uint64_t *)(states));
\c } if((n&15)>=3) { round2_ind(states, rnds);
\c if(n&0x10) set_entropy((uint64_t *)(message+64*2),(uint64_t *)(states));
\c } if((n&15)>=4) { round3_ind(states, rnds);
\c if(n&0x10) set_entropy((uint64_t *)(message+64*3),(uint64_t *)(states));
\c if(n&0x20) set_entropy((uint64_t *)(message+64*1),(uint64_t *)(states));
\c if(n&0x40) set_entropy((uint64_t *)(message+64*0),(uint64_t *)(states));
\c } if((n&15)>=5) { round4_ind(states, rnds);
\c if(n&0x10) set_entropy((uint64_t *)(message+64*4),(uint64_t *)(states));
\c } if((n&15)>=6) { round5_ind(states, rnds);
\c if(n&0x10) set_entropy((uint64_t *)(message+64*5),(uint64_t *)(states));
\c if(n&0x20) set_entropy((uint64_t *)(message+64*2),(uint64_t *)(states));
\c } if((n&15)>=7) { round6_ind(states, rnds);
\c if(n&0x10) set_entropy((uint64_t *)(message+64*6),(uint64_t *)(states));
\c } if((n&15)>=8) { round7_ind(states, rnds);
\c if(n&0x10) set_entropy((uint64_t *)(message+64*7),(uint64_t *)(states));
\c if(n&0x20) set_entropy((uint64_t *)(message+64*3),(uint64_t *)(states));
\c if(n&0x40) set_entropy((uint64_t *)(message+64*1),(uint64_t *)(states));
\c if(n&0x80) set_entropy((uint64_t *)(message+64*0),(uint64_t *)(states));
\c } }
\c uint64_t wurst_hash64(unsigned char * addr, unsigned int len,
\c uint64_t startval, uint64_t * rnds) {
\c uint64_t result=startval;
\c unsigned int i=0;
\c for(i=0; i<len; i++) {
\c result = ROL(result, 1) + rnds[addr[i] ^ (result & 0xFF)];
\c /* the result feedback kills parallelism, but makes sure
\c the hash cannot easily be attacked */
\c }
\c return result;
\c }
c-function (rounds-encrypt) rounds_encrypt a n a a -- void
c-function (rounds-decrypt) rounds_decrypt a n a a -- void
[IFDEF] 64bit
c-function wurst_hash64 wurst_hash64 a n n a -- n
[ELSE]
c-function wurst_hash64 wurst_hash64 a n d a -- d
[THEN]
end-c-library
UValue @state
wurst-source to @state
: rounds-setkey ( addr -- ) to @state ;
: rounds-encrypt ( addr u -- ) @state 'rngs (rounds-encrypt) ;
: rounds-decrypt ( addr u -- ) @state 'rngs (rounds-decrypt) ;
: wurst-init ( -- ) ;
: hash64 ( addr n init -- hash ) 'rngs wurst_hash64 ;
[ELSE]
: round0 ( -- ) [ 0 round# round, ] ;
: round1 ( -- ) [ 1 round# round, ] ;
: round2 ( -- ) [ 2 round# round, ] ;
: round3 ( -- ) [ 3 round# round, ] ;
: round4 ( -- ) [ 4 round# round, ] ;
: round5 ( -- ) [ 5 round# round, ] ;
: round6 ( -- ) [ 6 round# round, ] ;
: round7 ( -- ) [ 7 round# round, ] ;
: wurst-init ;
Create 'rounds
' round0 A, ' round1 A, ' round2 A, ' round3 A,
' round4 A, ' round5 A, ' round6 A, ' round7 A,
Create 'round-flags
$10 , $30 , $10 , $70 , $10 , $30 , $10 , $F0 ,
: +entropy ( message -- message' )
dup wurst-source state# xors
wurst-state over state# xors
state# + ;
: -entropy ( message -- message' )
wurst-state over state# xors
dup wurst-source state# xors
state# + ;
: rounds-encrypt ( addr n -- ) dup $F and 8 umin 0 ?DO
'rounds Ith execute
dup 'round-flags Ith and IF
swap +entropy swap
THEN
LOOP 2drop ;
\ : rounds' ( n -- ) dup $F and 8 umin 0 ?DO
\ 'rounds Ith execute .source cr .state cr cr
\ dup 'round-flags Ith and IF
\ swap +entropy swap
\ THEN
\ LOOP 2drop ;
: rounds-decrypt ( n -- ) dup $F and 8 umin 0 ?DO
'rounds Ith execute
dup 'round-flags Ith and IF
swap -entropy swap
THEN
LOOP 2drop ;
[THEN]
\ wurstkessel file functions
0 Value wurst-in
0 Value wurst-out
: wurst-file ( addr u -- ) r/o open-file throw to wurst-in ;
: size? ( -- ud )
wurst-in file-size throw ;
: wurst-outfile ( addr u -- ) w/o create-file throw to wurst-out ;
: wurst-close ( -- )
wurst-in ?dup IF close-file 0 to wurst-in throw THEN
wurst-out ?dup IF close-file 0 to wurst-out throw THEN ;
\ wurstkessel hash
: hash-init ( source state -- ) swap
wurst-source state# move
wurst-state state# move ;
: wurst-size ( -- )
[ cell 4 = ] [IF]
size? message 64! 0. message 1 64s + 64!
[ELSE]
size? drop message 64! 0 message 1 64s + 64!
[THEN] ;
: >reads ( flags -- n ) dup $F and swap 4 rshift / ;
: encrypt-read ( flags -- n ) >reads >r
message state# r> * 2dup erase wurst-in read-file throw ;
: read-first ( flags -- n ) wurst-size >reads >r
message state# r> * 2 64s /string wurst-in read-file throw 2 64s + ;
: wurst-hash ( source state final-rounds rounds -- )
2swap hash-init dup read-first
BEGIN 0> WHILE
message over rounds-encrypt
dup encrypt-read
REPEAT
drop message swap rounds-encrypt .source wurst-close ;
\ padding
: >pad ( addr u u2 -- addr u2 )
swap >r 2dup r@ /string r> fill ;
: >unpad ( addr u' -- addr u ) over + 1- c@ ;
: ?padded ( addr u' -- flag )
2dup + 1- c@ dup >r /string r> skip nip 0= ;
\ wurstkessel encryption
: message> ( flags -- ) >reads
message swap state# * wurst-out write-file throw ;
: encrypt-init ( key salt -- ) swap
wurst-state state# move
wurst-source state# move
wurst-source state# wurst-out write-file throw ;
: wurst-encrypt ( key salt first-rounds rounds -- )
>r >r encrypt-init
message r> rounds-encrypt r@ read-first
BEGIN 0> WHILE
message r@ rounds-encrypt r@ message>
r@ encrypt-read REPEAT
rdrop wurst-close ;
: decrypt-init ( key -- )
wurst-state state# move
wurst-source state# wurst-in read-file throw drop ;
2Variable wurst-outsize
: out- ( n -- n' )
0 wurst-outsize 2@ dmin wurst-outsize 2@ 2over d- wurst-outsize 2! drop ;
: .xormsg-size ( flags -- ) >reads
message 64@ [ cell 8 = ] [IF] 0 [THEN] wurst-outsize 2!
message swap state# * 2 64s /string out-
wurst-out write-file throw ;
: message>' ( flags -- ) >reads
message swap state# * out- wurst-out write-file throw ;
: wurst-decrypt ( first-rounds rounds -- )
>r >r decrypt-init
message r> rounds-encrypt
r@ encrypt-read message r@ rounds-decrypt r@ .xormsg-size
BEGIN 0> WHILE
r@ encrypt-read
message r@ rounds-decrypt r@ message>'
REPEAT
rdrop wurst-close ;
\ benchmark to evaluate quality of the compiled code
$18 Value roundsh#
$28 Value rounds#
4 Value roundse#
: wurst-bench ( n -- ) >r cputime d+
r@ 0 ?DO message rounds# rounds-encrypt LOOP cputime d+ d- d>f -1e-6 f*
1/f 256e r> fm* f* 1024e fdup f* f/ f. ." MB/s" ;
: mem-rounds# ( size -- n )
case
state# of $22 endof
state# 2* of $24 endof
$28 swap
endcase ;
\ OOP crypto api class
: wurst-crc ( -- xd )
message roundse# rounds-encrypt \ another key diffusion round
@state 128@ ;
: wurst-task-init ( -- )
crypto-o @ IF wurst-up @ next-task = ?EXIT THEN
wurstkessel new crypto-o ! next-task wurst-up !
wurst-source rounds-setkey ;
' wurst-task-init wurstkessel to c:init
:noname to @state ; wurstkessel to c:key!
' @state wurstkessel to c:key@
state# 2* Constant wurst-key# ' wurst-key# wurstkessel to c:key#
:noname ( addr -- )
@state swap state# 2* move ; wurstkessel to c:key>
:noname ( addr -- )
wurst-source state# 2* move ; wurstkessel to >c:key
:noname ( -- )
message roundse# rounds-encrypt ; wurstkessel to c:diffuse
:noname ( addr u -- ) dup mem-rounds#
dup >reads state# * { rnd reads }
BEGIN dup 0> WHILE
over rnd rounds-encrypt reads /string
REPEAT 2drop ; wurstkessel to c:encrypt
:noname ( addr u -- ) dup mem-rounds#
dup >reads state# * { rnd reads }
BEGIN dup 0> WHILE
over rnd rounds-decrypt reads /string
REPEAT 2drop ; wurstkessel to c:decrypt
:noname ( addr u -- ) dup mem-rounds#
dup >reads state# * { rnd reads }
BEGIN dup 0> WHILE
over rnd rounds-encrypt reads /string
REPEAT drop >r wurst-crc r> 128! ; wurstkessel to c:encrypt+auth
:noname ( addr u -- ) dup mem-rounds#
dup >reads state# * { rnd reads }
BEGIN dup 0> WHILE
over rnd rounds-decrypt reads /string
REPEAT drop 128@ wurst-crc 128= ; wurstkessel to c:decrypt+auth
:noname ( addr u -- ) dup mem-rounds#
dup >reads state# * { rnd reads }
BEGIN dup 0> WHILE
over rnd rounds-encrypt reads /string
REPEAT drop roundse# rounds-encrypt ; wurstkessel to c:hash
:noname ( addr u -- ) 2dup erase c:encrypt ; wurstkessel to c:prng
' wurst-crc wurstkessel to c:checksum
:noname ( -- x ) @state $10 + 64@ ; wurstkessel to c:cookie
static-a to allocater
wurstkessel new Constant wurstkessel-o
dynamic-a to allocater
wurst-init
wurst-task-init