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.

276 lines
6.9KB

  1. (setq
  2. *CONSTRUCTION
  3. `(mapcar char (chop "Noise_IKpsk2_25519_ChaChaPoly_BLAKE2s"))
  4. *IDENTIFIER
  5. `(mapcar char (chop "WireGuard v1 zx2c4 Jason@zx2c4.com"))
  6. *LABEL_MAC1
  7. `(mapcar char (chop "mac1----"))
  8. *LABEL_COOKIE
  9. `(mapcar char (chop "cookie--"))
  10. *DEMO_SERVER "demo.wireguard.com"
  11. *DEMO_PORT "12913"
  12. *PF_INET 2
  13. *SOCK_DGRAM 2
  14. *PING_LABEL
  15. `(mapcar char (chop "WireGuard"))
  16. # full ip-icmp packet, stolen
  17. *PING_DATA
  18. (69 0 0 37 0 0 0 0 20 1 143 91 10 189 129 2 10 189 129 1 8 0
  19. 27 250 3 153 1 182 87 105 114 101 71 117 97 114 100 0 0 0
  20. 0 0 0 0 0 0 0 0 ) )
  21. (def 'prv car)
  22. (def 'pub cadr)
  23. (de dh_generate NIL # already seeded
  24. (make (do 32 (link (rand 0 255)))) )
  25. (de ephemrl-pair NIL # (Priv Pub)
  26. (make (link (dh_generate) (dh_pubkey (car (made))))) )
  27. (de hmac (Key Msg) # blake2s
  28. (let Key (copy Key)
  29. (and
  30. (> (length Key) 64)
  31. (setq Key (blake2s Key)) )
  32. (setq Key (need -64 Key 0))
  33. (blake2s
  34. (conc
  35. (mapcar x| (need 64 `(hex "5C")) Key)
  36. (blake2s (conc (mapcar x| (need 64 `(hex "36")) Key) Msg)) ) ) ) )
  37. (de hash32 (Msg)
  38. (blake2s Msg) )
  39. (de mac (Key Msg)
  40. (blake2s Msg Key 16) )
  41. (de kdf1 (C D)
  42. (hmac (hmac C D) (cons 1)) )
  43. (de kdf2 (C D)
  44. (let Z (hmac C D)
  45. (list
  46. (setq @ (hmac Z (cons 1)))
  47. (hmac Z (append @ (cons 2))) ) ) )
  48. (de kdf3 (C D)
  49. (let Z (hmac C D)
  50. (list
  51. (setq @ (hmac Z (cons 1)))
  52. (setq @ (hmac Z (append @ (cons 2))))
  53. (hmac Z (append @ (cons 3))) ) ) )
  54. (de dh_pubkey (S)
  55. (use P
  56. (native
  57. "libmonocypher.so.2"
  58. "crypto_x25519_public_key"
  59. NIL
  60. '(P (32 B . 32))
  61. (cons NIL (32) S) )
  62. P ) )
  63. (de dh (S P)
  64. (use R
  65. (native
  66. "libmonocypher.so.2"
  67. "crypto_x25519"
  68. 'I
  69. '(R (32 B . 32))
  70. (cons NIL (32) S)
  71. (cons NIL (32) P) )
  72. R ) )
  73. (de lock_aead (K N P A)
  74. (let
  75. (AL (length A)
  76. PL (length P)
  77. Mac NIL
  78. CH NIL )
  79. (native
  80. "libmonocypher.so.2"
  81. "crypto_lock_aead"
  82. NIL
  83. '(Mac (16 B . 16))
  84. (if P # for empty plain data
  85. (list 'CH (cons PL 'B PL))
  86. 0 )
  87. (cons NIL (32) K)
  88. (cons NIL (12) N)
  89. (cons NIL (cons AL) A)
  90. AL
  91. (cons NIL (cons PL) P)
  92. PL )
  93. (conc CH Mac) ) )
  94. # TODO: check return value, now assume always success
  95. (de unlock_aead (K N C A)
  96. (let
  97. (AL (length A)
  98. CL (- (length C) 16)
  99. P NIL)
  100. (native
  101. "libmonocypher.so.2"
  102. "crypto_unlock_aead"
  103. 'I
  104. (if (=0 CL) # for empty crypted
  105. @
  106. (list 'P (cons CL 'B CL)) )
  107. (cons NIL (32) K)
  108. (cons NIL (12) N)
  109. (cons NIL (16) (tail 16 C))
  110. (cons NIL (cons AL) A)
  111. AL
  112. (cons NIL (cons CL) (head CL C))
  113. CL )
  114. P ) )
  115. (de tai64n NIL
  116. (let
  117. (S
  118. (+
  119. 4611686018427387914
  120. (-
  121. (+ (* 86400 (date T)) (time T))
  122. (* 86400 (date 1970 1 1)) ) )
  123. N (in '(date "+%N") (read)) ) # for real
  124. (conc (big64 S) (big32 N)) ) )
  125. (de nonce (N)
  126. (conc (need 4 0) (little64 N)) )
  127. (de little32 (N)
  128. (make
  129. (do 4
  130. (link (& N 255))
  131. (setq N (>> 8 N)) ) ) )
  132. (de little64 (N)
  133. (make
  134. (do 8
  135. (link (& N 255))
  136. (setq N (>> 8 N)) ) ) )
  137. (de big32 (N)
  138. (make
  139. (do 4
  140. (yoke (& N 255))
  141. (setq N (>> 8 N)) ) ) )
  142. (de big64 (N)
  143. (make
  144. (do 8
  145. (yoke (& N 255))
  146. (setq N (>> 8 N)) ) ) )
  147. (de socket NIL
  148. (native
  149. "@"
  150. "socket"
  151. 'I
  152. *PF_INET
  153. *SOCK_DGRAM
  154. 17 # IPPROTO_UDP
  155. ) )
  156. (de getaddrinfo (Host Port)
  157. (let (Hints NIL Res NIL)
  158. (setq Hints (native "@" "calloc" 'N 1 48))
  159. (struct Hints 'I (0 . 4) -2 -2) # 0, PF_INET, SOCK_DGRAM
  160. (native "@" "getaddrinfo" NIL Host Port Hints '(Res (8 . N) . 0))
  161. (native "@" "free" NIL Hints)
  162. (struct
  163. Res
  164. '(I I I I I I N N N) ) ) )
  165. (de server (Host Port)
  166. (let R (getaddrinfo Host Port)
  167. (list
  168. (socket)
  169. (get R 7) # ai_addr
  170. (get R 5) # ai_addrlen
  171. ) ) )
  172. (de sendto (S B) # without return check
  173. (let BL (length B)
  174. (native
  175. "@"
  176. "sendto"
  177. NIL
  178. (car S)
  179. (cons NIL (cons BL) B)
  180. BL
  181. 0
  182. (cadr S)
  183. (caddr S) ) ) )
  184. (de recvfrom (S) # without return check
  185. (let
  186. (Buf NIL
  187. N
  188. (native
  189. "@"
  190. "recvfrom"
  191. 'N
  192. (car S)
  193. '(Buf (1024 B . 1024))
  194. 1024
  195. 0
  196. 0
  197. 0 ) )
  198. (head N Buf) ) )
  199. (de start-handshake NIL
  200. (make
  201. (link 1 0 0 0)
  202. (chain (little32 28))
  203. (chain (pub *E))
  204. (setq
  205. *C (kdf1 *C (pub *E))
  206. *H (hash32 (append *H (pub *E)))
  207. @ (kdf2 *C (dh (prv *E) *RPub))
  208. *C (car @)
  209. *K (cadr @) )
  210. (chain (setq @ (lock_aead *K (nonce 0) *Pub *H)))
  211. (setq
  212. *H (hash32 (append *H @))
  213. # starting for tai64n
  214. @ (kdf2 *C (dh *Prv *RPub))
  215. *C (car @)
  216. *K (cadr @) )
  217. (chain
  218. (setq @ (lock_aead *K (nonce 0) (tai64n) *H)) )
  219. (setq *H (hash32 (append *H @)))
  220. # mac1 and mac2
  221. (chain (mac (hash32 (append *LABEL_MAC1 *RPub)) (made)))
  222. (chain (need 16 0)) ) )
  223. # full packet
  224. (de fin-handshake (Lst)
  225. (let
  226. (Er (head 32 (nth Lst 13))
  227. Crypted (head 16 (nth Lst 45))
  228. Mac1 (head 16 (nth Lst 61))
  229. Empty T )
  230. (test (2 0 0 0) (head 4 Lst))
  231. # check our index in first byte
  232. (test 28 (get Lst 9))
  233. # check MAC1
  234. (test
  235. Mac1
  236. (mac (hash32 (append *LABEL_MAC1 *Pub)) (head 60 Lst)) )
  237. (setq
  238. *IndexR (head 4 (nth Lst 5))
  239. *C (kdf1 *C Er)
  240. *H (hash32 (append *H Er))
  241. *C (kdf1 *C (dh (prv *E) Er))
  242. *C (kdf1 *C (dh *Prv Er))
  243. @ (kdf3 *C *Pre)
  244. *C (car @)
  245. *K (caddr @)
  246. *H (hash32 (append *H (cadr @)))
  247. Empty (unlock_aead *K (nonce 0) Crypted *H)
  248. *H (hash32 (append *H Crypted)) )
  249. (test NIL Empty) # receive empty payload
  250. (setq # split keys
  251. @ (kdf2 *C)
  252. *Enc (car @)
  253. *Dec (cadr @) ) ) )
  254. (de encryption (D)
  255. (make
  256. (link 4 0 0 0)
  257. (chain
  258. (copy *IndexR)
  259. (little64 *Nsend)
  260. (lock_aead
  261. *Enc
  262. (nonce (swap '*Nsend (+ 1 *Nsend)))
  263. D
  264. NIL ) ) ) )
  265. (de decryption (Lst) # full packet
  266. # header and index's first byte
  267. (test (4 0 0 0 28) (head 5 Lst))
  268. # extra check for synced counter
  269. (test (head 8 (nth Lst 9)) (little64 *Nrecv))
  270. (unlock_aead
  271. *Dec
  272. (nonce (swap '*Nrecv (+ 1 *Nrecv)))
  273. (nth Lst 17)
  274. NIL ) )