Artifact
539ce841d660ec76b577cd7f98612ea8cecb41ed:
- File
crypt.fs
— part of check-in
[2ef7582d7f]
at
2019-07-26 06:17:55
on branch trunk
— Checkin from holiday
(user:
bernd
size: 23550)
0000: 5c 20 73 79 6d 6d 65 74 72 69 63 20 65 6e 63 72 \ symmetric encr
0010: 79 70 74 69 6f 6e 20 61 6e 64 20 64 65 63 72 79 yption and decry
0020: 70 74 69 6f 6e 0a 0a 5c 20 43 6f 70 79 72 69 67 ption..\ Copyrig
0030: 68 74 20 28 43 29 20 32 30 31 31 2d 32 30 31 35 ht (C) 2011-2015
0040: 20 20 20 42 65 72 6e 64 20 50 61 79 73 61 6e 0a Bernd Paysan.
0050: 0a 5c 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 .\ This program
0060: 69 73 20 66 72 65 65 20 73 6f 66 74 77 61 72 65 is free software
0070: 3a 20 79 6f 75 20 63 61 6e 20 72 65 64 69 73 74 : you can redist
0080: 72 69 62 75 74 65 20 69 74 20 61 6e 64 2f 6f 72 ribute it and/or
0090: 20 6d 6f 64 69 66 79 0a 5c 20 69 74 20 75 6e 64 modify.\ it und
00a0: 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 20 er the terms of
00b0: 74 68 65 20 47 4e 55 20 41 66 66 65 72 6f 20 47 the GNU Affero G
00c0: 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 eneral Public Li
00d0: 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 73 68 cense as publish
00e0: 65 64 20 62 79 0a 5c 20 74 68 65 20 46 72 65 65 ed by.\ the Free
00f0: 20 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 Software Founda
0100: 74 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 tion, either ver
0110: 73 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 sion 3 of the Li
0120: 63 65 6e 73 65 2c 20 6f 72 0a 5c 20 28 61 74 20 cense, or.\ (at
0130: 79 6f 75 72 20 6f 70 74 69 6f 6e 29 20 61 6e 79 your option) any
0140: 20 6c 61 74 65 72 20 76 65 72 73 69 6f 6e 2e 0a later version..
0150: 0a 5c 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 .\ This program
0160: 69 73 20 64 69 73 74 72 69 62 75 74 65 64 20 69 is distributed i
0170: 6e 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 n the hope that
0180: 69 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 it will be usefu
0190: 6c 2c 0a 5c 20 62 75 74 20 57 49 54 48 4f 55 54 l,.\ but WITHOUT
01a0: 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 77 ANY WARRANTY; w
01b0: 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 20 ithout even the
01c0: 69 6d 70 6c 69 65 64 20 77 61 72 72 61 6e 74 79 implied warranty
01d0: 20 6f 66 0a 5c 20 4d 45 52 43 48 41 4e 54 41 42 of.\ MERCHANTAB
01e0: 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 53 53 ILITY or FITNESS
01f0: 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 4c 41 FOR A PARTICULA
0200: 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 65 20 R PURPOSE. See
0210: 74 68 65 0a 5c 20 47 4e 55 20 41 66 66 65 72 6f the.\ GNU Affero
0220: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
0230: 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 License for more
0240: 20 64 65 74 61 69 6c 73 2e 0a 0a 5c 20 59 6f 75 details...\ You
0250: 20 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 should have rec
0260: 65 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 eived a copy of
0270: 74 68 65 20 47 4e 55 20 41 66 66 65 72 6f 20 47 the GNU Affero G
0280: 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 eneral Public Li
0290: 63 65 6e 73 65 0a 5c 20 61 6c 6f 6e 67 20 77 69 cense.\ along wi
02a0: 74 68 20 74 68 69 73 20 70 72 6f 67 72 61 6d 2e th this program.
02b0: 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 3c 68 If not, see <h
02c0: 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f 72 ttp://www.gnu.or
02d0: 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a 0a 5c g/licenses/>...\
02e0: 20 6b 65 79 20 73 74 6f 72 61 67 65 20 73 74 75 key storage stu
02f0: 66 66 0a 24 31 45 30 20 43 6f 6e 73 74 61 6e 74 ff.$1E0 Constant
0300: 20 6b 65 79 70 61 63 6b 23 0a 6b 65 79 70 61 63 keypack#.keypac
0310: 6b 23 20 6b 65 79 2d 73 61 6c 74 23 20 2b 20 6b k# key-salt# + k
0320: 65 79 2d 63 6b 73 75 6d 23 20 2b 20 43 6f 6e 73 ey-cksum# + Cons
0330: 74 61 6e 74 20 6b 65 79 70 61 63 6b 2d 61 6c 6c tant keypack-all
0340: 23 0a 6b 65 79 2d 73 61 6c 74 23 20 6b 65 79 2d #.key-salt# key-
0350: 63 6b 73 75 6d 23 20 2b 20 43 6f 6e 73 74 61 6e cksum# + Constan
0360: 74 20 77 72 61 70 70 65 72 23 0a 0a 56 61 72 69 t wrapper#..Vari
0370: 61 62 6c 65 20 6d 79 2d 30 6b 65 79 0a 3a 20 79 able my-0key.: y
0380: 6f 75 72 2d 30 6b 65 79 20 28 20 2d 2d 20 61 64 our-0key ( -- ad
0390: 64 72 20 75 20 29 0a 20 20 20 20 6f 20 49 46 20 dr u ). o IF
03a0: 20 64 65 73 74 2d 30 6b 65 79 20 73 65 63 40 20 dest-0key sec@
03b0: 20 45 4c 53 45 20 20 23 30 2e 20 20 54 48 45 4e ELSE #0. THEN
03c0: 0a 20 20 20 20 64 75 70 20 30 3d 20 6c 61 73 74 . dup 0= last
03d0: 61 64 64 72 23 20 61 6e 64 20 20 49 46 20 20 32 addr# and IF 2
03e0: 64 72 6f 70 20 6c 61 73 74 61 64 64 72 23 20 63 drop lastaddr# c
03f0: 65 6c 6c 2b 20 24 40 20 20 54 48 45 4e 20 3b 0a ell+ $@ THEN ;.
0400: 0a 75 73 65 72 2d 6f 20 6b 65 79 74 6d 70 20 5c .user-o keytmp \
0410: 20 73 74 6f 72 61 67 65 20 66 6f 72 20 73 65 63 storage for sec
0420: 75 72 65 20 74 65 6d 70 6f 72 61 72 79 20 6b 65 ure temporary ke
0430: 79 73 0a 0a 6f 62 6a 65 63 74 20 75 63 6c 61 73 ys..object uclas
0440: 73 20 6b 65 79 74 6d 70 0a 20 20 20 20 73 74 61 s keytmp. sta
0450: 74 65 32 23 20 20 20 75 76 61 72 20 6b 65 79 2d te2# uvar key-
0460: 61 73 73 65 6d 62 6c 79 0a 20 20 20 20 73 74 61 assembly. sta
0470: 74 65 32 23 20 20 20 75 76 61 72 20 69 76 73 2d te2# uvar ivs-
0480: 61 73 73 65 6d 62 6c 79 0a 20 20 20 20 73 74 61 assembly. sta
0490: 74 65 23 20 20 20 20 75 76 61 72 20 6d 79 6b 65 te# uvar myke
04a0: 79 20 20 20 20 5c 20 69 6e 73 74 61 6e 63 65 27 y \ instance'
04b0: 73 20 72 6f 74 61 74 69 6e 67 20 70 72 69 76 61 s rotating priva
04c0: 74 65 20 6b 65 79 0a 20 20 20 20 73 74 61 74 65 te key. state
04d0: 23 20 20 20 20 75 76 61 72 20 6f 6c 64 6d 79 6b # uvar oldmyk
04e0: 65 79 20 5c 20 70 72 65 76 69 6f 75 73 20 72 6f ey \ previous ro
04f0: 74 61 74 69 6e 67 20 70 72 69 76 61 74 65 20 6b tating private k
0500: 65 79 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 20 ey. keysize
0510: 20 75 76 61 72 20 6f 6c 64 70 6b 63 20 20 20 5c uvar oldpkc \
0520: 20 70 72 65 76 69 6f 75 73 20 70 75 62 6b 65 79 previous pubkey
0530: 20 61 66 74 65 72 20 72 65 76 6f 63 61 74 69 6f after revocatio
0540: 6e 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 20 20 n. keysize
0550: 75 76 61 72 20 6f 6c 64 73 6b 63 20 20 20 5c 20 uvar oldskc \
0560: 70 72 65 76 69 6f 75 73 20 73 65 63 72 65 74 20 previous secret
0570: 6b 65 79 20 61 66 74 65 72 20 72 65 76 6f 63 61 key after revoca
0580: 74 69 6f 6e 0a 20 20 20 20 6b 65 79 73 69 7a 65 tion. keysize
0590: 20 20 20 75 76 61 72 20 6f 6c 64 70 6b 72 65 76 uvar oldpkrev
05a0: 20 5c 20 70 72 65 76 69 6f 75 73 20 72 65 76 6f \ previous revo
05b0: 63 61 74 69 6f 6e 20 70 75 62 6b 65 79 20 61 66 cation pubkey af
05c0: 74 65 72 20 72 65 76 6f 63 61 74 69 6f 6e 0a 20 ter revocation.
05d0: 20 20 20 6b 65 79 73 69 7a 65 20 20 20 75 76 61 keysize uva
05e0: 72 20 6f 6c 64 73 6b 72 65 76 20 5c 20 70 72 65 r oldskrev \ pre
05f0: 76 69 6f 75 73 20 72 65 76 6f 63 61 74 69 6f 6e vious revocation
0600: 20 73 65 63 72 65 74 20 61 66 74 65 72 20 72 65 secret after re
0610: 76 6f 63 61 74 69 6f 6e 0a 20 20 20 20 6b 65 79 vocation. key
0620: 73 69 7a 65 20 20 20 75 76 61 72 20 6b 65 79 70 size uvar keyp
0630: 61 64 0a 20 20 20 20 68 61 73 68 23 32 35 36 20 ad. hash#256
0640: 20 75 76 61 72 20 6b 65 79 65 64 2d 68 61 73 68 uvar keyed-hash
0650: 2d 6f 75 74 0a 20 20 20 20 64 61 74 65 73 69 7a -out. datesiz
0660: 65 23 20 75 76 61 72 20 73 69 67 64 61 74 65 0a e# uvar sigdate.
0670: 20 20 20 20 6b 65 79 73 69 7a 65 20 20 20 75 76 keysize uv
0680: 61 72 20 73 74 70 6b 63 20 5c 20 73 65 72 76 65 ar stpkc \ serve
0690: 72 20 74 65 6d 70 6f 72 61 72 79 20 6b 65 79 70 r temporary keyp
06a0: 61 69 72 20 2d 20 6f 6e 63 65 20 70 65 72 20 63 air - once per c
06b0: 6f 6e 6e 65 63 74 69 6f 6e 20 73 65 74 75 70 0a onnection setup.
06c0: 20 20 20 20 6b 65 79 73 69 7a 65 20 20 20 75 76 keysize uv
06d0: 61 72 20 73 74 73 6b 63 0a 20 20 20 20 6b 65 79 ar stskc. key
06e0: 70 61 63 6b 2d 61 6c 6c 23 20 75 76 61 72 20 6b pack-all# uvar k
06f0: 65 79 70 61 63 6b 2d 64 0a 20 20 20 20 24 31 30 eypack-d. $10
0700: 30 20 20 20 20 20 20 75 76 61 72 20 76 61 75 6c 0 uvar vaul
0710: 74 6b 65 79 20 5c 20 62 75 66 66 65 72 73 20 66 tkey \ buffers f
0720: 6f 72 20 76 61 75 6c 74 0a 20 20 20 20 24 31 30 or vault. $10
0730: 30 20 20 20 20 20 20 75 76 61 72 20 6b 65 79 64 0 uvar keyd
0740: 75 6d 70 2d 62 75 66 20 20 5c 20 62 75 66 66 65 ump-buf \ buffe
0750: 72 20 66 6f 72 20 64 75 6d 70 69 6e 67 20 6b 65 r for dumping ke
0760: 79 73 0a 20 20 20 20 73 74 61 74 65 32 23 20 20 ys. state2#
0770: 20 75 76 61 72 20 76 6b 65 79 20 5c 20 6d 61 78 uvar vkey \ max
0780: 69 6d 75 6d 20 73 69 7a 65 20 66 6f 72 20 73 65 imum size for se
0790: 73 73 69 6f 6e 20 6b 65 79 0a 20 20 20 20 73 74 ssion key. st
07a0: 61 74 65 32 23 20 20 20 75 76 61 72 20 76 6f 75 ate2# uvar vou
07b0: 74 6b 65 79 20 5c 20 66 6f 72 20 6b 65 79 64 75 tkey \ for keydu
07c0: 6d 70 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 20 mp. keysize
07d0: 20 75 76 61 72 20 6b 65 79 67 65 6e 64 68 0a 20 uvar keygendh.
07e0: 20 20 20 74 66 5f 63 74 78 5f 32 35 36 20 75 76 tf_ctx_256 uv
07f0: 61 72 20 74 66 2d 6b 65 79 0a 20 20 20 20 6b 65 ar tf-key. ke
0800: 79 73 69 7a 65 20 20 20 75 76 61 72 20 74 66 2d ysize uvar tf-
0810: 6f 75 74 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 out. keysize
0820: 20 20 75 76 61 72 20 70 6b 6d 6f 64 0a 20 20 20 uvar pkmod.
0830: 20 24 31 30 20 20 20 20 20 20 20 75 76 61 72 20 $10 uvar
0840: 74 66 2d 68 61 73 68 6f 75 74 0a 20 20 20 20 6b tf-hashout. k
0850: 65 63 63 61 6b 23 20 20 20 75 76 61 72 20 70 72 eccak# uvar pr
0860: 65 64 61 74 65 2d 6b 65 79 0a 20 20 20 20 31 20 edate-key. 1
0870: 36 34 73 20 20 20 20 20 75 76 61 72 20 6c 61 73 64s uvar las
0880: 74 2d 6d 79 6b 65 79 0a 20 20 20 20 63 65 6c 6c t-mykey. cell
0890: 20 20 20 20 20 20 75 76 61 72 20 6b 65 79 74 6d uvar keytm
08a0: 70 2d 75 70 0a 65 6e 64 2d 63 6c 61 73 73 20 6b p-up.end-class k
08b0: 65 79 74 6d 70 2d 63 0a 0a 75 73 65 72 2d 6f 20 eytmp-c..user-o
08c0: 6b 65 79 62 75 66 20 5c 20 73 74 6f 72 61 67 65 keybuf \ storage
08d0: 20 66 6f 72 20 73 65 63 75 72 65 20 70 65 72 6d for secure perm
08e0: 61 6e 65 6e 74 20 6b 65 79 73 0a 0a 6f 62 6a 65 anent keys..obje
08f0: 63 74 20 75 63 6c 61 73 73 20 6b 65 79 62 75 66 ct uclass keybuf
0900: 0a 20 20 20 20 5c 20 6b 65 79 20 73 74 6f 72 61 . \ key stora
0910: 67 65 0a 20 20 20 20 5c 20 63 6c 69 65 6e 74 20 ge. \ client
0920: 6b 65 79 73 0a 20 20 20 20 6b 65 79 73 69 7a 65 keys. keysize
0930: 20 75 76 61 72 20 70 6b 63 20 20 20 5c 20 70 75 uvar pkc \ pu
0940: 62 6b 65 79 0a 20 20 20 20 6b 65 79 73 69 7a 65 bkey. keysize
0950: 20 75 76 61 72 20 70 6b 31 20 20 20 5c 20 70 75 uvar pk1 \ pu
0960: 62 6b 65 79 20 31 20 66 6f 72 20 72 65 76 6f 6b bkey 1 for revok
0970: 61 74 69 6f 6e 0a 20 20 20 20 6b 65 79 73 69 7a ation. keysiz
0980: 65 20 75 76 61 72 20 73 6b 63 20 20 20 5c 20 73 e uvar skc \ s
0990: 65 63 72 65 74 20 6b 65 79 0a 20 20 20 20 6b 65 ecret key. ke
09a0: 79 73 69 7a 65 20 75 76 61 72 20 73 6b 73 69 67 ysize uvar sksig
09b0: 20 5c 20 73 65 63 72 65 74 20 6b 65 79 20 66 6f \ secret key fo
09c0: 72 20 73 69 67 6e 61 74 75 72 65 0a 20 20 20 20 r signature.
09d0: 6b 65 79 73 69 7a 65 20 75 76 61 72 20 73 6b 31 keysize uvar sk1
09e0: 20 20 20 5c 20 73 65 63 72 65 74 20 6b 65 79 20 \ secret key
09f0: 31 20 66 6f 72 20 72 65 76 6f 6b 61 74 69 6f 6e 1 for revokation
0a00: 20 28 77 69 6c 6c 20 6e 6f 74 20 6c 61 73 74 29 (will not last)
0a10: 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 75 76 61 . keysize uva
0a20: 72 20 70 6b 72 65 76 20 5c 20 70 75 62 6b 65 79 r pkrev \ pubkey
0a30: 20 66 6f 72 20 72 65 76 6f 6b 69 6e 67 20 6b 65 for revoking ke
0a40: 79 73 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 75 ys. keysize u
0a50: 76 61 72 20 73 6b 72 65 76 20 5c 20 73 65 63 72 var skrev \ secr
0a60: 65 74 20 66 6f 72 20 72 65 76 6f 6b 69 6e 67 20 et for revoking
0a70: 6b 65 79 73 0a 65 6e 64 2d 63 6c 61 73 73 20 6b keys.end-class k
0a80: 65 79 62 75 66 2d 63 0a 0a 73 74 61 74 65 32 23 eybuf-c..state2#
0a90: 20 62 75 66 66 65 72 3a 20 6e 6f 2d 6b 65 79 20 buffer: no-key
0aa0: 5c 20 6a 75 73 74 20 7a 65 72 6f 73 20 66 6f 72 \ just zeros for
0ab0: 20 6e 6f 20 6b 65 79 0a 6b 65 79 73 69 7a 65 20 no key.keysize
0ac0: 62 75 66 66 65 72 3a 20 71 72 2d 6b 65 79 20 5c buffer: qr-key \
0ad0: 20 6b 65 79 20 75 73 65 64 20 66 6f 72 20 51 52 key used for QR
0ae0: 20 63 68 61 6c 6c 65 6e 67 65 20 28 63 61 6e 20 challenge (can
0af0: 62 65 20 6f 6e 6c 79 20 6f 6e 65 29 0a 73 74 61 be only one).sta
0b00: 74 65 23 20 20 62 75 66 66 65 72 3a 20 71 72 2d te# buffer: qr-
0b10: 68 61 73 68 20 5c 20 68 61 73 68 20 6f 66 20 63 hash \ hash of c
0b20: 68 61 6c 6c 65 6e 67 65 0a 0a 3a 20 6e 65 77 2d hallenge..: new-
0b30: 6b 65 79 62 75 66 20 28 20 2d 2d 20 29 0a 20 20 keybuf ( -- ).
0b40: 20 20 6b 65 79 62 75 66 2d 63 20 3e 6f 73 69 7a keybuf-c >osiz
0b50: 65 20 40 20 6b 61 6c 6c 6f 63 20 6b 65 79 62 75 e @ kalloc keybu
0b60: 66 20 21 20 3b 0a 3a 20 6e 65 77 2d 6b 65 79 74 f ! ;.: new-keyt
0b70: 6d 70 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 mp ( -- ). ke
0b80: 79 74 6d 70 20 40 20 49 46 0a 09 75 70 40 20 6b ytmp @ IF..up@ k
0b90: 65 79 74 6d 70 2d 75 70 20 40 20 3c 3e 20 49 46 eytmp-up @ <> IF
0ba0: 20 20 42 55 54 20 20 54 48 45 4e 0a 09 6b 65 79 BUT THEN..key
0bb0: 74 6d 70 2d 63 20 3e 6f 73 69 7a 65 20 40 20 6b tmp-c >osize @ k
0bc0: 61 6c 6c 6f 63 20 6b 65 79 74 6d 70 20 21 0a 09 alloc keytmp !..
0bd0: 75 70 40 20 6b 65 79 74 6d 70 2d 75 70 20 21 0a up@ keytmp-up !.
0be0: 20 20 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 69 6e THEN ;..: in
0bf0: 69 74 2d 6b 65 79 62 75 66 20 28 20 2d 2d 20 29 it-keybuf ( -- )
0c00: 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 72 6e 67 . keysize rng
0c10: 24 20 71 72 2d 6b 65 79 20 73 77 61 70 20 6d 6f $ qr-key swap mo
0c20: 76 65 20 5c 20 71 72 2d 6b 65 79 20 73 68 61 6c ve \ qr-key shal
0c30: 6c 20 6e 6f 74 20 62 65 20 67 75 65 73 73 61 62 l not be guessab
0c40: 6c 65 0a 20 20 20 20 6e 65 77 2d 6b 65 79 74 6d le. new-keytm
0c50: 70 20 20 6e 65 77 2d 6b 65 79 62 75 66 20 3b 20 p new-keybuf ;
0c60: 5c 20 77 65 20 68 61 76 65 20 6f 6e 6c 79 20 6f \ we have only o
0c70: 6e 65 20 67 6c 6f 62 61 6c 20 6b 65 79 62 75 66 ne global keybuf
0c80: 0a 0a 69 6e 69 74 2d 6b 65 79 62 75 66 0a 0a 3a ..init-keybuf..:
0c90: 6e 6f 6e 61 6d 65 20 6b 65 79 74 6d 70 20 6f 66 noname keytmp of
0ca0: 66 20 6b 65 79 62 75 66 20 6f 66 66 20 64 65 66 f keybuf off def
0cb0: 65 72 73 20 27 69 6d 61 67 65 20 3b 20 69 73 20 ers 'image ; is
0cc0: 27 69 6d 61 67 65 0a 3a 6e 6f 6e 61 6d 65 20 64 'image.:noname d
0cd0: 65 66 65 72 73 20 27 63 6f 6c 64 20 69 6e 69 74 efers 'cold init
0ce0: 2d 6b 65 79 62 75 66 20 3b 20 69 73 20 27 63 6f -keybuf ; is 'co
0cf0: 6c 64 0a 3a 6e 6f 6e 61 6d 65 20 64 65 66 65 72 ld.:noname defer
0d00: 73 20 61 6c 6c 6f 63 2d 63 6f 64 65 2d 62 75 66 s alloc-code-buf
0d10: 73 20 20 6e 65 77 2d 6b 65 79 74 6d 70 20 3b 20 s new-keytmp ;
0d20: 69 73 20 61 6c 6c 6f 63 2d 63 6f 64 65 2d 62 75 is alloc-code-bu
0d30: 66 73 0a 5c 20 3a 6e 6f 6e 61 6d 65 20 64 65 66 fs.\ :noname def
0d40: 65 72 73 20 66 72 65 65 2d 63 6f 64 65 2d 62 75 ers free-code-bu
0d50: 66 73 20 3b 20 69 73 20 66 72 65 65 2d 63 6f 64 fs ; is free-cod
0d60: 65 2d 62 75 66 73 0a 0a 23 36 30 2e 30 30 30 2e e-bufs..#60.000.
0d70: 30 30 30 2e 30 30 30 20 64 3e 36 34 20 36 34 43 000.000 d>64 64C
0d80: 6f 6e 73 74 61 6e 74 20 3a 30 31 27 23 20 5c 20 onstant :01'# \
0d90: 6f 6e 65 20 6d 69 6e 75 74 65 0a 23 31 30 2e 30 one minute.#10.0
0da0: 30 30 2e 30 30 30 2e 30 30 30 20 64 3e 36 34 20 00.000.000 d>64
0db0: 36 34 43 6f 6e 73 74 61 6e 74 20 31 30 22 23 20 64Constant 10"#
0dc0: 20 5c 20 74 65 6e 20 73 65 63 6f 6e 64 0a 3a 30 \ ten second.:0
0dd0: 31 27 23 20 36 34 56 61 6c 75 65 20 64 65 6c 74 1'# 64Value delt
0de0: 61 2d 6d 79 6b 65 79 23 20 20 20 5c 20 6e 65 77 a-mykey# \ new
0df0: 20 6d 79 6b 65 79 20 65 76 65 72 79 20 36 30 20 mykey every 60
0e00: 73 65 63 6f 6e 64 73 0a 31 30 22 23 20 20 36 34 seconds.10"# 64
0e10: 43 6f 6e 73 74 61 6e 74 20 66 75 7a 7a 65 64 74 Constant fuzzedt
0e20: 69 6d 65 23 20 5c 20 61 6c 6c 6f 77 20 63 6c 69 ime# \ allow cli
0e30: 65 6e 74 73 20 74 6f 20 62 65 20 31 30 73 20 6f ents to be 10s o
0e40: 66 66 0a 0a 3a 20 69 6e 69 74 2d 6d 79 6b 65 79 ff..: init-mykey
0e50: 20 28 20 2d 2d 20 29 0a 20 20 20 20 74 69 63 6b ( -- ). tick
0e60: 73 20 64 65 6c 74 61 2d 6d 79 6b 65 79 23 20 36 s delta-mykey# 6
0e70: 34 2b 20 6c 61 73 74 2d 6d 79 6b 65 79 20 36 34 4+ last-mykey 64
0e80: 21 0a 20 20 20 20 6d 79 6b 65 79 20 6f 6c 64 6d !. mykey oldm
0e90: 79 6b 65 79 20 73 74 61 74 65 23 20 6d 6f 76 65 ykey state# move
0ea0: 0a 20 20 20 20 73 74 61 74 65 23 20 72 6e 67 24 . state# rng$
0eb0: 20 6d 79 6b 65 79 20 73 77 61 70 20 6d 6f 76 65 mykey swap move
0ec0: 0a 20 20 20 20 6d 79 6b 65 79 28 20 3c 69 6e 66 . mykey( <inf
0ed0: 6f 3e 20 2e 22 20 47 65 6e 65 72 61 74 65 20 6e o> ." Generate n
0ee0: 65 77 20 6d 79 6b 65 79 22 20 63 72 20 3c 64 65 ew mykey" cr <de
0ef0: 66 61 75 6c 74 3e 20 29 0a 20 20 20 20 67 65 6e fault> ). gen
0f00: 6b 65 79 28 20 2e 22 20 6d 79 6b 65 79 3a 20 22 key( ." mykey: "
0f10: 20 6d 79 6b 65 79 20 73 74 61 74 65 23 20 78 74 mykey state# xt
0f20: 79 70 65 20 63 72 20 29 20 3b 0a 0a 30 20 56 61 ype cr ) ;..0 Va
0f30: 6c 75 65 20 68 65 61 64 65 72 2d 6b 65 79 0a 30 lue header-key.0
0f40: 20 56 61 6c 75 65 20 68 65 61 64 65 72 2d 79 6f Value header-yo
0f50: 75 72 2d 6b 65 79 0a 24 32 30 20 62 75 66 66 65 ur-key.$20 buffe
0f60: 72 3a 20 64 75 6d 6d 79 2d 62 75 66 0a 0a 3a 20 r: dummy-buf..:
0f70: 69 6e 69 74 2d 68 65 61 64 65 72 2d 6b 65 79 20 init-header-key
0f80: 28 20 2d 2d 20 29 0a 20 20 20 20 6b 61 6c 6c 6f ( -- ). kallo
0f90: 63 36 34 20 64 75 70 20 74 6f 20 68 65 61 64 65 c64 dup to heade
0fa0: 72 2d 6b 65 79 20 24 34 30 20 65 72 61 73 65 0a r-key $40 erase.
0fb0: 20 20 20 20 6b 61 6c 6c 6f 63 36 34 20 64 75 70 kalloc64 dup
0fc0: 20 74 6f 20 68 65 61 64 65 72 2d 79 6f 75 72 2d to header-your-
0fd0: 6b 65 79 20 24 34 30 20 65 72 61 73 65 0a 20 20 key $40 erase.
0fe0: 20 20 6d 79 2d 30 6b 65 79 20 73 65 63 40 20 20 my-0key sec@
0ff0: 68 65 61 64 65 72 2d 6b 65 79 20 73 77 61 70 20 header-key swap
1000: 6d 6f 76 65 0a 20 20 20 20 68 65 61 64 65 72 2d move. header-
1010: 6b 65 79 20 64 75 6d 6d 79 2d 62 75 66 20 64 75 key dummy-buf du
1020: 70 20 24 43 20 74 66 5f 65 6e 63 72 79 70 74 5f p $C tf_encrypt_
1030: 32 35 36 20 28 20 73 65 74 73 20 74 77 65 61 6b 256 ( sets tweak
1040: 73 20 29 20 3b 0a 0a 3a 20 69 6e 69 74 2d 6d 79 s ) ;..: init-my
1050: 30 6b 65 79 20 28 20 2d 2d 20 29 0a 20 20 20 20 0key ( -- ).
1060: 6e 6f 30 6b 65 79 28 20 45 58 49 54 20 29 20 6b no0key( EXIT ) k
1070: 65 79 73 69 7a 65 20 72 6e 67 24 20 6d 79 2d 30 eysize rng$ my-0
1080: 6b 65 79 20 73 65 63 21 20 3b 0a 0a 3a 20 3f 6e key sec! ;..: ?n
1090: 65 77 2d 6d 79 6b 65 79 20 28 20 2d 2d 20 29 0a ew-mykey ( -- ).
10a0: 20 20 20 20 6c 61 73 74 2d 6d 79 6b 65 79 20 36 last-mykey 6
10b0: 34 40 20 74 69 63 6b 65 72 20 36 34 40 20 36 34 4@ ticker 64@ 64
10c0: 2d 20 36 34 2d 30 3c 20 49 46 20 20 69 6e 69 74 - 64-0< IF init
10d0: 2d 6d 79 6b 65 79 20 20 54 48 45 4e 20 3b 0a 0a -mykey THEN ;..
10e0: 3a 20 3e 63 72 79 70 74 2d 6b 65 79 20 28 20 61 : >crypt-key ( a
10f0: 64 64 72 20 75 20 2d 2d 20 29 20 6b 65 79 28 20 ddr u -- ) key(
1100: 64 75 70 20 2e 20 29 0a 20 20 20 20 64 75 70 20 dup . ). dup
1110: 30 3d 20 49 46 20 20 32 64 72 6f 70 20 6e 6f 2d 0= IF 2drop no-
1120: 6b 65 79 20 73 74 61 74 65 23 20 20 54 48 45 4e key state# THEN
1130: 0a 20 20 20 20 6b 65 79 2d 61 73 73 65 6d 62 6c . key-assembl
1140: 79 20 73 74 61 74 65 23 20 2b 20 73 74 61 74 65 y state# + state
1150: 23 20 6d 6f 76 65 2d 72 65 70 0a 20 20 20 20 6b # move-rep. k
1160: 65 79 2d 61 73 73 65 6d 62 6c 79 20 74 77 65 61 ey-assembly twea
1170: 6b 28 20 2e 22 20 3e 63 72 79 70 74 2d 6b 65 79 k( ." >crypt-key
1180: 20 22 20 64 75 70 20 73 74 61 74 65 32 23 20 38 " dup state2# 8
1190: 35 74 79 70 65 20 63 72 20 29 0a 20 20 20 20 3e 5type cr ). >
11a0: 63 3a 6b 65 79 20 3b 0a 3a 20 3e 63 72 79 70 74 c:key ;.: >crypt
11b0: 2d 73 6f 75 72 63 65 20 28 20 61 64 64 72 20 75 -source ( addr u
11c0: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 2d 61 73 -- ). key-as
11d0: 73 65 6d 62 6c 79 20 73 74 61 74 65 23 20 6d 6f sembly state# mo
11e0: 76 65 2d 72 65 70 20 3b 0a 0a 5c 20 72 65 67 65 ve-rep ;..\ rege
11f0: 6e 65 72 61 74 65 20 69 76 73 20 69 73 20 61 20 nerate ivs is a
1200: 62 75 66 66 65 72 20 73 77 61 70 70 69 6e 67 20 buffer swapping
1210: 66 75 6e 63 74 69 6f 6e 3a 0a 5c 20 72 65 67 65 function:.\ rege
1220: 6e 65 72 61 74 65 20 68 61 6c 66 20 6f 66 20 74 nerate half of t
1230: 68 65 20 69 76 73 20 70 65 72 20 74 69 6d 65 2c he ivs per time,
1240: 20 77 68 65 6e 20 79 6f 75 20 72 65 61 63 68 20 when you reach
1250: 74 68 65 20 6d 69 64 64 6c 65 20 6f 66 20 74 68 the middle of th
1260: 65 20 6f 74 68 65 72 20 68 61 6c 66 0a 5c 20 6f e other half.\ o
1270: 66 20 74 68 65 20 69 76 73 20 62 75 66 66 65 72 f the ivs buffer
1280: 2e 0a 0a 73 63 6f 70 65 7b 20 6d 61 70 63 0a 0a ...scope{ mapc..
1290: 3a 20 64 65 73 74 2d 61 2f 62 20 28 20 61 64 64 : dest-a/b ( add
12a0: 72 20 75 20 2d 2d 20 61 64 64 72 31 20 75 31 20 r u -- addr1 u1
12b0: 29 0a 20 20 20 20 32 2f 20 20 64 65 73 74 2d 69 ). 2/ dest-i
12c0: 76 73 6c 61 73 74 67 65 6e 20 31 20 3d 20 49 46 vslastgen 1 = IF
12d0: 20 20 64 75 70 20 3e 72 20 2b 20 72 3e 20 20 54 dup >r + r> T
12e0: 48 45 4e 20 3b 0a 0a 3a 20 72 65 70 6c 69 65 73 HEN ;..: replies
12f0: 2d 65 72 61 73 65 20 28 20 61 64 64 72 20 6c 65 -erase ( addr le
1300: 6e 20 2d 2d 20 29 0a 20 20 20 20 32 64 75 70 20 n -- ). 2dup
1310: 62 6f 75 6e 64 73 20 55 2b 44 4f 0a 09 49 20 72 bounds U+DO..I r
1320: 65 70 6c 79 2d 74 61 67 20 3f 64 75 70 2d 49 46 eply-tag ?dup-IF
1330: 20 20 6f 66 66 20 20 54 48 45 4e 0a 20 20 20 20 off THEN.
1340: 72 65 70 6c 79 20 2b 4c 4f 4f 50 20 20 65 72 61 reply +LOOP era
1350: 73 65 20 3b 0a 0a 3a 20 63 6c 65 61 72 2d 72 65 se ;..: clear-re
1360: 70 6c 69 65 73 20 28 20 2d 2d 20 29 0a 20 20 20 plies ( -- ).
1370: 20 64 65 73 74 2d 72 65 70 6c 69 65 73 20 64 65 dest-replies de
1380: 73 74 2d 73 69 7a 65 20 61 64 64 72 3e 72 65 70 st-size addr>rep
1390: 6c 69 65 73 20 64 65 73 74 2d 61 2f 62 0a 20 20 lies dest-a/b.
13a0: 20 20 72 65 70 6c 69 65 73 2d 65 72 61 73 65 20 replies-erase
13b0: 3b 0a 0a 3a 20 3e 69 76 73 6b 65 79 20 28 20 36 ;..: >ivskey ( 6
13c0: 34 61 64 64 72 20 2d 2d 20 6b 65 79 61 64 64 72 4addr -- keyaddr
13d0: 20 29 0a 20 20 20 20 36 34 3e 6e 20 61 64 64 72 ). 64>n addr
13e0: 3e 6b 65 79 73 20 64 65 73 74 2d 69 76 73 24 20 >keys dest-ivs$
13f0: 72 6f 74 20 75 6d 69 6e 20 2b 20 3b 0a 0a 7d 73 rot umin + ;..}s
1400: 63 6f 70 65 0a 0a 3a 20 63 72 79 70 74 2d 6b 65 cope..: crypt-ke
1410: 79 24 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 y$ ( -- addr u )
1420: 0a 20 20 20 20 6f 20 30 3d 20 49 46 20 20 6e 6f . o 0= IF no
1430: 2d 6b 65 79 20 73 74 61 74 65 23 20 20 45 4c 53 -key state# ELS
1440: 45 20 20 63 72 79 70 74 6f 2d 6b 65 79 20 73 65 E crypto-key se
1450: 63 40 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 64 65 c@ THEN ;..: de
1460: 66 61 75 6c 74 2d 6b 65 79 20 28 20 2d 2d 20 29 fault-key ( -- )
1470: 0a 20 20 20 20 63 6d 64 28 20 2e 22 20 44 65 66 . cmd( ." Def
1480: 61 75 6c 74 2d 6b 65 79 20 22 20 63 72 20 29 0a ault-key " cr ).
1490: 20 20 20 20 63 3a 30 6b 65 79 20 3b 0a 0a 3a 20 c:0key ;..:
14a0: 61 64 64 72 3e 61 73 73 65 6d 62 6c 79 20 28 20 addr>assembly (
14b0: 61 64 64 72 36 34 20 66 6c 61 67 20 2d 2d 20 78 addr64 flag -- x
14c0: 31 32 38 20 29 0a 20 20 20 20 5b 20 61 63 6b 73 128 ). [ acks
14d0: 23 20 69 6e 76 65 72 74 20 38 20 6c 73 68 69 66 # invert 8 lshif
14e0: 74 20 5d 4c 20 61 6e 64 20 6e 3e 36 34 20 3b 0a t ]L and n>64 ;.
14f0: 0a 3a 20 69 76 73 2d 74 77 65 61 6b 20 28 20 36 .: ivs-tweak ( 6
1500: 34 61 64 64 72 20 6b 65 79 61 64 64 72 20 2d 2d 4addr keyaddr --
1510: 20 29 0a 20 20 20 20 3e 72 20 64 65 73 74 2d 66 ). >r dest-f
1520: 6c 61 67 73 20 6c 65 2d 75 77 40 20 61 64 64 72 lags le-uw@ addr
1530: 3e 61 73 73 65 6d 62 6c 79 0a 20 20 20 20 72 3e >assembly. r>
1540: 20 73 74 61 74 65 23 20 63 3a 74 77 65 61 6b 6b state# c:tweakk
1550: 65 79 21 0a 20 20 20 20 74 77 65 61 6b 28 20 2e ey!. tweak( .
1560: 22 20 74 77 65 61 6b 20 6b 65 79 3a 20 22 20 76 " tweak key: " v
1570: 6f 75 74 6b 65 79 20 63 3a 6b 65 79 3e 20 76 6f outkey c:key> vo
1580: 75 74 6b 65 79 20 40 20 68 65 78 2e 20 76 6f 75 utkey @ hex. vou
1590: 74 6b 65 79 20 73 74 61 74 65 23 20 2b 20 24 31 tkey state# + $1
15a0: 30 20 2e 6e 6e 62 20 63 72 20 29 20 3b 0a 0a 73 0 .nnb cr ) ;..s
15b0: 63 6f 70 65 7b 20 6d 61 70 63 0a 0a 3a 20 69 76 cope{ mapc..: iv
15c0: 73 3e 73 6f 75 72 63 65 3f 20 28 20 6f 3a 6d 61 s>source? ( o:ma
15d0: 70 20 2d 2d 20 29 0a 20 20 20 20 64 65 73 74 2d p -- ). dest-
15e0: 61 64 64 72 20 36 34 40 20 64 65 73 74 2d 76 61 addr 64@ dest-va
15f0: 64 64 72 20 36 34 2d 0a 20 20 20 20 36 34 64 75 ddr 64-. 64du
1600: 70 20 64 65 73 74 2d 73 69 7a 65 20 6e 3e 36 34 p dest-size n>64
1610: 20 36 34 75 3e 3d 20 21 21 69 6e 76 2d 64 65 73 64u>= !!inv-des
1620: 74 21 21 0a 20 20 20 20 36 34 64 75 70 20 36 34 t!!. 64dup 64
1630: 64 75 70 20 3e 69 76 73 6b 65 79 20 69 76 73 2d dup >ivskey ivs-
1640: 74 77 65 61 6b 20 36 34 3e 6e 20 61 64 64 72 3e tweak 64>n addr>
1650: 6b 65 79 73 20 72 65 67 65 6e 2d 69 76 73 20 3b keys regen-ivs ;
1660: 0a 0a 7d 73 63 6f 70 65 0a 0a 3a 20 6b 65 79 3e ..}scope..: key>
1670: 64 75 6d 70 20 28 20 2d 2d 20 61 64 64 72 20 75 dump ( -- addr u
1680: 20 29 0a 20 20 20 20 6b 65 79 64 75 6d 70 2d 62 ). keydump-b
1690: 75 66 20 63 3a 6b 65 79 3e 20 6b 65 79 64 75 6d uf c:key> keydum
16a0: 70 2d 62 75 66 20 63 3a 6b 65 79 23 20 3b 0a 0a p-buf c:key# ;..
16b0: 3a 20 63 72 79 70 74 2d 6b 65 79 2d 69 6e 69 74 : crypt-key-init
16c0: 20 28 20 61 64 64 72 20 75 20 6b 65 79 20 75 20 ( addr u key u
16d0: 2d 2d 20 61 64 64 72 27 20 75 27 20 29 20 32 3e -- addr' u' ) 2>
16e0: 72 0a 20 20 20 20 6f 76 65 72 20 6c 65 2d 31 32 r. over le-12
16f0: 38 40 20 32 72 3e 20 63 3a 74 77 65 61 6b 6b 65 8@ 2r> c:tweakke
1700: 79 21 0a 20 20 20 20 6b 65 79 2d 73 61 6c 74 23 y!. key-salt#
1710: 20 73 61 66 65 2f 73 74 72 69 6e 67 0a 20 20 20 safe/string.
1720: 20 74 77 65 61 6b 28 20 2e 22 20 6b 65 79 20 69 tweak( ." key i
1730: 6e 69 74 3a 20 22 20 6b 65 79 3e 64 75 6d 70 20 nit: " key>dump
1740: 2e 6e 6e 62 20 63 72 20 29 20 3b 0a 0a 3a 20 63 .nnb cr ) ;..: c
1750: 72 79 70 74 2d 6b 65 79 2d 73 65 74 75 70 20 28 rypt-key-setup (
1760: 20 61 64 64 72 20 75 31 20 6b 65 79 20 75 32 20 addr u1 key u2
1770: 2d 2d 20 61 64 64 72 27 20 75 27 20 29 0a 20 20 -- addr' u' ).
1780: 20 20 32 3e 72 20 6f 76 65 72 20 3e 72 20 20 24 2>r over >r $
1790: 31 30 20 72 6e 67 24 20 64 72 6f 70 20 64 75 70 10 rng$ drop dup
17a0: 20 72 3e 20 24 31 30 20 6d 6f 76 65 20 6c 65 2d r> $10 move le-
17b0: 31 32 38 40 20 32 72 3e 20 63 3a 74 77 65 61 6b 128@ 2r> c:tweak
17c0: 6b 65 79 21 0a 20 20 20 20 6b 65 79 2d 73 61 6c key!. key-sal
17d0: 74 23 20 73 61 66 65 2f 73 74 72 69 6e 67 20 3b t# safe/string ;
17e0: 0a 0a 3a 20 65 6e 63 72 79 70 74 24 20 28 20 61 ..: encrypt$ ( a
17f0: 64 64 72 20 75 31 20 6b 65 79 20 75 32 20 2d 2d ddr u1 key u2 --
1800: 20 29 0a 20 20 20 20 63 72 79 70 74 2d 6b 65 79 ). crypt-key
1810: 2d 73 65 74 75 70 0a 20 20 20 20 6f 76 65 72 20 -setup. over
1820: 3e 72 20 24 3e 61 6c 69 67 6e 20 32 64 75 70 20 >r $>align 2dup
1830: 6b 65 79 2d 63 6b 73 75 6d 23 20 2d 20 30 20 63 key-cksum# - 0 c
1840: 3a 65 6e 63 72 79 70 74 2b 61 75 74 68 0a 20 20 :encrypt+auth.
1850: 20 20 72 3e 20 73 77 61 70 20 6d 6f 76 65 20 3b r> swap move ;
1860: 0a 0a 3a 20 64 65 63 72 79 70 74 24 20 28 20 61 ..: decrypt$ ( a
1870: 64 64 72 20 75 31 20 6b 65 79 20 75 32 20 2d 2d ddr u1 key u2 --
1880: 20 61 64 64 72 27 20 75 27 20 66 6c 61 67 20 29 addr' u' flag )
1890: 0a 20 20 20 20 63 72 79 70 74 2d 6b 65 79 2d 69 . crypt-key-i
18a0: 6e 69 74 0a 20 20 20 20 24 3e 61 6c 69 67 6e 20 nit. $>align
18b0: 6b 65 79 2d 63 6b 73 75 6d 23 20 2d 20 32 64 75 key-cksum# - 2du
18c0: 70 20 30 20 63 3a 64 65 63 72 79 70 74 2b 61 75 p 0 c:decrypt+au
18d0: 74 68 20 3b 0a 0a 5c 20 70 61 73 73 70 68 72 61 th ;..\ passphra
18e0: 65 73 65 20 65 6e 63 72 79 70 74 69 6f 6e 20 6e ese encryption n
18f0: 65 65 64 73 20 74 6f 20 64 69 66 66 75 73 65 20 eeds to diffuse
1900: 61 20 6c 6f 74 20 61 66 74 65 72 20 6d 65 72 67 a lot after merg
1910: 69 6e 20 69 6e 20 74 68 65 20 73 61 6c 74 0a 0a in in the salt..
1920: 32 20 56 61 6c 75 65 20 70 77 2d 6c 65 76 65 6c 2 Value pw-level
1930: 30 0a 0a 3a 20 63 72 79 70 74 2d 70 77 2d 73 65 0..: crypt-pw-se
1940: 74 75 70 20 28 20 61 64 64 72 20 75 31 20 6b 65 tup ( addr u1 ke
1950: 79 20 75 32 20 6e 20 2d 2d 20 61 64 64 72 27 20 y u2 n -- addr'
1960: 75 27 20 6e 27 20 29 20 7b 20 6e 20 7d 0a 20 20 u' n' ) { n }.
1970: 20 20 32 3e 72 20 6f 76 65 72 20 3e 72 20 20 24 2>r over >r $
1980: 31 30 20 72 6e 67 24 20 72 40 20 73 77 61 70 20 10 rng$ r@ swap
1990: 6d 6f 76 65 0a 20 20 20 20 72 40 20 63 40 20 6e move. r@ c@ n
19a0: 20 24 46 30 20 6d 75 78 20 72 3e 20 63 21 20 32 $F0 mux r> c! 2
19b0: 72 3e 20 63 72 79 70 74 2d 6b 65 79 2d 69 6e 69 r> crypt-key-ini
19c0: 74 20 70 77 2d 6c 65 76 65 6c 30 20 6e 20 32 2a t pw-level0 n 2*
19d0: 20 6c 73 68 69 66 74 20 3b 0a 0a 3a 20 70 77 2d lshift ;..: pw-
19e0: 64 69 66 66 75 73 65 2d 6b 65 63 63 61 6b 20 28 diffuse-keccak (
19f0: 20 64 69 66 66 75 73 65 23 20 2d 2d 20 29 0a 20 diffuse# -- ).
1a00: 20 20 20 2d 31 20 2b 44 4f 20 20 63 3a 64 69 66 -1 +DO c:dif
1a10: 66 75 73 65 20 20 4c 4f 4f 50 20 3b 20 5c 20 6a fuse LOOP ; \ j
1a20: 75 73 74 20 74 6f 20 77 61 73 74 65 20 74 69 6d ust to waste tim
1a30: 65 20 3b 2d 29 0a 0a 6b 65 79 73 69 7a 65 20 62 e ;-)..keysize b
1a40: 75 66 66 65 72 3a 20 64 69 66 66 75 73 65 2d 65 uffer: diffuse-e
1a50: 63 63 0a 6b 65 79 73 69 7a 65 20 62 75 66 66 65 cc.keysize buffe
1a60: 72 3a 20 64 69 66 66 75 73 65 2d 73 6b 0a 0a 3a r: diffuse-sk..:
1a70: 20 70 77 2d 64 69 66 66 75 73 65 2d 65 63 63 27 pw-diffuse-ecc'
1a80: 20 28 20 78 74 20 2d 2d 20 29 20 3e 72 0a 20 20 ( xt -- ) >r.
1a90: 20 20 64 69 66 66 75 73 65 2d 73 6b 20 6b 65 79 diffuse-sk key
1aa0: 73 69 7a 65 20 20 63 3a 68 61 73 68 40 0a 20 20 size c:hash@.
1ab0: 20 20 64 69 66 66 75 73 65 2d 73 6b 20 64 75 70 diffuse-sk dup
1ac0: 20 73 6b 2d 6d 61 73 6b 20 20 64 69 66 66 75 73 sk-mask diffus
1ad0: 65 2d 65 63 63 20 20 72 3e 20 65 78 65 63 75 74 e-ecc r> execut
1ae0: 65 0a 20 20 20 20 64 69 66 66 75 73 65 2d 65 63 e. diffuse-ec
1af0: 63 20 6b 65 79 73 69 7a 65 20 63 3a 73 68 6f 72 c keysize c:shor
1b00: 74 68 61 73 68 20 3b 0a 0a 3a 20 70 77 2d 64 69 thash ;..: pw-di
1b10: 66 66 75 73 65 2d 65 63 63 20 28 20 64 69 66 66 ffuse-ecc ( diff
1b20: 75 73 65 23 20 2d 2d 20 29 0a 20 20 20 20 63 3a use# -- ). c:
1b30: 64 69 66 66 75 73 65 20 5b 27 5d 20 73 6b 3e 70 diffuse ['] sk>p
1b40: 6b 20 73 77 61 70 0a 20 20 20 20 2d 31 20 2b 44 k swap. -1 +D
1b50: 4f 20 5c 20 64 6f 20 61 74 20 6c 65 61 73 74 20 O \ do at least
1b60: 31 20 74 69 6d 65 20 65 76 65 6e 20 69 66 20 73 1 time even if s
1b70: 75 70 70 6c 69 65 64 20 77 69 74 68 20 30 0a 09 upplied with 0..
1b80: 70 77 2d 64 69 66 66 75 73 65 2d 65 63 63 27 20 pw-diffuse-ecc'
1b90: 5b 3a 20 64 75 70 20 65 64 2d 64 68 20 32 64 72 [: dup ed-dh 2dr
1ba0: 6f 70 20 3b 5d 0a 20 20 20 20 4c 4f 4f 50 0a 20 op ;]. LOOP.
1bb0: 20 20 20 64 72 6f 70 20 20 64 69 66 66 75 73 65 drop diffuse
1bc0: 2d 65 63 63 20 6b 65 79 73 69 7a 65 20 65 72 61 -ecc keysize era
1bd0: 73 65 20 20 64 69 66 66 75 73 65 2d 73 6b 20 6b se diffuse-sk k
1be0: 65 79 73 69 7a 65 20 65 72 61 73 65 0a 3b 20 5c eysize erase.; \
1bf0: 20 6a 75 73 74 20 74 6f 20 77 61 73 74 65 20 74 just to waste t
1c00: 69 6d 65 20 69 6e 20 61 20 77 61 79 20 74 68 61 ime in a way tha
1c10: 74 20 69 73 20 64 69 66 66 69 63 75 6c 74 20 74 t is difficult t
1c20: 6f 20 62 75 69 6c 74 20 69 6e 74 6f 20 41 53 49 o built into ASI
1c30: 43 73 0a 0a 44 65 66 65 72 20 70 77 2d 64 69 66 Cs..Defer pw-dif
1c40: 66 75 73 65 0a 0a 3a 20 6e 65 77 2d 70 77 2d 64 fuse..: new-pw-d
1c50: 69 66 66 75 73 65 20 28 20 2d 2d 20 29 0a 20 20 iffuse ( -- ).
1c60: 20 20 5b 27 5d 20 70 77 2d 64 69 66 66 75 73 65 ['] pw-diffuse
1c70: 2d 65 63 63 20 69 73 20 70 77 2d 64 69 66 66 75 -ecc is pw-diffu
1c80: 73 65 20 20 32 20 74 6f 20 70 77 2d 6c 65 76 65 se 2 to pw-leve
1c90: 6c 30 20 3b 0a 0a 3a 20 6f 6c 64 2d 70 77 2d 64 l0 ;..: old-pw-d
1ca0: 69 66 66 75 73 65 20 28 20 2d 2d 20 29 0a 20 20 iffuse ( -- ).
1cb0: 20 20 5b 27 5d 20 70 77 2d 64 69 66 66 75 73 65 ['] pw-diffuse
1cc0: 2d 6b 65 63 63 61 6b 20 69 73 20 70 77 2d 64 69 -keccak is pw-di
1cd0: 66 66 75 73 65 20 20 24 31 30 30 20 74 6f 20 70 ffuse $100 to p
1ce0: 77 2d 6c 65 76 65 6c 30 20 3b 0a 0a 6e 65 77 2d w-level0 ;..new-
1cf0: 70 77 2d 64 69 66 66 75 73 65 0a 0a 3a 20 70 77 pw-diffuse..: pw
1d00: 2d 73 65 74 75 70 20 28 20 61 64 64 72 20 75 20 -setup ( addr u
1d10: 2d 2d 20 64 69 66 66 75 73 65 23 20 29 0a 20 20 -- diffuse# ).
1d20: 20 20 5c 67 20 63 6f 6d 70 75 74 65 20 62 65 74 \g compute bet
1d30: 77 65 65 6e 20 32 35 36 20 61 6e 64 20 72 69 64 ween 256 and rid
1d40: 69 63 75 6c 6f 75 73 6c 79 20 6d 61 6e 79 20 69 iculously many i
1d50: 74 65 72 61 74 69 6f 6e 73 0a 20 20 20 20 64 72 terations. dr
1d60: 6f 70 20 63 40 20 24 46 20 61 6e 64 20 32 2a 20 op c@ $F and 2*
1d70: 70 77 2d 6c 65 76 65 6c 30 20 73 77 61 70 20 6c pw-level0 swap l
1d80: 73 68 69 66 74 20 3b 0a 0a 3a 20 65 6e 63 72 79 shift ;..: encry
1d90: 70 74 2d 70 77 24 20 28 20 61 64 64 72 20 75 31 pt-pw$ ( addr u1
1da0: 20 6b 65 79 20 75 32 20 6e 20 2d 2d 20 29 0a 20 key u2 n -- ).
1db0: 20 20 20 63 72 79 70 74 2d 70 77 2d 73 65 74 75 crypt-pw-setu
1dc0: 70 20 20 70 77 2d 64 69 66 66 75 73 65 20 20 6b p pw-diffuse k
1dd0: 65 79 2d 63 6b 73 75 6d 23 20 2d 20 30 20 63 3a ey-cksum# - 0 c:
1de0: 65 6e 63 72 79 70 74 2b 61 75 74 68 20 3b 0a 0a encrypt+auth ;..
1df0: 3a 20 64 65 63 72 79 70 74 2d 70 77 24 20 28 20 : decrypt-pw$ (
1e00: 61 64 64 72 20 75 31 20 6b 65 79 20 75 32 20 2d addr u1 key u2 -
1e10: 2d 20 61 64 64 72 27 20 75 27 20 66 6c 61 67 20 - addr' u' flag
1e20: 29 20 20 32 6f 76 65 72 20 70 77 2d 73 65 74 75 ) 2over pw-setu
1e30: 70 20 3e 72 0a 20 20 20 20 63 72 79 70 74 2d 6b p >r. crypt-k
1e40: 65 79 2d 69 6e 69 74 20 20 20 72 3e 20 70 77 2d ey-init r> pw-
1e50: 64 69 66 66 75 73 65 20 6b 65 79 2d 63 6b 73 75 diffuse key-cksu
1e60: 6d 23 20 2d 20 32 64 75 70 20 30 20 63 3a 64 65 m# - 2dup 0 c:de
1e70: 63 72 79 70 74 2b 61 75 74 68 20 3b 0a 0a 5c 20 crypt+auth ;..\
1e80: 65 6e 63 72 79 70 74 2f 64 65 63 72 79 70 74 20 encrypt/decrypt
1e90: 68 65 61 64 65 72 0a 0a 3a 20 68 65 61 64 65 72 header..: header
1ea0: 2d 65 6e 63 72 79 70 74 20 28 20 61 64 64 72 20 -encrypt ( addr
1eb0: 2d 2d 20 29 0a 20 20 20 20 79 6f 75 72 2d 30 6b -- ). your-0k
1ec0: 65 79 20 68 65 61 64 65 72 2d 79 6f 75 72 2d 6b ey header-your-k
1ed0: 65 79 20 73 77 61 70 20 6d 6f 76 65 0a 20 20 20 ey swap move.
1ee0: 20 68 65 61 64 65 72 2d 79 6f 75 72 2d 6b 65 79 header-your-key
1ef0: 20 73 77 61 70 20 64 75 70 20 24 43 20 74 66 5f swap dup $C tf_
1f00: 65 6e 63 72 79 70 74 5f 32 35 36 20 3b 0a 3a 20 encrypt_256 ;.:
1f10: 68 65 61 64 65 72 2d 64 65 63 72 79 70 74 20 28 header-decrypt (
1f20: 20 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 20 68 addr -- ). h
1f30: 65 61 64 65 72 2d 6b 65 79 20 73 77 61 70 20 64 eader-key swap d
1f40: 75 70 20 24 30 20 74 66 5f 64 65 63 72 79 70 74 up $0 tf_decrypt
1f50: 5f 32 35 36 20 3b 0a 0a 5c 20 65 6e 63 72 79 70 _256 ;..\ encryp
1f60: 74 20 77 69 74 68 20 6f 77 6e 20 6b 65 79 0a 0a t with own key..
1f70: 3a 20 6d 79 6b 65 79 2d 65 6e 63 72 79 70 74 24 : mykey-encrypt$
1f80: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 2b ( addr u -- ) +
1f90: 63 61 6c 63 0a 20 20 20 20 6d 79 6b 65 79 28 20 calc. mykey(
1fa0: 32 64 75 70 20 29 20 6d 79 6b 65 79 20 73 74 61 2dup ) mykey sta
1fb0: 74 65 23 20 65 6e 63 72 79 70 74 24 20 2b 65 6e te# encrypt$ +en
1fc0: 63 0a 20 20 20 20 6d 79 6b 65 79 28 20 3c 69 6e c. mykey( <in
1fd0: 66 6f 3e 20 2e 22 20 6d 79 6b 65 79 20 65 6e 63 fo> ." mykey enc
1fe0: 3a 20 22 20 6d 79 6b 65 79 20 34 20 38 35 74 79 : " mykey 4 85ty
1ff0: 70 65 20 73 70 61 63 65 0a 20 20 20 20 64 75 70 pe space. dup
2000: 20 34 20 2d 20 2f 73 74 72 69 6e 67 20 38 35 74 4 - /string 85t
2010: 79 70 65 20 3c 64 65 66 61 75 6c 74 3e 20 63 72 ype <default> cr
2020: 20 29 20 3b 0a 0a 3a 20 6d 79 6b 65 79 2d 64 65 ) ;..: mykey-de
2030: 63 72 79 70 74 24 20 28 20 61 64 64 72 20 75 20 crypt$ ( addr u
2040: 2d 2d 20 61 64 64 72 27 20 75 27 20 66 6c 61 67 -- addr' u' flag
2050: 20 29 0a 20 20 20 20 2b 63 61 6c 63 20 32 64 75 ). +calc 2du
2060: 70 20 6d 79 6b 65 79 20 73 74 61 74 65 23 20 64 p mykey state# d
2070: 65 63 72 79 70 74 24 0a 20 20 20 20 49 46 20 20 ecrypt$. IF
2080: 2b 65 6e 63 20 6d 79 6b 65 79 28 20 3c 69 6e 66 +enc mykey( <inf
2090: 6f 3e 20 2e 22 20 6d 79 6b 65 79 20 64 65 63 72 o> ." mykey decr
20a0: 79 70 74 65 64 22 20 63 72 20 3c 64 65 66 61 75 ypted" cr <defau
20b0: 6c 74 3e 20 29 0a 09 32 6e 69 70 20 74 72 75 65 lt> )..2nip true
20c0: 20 20 45 58 49 54 20 20 54 48 45 4e 20 20 32 64 EXIT THEN 2d
20d0: 72 6f 70 20 6d 79 6b 65 79 28 20 3c 77 61 72 6e rop mykey( <warn
20e0: 3e 20 2e 22 20 74 72 79 20 6f 6c 64 6d 79 6b 65 > ." try oldmyke
20f0: 79 20 22 20 29 0a 20 20 20 20 6f 6c 64 6d 79 6b y " ). oldmyk
2100: 65 79 20 73 74 61 74 65 23 20 64 65 63 72 79 70 ey state# decryp
2110: 74 24 20 2b 65 6e 63 20 6d 79 6b 65 79 28 20 64 t$ +enc mykey( d
2120: 75 70 20 49 46 0a 09 3c 69 6e 66 6f 3e 20 2e 22 up IF..<info> ."
2130: 20 73 75 63 63 65 65 64 65 64 2e 2e 2e 22 20 20 succeeded..."
2140: 45 4c 53 45 20 20 3c 65 72 72 3e 20 2e 22 20 66 ELSE <err> ." f
2150: 61 69 6c 65 64 2e 2e 2e 22 20 20 54 48 45 4e 0a ailed..." THEN.
2160: 20 20 20 20 3c 64 65 66 61 75 6c 74 3e 20 20 63 <default> c
2170: 72 20 29 20 3b 0a 0a 3a 20 6f 75 74 62 75 66 2d r ) ;..: outbuf-
2180: 65 6e 63 72 79 70 74 20 28 20 6d 61 70 20 2d 2d encrypt ( map --
2190: 20 29 20 2b 63 61 6c 63 0a 20 20 20 20 2e 6d 61 ) +calc. .ma
21a0: 70 63 3a 69 76 73 3e 73 6f 75 72 63 65 3f 20 6f pc:ivs>source? o
21b0: 75 74 62 75 66 20 70 61 63 6b 65 74 2d 64 61 74 utbuf packet-dat
21c0: 61 20 2b 63 72 79 70 74 73 75 0a 20 20 20 20 6f a +cryptsu. o
21d0: 75 74 62 75 66 20 31 2b 20 63 40 20 63 3a 65 6e utbuf 1+ c@ c:en
21e0: 63 72 79 70 74 2b 61 75 74 68 20 2b 65 6e 63 20 crypt+auth +enc
21f0: 3b 0a 0a 3a 20 69 6e 62 75 66 2d 64 65 63 72 79 ;..: inbuf-decry
2200: 70 74 20 28 20 6d 61 70 20 2d 2d 20 66 6c 61 67 pt ( map -- flag
2210: 20 29 20 2b 63 61 6c 63 0a 20 20 20 20 2e 6d 61 ) +calc. .ma
2220: 70 63 3a 69 76 73 3e 73 6f 75 72 63 65 3f 20 69 pc:ivs>source? i
2230: 6e 62 75 66 20 70 61 63 6b 65 74 2d 64 61 74 61 nbuf packet-data
2240: 20 2b 63 72 79 70 74 73 75 0a 20 20 20 20 69 6e +cryptsu. in
2250: 62 75 66 20 31 2b 20 63 40 20 63 3a 64 65 63 72 buf 1+ c@ c:decr
2260: 79 70 74 2b 61 75 74 68 20 2b 65 6e 63 20 3b 0a ypt+auth +enc ;.
2270: 0a 3a 20 73 65 74 2d 30 6b 65 79 20 28 20 74 77 .: set-0key ( tw
2280: 65 61 6b 31 32 38 20 6b 65 79 61 64 64 72 20 75 eak128 keyaddr u
2290: 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 30 3d -- ). dup 0=
22a0: 20 49 46 20 20 32 64 72 6f 70 20 6e 6f 2d 6b 65 IF 2drop no-ke
22b0: 79 20 73 74 61 74 65 23 20 20 54 48 45 4e 0a 20 y state# THEN.
22c0: 20 20 20 63 6d 64 30 28 20 2e 22 20 30 6b 65 79 cmd0( ." 0key
22d0: 3a 20 22 20 32 64 75 70 20 38 35 74 79 70 65 20 : " 2dup 85type
22e0: 63 72 20 29 0a 20 20 20 20 63 3a 74 77 65 61 6b cr ). c:tweak
22f0: 6b 65 79 21 20 3b 0a 0a 3a 20 74 72 79 2d 30 64 key! ;..: try-0d
2300: 65 63 72 79 70 74 20 28 20 61 64 64 72 20 2d 2d ecrypt ( addr --
2310: 20 66 6c 61 67 20 29 20 3e 72 0a 20 20 20 20 69 flag ) >r. i
2320: 6e 62 75 66 20 6d 61 70 61 64 64 72 20 6c 65 2d nbuf mapaddr le-
2330: 36 34 40 20 69 6e 62 75 66 20 68 64 72 66 6c 61 64@ inbuf hdrfla
2340: 67 73 20 6c 65 2d 75 77 40 20 61 64 64 72 3e 61 gs le-uw@ addr>a
2350: 73 73 65 6d 62 6c 79 0a 20 20 20 20 72 3e 20 73 ssembly. r> s
2360: 65 63 40 20 73 65 74 2d 30 6b 65 79 0a 20 20 20 ec@ set-0key.
2370: 20 69 6e 62 75 66 20 70 61 63 6b 65 74 2d 64 61 inbuf packet-da
2380: 74 61 20 74 6d 70 62 75 66 20 73 77 61 70 20 32 ta tmpbuf swap 2
2390: 64 75 70 20 32 3e 72 20 24 31 30 20 2b 20 6d 6f dup 2>r $10 + mo
23a0: 76 65 0a 20 20 20 20 32 72 3e 20 2b 63 72 79 70 ve. 2r> +cryp
23b0: 74 73 75 0a 20 20 20 20 69 6e 62 75 66 20 31 2b tsu. inbuf 1+
23c0: 20 63 40 20 63 3a 64 65 63 72 79 70 74 2b 61 75 c@ c:decrypt+au
23d0: 74 68 20 2b 65 6e 63 0a 20 20 20 20 64 75 70 20 th +enc. dup
23e0: 49 46 20 20 74 6d 70 62 75 66 20 69 6e 62 75 66 IF tmpbuf inbuf
23f0: 20 70 61 63 6b 65 74 2d 64 61 74 61 20 6d 6f 76 packet-data mov
2400: 65 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 69 6e 62 e THEN ;..: inb
2410: 75 66 30 2d 64 65 63 72 79 70 74 20 28 20 2d 2d uf0-decrypt ( --
2420: 20 66 6c 61 67 20 29 20 2b 63 61 6c 63 0a 20 20 flag ) +calc.
2430: 20 20 6d 79 2d 30 6b 65 79 20 74 72 79 2d 30 64 my-0key try-0d
2440: 65 63 72 79 70 74 20 3b 0a 0a 3a 20 6f 75 74 62 ecrypt ;..: outb
2450: 75 66 30 2d 65 6e 63 72 79 70 74 20 28 20 2d 2d uf0-encrypt ( --
2460: 20 29 20 2b 63 61 6c 63 0a 20 20 20 20 6f 75 74 ) +calc. out
2470: 62 75 66 20 6d 61 70 61 64 64 72 20 6c 65 2d 36 buf mapaddr le-6
2480: 34 40 20 6f 75 74 62 75 66 20 68 64 72 66 6c 61 4@ outbuf hdrfla
2490: 67 73 20 6c 65 2d 75 77 40 20 61 64 64 72 3e 61 gs le-uw@ addr>a
24a0: 73 73 65 6d 62 6c 79 0a 20 20 20 20 79 6f 75 72 ssembly. your
24b0: 2d 30 6b 65 79 20 20 73 65 74 2d 30 6b 65 79 0a -0key set-0key.
24c0: 20 20 20 20 6f 75 74 62 75 66 20 70 61 63 6b 65 outbuf packe
24d0: 74 2d 64 61 74 61 20 2b 63 72 79 70 74 73 75 0a t-data +cryptsu.
24e0: 20 20 20 20 6f 75 74 62 75 66 20 31 2b 20 63 40 outbuf 1+ c@
24f0: 20 63 3a 65 6e 63 72 79 70 74 2b 61 75 74 68 20 c:encrypt+auth
2500: 2b 65 6e 63 20 3b 0a 0a 5c 20 49 56 53 0a 0a 53 +enc ;..\ IVS..S
2510: 65 6d 61 20 72 65 67 65 6e 2d 73 65 6d 61 0a 0a ema regen-sema..
2520: 3a 20 6b 65 79 70 61 64 24 20 28 20 2d 2d 20 61 : keypad$ ( -- a
2530: 64 64 72 20 75 20 29 0a 20 20 20 20 64 6f 2d 6b ddr u ). do-k
2540: 65 79 70 61 64 20 73 65 63 40 20 64 75 70 20 30 eypad sec@ dup 0
2550: 3d 20 49 46 20 20 32 64 72 6f 70 20 20 63 72 79 = IF 2drop cry
2560: 70 74 6f 2d 6b 65 79 20 73 65 63 40 20 20 54 48 pto-key sec@ TH
2570: 45 4e 20 3b 0a 0a 3a 20 3e 63 72 79 70 74 2d 6b EN ;..: >crypt-k
2580: 65 79 2d 69 76 73 20 28 20 2d 2d 20 29 0a 20 20 ey-ivs ( -- ).
2590: 20 20 6f 20 30 3d 20 49 46 20 20 6e 6f 2d 6b 65 o 0= IF no-ke
25a0: 79 20 73 74 61 74 65 23 20 20 45 4c 53 45 20 20 y state# ELSE
25b0: 6b 65 79 70 61 64 24 20 20 54 48 45 4e 0a 20 20 keypad$ THEN.
25c0: 20 20 63 72 79 70 74 28 20 2e 22 20 69 76 73 20 crypt( ." ivs
25d0: 6b 65 79 3a 20 22 20 32 64 75 70 20 2e 6e 6e 62 key: " 2dup .nnb
25e0: 20 63 72 20 29 0a 20 20 20 20 3e 63 72 79 70 74 cr ). >crypt
25f0: 2d 6b 65 79 20 3b 0a 0a 73 63 6f 70 65 7b 20 6d -key ;..scope{ m
2600: 61 70 63 0a 0a 3a 20 72 65 67 65 6e 2d 69 76 73 apc..: regen-ivs
2610: 2f 32 20 28 20 2d 2d 20 29 0a 20 20 20 20 5b 3a /2 ( -- ). [:
2620: 20 63 3a 6b 65 79 40 20 3e 72 0a 09 64 65 73 74 c:key@ >r..dest
2630: 2d 69 76 73 67 65 6e 20 6b 61 6c 69 67 6e 20 72 -ivsgen kalign r
2640: 65 70 6c 79 28 20 2e 22 20 72 65 67 65 6e 2d 69 eply( ." regen-i
2650: 76 73 2f 32 20 22 20 64 75 70 20 63 3a 6b 65 79 vs/2 " dup c:key
2660: 23 20 2e 6e 6e 62 20 63 72 20 29 20 63 3a 6b 65 # .nnb cr ) c:ke
2670: 79 21 0a 09 63 6c 65 61 72 2d 72 65 70 6c 69 65 y!..clear-replie
2680: 73 0a 09 64 65 73 74 2d 69 76 73 24 20 64 65 73 s..dest-ivs$ des
2690: 74 2d 61 2f 62 20 63 3a 70 72 6e 67 20 69 76 73 t-a/b c:prng ivs
26a0: 28 20 2e 22 20 52 65 67 65 6e 20 41 2f 42 20 49 ( ." Regen A/B I
26b0: 56 53 22 20 63 72 20 29 0a 09 32 20 61 64 64 72 VS" cr )..2 addr
26c0: 20 64 65 73 74 2d 69 76 73 6c 61 73 74 67 65 6e dest-ivslastgen
26d0: 20 78 6f 72 63 21 20 72 3e 20 63 3a 6b 65 79 21 xorc! r> c:key!
26e0: 20 3b 5d 0a 20 20 20 20 72 65 67 65 6e 2d 73 65 ;]. regen-se
26f0: 6d 61 20 63 2d 73 65 63 74 69 6f 6e 20 20 3b 0a ma c-section ;.
2700: 0a 3a 20 72 65 67 65 6e 2d 69 76 73 2d 61 6c 6c .: regen-ivs-all
2710: 20 28 20 6f 3a 6d 61 70 20 2d 2d 20 29 20 5b 3a ( o:map -- ) [:
2720: 20 63 3a 6b 65 79 40 20 3e 72 0a 20 20 20 20 20 c:key@ >r.
2730: 20 64 65 73 74 2d 69 76 73 67 65 6e 20 6b 61 6c dest-ivsgen kal
2740: 69 67 6e 20 6b 65 79 28 20 2e 22 20 72 65 67 65 ign key( ." rege
2750: 6e 2d 69 76 73 20 22 20 64 75 70 20 63 3a 6b 65 n-ivs " dup c:ke
2760: 79 23 20 2e 6e 6e 62 20 63 72 20 29 20 63 3a 6b y# .nnb cr ) c:k
2770: 65 79 21 0a 20 20 20 20 20 20 64 65 73 74 2d 69 ey!. dest-i
2780: 76 73 24 20 63 3a 70 72 6e 67 20 69 76 73 28 20 vs$ c:prng ivs(
2790: 2e 22 20 52 65 67 65 6e 20 61 6c 6c 20 49 56 53 ." Regen all IVS
27a0: 22 20 63 72 20 29 0a 20 20 20 20 20 20 72 3e 20 " cr ). r>
27b0: 63 3a 6b 65 79 21 20 3b 5d 0a 20 20 20 20 72 65 c:key! ;]. re
27c0: 67 65 6e 2d 73 65 6d 61 20 63 2d 73 65 63 74 69 gen-sema c-secti
27d0: 6f 6e 20 3b 0a 0a 3a 20 72 65 73 74 2b 20 28 20 on ;..: rest+ (
27e0: 61 64 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 addr u -- addr u
27f0: 20 29 0a 20 20 20 20 61 64 64 72 20 64 65 73 74 ). addr dest
2800: 2d 69 76 73 72 65 73 74 24 20 24 40 6c 65 6e 20 -ivsrest$ $@len
2810: 49 46 0a 09 32 64 75 70 20 64 65 73 74 2d 69 76 IF..2dup dest-iv
2820: 73 72 65 73 74 24 20 72 6f 74 20 75 6d 69 6e 20 srest$ rot umin
2830: 3e 72 20 73 77 61 70 20 72 40 20 6d 6f 76 65 0a >r swap r@ move.
2840: 09 72 40 20 73 61 66 65 2f 73 74 72 69 6e 67 0a .r@ safe/string.
2850: 09 61 64 64 72 20 64 65 73 74 2d 69 76 73 72 65 .addr dest-ivsre
2860: 73 74 24 20 30 20 72 3e 20 24 64 65 6c 0a 20 20 st$ 0 r> $del.
2870: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 72 65 73 74 THEN ;..: rest
2880: 2d 70 72 6e 67 20 28 20 61 64 64 72 20 75 20 2d -prng ( addr u -
2890: 2d 20 29 0a 20 20 20 20 72 65 73 74 2b 0a 20 20 - ). rest+.
28a0: 20 20 32 64 75 70 20 64 75 70 20 6b 65 63 63 61 2dup dup kecca
28b0: 6b 23 6d 61 78 20 6e 65 67 61 74 65 20 61 6e 64 k#max negate and
28c0: 20 73 61 66 65 2f 73 74 72 69 6e 67 20 32 3e 72 safe/string 2>r
28d0: 0a 20 20 20 20 6b 65 63 63 61 6b 23 6d 61 78 20 . keccak#max
28e0: 6e 65 67 61 74 65 20 61 6e 64 20 63 3a 70 72 6e negate and c:prn
28f0: 67 0a 20 20 20 20 32 72 3e 20 64 75 70 20 49 46 g. 2r> dup IF
2900: 0a 09 6b 65 63 63 61 6b 23 6d 61 78 20 61 64 64 ..keccak#max add
2910: 72 20 64 65 73 74 2d 69 76 73 72 65 73 74 24 20 r dest-ivsrest$
2920: 24 21 6c 65 6e 20 20 64 65 73 74 2d 69 76 73 72 $!len dest-ivsr
2930: 65 73 74 24 20 63 3a 70 72 6e 67 0a 09 72 65 73 est$ c:prng..res
2940: 74 2b 0a 20 20 20 20 54 48 45 4e 20 20 32 64 72 t+. THEN 2dr
2950: 6f 70 20 3b 0a 0a 3a 20 72 65 67 65 6e 2d 69 76 op ;..: regen-iv
2960: 73 2d 70 61 72 74 20 28 20 6f 6c 64 2d 62 61 63 s-part ( old-bac
2970: 6b 20 6e 65 77 2d 62 61 63 6b 20 2d 2d 20 29 0a k new-back -- ).
2980: 20 20 20 20 5b 3a 20 63 3a 6b 65 79 40 20 3e 72 [: c:key@ >r
2990: 0a 20 20 20 20 20 20 64 65 73 74 2d 69 76 73 67 . dest-ivsg
29a0: 65 6e 20 6b 61 6c 69 67 6e 0a 20 20 20 20 20 20 en kalign.
29b0: 72 65 67 65 6e 28 20 2e 22 20 72 65 67 65 6e 2d regen( ." regen-
29c0: 69 76 73 2d 70 61 72 74 20 22 20 32 20 70 69 63 ivs-part " 2 pic
29d0: 6b 20 68 65 78 2e 20 6f 76 65 72 20 68 65 78 2e k hex. over hex.
29e0: 20 64 75 70 20 63 3a 6b 65 79 23 20 2e 6e 6e 62 dup c:key# .nnb
29f0: 20 63 72 20 29 0a 20 20 20 20 20 20 63 3a 6b 65 cr ). c:ke
2a00: 79 21 0a 20 20 20 20 20 20 73 77 61 70 20 55 2b y!. swap U+
2a10: 44 4f 0a 09 20 20 49 20 49 27 20 66 69 78 2d 73 DO.. I I' fix-s
2a20: 69 7a 65 20 64 75 70 20 7b 20 6c 65 6e 20 7d 0a ize dup { len }.
2a30: 09 20 20 61 64 64 72 3e 6b 65 79 73 20 3e 72 20 . addr>keys >r
2a40: 61 64 64 72 3e 6b 65 79 73 20 3e 72 20 64 65 73 addr>keys >r des
2a50: 74 2d 69 76 73 24 20 72 3e 20 73 61 66 65 2f 73 t-ivs$ r> safe/s
2a60: 74 72 69 6e 67 20 72 3e 20 75 6d 69 6e 0a 09 20 tring r> umin..
2a70: 20 72 65 73 74 2d 70 72 6e 67 0a 20 20 20 20 20 rest-prng.
2a80: 20 6c 65 6e 20 2b 4c 4f 4f 50 0a 20 20 20 20 20 len +LOOP.
2a90: 20 72 65 67 65 6e 28 20 2e 22 20 72 65 67 65 6e regen( ." regen
2aa0: 2d 69 76 73 2d 70 61 72 74 27 20 22 20 64 65 73 -ivs-part' " des
2ab0: 74 2d 69 76 73 67 65 6e 20 6b 61 6c 69 67 6e 20 t-ivsgen kalign
2ac0: 63 3a 6b 65 79 23 20 2e 6e 6e 62 20 63 72 20 29 c:key# .nnb cr )
2ad0: 0a 20 20 20 20 20 20 72 3e 20 63 3a 6b 65 79 21 . r> c:key!
2ae0: 20 3b 5d 20 72 65 67 65 6e 2d 73 65 6d 61 20 63 ;] regen-sema c
2af0: 2d 73 65 63 74 69 6f 6e 20 3b 0a 0a 3a 20 28 72 -section ;..: (r
2b00: 65 67 65 6e 2d 69 76 73 29 20 28 20 6f 66 66 73 egen-ivs) ( offs
2b10: 65 74 20 6f 3a 6d 61 70 20 2d 2d 20 29 0a 20 20 et o:map -- ).
2b20: 20 20 61 64 64 72 20 64 65 73 74 2d 69 76 73 24 addr dest-ivs$
2b30: 20 24 40 6c 65 6e 20 32 2f 20 32 2f 20 2f 20 64 $@len 2/ 2/ / d
2b40: 65 73 74 2d 69 76 73 6c 61 73 74 67 65 6e 20 3d est-ivslastgen =
2b50: 0a 20 20 20 20 49 46 09 74 77 65 61 6b 28 20 2e . IF.tweak( .
2b60: 22 20 72 65 67 65 6e 2d 69 76 73 2f 32 22 20 63 " regen-ivs/2" c
2b70: 72 20 29 20 72 65 67 65 6e 2d 69 76 73 2f 32 20 r ) regen-ivs/2
2b80: 20 54 48 45 4e 20 3b 0a 27 20 28 72 65 67 65 6e THEN ;.' (regen
2b90: 2d 69 76 73 29 20 63 6f 64 65 2d 63 6c 61 73 73 -ivs) code-class
2ba0: 20 74 6f 20 72 65 67 65 6e 2d 69 76 73 0a 27 20 to regen-ivs.'
2bb0: 28 72 65 67 65 6e 2d 69 76 73 29 20 72 63 6f 64 (regen-ivs) rcod
2bc0: 65 2d 63 6c 61 73 73 20 74 6f 20 72 65 67 65 6e e-class to regen
2bd0: 2d 69 76 73 0a 0a 7d 73 63 6f 70 65 0a 0a 3a 20 -ivs..}scope..:
2be0: 6f 6e 65 2d 69 76 73 20 28 20 6d 61 70 2d 61 64 one-ivs ( map-ad
2bf0: 64 72 20 2d 2d 20 29 0a 20 20 20 20 77 69 74 68 dr -- ). with
2c00: 20 6d 61 70 63 20 63 3a 6b 65 79 40 20 3e 72 0a mapc c:key@ >r.
2c10: 20 20 20 20 6b 65 79 2d 61 73 73 65 6d 62 6c 79 key-assembly
2c20: 20 73 74 61 74 65 32 23 20 63 3a 70 72 6e 67 0a state2# c:prng.
2c30: 20 20 20 20 64 65 73 74 2d 69 76 73 67 65 6e 20 dest-ivsgen
2c40: 6b 61 6c 69 67 6e 20 63 3a 6b 65 79 21 20 20 6b kalign c:key! k
2c50: 65 79 2d 61 73 73 65 6d 62 6c 79 20 3e 63 3a 6b ey-assembly >c:k
2c60: 65 79 0a 20 20 20 20 64 65 73 74 2d 73 69 7a 65 ey. dest-size
2c70: 20 61 64 64 72 3e 6b 65 79 73 20 61 64 64 72 20 addr>keys addr
2c80: 64 65 73 74 2d 69 76 73 24 20 24 21 6c 65 6e 0a dest-ivs$ $!len.
2c90: 20 20 20 20 64 65 73 74 2d 69 76 73 24 20 63 3a dest-ivs$ c:
2ca0: 70 72 6e 67 20 69 76 73 28 20 2e 22 20 52 65 67 prng ivs( ." Reg
2cb0: 65 6e 20 6f 6e 65 20 49 56 53 22 20 63 72 20 29 en one IVS" cr )
2cc0: 0a 20 20 20 20 72 3e 20 63 3a 6b 65 79 21 20 65 . r> c:key! e
2cd0: 6e 64 77 69 74 68 20 3b 0a 0a 3a 20 63 6c 65 61 ndwith ;..: clea
2ce0: 72 2d 6b 65 79 73 20 28 20 2d 2d 20 29 0a 20 20 r-keys ( -- ).
2cf0: 20 20 63 72 79 70 74 6f 2d 6b 65 79 20 73 65 63 crypto-key sec
2d00: 2d 66 72 65 65 20 20 74 73 6b 63 20 4b 45 59 42 -free tskc KEYB
2d10: 59 54 45 53 20 65 72 61 73 65 20 20 73 74 73 6b YTES erase stsk
2d20: 63 20 4b 45 59 42 59 54 45 53 20 65 72 61 73 65 c KEYBYTES erase
2d30: 0a 20 20 20 20 74 72 75 65 20 74 6f 20 6b 65 79 . true to key
2d40: 2d 73 65 74 75 70 3f 20 3b 0a 0a 5c 20 57 65 20 -setup? ;..\ We
2d50: 67 65 6e 65 72 61 74 65 20 61 20 73 68 61 72 65 generate a share
2d60: 64 20 73 65 63 72 65 74 20 6f 75 74 20 6f 66 20 d secret out of
2d70: 74 68 72 65 65 20 70 61 72 74 73 3a 0a 5c 20 36 three parts:.\ 6
2d80: 34 20 62 79 74 65 73 20 49 56 2c 20 33 32 20 62 4 bytes IV, 32 b
2d90: 79 74 65 73 20 66 72 6f 6d 20 74 68 65 20 6f 6e ytes from the on
2da0: 65 2d 74 69 6d 65 2d 6b 65 79 73 20 61 6e 64 0a e-time-keys and.
2db0: 5c 20 33 32 20 62 79 74 65 73 20 66 72 6f 6d 20 \ 32 bytes from
2dc0: 74 68 65 20 70 65 72 6d 61 6e 65 6e 74 20 6b 65 the permanent ke
2dd0: 79 73 0a 0a 24 36 30 20 43 6f 6e 73 74 61 6e 74 ys..$60 Constant
2de0: 20 72 6e 64 6b 65 79 23 0a 0a 3a 20 70 75 6e 63 rndkey#..: punc
2df0: 68 23 21 20 28 20 2d 2d 20 29 0a 20 20 20 20 5c h#! ( -- ). \
2e00: 67 20 67 65 6e 65 72 61 74 65 20 61 20 73 68 61 g generate a sha
2e10: 72 65 64 20 73 65 63 72 65 74 20 66 6f 72 20 70 red secret for p
2e20: 75 6e 63 68 69 6e 67 20 4e 41 54 20 68 6f 6c 65 unching NAT hole
2e30: 73 0a 20 20 20 20 70 75 6e 63 68 23 20 24 32 30 s. punch# $20
2e40: 20 63 3a 70 72 6e 67 20 3b 0a 3a 20 72 65 63 65 c:prng ;.: rece
2e50: 69 76 65 2d 69 76 73 20 28 20 2d 2d 20 29 0a 20 ive-ivs ( -- ).
2e60: 20 20 20 67 65 6e 6b 65 79 28 20 2e 22 20 69 76 genkey( ." iv
2e70: 73 20 6b 65 79 3a 20 22 20 6b 65 79 3e 64 75 6d s key: " key>dum
2e80: 70 20 6f 76 65 72 20 72 6e 64 6b 65 79 23 20 78 p over rndkey# x
2e90: 74 79 70 65 20 63 72 0a 20 20 20 20 20 20 20 20 type cr.
2ea0: 20 20 20 20 2e 22 20 63 6f 6e 20 6b 65 79 3a 20 ." con key:
2eb0: 22 20 72 6e 64 6b 65 79 23 20 2f 73 74 72 69 6e " rndkey# /strin
2ec0: 67 20 78 74 79 70 65 20 63 72 20 29 0a 20 20 20 g xtype cr ).
2ed0: 20 69 76 73 28 20 2e 22 20 72 65 67 65 6e 20 72 ivs( ." regen r
2ee0: 65 63 65 69 76 65 20 49 56 53 22 20 63 72 20 29 eceive IVS" cr )
2ef0: 0a 20 20 20 20 63 6f 64 65 2d 6d 61 70 20 6f 6e . code-map on
2f00: 65 2d 69 76 73 20 20 20 63 6f 64 65 2d 72 6d 61 e-ivs code-rma
2f10: 70 20 6f 6e 65 2d 69 76 73 0a 20 20 20 20 64 61 p one-ivs. da
2f20: 74 61 2d 6d 61 70 20 6f 6e 65 2d 69 76 73 20 20 ta-map one-ivs
2f30: 20 64 61 74 61 2d 72 6d 61 70 20 6f 6e 65 2d 69 data-rmap one-i
2f40: 76 73 0a 20 20 20 20 70 75 6e 63 68 23 21 20 63 vs. punch#! c
2f50: 6c 65 61 72 2d 6b 65 79 73 20 3b 0a 0a 3a 20 73 lear-keys ;..: s
2f60: 65 6e 64 2d 69 76 73 20 28 20 2d 2d 20 29 0a 20 end-ivs ( -- ).
2f70: 20 20 20 67 65 6e 6b 65 79 28 20 2e 22 20 69 76 genkey( ." iv
2f80: 73 20 6b 65 79 3a 20 22 20 6b 65 79 3e 64 75 6d s key: " key>dum
2f90: 70 20 6f 76 65 72 20 72 6e 64 6b 65 79 23 20 78 p over rndkey# x
2fa0: 74 79 70 65 20 63 72 0a 20 20 20 20 20 20 20 20 type cr.
2fb0: 20 20 20 20 2e 22 20 63 6f 6e 20 6b 65 79 3a 20 ." con key:
2fc0: 22 20 72 6e 64 6b 65 79 23 20 2f 73 74 72 69 6e " rndkey# /strin
2fd0: 67 20 78 74 79 70 65 20 63 72 20 29 0a 20 20 20 g xtype cr ).
2fe0: 20 69 76 73 28 20 2e 22 20 72 65 67 65 6e 20 73 ivs( ." regen s
2ff0: 65 6e 64 20 49 56 53 22 20 63 72 20 29 0a 20 20 end IVS" cr ).
3000: 20 20 63 6f 64 65 2d 72 6d 61 70 20 6f 6e 65 2d code-rmap one-
3010: 69 76 73 20 20 63 6f 64 65 2d 6d 61 70 20 6f 6e ivs code-map on
3020: 65 2d 69 76 73 0a 20 20 20 20 64 61 74 61 2d 72 e-ivs. data-r
3030: 6d 61 70 20 6f 6e 65 2d 69 76 73 20 20 64 61 74 map one-ivs dat
3040: 61 2d 6d 61 70 20 6f 6e 65 2d 69 76 73 0a 20 20 a-map one-ivs.
3050: 20 20 70 75 6e 63 68 23 21 20 63 6c 65 61 72 2d punch#! clear-
3060: 6b 65 79 73 20 3b 0a 0a 3a 20 69 76 73 2d 73 74 keys ;..: ivs-st
3070: 72 69 6e 67 73 20 28 20 61 64 64 72 20 75 20 2d rings ( addr u -
3080: 2d 20 29 0a 20 20 20 20 6b 65 79 2d 73 65 74 75 - ). key-setu
3090: 70 3f 20 21 21 64 6f 75 62 6c 65 6b 65 79 21 21 p? !!doublekey!!
30a0: 0a 20 20 20 20 64 75 70 20 73 74 61 74 65 23 20 . dup state#
30b0: 3c 3e 20 21 21 69 76 73 21 21 20 3e 63 72 79 70 <> !!ivs!! >cryp
30c0: 74 2d 73 6f 75 72 63 65 20 3e 63 72 79 70 74 2d t-source >crypt-
30d0: 6b 65 79 2d 69 76 73 20 3b 0a 0a 5c 20 68 61 73 key-ivs ;..\ has
30e0: 68 20 77 69 74 68 20 6b 65 79 20 61 6e 64 20 73 h with key and s
30f0: 6b 73 69 67 20 67 65 6e 65 72 61 74 69 6f 6e 0a ksig generation.
3100: 0a 3a 20 3e 6b 65 79 65 64 2d 68 61 73 68 20 28 .: >keyed-hash (
3110: 20 76 61 6c 61 64 64 72 20 75 76 61 6c 20 6b 65 valaddr uval ke
3120: 79 61 64 64 72 20 75 6b 65 79 20 2d 2d 20 29 0a yaddr ukey -- ).
3130: 20 20 20 20 5c 67 20 67 65 6e 65 72 61 74 65 20 \g generate
3140: 61 20 6b 65 79 65 64 20 68 61 73 68 3a 20 6b 65 a keyed hash: ke
3150: 79 61 64 64 72 20 75 6b 65 79 20 69 73 20 74 68 yaddr ukey is th
3160: 65 20 6b 65 79 20 66 6f 72 20 68 61 73 69 6e 67 e key for hasing
3170: 20 76 61 6c 61 64 64 72 20 75 76 61 6c 0a 20 20 valaddr uval.
3180: 20 20 5c 20 68 61 73 68 28 20 2e 22 20 68 61 73 \ hash( ." has
3190: 68 69 6e 67 3a 20 22 20 32 6f 76 65 72 20 38 35 hing: " 2over 85
31a0: 74 79 70 65 20 27 3a 27 20 65 6d 69 74 20 32 64 type ':' emit 2d
31b0: 75 70 20 38 35 74 79 70 65 20 63 72 20 29 0a 20 up 85type cr ).
31c0: 20 20 20 63 3a 68 61 73 68 20 63 3a 68 61 73 68 c:hash c:hash
31d0: 0a 20 20 20 20 5c 20 68 61 73 68 28 20 40 6b 65 . \ hash( @ke
31e0: 63 63 61 6b 20 32 30 30 20 38 35 74 79 70 65 20 ccak 200 85type
31f0: 63 72 20 63 72 20 29 20 5c 20 64 65 62 75 67 67 cr cr ) \ debugg
3200: 69 6e 67 20 6d 61 79 20 6c 65 61 6b 20 73 65 63 ing may leak sec
3210: 72 65 74 73 21 0a 3b 0a 0a 5c 20 70 75 62 6c 69 rets!.;..\ publi
3220: 63 20 6b 65 79 20 65 6e 63 72 79 70 74 69 6f 6e c key encryption
3230: 0a 0a 5c 20 74 68 65 20 74 68 65 6f 72 79 20 68 ..\ the theory h
3240: 65 72 65 20 69 73 20 74 68 61 74 20 70 6b 63 2a ere is that pkc*
3250: 73 6b 73 20 3d 20 70 6b 73 2a 73 6b 63 0a 5c 20 sks = pks*skc.\
3260: 62 65 63 61 75 73 65 20 70 6b 3d 62 61 73 65 2a because pk=base*
3270: 73 6b 2c 20 73 6f 20 62 61 73 65 2a 73 6b 63 2a sk, so base*skc*
3280: 73 6b 73 20 3d 20 62 61 73 65 2a 73 6b 73 2a 73 sks = base*sks*s
3290: 6b 63 0a 5c 20 62 61 73 65 20 61 6e 64 20 70 6b kc.\ base and pk
32a0: 20 61 72 65 20 70 6f 69 6e 74 73 20 6f 6e 20 74 are points on t
32b0: 68 65 20 63 75 72 76 65 2c 20 73 6b 20 69 73 20 he curve, sk is
32c0: 61 20 73 6b 61 6c 61 72 0a 5c 20 77 65 20 73 65 a skalar.\ we se
32d0: 6e 64 20 6f 75 72 20 70 75 62 6c 69 63 20 6b 65 nd our public ke
32e0: 79 20 61 6e 64 20 71 75 65 72 79 20 74 68 65 20 y and query the
32f0: 73 65 72 76 65 72 27 73 20 70 75 62 6c 69 63 20 server's public
3300: 6b 65 79 2e 0a 0a 3a 20 67 65 6e 2d 6b 65 79 73 key...: gen-keys
3310: 20 28 20 2d 2d 20 29 0a 20 20 20 20 5c 67 20 67 ( -- ). \g g
3320: 65 6e 65 72 61 74 65 20 72 65 76 6f 63 61 62 6c enerate revocabl
3330: 65 20 6b 65 79 70 61 69 72 0a 20 20 20 20 73 6b e keypair. sk
3340: 31 20 70 6b 31 20 65 64 2d 6b 65 79 70 61 69 72 1 pk1 ed-keypair
3350: 20 5c 20 67 65 6e 65 72 61 74 65 20 66 69 72 73 \ generate firs
3360: 74 20 6b 65 79 70 61 69 72 0a 20 20 20 20 73 6b t keypair. sk
3370: 72 65 76 20 70 6b 72 65 76 20 65 64 2d 6b 65 79 rev pkrev ed-key
3380: 70 61 69 72 20 5c 20 67 65 6e 65 72 61 74 65 20 pair \ generate
3390: 6b 65 79 70 61 69 72 20 66 6f 72 20 72 65 63 6f keypair for reco
33a0: 76 65 72 79 0a 20 20 20 20 73 6b 31 20 70 6b 72 very. sk1 pkr
33b0: 65 76 20 73 6b 63 20 70 6b 63 20 65 64 2d 6b 65 ev skc pkc ed-ke
33c0: 79 70 61 69 72 78 20 5c 20 67 65 6e 65 72 61 74 ypairx \ generat
33d0: 65 20 72 65 61 6c 20 6b 65 79 70 61 69 72 0a 20 e real keypair.
33e0: 20 20 20 67 65 6e 6b 65 79 28 20 2e 22 20 67 65 genkey( ." ge
33f0: 6e 20 6b 65 79 3a 20 22 20 73 6b 63 20 6b 65 79 n key: " skc key
3400: 73 69 7a 65 20 2e 38 35 77 61 72 6e 20 70 6b 63 size .85warn pkc
3410: 20 6b 65 79 73 69 7a 65 20 2e 38 35 69 6e 66 6f keysize .85info
3420: 20 63 72 20 29 0a 3b 0a 3a 20 63 68 65 63 6b 2d cr ).;.: check-
3430: 72 65 76 3f 20 28 20 70 6b 20 2d 2d 20 66 6c 61 rev? ( pk -- fla
3440: 67 20 29 0a 20 20 20 20 5c 67 20 63 68 65 63 6b g ). \g check
3450: 20 67 65 6e 65 72 61 74 65 64 20 6b 65 79 20 69 generated key i
3460: 66 20 72 65 76 6f 63 61 74 69 6f 6e 20 69 73 20 f revocation is
3470: 70 6f 73 73 69 62 6c 65 0a 20 20 20 20 3e 72 20 possible. >r
3480: 73 6b 72 65 76 20 70 6b 72 65 76 20 73 6b 3e 70 skrev pkrev sk>p
3490: 6b 20 70 6b 72 65 76 20 64 75 70 20 73 6b 2d 6d k pkrev dup sk-m
34a0: 61 73 6b 0a 20 20 20 20 72 40 20 6b 65 79 73 69 ask. r@ keysi
34b0: 7a 65 20 2b 20 6b 65 79 70 61 64 20 65 64 2d 64 ze + keypad ed-d
34c0: 68 20 72 3e 20 6b 65 79 73 69 7a 65 20 73 74 72 h r> keysize str
34d0: 3d 20 3b 0a 3a 20 67 65 6e 2d 74 6d 70 6b 65 79 = ;.: gen-tmpkey
34e0: 73 20 28 20 2d 2d 20 29 20 74 73 6b 63 20 74 70 s ( -- ) tskc tp
34f0: 6b 63 20 65 64 2d 6b 65 79 70 61 69 72 0a 20 20 kc ed-keypair.
3500: 20 20 67 65 6e 6b 65 79 28 20 2e 22 20 74 6d 70 genkey( ." tmp
3510: 20 6b 65 79 3a 20 22 20 74 73 6b 63 20 6b 65 79 key: " tskc key
3520: 73 69 7a 65 20 2e 38 35 77 61 72 6e 20 74 70 6b size .85warn tpk
3530: 63 20 6b 65 79 73 69 7a 65 20 2e 38 35 69 6e 66 c keysize .85inf
3540: 6f 20 63 72 20 29 20 3b 0a 3a 20 67 65 6e 2d 73 o cr ) ;.: gen-s
3550: 74 6b 65 79 73 20 28 20 2d 2d 20 29 20 73 74 73 tkeys ( -- ) sts
3560: 6b 63 20 73 74 70 6b 63 20 65 64 2d 6b 65 79 70 kc stpkc ed-keyp
3570: 61 69 72 0a 20 20 20 20 67 65 6e 6b 65 79 28 20 air. genkey(
3580: 2e 22 20 74 6d 70 73 6b 65 79 3a 20 22 20 73 74 ." tmpskey: " st
3590: 73 6b 63 20 6b 65 79 73 69 7a 65 20 2e 38 35 77 skc keysize .85w
35a0: 61 72 6e 20 73 74 70 6b 63 20 6b 65 79 73 69 7a arn stpkc keysiz
35b0: 65 20 2e 38 35 69 6e 66 6f 20 63 72 20 29 20 3b e .85info cr ) ;
35c0: 0a 0a 5c 20 65 6e 63 72 79 70 74 20 66 6f 72 20 ..\ encrypt for
35d0: 6f 6e 65 20 73 69 6e 67 6c 65 20 72 65 63 65 69 one single recei
35e0: 76 65 72 0a 0a 3a 20 70 6b 2d 65 6e 63 72 79 70 ver..: pk-encryp
35f0: 74 20 28 20 61 64 64 72 20 75 20 70 6b 20 2d 2d t ( addr u pk --
3600: 20 70 6b 74 6d 70 20 29 0a 20 20 20 20 67 65 6e pktmp ). gen
3610: 2d 73 74 6b 65 79 73 0a 20 20 20 20 73 74 73 6b -stkeys. stsk
3620: 63 20 73 77 61 70 20 6b 65 79 70 61 64 20 65 64 c swap keypad ed
3630: 2d 64 68 20 32 3e 72 20 36 34 23 30 20 36 34 64 -dh 2>r 64#0 64d
3640: 75 70 20 32 72 3e 20 63 3a 74 77 65 61 6b 6b 65 up 2r> c:tweakke
3650: 79 21 0a 20 20 20 20 30 20 63 3a 65 6e 63 72 79 y!. 0 c:encry
3660: 70 74 2b 61 75 74 68 20 73 74 70 6b 63 20 3b 0a pt+auth stpkc ;.
3670: 0a 3a 20 70 6b 2d 64 65 63 72 79 70 74 20 28 20 .: pk-decrypt (
3680: 61 64 64 72 20 75 20 73 6b 20 2d 2d 20 66 6c 61 addr u sk -- fla
3690: 67 20 29 0a 20 20 20 20 3e 72 20 6f 76 65 72 20 g ). >r over
36a0: 72 3e 20 73 77 61 70 20 6b 65 79 70 61 64 20 65 r> swap keypad e
36b0: 64 2d 64 68 20 32 3e 72 20 36 34 23 30 20 36 34 d-dh 2>r 64#0 64
36c0: 64 75 70 20 32 72 3e 20 63 3a 74 77 65 61 6b 6b dup 2r> c:tweakk
36d0: 65 79 21 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 ey!. keysize
36e0: 2f 73 74 72 69 6e 67 20 30 20 63 3a 64 65 63 72 /string 0 c:decr
36f0: 79 70 74 2b 61 75 74 68 20 3b 0a 0a 5c 20 73 65 ypt+auth ;..\ se
3700: 74 74 69 6e 67 20 6f 66 20 6b 65 79 73 0a 0a 3a tting of keys..:
3710: 20 73 65 74 2d 6b 65 79 20 28 20 61 64 64 72 20 set-key ( addr
3720: 2d 2d 20 29 20 6f 20 30 3d 20 49 46 20 64 72 6f -- ) o 0= IF dro
3730: 70 20 20 2e 22 20 6b 65 79 2c 20 6e 6f 20 63 6f p ." key, no co
3740: 6e 74 65 78 74 21 22 20 63 72 20 20 45 58 49 54 ntext!" cr EXIT
3750: 20 20 54 48 45 4e 0a 20 20 20 20 6b 65 79 73 69 THEN. keysi
3760: 7a 65 20 63 72 79 70 74 6f 2d 6b 65 79 20 73 65 ze crypto-key se
3770: 63 21 0a 20 20 20 20 2e 22 20 73 65 74 20 6b 65 c!. ." set ke
3780: 79 20 74 6f 3a 22 20 6f 20 63 72 79 70 74 6f 2d y to:" o crypto-
3790: 6b 65 79 20 73 65 63 40 20 2e 6e 6e 62 20 63 72 key sec@ .nnb cr
37a0: 20 3b 0a 0a 3a 20 3f 6b 65 79 73 69 7a 65 20 28 ;..: ?keysize (
37b0: 20 75 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 73 u -- ). keys
37c0: 69 7a 65 20 3c 3e 20 21 21 6b 65 79 73 69 7a 65 ize <> !!keysize
37d0: 21 21 20 3b 0a 0a 46 6f 72 77 61 72 64 20 63 68 !! ;..Forward ch
37e0: 65 63 6b 2d 6b 65 79 20 5c 20 63 68 65 63 6b 20 eck-key \ check
37f0: 69 66 20 77 65 20 6b 6e 6f 77 20 74 68 61 74 20 if we know that
3800: 6b 65 79 0a 46 6f 72 77 61 72 64 20 73 65 61 72 key.Forward sear
3810: 63 68 2d 6b 65 79 20 5c 20 73 65 61 72 63 68 20 ch-key \ search
3820: 69 66 20 74 68 61 74 20 69 73 20 6f 6e 65 20 6f if that is one o
3830: 66 20 6f 75 72 20 70 75 62 6b 65 79 73 0a 46 6f f our pubkeys.Fo
3840: 72 77 61 72 64 20 73 65 61 72 63 68 2d 6b 65 79 rward search-key
3850: 3f 20 5c 20 73 65 61 72 63 68 20 69 66 20 74 68 ? \ search if th
3860: 61 74 20 69 73 20 6f 6e 65 20 6f 66 20 6f 75 72 at is one of our
3870: 20 70 75 62 6b 65 79 73 0a 0a 56 61 72 69 61 62 pubkeys..Variab
3880: 6c 65 20 74 6d 70 6b 65 79 73 2d 6c 73 31 36 62 le tmpkeys-ls16b
3890: 0a 24 31 30 30 30 20 56 61 6c 75 65 20 6d 61 78 .$1000 Value max
38a0: 2d 74 6d 70 6b 65 79 73 23 20 5c 20 6e 6f 20 6d -tmpkeys# \ no m
38b0: 6f 72 65 20 74 68 61 6e 20 32 35 36 20 6b 65 79 ore than 256 key
38c0: 73 20 69 6e 20 71 75 65 75 65 0a 0a 3a 20 3f 72 s in queue..: ?r
38d0: 65 70 65 61 74 2d 74 6d 70 6b 65 79 20 28 20 61 epeat-tmpkey ( a
38e0: 64 64 72 20 2d 2d 20 29 0a 20 20 20 20 74 6d 70 ddr -- ). tmp
38f0: 6b 65 79 73 2d 6c 73 31 36 62 20 24 40 6c 65 6e keys-ls16b $@len
3900: 20 6d 61 78 2d 74 6d 70 6b 65 79 73 23 20 75 3e max-tmpkeys# u>
3910: 3d 20 49 46 0a 09 74 6d 70 6b 65 79 73 2d 6c 73 = IF..tmpkeys-ls
3920: 31 36 62 20 30 20 6d 61 78 2d 74 6d 70 6b 65 79 16b 0 max-tmpkey
3930: 73 23 20 32 2f 20 24 64 65 6c 0a 20 20 20 20 54 s# 2/ $del. T
3940: 48 45 4e 0a 20 20 20 20 74 6d 70 6b 65 79 73 2d HEN. tmpkeys-
3950: 6c 73 31 36 62 20 24 40 20 62 6f 75 6e 64 73 20 ls16b $@ bounds
3960: 3f 44 4f 0a 09 64 75 70 20 49 20 24 31 30 20 74 ?DO..dup I $10 t
3970: 75 63 6b 20 73 74 72 3d 20 21 21 72 65 70 65 61 uck str= !!repea
3980: 74 65 64 2d 74 6d 70 6b 65 79 21 21 0a 20 20 20 ted-tmpkey!!.
3990: 20 24 31 30 20 2b 4c 4f 4f 50 0a 20 20 20 20 68 $10 +LOOP. h
39a0: 65 61 6c 74 68 28 20 2e 22 20 6e 6f 6e 2d 72 65 ealth( ." non-re
39b0: 70 65 61 74 65 64 20 74 6d 70 20 6b 65 79 20 22 peated tmp key "
39c0: 20 64 75 70 20 24 31 30 20 38 35 74 79 70 65 20 dup $10 85type
39d0: 63 72 20 29 0a 20 20 20 20 24 31 30 20 74 6d 70 cr ). $10 tmp
39e0: 6b 65 79 73 2d 6c 73 31 36 62 20 24 2b 21 20 3b keys-ls16b $+! ;
39f0: 20 5c 20 73 61 76 65 20 6f 6e 6c 79 20 68 61 6c \ save only hal
3a00: 66 20 6f 66 20 74 68 65 20 74 6d 70 6b 65 79 0a f of the tmpkey.
3a10: 0a 3a 20 6b 65 79 2d 73 74 61 67 65 32 20 28 20 .: key-stage2 (
3a20: 70 6b 20 73 6b 20 2d 2d 20 29 20 3e 72 0a 20 20 pk sk -- ) >r.
3a30: 20 20 6b 65 79 70 61 64 24 20 6b 65 79 73 69 7a keypad$ keysiz
3a40: 65 20 3c 3e 20 21 21 6e 6f 2d 74 6d 70 6b 65 79 e <> !!no-tmpkey
3a50: 21 21 0a 20 20 20 20 72 3e 20 72 6f 74 20 6b 65 !!. r> rot ke
3a60: 79 70 61 64 20 65 64 2d 64 68 78 20 64 6f 2d 6b ypad ed-dhx do-k
3a70: 65 79 70 61 64 20 73 65 63 2b 21 20 3b 0a 3a 20 eypad sec+! ;.:
3a80: 6b 65 79 2d 72 65 73 74 20 28 20 61 64 64 72 20 key-rest ( addr
3a90: 75 20 73 6b 20 2d 2d 20 29 20 3e 72 0a 20 20 20 u sk -- ) >r.
3aa0: 20 3f 6b 65 79 73 69 7a 65 20 64 75 70 20 6b 65 ?keysize dup ke
3ab0: 79 73 69 7a 65 20 63 68 65 63 6b 2d 6b 65 79 0a ysize check-key.
3ac0: 20 20 20 20 64 75 70 20 6b 65 79 73 69 7a 65 20 dup keysize
3ad0: 74 6d 70 2d 70 75 62 6b 65 79 20 24 21 20 72 3e tmp-pubkey $! r>
3ae0: 20 6b 65 79 2d 73 74 61 67 65 32 0a 20 20 20 20 key-stage2.
3af0: 6b 65 79 70 61 69 72 2d 76 61 6c 20 76 61 6c 69 keypair-val vali
3b00: 64 61 74 65 64 20 6f 72 21 20 3b 0a 3a 20 6e 65 dated or! ;.: ne
3b10: 74 32 6f 3a 6b 65 79 70 61 69 72 20 28 20 70 6b t2o:keypair ( pk
3b20: 63 20 75 63 20 70 6b 20 75 20 2d 2d 20 29 0a 20 c uc pk u -- ).
3b30: 20 20 20 3f 6b 65 79 73 69 7a 65 20 73 65 61 72 ?keysize sear
3b40: 63 68 2d 6b 65 79 20 73 77 61 70 20 74 6d 70 2d ch-key swap tmp-
3b50: 6d 79 2d 6b 65 79 20 21 20 6b 65 79 2d 72 65 73 my-key ! key-res
3b60: 74 20 3b 0a 3a 20 6e 65 74 32 6f 3a 72 65 63 65 t ;.: net2o:rece
3b70: 69 76 65 2d 74 6d 70 6b 65 79 20 28 20 61 64 64 ive-tmpkey ( add
3b80: 72 20 75 20 2d 2d 20 29 20 20 3f 6b 65 79 73 69 r u -- ) ?keysi
3b90: 7a 65 20 5c 20 64 75 70 20 6b 65 79 73 69 7a 65 ze \ dup keysize
3ba0: 20 2e 6e 6e 62 20 63 72 0a 20 20 20 20 6f 20 30 .nnb cr. o 0
3bb0: 3d 20 49 46 20 20 67 65 6e 2d 73 74 6b 65 79 73 = IF gen-stkeys
3bc0: 20 73 74 73 6b 63 0a 09 5c 20 72 65 70 65 61 74 stskc..\ repeat
3bd0: 65 64 20 74 6d 70 6b 65 79 73 20 61 72 65 20 61 ed tmpkeys are a
3be0: 6c 6c 6f 77 65 64 20 68 65 72 65 20 64 75 65 20 llowed here due
3bf0: 74 6f 20 70 61 63 6b 65 74 20 64 75 70 6c 69 63 to packet duplic
3c00: 61 74 69 6f 6e 0a 20 20 20 20 45 4c 53 45 20 20 ation. ELSE
3c10: 64 75 70 20 3f 72 65 70 65 61 74 2d 74 6d 70 6b dup ?repeat-tmpk
3c20: 65 79 20 5c 20 6e 6f 74 20 61 6c 6c 6f 77 65 64 ey \ not allowed
3c30: 20 68 65 72 65 2c 20 64 75 70 6c 69 63 61 74 65 here, duplicate
3c40: 73 20 77 69 6c 6c 20 62 65 20 72 65 6a 65 63 74 s will be reject
3c50: 65 64 0a 09 74 73 6b 63 20 20 54 48 45 4e 20 5c ed..tskc THEN \
3c60: 20 64 75 70 20 6b 65 79 73 69 7a 65 20 2e 6e 6e dup keysize .nn
3c70: 62 20 63 72 0a 20 20 20 20 73 77 61 70 20 6b 65 b cr. swap ke
3c80: 79 70 61 64 20 65 64 2d 64 68 0a 20 20 20 20 6f ypad ed-dh. o
3c90: 20 49 46 20 20 64 6f 2d 6b 65 79 70 61 64 20 73 IF do-keypad s
3ca0: 65 63 21 20 20 45 4c 53 45 20 20 32 64 72 6f 70 ec! ELSE 2drop
3cb0: 20 20 54 48 45 4e 0a 20 20 20 20 28 20 6b 65 79 THEN. ( key
3cc0: 70 61 64 20 6b 65 79 73 69 7a 65 20 2e 6e 6e 62 pad keysize .nnb
3cd0: 20 63 72 20 29 20 3b 0a 0a 3a 20 74 6d 70 6b 65 cr ) ;..: tmpke
3ce0: 79 40 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 y@ ( -- addr u )
3cf0: 0a 20 20 20 20 64 6f 2d 6b 65 79 70 61 64 20 73 . do-keypad s
3d00: 65 63 40 20 64 75 70 20 3f 45 58 49 54 20 20 32 ec@ dup ?EXIT 2
3d10: 64 72 6f 70 0a 20 20 20 20 6b 65 79 70 61 64 20 drop. keypad
3d20: 6b 65 79 73 69 7a 65 20 3b 0a 0a 3a 20 6e 65 74 keysize ;..: net
3d30: 32 6f 3a 75 70 64 61 74 65 2d 6b 65 79 20 28 20 2o:update-key (
3d40: 2d 2d 20 29 0a 20 20 20 20 6f 3f 20 64 6f 2d 6b -- ). o? do-k
3d50: 65 79 70 61 64 20 73 65 63 40 20 64 75 70 20 6b eypad sec@ dup k
3d60: 65 79 73 69 7a 65 32 20 3d 20 49 46 0a 09 6b 65 eysize2 = IF..ke
3d70: 79 28 20 2e 22 20 73 74 6f 72 65 20 6b 65 79 2c y( ." store key,
3d80: 20 6f 3d 22 20 6f 20 68 65 78 2e 20 32 64 75 70 o=" o hex. 2dup
3d90: 20 2e 6e 6e 62 20 63 72 20 29 0a 09 63 72 79 70 .nnb cr )..cryp
3da0: 74 6f 2d 6b 65 79 20 73 65 63 21 20 64 6f 2d 6b to-key sec! do-k
3db0: 65 79 70 61 64 20 73 65 63 2d 66 72 65 65 0a 09 eypad sec-free..
3dc0: 45 58 49 54 0a 20 20 20 20 54 48 45 4e 0a 20 20 EXIT. THEN.
3dd0: 20 20 32 64 72 6f 70 20 3b 0a 0a 5c 20 73 69 67 2drop ;..\ sig
3de0: 6e 61 74 75 72 65 20 73 74 75 66 66 0a 0a 5c 20 nature stuff..\
3df0: 49 64 65 61 3a 20 73 65 74 20 22 72 22 20 66 69 Idea: set "r" fi
3e00: 72 73 74 20 68 61 6c 66 20 74 6f 20 74 68 65 20 rst half to the
3e10: 76 61 6c 75 65 2c 20 22 72 22 20 73 65 63 6f 6e value, "r" secon
3e20: 64 20 68 61 6c 66 20 74 6f 20 74 68 65 20 6b 65 d half to the ke
3e30: 79 2c 20 64 69 66 66 75 73 65 0a 5c 20 77 65 20 y, diffuse.\ we
3e40: 75 73 65 20 65 78 70 6c 69 63 69 74 65 6c 79 20 use explicitely
3e50: 4b 65 63 63 61 6b 20 68 65 72 65 2c 20 74 68 69 Keccak here, thi
3e60: 73 20 6e 65 65 64 73 20 74 6f 20 62 65 20 67 6c s needs to be gl
3e70: 6f 62 61 6c 6c 79 20 74 68 65 20 73 61 6d 65 21 obally the same!
3e80: 0a 5c 20 4b 65 79 65 64 20 68 61 73 68 73 20 61 .\ Keyed hashs a
3e90: 72 65 20 74 68 65 72 65 20 66 6f 72 20 75 6e 69 re there for uni
3ea0: 71 75 65 20 68 61 6e 64 6c 65 73 0a 0a 3a 20 6b que handles..: k
3eb0: 65 79 65 64 2d 68 61 73 68 23 31 32 38 20 28 20 eyed-hash#128 (
3ec0: 76 61 6c 61 64 64 72 20 75 76 61 6c 20 6b 65 79 valaddr uval key
3ed0: 61 64 64 72 20 75 6b 65 79 20 2d 2d 20 68 61 73 addr ukey -- has
3ee0: 68 61 64 64 72 20 75 68 61 73 68 20 29 0a 20 20 haddr uhash ).
3ef0: 20 20 63 3a 30 6b 65 79 20 3e 6b 65 79 65 64 2d c:0key >keyed-
3f00: 68 61 73 68 20 20 6b 65 79 65 64 2d 68 61 73 68 hash keyed-hash
3f10: 2d 6f 75 74 20 68 61 73 68 23 31 32 38 20 32 64 -out hash#128 2d
3f20: 75 70 20 6b 65 63 63 61 6b 3e 20 3b 0a 3a 20 6b up keccak> ;.: k
3f30: 65 79 65 64 2d 68 61 73 68 23 32 35 36 20 28 20 eyed-hash#256 (
3f40: 76 61 6c 61 64 64 72 20 75 76 61 6c 20 6b 65 79 valaddr uval key
3f50: 61 64 64 72 20 75 6b 65 79 20 2d 2d 20 68 61 73 addr ukey -- has
3f60: 68 61 64 64 72 20 75 68 61 73 68 20 29 0a 20 20 haddr uhash ).
3f70: 20 20 63 3a 30 6b 65 79 20 3e 6b 65 79 65 64 2d c:0key >keyed-
3f80: 68 61 73 68 20 20 6b 65 79 65 64 2d 68 61 73 68 hash keyed-hash
3f90: 2d 6f 75 74 20 68 61 73 68 23 32 35 36 20 32 64 -out hash#256 2d
3fa0: 75 70 20 6b 65 63 63 61 6b 3e 20 3b 0a 0a 5c 20 up keccak> ;..\
3fb0: 73 69 67 6e 61 74 75 72 65 20 70 72 69 6e 74 69 signature printi
3fc0: 6e 67 0a 0a 23 31 30 2e 30 30 30 2e 30 30 30 2e ng..#10.000.000.
3fd0: 30 30 30 20 64 3e 36 34 20 36 34 56 61 6c 75 65 000 d>64 64Value
3fe0: 20 6f 74 72 73 69 67 2d 64 65 6c 74 61 23 20 5c otrsig-delta# \
3ff0: 20 4f 54 52 3a 20 6c 69 76 65 20 66 6f 72 20 31 OTR: live for 1
4000: 30 73 2c 20 74 68 65 6e 20 64 69 65 0a 0a 3a 20 0s, then die..:
4010: 6e 6f 77 3e 6e 65 76 65 72 20 28 20 2d 2d 20 29 now>never ( -- )
4020: 20 20 20 20 20 20 20 20 20 20 74 69 63 6b 73 20 ticks
4030: 36 34 23 2d 31 20 73 69 67 64 61 74 65 20 6c 65 64#-1 sigdate le
4040: 2d 31 32 38 21 20 3b 0a 3a 20 66 6f 72 65 76 65 -128! ;.: foreve
4050: 72 20 28 20 2d 2d 20 29 20 20 20 20 20 20 20 20 r ( -- )
4060: 20 20 20 20 36 34 23 30 20 36 34 23 2d 31 20 73 64#0 64#-1 s
4070: 69 67 64 61 74 65 20 6c 65 2d 31 32 38 21 20 3b igdate le-128! ;
4080: 0a 3a 20 6e 6f 77 2b 64 65 6c 74 61 20 28 20 64 .: now+delta ( d
4090: 65 6c 74 61 36 34 20 2d 2d 20 29 20 20 74 69 63 elta64 -- ) tic
40a0: 6b 73 20 36 34 74 75 63 6b 20 36 34 2b 20 73 69 ks 64tuck 64+ si
40b0: 67 64 61 74 65 20 6c 65 2d 31 32 38 21 20 3b 0a gdate le-128! ;.
40c0: 3a 20 6f 6c 64 3e 6f 74 72 20 28 20 6f 6c 64 74 : old>otr ( oldt
40d0: 69 6d 65 20 2d 2d 20 29 20 20 20 20 74 69 63 6b ime -- ) tick
40e0: 73 20 6f 74 72 73 69 67 2d 64 65 6c 74 61 23 20 s otrsig-delta#
40f0: 36 34 2b 20 73 69 67 64 61 74 65 20 6c 65 2d 31 64+ sigdate le-1
4100: 32 38 21 20 3b 0a 3a 20 6e 6f 77 3e 6f 74 72 20 28! ;.: now>otr
4110: 28 20 2d 2d 20 29 20 20 20 20 20 20 20 20 20 20 ( -- )
4120: 20 20 6f 74 72 73 69 67 2d 64 65 6c 74 61 23 20 otrsig-delta#
4130: 6e 6f 77 2b 64 65 6c 74 61 20 3b 0a 0a 65 3f 20 now+delta ;..e?
4140: 6d 61 78 2d 78 63 68 61 72 20 24 31 30 30 20 3c max-xchar $100 <
4150: 20 5b 49 46 5d 0a 20 20 20 20 3a 20 2e 63 68 65 [IF]. : .che
4160: 63 6b 20 28 20 66 6c 61 67 20 2d 2d 20 29 20 27 ck ( flag -- ) '
4170: 78 27 20 27 76 27 20 72 6f 74 20 73 65 6c 65 63 x' 'v' rot selec
4180: 74 20 78 65 6d 69 74 20 3b 0a 5b 45 4c 53 45 5d t xemit ;.[ELSE]
4190: 0a 20 20 20 20 3a 20 2e 63 68 65 63 6b 20 28 20 . : .check (
41a0: 66 6c 61 67 20 2d 2d 20 29 20 27 e2 9c 98 27 20 flag -- ) '✘'
41b0: 27 e2 9c 94 27 20 72 6f 74 20 73 65 6c 65 63 74 '✔' rot select
41c0: 20 78 65 6d 69 74 20 3b 0a 5b 54 48 45 4e 5d 0a xemit ;.[THEN].
41d0: 3a 20 2e 73 69 67 64 61 74 65 20 28 20 74 69 63 : .sigdate ( tic
41e0: 6b 20 2d 2d 20 29 0a 20 20 20 20 36 34 64 75 70 k -- ). 64dup
41f0: 20 36 34 23 30 20 20 36 34 3d 20 49 46 20 20 36 64#0 64= IF 6
4200: 34 64 72 6f 70 20 2e 66 6f 72 65 76 65 72 20 20 4drop .forever
4210: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 36 EXIT THEN. 6
4220: 34 64 75 70 20 36 34 23 2d 31 20 36 34 3d 20 49 4dup 64#-1 64= I
4230: 46 20 20 36 34 64 72 6f 70 20 2e 6e 65 76 65 72 F 64drop .never
4240: 20 20 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 EXIT THEN.
4250: 20 20 20 74 69 63 6b 73 20 36 34 6f 76 65 72 20 ticks 64over
4260: 36 34 2d 20 36 34 64 75 70 20 3a 30 31 27 23 20 64- 64dup :01'#
4270: 36 34 75 3c 20 49 46 0a 09 36 34 3e 66 20 2d 31 64u< IF..64>f -1
4280: 65 2d 39 20 66 2a 20 31 30 20 36 20 30 20 66 2e e-9 f* 10 6 0 f.
4290: 72 64 70 20 27 73 27 20 65 6d 69 74 20 36 34 64 rdp 's' emit 64d
42a0: 72 6f 70 0a 20 20 20 20 45 4c 53 45 20 20 36 34 rop. ELSE 64
42b0: 64 72 6f 70 20 2e 74 69 63 6b 73 20 20 54 48 45 drop .ticks THE
42c0: 4e 20 3b 0a 3a 20 2e 73 69 67 64 61 74 65 73 20 N ;.: .sigdates
42d0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 ( addr u -- ).
42e0: 20 20 32 64 75 70 20 73 74 61 72 74 64 61 74 65 2dup startdate
42f0: 40 20 2e 73 69 67 64 61 74 65 20 2e 22 20 2d 3e @ .sigdate ." ->
4300: 22 20 65 6e 64 64 61 74 65 40 20 2e 73 69 67 64 " enddate@ .sigd
4310: 61 74 65 20 3b 0a 0a 5c 20 73 69 67 6e 61 74 75 ate ;..\ signatu
4320: 72 65 20 76 65 72 69 66 69 63 61 74 69 6f 6e 0a re verification.
4330: 0a 3a 20 2b 64 61 74 65 20 28 20 61 64 64 72 20 .: +date ( addr
4340: 2d 2d 20 29 0a 20 20 20 20 64 61 74 65 73 69 7a -- ). datesiz
4350: 65 23 20 22 64 61 74 65 22 20 3e 6b 65 79 65 64 e# "date" >keyed
4360: 2d 68 61 73 68 20 3b 0a 3a 20 3e 64 61 74 65 20 -hash ;.: >date
4370: 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 64 72 ( addr u -- addr
4380: 20 75 20 29 0a 20 20 20 20 32 64 75 70 20 2b 20 u ). 2dup +
4390: 73 69 67 73 69 7a 65 23 20 2d 20 2b 64 61 74 65 sigsize# - +date
43a0: 20 3b 0a 3a 20 67 65 6e 3e 68 6f 73 74 20 28 20 ;.: gen>host (
43b0: 61 64 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 addr u -- addr u
43c0: 20 29 0a 20 20 20 20 32 64 75 70 20 63 3a 30 6b ). 2dup c:0k
43d0: 65 79 20 22 68 6f 73 74 22 20 3e 6b 65 79 65 64 ey "host" >keyed
43e0: 2d 68 61 73 68 20 3b 0a 0a 2d 35 0a 65 6e 75 6d -hash ;..-5.enum
43f0: 20 73 69 67 2d 6b 65 79 73 69 7a 65 0a 65 6e 75 sig-keysize.enu
4400: 6d 20 73 69 67 2d 75 6e 73 69 67 6e 65 64 0a 65 m sig-unsigned.e
4410: 6e 75 6d 20 73 69 67 2d 65 61 72 6c 79 0a 65 6e num sig-early.en
4420: 75 6d 20 73 69 67 2d 6c 61 74 65 0a 65 6e 75 6d um sig-late.enum
4430: 20 73 69 67 2d 77 72 6f 6e 67 0a 65 6e 75 6d 20 sig-wrong.enum
4440: 73 69 67 2d 6f 6b 0a 64 72 6f 70 0a 0a 3a 20 65 sig-ok.drop..: e
4450: 61 72 6c 79 2f 6c 61 74 65 3f 20 28 20 6e 36 34 arly/late? ( n64
4460: 20 6d 69 6e 36 34 20 6d 61 78 36 34 20 2d 2d 20 min64 max64 --
4470: 73 69 67 2d 65 72 72 6f 72 20 29 0a 20 20 20 20 sig-error ).
4480: 36 34 3e 72 20 36 34 6f 76 65 72 20 36 34 72 3e 64>r 64over 64r>
4490: 20 36 34 75 3e 3d 20 73 69 67 2d 6c 61 74 65 20 64u>= sig-late
44a0: 61 6e 64 20 3e 72 20 36 34 75 3c 20 73 69 67 2d and >r 64u< sig-
44b0: 65 61 72 6c 79 20 61 6e 64 20 72 3e 20 6d 69 6e early and r> min
44c0: 20 3b 0a 0a 3a 20 63 68 65 63 6b 2d 64 61 74 65 ;..: check-date
44d0: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 64 ( addr u -- add
44e0: 72 20 75 20 66 6c 61 67 20 29 0a 20 20 20 20 32 r u flag ). 2
44f0: 64 75 70 20 2b 20 31 2d 20 63 40 20 6b 65 79 73 dup + 1- c@ keys
4500: 69 7a 65 20 3c 3e 20 73 69 67 2d 6b 65 79 73 69 ize <> sig-keysi
4510: 7a 65 20 61 6e 64 20 3f 64 75 70 2d 49 46 20 20 ze and ?dup-IF
4520: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 32 EXIT THEN. 2
4530: 64 75 70 20 65 6e 64 64 61 74 65 40 20 36 34 3e dup enddate@ 64>
4540: 72 20 32 64 75 70 20 73 74 61 72 74 64 61 74 65 r 2dup startdate
4550: 40 20 36 34 3e 72 0a 20 20 20 20 74 69 63 6b 73 @ 64>r. ticks
4560: 20 66 75 7a 7a 65 64 74 69 6d 65 23 20 36 34 2b fuzzedtime# 64+
4570: 20 36 34 72 3e 20 36 34 72 3e 0a 20 20 20 20 36 64r> 64r>. 6
4580: 34 64 75 70 20 36 34 23 2d 31 20 36 34 3c 3e 20 4dup 64#-1 64<>
4590: 49 46 20 20 66 75 7a 7a 65 64 74 69 6d 65 23 20 IF fuzzedtime#
45a0: 36 34 2d 32 2a 20 36 34 2b 20 20 54 48 45 4e 0a 64-2* 64+ THEN.
45b0: 20 20 20 20 65 61 72 6c 79 2f 6c 61 74 65 3f 0a early/late?.
45c0: 20 20 20 20 6d 73 67 28 20 64 75 70 20 49 46 20 msg( dup IF
45d0: 20 3c 65 72 72 3e 20 2e 22 20 73 69 67 20 6f 75 <err> ." sig ou
45e0: 74 20 6f 66 20 64 61 74 65 3a 20 22 20 74 69 63 t of date: " tic
45f0: 6b 73 20 2e 74 69 63 6b 73 20 2e 22 20 20 73 69 ks .ticks ." si
4600: 67 64 61 74 65 3a 20 22 0a 20 20 20 20 3e 72 20 gdate: ". >r
4610: 32 64 75 70 20 73 74 61 72 74 64 61 74 65 40 20 2dup startdate@
4620: 2e 74 69 63 6b 73 20 32 64 75 70 20 65 6e 64 64 .ticks 2dup endd
4630: 61 74 65 40 20 2e 74 69 63 6b 73 20 72 3e 20 3c ate@ .ticks r> <
4640: 64 65 66 61 75 6c 74 3e 20 63 72 20 20 54 48 45 default> cr THE
4650: 4e 20 29 20 3b 0a 3a 20 76 65 72 69 66 79 2d 73 N ) ;.: verify-s
4660: 69 67 20 28 20 61 64 64 72 20 75 20 70 6b 20 2d ig ( addr u pk -
4670: 2d 20 61 64 64 72 20 75 20 66 6c 61 67 20 29 20 - addr u flag )
4680: 20 3e 72 0a 20 20 20 20 63 68 65 63 6b 2d 64 61 >r. check-da
4690: 74 65 20 64 75 70 20 30 3d 20 49 46 20 20 64 72 te dup 0= IF dr
46a0: 6f 70 20 2b 63 6d 64 0a 09 32 64 75 70 20 2b 20 op +cmd..2dup +
46b0: 73 69 67 6f 6e 6c 79 73 69 7a 65 23 20 2d 20 72 sigonlysize# - r
46c0: 3e 20 65 64 2d 76 65 72 69 66 79 20 30 3d 20 73 > ed-verify 0= s
46d0: 69 67 2d 77 72 6f 6e 67 20 61 6e 64 20 2b 73 69 ig-wrong and +si
46e0: 67 0a 09 45 58 49 54 20 20 54 48 45 4e 0a 20 20 g..EXIT THEN.
46f0: 20 20 72 64 72 6f 70 20 3b 0a 3a 20 71 75 69 63 rdrop ;.: quic
4700: 6b 2d 76 65 72 69 66 79 2d 73 69 67 20 28 20 61 k-verify-sig ( a
4710: 64 64 72 20 75 20 70 6b 20 2d 2d 20 61 64 64 72 ddr u pk -- addr
4720: 20 75 20 66 6c 61 67 20 29 20 20 3e 72 0a 20 20 u flag ) >r.
4730: 20 20 63 68 65 63 6b 2d 64 61 74 65 20 64 75 70 check-date dup
4740: 20 30 3d 20 49 46 20 20 64 72 6f 70 20 2b 63 6d 0= IF drop +cm
4750: 64 0a 09 32 64 75 70 20 2b 20 73 69 67 6f 6e 6c d..2dup + sigonl
4760: 79 73 69 7a 65 23 20 2d 0a 09 72 40 20 64 75 70 ysize# -..r@ dup
4770: 20 6c 61 73 74 23 20 3e 72 20 73 65 61 72 63 68 last# >r search
4780: 2d 6b 65 79 3f 20 72 3e 20 74 6f 20 6c 61 73 74 -key? r> to last
4790: 23 0a 09 64 75 70 20 30 3d 20 49 46 20 20 6e 69 #..dup 0= IF ni
47a0: 70 20 6e 69 70 20 72 64 72 6f 70 20 20 45 58 49 p nip rdrop EXI
47b0: 54 20 20 54 48 45 4e 0a 09 73 77 61 70 20 2e 6b T THEN..swap .k
47c0: 65 2d 73 6b 73 69 67 20 73 65 63 40 20 64 72 6f e-sksig sec@ dro
47d0: 70 20 73 77 61 70 20 32 73 77 61 70 0a 09 65 64 p swap 2swap..ed
47e0: 2d 71 75 69 63 6b 2d 76 65 72 69 66 79 20 30 3d -quick-verify 0=
47f0: 20 73 69 67 2d 77 72 6f 6e 67 20 61 6e 64 20 2b sig-wrong and +
4800: 73 69 67 71 75 69 63 6b 0a 20 20 20 20 54 48 45 sigquick. THE
4810: 4e 0a 20 20 20 20 72 64 72 6f 70 20 3b 0a 0a 3a N. rdrop ;..:
4820: 20 64 61 74 65 2d 73 69 67 3f 20 28 20 61 64 64 date-sig? ( add
4830: 72 20 75 20 70 6b 20 2d 2d 20 61 64 64 72 20 75 r u pk -- addr u
4840: 20 66 6c 61 67 20 29 0a 20 20 20 20 63 3a 6b 65 flag ). c:ke
4850: 79 40 20 63 3a 6b 65 79 23 20 70 72 65 64 61 74 y@ c:key# predat
4860: 65 2d 6b 65 79 20 6b 65 63 63 61 6b 23 20 73 6d e-key keccak# sm
4870: 6f 76 65 0a 20 20 20 20 3e 72 20 3e 64 61 74 65 ove. >r >date
4880: 20 72 3e 20 76 65 72 69 66 79 2d 73 69 67 20 3b r> verify-sig ;
4890: 0a 3a 20 70 6b 2d 73 69 67 3f 20 28 20 61 64 64 .: pk-sig? ( add
48a0: 72 20 75 20 2d 2d 20 61 64 64 72 20 75 27 20 66 r u -- addr u' f
48b0: 6c 61 67 20 29 0a 20 20 20 20 64 75 70 20 73 69 lag ). dup si
48c0: 67 70 6b 73 69 7a 65 23 20 75 3c 20 49 46 20 20 gpksize# u< IF
48d0: 73 69 67 2d 75 6e 73 69 67 6e 65 64 20 20 45 58 sig-unsigned EX
48e0: 49 54 20 20 54 48 45 4e 0a 20 20 20 20 32 64 75 IT THEN. 2du
48f0: 70 20 73 69 67 70 6b 73 69 7a 65 23 20 2d 20 63 p sigpksize# - c
4900: 3a 30 6b 65 79 0a 20 20 20 20 32 64 75 70 20 63 :0key. 2dup c
4910: 3a 68 61 73 68 20 2b 20 64 61 74 65 2d 73 69 67 :hash + date-sig
4920: 3f 20 3b 0a 3a 20 70 6b 2d 71 75 69 63 6b 2d 73 ? ;.: pk-quick-s
4930: 69 67 3f 20 28 20 61 64 64 72 20 75 20 2d 2d 20 ig? ( addr u --
4940: 61 64 64 72 20 75 27 20 66 6c 61 67 20 29 0a 20 addr u' flag ).
4950: 20 20 20 64 75 70 20 73 69 67 70 6b 73 69 7a 65 dup sigpksize
4960: 23 20 75 3c 20 49 46 20 20 73 69 67 2d 75 6e 73 # u< IF sig-uns
4970: 69 67 6e 65 64 20 20 45 58 49 54 20 20 54 48 45 igned EXIT THE
4980: 4e 0a 20 20 20 20 32 64 75 70 20 73 69 67 70 6b N. 2dup sigpk
4990: 73 69 7a 65 23 20 2d 20 63 3a 30 6b 65 79 0a 20 size# - c:0key.
49a0: 20 20 20 32 64 75 70 20 63 3a 68 61 73 68 20 2b 2dup c:hash +
49b0: 20 3e 72 20 3e 64 61 74 65 20 72 3e 20 71 75 69 >r >date r> qui
49c0: 63 6b 2d 76 65 72 69 66 79 2d 73 69 67 20 3b 0a ck-verify-sig ;.
49d0: 3a 20 70 6b 2d 64 61 74 65 3f 20 28 20 61 64 64 : pk-date? ( add
49e0: 72 20 75 20 2d 2d 20 61 64 64 72 20 75 27 20 66 r u -- addr u' f
49f0: 6c 61 67 20 29 20 5c 20 63 68 65 63 6b 20 6f 6e lag ) \ check on
4a00: 6c 79 20 74 68 65 20 64 61 74 65 0a 20 20 20 20 ly the date.
4a10: 64 75 70 20 73 69 67 70 6b 73 69 7a 65 23 20 75 dup sigpksize# u
4a20: 3c 20 49 46 20 20 73 69 67 2d 75 6e 73 69 67 6e < IF sig-unsign
4a30: 65 64 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 ed EXIT THEN.
4a40: 20 20 20 63 68 65 63 6b 2d 64 61 74 65 20 3b 0a check-date ;.
4a50: 3a 20 70 6b 32 2d 73 69 67 3f 20 28 20 61 64 64 : pk2-sig? ( add
4a60: 72 20 75 20 2d 2d 20 61 64 64 72 20 75 27 20 66 r u -- addr u' f
4a70: 6c 61 67 20 29 0a 20 20 20 20 64 75 70 20 73 69 lag ). dup si
4a80: 67 70 6b 32 73 69 7a 65 23 20 75 3c 20 49 46 20 gpk2size# u< IF
4a90: 20 73 69 67 2d 75 6e 73 69 67 6e 65 64 20 20 45 sig-unsigned E
4aa0: 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 32 64 XIT THEN. 2d
4ab0: 75 70 20 73 69 67 70 6b 32 73 69 7a 65 23 20 2d up sigpk2size# -
4ac0: 20 2b 20 3e 72 20 63 3a 30 6b 65 79 20 32 64 75 + >r c:0key 2du
4ad0: 70 20 73 69 67 73 69 7a 65 23 20 2d 20 63 3a 68 p sigsize# - c:h
4ae0: 61 73 68 20 72 3e 20 64 61 74 65 2d 73 69 67 3f ash r> date-sig?
4af0: 20 3b 0a 3a 20 6d 79 2d 6b 65 79 3f 20 28 20 2d ;.: my-key? ( -
4b00: 2d 20 6f 20 29 20 20 6f 20 49 46 20 20 6d 79 2d - o ) o IF my-
4b10: 6b 65 79 20 20 45 4c 53 45 20 20 6d 79 2d 6b 65 key ELSE my-ke
4b20: 79 2d 64 65 66 61 75 6c 74 20 20 54 48 45 4e 20 y-default THEN
4b30: 3b 0a 3a 20 73 69 67 2d 70 61 72 61 6d 73 20 28 ;.: sig-params (
4b40: 20 2d 2d 20 73 6b 73 69 67 20 73 6b 20 70 6b 20 -- sksig sk pk
4b50: 29 0a 20 20 20 20 6d 79 2d 6b 65 79 3f 20 3f 64 ). my-key? ?d
4b60: 75 70 2d 49 46 0a 09 3e 6f 20 6b 65 2d 73 6b 73 up-IF..>o ke-sks
4b70: 69 67 20 73 65 63 40 20 64 72 6f 70 20 6b 65 2d ig sec@ drop ke-
4b80: 73 6b 20 73 65 63 40 20 64 72 6f 70 20 6b 65 2d sk sec@ drop ke-
4b90: 70 6b 20 24 40 20 64 72 6f 70 20 6f 3e 20 20 45 pk $@ drop o> E
4ba0: 58 49 54 0a 20 20 20 20 54 48 45 4e 20 20 21 21 XIT. THEN !!
4bb0: 46 49 58 4d 45 21 21 20 28 20 6f 6c 64 20 76 65 FIXME!! ( old ve
4bc0: 72 73 69 6f 6e 20 29 20 73 6b 73 69 67 20 73 6b rsion ) sksig sk
4bd0: 63 20 70 6b 63 20 3b 0a 3a 20 70 6b 40 20 28 20 c pkc ;.: pk@ (
4be0: 2d 2d 20 70 6b 20 75 20 29 0a 20 20 20 20 6d 79 -- pk u ). my
4bf0: 2d 6b 65 79 3f 20 2e 6b 65 2d 70 6b 20 24 40 20 -key? .ke-pk $@
4c00: 3b 0a 3a 20 73 6b 40 20 28 20 2d 2d 20 73 6b 20 ;.: sk@ ( -- sk
4c10: 75 20 29 0a 20 20 20 20 6d 79 2d 6b 65 79 3f 20 u ). my-key?
4c20: 2e 6b 65 2d 73 6b 20 73 65 63 40 20 3b 0a 3a 20 .ke-sk sec@ ;.:
4c30: 73 6b 73 69 67 40 20 28 20 2d 2d 20 73 6b 73 69 sksig@ ( -- sksi
4c40: 67 20 75 20 29 0a 20 20 20 20 6d 79 2d 6b 65 79 g u ). my-key
4c50: 3f 20 2e 6b 65 2d 73 6b 73 69 67 20 73 65 63 40 ? .ke-sksig sec@
4c60: 20 3b 0a 3a 20 2e 73 69 67 20 28 20 2d 2d 20 29 ;.: .sig ( -- )
4c70: 0a 20 20 20 20 2b 73 69 67 20 73 69 67 64 61 74 . +sig sigdat
4c80: 65 20 2b 64 61 74 65 20 20 73 69 67 64 61 74 65 e +date sigdate
4c90: 20 64 61 74 65 73 69 7a 65 23 20 74 79 70 65 0a datesize# type.
4ca0: 20 20 20 20 73 69 67 2d 70 61 72 61 6d 73 20 65 sig-params e
4cb0: 64 2d 73 69 67 6e 20 74 79 70 65 20 6b 65 79 73 d-sign type keys
4cc0: 69 7a 65 20 65 6d 69 74 20 3b 0a 3a 20 2e 70 6b ize emit ;.: .pk
4cd0: 20 28 20 2d 2d 20 29 20 20 70 6b 40 20 6b 65 79 ( -- ) pk@ key
4ce0: 7c 20 74 79 70 65 20 3b 0a 3a 20 70 6b 2d 73 69 | type ;.: pk-si
4cf0: 67 20 28 20 61 64 64 72 20 75 20 2d 2d 20 73 69 g ( addr u -- si
4d00: 67 20 75 20 29 0a 20 20 20 20 63 3a 30 6b 65 79 g u ). c:0key
4d10: 20 63 3a 68 61 73 68 20 5b 3a 20 2e 70 6b 20 2e c:hash [: .pk .
4d20: 73 69 67 20 3b 5d 20 24 74 6d 70 20 3b 0a 0a 3a sig ;] $tmp ;..:
4d30: 20 2b 73 69 67 24 20 28 20 61 64 64 72 20 75 20 +sig$ ( addr u
4d40: 2d 2d 20 68 6f 73 74 61 64 64 72 20 68 6f 73 74 -- hostaddr host
4d50: 2d 75 20 29 20 5b 3a 20 74 79 70 65 20 2e 73 69 -u ) [: type .si
4d60: 67 20 3b 5d 20 24 74 6d 70 20 3b 0a 3a 20 67 65 g ;] $tmp ;.: ge
4d70: 6e 2d 68 6f 73 74 20 28 20 61 64 64 72 20 75 20 n-host ( addr u
4d80: 2d 2d 20 61 64 64 72 27 20 75 27 20 29 0a 20 20 -- addr' u' ).
4d90: 20 20 67 65 6e 3e 68 6f 73 74 20 2b 73 69 67 24 gen>host +sig$
4da0: 20 3b 0a 3a 20 3e 64 65 6c 65 74 65 20 28 20 61 ;.: >delete ( a
4db0: 64 64 72 20 75 20 74 79 70 65 20 75 32 20 2d 2d ddr u type u2 --
4dc0: 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 22 64 addr u ). "d
4dd0: 65 6c 65 74 65 22 20 3e 6b 65 79 65 64 2d 68 61 elete" >keyed-ha
4de0: 73 68 20 3b 0a 3a 20 67 65 6e 2d 68 6f 73 74 2d sh ;.: gen-host-
4df0: 64 65 6c 20 28 20 61 64 64 72 20 75 20 2d 2d 20 del ( addr u --
4e00: 61 64 64 72 27 20 75 27 20 29 0a 20 20 20 20 67 addr' u' ). g
4e10: 65 6e 3e 68 6f 73 74 20 22 68 6f 73 74 22 20 3e en>host "host" >
4e20: 64 65 6c 65 74 65 20 2b 73 69 67 24 20 3b 0a 0a delete +sig$ ;..
4e30: 5c 20 56 61 75 6c 74 20 73 75 70 70 6f 72 74 20 \ Vault support
4e40: 63 6f 64 65 20 28 67 65 6e 65 72 69 63 20 61 6e code (generic an
4e50: 64 20 6d 6f 72 65 20 63 6f 6d 70 61 63 74 29 0a d more compact).
4e60: 0a 5c 20 70 72 69 6e 63 69 70 6c 65 3a 20 75 73 .\ principle: us
4e70: 65 20 54 68 72 65 65 66 69 73 68 5f 32 35 36 2e e Threefish_256.
4e80: 0a 5c 20 62 6c 6f 63 6b 20 6c 61 79 6f 75 74 3a .\ block layout:
4e90: 0a 5c 20 31 2e 20 33 32 20 62 79 74 65 20 65 70 .\ 1. 32 byte ep
4ea0: 68 65 6d 65 72 61 6c 20 6b 65 79 20 2d 3e 20 75 hemeral key -> u
4eb0: 73 65 20 66 6f 72 20 44 48 45 2e 0a 5c 20 32 2e se for DHE..\ 2.
4ec0: 20 31 36 20 62 79 74 65 20 49 56 2c 20 75 73 65 16 byte IV, use
4ed0: 64 20 66 6f 72 20 61 6c 6c 20 62 6c 6f 63 6b 73 d for all blocks
4ee0: 20 61 73 20 69 6e 63 72 65 6d 65 6e 74 69 6e 67 as incrementing
4ef0: 20 74 77 65 61 6b 0a 5c 20 33 2e 20 31 36 20 62 tweak.\ 3. 16 b
4f00: 79 74 65 20 68 61 73 68 2c 20 74 6f 20 63 68 65 yte hash, to che
4f10: 63 6b 20 66 6f 72 20 73 75 63 63 65 73 73 0a 5c ck for success.\
4f20: 20 34 2e 20 33 32 20 62 79 74 65 20 65 61 63 68 4. 32 byte each
4f30: 20 62 6c 6f 63 6b 73 2c 20 64 65 63 72 79 70 74 blocks, decrypt
4f40: 65 64 20 62 79 20 44 48 45 2b 74 77 65 61 6b 20 ed by DHE+tweak
4f50: 69 6e 20 45 43 42 20 6d 6f 64 65 0a 0a 3a 20 3e in ECB mode..: >
4f60: 76 64 68 65 20 28 20 61 64 64 72 20 2d 2d 20 29 vdhe ( addr -- )
4f70: 20 20 73 6b 40 20 64 72 6f 70 20 73 77 61 70 20 sk@ drop swap
4f80: 74 66 2d 6b 65 79 20 74 66 5f 63 74 78 5f 32 35 tf-key tf_ctx_25
4f90: 36 2d 6b 65 79 20 65 64 2d 64 68 20 32 64 72 6f 6-key ed-dh 2dro
4fa0: 70 20 3b 0a 3a 20 3e 76 69 76 20 20 28 20 61 64 p ;.: >viv ( ad
4fb0: 64 72 20 2d 2d 20 29 20 20 74 66 2d 6b 65 79 20 dr -- ) tf-key
4fc0: 74 66 5f 63 74 78 5f 32 35 36 2d 74 77 65 61 6b tf_ctx_256-tweak
4fd0: 20 24 31 30 20 6d 6f 76 65 20 3b 0a 3a 20 76 2d $10 move ;.: v-
4fe0: 64 65 63 2d 6c 6f 6f 70 20 28 20 61 64 64 72 20 dec-loop ( addr
4ff0: 75 20 2d 2d 20 73 65 73 73 69 6f 6e 2d 6b 65 79 u -- session-key
5000: 20 75 20 2f 20 30 20 30 20 29 0a 20 20 20 20 6f u / 0 0 ). o
5010: 76 65 72 20 7b 20 63 68 6b 20 7d 20 24 31 30 20 ver { chk } $10
5020: 2f 73 74 72 69 6e 67 20 20 24 43 20 7b 20 6d 6f /string $C { mo
5030: 64 65 20 7d 0a 20 20 20 20 62 6f 75 6e 64 73 20 de }. bounds
5040: 55 2b 44 4f 0a 09 74 66 2d 6b 65 79 20 49 20 74 U+DO..tf-key I t
5050: 66 2d 6f 75 74 20 6d 6f 64 65 20 74 66 5f 64 65 f-out mode tf_de
5060: 63 72 79 70 74 5f 32 35 36 0a 09 63 3a 30 6b 65 crypt_256..c:0ke
5070: 79 20 74 66 2d 6f 75 74 20 6b 65 79 73 69 7a 65 y tf-out keysize
5080: 20 63 3a 68 61 73 68 20 74 66 2d 68 61 73 68 6f c:hash tf-hasho
5090: 75 74 20 24 31 30 20 63 3a 68 61 73 68 40 0a 09 ut $10 c:hash@..
50a0: 74 66 2d 68 61 73 68 6f 75 74 20 24 31 30 20 63 tf-hashout $10 c
50b0: 68 6b 20 6f 76 65 72 20 73 74 72 3d 20 49 46 0a hk over str= IF.
50c0: 09 20 20 20 20 74 66 2d 6f 75 74 20 6b 65 79 73 . tf-out keys
50d0: 69 7a 65 20 20 75 6e 6c 6f 6f 70 20 20 45 58 49 ize unloop EXI
50e0: 54 20 20 54 48 45 4e 0a 09 74 66 2d 6b 65 79 20 T THEN..tf-key
50f0: 74 66 5f 74 77 65 61 6b 32 35 36 2b 2b 0a 09 34 tf_tweak256++..4
5100: 20 74 6f 20 6d 6f 64 65 0a 20 20 20 20 6b 65 79 to mode. key
5110: 73 69 7a 65 20 2b 4c 4f 4f 50 20 20 30 20 30 20 size +LOOP 0 0
5120: 3b 0a 3a 20 76 2d 64 65 63 24 20 28 20 61 64 64 ;.: v-dec$ ( add
5130: 72 20 75 20 2d 2d 20 73 65 73 73 69 6f 6e 2d 6b r u -- session-k
5140: 65 79 20 75 20 2f 20 30 20 30 20 29 0a 20 20 20 ey u / 0 0 ).
5150: 20 6f 76 65 72 20 3e 76 64 68 65 20 6b 65 79 73 over >vdhe keys
5160: 69 7a 65 20 2f 73 74 72 69 6e 67 0a 20 20 20 20 ize /string.
5170: 6f 76 65 72 20 3e 76 69 76 20 20 24 31 30 20 2f over >viv $10 /
5180: 73 74 72 69 6e 67 0a 20 20 20 20 76 2d 64 65 63 string. v-dec
5190: 2d 6c 6f 6f 70 20 3b 0a 0a 3a 20 76 64 68 65 20 -loop ;..: vdhe
51a0: 28 20 2d 2d 20 29 20 20 73 74 73 6b 63 20 73 74 ( -- ) stskc st
51b0: 70 6b 63 20 65 64 2d 6b 65 79 70 61 69 72 20 20 pkc ed-keypair
51c0: 73 74 70 6b 63 20 6b 65 79 73 69 7a 65 20 74 79 stpkc keysize ty
51d0: 70 65 20 3b 0a 3a 20 76 69 76 20 20 28 20 2d 2d pe ;.: viv ( --
51e0: 20 29 20 20 24 31 30 20 72 6e 67 24 20 32 64 75 ) $10 rng$ 2du
51f0: 70 20 74 79 70 65 20 20 74 66 2d 6b 65 79 20 74 p type tf-key t
5200: 66 5f 63 74 78 5f 32 35 36 2d 74 77 65 61 6b 20 f_ctx_256-tweak
5210: 73 77 61 70 20 6d 6f 76 65 20 3b 0a 3a 20 76 73 swap move ;.: vs
5220: 65 73 73 69 6f 6e 6b 65 79 20 28 20 2d 2d 20 29 essionkey ( -- )
5230: 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 72 6e 67 . keysize rng
5240: 24 20 76 6b 65 79 20 73 74 61 74 65 23 20 6d 6f $ vkey state# mo
5250: 76 65 2d 72 65 70 0a 20 20 20 20 63 3a 30 6b 65 ve-rep. c:0ke
5260: 79 20 76 6b 65 79 20 6b 65 79 73 69 7a 65 20 63 y vkey keysize c
5270: 3a 68 61 73 68 20 74 66 2d 68 61 73 68 6f 75 74 :hash tf-hashout
5280: 20 24 31 30 20 32 64 75 70 20 63 3a 68 61 73 68 $10 2dup c:hash
5290: 40 20 74 79 70 65 20 3b 0a 3a 20 76 2d 65 6e 63 @ type ;.: v-enc
52a0: 2d 6c 6f 6f 70 20 28 20 6b 65 79 6c 69 73 74 20 -loop ( keylist
52b0: 2d 2d 20 29 0a 20 20 20 20 5b 3a 20 20 64 72 6f -- ). [: dro
52c0: 70 20 73 74 73 6b 63 20 73 77 61 70 20 74 66 2d p stskc swap tf-
52d0: 6b 65 79 20 74 66 5f 63 74 78 5f 32 35 36 2d 6b key tf_ctx_256-k
52e0: 65 79 20 65 64 2d 64 68 20 32 64 72 6f 70 0a 09 ey ed-dh 2drop..
52f0: 74 66 2d 6b 65 79 20 76 6b 65 79 20 74 66 2d 6f tf-key vkey tf-o
5300: 75 74 20 24 43 20 74 66 5f 65 6e 63 72 79 70 74 ut $C tf_encrypt
5310: 5f 32 35 36 0a 09 74 66 2d 6f 75 74 20 6b 65 79 _256..tf-out key
5320: 73 69 7a 65 20 74 79 70 65 0a 09 74 66 2d 6b 65 size type..tf-ke
5330: 79 20 74 66 5f 74 77 65 61 6b 32 35 36 2b 2b 0a y tf_tweak256++.
5340: 20 20 20 20 3b 5d 20 24 5b 5d 6d 61 70 20 3b 0a ;] $[]map ;.
5350: 3a 20 76 2d 65 6e 63 2d 67 65 6e 20 28 20 6b 65 : v-enc-gen ( ke
5360: 79 6c 69 73 74 20 2d 2d 20 29 0a 20 20 20 20 76 ylist -- ). v
5370: 64 68 65 20 76 69 76 20 76 73 65 73 73 69 6f 6e dhe viv vsession
5380: 6b 65 79 20 76 2d 65 6e 63 2d 6c 6f 6f 70 20 3b key v-enc-loop ;
5390: 0a 3a 20 76 2d 65 6e 63 24 20 28 20 6b 65 79 6c .: v-enc$ ( keyl
53a0: 69 73 74 20 2d 2d 20 61 64 64 72 20 75 20 29 0a ist -- addr u ).
53b0: 20 20 20 20 5b 27 5d 20 76 2d 65 6e 63 2d 67 65 ['] v-enc-ge
53c0: 6e 20 24 74 6d 70 20 3b 0a 0a 5c 20 6d 65 73 73 n $tmp ;..\ mess
53d0: 61 67 65 20 65 6e 63 72 79 70 74 69 6f 6e 0a 0a age encryption..
53e0: 3a 20 3e 6d 6f 64 6b 65 79 20 28 20 64 73 74 73 : >modkey ( dsts
53f0: 6b 20 64 73 74 70 6b 20 73 6b 20 2d 2d 20 29 0a k dstpk sk -- ).
5400: 20 20 20 20 5c 20 64 75 70 20 70 61 64 20 73 63 \ dup pad sc
5410: 74 30 20 72 6f 74 20 72 61 77 3e 73 63 32 35 35 t0 rot raw>sc255
5420: 31 39 0a 20 20 20 20 5c 20 67 65 74 30 20 73 63 19. \ get0 sc
5430: 74 30 20 67 65 32 35 35 31 39 2a 62 61 73 65 0a t0 ge25519*base.
5440: 20 20 20 20 5c 20 67 65 74 30 20 67 65 32 35 35 \ get0 ge255
5450: 31 39 2d 70 61 63 6b 20 70 61 64 20 6b 65 79 73 19-pack pad keys
5460: 69 7a 65 20 38 35 74 79 70 65 20 2e 22 20 20 2d ize 85type ." -
5470: 5b 22 0a 20 20 20 20 76 6f 75 74 6b 65 79 20 73 [". voutkey s
5480: 74 61 74 65 32 23 20 63 3a 68 61 73 68 40 0a 20 tate2# c:hash@.
5490: 20 20 20 28 20 76 6f 75 74 6b 65 79 20 24 31 30 ( voutkey $10
54a0: 20 2b 20 6b 65 79 73 69 7a 65 20 38 35 74 79 70 + keysize 85typ
54b0: 65 20 2e 22 20 5d 3e 20 22 20 29 0a 20 20 20 20 e ." ]> " ).
54c0: 73 63 74 30 20 76 6f 75 74 6b 65 79 20 24 31 30 sct0 voutkey $10
54d0: 20 2b 20 33 32 62 3e 73 63 32 35 35 31 39 20 5c + 32b>sc25519 \
54e0: 20 64 6f 6e 27 74 20 75 73 65 20 66 69 72 73 74 don't use first
54f0: 20 24 31 30 20 62 79 74 65 73 2c 20 75 73 65 64 $10 bytes, used
5500: 20 62 79 20 24 65 6e 63 72 79 70 74 0a 20 20 20 by $encrypt.
5510: 20 73 63 74 31 20 73 63 74 30 20 73 63 32 35 35 sct1 sct0 sc255
5520: 31 39 2f 0a 20 20 20 20 73 63 74 30 20 73 77 61 19/. sct0 swa
5530: 70 20 72 61 77 3e 73 63 32 35 35 31 39 0a 20 20 p raw>sc25519.
5540: 20 20 73 63 74 32 20 73 63 74 30 20 73 63 74 31 sct2 sct0 sct1
5550: 20 73 63 32 35 35 31 39 2a 0a 20 20 20 20 67 65 sc25519*. ge
5560: 74 30 20 73 63 74 32 20 67 65 32 35 35 31 39 2a t0 sct2 ge25519*
5570: 62 61 73 65 0a 20 20 20 20 28 20 64 75 70 20 29 base. ( dup )
5580: 20 67 65 74 30 20 67 65 32 35 35 31 39 2d 70 61 get0 ge25519-pa
5590: 63 6b 0a 20 20 20 20 28 20 6b 65 79 73 69 7a 65 ck. ( keysize
55a0: 20 38 35 74 79 70 65 20 66 6f 72 74 68 3a 63 72 85type forth:cr
55b0: 20 29 0a 20 20 20 20 73 63 74 32 20 73 63 32 35 ). sct2 sc25
55c0: 35 31 39 3e 33 32 62 20 3b 0a 0a 3a 20 6d 6f 64 519>32b ;..: mod
55d0: 6b 65 79 3e 20 28 20 73 72 63 20 64 65 73 74 20 key> ( src dest
55e0: 2d 2d 20 29 0a 20 20 20 20 28 20 6f 76 65 72 20 -- ). ( over
55f0: 6b 65 79 73 69 7a 65 20 38 35 74 79 70 65 20 2e keysize 85type .
5600: 22 20 20 2d 5b 22 20 29 0a 20 20 20 20 67 65 74 " -[" ). get
5610: 30 20 72 6f 74 20 67 65 32 35 35 31 39 2d 75 6e 0 rot ge25519-un
5620: 70 61 63 6b 2d 20 30 3d 20 21 21 6e 6f 2d 65 64 pack- 0= !!no-ed
5630: 2d 6b 65 79 21 21 0a 20 20 20 20 76 6f 75 74 6b -key!!. voutk
5640: 65 79 20 73 74 61 74 65 32 23 20 63 3a 68 61 73 ey state2# c:has
5650: 68 40 0a 20 20 20 20 28 20 76 6f 75 74 6b 65 79 h@. ( voutkey
5660: 20 6b 65 79 73 69 7a 65 20 38 35 74 79 70 65 20 keysize 85type
5670: 2e 22 20 5d 3e 20 22 20 29 0a 20 20 20 20 73 63 ." ]> " ). sc
5680: 74 30 20 76 6f 75 74 6b 65 79 20 24 31 30 20 2b t0 voutkey $10 +
5690: 20 33 32 62 3e 73 63 32 35 35 31 39 0a 20 20 20 32b>sc25519.
56a0: 20 67 65 74 31 20 67 65 74 30 20 73 63 74 30 20 get1 get0 sct0
56b0: 67 65 32 35 35 31 39 2a 0a 20 20 20 20 64 75 70 ge25519*. dup
56c0: 20 67 65 74 31 20 67 65 32 35 35 31 39 2d 70 61 get1 ge25519-pa
56d0: 63 6b 0a 20 20 20 20 24 38 30 20 73 77 61 70 20 ck. $80 swap
56e0: 28 20 6f 76 65 72 20 29 20 24 31 46 20 2b 20 78 ( over ) $1F + x
56f0: 6f 72 63 21 0a 20 20 20 20 28 20 6b 65 79 73 69 orc!. ( keysi
5700: 7a 65 20 38 35 74 79 70 65 20 66 6f 72 74 68 3a ze 85type forth:
5710: 63 72 20 29 20 3b 0a 3a 20 64 65 63 72 79 70 74 cr ) ;.: decrypt
5720: 2d 73 69 67 3f 20 28 20 6b 65 79 20 75 20 6d 73 -sig? ( key u ms
5730: 67 20 75 20 73 69 67 20 2d 2d 20 61 64 64 72 20 g u sig -- addr
5740: 75 20 73 69 67 65 72 72 20 29 0a 20 20 20 20 7b u sigerr ). {
5750: 20 70 6b 73 69 67 20 7d 20 24 6d 61 6b 65 20 2d pksig } $make -
5760: 35 20 7b 20 77 5e 20 6d 73 67 20 65 72 72 20 7d 5 { w^ msg err }
5770: 0a 20 20 20 20 6d 73 67 20 24 40 20 32 73 77 61 . msg $@ 2swa
5780: 70 20 64 65 63 72 79 70 74 24 20 49 46 0a 09 70 p decrypt$ IF..p
5790: 6b 73 69 67 20 70 6b 6d 6f 64 20 6d 6f 64 6b 65 ksig pkmod modke
57a0: 79 3e 20 5c 20 6b 65 79 20 6d 6f 64 69 66 69 63 y> \ key modific
57b0: 61 74 69 6f 6e 20 77 69 74 68 6f 75 74 20 64 61 ation without da
57c0: 74 65 0a 09 70 6b 73 69 67 20 73 69 67 70 6b 73 te..pksig sigpks
57d0: 69 7a 65 23 20 6f 76 65 72 20 64 61 74 65 2d 73 ize# over date-s
57e0: 69 67 3f 20 74 6f 20 65 72 72 20 20 32 64 72 6f ig? to err 2dro
57f0: 70 0a 09 65 72 72 20 30 3d 20 49 46 0a 09 20 20 p..err 0= IF..
5800: 20 20 70 6b 73 69 67 20 73 69 67 70 6b 73 69 7a pksig sigpksiz
5810: 65 23 20 6b 65 79 73 69 7a 65 20 2f 73 74 72 69 e# keysize /stri
5820: 6e 67 0a 09 20 20 20 20 70 6b 6d 6f 64 20 6b 65 ng.. pkmod ke
5830: 79 73 69 7a 65 0a 09 20 20 20 20 32 72 6f 74 20 ysize.. 2rot
5840: 5b 3a 20 74 79 70 65 20 74 79 70 65 20 74 79 70 [: type type typ
5850: 65 20 3b 5d 20 24 74 6d 70 0a 09 20 20 20 20 32 e ;] $tmp.. 2
5860: 64 75 70 20 2b 20 32 20 2d 20 24 37 46 20 73 77 dup + 2 - $7F sw
5870: 61 70 20 61 6e 64 63 21 0a 09 20 20 20 20 6d 73 ap andc!.. ms
5880: 67 20 24 66 72 65 65 0a 09 20 20 20 20 65 72 72 g $free.. err
5890: 20 20 45 58 49 54 20 20 54 48 45 4e 20 20 54 48 EXIT THEN TH
58a0: 45 4e 0a 20 20 20 20 32 64 72 6f 70 20 6d 73 67 EN. 2drop msg
58b0: 20 24 66 72 65 65 20 20 30 20 30 20 65 72 72 20 $free 0 0 err
58c0: 3b 0a 0a 3a 20 2e 65 6e 63 73 69 67 6e 2d 72 65 ;..: .encsign-re
58d0: 73 74 20 28 20 2d 2d 20 29 0a 20 20 20 20 73 69 st ( -- ). si
58e0: 67 64 61 74 65 20 2b 64 61 74 65 0a 20 20 20 20 gdate +date.
58f0: 73 69 67 64 61 74 65 20 64 61 74 65 73 69 7a 65 sigdate datesize
5900: 23 20 74 79 70 65 0a 20 20 20 20 73 6b 73 69 67 # type. sksig
5910: 40 20 64 72 6f 70 20 73 6b 74 6d 70 20 70 6b 6d @ drop sktmp pkm
5920: 6f 64 20 65 64 2d 73 69 67 6e 0a 20 20 20 20 32 od ed-sign. 2
5930: 64 75 70 20 2b 20 31 2d 20 24 38 30 20 73 77 61 dup + 1- $80 swa
5940: 70 20 6f 72 63 21 20 74 79 70 65 0a 20 20 20 20 p orc! type.
5950: 6b 65 79 73 69 7a 65 20 65 6d 69 74 20 3b 0a 0a keysize emit ;..
5960: 3a 20 2e 65 6e 63 73 69 67 6e 20 28 20 2d 2d 20 : .encsign ( --
5970: 29 0a 20 20 20 20 2b 73 69 67 0a 20 20 20 20 73 ). +sig. s
5980: 6b 74 6d 70 20 70 6b 6d 6f 64 20 73 6b 40 20 64 ktmp pkmod sk@ d
5990: 72 6f 70 20 3e 6d 6f 64 6b 65 79 0a 20 20 20 20 rop >modkey.
59a0: 70 6b 6d 6f 64 20 6b 65 79 73 69 7a 65 20 74 79 pkmod keysize ty
59b0: 70 65 20 2e 65 6e 63 73 69 67 6e 2d 72 65 73 74 pe .encsign-rest
59c0: 20 3b 0a 0a 5c 5c 5c 0a 4c 6f 63 61 6c 20 56 61 ;..\\\.Local Va
59d0: 72 69 61 62 6c 65 73 3a 0a 66 6f 72 74 68 2d 6c riables:.forth-l
59e0: 6f 63 61 6c 2d 77 6f 72 64 73 3a 0a 20 20 20 20 ocal-words:.
59f0: 28 0a 20 20 20 20 20 28 28 22 65 76 65 6e 74 3a (. (("event:
5a00: 22 29 20 64 65 66 69 6e 69 74 69 6f 6e 2d 73 74 ") definition-st
5a10: 61 72 74 65 72 20 28 66 6f 6e 74 2d 6c 6f 63 6b arter (font-lock
5a20: 2d 6b 65 79 77 6f 72 64 2d 66 61 63 65 20 2e 20 -keyword-face .
5a30: 31 29 0a 20 20 20 20 20 20 22 5b 20 5c 74 5c 6e 1). "[ \t\n
5a40: 5d 22 20 74 20 6e 61 6d 65 20 28 66 6f 6e 74 2d ]" t name (font-
5a50: 6c 6f 63 6b 2d 66 75 6e 63 74 69 6f 6e 2d 6e 61 lock-function-na
5a60: 6d 65 2d 66 61 63 65 20 2e 20 33 29 29 0a 20 20 me-face . 3)).
5a70: 20 20 20 28 28 22 64 65 62 75 67 3a 22 20 22 66 (("debug:" "f
5a80: 69 65 6c 64 3a 22 20 22 32 66 69 65 6c 64 3a 22 ield:" "2field:"
5a90: 20 22 73 66 66 69 65 6c 64 3a 22 20 22 64 66 66 "sffield:" "dff
5aa0: 69 65 6c 64 3a 22 20 22 36 34 66 69 65 6c 64 3a ield:" "64field:
5ab0: 22 20 22 75 76 61 72 22 20 22 75 76 61 6c 75 65 " "uvar" "uvalue
5ac0: 22 29 20 6e 6f 6e 2d 69 6d 6d 65 64 69 61 74 65 ") non-immediate
5ad0: 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 74 79 70 65 (font-lock-type
5ae0: 2d 66 61 63 65 20 2e 20 32 29 0a 20 20 20 20 20 -face . 2).
5af0: 20 22 5b 20 5c 74 5c 6e 5d 22 20 74 20 6e 61 6d "[ \t\n]" t nam
5b00: 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 76 61 72 e (font-lock-var
5b10: 69 61 62 6c 65 2d 6e 61 6d 65 2d 66 61 63 65 20 iable-name-face
5b20: 2e 20 33 29 29 0a 20 20 20 20 20 28 22 5b 61 2d . 3)). ("[a-
5b30: 7a 5c 2d 30 2d 39 5d 2b 28 22 20 69 6d 6d 65 64 z\-0-9]+(" immed
5b40: 69 61 74 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d iate (font-lock-
5b50: 63 6f 6d 6d 65 6e 74 2d 66 61 63 65 20 2e 20 31 comment-face . 1
5b60: 29 0a 20 20 20 20 20 20 22 29 22 20 6e 69 6c 20 ). ")" nil
5b70: 63 6f 6d 6d 65 6e 74 20 28 66 6f 6e 74 2d 6c 6f comment (font-lo
5b80: 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 65 20 ck-comment-face
5b90: 2e 20 31 29 29 0a 20 20 20 20 29 0a 66 6f 72 74 . 1)). ).fort
5ba0: 68 2d 6c 6f 63 61 6c 2d 69 6e 64 65 6e 74 2d 77 h-local-indent-w
5bb0: 6f 72 64 73 3a 0a 20 20 20 20 28 0a 20 20 20 20 ords:. (.
5bc0: 20 28 28 22 65 76 65 6e 74 3a 22 29 20 28 30 20 (("event:") (0
5bd0: 2e 20 32 29 20 28 30 20 2e 20 32 29 20 6e 6f 6e . 2) (0 . 2) non
5be0: 2d 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 -immediate).
5bf0: 29 0a 45 6e 64 3a 0a 5b 54 48 45 4e 5d 0a ).End:.[THEN].