You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

125 lines
3.8KB

  1. # https://bitbucket.org/mihailp/tankfeeder/src/default/crypto/
  2. (setq
  3. *BLAKE2S-IV
  4. (mapcar
  5. hex
  6. (quote
  7. "6A09E667" "BB67AE85"
  8. "3C6EF372" "A54FF53A"
  9. "510E527F" "9B05688C"
  10. "1F83D9AB" "5BE0CD19" ) )
  11. *BLAKE2S-S
  12. (mapcar
  13. '((L) (mapcar inc L) )
  14. (quote
  15. ( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)
  16. (14 10 4 8 9 15 13 6 1 12 0 2 11 7 5 3)
  17. (11 8 12 0 5 2 15 13 10 14 3 6 7 1 9 4)
  18. ( 7 9 3 1 13 12 11 14 2 6 5 10 4 0 15 8)
  19. ( 9 0 5 7 2 4 10 15 14 1 11 12 6 8 3 13)
  20. ( 2 12 6 10 0 11 8 3 4 13 7 5 15 14 1 9)
  21. (12 5 1 15 14 13 4 10 0 7 6 3 9 2 8 11)
  22. (13 11 7 14 12 1 3 9 5 0 15 4 8 6 2 10)
  23. ( 6 15 14 9 11 3 0 8 12 2 13 7 1 4 10 5)
  24. (10 2 8 4 7 6 1 5 15 11 9 14 3 12 13 0) ) ) )
  25. (de mod32 (N)
  26. (& N `(hex "FFFFFFFF")) )
  27. (de not32 (N)
  28. (x| N `(hex "FFFFFFFF")) )
  29. (de add32 @
  30. (mod32 (pass +)) )
  31. (de ror32 (X C)
  32. (| (>> C X) (mod32 (>> (- C 32) X))) )
  33. (de endian (L) # little
  34. (apply
  35. |
  36. (mapcar >> (0 -8 -16 -24) L) ) )
  37. (de _Gblake2s (A B C D X Y)
  38. (let
  39. (VA (get V A)
  40. VB (get V B)
  41. VC (get V C)
  42. VD (get V D) )
  43. (set
  44. 'VA (add32 VA VB X)
  45. 'VD (ror32 (x| VD VA) 16)
  46. 'VC (add32 VC VD)
  47. 'VB (ror32 (x| VB VC) 12)
  48. 'VA (add32 VA VB Y)
  49. 'VD (ror32 (x| VD VA) 8)
  50. 'VC (add32 VC VD)
  51. 'VB (ror32 (x| VB VC) 7)
  52. (nth V A) VA
  53. (nth V B) VB
  54. (nth V C) VC
  55. (nth V D) VD ) ) )
  56. (de blake2s (Lst Key Out)
  57. (default Out 32)
  58. (let
  59. (Len (length Lst)
  60. KeyLen (length Key)
  61. H (copy *BLAKE2S-IV)
  62. C 0 )
  63. # Lst
  64. (if Lst
  65. (setq
  66. Lst
  67. (need
  68. (* -64 (/ (+ Len 63) 64))
  69. (copy Lst)
  70. 0 ) )
  71. (or Key (setq Lst (need 64 0))) )
  72. # Key
  73. (and
  74. Key
  75. (inc 'Len 64)
  76. (setq Lst
  77. (conc
  78. (need
  79. (* -64 (/ (+ KeyLen 63) 64))
  80. (copy Key)
  81. 0 )
  82. Lst ) ) )
  83. (set H
  84. (x| (car H) `(hex "1010000") (>> -8 KeyLen) Out) )
  85. (while Lst
  86. (let
  87. (M
  88. (make
  89. (do 16
  90. (link (endian (cut 4 'Lst))) ) )
  91. V (conc (copy H) (copy *BLAKE2S-IV)) )
  92. (if (< Len 64)
  93. (inc 'C (swap 'Len 0))
  94. (inc 'C 64)
  95. (dec 'Len 64) )
  96. (set
  97. (prog1 (nth V 13) (setq @@ (car @))) (x| @@ (mod32 C))
  98. (prog1 (nth V 14) (setq @@ (car @))) (x| @@ (>> 32 C)) )
  99. (and
  100. (=0 Len)
  101. (set (prog1 (nth V 15) (setq @@ (car @)))
  102. (not32 @@) ) )
  103. (for S *BLAKE2S-S
  104. (let MS (mapcar '((I) (get M I)) S)
  105. (_Gblake2s 1 5 9 13 (++ MS) (++ MS))
  106. (_Gblake2s 2 6 10 14 (++ MS) (++ MS))
  107. (_Gblake2s 3 7 11 15 (++ MS) (++ MS))
  108. (_Gblake2s 4 8 12 16 (++ MS) (++ MS))
  109. (_Gblake2s 1 6 11 16 (++ MS) (++ MS))
  110. (_Gblake2s 2 7 12 13 (++ MS) (++ MS))
  111. (_Gblake2s 3 8 9 14 (++ MS) (++ MS))
  112. (_Gblake2s 4 5 10 15 (++ MS) (++ MS)) ) )
  113. (let (LH (head 8 V) LT (tail 8 V))
  114. (for (L H L)
  115. (set L
  116. (x| (++ L) (++ LH) (++ LT)) ) ) ) ) )
  117. (let C (circ 0 8 16 24)
  118. (head
  119. Out
  120. (make
  121. (for N H
  122. (do 4
  123. (link (& (>> (++ C) N) `(hex "FF"))) ) ) ) ) ) ) )