0000: 5c 20 6e 65 74 32 6f 20 6b 65 79 20 73 74 6f 72 \ net2o key stor
0010: 61 67 65 0a 0a 5c 20 43 6f 70 79 72 69 67 68 74 age..\ Copyright
0020: 20 28 43 29 20 32 30 31 33 2d 32 30 31 35 20 20 (C) 2013-2015
0030: 20 42 65 72 6e 64 20 50 61 79 73 61 6e 0a 0a 5c Bernd Paysan..\
0040: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0050: 20 66 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 free software:
0060: 79 6f 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 you can redistri
0070: 62 75 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d bute it and/or m
0080: 6f 64 69 66 79 0a 5c 20 69 74 20 75 6e 64 65 72 odify.\ it under
0090: 20 74 68 65 20 74 65 72 6d 73 20 6f 66 20 74 68 the terms of th
00a0: 65 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e e GNU Affero Gen
00b0: 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 eral Public Lice
00c0: 6e 73 65 20 61 73 20 70 75 62 6c 69 73 68 65 64 nse as published
00d0: 20 62 79 0a 5c 20 74 68 65 20 46 72 65 65 20 53 by.\ the Free S
00e0: 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 69 oftware Foundati
00f0: 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 69 on, either versi
0100: 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 65 on 3 of the Lice
0110: 6e 73 65 2c 20 6f 72 0a 5c 20 28 61 74 20 79 6f nse, or.\ (at yo
0120: 75 72 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c ur option) any l
0130: 61 74 65 72 20 76 65 72 73 69 6f 6e 2e 0a 0a 5c ater version...\
0140: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0150: 20 64 69 73 74 72 69 62 75 74 65 64 20 69 6e 20 distributed in
0160: 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 69 74 the hope that it
0170: 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 6c 2c will be useful,
0180: 0a 5c 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 .\ but WITHOUT A
0190: 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 NY WARRANTY; wit
01a0: 68 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d hout even the im
01b0: 70 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f plied warranty o
01c0: 66 0a 5c 20 4d 45 52 43 48 41 4e 54 41 42 49 4c f.\ MERCHANTABIL
01d0: 49 54 59 20 6f 72 20 46 49 54 4e 45 53 53 20 46 ITY or FITNESS F
01e0: 4f 52 20 41 20 50 41 52 54 49 43 55 4c 41 52 20 OR A PARTICULAR
01f0: 50 55 52 50 4f 53 45 2e 20 20 53 65 65 20 74 68 PURPOSE. See th
0200: 65 0a 5c 20 47 4e 55 20 41 66 66 65 72 6f 20 47 e.\ GNU Affero G
0210: 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 eneral Public Li
0220: 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 20 64 cense for more d
0230: 65 74 61 69 6c 73 2e 0a 0a 5c 20 59 6f 75 20 73 etails...\ You s
0240: 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 65 69 hould have recei
0250: 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 74 68 ved a copy of th
0260: 65 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e e GNU Affero Gen
0270: 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 eral Public Lice
0280: 6e 73 65 0a 5c 20 61 6c 6f 6e 67 20 77 69 74 68 nse.\ along with
0290: 20 74 68 69 73 20 70 72 6f 67 72 61 6d 2e 20 20 this program.
02a0: 49 66 20 6e 6f 74 2c 20 73 65 65 20 3c 68 74 74 If not, see <htt
02b0: 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 2f p://www.gnu.org/
02c0: 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a 0a 72 65 71 licenses/>...req
02d0: 75 69 72 65 20 6d 6b 64 69 72 2e 66 73 0a 0a 5c uire mkdir.fs..\
02e0: 20 61 63 63 65 70 74 20 66 6f 72 20 70 61 73 73 accept for pass
02f0: 77 6f 72 64 20 65 6e 74 72 79 0a 0a 73 63 6f 70 word entry..scop
0300: 65 7b 20 63 6f 6e 66 69 67 0a 56 61 72 69 61 62 e{ config.Variab
0310: 6c 65 20 70 77 2d 6c 65 76 65 6c 23 20 32 20 70 le pw-level# 2 p
0320: 77 2d 6c 65 76 65 6c 23 20 21 20 5c 20 70 77 2d w-level# ! \ pw-
0330: 6c 65 76 65 6c 23 20 30 20 69 73 20 6c 6f 77 65 level# 0 is lowe
0340: 73 74 0a 56 61 72 69 61 62 6c 65 20 70 77 2d 6d st.Variable pw-m
0350: 61 78 6c 65 76 65 6c 23 20 34 20 70 77 2d 6d 61 axlevel# 4 pw-ma
0360: 78 6c 65 76 65 6c 23 20 21 20 5c 20 70 77 2d 6d xlevel# ! \ pw-m
0370: 61 78 6c 65 76 65 6c 23 20 69 73 20 74 68 65 20 axlevel# is the
0380: 6d 61 78 69 6d 75 6d 20 63 68 65 63 6b 65 64 0a maximum checked.
0390: 7d 73 63 6f 70 65 0a 0a 5b 49 46 44 45 46 5d 20 }scope..[IFDEF]
03a0: 6d 73 6c 69 6e 75 78 20 27 2a 27 20 5b 45 4c 53 mslinux '*' [ELS
03b0: 45 5d 20 27 e2 80 a2 27 20 5b 54 48 45 4e 5d 20 E] '•' [THEN]
03c0: 43 6f 6e 73 74 61 6e 74 20 70 77 2a 0a 0a 78 63 Constant pw*..xc
03d0: 2d 76 65 63 74 6f 72 20 75 70 40 20 2d 20 63 6c -vector up@ - cl
03e0: 61 73 73 2d 6f 20 21 0a 0a 30 20 63 65 6c 6c 20 ass-o !..0 cell
03f0: 75 76 61 72 20 65 73 63 2d 73 74 61 74 65 20 64 uvar esc-state d
0400: 72 6f 70 0a 0a 44 65 66 65 72 20 6f 6c 64 2d 65 rop..Defer old-e
0410: 6d 69 74 20 20 77 68 61 74 27 73 20 65 6d 69 74 mit what's emit
0420: 20 69 73 20 6f 6c 64 2d 65 6d 69 74 0a 0a 68 65 is old-emit..he
0430: 72 65 0a 78 63 2d 76 65 63 74 6f 72 20 40 20 63 re.xc-vector @ c
0440: 65 6c 6c 2d 20 64 75 70 20 40 20 74 75 63 6b 20 ell- dup @ tuck
0450: 2d 20 68 65 72 65 20 73 77 61 70 20 64 75 70 20 - here swap dup
0460: 61 6c 6c 6f 74 20 6d 6f 76 65 0a 2c 20 68 65 72 allot move., her
0470: 65 20 30 20 2c 20 43 6f 6e 73 74 61 6e 74 20 75 e 0 , Constant u
0480: 74 66 2d 38 2a 0a 0a 78 63 2d 76 65 63 74 6f 72 tf-8*..xc-vector
0490: 20 40 20 20 75 74 66 2d 38 2a 20 78 63 2d 76 65 @ utf-8* xc-ve
04a0: 63 74 6f 72 20 21 20 27 20 2a 2d 77 69 64 74 68 ctor ! ' *-width
04b0: 20 69 73 20 78 2d 77 69 64 74 68 20 20 78 63 2d is x-width xc-
04c0: 76 65 63 74 6f 72 20 21 0a 0a 3a 20 65 6d 69 74 vector !..: emit
04d0: 2d 70 77 2a 20 28 20 6e 20 2d 2d 20 29 0a 20 20 -pw* ( n -- ).
04e0: 20 20 64 75 70 20 23 65 73 63 20 3d 20 49 46 20 dup #esc = IF
04f0: 20 65 73 63 2d 73 74 61 74 65 20 6f 6e 20 20 54 esc-state on T
0500: 48 45 4e 0a 20 20 20 20 64 75 70 20 62 6c 20 3c HEN. dup bl <
0510: 20 49 46 20 20 6f 6c 64 2d 65 6d 69 74 20 20 45 IF old-emit E
0520: 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 65 73 XIT THEN. es
0530: 63 2d 73 74 61 74 65 20 40 20 49 46 20 20 64 75 c-state @ IF du
0540: 70 20 6f 6c 64 2d 65 6d 69 74 0a 20 20 20 20 45 p old-emit. E
0550: 4c 53 45 20 20 64 75 70 20 24 43 30 20 24 38 30 LSE dup $C0 $80
0560: 20 77 69 74 68 69 6e 20 49 46 0a 09 20 20 20 20 within IF..
0570: 5b 20 70 77 2a 20 27 20 78 65 6d 69 74 20 24 74 [ pw* ' xemit $t
0580: 6d 70 0a 09 20 20 20 20 62 6f 75 6e 64 73 20 5b mp.. bounds [
0590: 3f 44 4f 5d 20 5b 49 5d 20 63 40 20 5d 4c 20 6f ?DO] [I] c@ ]L o
05a0: 6c 64 2d 65 6d 69 74 20 5b 20 5b 4c 4f 4f 50 5d ld-emit [ [LOOP]
05b0: 20 5d 0a 09 54 48 45 4e 0a 20 20 20 20 54 48 45 ]..THEN. THE
05c0: 4e 0a 20 20 20 20 74 6f 75 70 70 65 72 20 27 41 N. toupper 'A
05d0: 27 20 27 5b 27 20 77 69 74 68 69 6e 20 49 46 20 ' '[' within IF
05e0: 20 65 73 63 2d 73 74 61 74 65 20 6f 66 66 20 20 esc-state off
05f0: 54 48 45 4e 20 3b 0a 0a 3a 20 74 79 70 65 2d 70 THEN ;..: type-p
0600: 77 2a 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 w* ( addr u -- )
0610: 20 20 32 64 75 70 20 62 6c 20 73 6b 69 70 20 6e 2dup bl skip n
0620: 69 70 20 30 3d 0a 20 20 20 20 49 46 20 20 20 20 ip 0=. IF
0630: 62 6f 75 6e 64 73 20 55 2b 44 4f 20 20 62 6c 20 bounds U+DO bl
0640: 6f 6c 64 2d 65 6d 69 74 20 20 20 20 4c 4f 4f 50 old-emit LOOP
0650: 0a 20 20 20 20 45 4c 53 45 20 20 62 6f 75 6e 64 . ELSE bound
0660: 73 20 55 2b 44 4f 20 20 49 20 63 40 20 65 6d 69 s U+DO I c@ emi
0670: 74 2d 70 77 2a 20 20 4c 4f 4f 50 20 20 54 48 45 t-pw* LOOP THE
0680: 4e 20 3b 0a 0a 3a 20 61 63 63 65 70 74 2a 20 28 N ;..: accept* (
0690: 20 61 64 64 72 20 75 20 2d 2d 20 75 27 20 29 0a addr u -- u' ).
06a0: 20 20 20 20 5c 47 20 61 63 63 65 70 74 2d 6c 69 \G accept-li
06b0: 6b 65 20 69 6e 70 75 74 2c 20 62 75 74 20 74 79 ke input, but ty
06c0: 70 65 73 20 2a 20 69 6e 73 74 65 61 64 20 6f 66 pes * instead of
06d0: 20 74 68 65 20 63 68 61 72 61 63 74 65 72 0a 20 the character.
06e0: 20 20 20 5c 47 20 64 6f 6e 27 74 20 73 61 76 65 \G don't save
06f0: 20 69 6e 74 6f 20 68 69 73 74 6f 72 79 0a 20 20 into history.
0700: 20 20 68 69 73 74 6f 72 79 20 3e 72 20 20 77 68 history >r wh
0710: 61 74 27 73 20 74 79 70 65 20 3e 72 20 20 77 68 at's type >r wh
0720: 61 74 27 73 20 65 6d 69 74 20 69 73 20 6f 6c 64 at's emit is old
0730: 2d 65 6d 69 74 0a 20 20 20 20 75 74 66 2d 38 2a -emit. utf-8*
0740: 20 78 63 2d 76 65 63 74 6f 72 20 21 40 20 3e 72 xc-vector !@ >r
0750: 20 20 5b 27 5d 20 74 79 70 65 2d 70 77 2a 20 69 ['] type-pw* i
0760: 73 20 74 79 70 65 20 20 5b 27 5d 20 65 6d 69 74 s type ['] emit
0770: 2d 70 77 2a 20 69 73 20 65 6d 69 74 0a 20 20 20 -pw* is emit.
0780: 20 30 20 74 6f 20 68 69 73 74 6f 72 79 0a 20 20 0 to history.
0790: 20 20 5b 27 5d 20 61 63 63 65 70 74 20 63 61 74 ['] accept cat
07a0: 63 68 0a 20 20 20 20 72 3e 20 78 63 2d 76 65 63 ch. r> xc-vec
07b0: 74 6f 72 20 21 20 20 77 68 61 74 27 73 20 6f 6c tor ! what's ol
07c0: 64 2d 65 6d 69 74 20 69 73 20 65 6d 69 74 20 20 d-emit is emit
07d0: 72 3e 20 69 73 20 74 79 70 65 20 20 72 3e 20 74 r> is type r> t
07e0: 6f 20 68 69 73 74 6f 72 79 0a 20 20 20 20 74 68 o history. th
07f0: 72 6f 77 20 2d 31 20 30 20 61 74 2d 64 65 6c 74 row -1 0 at-delt
0800: 61 78 79 20 73 70 61 63 65 20 3b 0a 0a 5c 20 4b axy space ;..\ K
0810: 65 79 73 20 61 72 65 20 70 61 73 73 77 6f 72 64 eys are password
0820: 73 20 61 6e 64 20 70 72 69 76 61 74 65 20 6b 65 s and private ke
0830: 79 73 20 28 73 65 6c 66 2d 6b 65 79 65 64 2c 20 ys (self-keyed,
0840: 69 2e 65 2e 20 70 72 69 76 61 74 65 2a 70 75 62 i.e. private*pub
0850: 6c 69 63 20 6b 65 79 29 0a 0a 63 6d 64 2d 62 75 lic key)..cmd-bu
0860: 66 30 20 75 63 6c 61 73 73 20 63 6d 64 62 75 66 f0 uclass cmdbuf
0870: 2d 6f 0a 20 20 20 20 6d 61 78 64 61 74 61 20 2d -o. maxdata -
0880: 0a 20 20 20 20 6b 65 79 2d 73 61 6c 74 23 20 75 . key-salt# u
0890: 76 61 72 20 6b 65 79 70 61 63 6b 0a 20 20 20 20 var keypack.
08a0: 6b 65 79 70 61 63 6b 23 20 20 75 76 61 72 20 6b keypack# uvar k
08b0: 65 79 70 61 63 6b 2d 62 75 66 0a 20 20 20 20 6b eypack-buf. k
08c0: 65 79 2d 63 6b 73 75 6d 23 20 75 76 61 72 20 6b ey-cksum# uvar k
08d0: 65 79 70 61 63 6b 2d 63 68 6b 73 75 6d 0a 65 6e eypack-chksum.en
08e0: 64 2d 63 6c 61 73 73 20 63 6d 64 2d 6b 65 79 62 d-class cmd-keyb
08f0: 75 66 2d 63 0a 0a 63 6d 64 2d 6b 65 79 62 75 66 uf-c..cmd-keybuf
0900: 2d 63 20 27 20 6e 65 77 20 73 74 61 74 69 63 2d -c ' new static-
0910: 61 20 77 69 74 68 2d 61 6c 6c 6f 63 61 74 65 72 a with-allocater
0920: 20 63 6f 64 65 2d 6b 65 79 5e 20 21 0a 27 20 63 code-key^ !.' c
0930: 6f 64 65 2d 6b 65 79 5e 20 63 6d 64 62 75 66 3a ode-key^ cmdbuf:
0940: 20 63 6f 64 65 2d 6b 65 79 0a 0a 63 6f 64 65 2d code-key..code-
0950: 6b 65 79 0a 63 6d 64 30 6c 6f 63 6b 20 30 20 70 key.cmd0lock 0 p
0960: 74 68 72 65 61 64 5f 6d 75 74 65 78 5f 69 6e 69 thread_mutex_ini
0970: 74 20 64 72 6f 70 0a 0a 3a 6e 6f 6e 61 6d 65 20 t drop..:noname
0980: 28 20 2d 2d 20 61 64 64 72 20 75 20 29 20 6b 65 ( -- addr u ) ke
0990: 79 70 61 63 6b 2d 62 75 66 20 63 6d 64 62 75 66 ypack-buf cmdbuf
09a0: 23 20 40 20 3b 20 74 6f 20 63 6d 64 62 75 66 24 # @ ; to cmdbuf$
09b0: 0a 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d 20 6e 20 .:noname ( -- n
09c0: 29 20 20 6b 65 79 70 61 63 6b 23 20 63 6d 64 62 ) keypack# cmdb
09d0: 75 66 23 20 40 20 2d 20 3b 20 74 6f 20 6d 61 78 uf# @ - ; to max
09e0: 73 74 72 69 6e 67 0a 0a 63 6f 64 65 30 2d 62 75 string..code0-bu
09f0: 66 0a 0a 3a 6e 6f 6e 61 6d 65 20 64 65 66 65 72 f..:noname defer
0a00: 73 20 61 6c 6c 6f 63 2d 63 6f 64 65 2d 62 75 66 s alloc-code-buf
0a10: 73 0a 20 20 20 20 63 6d 64 2d 6b 65 79 62 75 66 s. cmd-keybuf
0a20: 2d 63 20 6e 65 77 20 63 6f 64 65 2d 6b 65 79 5e -c new code-key^
0a30: 20 21 20 3b 20 69 73 20 61 6c 6c 6f 63 2d 63 6f ! ; is alloc-co
0a40: 64 65 2d 62 75 66 73 0a 3a 6e 6f 6e 61 6d 65 20 de-bufs.:noname
0a50: 64 65 66 65 72 73 20 66 72 65 65 2d 63 6f 64 65 defers free-code
0a60: 2d 62 75 66 73 0a 20 20 20 20 63 6f 64 65 2d 6b -bufs. code-k
0a70: 65 79 5e 20 40 20 2e 64 69 73 70 6f 73 65 20 3b ey^ @ .dispose ;
0a80: 20 69 73 20 66 72 65 65 2d 63 6f 64 65 2d 62 75 is free-code-bu
0a90: 66 73 0a 0a 5c 20 68 61 73 68 65 64 20 6b 65 79 fs..\ hashed key
0aa0: 20 64 61 74 61 20 62 61 73 65 0a 0a 56 61 72 69 data base..Vari
0ab0: 61 62 6c 65 20 67 72 6f 75 70 73 5b 5d 20 5c 20 able groups[] \
0ac0: 6e 61 6d 65 73 20 6f 66 20 67 72 6f 75 70 73 2c names of groups,
0ad0: 20 73 6f 72 74 65 64 20 62 79 20 6f 72 64 65 72 sorted by order
0ae0: 20 69 6e 20 67 72 6f 75 70 73 20 66 69 6c 65 0a in groups file.
0af0: 0a 55 73 65 72 20 3e 73 74 6f 72 65 6b 65 79 0a .User >storekey.
0b00: 56 61 72 69 61 62 6c 65 20 64 65 66 61 75 6c 74 Variable default
0b10: 6b 65 79 0a 0a 63 6d 64 2d 63 6c 61 73 73 20 63 key..cmd-class c
0b20: 6c 61 73 73 0a 20 20 20 20 66 69 65 6c 64 3a 20 lass. field:
0b30: 6b 65 2d 73 6b 20 20 20 20 20 20 20 5c 20 73 65 ke-sk \ se
0b40: 63 72 65 74 20 6b 65 79 0a 20 20 20 20 66 69 65 cret key. fie
0b50: 6c 64 3a 20 6b 65 2d 70 6b 20 20 20 20 20 20 20 ld: ke-pk
0b60: 5c 20 70 75 62 6c 69 63 20 6b 65 79 0a 20 20 20 \ public key.
0b70: 20 66 69 65 6c 64 3a 20 6b 65 2d 72 73 6b 20 20 field: ke-rsk
0b80: 20 20 20 20 5c 20 72 65 76 6f 6b 65 20 73 65 63 \ revoke sec
0b90: 72 65 74 20 28 74 65 6d 70 6f 72 61 72 69 6c 79 ret (temporarily
0ba0: 20 73 74 6f 72 65 64 29 0a 20 20 20 20 66 69 65 stored). fie
0bb0: 6c 64 3a 20 6b 65 2d 74 79 70 65 20 20 20 20 20 ld: ke-type
0bc0: 5c 20 6b 65 79 20 74 79 70 65 0a 20 20 20 20 66 \ key type. f
0bd0: 69 65 6c 64 3a 20 6b 65 2d 6e 69 63 6b 20 20 20 ield: ke-nick
0be0: 20 20 5c 20 6b 65 79 20 6e 69 63 6b 0a 20 20 20 \ key nick.
0bf0: 20 66 69 65 6c 64 3a 20 6b 65 2d 6e 69 63 6b 23 field: ke-nick#
0c00: 20 20 20 20 5c 20 74 6f 20 61 76 6f 69 64 20 63 \ to avoid c
0c10: 6f 6c 69 73 73 69 6f 6e 73 2c 20 61 64 64 20 61 olissions, add a
0c20: 20 6e 75 6d 62 65 72 20 68 65 72 65 0a 20 20 20 number here.
0c30: 20 66 69 65 6c 64 3a 20 6b 65 2d 70 65 74 73 20 field: ke-pets
0c40: 20 20 20 20 5c 20 6b 65 79 20 70 65 74 6e 61 6d \ key petnam
0c50: 65 73 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 es. field: ke
0c60: 2d 70 65 74 73 23 20 20 20 20 5c 20 74 6f 20 61 -pets# \ to a
0c70: 76 6f 69 64 20 63 6f 6c 69 73 73 69 6f 6e 73 2c void colissions,
0c80: 20 61 64 64 20 61 20 6e 75 6d 62 65 72 20 68 65 add a number he
0c90: 72 65 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 re. field: ke
0ca0: 2d 70 72 6f 66 20 20 20 20 20 5c 20 70 72 6f 66 -prof \ prof
0cb0: 69 6c 65 20 6f 62 6a 65 63 74 0a 20 20 20 20 66 ile object. f
0cc0: 69 65 6c 64 3a 20 6b 65 2d 73 65 6c 66 73 69 67 ield: ke-selfsig
0cd0: 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 2d 73 . field: ke-s
0ce0: 69 67 73 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b igs. field: k
0cf0: 65 2d 69 6d 70 6f 72 74 73 20 20 5c 20 62 69 74 e-imports \ bit
0d00: 6d 61 73 6b 20 6f 66 20 6b 65 79 20 69 6d 70 6f mask of key impo
0d10: 72 74 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 rt. field: ke
0d20: 2d 73 74 6f 72 65 6b 65 79 20 5c 20 75 73 65 64 -storekey \ used
0d30: 20 74 6f 20 65 6e 63 72 79 70 74 20 6f 6e 20 73 to encrypt on s
0d40: 74 6f 72 61 67 65 0a 20 20 20 20 66 69 65 6c 64 torage. field
0d50: 3a 20 6b 65 2d 6d 61 73 6b 20 20 20 20 20 5c 20 : ke-mask \
0d60: 70 65 72 6d 69 73 73 69 6f 6e 20 6d 61 73 6b 0a permission mask.
0d70: 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 2d 67 72 field: ke-gr
0d80: 6f 75 70 73 20 20 20 5c 20 70 72 65 6d 69 73 73 oups \ premiss
0d90: 69 6f 6e 20 67 72 6f 75 70 73 0a 20 20 20 20 36 ion groups. 6
0da0: 34 66 69 65 6c 64 3a 20 6b 65 2d 6f 66 66 73 65 4field: ke-offse
0db0: 74 20 5c 20 6f 66 66 73 65 74 20 69 6e 20 6b 65 t \ offset in ke
0dc0: 79 20 66 69 6c 65 0a 20 20 20 20 66 69 65 6c 64 y file. field
0dd0: 3a 20 6b 65 2d 70 77 6c 65 76 65 6c 20 20 5c 20 : ke-pwlevel \
0de0: 70 61 73 73 77 6f 72 64 20 73 74 72 65 6e 67 74 password strengt
0df0: 68 20 6c 65 76 65 6c 0a 20 20 20 20 30 20 2b 66 h level. 0 +f
0e00: 69 65 6c 64 20 6b 65 2d 65 6e 64 0a 65 6e 64 2d ield ke-end.end-
0e10: 63 6c 61 73 73 20 6b 65 79 2d 65 6e 74 72 79 0a class key-entry.
0e20: 0a 3a 20 66 72 65 65 2d 6b 65 79 20 28 20 6f 3a .: free-key ( o:
0e30: 6b 65 79 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 key -- o:key ).
0e40: 20 20 20 5c 67 20 66 72 65 65 20 61 6c 6c 20 70 \g free all p
0e50: 61 72 74 73 20 6f 66 20 74 68 65 20 73 75 62 6b arts of the subk
0e60: 65 79 0a 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 ey. ke-sk sec
0e70: 2d 6f 66 66 0a 20 20 20 20 6b 65 2d 70 6b 20 24 -off. ke-pk $
0e80: 6f 66 66 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 off. ke-nick
0e90: 24 6f 66 66 0a 20 20 20 20 6b 65 2d 73 65 6c 66 $off. ke-self
0ea0: 73 69 67 20 24 6f 66 66 0a 20 20 20 20 6b 65 2d sig $off. ke-
0eb0: 73 69 67 73 20 24 5b 5d 6f 66 66 0a 20 20 20 20 sigs $[]off.
0ec0: 6b 65 2d 70 65 74 73 20 24 5b 5d 6f 66 66 0a 20 ke-pets $[]off.
0ed0: 20 20 20 6b 65 2d 70 65 74 73 23 20 24 6f 66 66 ke-pets# $off
0ee0: 20 3b 0a 0a 5c 20 6b 65 79 20 63 6c 61 73 73 0a ;..\ key class.
0ef0: 0a 30 0a 65 6e 75 6d 20 6b 65 79 23 61 6e 6f 6e .0.enum key#anon
0f00: 0a 65 6e 75 6d 20 6b 65 79 23 75 73 65 72 0a 65 .enum key#user.e
0f10: 6e 75 6d 20 6b 65 79 23 67 72 6f 75 70 0a 64 72 num key#group.dr
0f20: 6f 70 0a 0a 5c 20 6b 65 79 20 69 6d 70 6f 72 74 op..\ key import
0f30: 20 74 79 70 65 0a 0a 30 0a 65 6e 75 6d 20 69 6d type..0.enum im
0f40: 70 6f 72 74 23 73 65 6c 66 20 20 20 20 20 20 5c port#self \
0f50: 20 70 72 69 76 61 74 65 20 6b 65 79 0a 65 6e 75 private key.enu
0f60: 6d 20 69 6d 70 6f 72 74 23 6d 61 6e 75 61 6c 20 m import#manual
0f70: 20 20 20 5c 20 6d 61 6e 75 61 6c 20 69 6d 70 6f \ manual impo
0f80: 72 74 0a 65 6e 75 6d 20 69 6d 70 6f 72 74 23 73 rt.enum import#s
0f90: 63 61 6e 20 20 20 20 20 20 5c 20 73 63 61 6e 20 can \ scan
0fa0: 69 6d 70 6f 72 74 0a 65 6e 75 6d 20 69 6d 70 6f import.enum impo
0fb0: 72 74 23 63 68 61 74 20 20 20 20 20 20 5c 20 73 rt#chat \ s
0fc0: 65 65 6e 20 69 6e 20 63 68 61 74 0a 65 6e 75 6d een in chat.enum
0fd0: 20 69 6d 70 6f 72 74 23 64 68 74 20 20 20 20 20 import#dht
0fe0: 20 20 5c 20 64 68 74 20 69 6d 70 6f 72 74 0a 65 \ dht import.e
0ff0: 6e 75 6d 20 69 6d 70 6f 72 74 23 69 6e 76 69 74 num import#invit
1000: 65 64 20 20 20 5c 20 69 6e 76 69 74 61 74 69 6f ed \ invitatio
1010: 6e 20 69 6d 70 6f 72 74 0a 65 6e 75 6d 20 69 6d n import.enum im
1020: 70 6f 72 74 23 75 6e 74 72 75 73 74 65 64 20 5c port#untrusted \
1030: 20 6d 75 73 74 20 62 65 20 6c 61 73 74 0a 64 72 must be last.dr
1040: 6f 70 0a 24 31 46 20 65 6e 75 6d 20 69 6d 70 6f op.$1F enum impo
1050: 72 74 23 6e 65 77 20 20 20 5c 20 6e 65 77 20 66 rt#new \ new f
1060: 6f 72 6d 61 74 0a 64 72 6f 70 0a 0a 43 72 65 61 ormat.drop..Crea
1070: 74 65 20 69 6d 70 6f 72 74 73 24 20 24 32 30 20 te imports$ $20
1080: 61 6c 6c 6f 74 20 69 6d 70 6f 72 74 73 24 20 24 allot imports$ $
1090: 32 30 20 62 6c 20 66 69 6c 6c 0a 22 49 6d 73 63 20 bl fill."Imsc
10a0: 64 69 75 22 20 69 6d 70 6f 72 74 73 24 20 73 77 diu" imports$ sw
10b0: 61 70 20 6d 6f 76 65 0a 0a 56 61 72 69 61 62 6c ap move..Variabl
10c0: 65 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 20 69 e import-type i
10d0: 6d 70 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 mport#new import
10e0: 2d 74 79 70 65 20 21 0a 0a 43 72 65 61 74 65 20 -type !..Create
10f0: 3e 69 6d 2d 63 6f 6c 6f 72 20 20 24 42 36 30 20 >im-color $B60
1100: 2c 20 24 44 36 30 20 2c 20 24 39 36 30 20 2c 20 , $D60 , $960 ,
1110: 24 43 36 30 20 2c 20 24 41 36 30 20 2c 20 24 38 $C60 , $A60 , $8
1120: 42 31 20 2c 20 24 45 36 30 20 2c 0a 44 4f 45 53 B1 , $E60 ,.DOES
1130: 3e 20 73 77 61 70 20 38 20 63 65 6c 6c 73 20 30 > swap 8 cells 0
1140: 20 44 4f 20 20 64 75 70 20 31 20 61 6e 64 20 49 DO dup 1 and I
1150: 46 20 20 64 72 6f 70 20 49 20 4c 45 41 56 45 20 F drop I LEAVE
1160: 20 54 48 45 4e 20 20 32 2f 20 20 4c 4f 4f 50 0a THEN 2/ LOOP.
1170: 20 20 63 65 6c 6c 73 20 2b 20 40 20 61 74 74 72 cells + @ attr
1180: 21 20 3b 0a 0a 3a 20 2e 69 6d 70 6f 72 74 73 20 ! ;..: .imports
1190: 28 20 6d 61 73 6b 20 2d 2d 20 29 0a 20 20 20 20 ( mask -- ).
11a0: 69 6d 70 6f 72 74 73 24 20 69 6d 70 6f 72 74 23 imports$ import#
11b0: 6e 65 77 20 62 6f 75 6e 64 73 20 44 4f 0a 09 64 new bounds DO..d
11c0: 75 70 20 31 20 61 6e 64 20 49 46 20 20 49 20 63 up 1 and IF I c
11d0: 40 20 65 6d 69 74 20 20 54 48 45 4e 20 20 32 2f @ emit THEN 2/
11e0: 20 4c 4f 4f 50 0a 20 20 20 20 64 72 6f 70 20 3b LOOP. drop ;
11f0: 0a 0a 5c 20 73 61 6d 70 6c 65 20 6b 65 79 0a 0a ..\ sample key..
1200: 6b 65 79 2d 65 6e 74 72 79 20 27 20 6e 65 77 20 key-entry ' new
1210: 73 74 61 74 69 63 2d 61 20 77 69 74 68 2d 61 6c static-a with-al
1220: 6c 6f 63 61 74 65 72 20 43 6f 6e 73 74 61 6e 74 locater Constant
1230: 20 73 61 6d 70 6c 65 2d 6b 65 79 0a 0a 56 61 72 sample-key..Var
1240: 69 61 62 6c 65 20 6b 65 79 23 20 5c 20 6b 65 79 iable key# \ key
1250: 20 68 61 73 68 20 74 61 62 6c 65 0a 56 61 72 69 hash table.Vari
1260: 61 62 6c 65 20 6e 69 63 6b 23 20 5c 20 6e 69 63 able nick# \ nic
1270: 6b 20 68 61 73 68 20 74 61 62 6c 65 0a 0a 36 34 k hash table..64
1280: 56 61 72 69 61 62 6c 65 20 6b 65 79 2d 72 65 61 Variable key-rea
1290: 64 2d 6f 66 66 73 65 74 0a 0a 3a 20 63 75 72 72 d-offset..: curr
12a0: 65 6e 74 2d 6b 65 79 20 28 20 61 64 64 72 20 75 ent-key ( addr u
12b0: 20 2d 2d 20 6f 20 29 0a 20 20 20 20 32 64 75 70 -- o ). 2dup
12c0: 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 64 72 key| key# #@ dr
12d0: 6f 70 0a 20 20 20 20 64 75 70 20 30 3d 20 49 46 op. dup 0= IF
12e0: 20 20 64 72 6f 70 20 2e 22 20 75 6e 6b 6e 6f 77 drop ." unknow
12f0: 6e 20 6b 65 79 3a 20 22 20 38 35 74 79 70 65 20 n key: " 85type
1300: 63 72 20 20 30 20 45 58 49 54 20 20 54 48 45 4e cr 0 EXIT THEN
1310: 0a 20 20 20 20 63 65 6c 6c 2b 20 3e 6f 20 6b 65 . cell+ >o ke
1320: 2d 70 6b 20 24 21 20 6f 20 6f 3e 20 3b 0a 0a 56 -pk $! o o> ;..V
1330: 61 72 69 61 62 6c 65 20 73 69 6d 2d 6e 69 63 6b ariable sim-nick
1340: 21 0a 0a 3a 20 6e 69 63 6b 21 20 28 20 2d 2d 20 !..: nick! ( --
1350: 29 20 73 69 6d 2d 6e 69 63 6b 21 20 40 20 3f 45 ) sim-nick! @ ?E
1360: 58 49 54 20 20 6f 20 7b 20 77 5e 20 6f 70 74 72 XIT o { w^ optr
1370: 20 7d 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 24 }. ke-nick $
1380: 40 20 6e 69 63 6b 23 20 23 40 20 64 30 3d 20 49 @ nick# #@ d0= I
1390: 46 0a 09 6f 70 74 72 20 63 65 6c 6c 20 6b 65 2d F..optr cell ke-
13a0: 6e 69 63 6b 20 24 40 20 6e 69 63 6b 23 20 23 21 nick $@ nick# #!
13b0: 20 30 0a 20 20 20 20 45 4c 53 45 0a 09 6c 61 73 0. ELSE..las
13c0: 74 23 20 63 65 6c 6c 2b 20 24 40 6c 65 6e 20 63 t# cell+ $@len c
13d0: 65 6c 6c 2f 0a 09 6f 70 74 72 20 63 65 6c 6c 20 ell/..optr cell
13e0: 6c 61 73 74 23 20 63 65 6c 6c 2b 20 24 2b 21 0a last# cell+ $+!.
13f0: 20 20 20 20 54 48 45 4e 20 20 6b 65 2d 6e 69 63 THEN ke-nic
1400: 6b 23 20 21 20 3b 0a 0a 3a 20 23 2e 6e 69 63 6b k# ! ;..: #.nick
1410: 20 28 20 68 61 73 68 20 2d 2d 20 29 0a 20 20 20 ( hash -- ).
1420: 20 64 75 70 20 24 40 20 74 79 70 65 20 27 23 27 dup $@ type '#'
1430: 20 65 6d 69 74 20 63 65 6c 6c 2b 20 24 40 6c 65 emit cell+ $@le
1440: 6e 20 63 65 6c 6c 2f 20 2e 20 3b 0a 0a 3a 20 6c n cell/ . ;..: l
1450: 61 73 74 2d 70 65 74 40 20 28 20 2d 2d 20 61 64 ast-pet@ ( -- ad
1460: 64 72 20 75 20 29 0a 20 20 20 20 6b 65 2d 70 65 dr u ). ke-pe
1470: 74 73 20 24 5b 5d 23 20 3f 64 75 70 2d 49 46 20 ts $[]# ?dup-IF
1480: 20 31 2d 20 6b 65 2d 70 65 74 73 20 24 5b 5d 40 1- ke-pets $[]@
1490: 20 20 45 4c 53 45 20 20 23 30 2e 20 20 54 48 45 ELSE #0. THE
14a0: 4e 20 3b 0a 0a 3a 20 70 65 74 21 20 28 20 2d 2d N ;..: pet! ( --
14b0: 20 29 20 73 69 6d 2d 6e 69 63 6b 21 20 40 20 3f ) sim-nick! @ ?
14c0: 45 58 49 54 20 20 6f 20 7b 20 77 5e 20 6f 70 74 EXIT o { w^ opt
14d0: 72 20 7d 0a 20 20 20 20 6c 61 73 74 2d 70 65 74 r }. last-pet
14e0: 40 20 6e 69 63 6b 23 20 23 40 20 64 30 3d 20 49 @ nick# #@ d0= I
14f0: 46 0a 09 6f 70 74 72 20 63 65 6c 6c 20 6c 61 73 F..optr cell las
1500: 74 2d 70 65 74 40 20 6e 69 63 6b 23 20 23 21 20 t-pet@ nick# #!
1510: 30 0a 20 20 20 20 45 4c 53 45 0a 09 6c 61 73 74 0. ELSE..last
1520: 23 20 63 65 6c 6c 2b 20 24 40 6c 65 6e 20 63 65 # cell+ $@len ce
1530: 6c 6c 2f 0a 09 6f 70 74 72 20 63 65 6c 6c 20 6c ll/..optr cell l
1540: 61 73 74 23 20 63 65 6c 6c 2b 20 24 2b 21 0a 20 ast# cell+ $+!.
1550: 20 20 20 54 48 45 4e 20 20 6b 65 2d 70 65 74 73 THEN ke-pets
1560: 20 24 5b 5d 23 20 31 2d 20 6b 65 2d 70 65 74 73 $[]# 1- ke-pets
1570: 23 20 24 5b 5d 20 21 20 3b 0a 0a 3a 20 6b 65 79 # $[] ! ;..: key
1580: 3a 6e 65 77 20 28 20 61 64 64 72 20 75 20 2d 2d :new ( addr u --
1590: 20 6f 20 29 0a 20 20 20 20 5c 47 20 63 72 65 61 o ). \G crea
15a0: 74 65 20 6e 65 77 20 6b 65 79 2c 20 61 64 64 72 te new key, addr
15b0: 20 75 20 69 73 20 74 68 65 20 70 75 62 6c 69 63 u is the public
15c0: 20 6b 65 79 0a 20 20 20 20 73 61 6d 70 6c 65 2d key. sample-
15d0: 6b 65 79 20 3e 6f 20 20 6b 65 2d 73 6b 20 6b 65 key >o ke-sk ke
15e0: 2d 65 6e 64 20 6f 76 65 72 20 2d 20 65 72 61 73 -end over - eras
15f0: 65 0a 20 20 20 20 6b 65 79 2d 65 6e 74 72 79 2d e. key-entry-
1600: 74 61 62 6c 65 20 40 20 74 6f 6b 65 6e 2d 74 61 table @ token-ta
1610: 62 6c 65 20 21 0a 20 20 20 20 3e 73 74 6f 72 65 ble !. >store
1620: 6b 65 79 20 40 20 6b 65 2d 73 74 6f 72 65 6b 65 key @ ke-storeke
1630: 79 20 21 0a 20 20 20 20 6b 65 79 2d 72 65 61 64 y !. key-read
1640: 2d 6f 66 66 73 65 74 20 36 34 40 20 6b 65 2d 6f -offset 64@ ke-o
1650: 66 66 73 65 74 20 36 34 21 0a 20 20 20 20 31 20 ffset 64!. 1
1660: 69 6d 70 6f 72 74 2d 74 79 70 65 20 40 20 6c 73 import-type @ ls
1670: 68 69 66 74 20 5b 20 31 20 69 6d 70 6f 72 74 23 hift [ 1 import#
1680: 6e 65 77 20 6c 73 68 69 66 74 20 5d 4c 20 6f 72 new lshift ]L or
1690: 20 6b 65 2d 69 6d 70 6f 72 74 73 20 21 0a 20 20 ke-imports !.
16a0: 20 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 6e keypack-all# n
16b0: 3e 36 34 20 6b 65 79 2d 72 65 61 64 2d 6f 66 66 >64 key-read-off
16c0: 73 65 74 20 36 34 2b 21 20 6f 20 63 65 6c 6c 2d set 64+! o cell-
16d0: 20 6b 65 2d 65 6e 64 20 6f 76 65 72 20 2d 0a 20 ke-end over -.
16e0: 20 20 20 32 6f 76 65 72 20 6b 65 79 7c 20 6b 65 2over key| ke
16f0: 79 23 20 23 21 20 6f 3e 0a 20 20 20 20 63 75 72 y# #! o>. cur
1700: 72 65 6e 74 2d 6b 65 79 20 3b 0a 0a 30 20 56 61 rent-key ;..0 Va
1710: 6c 75 65 20 6c 61 73 74 2d 6b 65 79 0a 0a 3a 20 lue last-key..:
1720: 6b 65 79 3f 6e 65 77 20 28 20 61 64 64 72 20 75 key?new ( addr u
1730: 20 2d 2d 20 6f 20 29 0a 20 20 20 20 5c 47 20 43 -- o ). \G C
1740: 72 65 61 74 65 20 6f 72 20 6c 6f 6f 6b 75 70 20 reate or lookup
1750: 6e 65 77 20 6b 65 79 0a 20 20 20 20 32 64 75 70 new key. 2dup
1760: 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 64 72 key| key# #@ dr
1770: 6f 70 0a 20 20 20 20 64 75 70 20 30 3d 20 49 46 op. dup 0= IF
1780: 20 20 64 72 6f 70 20 6b 65 79 3a 6e 65 77 0a 20 drop key:new.
1790: 20 20 20 45 4c 53 45 20 20 6e 69 70 20 6e 69 70 ELSE nip nip
17a0: 20 63 65 6c 6c 2b 20 20 31 20 69 6d 70 6f 72 74 cell+ 1 import
17b0: 2d 74 79 70 65 20 40 20 6c 73 68 69 66 74 20 6f -type @ lshift o
17c0: 76 65 72 20 2e 6b 65 2d 69 6d 70 6f 72 74 73 20 ver .ke-imports
17d0: 6f 72 21 20 20 54 48 45 4e 0a 20 20 20 20 64 75 or! THEN. du
17e0: 70 20 74 6f 20 6c 61 73 74 2d 6b 65 79 20 3b 0a p to last-key ;.
17f0: 0a 5c 20 73 65 61 72 63 68 20 66 6f 72 20 6b 65 .\ search for ke
1800: 79 73 20 2d 20 6e 6f 74 20 6f 70 74 69 6d 69 7a ys - not optimiz
1810: 65 64 0a 0a 3a 20 23 73 70 6c 69 74 20 28 20 61 ed..: #split ( a
1820: 64 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 20 ddr u -- addr u
1830: 6e 20 29 0a 20 20 20 20 5b 3a 20 32 64 75 70 20 n ). [: 2dup
1840: 27 23 27 20 2d 73 63 61 6e 20 6e 69 70 20 3e 72 '#' -scan nip >r
1850: 0a 20 20 20 20 20 20 72 40 20 30 3d 20 49 46 20 . r@ 0= IF
1860: 20 72 64 72 6f 70 20 30 20 20 45 58 49 54 20 20 rdrop 0 EXIT
1870: 54 48 45 4e 0a 20 20 20 20 20 20 23 30 2e 20 32 THEN. #0. 2
1880: 6f 76 65 72 20 72 40 20 2f 73 74 72 69 6e 67 20 over r@ /string
1890: 3e 6e 75 6d 62 65 72 0a 20 20 20 20 20 20 30 3d >number. 0=
18a0: 20 49 46 20 20 6e 69 70 20 64 72 6f 70 20 6e 69 IF nip drop ni
18b0: 70 20 72 3e 20 31 2d 20 73 77 61 70 20 20 45 4c p r> 1- swap EL
18c0: 53 45 0a 09 20 20 72 64 72 6f 70 20 64 72 6f 70 SE.. rdrop drop
18d0: 20 32 64 72 6f 70 20 30 20 20 20 54 48 45 4e 20 2drop 0 THEN
18e0: 3b 5d 20 23 31 30 20 62 61 73 65 2d 65 78 65 63 ;] #10 base-exec
18f0: 75 74 65 20 3b 0a 0a 3a 20 6e 69 63 6b 2d 6b 65 ute ;..: nick-ke
1900: 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 6f 20 y ( addr u -- o
1910: 2f 20 30 20 29 20 5c 20 73 65 61 72 63 68 20 66 / 0 ) \ search f
1920: 6f 72 20 6b 65 79 20 6e 69 63 6b 6e 61 6d 65 0a or key nickname.
1930: 20 20 20 20 23 73 70 6c 69 74 20 3e 72 20 6e 69 #split >r ni
1940: 63 6b 23 20 23 40 20 32 64 75 70 20 64 30 3d 20 ck# #@ 2dup d0=
1950: 49 46 20 20 72 64 72 6f 70 20 64 72 6f 70 20 20 IF rdrop drop
1960: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 72 EXIT THEN. r
1970: 3e 20 63 65 6c 6c 73 20 73 61 66 65 2f 73 74 72 > cells safe/str
1980: 69 6e 67 20 30 3d 20 49 46 20 20 64 72 6f 70 20 ing 0= IF drop
1990: 30 20 20 45 58 49 54 20 20 54 48 45 4e 20 20 40 0 EXIT THEN @
19a0: 20 3b 0a 0a 3a 20 73 65 63 72 65 74 2d 6b 65 79 ;..: secret-key
19b0: 73 23 20 28 20 2d 2d 20 6e 20 29 0a 20 20 20 20 s# ( -- n ).
19c0: 30 20 6b 65 79 23 20 5b 3a 20 63 65 6c 6c 2b 20 0 key# [: cell+
19d0: 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f $@ drop cell+ >o
19e0: 20 6b 65 2d 73 6b 20 40 20 30 3c 3e 20 2d 20 6f ke-sk @ 0<> - o
19f0: 3e 20 3b 5d 20 23 6d 61 70 20 3b 0a 3a 20 73 65 > ;] #map ;.: se
1a00: 63 72 65 74 2d 6b 65 79 20 28 20 6e 20 2d 2d 20 cret-key ( n --
1a10: 6f 2f 30 20 29 0a 20 20 20 20 30 20 74 75 63 6b o/0 ). 0 tuck
1a20: 20 6b 65 79 23 20 5b 3a 20 63 65 6c 6c 2b 20 24 key# [: cell+ $
1a30: 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 20 @ drop cell+ >o
1a40: 6b 65 2d 73 6b 20 40 20 49 46 0a 09 20 20 32 64 ke-sk @ IF.. 2d
1a50: 75 70 20 3d 20 49 46 20 20 72 6f 74 20 64 72 6f up = IF rot dro
1a60: 70 20 6f 20 2d 72 6f 74 20 20 54 48 45 4e 20 20 p o -rot THEN
1a70: 31 2b 0a 20 20 20 20 20 20 54 48 45 4e 20 20 6f 1+. THEN o
1a80: 3e 20 3b 5d 20 23 6d 61 70 20 32 64 72 6f 70 20 > ;] #map 2drop
1a90: 3b 0a 3a 20 2e 23 20 28 20 6e 20 2d 2d 20 29 20 ;.: .# ( n -- )
1aa0: 3f 64 75 70 2d 49 46 20 20 27 23 27 20 65 6d 69 ?dup-IF '#' emi
1ab0: 74 20 30 20 2e 72 20 20 54 48 45 4e 20 3b 0a 3a t 0 .r THEN ;.:
1ac0: 20 2e 6e 69 63 6b 2d 62 61 73 65 20 28 20 6f 3a .nick-base ( o:
1ad0: 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d key -- ). ke-
1ae0: 6e 69 63 6b 20 24 2e 20 20 6b 65 2d 6e 69 63 6b nick $. ke-nick
1af0: 23 20 40 20 2e 23 20 3b 0a 3a 20 2e 70 65 74 2d # @ .# ;.: .pet-
1b00: 62 61 73 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 base ( o:key --
1b10: 29 0a 20 20 20 20 30 20 6b 65 2d 70 65 74 73 20 ). 0 ke-pets
1b20: 5b 3a 20 73 70 61 63 65 20 74 79 70 65 0a 20 20 [: space type.
1b30: 20 20 20 20 64 75 70 20 6b 65 2d 70 65 74 73 23 dup ke-pets#
1b40: 20 24 5b 5d 20 40 20 2e 23 20 20 31 2b 20 3b 5d $[] @ .# 1+ ;]
1b50: 20 24 5b 5d 6d 61 70 20 64 72 6f 70 20 3b 0a 3a $[]map drop ;.:
1b60: 20 2e 70 65 74 30 2d 62 61 73 65 20 28 20 6f 3a .pet0-base ( o:
1b70: 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d key -- ). ke-
1b80: 70 65 74 73 20 24 5b 5d 23 20 49 46 20 20 30 20 pets $[]# IF 0
1b90: 6b 65 2d 70 65 74 73 20 24 5b 5d 40 20 74 79 70 ke-pets $[]@ typ
1ba0: 65 20 30 20 6b 65 2d 70 65 74 73 23 20 24 5b 5d e 0 ke-pets# $[]
1bb0: 20 40 20 2e 23 0a 20 20 20 20 45 4c 53 45 20 20 @ .#. ELSE
1bc0: 2e 6e 69 63 6b 2d 62 61 73 65 20 20 54 48 45 4e .nick-base THEN
1bd0: 20 3b 0a 3a 20 2e 72 65 61 6c 2d 6e 69 63 6b 20 ;.: .real-nick
1be0: 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 20 20 20 6b ( o:key -- ) k
1bf0: 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e 69 6d 2d e-imports @ >im-
1c00: 63 6f 6c 6f 72 20 2e 6e 69 63 6b 2d 62 61 73 65 color .nick-base
1c10: 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 3a 20 2e <default> ;.: .
1c20: 6e 69 63 6b 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 nick ( o:key --
1c30: 29 20 20 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 ) ke-imports @
1c40: 20 3e 69 6d 2d 63 6f 6c 6f 72 20 2e 70 65 74 30 >im-color .pet0
1c50: 2d 62 61 73 65 20 3c 64 65 66 61 75 6c 74 3e 20 -base <default>
1c60: 3b 0a 3a 20 2e 6e 69 63 6b 2b 70 65 74 20 28 20 ;.: .nick+pet (
1c70: 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b o:key -- ). k
1c80: 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e 69 6d 2d e-imports @ >im-
1c90: 63 6f 6c 6f 72 20 2e 6e 69 63 6b 2d 62 61 73 65 color .nick-base
1ca0: 20 2e 70 65 74 2d 62 61 73 65 20 3c 64 65 66 61 .pet-base <defa
1cb0: 75 6c 74 3e 20 3b 0a 0a 3a 20 6e 69 63 6b 3e 70 ult> ;..: nick>p
1cc0: 6b 20 28 20 6e 69 63 6b 20 75 20 2d 2d 20 70 6b k ( nick u -- pk
1cd0: 20 75 20 29 0a 20 20 20 20 6e 69 63 6b 2d 6b 65 u ). nick-ke
1ce0: 79 20 3f 64 75 70 2d 49 46 20 2e 6b 65 2d 70 6b y ?dup-IF .ke-pk
1cf0: 20 24 40 20 45 4c 53 45 20 30 20 30 20 54 48 45 $@ ELSE 0 0 THE
1d00: 4e 20 3b 0a 3a 20 68 6f 73 74 2e 6e 69 63 6b 3e N ;.: host.nick>
1d10: 70 6b 20 28 20 61 64 64 72 20 75 20 2d 2d 20 70 pk ( addr u -- p
1d20: 6b 20 75 27 20 29 0a 20 20 20 20 27 2e 27 20 24 k u' ). '.' $
1d30: 73 70 6c 69 74 20 64 75 70 20 30 3d 20 49 46 20 split dup 0= IF
1d40: 20 32 73 77 61 70 20 20 54 48 45 4e 20 5b 3a 20 2swap THEN [:
1d50: 6e 69 63 6b 3e 70 6b 20 74 79 70 65 20 74 79 70 nick>pk type typ
1d60: 65 20 3b 5d 20 24 74 6d 70 20 3b 0a 0a 3a 20 6b e ;] $tmp ;..: k
1d70: 65 79 2d 65 78 69 73 74 3f 20 28 20 61 64 64 72 ey-exist? ( addr
1d80: 20 75 20 2d 2d 20 6f 2f 30 20 29 0a 20 20 20 20 u -- o/0 ).
1d90: 6b 65 79 23 20 23 40 20 49 46 20 20 63 65 6c 6c key# #@ IF cell
1da0: 2b 20 20 54 48 45 4e 20 3b 20 0a 0a 5c 20 70 65 + THEN ; ..\ pe
1db0: 72 6d 69 73 73 69 6f 6e 20 6d 6f 64 69 66 69 63 rmission modific
1dc0: 61 74 69 6f 6e 0a 0a 32 36 20 62 75 66 66 65 72 ation..26 buffer
1dd0: 3a 20 70 65 72 6d 2d 63 68 61 72 73 0a 30 20 70 : perm-chars.0 p
1de0: 65 72 6d 24 20 63 6f 75 6e 74 20 62 6f 75 6e 64 erm$ count bound
1df0: 73 20 5b 44 4f 5d 20 64 75 70 20 5b 49 5d 20 63 s [DO] dup [I] c
1e00: 40 20 27 61 27 20 2d 20 70 65 72 6d 2d 63 68 61 @ 'a' - perm-cha
1e10: 72 73 20 2b 20 63 21 20 31 2b 20 5b 4c 4f 4f 50 rs + c! 1+ [LOOP
1e20: 5d 20 64 72 6f 70 0a 0a 3a 20 2e 70 65 72 6d 20 ] drop..: .perm
1e30: 28 20 70 65 72 6d 69 73 73 69 6f 6e 20 2d 2d 20 ( permission --
1e40: 29 20 20 31 20 70 65 72 6d 24 20 63 6f 75 6e 74 ) 1 perm$ count
1e50: 20 62 6f 75 6e 64 73 20 44 4f 0a 09 32 64 75 70 bounds DO..2dup
1e60: 20 61 6e 64 20 30 3c 3e 20 49 20 63 40 20 27 2d and 0<> I c@ '-
1e70: 27 20 72 6f 74 20 73 65 6c 65 63 74 20 65 6d 69 ' rot select emi
1e80: 74 20 32 2a 0a 20 20 20 20 4c 4f 4f 50 20 20 32 t 2*. LOOP 2
1e90: 64 72 6f 70 20 3b 0a 3a 20 70 65 72 6d 61 6e 64 drop ;.: permand
1ea0: 20 28 20 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f ( permand permo
1eb0: 72 20 6e 65 77 20 2d 2d 20 70 65 72 6d 61 6e 64 r new -- permand
1ec0: 27 20 70 65 72 6d 6f 72 20 29 0a 20 20 20 20 69 ' permor ). i
1ed0: 6e 76 65 72 74 20 74 75 63 6b 20 61 6e 64 20 3e nvert tuck and >
1ee0: 72 20 61 6e 64 20 72 3e 20 3b 0a 3a 20 3e 70 65 r and r> ;.: >pe
1ef0: 72 6d 2d 6d 6f 64 20 28 20 70 65 72 6d 61 6e 64 rm-mod ( permand
1f00: 20 70 65 72 6d 6f 72 20 2d 2d 20 70 65 72 6d 61 permor -- perma
1f10: 6e 64 27 20 70 65 72 6d 6f 72 20 29 0a 20 20 20 nd' permor ).
1f20: 20 73 77 61 70 20 64 75 70 20 30 3d 20 49 46 20 swap dup 0= IF
1f30: 20 64 72 6f 70 20 64 75 70 20 69 6e 76 65 72 74 drop dup invert
1f40: 20 20 54 48 45 4e 20 73 77 61 70 20 3b 0a 3a 20 THEN swap ;.:
1f50: 3e 70 65 72 6d 20 28 20 61 64 64 72 20 75 20 2d >perm ( addr u -
1f60: 2d 20 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72 - permand permor
1f70: 20 29 0a 20 20 20 20 5c 47 20 70 61 72 73 65 20 ). \G parse
1f80: 70 65 72 6d 69 73 73 69 6f 6e 73 3a 20 2b 20 61 permissions: + a
1f90: 64 64 73 2c 20 2d 20 72 65 6d 6f 76 65 73 20 70 dds, - removes p
1fa0: 65 72 6d 69 73 73 69 6f 6e 73 2c 0a 20 20 20 20 ermissions,.
1fb0: 5c 47 20 6e 6f 20 6d 6f 64 69 66 69 65 72 20 73 \G no modifier s
1fc0: 65 74 73 20 70 65 72 6d 69 73 73 6f 6e 73 2e 0a ets permissons..
1fd0: 20 20 20 20 30 20 30 20 5b 27 5d 20 6f 72 20 7b 0 0 ['] or {
1fe0: 20 78 74 20 7d 0a 20 20 20 20 32 73 77 61 70 20 xt }. 2swap
1ff0: 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 20 63 40 bounds ?DO..I c@
2000: 20 63 61 73 65 0a 09 20 20 20 20 27 2b 27 20 6f case.. '+' o
2010: 66 20 20 3e 70 65 72 6d 2d 6d 6f 64 20 5b 27 5d f >perm-mod [']
2020: 20 6f 72 20 74 6f 20 78 74 20 65 6e 64 6f 66 0a or to xt endof.
2030: 09 20 20 20 20 27 2d 27 20 6f 66 20 20 3e 70 65 . '-' of >pe
2040: 72 6d 2d 6d 6f 64 20 5b 27 5d 20 70 65 72 6d 61 rm-mod ['] perma
2050: 6e 64 20 74 6f 20 78 74 20 20 65 6e 64 6f 66 0a nd to xt endof.
2060: 09 20 20 20 20 27 3d 27 20 6f 66 20 20 32 64 72 . '=' of 2dr
2070: 6f 70 20 70 65 72 6d 25 64 65 66 61 75 6c 74 20 op perm%default
2080: 64 75 70 20 5b 27 5d 20 6f 72 20 74 6f 20 78 74 dup ['] or to xt
2090: 20 20 65 6e 64 6f 66 0a 09 20 20 20 20 27 61 27 endof.. 'a'
20a0: 20 2d 20 64 75 70 20 27 7a 27 20 75 3c 3d 20 20 - dup 'z' u<=
20b0: 49 46 0a 09 09 70 65 72 6d 2d 63 68 61 72 73 20 IF...perm-chars
20c0: 2b 20 63 40 20 31 20 73 77 61 70 20 6c 73 68 69 + c@ 1 swap lshi
20d0: 66 74 20 78 74 20 65 78 65 63 75 74 65 0a 09 09 ft xt execute...
20e0: 30 20 28 20 64 75 6d 6d 79 20 66 6f 72 20 65 6e 0 ( dummy for en
20f0: 64 63 61 73 65 20 29 0a 09 20 20 20 20 54 48 45 dcase ).. THE
2100: 4e 20 20 65 6e 64 63 61 73 65 0a 20 20 20 20 4c N endcase. L
2110: 4f 4f 50 20 3b 0a 3a 20 2e 70 65 72 6d 61 6e 64 OOP ;.: .permand
2120: 6f 72 20 28 20 70 65 72 6d 61 6e 64 20 70 65 72 or ( permand per
2130: 6d 6f 72 20 2d 2d 20 29 0a 20 20 20 20 30 20 7b mor -- ). 0 {
2140: 20 2b 2d 20 7d 0a 20 20 20 20 31 20 70 65 72 6d +- }. 1 perm
2150: 24 20 63 6f 75 6e 74 20 62 6f 75 6e 64 73 20 44 $ count bounds D
2160: 4f 20 20 3e 72 0a 09 6f 76 65 72 20 72 40 20 61 O >r..over r@ a
2170: 6e 64 20 30 3d 20 49 46 20 20 27 2d 27 20 64 75 nd 0= IF '-' du
2180: 70 20 2b 2d 20 3c 3e 20 49 46 20 20 64 75 70 20 p +- <> IF dup
2190: 74 6f 20 2b 2d 20 65 6d 69 74 0a 09 20 20 20 20 to +- emit..
21a0: 45 4c 53 45 20 20 64 72 6f 70 20 20 54 48 45 4e ELSE drop THEN
21b0: 20 72 3e 20 20 49 20 63 40 20 65 6d 69 74 20 20 r> I c@ emit
21c0: 3e 72 20 54 48 45 4e 0a 09 64 75 70 20 20 72 40 >r THEN..dup r@
21d0: 20 61 6e 64 20 20 20 20 49 46 20 20 27 2b 27 20 and IF '+'
21e0: 64 75 70 20 2b 2d 20 3c 3e 20 49 46 20 20 64 75 dup +- <> IF du
21f0: 70 20 74 6f 20 2b 2d 20 65 6d 69 74 0a 09 20 20 p to +- emit..
2200: 20 20 45 4c 53 45 20 20 64 72 6f 70 20 20 54 48 ELSE drop TH
2210: 45 4e 20 72 3e 20 20 49 20 63 40 20 65 6d 69 74 EN r> I c@ emit
2220: 20 20 3e 72 20 54 48 45 4e 0a 09 72 3e 20 32 2a >r THEN..r> 2*
2230: 0a 20 20 20 20 4c 4f 4f 50 20 20 64 72 6f 70 20 . LOOP drop
2240: 32 64 72 6f 70 20 3b 0a 0a 5c 20 72 65 61 64 20 2drop ;..\ read
2250: 69 6e 20 70 65 72 6d 69 73 73 69 6f 6e 20 67 72 in permission gr
2260: 6f 75 70 73 2c 20 67 72 6f 75 70 73 20 69 73 20 oups, groups is
2270: 69 6e 20 74 68 65 20 2e 6e 65 74 32 6f 20 64 69 in the .net2o di
2280: 72 65 63 74 6f 72 79 0a 0a 3a 20 3e 67 72 6f 75 rectory..: >grou
2290: 70 2d 69 64 20 28 20 61 64 64 72 20 75 20 2d 2d p-id ( addr u --
22a0: 20 69 64 2f 2d 31 20 29 0a 20 20 20 20 2d 31 20 id/-1 ). -1
22b0: 30 20 67 72 6f 75 70 73 5b 5d 20 5b 3a 20 32 73 0 groups[] [: 2s
22c0: 77 61 70 20 32 3e 72 20 32 20 63 65 6c 6c 73 20 wap 2>r 2 cells
22d0: 2f 73 74 72 69 6e 67 0a 20 20 20 20 20 20 32 6f /string. 2o
22e0: 76 65 72 20 73 74 72 69 6e 67 2d 70 72 65 66 69 ver string-prefi
22f0: 78 3f 20 49 46 20 20 32 72 3e 20 6e 69 70 20 64 x? IF 2r> nip d
2300: 75 70 0a 20 20 20 20 20 20 45 4c 53 45 20 20 32 up. ELSE 2
2310: 72 3e 20 20 54 48 45 4e 20 20 31 2b 20 3b 5d 20 r> THEN 1+ ;]
2320: 24 5b 5d 6d 61 70 0a 20 20 20 20 32 6e 69 70 20 $[]map. 2nip
2330: 64 72 6f 70 20 3b 0a 0a 3a 20 3e 67 72 6f 75 70 drop ;..: >group
2340: 73 20 28 20 61 64 64 72 20 75 20 70 61 6e 64 20 s ( addr u pand
2350: 70 6f 72 20 2d 2d 20 29 0a 20 20 20 20 73 22 20 por -- ). s"
2360: 22 20 67 72 6f 75 70 73 5b 5d 20 24 2b 5b 5d 21 " groups[] $+[]!
2370: 0a 20 20 20 20 5b 3a 20 7b 20 64 5e 20 70 61 6e . [: { d^ pan
2380: 64 6f 72 20 7d 20 70 61 6e 64 6f 72 20 32 20 63 dor } pandor 2 c
2390: 65 6c 6c 73 20 74 79 70 65 20 20 74 79 70 65 20 ells type type
23a0: 3b 5d 0a 20 20 20 20 67 72 6f 75 70 73 5b 5d 20 ;]. groups[]
23b0: 64 75 70 20 24 5b 5d 23 20 31 2d 20 73 77 61 70 dup $[]# 1- swap
23c0: 20 24 5b 5d 20 24 65 78 65 63 20 3b 0a 0a 3a 20 $[] $exec ;..:
23d0: 69 6e 69 74 2d 67 72 6f 75 70 73 20 28 20 2d 2d init-groups ( --
23e0: 20 29 0a 20 20 20 20 22 6d 79 73 65 6c 66 22 20 ). "myself"
23f0: 20 70 65 72 6d 25 6d 79 73 65 6c 66 20 20 64 75 perm%myself du
2400: 70 20 3e 67 72 6f 75 70 73 0a 20 20 20 20 22 70 p >groups. "p
2410: 65 65 72 22 20 20 20 20 70 65 72 6d 25 64 65 66 eer" perm%def
2420: 61 75 6c 74 20 64 75 70 20 3e 67 72 6f 75 70 73 ault dup >groups
2430: 0a 20 20 20 20 22 75 6e 6b 6e 6f 77 6e 22 20 70 . "unknown" p
2440: 65 72 6d 25 75 6e 6b 6e 6f 77 6e 20 64 75 70 20 erm%unknown dup
2450: 3e 67 72 6f 75 70 73 0a 20 20 20 20 22 62 6c 6f >groups. "blo
2460: 63 6b 65 64 22 20 70 65 72 6d 25 62 6c 6f 63 6b cked" perm%block
2470: 65 64 20 70 65 72 6d 25 69 6e 64 69 72 65 63 74 ed perm%indirect
2480: 20 6f 72 20 64 75 70 20 3e 67 72 6f 75 70 73 20 or dup >groups
2490: 3b 0a 0a 69 6e 69 74 2d 67 72 6f 75 70 73 0a 0a ;..init-groups..
24a0: 3a 20 2e 67 72 6f 75 70 73 20 28 20 2d 2d 20 29 : .groups ( -- )
24b0: 0a 20 20 20 20 67 72 6f 75 70 73 5b 5d 20 5b 3a . groups[] [:
24c0: 20 32 64 75 70 20 32 20 63 65 6c 6c 73 20 2f 73 2dup 2 cells /s
24d0: 74 72 69 6e 67 20 74 79 70 65 20 73 70 61 63 65 tring type space
24e0: 0a 20 20 20 20 20 20 64 72 6f 70 20 32 40 20 2e . drop 2@ .
24f0: 70 65 72 6d 61 6e 64 6f 72 20 63 72 20 3b 5d 20 permandor cr ;]
2500: 24 5b 5d 6d 61 70 20 3b 0a 0a 3a 20 2e 69 6e 2d $[]map ;..: .in-
2510: 67 72 6f 75 70 73 20 28 20 61 64 64 72 20 75 20 groups ( addr u
2520: 2d 2d 20 29 0a 20 20 20 20 62 6f 75 6e 64 73 20 -- ). bounds
2530: 3f 44 4f 0a 09 49 20 70 40 2b 20 49 20 2d 20 3e ?DO..I p@+ I - >
2540: 72 20 36 34 3e 6e 20 67 72 6f 75 70 73 5b 5d 20 r 64>n groups[]
2550: 24 5b 5d 40 20 32 20 63 65 6c 6c 73 20 2f 73 74 $[]@ 2 cells /st
2560: 72 69 6e 67 20 73 70 61 63 65 20 74 79 70 65 0a ring space type.
2570: 20 20 20 20 72 3e 20 2b 4c 4f 4f 50 20 3b 0a 0a r> +LOOP ;..
2580: 3a 20 77 72 69 74 65 2d 67 72 6f 75 70 73 20 28 : write-groups (
2590: 20 2d 2d 20 29 0a 20 20 20 20 22 67 72 6f 75 70 -- ). "group
25a0: 73 22 20 2e 6e 65 74 32 6f 2f 20 77 2f 6f 20 63 s" .net2o/ w/o c
25b0: 72 65 61 74 65 2d 66 69 6c 65 20 74 68 72 6f 77 reate-file throw
25c0: 20 3e 72 0a 20 20 20 20 5b 27 5d 20 2e 67 72 6f >r. ['] .gro
25d0: 75 70 73 20 72 40 20 6f 75 74 66 69 6c 65 2d 65 ups r@ outfile-e
25e0: 78 65 63 75 74 65 0a 20 20 20 20 72 3e 20 63 6c xecute. r> cl
25f0: 6f 73 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 3b ose-file throw ;
2600: 0a 0a 3a 20 67 72 6f 75 70 2d 6c 69 6e 65 20 28 ..: group-line (
2610: 20 2d 2d 20 29 0a 20 20 20 20 70 61 72 73 65 2d -- ). parse-
2620: 6e 61 6d 65 20 70 61 72 73 65 2d 6e 61 6d 65 20 name parse-name
2630: 3e 70 65 72 6d 20 3e 67 72 6f 75 70 73 20 3b 0a >perm >groups ;.
2640: 0a 3a 20 72 65 61 64 2d 67 72 6f 75 70 73 2d 6c .: read-groups-l
2650: 6f 6f 70 20 28 20 2d 2d 20 29 0a 20 20 20 20 42 oop ( -- ). B
2660: 45 47 49 4e 20 20 72 65 66 69 6c 6c 20 20 57 48 EGIN refill WH
2670: 49 4c 45 20 20 67 72 6f 75 70 2d 6c 69 6e 65 20 ILE group-line
2680: 20 52 45 50 45 41 54 20 3b 0a 0a 3a 20 72 65 61 REPEAT ;..: rea
2690: 64 2d 67 72 6f 75 70 73 20 28 20 2d 2d 20 29 0a d-groups ( -- ).
26a0: 20 20 20 20 22 67 72 6f 75 70 73 22 20 2e 6e 65 "groups" .ne
26b0: 74 32 6f 2f 20 32 64 75 70 20 66 69 6c 65 2d 73 t2o/ 2dup file-s
26c0: 74 61 74 75 73 20 6e 69 70 20 6e 6f 2d 66 69 6c tatus nip no-fil
26d0: 65 23 20 3d 20 49 46 0a 09 69 6e 69 74 2d 67 72 e# = IF..init-gr
26e0: 6f 75 70 73 20 77 72 69 74 65 2d 67 72 6f 75 70 oups write-group
26f0: 73 0a 20 20 20 20 54 48 45 4e 20 20 3e 69 6e 63 s. THEN >inc
2700: 6c 75 64 65 64 20 74 68 72 6f 77 0a 20 20 20 20 luded throw.
2710: 5b 27 5d 20 72 65 61 64 2d 67 72 6f 75 70 73 2d ['] read-groups-
2720: 6c 6f 6f 70 20 65 78 65 63 75 74 65 2d 70 61 72 loop execute-par
2730: 73 69 6e 67 2d 6e 61 6d 65 64 2d 66 69 6c 65 20 sing-named-file
2740: 3b 0a 0a 3a 20 67 72 6f 75 70 73 3e 6d 61 73 6b ;..: groups>mask
2750: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 6d 61 73 ( addr u -- mas
2760: 6b 20 29 0a 20 20 20 20 30 20 2d 72 6f 74 20 62 k ). 0 -rot b
2770: 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 20 70 40 2b ounds ?DO..I p@+
2780: 20 49 20 2d 20 3e 72 0a 09 36 34 3e 6e 20 64 75 I - >r..64>n du
2790: 70 20 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 23 20 p groups[] $[]#
27a0: 75 3e 3d 20 21 21 6e 6f 2d 67 72 6f 75 70 21 21 u>= !!no-group!!
27b0: 0a 09 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 40 20 ..groups[] $[]@
27c0: 64 72 6f 70 20 32 40 20 3e 72 20 61 6e 64 20 72 drop 2@ >r and r
27d0: 3e 20 6f 72 0a 20 20 20 20 72 3e 20 2b 4c 4f 4f > or. r> +LOO
27e0: 50 20 3b 0a 0a 3a 20 3f 3e 67 72 6f 75 70 73 20 P ;..: ?>groups
27f0: 28 20 6d 61 73 6b 20 2d 2d 20 6d 61 73 6b 27 20 ( mask -- mask'
2800: 29 0a 20 20 20 20 6b 65 2d 67 72 6f 75 70 73 20 ). ke-groups
2810: 24 40 6c 65 6e 20 30 3d 20 49 46 0a 09 34 20 30 $@len 0= IF..4 0
2820: 20 44 4f 0a 09 20 20 20 20 64 75 70 20 49 20 67 DO.. dup I g
2830: 72 6f 75 70 73 5b 5d 20 24 5b 5d 40 20 64 72 6f roups[] $[]@ dro
2840: 70 20 63 65 6c 6c 2b 20 40 0a 09 20 20 20 20 6f p cell+ @.. o
2850: 72 20 6f 76 65 72 20 3d 20 49 46 0a 09 09 49 20 r over = IF...I
2860: 6b 65 2d 67 72 6f 75 70 73 20 63 24 2b 21 20 49 ke-groups c$+! I
2870: 20 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 40 20 64 groups[] $[]@ d
2880: 72 6f 70 20 63 65 6c 6c 2b 20 40 20 69 6e 76 65 rop cell+ @ inve
2890: 72 74 20 61 6e 64 0a 09 20 20 20 20 54 48 45 4e rt and.. THEN
28a0: 0a 09 4c 4f 4f 50 0a 20 20 20 20 54 48 45 4e 20 ..LOOP. THEN
28b0: 20 64 72 6f 70 20 3b 0a 0a 5c 20 6b 65 79 20 64 drop ;..\ key d
28c0: 69 73 70 6c 61 79 0a 0a 5b 49 46 55 4e 44 45 46 isplay..[IFUNDEF
28d0: 5d 20 6d 61 67 65 6e 74 61 20 20 62 72 6f 77 6e ] magenta brown
28e0: 20 63 6f 6e 73 74 61 6e 74 20 6d 61 67 65 6e 74 constant magent
28f0: 61 20 5b 54 48 45 4e 5d 0a 5b 49 46 44 45 46 5d a [THEN].[IFDEF]
2900: 20 67 6c 2d 74 79 70 65 20 3a 20 62 67 7c 20 3e gl-type : bg| >
2910: 62 67 20 6f 72 20 3b 20 5b 45 4c 53 45 5d 20 3a bg or ; [ELSE] :
2920: 20 62 67 7c 20 64 72 6f 70 20 3b 20 5b 54 48 45 bg| drop ; [THE
2930: 4e 5d 0a 0a 43 72 65 61 74 65 20 38 35 63 6f 6c N]..Create 85col
2940: 6f 72 73 2d 62 77 0a 30 20 2c 20 69 6e 76 65 72 ors-bw.0 , inver
2950: 73 20 2c 0a 69 6e 76 65 72 73 20 2c 20 30 20 2c s ,.invers , 0 ,
2960: 0a 30 20 2c 20 69 6e 76 65 72 73 20 2c 0a 69 6e .0 , invers ,.in
2970: 76 65 72 73 20 2c 20 30 20 2c 0a 43 72 65 61 74 vers , 0 ,.Creat
2980: 65 20 38 35 63 6f 6c 6f 72 73 2d 63 6c 0a 79 65 e 85colors-cl.ye
2990: 6c 6c 6f 77 20 3e 66 67 20 62 6c 75 65 20 3e 62 llow >fg blue >b
29a0: 67 20 6f 72 20 62 6f 6c 64 20 6f 72 20 2c 20 72 g or bold or , r
29b0: 65 64 20 3e 66 67 20 77 68 69 74 65 20 62 67 7c ed >fg white bg|
29c0: 20 2c 0a 62 6c 61 63 6b 20 3e 66 67 20 63 79 61 ,.black >fg cya
29d0: 6e 20 62 67 7c 20 2c 20 67 72 65 65 6e 20 3e 66 n bg| , green >f
29e0: 67 20 62 6c 61 63 6b 20 3e 62 67 20 6f 72 20 62 g black >bg or b
29f0: 6f 6c 64 20 6f 72 20 2c 0a 77 68 69 74 65 20 3e old or ,.white >
2a00: 66 67 20 62 6c 61 63 6b 20 3e 62 67 20 6f 72 20 fg black >bg or
2a10: 62 6f 6c 64 20 6f 72 20 2c 20 6d 61 67 65 6e 74 bold or , magent
2a20: 61 20 3e 66 67 20 79 65 6c 6c 6f 77 20 62 67 7c a >fg yellow bg|
2a30: 20 2c 0a 62 6c 75 65 20 3e 66 67 20 79 65 6c 6c ,.blue >fg yell
2a40: 6f 77 20 62 67 7c 20 2c 20 63 79 61 6e 20 3e 66 ow bg| , cyan >f
2a50: 67 20 72 65 64 20 3e 62 67 20 6f 72 20 62 6f 6c g red >bg or bol
2a60: 64 20 6f 72 20 2c 0a 0a 5b 49 46 44 45 46 5d 20 d or ,..[IFDEF]
2a70: 67 6c 2d 74 79 70 65 20 38 35 63 6f 6c 6f 72 73 gl-type 85colors
2a80: 2d 63 6c 20 5b 45 4c 53 45 5d 20 38 35 63 6f 6c -cl [ELSE] 85col
2a90: 6f 72 73 2d 62 77 20 5b 54 48 45 4e 5d 20 56 61 ors-bw [THEN] Va
2aa0: 6c 75 65 20 38 35 63 6f 6c 6f 72 73 0a 0a 3a 20 lue 85colors..:
2ab0: 2e 73 74 72 69 70 65 38 35 20 28 20 61 64 64 72 .stripe85 ( addr
2ac0: 20 75 20 2d 2d 20 29 20 20 30 20 2d 72 6f 74 20 u -- ) 0 -rot
2ad0: 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 64 75 70 20 bounds ?DO..dup
2ae0: 63 65 6c 6c 73 20 38 35 63 6f 6c 6f 72 73 20 2b cells 85colors +
2af0: 20 40 20 61 74 74 72 21 20 31 2b 0a 09 49 20 34 @ attr! 1+..I 4
2b00: 20 38 35 74 79 70 65 20 20 64 75 70 20 63 65 6c 85type dup cel
2b10: 6c 73 20 38 35 63 6f 6c 6f 72 73 20 2b 20 40 20 ls 85colors + @
2b20: 61 74 74 72 21 20 31 2b 0a 20 20 20 20 49 20 34 attr! 1+. I 4
2b30: 20 2b 20 34 20 38 35 74 79 70 65 20 3c 64 65 66 + 4 85type <def
2b40: 61 75 6c 74 3e 20 63 72 20 38 20 2b 4c 4f 4f 50 ault> cr 8 +LOOP
2b50: 20 20 64 72 6f 70 20 3b 0a 3a 20 2e 69 6d 70 6f drop ;.: .impo
2b60: 72 74 38 35 20 28 20 61 64 64 72 20 75 20 2d 2d rt85 ( addr u --
2b70: 20 29 0a 20 20 20 20 6b 65 2d 69 6d 70 6f 72 74 ). ke-import
2b80: 73 20 40 20 3e 69 6d 2d 63 6f 6c 6f 72 20 38 35 s @ >im-color 85
2b90: 74 79 70 65 20 3c 64 65 66 61 75 6c 74 3e 20 3b type <default> ;
2ba0: 0a 3a 20 2e 72 73 6b 20 28 20 6e 69 63 6b 20 75 .: .rsk ( nick u
2bb0: 20 2d 2d 20 29 0a 20 20 20 20 73 6b 72 65 76 20 -- ). skrev
2bc0: 24 32 30 20 2e 73 74 72 69 70 65 38 35 20 73 70 $20 .stripe85 sp
2bd0: 61 63 65 20 74 79 70 65 20 2e 22 20 20 28 6b 65 ace type ." (ke
2be0: 65 70 20 6f 66 66 6c 69 6e 65 20 63 6f 70 79 21 ep offline copy!
2bf0: 29 22 20 63 72 20 3b 0a 3a 20 2e 6b 65 79 20 28 )" cr ;.: .key (
2c00: 20 61 64 64 72 20 75 20 2d 2d 20 29 20 64 72 6f addr u -- ) dro
2c10: 70 20 63 65 6c 6c 2b 20 3e 6f 0a 20 20 20 20 2e p cell+ >o. .
2c20: 22 20 6e 69 63 6b 3a 20 20 20 22 20 2e 6e 69 63 " nick: " .nic
2c30: 6b 20 63 72 0a 20 20 20 20 2e 22 20 70 75 62 6b k cr. ." pubk
2c40: 65 79 3a 20 22 20 6b 65 2d 70 6b 20 24 40 20 38 ey: " ke-pk $@ 8
2c50: 35 74 79 70 65 20 63 72 0a 20 20 20 20 6b 65 2d 5type cr. ke-
2c60: 73 6b 20 40 20 49 46 0a 09 2e 22 20 73 65 63 6b sk @ IF..." seck
2c70: 65 79 3a 20 22 20 6b 65 2d 73 6b 20 73 65 63 40 ey: " ke-sk sec@
2c80: 20 2e 62 6c 61 63 6b 38 35 20 2e 22 20 20 28 6b .black85 ." (k
2c90: 65 65 70 20 73 65 63 72 65 74 21 29 22 20 63 72 eep secret!)" cr
2ca0: 20 20 54 48 45 4e 0a 20 20 20 20 2e 22 20 76 61 THEN. ." va
2cb0: 6c 69 64 3a 20 20 22 20 6b 65 2d 73 65 6c 66 73 lid: " ke-selfs
2cc0: 69 67 20 24 40 20 2e 73 69 67 64 61 74 65 73 20 ig $@ .sigdates
2cd0: 63 72 0a 20 20 20 20 2e 22 20 67 72 6f 75 70 73 cr. ." groups
2ce0: 3a 20 22 20 6b 65 2d 67 72 6f 75 70 73 20 24 40 : " ke-groups $@
2cf0: 20 2e 69 6e 2d 67 72 6f 75 70 73 20 63 72 0a 20 .in-groups cr.
2d00: 20 20 20 2e 22 20 70 65 72 6d 3a 20 20 20 22 20 ." perm: "
2d10: 6b 65 2d 6d 61 73 6b 20 40 20 2e 70 65 72 6d 20 ke-mask @ .perm
2d20: 63 72 0a 20 20 20 20 6f 3e 20 3b 0a 3a 20 2e 6b cr. o> ;.: .k
2d30: 65 79 2d 72 65 73 74 20 28 20 6f 3a 6b 65 79 20 ey-rest ( o:key
2d40: 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 6b -- o:key ). k
2d50: 65 2d 70 6b 20 24 40 20 6b 65 79 7c 20 2e 69 6d e-pk $@ key| .im
2d60: 70 6f 72 74 38 35 0a 20 20 20 20 6b 65 2d 73 65 port85. ke-se
2d70: 6c 66 73 69 67 20 24 40 20 73 70 61 63 65 20 2e lfsig $@ space .
2d80: 73 69 67 64 61 74 65 73 0a 20 20 20 20 6b 65 2d sigdates. ke-
2d90: 67 72 6f 75 70 73 20 24 40 20 32 64 75 70 20 2e groups $@ 2dup .
2da0: 69 6e 2d 67 72 6f 75 70 73 20 67 72 6f 75 70 73 in-groups groups
2db0: 3e 6d 61 73 6b 20 69 6e 76 65 72 74 0a 20 20 20 >mask invert.
2dc0: 20 73 70 61 63 65 20 6b 65 2d 6d 61 73 6b 20 40 space ke-mask @
2dd0: 20 61 6e 64 20 2d 31 20 73 77 61 70 20 2e 70 65 and -1 swap .pe
2de0: 72 6d 61 6e 64 6f 72 0a 20 20 20 20 23 74 61 62 rmandor. #tab
2df0: 20 65 6d 69 74 20 6b 65 2d 69 6d 70 6f 72 74 73 emit ke-imports
2e00: 20 40 20 2e 69 6d 70 6f 72 74 73 0a 20 20 20 20 @ .imports.
2e10: 73 70 61 63 65 20 2e 6e 69 63 6b 2b 70 65 74 20 space .nick+pet
2e20: 3b 0a 3a 20 2e 6b 65 79 2d 6c 69 73 74 20 28 20 ;.: .key-list (
2e30: 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b 65 79 20 29 o:key -- o:key )
2e40: 0a 20 20 20 20 6b 65 2d 6f 66 66 73 65 74 20 36 . ke-offset 6
2e50: 34 40 20 36 34 3e 64 20 6b 65 79 70 61 63 6b 2d 4@ 64>d keypack-
2e60: 61 6c 6c 23 20 66 6d 2f 6d 6f 64 20 6e 69 70 20 all# fm/mod nip
2e70: 33 20 2e 72 20 73 70 61 63 65 0a 20 20 20 20 2e 3 .r space. .
2e80: 6b 65 79 2d 72 65 73 74 20 63 72 20 3b 0a 3a 20 key-rest cr ;.:
2e90: 2e 73 65 63 72 65 74 2d 6e 69 63 6b 73 20 28 20 .secret-nicks (
2ea0: 2d 2d 20 29 0a 20 20 20 20 30 20 6b 65 79 23 20 -- ). 0 key#
2eb0: 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 [: cell+ $@ drop
2ec0: 20 63 65 6c 6c 2b 20 3e 6f 20 6b 65 2d 73 6b 20 cell+ >o ke-sk
2ed0: 40 20 49 46 0a 09 20 20 5b 3a 20 64 75 70 20 31 @ IF.. [: dup 1
2ee0: 20 2e 72 20 3b 5d 20 23 33 36 20 62 61 73 65 2d .r ;] #36 base-
2ef0: 65 78 65 63 75 74 65 20 73 70 61 63 65 20 2e 6b execute space .k
2f00: 65 79 2d 72 65 73 74 20 63 72 20 31 2b 0a 20 20 ey-rest cr 1+.
2f10: 20 20 20 20 54 48 45 4e 20 6f 3e 20 3b 5d 20 23 THEN o> ;] #
2f20: 6d 61 70 20 64 72 6f 70 20 3b 0a 3a 20 2e 6b 65 map drop ;.: .ke
2f30: 79 2d 69 6e 76 69 74 65 20 28 20 6f 3a 6b 65 79 y-invite ( o:key
2f40: 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 -- o:key ).
2f50: 6b 65 2d 70 6b 20 24 40 20 6b 65 79 73 69 7a 65 ke-pk $@ keysize
2f60: 20 75 6d 69 6e 0a 20 20 20 20 6b 65 2d 69 6d 70 umin. ke-imp
2f70: 6f 72 74 73 20 40 20 3e 69 6d 2d 63 6f 6c 6f 72 orts @ >im-color
2f80: 20 38 35 74 79 70 65 20 3c 64 65 66 61 75 6c 74 85type <default
2f90: 3e 0a 20 20 20 20 73 70 61 63 65 20 2e 6e 69 63 >. space .nic
2fa0: 6b 20 73 70 61 63 65 20 3b 0a 3a 20 2e 6b 65 79 k space ;.: .key
2fb0: 2d 73 68 6f 72 74 20 28 20 6f 3a 6b 65 79 20 2d -short ( o:key -
2fc0: 2d 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 6b 65 - o:key ). ke
2fd0: 2d 6e 69 63 6b 20 24 2e 20 6b 65 2d 70 72 6f 66 -nick $. ke-prof
2fe0: 20 24 40 6c 65 6e 20 49 46 20 2e 22 20 20 70 72 $@len IF ." pr
2ff0: 6f 66 69 6c 65 3a 20 22 20 6b 65 2d 70 72 6f 66 ofile: " ke-prof
3000: 20 24 40 20 38 35 74 79 70 65 20 54 48 45 4e 20 $@ 85type THEN
3010: 3b 0a 3a 20 6c 69 73 74 2d 6b 65 79 73 20 28 20 ;.: list-keys (
3020: 2d 2d 20 29 0a 20 20 20 20 2e 22 20 6e 75 6d 20 -- ). ." num
3030: 70 75 62 6b 65 79 20 20 20 20 20 20 20 20 20 20 pubkey
3040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3050: 20 20 20 20 20 20 20 20 20 64 61 74 65 20 20 20 date
3060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3070: 20 20 67 72 70 2b 70 65 72 6d 09 68 20 6e 69 63 grp+perm.h nic
3080: 6b 22 20 63 72 0a 20 20 20 20 6b 65 79 23 20 5b k" cr. key# [
3090: 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 20 : cell+ $@ drop
30a0: 63 65 6c 6c 2b 20 2e 2e 6b 65 79 2d 6c 69 73 74 cell+ ..key-list
30b0: 20 3b 5d 20 23 6d 61 70 20 3b 0a 3a 20 6c 69 73 ;] #map ;.: lis
30c0: 74 2d 6e 69 63 6b 73 20 28 20 2d 2d 20 29 0a 20 t-nicks ( -- ).
30d0: 20 20 20 6e 69 63 6b 23 20 5b 3a 20 64 75 70 20 nick# [: dup
30e0: 24 2e 20 2e 22 20 3a 22 20 63 72 20 63 65 6c 6c $. ." :" cr cell
30f0: 2b 20 24 40 20 62 6f 75 6e 64 73 20 3f 44 4f 0a + $@ bounds ?DO.
3100: 09 20 20 49 20 40 20 2e 2e 6b 65 79 2d 6c 69 73 . I @ ..key-lis
3110: 74 20 20 63 65 6c 6c 20 2b 4c 4f 4f 50 20 3b 5d t cell +LOOP ;]
3120: 20 23 6d 61 70 20 3b 0a 0a 3a 20 64 75 6d 70 6b #map ;..: dumpk
3130: 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 ey ( addr u -- )
3140: 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 0a 20 drop cell+ >o.
3150: 20 20 20 2e 5c 22 20 78 5c 22 20 22 20 6b 65 2d .\" x\" " ke-
3160: 70 6b 20 24 40 20 38 35 74 79 70 65 20 2e 5c 22 pk $@ 85type .\"
3170: 20 5c 22 20 6b 65 79 3f 6e 65 77 22 20 63 72 0a \" key?new" cr.
3180: 20 20 20 20 6b 65 2d 73 6b 20 40 20 49 46 20 20 ke-sk @ IF
3190: 2e 5c 22 20 78 5c 22 20 22 20 6b 65 2d 73 6b 20 .\" x\" " ke-sk
31a0: 40 20 6b 65 79 73 69 7a 65 20 38 35 74 79 70 65 @ keysize 85type
31b0: 20 2e 5c 22 20 5c 22 20 6b 65 2d 73 6b 20 73 65 .\" \" ke-sk se
31c0: 63 21 20 2b 73 65 63 6b 65 79 22 20 63 72 20 20 c! +seckey" cr
31d0: 54 48 45 4e 0a 20 20 20 20 27 22 27 20 65 6d 69 THEN. '"' emi
31e0: 74 20 2e 6e 69 63 6b 20 2e 5c 22 20 5c 22 20 6b t .nick .\" \" k
31f0: 65 2d 6e 69 63 6b 20 24 21 20 22 0a 20 20 20 20 e-nick $! ".
3200: 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 20 64 72 ke-selfsig $@ dr
3210: 6f 70 20 36 34 40 20 36 34 3e 64 20 5b 3a 20 27 op 64@ 64>d [: '
3220: 24 27 20 65 6d 69 74 20 30 20 75 64 2e 72 20 3b $' emit 0 ud.r ;
3230: 5d 20 24 31 30 20 62 61 73 65 2d 65 78 65 63 75 ] $10 base-execu
3240: 74 65 0a 20 20 20 20 2e 22 20 2e 20 64 3e 36 34 te. ." . d>64
3250: 20 6b 65 2d 66 69 72 73 74 21 20 22 20 6b 65 2d ke-first! " ke-
3260: 74 79 70 65 20 40 20 2e 20 2e 22 20 6b 65 2d 74 type @ . ." ke-t
3270: 79 70 65 20 21 22 20 20 63 72 20 6f 3e 20 3b 0a ype !" cr o> ;.
3280: 0a 3a 20 2e 6b 65 79 73 20 28 20 2d 2d 20 29 20 .: .keys ( -- )
3290: 6b 65 79 23 20 5b 3a 20 2e 22 20 69 6e 64 65 78 key# [: ." index
32a0: 3a 20 22 20 64 75 70 20 24 40 20 38 35 74 79 70 : " dup $@ 85typ
32b0: 65 20 63 72 20 63 65 6c 6c 2b 20 24 40 20 2e 6b e cr cell+ $@ .k
32c0: 65 79 20 3b 5d 20 23 6d 61 70 20 3b 0a 3a 20 64 ey ;] #map ;.: d
32d0: 75 6d 70 6b 65 79 73 20 28 20 2d 2d 20 29 20 6b umpkeys ( -- ) k
32e0: 65 79 23 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 ey# [: cell+ $@
32f0: 64 75 6d 70 6b 65 79 20 3b 5d 20 23 6d 61 70 20 dumpkey ;] #map
3300: 3b 0a 0a 3a 20 6b 65 79 3e 6e 69 63 6b 20 28 20 ;..: key>nick (
3310: 61 64 64 72 6b 65 79 20 75 31 20 2d 2d 20 6e 69 addrkey u1 -- ni
3320: 63 6b 20 75 32 20 29 0a 20 20 20 20 5c 47 20 63 ck u2 ). \G c
3330: 6f 6e 76 65 72 74 20 6b 65 79 20 74 6f 20 6e 69 onvert key to ni
3340: 63 6b 0a 20 20 20 20 6b 65 79 7c 20 6b 65 79 23 ck. key| key#
3350: 20 23 40 20 30 3d 20 49 46 20 20 64 72 6f 70 20 #@ 0= IF drop
3360: 23 30 2e 20 20 45 58 49 54 20 20 54 48 45 4e 0a #0. EXIT THEN.
3370: 20 20 20 20 63 65 6c 6c 2b 20 2e 6b 65 2d 6e 69 cell+ .ke-ni
3380: 63 6b 20 24 40 20 3b 0a 3a 20 6b 65 79 3e 6b 65 ck $@ ;.: key>ke
3390: 79 20 28 20 61 64 64 72 6b 65 79 20 75 31 20 2d y ( addrkey u1 -
33a0: 2d 20 6b 65 79 20 75 32 20 29 0a 20 20 20 20 5c - key u2 ). \
33b0: 47 20 65 78 70 61 6e 64 20 6b 65 79 20 74 6f 20 G expand key to
33c0: 66 75 6c 6c 20 73 69 7a 65 20 61 6e 64 20 63 68 full size and ch
33d0: 65 63 6b 20 69 66 20 77 65 20 6b 6e 6f 77 20 69 eck if we know i
33e0: 74 0a 20 20 20 20 6b 65 79 7c 20 6b 65 79 23 20 t. key| key#
33f0: 23 40 20 30 3d 20 49 46 20 20 64 72 6f 70 20 23 #@ 0= IF drop #
3400: 30 2e 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 0. EXIT THEN.
3410: 20 20 20 63 65 6c 6c 2b 20 2e 6b 65 2d 70 6b 20 cell+ .ke-pk
3420: 24 40 20 3b 0a 0a 3a 20 2e 6b 65 79 23 20 28 20 $@ ;..: .key# (
3430: 61 64 64 72 20 75 20 2d 2d 20 29 20 6b 65 79 7c addr u -- ) key|
3440: 0a 20 20 20 20 2e 22 20 4b 65 79 20 27 22 20 6b . ." Key '" k
3450: 65 79 23 20 23 40 20 30 3d 20 49 46 20 64 72 6f ey# #@ 0= IF dro
3460: 70 20 45 58 49 54 20 54 48 45 4e 0a 20 20 20 20 p EXIT THEN.
3470: 63 65 6c 6c 2b 20 2e 2e 6e 69 63 6b 20 2e 22 20 cell+ ..nick ."
3480: 27 20 6f 6b 22 20 63 72 20 3b 0a 0a 44 65 66 65 ' ok" cr ;..Defe
3490: 72 20 64 68 74 2d 6e 69 63 6b 3f 0a 65 76 65 6e r dht-nick?.even
34a0: 74 3a 20 2d 3e 73 65 61 72 63 68 2d 6b 65 79 20 t: ->search-key
34b0: 20 6b 65 79 7c 20 6f 76 65 72 20 3e 72 20 64 68 key| over >r dh
34c0: 74 2d 6e 69 63 6b 3f 20 72 3e 20 66 72 65 65 20 t-nick? r> free
34d0: 74 68 72 6f 77 20 3b 0a 0a 3a 20 2e 75 6e 6b 65 throw ;..: .unke
34e0: 79 2d 69 64 20 28 20 61 64 64 72 20 75 20 2d 2d y-id ( addr u --
34f0: 20 29 20 3c 65 72 72 3e 20 38 20 75 6d 69 6e 20 ) <err> 8 umin
3500: 38 35 74 79 70 65 20 2e 22 20 28 75 6e 6b 6e 6f 85type ." (unkno
3510: 77 6e 29 22 20 3c 64 65 66 61 75 6c 74 3e 20 3b wn)" <default> ;
3520: 0a 0a 56 61 72 69 61 62 6c 65 20 75 6e 6b 65 79 ..Variable unkey
3530: 2d 69 64 23 0a 23 36 30 2e 30 30 30 2e 30 30 30 -id#.#60.000.000
3540: 2e 30 30 30 20 64 3e 36 34 20 36 34 43 6f 6e 73 .000 d>64 64Cons
3550: 74 61 6e 74 20 75 6e 6b 65 79 2d 74 6f 23 0a 3a tant unkey-to#.:
3560: 20 3f 75 6e 6b 65 79 20 28 20 61 64 64 72 20 75 ?unkey ( addr u
3570: 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 75 -- flag ). u
3580: 6e 6b 65 79 2d 69 64 23 20 23 40 0a 20 20 20 20 nkey-id# #@.
3590: 49 46 20 20 36 34 40 20 75 6e 6b 65 79 2d 74 6f IF 64@ unkey-to
35a0: 23 20 36 34 2b 20 74 69 63 6b 73 20 36 34 2d 20 # 64+ ticks 64-
35b0: 36 34 2d 30 3e 3d 20 20 54 48 45 4e 20 20 30 3d 64-0>= THEN 0=
35c0: 20 3b 0a 20 20 20 20 0a 3a 20 2e 6b 65 79 2d 69 ;. .: .key-i
35d0: 64 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 d ( addr u -- )
35e0: 6b 65 79 7c 20 32 64 75 70 20 6b 65 79 23 20 23 key| 2dup key# #
35f0: 40 20 30 3d 0a 20 20 20 20 49 46 20 20 64 72 6f @ 0=. IF dro
3600: 70 20 75 70 40 20 72 65 63 65 69 76 65 72 2d 74 p up@ receiver-t
3610: 61 73 6b 20 3d 20 49 46 0a 09 20 20 20 20 3c 65 ask = IF.. <e
3620: 76 65 6e 74 20 32 64 75 70 20 73 61 76 65 2d 6d vent 2dup save-m
3630: 65 6d 20 65 24 2c 20 2d 3e 73 65 61 72 63 68 2d em e$, ->search-
3640: 6b 65 79 20 6d 61 69 6e 2d 75 70 40 20 65 76 65 key main-up@ eve
3650: 6e 74 3e 0a 09 20 20 20 20 2e 75 6e 6b 65 79 2d nt>.. .unkey-
3660: 69 64 20 45 58 49 54 20 20 54 48 45 4e 0a 09 32 id EXIT THEN..2
3670: 64 75 70 20 3f 75 6e 6b 65 79 20 20 49 46 0a 09 dup ?unkey IF..
3680: 20 20 20 20 74 69 63 6b 73 20 7b 20 36 34 5e 20 ticks { 64^
3690: 74 78 20 7d 20 74 78 20 31 20 36 34 73 20 32 6f tx } tx 1 64s 2o
36a0: 76 65 72 20 75 6e 6b 65 79 2d 69 64 23 20 23 21 ver unkey-id# #!
36b0: 0a 09 20 20 20 20 63 6f 6e 6e 65 63 74 69 6f 6e .. connection
36c0: 20 3e 72 20 32 64 75 70 20 5b 27 5d 20 64 68 74 >r 2dup ['] dht
36d0: 2d 6e 69 63 6b 3f 20 63 6d 64 2d 6e 65 73 74 20 -nick? cmd-nest
36e0: 72 3e 20 74 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e r> to connection
36f0: 0a 09 20 20 20 20 32 64 75 70 20 6b 65 79 23 20 .. 2dup key#
3700: 23 40 20 30 3d 20 49 46 20 20 64 72 6f 70 20 2e #@ 0= IF drop .
3710: 75 6e 6b 65 79 2d 69 64 20 45 58 49 54 0a 09 20 unkey-id EXIT..
3720: 20 20 20 45 4c 53 45 20 20 3e 72 20 32 64 75 70 ELSE >r 2dup
3730: 20 75 6e 6b 65 79 2d 69 64 23 20 23 6f 66 66 20 unkey-id# #off
3740: 72 3e 20 20 54 48 45 4e 0a 09 45 4c 53 45 20 20 r> THEN..ELSE
3750: 2e 75 6e 6b 65 79 2d 69 64 20 20 45 58 49 54 20 .unkey-id EXIT
3760: 20 54 48 45 4e 0a 20 20 20 20 54 48 45 4e 0a 20 THEN. THEN.
3770: 20 20 20 63 65 6c 6c 2b 20 2e 2e 6e 69 63 6b 20 cell+ ..nick
3780: 32 64 72 6f 70 20 3b 0a 0a 3a 20 2e 63 6f 6e 2d 2drop ;..: .con-
3790: 69 64 20 28 20 6f 3a 63 6f 6e 6e 65 63 74 69 6f id ( o:connectio
37a0: 6e 20 2d 2d 20 29 20 70 75 62 6b 65 79 20 24 40 n -- ) pubkey $@
37b0: 20 2e 6b 65 79 2d 69 64 20 3b 0a 0a 3a 20 2e 73 .key-id ;..: .s
37c0: 69 6d 70 6c 65 2d 69 64 20 28 20 61 64 64 72 20 imple-id ( addr
37d0: 75 20 2d 2d 20 29 20 6b 65 79 3e 6e 69 63 6b 20 u -- ) key>nick
37e0: 74 79 70 65 20 3b 0a 0a 3a 20 63 68 65 63 6b 2d type ;..: check-
37f0: 6b 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 key ( addr u --
3800: 29 0a 20 20 20 20 6f 20 49 46 20 20 70 75 62 6b ). o IF pubk
3810: 65 79 20 40 20 49 46 0a 09 20 20 20 20 32 64 75 ey @ IF.. 2du
3820: 70 20 70 75 62 6b 65 79 20 24 40 20 6b 65 79 7c p pubkey $@ key|
3830: 20 73 74 72 3d 20 30 3d 20 49 46 0a 09 09 5b 3a str= 0= IF...[:
3840: 20 2e 22 20 77 61 6e 74 3a 20 22 20 70 75 62 6b ." want: " pubk
3850: 65 79 20 24 40 20 6b 65 79 7c 20 38 35 74 79 70 ey $@ key| 85typ
3860: 65 20 63 72 0a 09 09 20 20 2e 22 20 67 6f 74 20 e cr... ." got
3870: 3a 20 22 20 32 64 75 70 20 38 35 74 79 70 65 20 : " 2dup 85type
3880: 63 72 20 3b 5d 20 24 65 72 72 0a 09 09 74 72 75 cr ;] $err...tru
3890: 65 20 21 21 77 72 6f 6e 67 2d 6b 65 79 21 21 0a e !!wrong-key!!.
38a0: 09 20 20 20 20 54 48 45 4e 0a 09 20 20 20 20 63 . THEN.. c
38b0: 6f 6e 6e 65 63 74 28 20 2e 6b 65 79 23 20 29 65 onnect( .key# )e
38c0: 6c 73 65 28 20 32 64 72 6f 70 20 29 20 20 45 58 lse( 2drop ) EX
38d0: 49 54 0a 09 54 48 45 4e 20 20 54 48 45 4e 0a 20 IT..THEN THEN.
38e0: 20 20 20 32 64 75 70 20 6b 65 79 2d 65 78 69 73 2dup key-exis
38f0: 74 3f 0a 20 20 20 20 3f 64 75 70 2d 30 3d 2d 49 t?. ?dup-0=-I
3900: 46 20 20 70 65 72 6d 25 75 6e 6b 6e 6f 77 6e 20 F perm%unknown
3910: 20 45 4c 53 45 20 20 2e 6b 65 2d 6d 61 73 6b 20 ELSE .ke-mask
3920: 40 20 20 54 48 45 4e 20 20 74 6d 70 2d 70 65 72 @ THEN tmp-per
3930: 6d 20 21 0a 20 20 20 20 63 6f 6e 6e 65 63 74 28 m !. connect(
3940: 20 32 64 75 70 20 2e 6b 65 79 23 20 29 0a 20 20 2dup .key# ).
3950: 20 20 74 6d 70 2d 70 65 72 6d 20 40 20 70 65 72 tmp-perm @ per
3960: 6d 25 62 6c 6f 63 6b 65 64 20 61 6e 64 20 49 46 m%blocked and IF
3970: 0a 09 5b 3a 20 2e 22 20 55 6e 6b 6e 6f 77 6e 20 ..[: ." Unknown
3980: 6b 65 79 2c 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 key, connection
3990: 72 65 66 75 73 65 64 3a 20 22 20 38 35 74 79 70 refused: " 85typ
39a0: 65 20 63 72 20 3b 5d 20 24 65 72 72 0a 09 74 72 e cr ;] $err..tr
39b0: 75 65 20 21 21 63 6f 6e 6e 65 63 74 2d 70 65 72 ue !!connect-per
39c0: 6d 21 21 0a 20 20 20 20 45 4c 53 45 20 20 32 64 m!!. ELSE 2d
39d0: 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 73 rop THEN ;..: s
39e0: 65 61 72 63 68 2d 6b 65 79 20 28 20 70 6b 63 20 earch-key ( pkc
39f0: 2d 2d 20 73 6b 63 20 29 0a 20 20 20 20 6b 65 79 -- skc ). key
3a00: 73 69 7a 65 20 6b 65 79 23 20 23 40 20 30 3d 20 size key# #@ 0=
3a10: 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21 0a !!unknown-key!!.
3a20: 20 20 20 20 63 65 6c 6c 2b 20 2e 6b 65 2d 73 6b cell+ .ke-sk
3a30: 20 73 65 63 40 20 30 3d 20 21 21 75 6e 6b 6e 6f sec@ 0= !!unkno
3a40: 77 6e 2d 6b 65 79 21 21 20 3b 0a 0a 5c 20 61 70 wn-key!! ;..\ ap
3a50: 70 6c 79 20 70 65 72 6d 69 73 73 69 6f 6e 73 26 ply permissions&
3a60: 67 72 6f 75 70 73 0a 0a 3a 20 61 70 70 6c 79 2d groups..: apply-
3a70: 70 65 72 6d 69 73 73 69 6f 6e 20 28 20 70 65 72 permission ( per
3a80: 6d 61 6e 64 20 70 65 72 6d 6f 72 20 6f 3a 6b 65 mand permor o:ke
3a90: 79 20 2d 2d 20 70 65 72 6d 61 6e 64 20 70 65 72 y -- permand per
3aa0: 6d 6f 72 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 mor o:key ).
3ab0: 6f 76 65 72 20 6b 65 2d 6d 61 73 6b 20 40 20 61 over ke-mask @ a
3ac0: 6e 64 20 6f 76 65 72 20 6f 72 20 6b 65 2d 6d 61 nd over or ke-ma
3ad0: 73 6b 20 21 20 2e 6b 65 79 2d 6c 69 73 74 20 3b sk ! .key-list ;
3ae0: 0a 0a 3a 20 2d 67 72 6f 75 70 2d 70 65 72 6d 20 ..: -group-perm
3af0: 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 ( o:key -- ).
3b00: 20 6b 65 2d 67 72 6f 75 70 73 20 24 40 20 67 72 ke-groups $@ gr
3b10: 6f 75 70 73 3e 6d 61 73 6b 20 69 6e 76 65 72 74 oups>mask invert
3b20: 20 6b 65 2d 6d 61 73 6b 20 61 6e 64 21 20 3b 0a ke-mask and! ;.
3b30: 3a 20 2b 67 72 6f 75 70 2d 70 65 72 6d 20 28 20 : +group-perm (
3b40: 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b o:key -- ). k
3b50: 65 2d 67 72 6f 75 70 73 20 24 40 20 67 72 6f 75 e-groups $@ grou
3b60: 70 73 3e 6d 61 73 6b 20 20 20 20 20 20 20 20 6b ps>mask k
3b70: 65 2d 6d 61 73 6b 20 6f 72 21 20 3b 0a 0a 3a 20 e-mask or! ;..:
3b80: 61 64 64 2d 67 72 6f 75 70 20 28 20 69 64 20 6f add-group ( id o
3b90: 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 64 75 :key -- ). du
3ba0: 70 20 2d 31 20 3d 20 21 21 6e 6f 2d 67 72 6f 75 p -1 = !!no-grou
3bb0: 70 21 21 20 2d 67 72 6f 75 70 2d 70 65 72 6d 20 p!! -group-perm
3bc0: 63 6d 64 74 6d 70 24 20 6b 65 2d 67 72 6f 75 70 cmdtmp$ ke-group
3bd0: 73 20 24 2b 21 20 2b 67 72 6f 75 70 2d 70 65 72 s $+! +group-per
3be0: 6d 20 3b 0a 3a 20 73 65 74 2d 67 72 6f 75 70 20 m ;.: set-group
3bf0: 28 20 69 64 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a ( id o:key -- ).
3c00: 20 20 20 20 64 75 70 20 2d 31 20 3d 20 21 21 6e dup -1 = !!n
3c10: 6f 2d 67 72 6f 75 70 21 21 20 2d 67 72 6f 75 70 o-group!! -group
3c20: 2d 70 65 72 6d 20 63 6d 64 74 6d 70 24 20 6b 65 -perm cmdtmp$ ke
3c30: 2d 67 72 6f 75 70 73 20 24 21 20 2b 67 72 6f 75 -groups $! +grou
3c40: 70 2d 70 65 72 6d 20 3b 0a 3a 20 73 75 62 2d 67 p-perm ;.: sub-g
3c50: 72 6f 75 70 20 28 20 69 64 20 6f 3a 6b 65 79 20 roup ( id o:key
3c60: 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 2d 31 20 -- ). dup -1
3c70: 3d 20 21 21 6e 6f 2d 67 72 6f 75 70 21 21 20 2d = !!no-group!! -
3c80: 67 72 6f 75 70 2d 70 65 72 6d 20 63 6d 64 74 6d group-perm cmdtm
3c90: 70 24 20 6b 65 2d 67 72 6f 75 70 73 20 24 40 20 p$ ke-groups $@
3ca0: 32 6f 76 65 72 20 73 65 61 72 63 68 0a 20 20 20 2over search.
3cb0: 20 49 46 20 20 20 6e 69 70 20 3e 72 20 6e 69 70 IF nip >r nip
3cc0: 20 6b 65 2d 67 72 6f 75 70 73 20 64 75 70 20 24 ke-groups dup $
3cd0: 40 6c 65 6e 20 72 3e 20 2d 20 72 6f 74 20 24 64 @len r> - rot $d
3ce0: 65 6c 0a 20 20 20 20 45 4c 53 45 20 20 32 64 72 el. ELSE 2dr
3cf0: 6f 70 20 32 64 72 6f 70 20 20 54 48 45 4e 20 2b op 2drop THEN +
3d00: 67 72 6f 75 70 2d 70 65 72 6d 20 3b 0a 0a 3a 20 group-perm ;..:
3d10: 61 70 70 6c 79 2d 67 72 6f 75 70 20 28 20 61 64 apply-group ( ad
3d20: 64 72 20 75 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a dr u o:key -- ).
3d30: 20 20 20 20 6f 76 65 72 20 63 40 20 27 2b 27 20 over c@ '+'
3d40: 3d 20 49 46 20 20 31 20 2f 73 74 72 69 6e 67 20 = IF 1 /string
3d50: 3e 67 72 6f 75 70 2d 69 64 20 61 64 64 2d 67 72 >group-id add-gr
3d60: 6f 75 70 20 2e 6b 65 79 2d 6c 69 73 74 20 20 45 oup .key-list E
3d70: 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 6f 76 XIT THEN. ov
3d80: 65 72 20 63 40 20 27 2d 27 20 3d 20 49 46 20 20 er c@ '-' = IF
3d90: 31 20 2f 73 74 72 69 6e 67 20 3e 67 72 6f 75 70 1 /string >group
3da0: 2d 69 64 20 73 75 62 2d 67 72 6f 75 70 20 2e 6b -id sub-group .k
3db0: 65 79 2d 6c 69 73 74 20 20 45 58 49 54 20 20 54 ey-list EXIT T
3dc0: 48 45 4e 0a 20 20 20 20 3e 67 72 6f 75 70 2d 69 HEN. >group-i
3dd0: 64 20 73 65 74 2d 67 72 6f 75 70 20 2e 6b 65 79 d set-group .key
3de0: 2d 6c 69 73 74 20 3b 0a 0a 5c 20 67 65 74 20 70 -list ;..\ get p
3df0: 61 73 73 70 68 72 61 73 65 0a 0a 33 20 56 61 6c assphrase..3 Val
3e00: 75 65 20 70 61 73 73 70 68 72 61 73 65 2d 72 65 ue passphrase-re
3e10: 74 72 79 23 0a 24 31 30 30 20 43 6f 6e 73 74 61 try#.$100 Consta
3e20: 6e 74 20 6d 61 78 2d 70 61 73 73 70 68 72 61 73 nt max-passphras
3e30: 65 23 20 5c 20 32 35 36 20 63 68 61 72 61 63 74 e# \ 256 charact
3e40: 65 72 73 20 73 68 6f 75 6c 64 20 62 65 20 65 6e ers should be en
3e50: 6f 75 67 68 2e 2e 2e 0a 6d 61 78 2d 70 61 73 73 ough....max-pass
3e60: 70 68 72 61 73 65 23 20 62 75 66 66 65 72 3a 20 phrase# buffer:
3e70: 70 61 73 73 70 68 72 61 73 65 0a 0a 3a 20 70 61 passphrase..: pa
3e80: 73 73 70 68 72 61 73 65 2d 69 6e 20 28 20 61 64 ssphrase-in ( ad
3e90: 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 20 29 dr u -- addr u )
3ea0: 0a 20 20 20 20 22 50 41 53 53 50 48 52 41 53 45 . "PASSPHRASE
3eb0: 22 20 67 65 74 65 6e 76 20 32 64 75 70 20 64 30 " getenv 2dup d0
3ec0: 3d 20 49 46 20 20 32 64 72 6f 70 20 74 79 70 65 = IF 2drop type
3ed0: 0a 09 70 61 73 73 70 68 72 61 73 65 20 64 75 70 ..passphrase dup
3ee0: 20 6d 61 78 2d 70 61 73 73 70 68 72 61 73 65 23 max-passphrase#
3ef0: 20 61 63 63 65 70 74 2a 20 63 72 0a 20 20 20 20 accept* cr.
3f00: 45 4c 53 45 20 20 32 6e 69 70 20 20 54 48 45 4e ELSE 2nip THEN
3f10: 20 3b 0a 0a 3a 20 3e 70 61 73 73 70 68 72 61 73 ;..: >passphras
3f20: 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 e ( addr u -- ad
3f30: 64 72 20 75 20 29 0a 20 20 20 20 5c 47 20 63 72 dr u ). \G cr
3f40: 65 61 74 65 20 61 20 35 31 32 20 62 69 74 20 68 eate a 512 bit h
3f50: 61 73 68 20 6f 66 20 74 68 65 20 70 61 73 73 70 ash of the passp
3f60: 68 72 61 73 65 0a 20 20 20 20 6e 6f 2d 6b 65 79 hrase. no-key
3f70: 20 3e 63 3a 6b 65 79 20 63 3a 68 61 73 68 0a 20 >c:key c:hash.
3f80: 20 20 20 6b 65 63 63 61 6b 2d 70 61 64 64 65 64 keccak-padded
3f90: 20 63 3a 6b 65 79 3e 20 6b 65 63 63 61 6b 2d 70 c:key> keccak-p
3fa0: 61 64 64 65 64 20 6b 65 63 63 61 6b 23 6d 61 78 added keccak#max
3fb0: 20 32 2f 20 3b 0a 0a 3a 20 67 65 74 2d 70 61 73 2/ ;..: get-pas
3fc0: 73 70 68 72 61 73 65 20 28 20 61 64 64 72 20 75 sphrase ( addr u
3fd0: 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 -- addr u ).
3fe0: 20 70 61 73 73 70 68 72 61 73 65 2d 69 6e 20 3e passphrase-in >
3ff0: 70 61 73 73 70 68 72 61 73 65 20 3b 0a 0a 56 61 passphrase ;..Va
4000: 72 69 61 62 6c 65 20 6b 65 79 73 0a 0a 3a 20 6c riable keys..: l
4010: 61 73 74 6b 65 79 40 20 28 20 2d 2d 20 61 64 64 astkey@ ( -- add
4020: 72 20 75 20 29 20 6b 65 79 73 20 24 5b 5d 23 20 r u ) keys $[]#
4030: 31 2d 20 6b 65 79 73 20 73 65 63 5b 5d 40 20 3b 1- keys sec[]@ ;
4040: 0a 3a 20 6b 65 79 3e 64 65 66 61 75 6c 74 20 28 .: key>default (
4050: 20 2d 2d 20 29 20 6c 61 73 74 6b 65 79 40 20 64 -- ) lastkey@ d
4060: 72 6f 70 20 3e 73 74 6f 72 65 6b 65 79 20 21 20 rop >storekey !
4070: 3b 0a 3a 20 2b 6b 65 79 20 28 20 61 64 64 72 20 ;.: +key ( addr
4080: 75 20 2d 2d 20 29 20 6b 65 79 73 20 73 65 63 2b u -- ) keys sec+
4090: 5b 5d 21 20 3b 0a 3a 20 2b 70 61 73 73 70 68 72 []! ;.: +passphr
40a0: 61 73 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 ase ( addr u --
40b0: 29 20 20 67 65 74 2d 70 61 73 73 70 68 72 61 73 ) get-passphras
40c0: 65 20 2b 6b 65 79 20 3b 0a 3a 20 2b 63 68 65 63 e +key ;.: +chec
40d0: 6b 70 68 72 61 73 65 20 28 20 61 64 64 72 20 75 kphrase ( addr u
40e0: 20 2d 2d 20 66 6c 61 67 20 29 20 67 65 74 2d 70 -- flag ) get-p
40f0: 61 73 73 70 68 72 61 73 65 20 6c 61 73 74 6b 65 assphrase lastke
4100: 79 40 20 73 74 72 3d 20 3b 0a 3a 20 2b 6e 65 77 y@ str= ;.: +new
4110: 70 68 72 61 73 65 20 28 20 2d 2d 20 29 0a 20 20 phrase ( -- ).
4120: 20 20 42 45 47 49 4e 0a 09 73 22 20 50 61 73 73 BEGIN..s" Pass
4130: 70 68 72 61 73 65 3a 20 22 20 2b 70 61 73 73 70 phrase: " +passp
4140: 68 72 61 73 65 0a 09 73 22 20 52 65 74 79 70 65 hrase..s" Retype
4150: 20 70 6c 73 3a 20 22 20 2b 63 68 65 63 6b 70 68 pls: " +checkph
4160: 72 61 73 65 20 30 3d 20 57 48 49 4c 45 0a 09 20 rase 0= WHILE..
4170: 20 20 20 63 72 20 2e 22 20 20 64 69 64 6e 27 74 cr ." didn't
4180: 20 6d 61 74 63 68 2c 20 74 72 79 20 61 67 61 69 match, try agai
4190: 6e 20 70 6c 65 61 73 65 22 20 63 72 0a 20 20 20 n please" cr.
41a0: 20 52 45 50 45 41 54 20 63 72 20 3b 0a 0a 3a 20 REPEAT cr ;..:
41b0: 22 3e 70 61 73 73 70 68 72 61 73 65 20 28 20 61 ">passphrase ( a
41c0: 64 64 72 20 75 20 2d 2d 20 29 20 3e 70 61 73 73 ddr u -- ) >pass
41d0: 70 68 72 61 73 65 20 2b 6b 65 79 20 3b 0a 3a 20 phrase +key ;.:
41e0: 3e 73 65 63 6b 65 79 20 28 20 2d 2d 20 61 64 64 >seckey ( -- add
41f0: 72 20 75 20 29 0a 20 20 20 20 6b 65 2d 73 6b 20 r u ). ke-sk
4200: 40 20 6b 65 2d 70 6b 20 24 40 20 64 72 6f 70 20 @ ke-pk $@ drop
4210: 6b 65 79 70 61 64 20 65 64 2d 64 68 20 3b 0a 3a keypad ed-dh ;.:
4220: 20 2b 73 65 63 6b 65 79 20 28 20 2d 2d 20 29 20 +seckey ( -- )
4230: 3e 73 65 63 6b 65 79 20 2b 6b 65 79 20 3b 0a 0a >seckey +key ;..
4240: 5c 20 22 22 20 22 3e 70 61 73 73 70 68 72 61 73 \ "" ">passphras
4250: 65 20 5c 20 66 6f 6c 6c 6f 77 69 6e 67 20 74 68 e \ following th
4260: 65 20 65 6e 63 72 79 70 74 2d 65 76 65 72 79 74 e encrypt-everyt
4270: 68 69 6e 67 20 70 61 72 61 64 69 67 6d 2c 0a 5c hing paradigm,.\
4280: 20 6e 6f 20 70 61 73 73 77 6f 72 64 20 69 73 20 no password is
4290: 74 68 65 20 65 6d 70 74 79 20 73 74 72 69 6e 67 the empty string
42a0: 21 20 20 49 74 27 73 20 73 74 69 6c 6c 20 65 6e ! It's still en
42b0: 63 72 79 70 74 65 64 20 3b 2d 29 21 0a 0a 5c 20 crypted ;-)!..\
42c0: 61 20 73 65 63 72 65 74 20 6b 65 79 20 6a 75 73 a secret key jus
42d0: 74 20 6e 65 65 64 73 20 61 20 6e 69 63 6b 20 61 t needs a nick a
42e0: 6e 64 20 61 20 74 79 70 65 2e 0a 5c 20 53 65 63 nd a type..\ Sec
42f0: 72 65 74 20 6b 65 79 73 20 63 61 6e 20 62 65 20 ret keys can be
4300: 70 65 72 73 6f 6e 73 20 61 6e 64 20 67 72 6f 75 persons and grou
4310: 70 73 2e 0a 0a 5c 20 61 20 70 75 62 6c 69 63 20 ps...\ a public
4320: 6b 65 79 20 6e 65 65 64 73 20 6d 6f 72 65 3a 20 key needs more:
4330: 6e 69 63 6b 2c 20 74 79 70 65 2c 20 70 72 6f 66 nick, type, prof
4340: 69 6c 65 2e 0a 5c 20 54 68 65 20 70 72 6f 66 69 ile..\ The profi
4350: 6c 65 20 69 73 20 61 20 73 74 72 75 63 74 75 72 le is a structur
4360: 65 64 20 64 6f 63 75 6d 65 6e 74 2c 20 69 2e 65 ed document, i.e
4370: 2e 20 70 6f 69 6e 74 65 64 20 74 6f 20 62 79 20 . pointed to by
4380: 61 20 68 61 73 68 2e 0a 0a 5c 20 61 20 73 69 67 a hash...\ a sig
4390: 6e 61 74 75 72 65 20 63 6f 6e 74 61 69 6e 73 20 nature contains
43a0: 61 20 70 75 62 6b 65 79 2c 20 61 20 63 68 65 63 a pubkey, a chec
43b0: 6b 62 6f 78 20 62 69 74 6d 61 73 6b 2c 0a 5c 20 kbox bitmask,.\
43c0: 61 20 64 61 74 65 2c 20 61 6e 20 65 78 70 69 72 a date, an expir
43d0: 61 74 69 6f 6e 20 64 61 74 65 2c 20 74 68 65 20 ation date, the
43e0: 73 69 67 6e 65 72 27 73 20 70 75 62 6b 65 79 20 signer's pubkey
43f0: 61 6e 64 20 74 68 65 20 73 69 67 6e 61 74 75 72 and the signatur
4400: 65 20 69 74 73 65 6c 66 0a 5c 20 28 72 2b 73 29 e itself.\ (r+s)
4410: 2e 20 20 54 68 65 72 65 20 69 73 20 61 6e 20 6f . There is an o
4420: 70 74 69 6f 6e 61 6c 20 73 69 67 6e 69 6e 67 20 ptional signing
4430: 70 72 6f 74 6f 63 6f 6c 20 64 6f 63 75 6d 65 6e protocol documen
4440: 74 20 28 68 61 73 68 29 2e 0a 0a 5c 20 77 65 20 t (hash)...\ we
4450: 73 74 6f 72 65 20 65 61 63 68 20 69 74 65 6d 20 store each item
4460: 69 6e 20 61 20 32 35 36 20 62 79 74 65 73 20 65 in a 256 bytes e
4470: 6e 63 72 79 70 74 65 64 20 73 74 72 69 6e 67 2c ncrypted string,
4480: 20 69 2e 65 2e 20 77 69 74 68 20 61 20 31 36 0a i.e. with a 16.
4490: 5c 20 62 79 74 65 20 73 61 6c 74 20 61 6e 64 20 \ byte salt and
44a0: 61 20 31 36 20 62 79 74 65 20 63 68 65 63 6b 73 a 16 byte checks
44b0: 75 6d 2e 0a 0a 3a 20 6b 65 2d 6c 61 73 74 21 20 um...: ke-last!
44c0: 28 20 36 34 64 61 74 65 20 2d 2d 20 29 0a 20 20 ( 64date -- ).
44d0: 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 6c ke-selfsig $@l
44e0: 65 6e 20 24 31 30 20 75 6d 61 78 20 6b 65 2d 73 en $10 umax ke-s
44f0: 65 6c 66 73 69 67 20 24 21 6c 65 6e 0a 20 20 20 elfsig $!len.
4500: 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 20 64 ke-selfsig $@ d
4510: 72 6f 70 20 36 34 27 2b 20 36 34 21 20 3b 0a 3a rop 64'+ 64! ;.:
4520: 20 6b 65 2d 66 69 72 73 74 21 20 28 20 36 34 64 ke-first! ( 64d
4530: 61 74 65 20 2d 2d 20 29 20 36 34 23 2d 31 20 6b ate -- ) 64#-1 k
4540: 65 2d 6c 61 73 74 21 0a 20 20 20 20 6b 65 2d 73 e-last!. ke-s
4550: 65 6c 66 73 69 67 20 24 40 20 64 72 6f 70 20 36 elfsig $@ drop 6
4560: 34 21 20 3b 0a 0a 73 63 6f 70 65 7b 20 6e 65 74 4! ;..scope{ net
4570: 32 6f 2d 62 61 73 65 0a 0a 63 6d 64 2d 74 61 62 2o-base..cmd-tab
4580: 6c 65 20 24 40 20 69 6e 68 65 72 69 74 2d 74 61 le $@ inherit-ta
4590: 62 6c 65 20 6b 65 79 2d 65 6e 74 72 79 2d 74 61 ble key-entry-ta
45a0: 62 6c 65 0a 5c 67 20 0a 5c 67 20 23 23 23 20 6b ble.\g .\g ### k
45b0: 65 79 20 73 74 6f 72 61 67 65 20 63 6f 6d 6d 61 ey storage comma
45c0: 6e 64 73 20 23 23 23 0a 5c 67 20 0a 24 31 31 20 nds ###.\g .$11
45d0: 6e 65 74 32 6f 3a 20 70 72 69 76 6b 65 79 20 28 net2o: privkey (
45e0: 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 0a 20 $:string -- ).
45f0: 20 20 20 5c 67 20 70 72 69 76 61 74 65 20 6b 65 \g private ke
4600: 79 0a 20 20 20 20 5c 20 64 6f 65 73 20 6e 6f 74 y. \ does not
4610: 20 6e 65 65 64 20 74 6f 20 62 65 20 73 69 67 6e need to be sign
4620: 65 64 2c 20 74 68 65 20 73 65 63 72 65 74 20 6b ed, the secret k
4630: 65 79 20 76 65 72 69 66 69 65 73 20 69 74 73 65 ey verifies itse
4640: 6c 66 0a 20 20 20 20 21 21 75 6e 73 69 67 6e 65 lf. !!unsigne
4650: 64 3f 20 24 34 30 20 21 21 3e 3d 6f 72 64 65 72 d? $40 !!>=order
4660: 3f 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 63 40 ?. keypack c@
4670: 20 24 46 20 61 6e 64 20 6b 65 2d 70 77 6c 65 76 $F and ke-pwlev
4680: 65 6c 20 21 0a 20 20 20 20 24 3e 20 6f 76 65 72 el !. $> over
4690: 20 6b 65 79 70 61 64 20 73 6b 3e 70 6b 20 5c 20 keypad sk>pk \
46a0: 67 65 6e 65 72 61 74 65 20 70 75 62 6b 65 79 0a generate pubkey.
46b0: 20 20 20 20 6b 65 79 70 61 64 20 6b 65 2d 70 6b keypad ke-pk
46c0: 20 24 40 20 64 72 6f 70 20 6b 65 79 73 69 7a 65 $@ drop keysize
46d0: 20 74 75 63 6b 20 73 74 72 3d 20 30 3d 20 21 21 tuck str= 0= !!
46e0: 77 72 6f 6e 67 2d 6b 65 79 21 21 0a 20 20 20 20 wrong-key!!.
46f0: 6b 65 2d 73 6b 20 73 65 63 21 20 2b 73 65 63 6b ke-sk sec! +seck
4700: 65 79 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 ey ;.+net2o: key
4710: 74 79 70 65 20 28 20 6e 20 2d 2d 20 29 20 20 20 type ( n -- )
4720: 20 20 20 20 20 20 20 20 21 21 73 69 67 6e 65 64 !!signed
4730: 3f 20 20 20 31 20 21 21 3e 6f 72 64 65 72 3f 20 ? 1 !!>order?
4740: 36 34 3e 6e 20 6b 65 2d 74 79 70 65 20 21 20 3b 64>n ke-type ! ;
4750: 0a 20 20 20 20 5c 67 20 6b 65 79 20 74 79 70 65 . \g key type
4760: 20 28 30 3a 20 61 6e 6f 6e 2c 20 31 3a 20 75 73 (0: anon, 1: us
4770: 65 72 2c 20 32 3a 20 67 72 6f 75 70 29 0a 2b 6e er, 2: group).+n
4780: 65 74 32 6f 3a 20 6b 65 79 6e 69 63 6b 20 28 20 et2o: keynick (
4790: 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 20 20 $:string -- )
47a0: 20 21 21 73 69 67 6e 65 64 3f 20 20 20 32 20 21 !!signed? 2 !
47b0: 21 3e 6f 72 64 65 72 3f 20 24 3e 20 6b 65 2d 6e !>order? $> ke-n
47c0: 69 63 6b 20 24 21 0a 20 20 20 20 5c 67 20 6b 65 ick $!. \g ke
47d0: 79 20 6e 69 63 6b 0a 20 20 20 20 6e 69 63 6b 21 y nick. nick!
47e0: 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 70 72 ;.+net2o: keypr
47f0: 6f 66 69 6c 65 20 28 20 24 3a 73 74 72 69 6e 67 ofile ( $:string
4800: 20 2d 2d 20 29 20 21 21 73 69 67 6e 65 64 3f 20 -- ) !!signed?
4810: 20 20 34 20 21 21 3e 6f 72 64 65 72 3f 20 24 3e 4 !!>order? $>
4820: 20 6b 65 2d 70 72 6f 66 20 24 21 20 3b 0a 20 20 ke-prof $! ;.
4830: 20 20 5c 67 20 6b 65 79 20 70 72 6f 66 69 6c 65 \g key profile
4840: 20 28 68 61 73 68 20 6f 66 20 61 20 72 65 73 6f (hash of a reso
4850: 75 72 63 65 29 0a 2b 6e 65 74 32 6f 3a 20 6b 65 urce).+net2o: ke
4860: 79 6d 61 73 6b 20 28 20 78 20 2d 2d 20 29 20 20 ymask ( x -- )
4870: 20 20 20 20 20 20 20 21 21 75 6e 73 69 67 6e 65 !!unsigne
4880: 64 3f 20 24 34 30 20 21 21 3e 3d 6f 72 64 65 72 d? $40 !!>=order
4890: 3f 20 36 34 3e 6e 0a 20 20 20 20 5c 67 20 6b 65 ? 64>n. \g ke
48a0: 79 20 61 63 63 65 73 73 20 72 69 67 68 74 20 6d y access right m
48b0: 61 73 6b 0a 20 20 20 20 31 20 69 6d 70 6f 72 74 ask. 1 import
48c0: 2d 74 79 70 65 20 40 20 6c 73 68 69 66 74 0a 20 -type @ lshift.
48d0: 20 20 20 5b 20 31 20 69 6d 70 6f 72 74 23 73 65 [ 1 import#se
48e0: 6c 66 20 6c 73 68 69 66 74 20 31 20 69 6d 70 6f lf lshift 1 impo
48f0: 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 rt#new lshift or
4900: 20 5d 4c 0a 20 20 20 20 61 6e 64 20 49 46 20 20 ]L. and IF
4910: 64 75 70 20 6b 65 2d 6d 61 73 6b 20 6f 72 21 20 dup ke-mask or!
4920: 3f 3e 67 72 6f 75 70 73 20 20 45 4c 53 45 20 20 ?>groups ELSE
4930: 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 2b 6e 65 drop THEN ;.+ne
4940: 74 32 6f 3a 20 6b 65 79 67 72 6f 75 70 73 20 28 t2o: keygroups (
4950: 20 24 3a 67 72 6f 75 70 73 20 2d 2d 20 29 20 21 $:groups -- ) !
4960: 21 75 6e 73 69 67 6e 65 64 3f 20 24 32 30 20 21 !unsigned? $20 !
4970: 21 3e 6f 72 64 65 72 3f 20 24 3e 0a 20 20 20 20 !>order? $>.
4980: 5c 67 20 61 63 63 65 73 73 20 67 72 6f 75 70 73 \g access groups
4990: 0a 20 20 20 20 31 20 69 6d 70 6f 72 74 2d 74 79 . 1 import-ty
49a0: 70 65 20 40 20 6c 73 68 69 66 74 0a 20 20 20 20 pe @ lshift.
49b0: 5b 20 31 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 [ 1 import#self
49c0: 6c 73 68 69 66 74 20 31 20 69 6d 70 6f 72 74 23 lshift 1 import#
49d0: 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 20 5d 4c new lshift or ]L
49e0: 0a 20 20 20 20 61 6e 64 20 49 46 20 20 20 32 64 . and IF 2d
49f0: 75 70 20 6b 65 2d 67 72 6f 75 70 73 20 24 21 20 up ke-groups $!
4a00: 67 72 6f 75 70 73 3e 6d 61 73 6b 20 6b 65 2d 6d groups>mask ke-m
4a10: 61 73 6b 20 21 0a 20 20 20 20 45 4c 53 45 20 20 ask !. ELSE
4a20: 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 2b 6e 2drop THEN ;.+n
4a30: 65 74 32 6f 3a 20 2b 6b 65 79 73 69 67 20 28 20 et2o: +keysig (
4a40: 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 20 21 $:string -- ) !
4a50: 21 75 6e 73 69 67 6e 65 64 3f 20 24 31 30 20 21 !unsigned? $10 !
4a60: 21 3e 3d 6f 72 64 65 72 3f 20 24 3e 20 6b 65 2d !>=order? $> ke-
4a70: 73 69 67 73 20 24 2b 5b 5d 21 20 3b 0a 20 20 20 sigs $+[]! ;.
4a80: 20 5c 67 20 61 64 64 20 61 20 6b 65 79 20 73 69 \g add a key si
4a90: 67 6e 61 74 75 72 65 0a 2b 6e 65 74 32 6f 3a 20 gnature.+net2o:
4aa0: 6b 65 79 69 6d 70 6f 72 74 20 28 20 6e 20 2d 2d keyimport ( n --
4ab0: 20 29 20 20 20 20 20 20 20 21 21 75 6e 73 69 67 ) !!unsig
4ac0: 6e 65 64 3f 20 24 31 30 20 21 21 3e 3d 6f 72 64 ned? $10 !!>=ord
4ad0: 65 72 3f 0a 20 20 20 20 63 6f 6e 66 69 67 3a 70 er?. config:p
4ae0: 77 2d 6c 65 76 65 6c 23 20 40 20 30 3c 20 49 46 w-level# @ 0< IF
4af0: 20 20 36 34 3e 6e 0a 09 64 75 70 20 5b 20 31 20 64>n..dup [ 1
4b00: 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 import#new lshif
4b10: 74 20 5d 4c 20 61 6e 64 20 30 3d 20 49 46 0a 09 t ]L and 0= IF..
4b20: 20 20 20 20 69 6d 70 6f 72 74 23 75 6e 74 72 75 import#untru
4b30: 73 74 65 64 20 75 6d 69 6e 20 31 20 73 77 61 70 sted umin 1 swap
4b40: 20 6c 73 68 69 66 74 20 5b 20 31 20 69 6d 70 6f lshift [ 1 impo
4b50: 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 5d 4c rt#new lshift ]L
4b60: 20 6f 72 0a 09 45 4c 53 45 0a 09 20 20 20 20 5b or..ELSE.. [
4b70: 20 32 20 69 6d 70 6f 72 74 23 75 6e 74 72 75 73 2 import#untrus
4b80: 74 65 64 20 6c 73 68 69 66 74 20 31 2d 20 31 20 ted lshift 1- 1
4b90: 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 import#new lshif
4ba0: 74 20 6f 72 20 5d 4c 20 61 6e 64 0a 09 54 48 45 t or ]L and..THE
4bb0: 4e 0a 09 6b 65 2d 69 6d 70 6f 72 74 73 20 6f 72 N..ke-imports or
4bc0: 21 0a 20 20 20 20 45 4c 53 45 20 20 36 34 64 72 !. ELSE 64dr
4bd0: 6f 70 20 20 54 48 45 4e 20 3b 0a 2b 6e 65 74 32 op THEN ;.+net2
4be0: 6f 3a 20 72 73 6b 6b 65 79 20 28 20 24 3a 73 74 o: rskkey ( $:st
4bf0: 72 69 6e 67 20 2d 2d 2d 20 29 0a 20 20 20 20 5c ring --- ). \
4c00: 67 20 72 65 76 6f 6b 65 20 6b 65 79 2c 20 74 65 g revoke key, te
4c10: 6d 70 6f 72 61 72 69 6c 79 20 73 74 6f 72 65 64 mporarily stored
4c20: 0a 20 20 20 20 5c 20 64 6f 65 73 20 6e 6f 74 20 . \ does not
4c30: 6e 65 65 64 20 74 6f 20 62 65 20 73 69 67 6e 65 need to be signe
4c40: 64 2c 20 74 68 65 20 72 65 76 6f 6b 65 20 6b 65 d, the revoke ke
4c50: 79 20 76 65 72 69 66 69 65 73 20 69 74 73 65 6c y verifies itsel
4c60: 66 0a 20 20 20 20 21 21 75 6e 73 69 67 6e 65 64 f. !!unsigned
4c70: 3f 20 24 38 30 20 21 21 3e 3d 6f 72 64 65 72 3f ? $80 !!>=order?
4c80: 0a 20 20 20 20 24 3e 20 32 64 75 70 20 73 6b 72 . $> 2dup skr
4c90: 65 76 20 73 77 61 70 20 6b 65 79 7c 20 6d 6f 76 ev swap key| mov
4ca0: 65 20 6b 65 2d 70 6b 20 24 40 20 64 72 6f 70 20 e ke-pk $@ drop
4cb0: 63 68 65 63 6b 2d 72 65 76 3f 20 30 3d 20 21 21 check-rev? 0= !!
4cc0: 6e 6f 74 2d 6d 79 2d 72 65 76 73 6b 21 21 0a 20 not-my-revsk!!.
4cd0: 20 20 20 70 6b 72 65 76 20 6b 65 79 73 69 7a 65 pkrev keysize
4ce0: 32 20 65 72 61 73 65 20 20 6b 65 2d 72 73 6b 20 2 erase ke-rsk
4cf0: 73 65 63 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b sec! ;.+net2o: k
4d00: 65 79 70 65 74 20 28 20 24 3a 73 74 72 69 6e 67 eypet ( $:string
4d10: 20 2d 2d 20 29 20 20 21 21 75 6e 73 69 67 6e 65 -- ) !!unsigne
4d20: 64 3f 20 20 24 3e 0a 20 20 20 20 63 6f 6e 66 69 d? $>. confi
4d30: 67 3a 70 77 2d 6c 65 76 65 6c 23 20 40 20 30 3c g:pw-level# @ 0<
4d40: 20 49 46 20 20 6b 65 2d 70 65 74 73 20 24 2b 5b IF ke-pets $+[
4d50: 5d 21 20 70 65 74 21 20 20 45 4c 53 45 20 20 32 ]! pet! ELSE 2
4d60: 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 7d 73 63 drop THEN ;.}sc
4d70: 6f 70 65 0a 0a 67 65 6e 2d 74 61 62 6c 65 20 24 ope..gen-table $
4d80: 66 72 65 65 7a 65 0a 27 20 63 6f 6e 74 65 78 74 freeze.' context
4d90: 2d 74 61 62 6c 65 20 69 73 20 67 65 6e 2d 74 61 -table is gen-ta
4da0: 62 6c 65 0a 0a 3a 20 6b 65 79 3a 6e 65 73 74 2d ble..: key:nest-
4db0: 73 69 67 20 28 20 61 64 64 72 20 75 20 2d 2d 20 sig ( addr u --
4dc0: 61 64 64 72 20 75 27 20 66 6c 61 67 20 29 0a 20 addr u' flag ).
4dd0: 20 20 20 70 6b 32 2d 73 69 67 3f 20 64 75 70 20 pk2-sig? dup
4de0: 3f 45 58 49 54 20 64 72 6f 70 0a 20 20 20 20 32 ?EXIT drop. 2
4df0: 64 75 70 20 2b 20 73 69 67 73 69 7a 65 23 20 2d dup + sigsize# -
4e00: 20 73 69 67 73 69 7a 65 23 20 3e 24 0a 20 20 20 sigsize# >$.
4e10: 20 73 69 67 70 6b 32 73 69 7a 65 23 20 2d 20 32 sigpk2size# - 2
4e20: 64 75 70 20 2b 20 6b 65 79 73 69 7a 65 32 20 6b dup + keysize2 k
4e30: 65 79 3f 6e 65 77 20 6e 3a 3e 6f 20 24 3e 20 6b ey?new n:>o $> k
4e40: 65 2d 73 65 6c 66 73 69 67 20 24 21 0a 20 20 20 e-selfsig $!.
4e50: 20 73 69 6d 2d 6e 69 63 6b 21 20 6f 66 66 20 63 sim-nick! off c
4e60: 2d 73 74 61 74 65 20 6f 66 66 20 73 69 67 2d 6f -state off sig-o
4e70: 6b 20 3b 0a 27 20 6b 65 79 3a 6e 65 73 74 2d 73 k ;.' key:nest-s
4e80: 69 67 20 6b 65 79 2d 65 6e 74 72 79 20 74 6f 20 ig key-entry to
4e90: 6e 65 73 74 2d 73 69 67 0a 0a 73 61 6d 70 6c 65 nest-sig..sample
4ea0: 2d 6b 65 79 20 3e 6f 20 6b 65 79 2d 65 6e 74 72 -key >o key-entr
4eb0: 79 2d 74 61 62 6c 65 20 40 20 74 6f 6b 65 6e 2d y-table @ token-
4ec0: 74 61 62 6c 65 20 21 20 6f 3e 0a 0a 3a 20 6b 65 table ! o>..: ke
4ed0: 79 3a 63 6f 64 65 20 28 20 2d 2d 20 29 0a 20 20 y:code ( -- ).
4ee0: 20 20 63 6f 64 65 2d 6b 65 79 20 20 63 6d 64 6c code-key cmdl
4ef0: 6f 63 6b 20 6c 6f 63 6b 0a 20 20 20 20 6b 65 79 ock lock. key
4f00: 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c pack keypack-all
4f10: 23 20 65 72 61 73 65 0a 20 20 20 20 63 6d 64 72 # erase. cmdr
4f20: 65 73 65 74 20 69 6e 69 74 2d 72 65 70 6c 79 20 eset init-reply
4f30: 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73 65 20 also net2o-base
4f40: 3b 0a 63 6f 6d 70 3a 20 3a 2c 20 61 6c 73 6f 20 ;.comp: :, also
4f50: 6e 65 74 32 6f 2d 62 61 73 65 20 3b 0a 0a 73 63 net2o-base ;..sc
4f60: 6f 70 65 7b 20 6e 65 74 32 6f 2d 62 61 73 65 0a ope{ net2o-base.
4f70: 0a 3a 20 65 6e 64 3a 6b 65 79 20 28 20 2d 2d 20 .: end:key ( --
4f80: 29 0a 20 20 20 20 65 6e 64 2d 77 69 74 68 20 70 ). end-with p
4f90: 72 65 76 69 6f 75 73 20 63 6d 64 6c 6f 63 6b 20 revious cmdlock
4fa0: 75 6e 6c 6f 63 6b 20 3b 0a 63 6f 6d 70 3a 20 3a unlock ;.comp: :
4fb0: 2c 20 70 72 65 76 69 6f 75 73 20 3b 0a 0a 7d 73 , previous ;..}s
4fc0: 63 6f 70 65 0a 0a 3a 20 6b 65 79 2d 63 72 79 70 cope..: key-cryp
4fd0: 74 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 t ( -- ). key
4fe0: 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c pack keypack-all
4ff0: 23 0a 20 20 20 20 3e 73 74 6f 72 65 6b 65 79 20 #. >storekey
5000: 73 65 63 40 20 64 75 70 20 24 32 30 20 75 3c 3d sec@ dup $20 u<=
5010: 20 5c 20 69 73 20 61 20 73 65 63 72 65 74 2c 20 \ is a secret,
5020: 6e 6f 20 6e 65 65 64 20 74 6f 20 62 65 20 73 6c no need to be sl
5030: 6f 77 0a 20 20 20 20 49 46 20 20 65 6e 63 72 79 ow. IF encry
5040: 70 74 24 20 20 45 4c 53 45 20 20 63 6f 6e 66 69 pt$ ELSE confi
5050: 67 3a 70 77 2d 6c 65 76 65 6c 23 20 40 20 65 6e g:pw-level# @ en
5060: 63 72 79 70 74 2d 70 77 24 20 20 54 48 45 4e 20 crypt-pw$ THEN
5070: 3b 0a 0a 30 20 56 61 6c 75 65 20 6b 65 79 2d 73 ;..0 Value key-s
5080: 66 64 20 5c 20 73 65 63 72 65 74 20 6b 65 79 73 fd \ secret keys
5090: 0a 30 20 56 61 6c 75 65 20 6b 65 79 2d 70 66 64 .0 Value key-pfd
50a0: 20 5c 20 70 75 62 6b 65 79 73 0a 0a 5c 20 6c 65 \ pubkeys..\ le
50b0: 67 61 63 79 20 66 6f 72 20 65 61 72 6c 79 20 76 gacy for early v
50c0: 65 72 73 69 6f 6e 73 20 6f 66 20 6e 65 74 32 6f ersions of net2o
50d0: 20 70 72 69 6f 72 20 32 30 31 36 30 36 30 36 0a prior 20160606.
50e0: 0a 3a 20 6e 65 74 32 6f 3e 6b 65 79 73 20 7b 20 .: net2o>keys {
50f0: 61 64 64 72 20 75 20 2d 2d 20 7d 0a 20 20 20 20 addr u -- }.
5100: 61 64 64 72 20 75 20 2e 6e 65 74 32 6f 2f 20 20 addr u .net2o/
5110: 61 64 64 72 20 75 20 2e 6b 65 79 73 2f 20 72 65 addr u .keys/ re
5120: 6e 61 6d 65 2d 66 69 6c 65 20 64 72 6f 70 20 3b name-file drop ;
5130: 0a 3a 20 3f 6c 65 67 61 63 79 2d 6b 65 79 73 20 .: ?legacy-keys
5140: 28 20 66 6c 61 67 20 2d 2d 20 29 0a 20 20 20 20 ( flag -- ).
5150: 5c 20 21 21 46 49 58 4d 45 21 21 20 6e 65 65 64 \ !!FIXME!! need
5160: 73 20 74 6f 20 62 65 20 72 65 6d 6f 76 65 64 20 s to be removed
5170: 77 68 65 6e 20 61 6c 6c 20 63 75 72 72 65 6e 74 when all current
5180: 20 75 73 65 72 73 0a 20 20 20 20 5c 20 68 61 76 users. \ hav
5190: 65 20 6d 69 67 72 61 74 65 64 0a 20 20 20 20 49 e migrated. I
51a0: 46 0a 09 22 70 75 62 6b 65 79 73 2e 6b 32 6f 22 F.."pubkeys.k2o"
51b0: 20 6e 65 74 32 6f 3e 6b 65 79 73 0a 09 22 73 65 net2o>keys.."se
51c0: 63 6b 65 79 73 2e 6b 32 6f 22 20 6e 65 74 32 6f ckeys.k2o" net2o
51d0: 3e 6b 65 79 73 0a 20 20 20 20 54 48 45 4e 20 3b >keys. THEN ;
51e0: 0a 0a 3a 20 67 65 6e 2d 6b 65 79 73 2d 64 69 72 ..: gen-keys-dir
51f0: 20 28 20 2d 2d 20 29 0a 20 20 20 20 69 6e 69 74 ( -- ). init
5200: 2d 64 69 72 73 20 3f 2e 6e 65 74 32 6f 2f 6b 65 -dirs ?.net2o/ke
5210: 79 73 20 3f 6c 65 67 61 63 79 2d 6b 65 79 73 20 ys ?legacy-keys
5220: 3b 0a 0a 3a 20 3f 66 64 2d 6b 65 79 73 20 28 20 ;..: ?fd-keys (
5230: 66 64 20 61 64 64 72 20 75 20 2d 2d 20 66 64 27 fd addr u -- fd'
5240: 20 29 20 7b 20 61 64 64 72 20 75 20 7d 20 64 75 ) { addr u } du
5250: 70 20 3f 45 58 49 54 20 64 72 6f 70 0a 20 20 20 p ?EXIT drop.
5260: 20 67 65 6e 2d 6b 65 79 73 2d 64 69 72 0a 20 20 gen-keys-dir.
5270: 20 20 61 64 64 72 20 75 20 72 2f 77 20 6f 70 65 addr u r/w ope
5280: 6e 2d 66 69 6c 65 20 64 75 70 20 6e 6f 2d 66 69 n-file dup no-fi
5290: 6c 65 23 20 3d 20 49 46 0a 09 32 64 72 6f 70 20 le# = IF..2drop
52a0: 61 64 64 72 20 75 20 72 2f 77 20 63 72 65 61 74 addr u r/w creat
52b0: 65 2d 66 69 6c 65 0a 20 20 20 20 54 48 45 4e 20 e-file. THEN
52c0: 20 74 68 72 6f 77 20 3b 0a 0a 3a 20 3f 6b 65 79 throw ;..: ?key
52d0: 2d 73 66 64 20 28 20 2d 2d 20 66 64 20 29 0a 20 -sfd ( -- fd ).
52e0: 20 20 20 6b 65 79 2d 73 66 64 20 22 73 65 63 6b key-sfd "seck
52f0: 65 79 73 2e 6b 32 6f 22 20 2e 6b 65 79 73 2f 20 eys.k2o" .keys/
5300: 3f 66 64 2d 6b 65 79 73 20 64 75 70 20 74 6f 20 ?fd-keys dup to
5310: 6b 65 79 2d 73 66 64 20 3b 0a 3a 20 3f 6b 65 79 key-sfd ;.: ?key
5320: 2d 70 66 64 20 28 20 2d 2d 20 66 64 20 29 0a 20 -pfd ( -- fd ).
5330: 20 20 20 6b 65 79 2d 70 66 64 20 22 70 75 62 6b key-pfd "pubk
5340: 65 79 73 2e 6b 32 6f 22 20 2e 6b 65 79 73 2f 20 eys.k2o" .keys/
5350: 3f 66 64 2d 6b 65 79 73 20 64 75 70 20 74 6f 20 ?fd-keys dup to
5360: 6b 65 79 2d 70 66 64 20 3b 0a 0a 3a 20 6b 65 79 key-pfd ;..: key
5370: 3e 73 66 69 6c 65 20 28 20 2d 2d 20 29 0a 20 20 >sfile ( -- ).
5380: 20 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 keypack keypac
5390: 6b 2d 61 6c 6c 23 20 3f 6b 65 79 2d 73 66 64 20 k-all# ?key-sfd
53a0: 61 70 70 65 6e 64 2d 66 69 6c 65 20 6b 65 2d 6f append-file ke-o
53b0: 66 66 73 65 74 20 36 34 21 20 3b 0a 3a 20 6b 65 ffset 64! ;.: ke
53c0: 79 3e 70 66 69 6c 65 20 28 20 2d 2d 20 29 0a 20 y>pfile ( -- ).
53d0: 20 20 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 keypack keypa
53e0: 63 6b 2d 61 6c 6c 23 20 3f 6b 65 79 2d 70 66 64 ck-all# ?key-pfd
53f0: 20 61 70 70 65 6e 64 2d 66 69 6c 65 20 6b 65 2d append-file ke-
5400: 6f 66 66 73 65 74 20 36 34 21 20 3b 0a 0a 3a 20 offset 64! ;..:
5410: 6b 65 79 3e 73 66 69 6c 65 40 70 6f 73 20 28 20 key>sfile@pos (
5420: 36 34 70 6f 73 20 2d 2d 20 29 20 36 34 64 75 70 64pos -- ) 64dup
5430: 20 36 34 23 2d 31 20 36 34 3d 20 49 46 20 20 36 64#-1 64= IF 6
5440: 34 64 72 6f 70 20 6b 65 79 3e 73 66 69 6c 65 0a 4drop key>sfile.
5450: 20 20 20 20 45 4c 53 45 20 20 36 34 3e 72 20 6b ELSE 64>r k
5460: 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 eypack keypack-a
5470: 6c 6c 23 20 36 34 72 3e 20 3f 6b 65 79 2d 73 66 ll# 64r> ?key-sf
5480: 64 20 77 72 69 74 65 40 70 6f 73 2d 66 69 6c 65 d write@pos-file
5490: 20 20 54 48 45 4e 20 3b 0a 3a 20 6b 65 79 3e 70 THEN ;.: key>p
54a0: 66 69 6c 65 40 70 6f 73 20 28 20 36 34 70 6f 73 file@pos ( 64pos
54b0: 20 2d 2d 20 29 20 36 34 64 75 70 20 36 34 23 2d -- ) 64dup 64#-
54c0: 31 20 36 34 3d 20 49 46 20 20 36 34 64 72 6f 70 1 64= IF 64drop
54d0: 20 6b 65 79 3e 70 66 69 6c 65 0a 20 20 20 20 45 key>pfile. E
54e0: 4c 53 45 20 20 36 34 3e 72 20 6b 65 79 70 61 63 LSE 64>r keypac
54f0: 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 36 k keypack-all# 6
5500: 34 72 3e 20 3f 6b 65 79 2d 70 66 64 20 77 72 69 4r> ?key-pfd wri
5510: 74 65 40 70 6f 73 2d 66 69 6c 65 20 20 54 48 45 te@pos-file THE
5520: 4e 20 3b 0a 0a 3a 20 72 6e 64 3e 73 66 69 6c 65 N ;..: rnd>sfile
5530: 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 70 ( -- ). keyp
5540: 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 ack keypack-all#
5550: 20 3e 72 6e 67 24 20 6b 65 79 3e 73 66 69 6c 65 >rng$ key>sfile
5560: 20 3b 0a 3a 20 72 6e 64 3e 70 66 69 6c 65 20 28 ;.: rnd>pfile (
5570: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 70 61 63 -- ). keypac
5580: 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3e k keypack-all# >
5590: 72 6e 67 24 20 6b 65 79 3e 70 66 69 6c 65 20 3b rng$ key>pfile ;
55a0: 0a 0a 3a 20 3e 6b 65 79 73 20 28 20 2d 2d 20 29 ..: >keys ( -- )
55b0: 0a 20 20 20 20 5c 47 20 61 64 64 20 73 68 61 72 . \G add shar
55c0: 65 64 20 73 65 63 72 65 74 20 74 6f 20 6c 69 73 ed secret to lis
55d0: 74 20 6f 66 20 70 6f 73 73 69 62 6c 65 20 6b 65 t of possible ke
55e0: 79 73 0a 20 20 20 20 73 6b 63 20 70 6b 63 20 6b ys. skc pkc k
55f0: 65 79 70 61 64 20 65 64 2d 64 68 20 2b 6b 65 79 eypad ed-dh +key
5600: 20 3b 0a 0a 5c 20 6b 65 79 20 67 65 6e 65 72 61 ;..\ key genera
5610: 74 69 6f 6e 0a 5c 20 66 6f 72 20 72 65 70 72 6f tion.\ for repro
5620: 64 75 63 69 62 69 6c 69 74 79 20 6f 66 20 74 68 ducibility of th
5630: 65 20 73 65 6c 66 73 69 67 2c 20 61 6c 77 61 79 e selfsig, alway
5640: 73 20 75 73 65 20 74 68 65 20 73 61 6d 65 20 6f s use the same o
5650: 72 64 65 72 3a 0a 5c 20 22 70 75 62 6b 65 79 22 rder:.\ "pubkey"
5660: 20 6e 65 77 6b 65 79 20 3c 6e 3e 20 6b 65 79 74 newkey <n> keyt
5670: 79 70 65 20 22 6e 69 63 6b 22 20 6b 65 79 6e 69 ype "nick" keyni
5680: 63 6b 20 22 73 69 67 22 20 6b 65 79 73 65 6c 66 ck "sig" keyself
5690: 73 69 67 0a 0a 55 73 65 72 20 70 6b 2b 73 69 67 sig..User pk+sig
56a0: 24 0a 0a 6b 65 79 73 69 7a 65 32 20 43 6f 6e 73 $..keysize2 Cons
56b0: 74 61 6e 74 20 70 6b 72 6b 23 0a 0a 3a 20 5d 70 tant pkrk#..: ]p
56c0: 6b 2b 73 69 67 6e 20 28 20 61 64 64 72 20 75 20 k+sign ( addr u
56d0: 2d 2d 20 29 20 2b 63 6d 64 62 75 66 20 5d 73 69 -- ) +cmdbuf ]si
56e0: 67 6e 20 3b 0a 0a 3a 20 70 61 63 6b 2d 6b 65 79 gn ;..: pack-key
56f0: 20 28 20 74 79 70 65 20 6e 69 63 6b 20 75 20 2d ( type nick u -
5700: 2d 20 29 0a 20 20 20 20 6e 6f 77 3e 6e 65 76 65 - ). now>neve
5710: 72 0a 20 20 20 20 6b 65 79 3a 63 6f 64 65 0a 20 r. key:code.
5720: 20 20 20 20 20 73 69 67 6e 5b 0a 20 20 20 20 20 sign[.
5730: 20 72 6f 74 20 75 6c 69 74 2c 20 6b 65 79 74 79 rot ulit, keyty
5740: 70 65 20 24 2c 20 6b 65 79 6e 69 63 6b 0a 20 20 pe $, keynick.
5750: 20 20 20 20 70 6b 63 20 70 6b 72 6b 23 20 5d 70 pkc pkrk# ]p
5760: 6b 2b 73 69 67 6e 0a 20 20 20 20 20 20 73 6b 63 k+sign. skc
5770: 20 6b 65 79 73 69 7a 65 20 73 65 63 24 2c 20 70 keysize sec$, p
5780: 72 69 76 6b 65 79 0a 20 20 20 20 65 6e 64 3a 6b rivkey. end:k
5790: 65 79 20 3b 0a 0a 61 6c 73 6f 20 6e 65 74 32 6f ey ;..also net2o
57a0: 2d 62 61 73 65 0a 3a 20 70 61 63 6b 2d 63 6f 72 -base.: pack-cor
57b0: 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 20 5c e ( o:key -- ) \
57c0: 20 63 6f 72 65 20 77 69 74 68 6f 75 74 20 6b 65 core without ke
57d0: 79 0a 20 20 20 20 6b 65 2d 74 79 70 65 20 40 20 y. ke-type @
57e0: 75 6c 69 74 2c 20 6b 65 79 74 79 70 65 0a 20 20 ulit, keytype.
57f0: 20 20 6b 65 2d 6e 69 63 6b 20 24 40 20 24 2c 20 ke-nick $@ $,
5800: 6b 65 79 6e 69 63 6b 0a 20 20 20 20 6b 65 2d 70 keynick. ke-p
5810: 72 6f 66 20 24 40 20 64 75 70 20 49 46 20 20 24 rof $@ dup IF $
5820: 2c 20 6b 65 79 70 72 6f 66 69 6c 65 20 20 45 4c , keyprofile EL
5830: 53 45 20 20 32 64 72 6f 70 20 20 54 48 45 4e 20 SE 2drop THEN
5840: 3b 0a 0a 3a 20 70 61 63 6b 2d 73 69 67 6e 6b 65 ;..: pack-signke
5850: 79 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 y ( o:key -- ).
5860: 20 20 20 73 69 67 6e 5b 0a 20 20 20 20 70 61 63 sign[. pac
5870: 6b 2d 63 6f 72 65 0a 20 20 20 20 6b 65 2d 70 6b k-core. ke-pk
5880: 20 24 40 20 2b 63 6d 64 62 75 66 0a 20 20 20 20 $@ +cmdbuf.
5890: 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 20 2b 63 ke-selfsig $@ +c
58a0: 6d 64 62 75 66 20 63 6d 64 2d 72 65 73 6f 6c 76 mdbuf cmd-resolv
58b0: 65 3e 20 32 64 72 6f 70 20 6e 65 73 74 73 69 67 e> 2drop nestsig
58c0: 20 3b 0a 0a 3a 20 70 61 63 6b 2d 63 6f 72 65 6b ;..: pack-corek
58d0: 65 79 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a ey ( o:key -- ).
58e0: 20 20 20 20 70 61 63 6b 2d 73 69 67 6e 6b 65 79 pack-signkey
58f0: 0a 20 20 20 20 6b 65 2d 69 6d 70 6f 72 74 73 20 . ke-imports
5900: 40 20 75 6c 69 74 2c 20 6b 65 79 69 6d 70 6f 72 @ ulit, keyimpor
5910: 74 0a 20 20 20 20 6b 65 2d 6d 61 73 6b 20 40 20 t. ke-mask @
5920: 20 6b 65 2d 67 72 6f 75 70 73 20 24 40 6c 65 6e ke-groups $@len
5930: 20 49 46 0a 09 6b 65 2d 67 72 6f 75 70 73 20 24 IF..ke-groups $
5940: 40 20 32 64 75 70 20 24 2c 20 6b 65 79 67 72 6f @ 2dup $, keygro
5950: 75 70 73 0a 09 67 72 6f 75 70 73 3e 6d 61 73 6b ups..groups>mask
5960: 20 69 6e 76 65 72 74 20 61 6e 64 20 20 54 48 45 invert and THE
5970: 4e 0a 20 20 20 20 3f 64 75 70 2d 49 46 20 20 6e N. ?dup-IF n
5980: 6c 69 74 2c 20 6b 65 79 6d 61 73 6b 20 20 54 48 lit, keymask TH
5990: 45 4e 0a 20 20 20 20 6b 65 2d 70 65 74 73 20 5b EN. ke-pets [
59a0: 3a 20 24 2c 20 6b 65 79 70 65 74 20 3b 5d 20 24 : $, keypet ;] $
59b0: 5b 5d 6d 61 70 0a 20 20 20 20 6b 65 2d 73 74 6f []map. ke-sto
59c0: 72 65 6b 65 79 20 40 20 3e 73 74 6f 72 65 6b 65 rekey @ >storeke
59d0: 79 20 21 20 3b 0a 70 72 65 76 69 6f 75 73 0a 0a y ! ;.previous..
59e0: 3a 20 70 61 63 6b 2d 70 75 62 6b 65 79 20 28 20 : pack-pubkey (
59f0: 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b o:key -- ). k
5a00: 65 79 3a 63 6f 64 65 0a 20 20 20 20 20 20 70 61 ey:code. pa
5a10: 63 6b 2d 63 6f 72 65 6b 65 79 0a 20 20 20 20 65 ck-corekey. e
5a20: 6e 64 3a 6b 65 79 20 3b 0a 3a 20 70 61 63 6b 2d nd:key ;.: pack-
5a30: 6f 75 74 6b 65 79 20 28 20 6f 3a 6b 65 79 20 2d outkey ( o:key -
5a40: 2d 20 29 0a 20 20 20 20 6b 65 79 3a 63 6f 64 65 - ). key:code
5a50: 0a 20 20 20 20 20 20 22 6e 32 6f 22 20 6e 65 74 . "n2o" net
5a60: 32 6f 2d 62 61 73 65 3a 34 63 63 2c 0a 20 20 20 2o-base:4cc,.
5a70: 20 20 20 70 61 63 6b 2d 73 69 67 6e 6b 65 79 0a pack-signkey.
5a80: 20 20 20 20 65 6e 64 3a 6b 65 79 20 3b 0a 3a 20 end:key ;.:
5a90: 70 61 63 6b 2d 73 65 63 6b 65 79 20 28 20 6f 3a pack-seckey ( o:
5aa0: 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 key -- ). key
5ab0: 3a 63 6f 64 65 0a 20 20 20 20 20 20 70 61 63 6b :code. pack
5ac0: 2d 63 6f 72 65 6b 65 79 0a 20 20 20 20 20 20 6b -corekey. k
5ad0: 65 2d 73 6b 20 73 65 63 40 20 73 65 63 24 2c 20 e-sk sec@ sec$,
5ae0: 70 72 69 76 6b 65 79 0a 20 20 20 20 20 20 6b 65 privkey. ke
5af0: 2d 72 73 6b 20 73 65 63 40 20 64 75 70 20 49 46 -rsk sec@ dup IF
5b00: 20 20 73 65 63 24 2c 20 72 73 6b 6b 65 79 20 20 sec$, rskkey
5b10: 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 45 ELSE 2drop THE
5b20: 4e 0a 20 20 20 20 65 6e 64 3a 6b 65 79 20 3b 0a N. end:key ;.
5b30: 3a 20 6b 65 79 6e 69 63 6b 24 20 28 20 6f 3a 6b : keynick$ ( o:k
5b40: 65 79 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 ey -- addr u ).
5b50: 20 20 20 5c 47 20 67 65 74 20 74 68 65 20 61 6e \G get the an
5b60: 6e 6f 74 61 74 69 6f 6e 73 20 77 69 74 68 20 73 notations with s
5b70: 69 67 6e 61 74 75 72 65 0a 20 20 20 20 5b 27 5d ignature. [']
5b80: 20 70 61 63 6b 2d 63 6f 72 65 20 67 65 6e 2d 63 pack-core gen-c
5b90: 6d 64 24 20 32 64 72 6f 70 0a 20 20 20 20 6b 65 md$ 2drop. ke
5ba0: 2d 73 65 6c 66 73 69 67 20 24 40 20 74 6d 70 24 -selfsig $@ tmp$
5bb0: 20 24 2b 21 20 74 6d 70 24 20 24 40 20 3b 0a 3a $+! tmp$ $@ ;.:
5bc0: 20 6b 65 79 70 6b 32 6e 69 63 6b 24 20 28 20 6f keypk2nick$ ( o
5bd0: 3a 6b 65 79 20 2d 2d 20 61 64 64 72 20 75 20 29 :key -- addr u )
5be0: 0a 20 20 20 20 5c 47 20 67 65 74 20 74 68 65 20 . \G get the
5bf0: 61 6e 6e 6f 74 61 74 69 6f 6e 73 20 77 69 74 68 annotations with
5c00: 20 73 69 67 6e 61 74 75 72 65 0a 20 20 20 20 5b signature. [
5c10: 27 5d 20 70 61 63 6b 2d 63 6f 72 65 20 67 65 6e '] pack-core gen
5c20: 2d 63 6d 64 24 20 32 64 72 6f 70 0a 20 20 20 20 -cmd$ 2drop.
5c30: 6b 65 2d 70 6b 20 24 40 20 74 6d 70 24 20 24 2b ke-pk $@ tmp$ $+
5c40: 21 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 20 ! ke-selfsig $@
5c50: 74 6d 70 24 20 24 2b 21 20 74 6d 70 24 20 24 40 tmp$ $+! tmp$ $@
5c60: 20 3b 0a 3a 20 6d 79 6e 69 63 6b 2d 6b 65 79 20 ;.: mynick-key
5c70: 28 20 2d 2d 20 6f 20 29 0a 20 20 20 20 70 6b 63 ( -- o ). pkc
5c80: 20 6b 65 79 73 69 7a 65 20 6b 65 79 23 20 23 40 keysize key# #@
5c90: 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3b 0a 3a 20 drop cell+ ;.:
5ca0: 6d 79 6e 69 63 6b 24 20 28 20 2d 2d 20 61 64 64 mynick$ ( -- add
5cb0: 72 20 75 20 29 0a 20 20 20 20 5c 47 20 67 65 74 r u ). \G get
5cc0: 20 6d 79 20 6e 69 63 6b 20 77 69 74 68 20 73 69 my nick with si
5cd0: 67 6e 61 74 75 72 65 0a 20 20 20 20 6d 79 6e 69 gnature. myni
5ce0: 63 6b 2d 6b 65 79 20 2e 6b 65 79 6e 69 63 6b 24 ck-key .keynick$
5cf0: 20 3b 0a 3a 20 6d 79 70 6b 32 6e 69 63 6b 24 20 ;.: mypk2nick$
5d00: 28 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 64 72 20 ( o:key -- addr
5d10: 75 20 29 0a 20 20 20 20 5c 47 20 67 65 74 20 6d u ). \G get m
5d20: 79 20 6e 69 63 6b 20 77 69 74 68 20 73 69 67 6e y nick with sign
5d30: 61 74 75 72 65 0a 20 20 20 20 6d 79 6e 69 63 6b ature. mynick
5d40: 2d 6b 65 79 20 2e 6b 65 79 70 6b 32 6e 69 63 6b -key .keypk2nick
5d50: 24 20 3b 0a 3a 20 6b 65 79 2d 73 69 67 6e 20 28 $ ;.: key-sign (
5d60: 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b 65 79 20 o:key -- o:key
5d70: 29 0a 20 20 20 20 5b 27 5d 20 70 61 63 6b 2d 63 ). ['] pack-c
5d80: 6f 72 65 20 67 65 6e 2d 63 6d 64 24 0a 20 20 20 ore gen-cmd$.
5d90: 20 5b 3a 20 74 79 70 65 20 6b 65 2d 70 6b 20 24 [: type ke-pk $
5da0: 40 20 74 79 70 65 20 3b 5d 20 24 74 6d 70 0a 20 @ type ;] $tmp.
5db0: 20 20 20 6e 6f 77 3e 6e 65 76 65 72 20 63 3a 30 now>never c:0
5dc0: 6b 65 79 20 63 3a 68 61 73 68 20 5b 27 5d 20 2e key c:hash ['] .
5dd0: 73 69 67 20 24 74 6d 70 20 6b 65 2d 73 65 6c 66 sig $tmp ke-self
5de0: 73 69 67 20 24 21 20 3b 0a 0a 56 61 72 69 61 62 sig $! ;..Variab
5df0: 6c 65 20 63 70 2d 74 6d 70 0a 0a 3a 20 73 61 76 le cp-tmp..: sav
5e00: 65 2d 70 75 62 6b 65 79 73 20 28 20 2d 2d 20 29 e-pubkeys ( -- )
5e10: 0a 20 20 20 20 6b 65 79 2d 70 66 64 20 3f 64 75 . key-pfd ?du
5e20: 70 2d 49 46 20 20 63 6c 6f 73 65 2d 66 69 6c 65 p-IF close-file
5e30: 20 74 68 72 6f 77 20 20 54 48 45 4e 0a 20 20 20 throw THEN.
5e40: 20 22 70 75 62 6b 65 79 73 2e 6b 32 6f 22 20 2e "pubkeys.k2o" .
5e50: 6b 65 79 73 2f 20 5b 3a 20 74 6f 20 6b 65 79 2d keys/ [: to key-
5e60: 70 66 64 0a 20 20 20 20 20 20 6b 65 79 23 20 5b pfd. key# [
5e70: 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 20 : cell+ $@ drop
5e80: 63 65 6c 6c 2b 20 3e 6f 0a 09 6b 65 2d 73 6b 20 cell+ >o..ke-sk
5e90: 73 65 63 40 20 64 30 3d 20 49 46 20 20 70 61 63 sec@ d0= IF pac
5ea0: 6b 2d 70 75 62 6b 65 79 0a 09 20 20 20 20 66 6c k-pubkey.. fl
5eb0: 75 73 68 28 20 2e 22 20 73 61 76 69 6e 67 20 22 ush( ." saving "
5ec0: 20 2e 6e 69 63 6b 20 66 6f 72 74 68 3a 63 72 20 .nick forth:cr
5ed0: 29 0a 09 20 20 20 20 6b 65 79 2d 63 72 79 70 74 ).. key-crypt
5ee0: 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 40 20 6b ke-offset 64@ k
5ef0: 65 79 3e 70 66 69 6c 65 40 70 6f 73 0a 09 54 48 ey>pfile@pos..TH
5f00: 45 4e 20 6f 3e 20 3b 5d 20 23 6d 61 70 0a 20 20 EN o> ;] #map.
5f10: 20 20 30 20 74 6f 20 6b 65 79 2d 70 66 64 20 3b 0 to key-pfd ;
5f20: 5d 20 73 61 76 65 2d 66 69 6c 65 20 20 3f 6b 65 ] save-file ?ke
5f30: 79 2d 70 66 64 20 64 72 6f 70 20 3b 0a 0a 3a 20 y-pfd drop ;..:
5f40: 73 61 76 65 2d 73 65 63 6b 65 79 73 20 28 20 2d save-seckeys ( -
5f50: 2d 20 29 0a 20 20 20 20 6b 65 79 2d 73 66 64 20 - ). key-sfd
5f60: 3f 64 75 70 2d 49 46 20 20 63 6c 6f 73 65 2d 66 ?dup-IF close-f
5f70: 69 6c 65 20 74 68 72 6f 77 20 20 54 48 45 4e 0a ile throw THEN.
5f80: 20 20 20 20 22 73 65 63 6b 65 79 73 2e 6b 32 6f "seckeys.k2o
5f90: 22 20 2e 6b 65 79 73 2f 20 5b 3a 20 74 6f 20 6b " .keys/ [: to k
5fa0: 65 79 2d 73 66 64 0a 20 20 20 20 20 20 6b 65 79 ey-sfd. key
5fb0: 23 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 # [: cell+ $@ dr
5fc0: 6f 70 20 63 65 6c 6c 2b 20 3e 6f 0a 09 6b 65 2d op cell+ >o..ke-
5fd0: 73 6b 20 73 65 63 40 20 64 30 3c 3e 20 49 46 20 sk sec@ d0<> IF
5fe0: 20 70 61 63 6b 2d 73 65 63 6b 65 79 0a 09 20 20 pack-seckey..
5ff0: 20 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76 65 config:pw-leve
6000: 6c 23 20 40 20 3e 72 20 20 6b 65 2d 70 77 6c 65 l# @ >r ke-pwle
6010: 76 65 6c 20 40 20 63 6f 6e 66 69 67 3a 70 77 2d vel @ config:pw-
6020: 6c 65 76 65 6c 23 20 21 0a 09 20 20 20 20 6b 65 level# !.. ke
6030: 79 2d 63 72 79 70 74 20 6b 65 2d 6f 66 66 73 65 y-crypt ke-offse
6040: 74 20 36 34 40 20 6b 65 79 3e 73 66 69 6c 65 40 t 64@ key>sfile@
6050: 70 6f 73 0a 09 20 20 20 20 72 3e 20 63 6f 6e 66 pos.. r> conf
6060: 69 67 3a 70 77 2d 6c 65 76 65 6c 23 20 21 0a 09 ig:pw-level# !..
6070: 54 48 45 4e 20 6f 3e 20 3b 5d 20 23 6d 61 70 0a THEN o> ;] #map.
6080: 20 20 20 20 30 20 74 6f 20 6b 65 79 2d 73 66 64 0 to key-sfd
6090: 20 3b 5d 20 73 61 76 65 2d 66 69 6c 65 20 20 3f ;] save-file ?
60a0: 6b 65 79 2d 73 66 64 20 64 72 6f 70 20 3b 0a 0a key-sfd drop ;..
60b0: 3a 20 73 61 76 65 2d 6b 65 79 73 20 28 20 2d 2d : save-keys ( --
60c0: 20 29 20 20 3f 2e 6e 65 74 32 6f 2f 6b 65 79 73 ) ?.net2o/keys
60d0: 0a 20 20 20 20 73 61 76 65 2d 70 75 62 6b 65 79 . save-pubkey
60e0: 73 20 73 61 76 65 2d 73 65 63 6b 65 79 73 20 3b s save-seckeys ;
60f0: 0a 0a 3a 20 2b 67 65 6e 2d 6b 65 79 73 20 28 20 ..: +gen-keys (
6100: 6e 69 63 6b 20 75 20 74 79 70 65 20 2d 2d 20 29 nick u type -- )
6110: 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 20 20 36 . gen-keys 6
6120: 34 23 2d 31 20 6b 65 79 2d 72 65 61 64 2d 6f 66 4#-1 key-read-of
6130: 66 73 65 74 20 36 34 21 20 20 70 6b 63 20 6b 65 fset 64! pkc ke
6140: 79 73 69 7a 65 32 20 6b 65 79 3a 6e 65 77 20 3e ysize2 key:new >
6150: 6f 0a 20 20 20 20 5b 20 31 20 69 6d 70 6f 72 74 o. [ 1 import
6160: 23 73 65 6c 66 20 6c 73 68 69 66 74 20 31 20 69 #self lshift 1 i
6170: 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 74 mport#new lshift
6180: 20 6f 72 20 5d 4c 20 6b 65 2d 69 6d 70 6f 72 74 or ]L ke-import
6190: 73 20 21 0a 20 20 20 20 6b 65 2d 74 79 70 65 20 s !. ke-type
61a0: 21 20 20 6b 65 2d 6e 69 63 6b 20 24 21 20 20 6e ! ke-nick $! n
61b0: 69 63 6b 21 0a 20 20 20 20 63 6f 6e 66 69 67 3a ick!. config:
61c0: 70 77 2d 6c 65 76 65 6c 23 20 40 20 6b 65 2d 70 pw-level# @ ke-p
61d0: 77 6c 65 76 65 6c 20 21 20 20 70 65 72 6d 25 6d wlevel ! perm%m
61e0: 79 73 65 6c 66 20 6b 65 2d 6d 61 73 6b 20 21 0a yself ke-mask !.
61f0: 20 20 20 20 73 6b 63 20 6b 65 79 73 69 7a 65 20 skc keysize
6200: 6b 65 2d 73 6b 20 73 65 63 21 20 20 2b 73 65 63 ke-sk sec! +sec
6210: 6b 65 79 0a 20 20 20 20 73 6b 72 65 76 20 6b 65 key. skrev ke
6220: 79 73 69 7a 65 20 6b 65 2d 72 73 6b 20 73 65 63 ysize ke-rsk sec
6230: 21 0a 20 20 20 20 6b 65 79 2d 73 69 67 6e 20 6f !. key-sign o
6240: 3e 20 3b 0a 0a 24 34 30 20 62 75 66 66 65 72 3a > ;..$40 buffer:
6250: 20 6e 69 63 6b 2d 62 75 66 0a 0a 3a 20 67 65 74 nick-buf..: get
6260: 2d 6e 69 63 6b 20 28 20 2d 2d 20 61 64 64 72 20 -nick ( -- addr
6270: 75 20 29 0a 20 20 20 20 2e 22 20 6e 69 63 6b 3a u ). ." nick:
6280: 20 22 20 6e 69 63 6b 2d 62 75 66 20 24 34 30 20 " nick-buf $40
6290: 61 63 63 65 70 74 20 6e 69 63 6b 2d 62 75 66 20 accept nick-buf
62a0: 73 77 61 70 20 2d 74 72 61 69 6c 69 6e 67 20 63 swap -trailing c
62b0: 72 20 3b 0a 0a 66 61 6c 73 65 20 76 61 6c 75 65 r ;..false value
62c0: 20 3f 79 65 73 0a 3a 20 79 65 73 3f 20 28 20 61 ?yes.: yes? ( a
62d0: 64 64 72 20 75 20 2d 2d 20 66 6c 61 67 20 29 0a ddr u -- flag ).
62e0: 20 20 20 20 3f 79 65 73 20 49 46 20 20 32 64 72 ?yes IF 2dr
62f0: 6f 70 20 74 72 75 65 20 20 45 4c 53 45 20 20 74 op true ELSE t
6300: 79 70 65 20 2e 22 20 20 28 79 2f 4e 29 22 20 6b ype ." (y/N)" k
6310: 65 79 20 63 72 20 27 79 27 20 3d 20 20 54 48 45 ey cr 'y' = THE
6320: 4e 20 3b 0a 0a 3a 20 3f 72 73 6b 20 28 20 2d 2d N ;..: ?rsk ( --
6330: 20 29 0a 20 20 20 20 70 6b 63 20 6b 65 79 73 69 ). pkc keysi
6340: 7a 65 20 6b 65 79 2d 65 78 69 73 74 3f 20 64 75 ze key-exist? du
6350: 70 20 30 3d 20 49 46 20 20 64 72 6f 70 20 20 45 p 0= IF drop E
6360: 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 3e 6f XIT THEN. >o
6370: 20 6b 65 2d 72 73 6b 20 73 65 63 40 20 64 75 70 ke-rsk sec@ dup
6380: 20 30 3d 20 49 46 20 20 32 64 72 6f 70 20 6f 3e 0= IF 2drop o>
6390: 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 EXIT THEN.
63a0: 20 2e 22 20 59 6f 75 20 73 74 69 6c 6c 20 68 61 ." You still ha
63b0: 76 65 6e 27 74 20 73 74 6f 72 65 64 20 79 6f 75 ven't stored you
63c0: 72 20 72 65 76 6f 6b 65 20 6b 65 79 20 73 65 63 r revoke key sec
63d0: 75 72 65 6c 79 20 6f 66 66 2d 6c 69 6e 65 2e 22 urely off-line."
63e0: 20 63 72 0a 20 20 20 20 73 22 20 50 61 70 65 72 cr. s" Paper
63f0: 20 61 6e 64 20 70 65 6e 63 69 6c 20 72 65 61 64 and pencil read
6400: 79 3f 22 20 79 65 73 3f 20 49 46 0a 09 2e 73 74 y?" yes? IF...st
6410: 72 69 70 65 38 35 0a 09 73 22 20 57 72 69 74 74 ripe85..s" Writt
6420: 65 6e 20 64 6f 77 6e 3f 22 20 79 65 73 3f 20 49 en down?" yes? I
6430: 46 0a 09 20 20 20 20 73 22 20 59 6f 75 20 77 6f F.. s" You wo
6440: 6e 27 74 20 73 65 65 20 74 68 69 73 20 61 67 61 n't see this aga
6450: 69 6e 21 20 44 65 6c 65 74 65 3f 22 20 79 65 73 in! Delete?" yes
6460: 3f 0a 09 20 20 20 20 49 46 20 6b 65 2d 72 73 6b ?.. IF ke-rsk
6470: 20 73 65 63 2d 6f 66 66 20 20 73 61 76 65 2d 6b sec-off save-k
6480: 65 79 73 0a 09 09 2e 22 20 72 65 76 6f 6b 65 20 eys...." revoke
6490: 6b 65 79 20 64 65 6c 65 74 65 64 2e 22 20 63 72 key deleted." cr
64a0: 20 6f 3e 20 20 45 58 49 54 20 20 54 48 45 4e 20 o> EXIT THEN
64b0: 20 54 48 45 4e 0a 20 20 20 20 45 4c 53 45 20 20 THEN. ELSE
64c0: 32 64 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 2drop THEN.
64d0: 2e 22 20 49 27 6d 20 6b 65 65 70 69 6e 67 20 79 ." I'm keeping y
64e0: 6f 75 72 20 72 65 76 6f 6b 65 20 6b 65 79 2e 20 our revoke key.
64f0: 20 54 68 69 73 20 77 69 6c 6c 20 73 68 6f 77 20 This will show
6500: 75 70 20 61 67 61 69 6e 2e 22 20 63 72 20 6f 3e up again." cr o>
6510: 20 3b 0a 0a 5c 20 72 65 61 64 20 6b 65 79 20 66 ;..\ read key f
6520: 69 6c 65 0a 0a 3a 20 74 72 79 2d 64 65 63 72 79 ile..: try-decry
6530: 70 74 2d 6b 65 79 20 28 20 6b 65 79 20 75 31 20 pt-key ( key u1
6540: 2d 2d 20 61 64 64 72 20 75 32 20 66 6c 61 67 20 -- addr u2 flag
6550: 29 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 6b 65 ). keypack ke
6560: 79 70 61 63 6b 2d 64 20 6b 65 79 70 61 63 6b 2d ypack-d keypack-
6570: 61 6c 6c 23 20 6d 6f 76 65 0a 20 20 20 20 6b 65 all# move. ke
6580: 79 70 61 63 6b 2d 64 20 6b 65 79 70 61 63 6b 2d ypack-d keypack-
6590: 61 6c 6c 23 20 32 73 77 61 70 0a 20 20 20 20 64 all# 2swap. d
65a0: 75 70 20 24 32 30 20 3d 20 49 46 20 20 64 65 63 up $20 = IF dec
65b0: 72 79 70 74 24 20 20 45 4c 53 45 0a 09 6b 65 79 rypt$ ELSE..key
65c0: 70 61 63 6b 20 63 40 20 24 46 20 61 6e 64 20 63 pack c@ $F and c
65d0: 6f 6e 66 69 67 3a 70 77 2d 6d 61 78 6c 65 76 65 onfig:pw-maxleve
65e0: 6c 23 20 40 20 3c 3d 0a 09 49 46 20 20 64 65 63 l# @ <=..IF dec
65f0: 72 79 70 74 2d 70 77 24 20 20 45 4c 53 45 20 20 rypt-pw$ ELSE
6600: 32 64 72 6f 70 20 66 61 6c 73 65 20 20 54 48 45 2drop false THE
6610: 4e 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 N. THEN ;..:
6620: 74 72 79 2d 64 65 63 72 79 70 74 20 28 20 66 6c try-decrypt ( fl
6630: 61 67 20 2d 2d 20 61 64 64 72 20 75 20 2f 20 30 ag -- addr u / 0
6640: 20 30 20 29 20 7b 20 66 6c 61 67 20 7d 0a 20 20 0 ) { flag }.
6650: 20 20 6b 65 79 73 20 24 5b 5d 23 20 30 20 3f 44 keys $[]# 0 ?D
6660: 4f 0a 09 49 20 6b 65 79 73 20 73 65 63 5b 5d 40 O..I keys sec[]@
6670: 20 64 75 70 20 6b 65 79 73 69 7a 65 20 3d 20 66 dup keysize = f
6680: 6c 61 67 20 78 6f 72 20 49 46 0a 09 20 20 20 20 lag xor IF..
6690: 74 72 79 2d 64 65 63 72 79 70 74 2d 6b 65 79 20 try-decrypt-key
66a0: 49 46 0a 09 09 49 20 6b 65 79 73 20 24 5b 5d 20 IF...I keys $[]
66b0: 40 20 64 75 70 20 3e 73 74 6f 72 65 6b 65 79 20 @ dup >storekey
66c0: 21 20 64 65 66 61 75 6c 74 6b 65 79 20 21 0a 09 ! defaultkey !..
66d0: 09 75 6e 6c 6f 6f 70 20 20 45 58 49 54 20 20 54 .unloop EXIT T
66e0: 48 45 4e 20 20 54 48 45 4e 0a 09 32 64 72 6f 70 HEN THEN..2drop
66f0: 0a 20 20 20 20 4c 4f 4f 50 20 20 30 20 30 20 3b . LOOP 0 0 ;
6700: 0a 0a 3a 20 3f 70 65 72 6d 20 28 20 6f 3a 6b 65 ..: ?perm ( o:ke
6710: 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 73 6b y -- ). ke-sk
6720: 20 73 65 63 40 20 6e 69 70 20 49 46 20 20 70 65 sec@ nip IF pe
6730: 72 6d 25 6d 79 73 65 6c 66 20 20 45 4c 53 45 20 rm%myself ELSE
6740: 20 70 65 72 6d 25 64 65 66 61 75 6c 74 20 20 54 perm%default T
6750: 48 45 4e 20 20 6b 65 2d 6d 61 73 6b 20 21 20 3b HEN ke-mask ! ;
6760: 0a 0a 3a 20 64 6f 2d 6b 65 79 20 28 20 61 64 64 ..: do-key ( add
6770: 72 20 75 20 2f 20 30 20 30 20 20 2d 2d 20 29 0a r u / 0 0 -- ).
6780: 20 20 20 20 64 75 70 20 30 3d 20 49 46 20 20 32 dup 0= IF 2
6790: 64 72 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e drop EXIT THEN
67a0: 0a 20 20 20 20 73 61 6d 70 6c 65 2d 6b 65 79 20 . sample-key
67b0: 3e 6f 20 6b 65 2d 73 6b 20 6b 65 2d 65 6e 64 20 >o ke-sk ke-end
67c0: 6f 76 65 72 20 2d 20 65 72 61 73 65 20 20 64 6f over - erase do
67d0: 2d 63 6d 64 2d 6c 6f 6f 70 20 6f 3e 20 3b 0a 0a -cmd-loop o> ;..
67e0: 3a 20 2e 6b 65 79 24 20 28 20 61 64 64 72 20 75 : .key$ ( addr u
67f0: 20 2d 2d 20 29 0a 20 20 20 20 73 61 6d 70 6c 65 -- ). sample
6800: 2d 6b 65 79 20 3e 6f 20 20 6b 65 2d 73 6b 20 6b -key >o ke-sk k
6810: 65 2d 65 6e 64 20 6f 76 65 72 20 2d 20 65 72 61 e-end over - era
6820: 73 65 0a 20 20 20 20 73 69 67 6e 65 64 2d 76 61 se. signed-va
6830: 6c 20 76 61 6c 69 64 61 74 65 64 20 6f 72 21 20 l validated or!
6840: 20 63 2d 73 74 61 74 65 20 6f 66 66 20 20 6e 65 c-state off ne
6850: 73 74 2d 63 6d 64 2d 6c 6f 6f 70 0a 20 20 20 20 st-cmd-loop.
6860: 73 69 67 6e 65 64 2d 76 61 6c 20 69 6e 76 65 72 signed-val inver
6870: 74 20 76 61 6c 69 64 61 74 65 64 20 61 6e 64 21 t validated and!
6880: 0a 20 20 20 20 2e 6b 65 79 2d 73 68 6f 72 74 20 . .key-short
6890: 66 72 65 65 2d 6b 65 79 20 6f 3e 20 3b 0a 0a 3a free-key o> ;..:
68a0: 20 72 65 61 64 2d 6b 65 79 73 2d 6c 6f 6f 70 20 read-keys-loop
68b0: 28 20 66 64 20 2d 2d 20 29 20 20 63 6f 64 65 2d ( fd -- ) code-
68c0: 6b 65 79 0a 20 20 20 20 3e 72 20 23 30 2e 20 72 key. >r #0. r
68d0: 40 20 72 65 70 6f 73 69 74 69 6f 6e 2d 66 69 6c @ reposition-fil
68e0: 65 20 74 68 72 6f 77 0a 20 20 20 20 42 45 47 49 e throw. BEGI
68f0: 4e 0a 09 72 40 20 66 69 6c 65 2d 70 6f 73 69 74 N..r@ file-posit
6900: 69 6f 6e 20 74 68 72 6f 77 20 64 3e 36 34 20 6b ion throw d>64 k
6910: 65 79 2d 72 65 61 64 2d 6f 66 66 73 65 74 20 36 ey-read-offset 6
6920: 34 21 0a 09 6b 65 79 70 61 63 6b 20 6b 65 79 70 4!..keypack keyp
6930: 61 63 6b 2d 61 6c 6c 23 20 72 40 20 72 65 61 64 ack-all# r@ read
6940: 2d 66 69 6c 65 20 74 68 72 6f 77 0a 09 6b 65 79 -file throw..key
6950: 70 61 63 6b 2d 61 6c 6c 23 20 3d 20 57 48 49 4c pack-all# = WHIL
6960: 45 0a 09 20 20 20 20 69 6d 70 6f 72 74 2d 74 79 E.. import-ty
6970: 70 65 20 40 20 69 6d 70 6f 72 74 23 73 65 6c 66 pe @ import#self
6980: 20 3d 20 74 72 79 2d 64 65 63 72 79 70 74 20 64 = try-decrypt d
6990: 6f 2d 6b 65 79 0a 20 20 20 20 52 45 50 45 41 54 o-key. REPEAT
69a0: 20 20 72 64 72 6f 70 20 20 63 6f 64 65 30 2d 62 rdrop code0-b
69b0: 75 66 20 3b 0a 3a 20 72 65 61 64 2d 6b 65 79 2d uf ;.: read-key-
69c0: 6c 6f 6f 70 20 28 20 2d 2d 20 29 0a 20 20 20 20 loop ( -- ).
69d0: 69 6d 70 6f 72 74 23 73 65 6c 66 20 69 6d 70 6f import#self impo
69e0: 72 74 2d 74 79 70 65 20 21 0a 20 20 20 20 3f 6b rt-type !. ?k
69f0: 65 79 2d 73 66 64 20 72 65 61 64 2d 6b 65 79 73 ey-sfd read-keys
6a00: 2d 6c 6f 6f 70 20 3b 0a 3a 20 72 65 61 64 2d 70 -loop ;.: read-p
6a10: 6b 65 79 2d 6c 6f 6f 70 20 28 20 2d 2d 20 29 0a key-loop ( -- ).
6a20: 20 20 20 20 6c 61 73 74 6b 65 79 40 20 64 72 6f lastkey@ dro
6a30: 70 20 64 65 66 61 75 6c 74 6b 65 79 20 21 20 5c p defaultkey ! \
6a40: 20 61 74 20 6c 65 61 73 74 20 6f 6e 65 20 64 65 at least one de
6a50: 66 61 75 6c 74 20 6b 65 79 20 61 76 61 69 6c 61 fault key availa
6a60: 62 6c 65 0a 20 20 20 20 2d 31 20 63 6f 6e 66 69 ble. -1 confi
6a70: 67 3a 70 77 2d 6c 65 76 65 6c 23 0a 20 20 20 20 g:pw-level#.
6a80: 5b 3a 20 69 6d 70 6f 72 74 23 6e 65 77 20 69 6d [: import#new im
6a90: 70 6f 72 74 2d 74 79 70 65 20 21 20 3f 6b 65 79 port-type ! ?key
6aa0: 2d 70 66 64 20 72 65 61 64 2d 6b 65 79 73 2d 6c -pfd read-keys-l
6ab0: 6f 6f 70 20 3b 5d 20 21 77 72 61 70 70 65 72 20 oop ;] !wrapper
6ac0: 3b 0a 0a 3a 20 72 65 61 64 2d 6b 65 79 73 20 28 ;..: read-keys (
6ad0: 20 2d 2d 20 29 0a 20 20 20 20 72 65 61 64 2d 6b -- ). read-k
6ae0: 65 79 2d 6c 6f 6f 70 20 72 65 61 64 2d 70 6b 65 ey-loop read-pke
6af0: 79 2d 6c 6f 6f 70 20 69 6d 70 6f 72 74 23 6e 65 y-loop import#ne
6b00: 77 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 w import-type !
6b10: 3b 0a 0a 3a 20 72 65 61 64 2d 70 6b 32 6b 65 79 ;..: read-pk2key
6b20: 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a $ ( addr u -- ).
6b30: 20 20 20 20 5c 67 20 72 65 61 64 20 61 20 6e 65 \g read a ne
6b40: 73 74 65 64 20 6b 65 79 20 69 6e 74 6f 20 73 61 sted key into sa
6b50: 6d 70 6c 65 2d 6b 65 79 0a 20 20 20 20 73 61 6d mple-key. sam
6b60: 70 6c 65 2d 6b 65 79 20 3e 6f 20 63 2d 73 74 61 ple-key >o c-sta
6b70: 74 65 20 6f 66 66 20 20 73 69 6d 2d 6e 69 63 6b te off sim-nick
6b80: 21 20 6f 6e 0a 20 20 20 20 70 6b 32 2d 73 69 67 ! on. pk2-sig
6b90: 3f 20 21 21 73 69 67 21 21 20 73 69 67 70 6b 32 ? !!sig!! sigpk2
6ba0: 73 69 7a 65 23 20 2d 20 32 64 75 70 20 2b 20 3e size# - 2dup + >
6bb0: 72 20 64 6f 2d 6e 65 73 74 73 69 67 0a 20 20 20 r do-nestsig.
6bc0: 20 72 40 20 6b 65 79 73 69 7a 65 32 20 6b 65 2d r@ keysize2 ke-
6bd0: 70 6b 20 24 21 0a 20 20 20 20 72 3e 20 6b 65 79 pk $!. r> key
6be0: 73 69 7a 65 32 20 2b 20 73 69 67 73 69 7a 65 23 size2 + sigsize#
6bf0: 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 21 0a 20 ke-selfsig $!.
6c00: 20 20 20 6f 3e 20 20 73 69 6d 2d 6e 69 63 6b 21 o> sim-nick!
6c10: 20 6f 66 66 20 3b 0a 0a 3a 20 2e 70 6b 32 6b 65 off ;..: .pk2ke
6c20: 79 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 y$ ( addr u -- )
6c30: 0a 20 20 20 20 72 65 61 64 2d 70 6b 32 6b 65 79 . read-pk2key
6c40: 24 20 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 0a $ sample-key >o.
6c50: 20 20 20 20 5b 20 31 20 69 6d 70 6f 72 74 23 69 [ 1 import#i
6c60: 6e 76 69 74 65 64 20 6c 73 68 69 66 74 20 31 20 nvited lshift 1
6c70: 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 import#new lshif
6c80: 74 20 6f 72 20 5d 4c 20 6b 65 2d 69 6d 70 6f 72 t or ]L ke-impor
6c90: 74 73 20 21 0a 20 20 20 20 2e 6b 65 79 2d 69 6e ts !. .key-in
6ca0: 76 69 74 65 20 66 72 65 65 2d 6b 65 79 20 6f 3e vite free-key o>
6cb0: 20 3b 0a 0a 5c 20 73 65 6c 65 63 74 20 6b 65 79 ;..\ select key
6cc0: 20 62 79 20 6e 69 63 6b 0a 0a 3a 20 3e 72 61 77 by nick..: >raw
6cd0: 2d 6b 65 79 20 28 20 6f 20 2d 2d 20 29 0a 20 20 -key ( o -- ).
6ce0: 20 20 64 75 70 20 30 3d 20 21 21 6e 6f 2d 6e 69 dup 0= !!no-ni
6cf0: 63 6b 21 21 20 3e 6f 0a 20 20 20 20 6b 65 2d 70 ck!! >o. ke-p
6d00: 6b 20 24 40 20 70 6b 63 20 70 6b 72 6b 23 20 73 k $@ pkc pkrk# s
6d10: 6d 6f 76 65 0a 20 20 20 20 6b 65 2d 73 6b 20 73 move. ke-sk s
6d20: 65 63 40 20 73 6b 63 20 73 77 61 70 20 6b 65 79 ec@ skc swap key
6d30: 7c 20 6d 6f 76 65 0a 20 20 20 20 3e 73 6b 73 69 | move. >sksi
6d40: 67 20 6f 3e 20 3b 0a 0a 3a 20 3e 6b 65 79 20 28 g o> ;..: >key (
6d50: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 addr u -- ).
6d60: 20 6b 65 79 23 20 40 20 30 3d 20 49 46 20 20 72 key# @ 0= IF r
6d70: 65 61 64 2d 6b 65 79 73 20 20 54 48 45 4e 0a 20 ead-keys THEN.
6d80: 20 20 20 6e 69 63 6b 2d 6b 65 79 20 3e 72 61 77 nick-key >raw
6d90: 2d 6b 65 79 20 3b 0a 0a 3a 20 69 27 6d 20 28 20 -key ;..: i'm (
6da0: 22 6e 61 6d 65 22 20 2d 2d 20 29 20 70 61 72 73 "name" -- ) pars
6db0: 65 2d 6e 61 6d 65 20 3e 6b 65 79 20 3b 0a 3a 20 e-name >key ;.:
6dc0: 70 6b 27 20 28 20 22 6e 61 6d 65 22 20 2d 2d 20 pk' ( "name" --
6dd0: 61 64 64 72 20 75 20 29 0a 20 20 20 20 70 61 72 addr u ). par
6de0: 73 65 2d 6e 61 6d 65 20 6e 69 63 6b 3e 70 6b 20 se-name nick>pk
6df0: 3b 0a 0a 3a 20 64 65 73 74 2d 6b 65 79 20 28 20 ;..: dest-key (
6e00: 61 64 64 72 20 75 20 2d 2d 20 29 20 64 75 70 20 addr u -- ) dup
6e10: 30 3d 20 49 46 20 20 32 64 72 6f 70 20 20 45 58 0= IF 2drop EX
6e20: 49 54 20 20 54 48 45 4e 0a 20 20 20 20 6e 69 63 IT THEN. nic
6e30: 6b 2d 6b 65 79 20 3e 6f 20 6f 20 30 3d 20 21 21 k-key >o o 0= !!
6e40: 75 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21 0a 20 20 unknown-key!!.
6e50: 20 20 6b 65 2d 70 6b 20 24 40 20 6f 3e 0a 20 20 ke-pk $@ o>.
6e60: 20 20 70 75 62 6b 65 79 20 24 21 20 3b 0a 0a 3a pubkey $! ;..:
6e70: 20 64 65 73 74 2d 70 6b 20 28 20 61 64 64 72 20 dest-pk ( addr
6e80: 75 20 2d 2d 20 29 20 6b 65 79 32 7c 20 32 64 75 u -- ) key2| 2du
6e90: 70 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 30 p key| key# #@ 0
6ea0: 3d 20 49 46 0a 09 64 72 6f 70 20 70 75 62 6b 65 = IF..drop pubke
6eb0: 79 20 24 21 20 20 70 65 72 6d 25 75 6e 6b 6e 6f y $! perm%unkno
6ec0: 77 6e 20 70 65 72 6d 2d 6d 61 73 6b 20 21 0a 20 wn perm-mask !.
6ed0: 20 20 20 45 4c 53 45 20 20 63 65 6c 6c 2b 20 3e ELSE cell+ >
6ee0: 6f 0a 09 6b 65 2d 6d 61 73 6b 20 40 0a 09 6b 65 o..ke-mask @..ke
6ef0: 2d 70 6b 20 24 40 20 6f 3e 0a 09 70 75 62 6b 65 -pk $@ o>..pubke
6f00: 79 20 24 21 20 20 70 65 72 6d 2d 6d 61 73 6b 20 y $! perm-mask
6f10: 21 20 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b ! 2drop THEN ;
6f20: 0a 0a 3a 20 72 65 70 6c 61 63 65 2d 6b 65 79 20 ..: replace-key
6f30: 31 20 2f 73 74 72 69 6e 67 20 7b 20 72 65 76 2d 1 /string { rev-
6f40: 61 64 64 72 20 75 20 2d 2d 20 6f 20 7d 20 5c 20 addr u -- o } \
6f50: 72 65 76 6f 63 61 74 69 6f 6e 20 74 69 63 6b 65 revocation ticke
6f60: 74 0a 20 20 20 20 6b 65 79 28 20 2e 22 20 52 65 t. key( ." Re
6f70: 70 6c 61 63 65 3a 22 20 63 72 20 6f 20 63 65 6c place:" cr o cel
6f80: 6c 2d 20 30 20 2e 6b 65 79 20 29 0a 20 20 20 20 l- 0 .key ).
6f90: 69 6d 70 6f 72 74 23 73 65 6c 66 20 69 6d 70 6f import#self impo
6fa0: 72 74 2d 74 79 70 65 20 21 0a 20 20 20 20 73 22 rt-type !. s"
6fb0: 20 23 72 65 76 6f 6b 65 64 22 20 64 75 70 20 3e #revoked" dup >
6fc0: 72 20 6b 65 2d 6e 69 63 6b 20 24 2b 21 0a 20 20 r ke-nick $+!.
6fd0: 20 20 6b 65 2d 6e 69 63 6b 20 24 40 20 72 3e 20 ke-nick $@ r>
6fe0: 2d 20 6b 65 2d 70 72 6f 66 20 24 40 20 6b 65 2d - ke-prof $@ ke-
6ff0: 73 69 67 73 20 6b 65 2d 74 79 70 65 20 40 0a 20 sigs ke-type @.
7000: 20 20 20 72 65 76 2d 61 64 64 72 20 70 6b 72 6b rev-addr pkrk
7010: 23 20 6b 65 79 3f 6e 65 77 20 3e 6f 0a 20 20 20 # key?new >o.
7020: 20 6b 65 2d 74 79 70 65 20 21 20 5b 3a 20 6b 65 ke-type ! [: ke
7030: 2d 73 69 67 73 20 24 2b 5b 5d 21 20 3b 5d 20 24 -sigs $+[]! ;] $
7040: 5b 5d 6d 61 70 20 6b 65 2d 70 72 6f 66 20 24 21 []map ke-prof $!
7050: 20 6b 65 2d 6e 69 63 6b 20 24 21 0a 20 20 20 20 ke-nick $!.
7060: 72 65 76 2d 61 64 64 72 20 70 6b 72 6b 23 20 6b rev-addr pkrk# k
7070: 65 2d 70 6b 20 24 21 0a 20 20 20 20 72 65 76 2d e-pk $!. rev-
7080: 61 64 64 72 20 75 20 2b 20 31 2d 20 64 75 70 20 addr u + 1- dup
7090: 63 40 20 32 2a 20 2d 20 24 31 30 20 2d 20 24 31 c@ 2* - $10 - $1
70a0: 30 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 21 0a 0 ke-selfsig $!.
70b0: 20 20 20 20 6b 65 79 28 20 2e 22 20 77 69 74 68 key( ." with
70c0: 3a 22 20 63 72 20 6f 20 63 65 6c 6c 2d 20 30 20 :" cr o cell- 0
70d0: 2e 6b 65 79 20 29 20 6f 20 6f 3e 0a 20 20 20 20 .key ) o o>.
70e0: 69 6d 70 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 import#new impor
70f0: 74 2d 74 79 70 65 20 21 20 3b 0a 0a 3a 20 72 65 t-type ! ;..: re
7100: 6e 65 77 2d 6b 65 79 20 28 20 72 65 76 61 64 64 new-key ( revadd
7110: 72 20 75 31 20 6b 65 79 61 64 64 72 20 75 32 20 r u1 keyaddr u2
7120: 2d 2d 20 6f 20 29 0a 20 20 20 20 63 75 72 72 65 -- o ). curre
7130: 6e 74 2d 6b 65 79 20 3e 6f 20 72 65 70 6c 61 63 nt-key >o replac
7140: 65 2d 6b 65 79 20 6f 3e 0a 20 20 20 20 3e 6f 20 e-key o>. >o
7150: 73 6b 63 20 6b 65 79 73 69 7a 65 20 6b 65 2d 73 skc keysize ke-s
7160: 6b 20 73 65 63 21 20 6f 20 6f 3e 20 3b 0a 0a 5c k sec! o o> ;..\
7170: 20 67 65 6e 65 72 61 74 65 20 6e 65 77 20 6b 65 generate new ke
7180: 79 0a 0a 3a 20 6f 75 74 2d 6b 65 79 20 28 20 6f y..: out-key ( o
7190: 20 2d 2d 20 29 0a 20 20 20 20 3e 6f 20 70 61 63 -- ). >o pac
71a0: 6b 2d 6f 75 74 6b 65 79 20 5b 27 5d 20 2e 6e 69 k-outkey ['] .ni
71b0: 63 6b 2d 62 61 73 65 20 24 74 6d 70 20 66 6e 2d ck-base $tmp fn-
71c0: 73 61 6e 69 74 69 7a 65 20 6f 3e 0a 20 20 20 20 sanitize o>.
71d0: 5b 3a 20 2e 22 20 7e 2f 22 20 74 79 70 65 20 2e [: ." ~/" type .
71e0: 22 20 2e 6e 32 6f 22 20 3b 5d 20 24 74 6d 70 20 " .n2o" ;] $tmp
71f0: 77 2f 6f 20 63 72 65 61 74 65 2d 66 69 6c 65 20 w/o create-file
7200: 74 68 72 6f 77 0a 20 20 20 20 3e 72 20 63 6d 64 throw. >r cmd
7210: 62 75 66 24 20 72 40 20 77 72 69 74 65 2d 66 69 buf$ r@ write-fi
7220: 6c 65 20 74 68 72 6f 77 20 72 3e 20 63 6c 6f 73 le throw r> clos
7230: 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 3b 0a 3a e-file throw ;.:
7240: 20 6f 75 74 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 out-me ( -- ).
7250: 20 20 20 70 6b 63 20 6b 65 79 73 69 7a 65 20 6b pkc keysize k
7260: 65 79 23 20 23 40 20 30 3d 20 21 21 75 6e 6b 6e ey# #@ 0= !!unkn
7270: 6f 77 6e 2d 6b 65 79 21 21 0a 20 20 20 20 63 65 own-key!!. ce
7280: 6c 6c 2b 20 6f 75 74 2d 6b 65 79 20 3b 0a 0a 56 ll+ out-key ;..V
7290: 61 72 69 61 62 6c 65 20 64 68 74 72 6f 6f 74 2e ariable dhtroot.
72a0: 6e 32 6f 0a 0a 3a 20 2b 64 68 74 72 6f 6f 74 20 n2o..: +dhtroot
72b0: 28 20 2d 2d 20 29 0a 20 20 20 20 64 65 66 61 75 ( -- ). defau
72c0: 6c 74 6b 65 79 20 40 20 3e 73 74 6f 72 65 6b 65 ltkey @ >storeke
72d0: 79 20 21 0a 20 20 20 20 69 6d 70 6f 72 74 23 6d y !. import#m
72e0: 61 6e 75 61 6c 20 69 6d 70 6f 72 74 2d 74 79 70 anual import-typ
72f0: 65 20 21 20 20 36 34 23 2d 31 20 6b 65 79 2d 72 e ! 64#-1 key-r
7300: 65 61 64 2d 6f 66 66 73 65 74 20 36 34 21 0a 20 ead-offset 64!.
7310: 20 20 20 64 68 74 72 6f 6f 74 2e 6e 32 6f 20 24 dhtroot.n2o $
7320: 40 20 64 6f 2d 6b 65 79 20 20 69 6d 70 6f 72 74 @ do-key import
7330: 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 79 70 65 #new import-type
7340: 20 21 20 3b 0a 0a 3a 20 6e 65 77 2d 6b 65 79 20 ! ;..: new-key
7350: 28 20 6e 69 63 6b 61 64 64 72 20 75 20 2d 2d 20 ( nickaddr u --
7360: 29 0a 20 20 20 20 3f 63 68 65 63 6b 2d 72 6e 67 ). ?check-rng
7370: 20 5c 20 62 65 66 6f 72 65 20 67 65 6e 65 72 61 \ before genera
7380: 74 69 6e 67 20 61 20 6b 65 79 2c 20 63 68 65 63 ting a key, chec
7390: 6b 20 74 68 65 20 72 6e 67 20 66 6f 72 20 68 65 k the rng for he
73a0: 61 6c 74 68 0a 20 20 20 20 2b 6e 65 77 70 68 72 alth. +newphr
73b0: 61 73 65 20 6b 65 79 3e 64 65 66 61 75 6c 74 0a ase key>default.
73c0: 20 20 20 20 6b 65 79 23 75 73 65 72 20 2b 67 65 key#user +ge
73d0: 6e 2d 6b 65 79 73 0a 20 20 20 20 73 65 63 72 65 n-keys. secre
73e0: 74 2d 6b 65 79 73 23 20 31 2d 20 73 65 63 72 65 t-keys# 1- secre
73f0: 74 2d 6b 65 79 20 3e 72 61 77 2d 6b 65 79 20 20 t-key >raw-key
7400: 6c 61 73 74 6b 65 79 40 20 64 72 6f 70 20 64 65 lastkey@ drop de
7410: 66 61 75 6c 74 6b 65 79 20 21 0a 20 20 20 20 6f faultkey !. o
7420: 75 74 2d 6d 65 20 2b 64 68 74 72 6f 6f 74 20 73 ut-me +dhtroot s
7430: 61 76 65 2d 6b 65 79 73 20 3b 0a 0a 5c 20 72 65 ave-keys ;..\ re
7440: 76 6f 6b 61 74 69 6f 6e 0a 0a 34 20 64 61 74 65 vokation..4 date
7450: 73 69 7a 65 23 20 2b 20 6b 65 79 73 69 7a 65 20 size# + keysize
7460: 39 20 2a 20 2b 20 43 6f 6e 73 74 61 6e 74 20 72 9 * + Constant r
7470: 65 76 73 69 7a 65 23 0a 0a 56 61 72 69 61 62 6c evsize#..Variabl
7480: 65 20 72 65 76 74 6f 6b 65 6e 0a 0a 3a 20 30 6f e revtoken..: 0o
7490: 6c 64 6b 65 79 20 28 20 2d 2d 20 29 20 5c 20 70 ldkey ( -- ) \ p
74a0: 75 62 6b 65 79 73 20 63 61 6e 20 73 74 61 79 0a ubkeys can stay.
74b0: 20 20 20 20 6f 6c 64 73 6b 63 20 6b 65 79 73 69 oldskc keysi
74c0: 7a 65 20 65 72 61 73 65 20 20 6f 6c 64 73 6b 72 ze erase oldskr
74d0: 65 76 20 6b 65 79 73 69 7a 65 20 65 72 61 73 65 ev keysize erase
74e0: 20 3b 0a 0a 3a 20 6b 65 79 6d 6f 76 65 20 28 20 ;..: keymove (
74f0: 61 64 64 72 31 20 61 64 64 72 32 20 2d 2d 20 29 addr1 addr2 -- )
7500: 20 20 6b 65 79 73 69 7a 65 20 6d 6f 76 65 20 3b keysize move ;
7510: 0a 0a 3a 20 72 65 76 6f 6b 65 2d 76 65 72 69 66 ..: revoke-verif
7520: 79 20 28 20 61 64 64 72 20 75 31 20 70 6b 20 73 y ( addr u1 pk s
7530: 74 72 69 6e 67 20 75 32 20 2d 2d 20 61 64 64 72 tring u2 -- addr
7540: 20 75 20 66 6c 61 67 20 29 20 72 6f 74 20 3e 72 u flag ) rot >r
7550: 20 32 3e 72 20 63 3a 30 6b 65 79 0a 20 20 20 20 2>r c:0key.
7560: 73 69 67 6f 6e 6c 79 73 69 7a 65 23 20 2d 20 32 sigonlysize# - 2
7570: 64 75 70 20 32 72 3e 20 3e 6b 65 79 65 64 2d 68 dup 2r> >keyed-h
7580: 61 73 68 0a 20 20 20 20 73 69 67 64 61 74 65 20 ash. sigdate
7590: 2b 64 61 74 65 0a 20 20 20 20 32 64 75 70 20 2b +date. 2dup +
75a0: 20 72 3e 20 65 64 2d 76 65 72 69 66 79 20 3b 0a r> ed-verify ;.
75b0: 0a 3a 20 3e 72 65 76 6f 6b 65 20 28 20 73 6b 72 .: >revoke ( skr
75c0: 65 76 20 2d 2d 20 29 20 20 73 6b 72 65 76 20 6b ev -- ) skrev k
75d0: 65 79 6d 6f 76 65 20 20 70 6b 63 20 63 68 65 63 eymove pkc chec
75e0: 6b 2d 72 65 76 3f 20 30 3d 20 21 21 6e 6f 74 2d k-rev? 0= !!not-
75f0: 6d 79 2d 72 65 76 73 6b 21 21 20 3b 0a 0a 3a 20 my-revsk!! ;..:
7600: 2b 72 65 76 73 69 67 6e 20 28 20 73 6b 20 70 6b +revsign ( sk pk
7610: 20 2d 2d 20 29 20 20 73 6b 73 69 67 20 2d 72 6f -- ) sksig -ro
7620: 74 20 65 64 2d 73 69 67 6e 20 72 65 76 74 6f 6b t ed-sign revtok
7630: 65 6e 20 24 2b 21 20 62 6c 20 72 65 76 74 6f 6b en $+! bl revtok
7640: 65 6e 20 63 24 2b 21 20 3b 0a 0a 3a 20 73 69 67 en c$+! ;..: sig
7650: 6e 2d 74 6f 6b 65 6e 2c 20 28 20 73 6b 20 70 6b n-token, ( sk pk
7660: 20 73 74 72 69 6e 67 20 75 32 20 2d 2d 20 29 0a string u2 -- ).
7670: 20 20 20 20 63 3a 30 6b 65 79 20 72 65 76 74 6f c:0key revto
7680: 6b 65 6e 20 24 40 20 32 73 77 61 70 20 3e 6b 65 ken $@ 2swap >ke
7690: 79 65 64 2d 68 61 73 68 0a 20 20 20 20 73 69 67 yed-hash. sig
76a0: 64 61 74 65 20 2b 64 61 74 65 20 2b 72 65 76 73 date +date +revs
76b0: 69 67 6e 20 3b 0a 0a 3a 20 72 65 76 6f 6b 65 2d ign ;..: revoke-
76c0: 6b 65 79 20 28 20 2d 2d 20 61 64 64 72 20 75 20 key ( -- addr u
76d0: 29 0a 20 20 20 20 73 6b 63 20 6f 6c 64 73 6b 63 ). skc oldskc
76e0: 20 6b 65 79 6d 6f 76 65 20 20 70 6b 63 20 6f 6c keymove pkc ol
76f0: 64 70 6b 63 20 6b 65 79 6d 6f 76 65 20 20 73 6b dpkc keymove sk
7700: 72 65 76 20 6f 6c 64 73 6b 72 65 76 20 6b 65 79 rev oldskrev key
7710: 6d 6f 76 65 0a 20 20 20 20 20 20 20 20 20 20 20 move.
7720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7740: 5c 20 62 61 63 6b 75 70 20 6b 65 79 73 0a 20 20 \ backup keys.
7750: 20 20 6f 6c 64 73 6b 72 65 76 20 6f 6c 64 70 6b oldskrev oldpk
7760: 72 65 76 20 73 6b 3e 70 6b 20 20 20 20 20 20 20 rev sk>pk
7770: 20 20 20 20 20 20 20 20 20 5c 20 67 65 6e 65 72 \ gener
7780: 61 74 65 20 72 65 76 6f 6b 61 74 69 6f 6e 20 70 ate revokation p
7790: 75 62 6b 65 79 0a 20 20 20 20 67 65 6e 2d 6b 65 ubkey. gen-ke
77a0: 79 73 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ys
77b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
77c0: 20 5c 20 67 65 6e 65 72 61 74 65 20 6e 65 77 20 \ generate new
77d0: 6b 65 79 73 0a 20 20 20 20 70 6b 63 20 6b 65 79 keys. pkc key
77e0: 73 69 7a 65 32 20 72 65 76 74 6f 6b 65 6e 20 24 size2 revtoken $
77f0: 21 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 !
7800: 5c 20 6d 79 20 6e 65 77 20 6b 65 79 0a 20 20 20 \ my new key.
7810: 20 6f 6c 64 70 6b 72 65 76 20 6b 65 79 73 69 7a oldpkrev keysiz
7820: 65 20 72 65 76 74 6f 6b 65 6e 20 24 2b 21 20 20 e revtoken $+!
7830: 20 20 20 20 20 20 20 20 5c 20 72 65 76 6f 6b 65 \ revoke
7840: 20 74 6f 6b 65 6e 0a 20 20 20 20 6f 6c 64 73 6b token. oldsk
7850: 72 65 76 20 6f 6c 64 70 6b 72 65 76 20 22 72 65 rev oldpkrev "re
7860: 76 6f 6b 65 22 20 73 69 67 6e 2d 74 6f 6b 65 6e voke" sign-token
7870: 2c 20 5c 20 72 65 76 6f 6b 65 20 73 69 67 6e 61 , \ revoke signa
7880: 74 75 72 65 0a 20 20 20 20 73 6b 63 20 70 6b 63 ture. skc pkc
7890: 20 22 73 65 6c 66 73 69 67 6e 22 20 73 69 67 6e "selfsign" sign
78a0: 2d 74 6f 6b 65 6e 2c 20 20 20 20 20 20 20 20 20 -token,
78b0: 5c 20 73 65 6c 66 20 73 69 67 6e 65 64 20 77 69 \ self signed wi
78c0: 74 68 20 6e 65 77 20 6b 65 79 0a 20 20 20 20 22 th new key. "
78d0: 21 22 20 72 65 76 74 6f 6b 65 6e 20 30 20 24 69 !" revtoken 0 $i
78e0: 6e 73 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ns
78f0: 20 20 20 20 20 20 5c 20 22 21 22 20 2b 20 6f 6c \ "!" + ol
7900: 64 6b 65 79 6c 65 6e 2b 6e 65 77 6b 65 79 6c 65 dkeylen+newkeyle
7910: 6e 20 74 6f 20 66 6c 61 67 20 72 65 76 6f 6b 61 n to flag revoka
7920: 74 69 6f 6e 0a 20 20 20 20 72 65 76 74 6f 6b 65 tion. revtoke
7930: 6e 20 24 40 20 67 65 6e 3e 68 6f 73 74 20 32 64 n $@ gen>host 2d
7940: 72 6f 70 20 20 20 20 20 20 20 20 20 20 20 20 20 rop
7950: 5c 20 73 69 67 6e 20 68 6f 73 74 20 69 6e 66 6f \ sign host info
7960: 72 6d 61 74 69 6f 6e 20 77 69 74 68 20 6f 6c 64 rmation with old
7970: 20 6b 65 79 0a 20 20 20 20 73 69 67 64 61 74 65 key. sigdate
7980: 20 2b 64 61 74 65 20 73 69 67 64 61 74 65 20 64 +date sigdate d
7990: 61 74 65 73 69 7a 65 23 20 72 65 76 74 6f 6b 65 atesize# revtoke
79a0: 6e 20 24 2b 21 0a 20 20 20 20 6f 6c 64 73 6b 63 n $+!. oldskc
79b0: 20 6f 6c 64 70 6b 63 20 2b 72 65 76 73 69 67 6e oldpkc +revsign
79c0: 0a 20 20 20 20 30 6f 6c 64 6b 65 79 20 72 65 76 . 0oldkey rev
79d0: 74 6f 6b 65 6e 20 24 40 20 3b 0a 0a 5c 20 69 6e token $@ ;..\ in
79e0: 76 69 74 61 74 69 6f 6e 0a 0a 56 61 72 69 61 62 vitation..Variab
79f0: 6c 65 20 69 6e 76 69 74 61 74 69 6f 6e 73 0a 0a le invitations..
7a00: 65 76 65 6e 74 3a 20 2d 3e 69 6e 76 69 74 65 20 event: ->invite
7a10: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 ( addr u -- ).
7a20: 20 20 2e 22 20 69 6e 76 69 74 65 20 6d 65 3a 20 ." invite me:
7a30: 22 20 6f 76 65 72 20 3e 72 20 2e 70 6b 32 6b 65 " over >r .pk2ke
7a40: 79 24 20 63 72 20 72 3e 20 66 72 65 65 20 74 68 y$ cr r> free th
7a50: 72 6f 77 20 63 74 72 6c 20 4c 20 69 6e 73 6b 65 row ctrl L inske
7a60: 79 20 3b 0a 65 76 65 6e 74 3a 20 2d 3e 77 61 6b y ;.event: ->wak
7a70: 65 6d 65 20 28 20 6f 20 2d 2d 20 29 20 3c 65 76 eme ( o -- ) <ev
7a80: 65 6e 74 20 2d 3e 77 61 6b 65 20 65 76 65 6e 74 ent ->wake event
7a90: 3e 20 3b 0a 0a 3a 20 70 6b 32 6b 65 79 24 2d 61 > ;..: pk2key$-a
7aa0: 64 64 20 28 20 61 64 64 72 20 75 20 70 65 72 6d dd ( addr u perm
7ab0: 20 2d 2d 20 29 20 7b 20 70 65 72 6d 20 7d 0a 20 -- ) { perm }.
7ac0: 20 20 20 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f sample-key >o
7ad0: 20 69 6d 70 6f 72 74 23 69 6e 76 69 74 65 64 20 import#invited
7ae0: 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 63 6d import-type ! cm
7af0: 64 3a 6e 65 73 74 73 69 67 0a 20 20 20 20 70 65 d:nestsig. pe
7b00: 72 6d 20 6b 65 2d 6d 61 73 6b 20 21 0a 20 20 20 rm ke-mask !.
7b10: 20 69 6d 70 6f 72 74 23 6e 65 77 20 69 6d 70 6f import#new impo
7b20: 72 74 2d 74 79 70 65 20 21 20 20 73 61 76 65 2d rt-type ! save-
7b30: 70 75 62 6b 65 79 73 20 6f 3e 20 3b 0a 0a 3a 20 pubkeys o> ;..:
7b40: 78 2d 65 72 61 73 65 20 28 20 6c 65 6e 20 2d 2d x-erase ( len --
7b50: 20 29 0a 20 20 20 20 64 75 70 20 78 62 61 63 6b ). dup xback
7b60: 2d 72 65 73 74 6f 72 65 20 20 64 75 70 20 73 70 -restore dup sp
7b70: 61 63 65 73 20 20 78 62 61 63 6b 2d 72 65 73 74 aces xback-rest
7b80: 6f 72 65 20 3b 0a 0a 3a 20 69 6e 76 69 74 65 2d ore ;..: invite-
7b90: 6b 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 key ( addr u --
7ba0: 6b 65 79 20 29 0a 20 20 20 20 32 64 75 70 20 78 key ). 2dup x
7bb0: 2d 77 69 64 74 68 20 7b 20 61 64 64 72 20 75 20 -width { addr u
7bc0: 6c 65 6e 20 7d 0a 20 20 20 20 42 45 47 49 4e 20 len }. BEGIN
7bd0: 20 61 64 64 72 20 75 20 74 79 70 65 20 6b 65 79 addr u type key
7be0: 20 20 6c 65 6e 20 78 2d 65 72 61 73 65 0a 09 64 len x-erase..d
7bf0: 75 70 20 63 74 72 6c 20 5a 20 3d 0a 20 20 20 20 up ctrl Z =.
7c00: 57 48 49 4c 45 20 20 64 72 6f 70 20 20 42 45 47 WHILE drop BEG
7c10: 49 4e 20 20 6b 65 79 20 63 74 72 6c 20 4c 20 3d IN key ctrl L =
7c20: 20 20 55 4e 54 49 4c 20 20 52 45 50 45 41 54 20 UNTIL REPEAT
7c30: 3b 0a 0a 3a 20 70 72 6f 63 65 73 73 2d 69 6e 76 ;..: process-inv
7c40: 69 74 61 74 69 6f 6e 20 28 20 61 64 64 72 20 75 itation ( addr u
7c50: 20 2d 2d 20 29 0a 20 20 20 20 73 22 20 69 6e 76 -- ). s" inv
7c60: 69 74 65 20 28 79 2f 6e 2f 62 29 3f 22 20 69 6e ite (y/n/b)?" in
7c70: 76 69 74 65 2d 6b 65 79 0a 20 20 20 20 63 61 73 vite-key. cas
7c80: 65 0a 09 27 79 27 20 6f 66 20 20 70 65 72 6d 25 e..'y' of perm%
7c90: 64 65 66 61 75 6c 74 20 70 6b 32 6b 65 79 24 2d default pk2key$-
7ca0: 61 64 64 20 20 2e 22 20 61 64 64 65 64 22 20 63 add ." added" c
7cb0: 72 20 20 20 65 6e 64 6f 66 0a 09 27 62 27 20 6f r endof..'b' o
7cc0: 66 20 20 70 65 72 6d 25 62 6c 6f 63 6b 65 64 20 f perm%blocked
7cd0: 70 6b 32 6b 65 79 24 2d 61 64 64 20 20 2e 22 20 pk2key$-add ."
7ce0: 62 6c 6f 63 6b 65 64 22 20 63 72 20 65 6e 64 6f blocked" cr endo
7cf0: 66 0a 09 32 64 72 6f 70 20 2e 22 20 69 67 6e 6f f..2drop ." igno
7d00: 72 65 64 22 20 63 72 0a 20 20 20 20 65 6e 64 63 red" cr. endc
7d10: 61 73 65 20 3b 0a 0a 3a 20 66 69 6c 74 65 72 2d ase ;..: filter-
7d20: 69 6e 76 69 74 61 74 69 6f 6e 3f 20 28 20 61 64 invitation? ( ad
7d30: 64 72 20 75 20 2d 2d 20 66 6c 61 67 20 29 0a 20 dr u -- flag ).
7d40: 20 20 20 73 69 67 70 6b 32 73 69 7a 65 23 20 2d sigpk2size# -
7d50: 20 2b 20 6b 65 79 73 69 7a 65 20 6b 65 79 23 20 + keysize key#
7d60: 23 40 20 64 30 3c 3e 20 3b 20 5c 20 61 6c 72 65 #@ d0<> ; \ alre
7d70: 61 64 79 20 74 68 65 72 65 0a 0a 3a 20 2e 69 6e ady there..: .in
7d80: 76 69 74 61 74 69 6f 6e 73 20 28 20 2d 2d 20 29 vitations ( -- )
7d90: 0a 20 20 20 20 69 6e 76 69 74 61 74 69 6f 6e 73 . invitations
7da0: 20 5b 3a 20 32 64 75 70 20 2e 70 6b 32 6b 65 79 [: 2dup .pk2key
7db0: 24 20 63 72 20 70 72 6f 63 65 73 73 2d 69 6e 76 $ cr process-inv
7dc0: 69 74 61 74 69 6f 6e 20 3b 5d 20 24 5b 5d 6d 61 itation ;] $[]ma
7dd0: 70 0a 20 20 20 20 69 6e 76 69 74 61 74 69 6f 6e p. invitation
7de0: 73 20 24 5b 5d 6f 66 66 20 3b 0a 0a 3a 20 3e 69 s $[]off ;..: >i
7df0: 6e 76 69 74 61 74 69 6f 6e 73 20 28 20 61 64 64 nvitations ( add
7e00: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 32 64 75 r u -- ). 2du
7e10: 70 20 66 69 6c 74 65 72 2d 69 6e 76 69 74 61 74 p filter-invitat
7e20: 69 6f 6e 3f 20 49 46 20 20 32 64 72 6f 70 20 45 ion? IF 2drop E
7e30: 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 69 6e XIT THEN. in
7e40: 76 69 74 61 74 69 6f 6e 73 20 24 5b 5d 23 20 3e vitations $[]# >
7e50: 72 0a 20 20 20 20 32 64 75 70 20 69 6e 76 69 74 r. 2dup invit
7e60: 61 74 69 6f 6e 73 20 24 69 6e 73 5b 5d 73 69 67 ations $ins[]sig
7e70: 20 64 72 6f 70 0a 20 20 20 20 69 6e 76 69 74 61 drop. invita
7e80: 74 69 6f 6e 73 20 24 5b 5d 23 20 72 3e 20 3c 3e tions $[]# r> <>
7e90: 20 49 46 0a 09 73 61 76 65 2d 6d 65 6d 20 6d 61 IF..save-mem ma
7ea0: 69 6e 2d 75 70 40 20 3c 68 69 64 65 3e 0a 09 3c in-up@ <hide>..<
7eb0: 65 76 65 6e 74 20 65 24 2c 20 2d 3e 69 6e 76 69 event e$, ->invi
7ec0: 74 65 20 75 70 40 20 65 6c 69 74 2c 20 2d 3e 77 te up@ elit, ->w
7ed0: 61 6b 65 6d 65 20 6d 61 69 6e 2d 75 70 40 20 65 akeme main-up@ e
7ee0: 76 65 6e 74 3e 20 73 74 6f 70 0a 20 20 20 20 45 vent> stop. E
7ef0: 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 45 4e LSE 2drop THEN
7f00: 20 3b 0a 0a 3a 20 73 65 6e 64 2d 69 6e 76 69 74 ;..: send-invit
7f10: 61 74 69 6f 6e 20 28 20 70 6b 20 75 20 2d 2d 20 ation ( pk u --
7f20: 29 0a 20 20 20 20 73 65 74 75 70 21 20 6d 79 70 ). setup! myp
7f30: 6b 32 6e 69 63 6b 24 20 32 3e 72 0a 20 20 20 20 k2nick$ 2>r.
7f40: 67 65 6e 2d 74 6d 70 6b 65 79 73 20 64 72 6f 70 gen-tmpkeys drop
7f50: 20 74 73 6b 63 20 73 77 61 70 20 6b 65 79 70 61 tskc swap keypa
7f60: 64 20 65 64 2d 64 68 20 64 6f 2d 6b 65 79 70 61 d ed-dh do-keypa
7f70: 64 20 73 65 63 21 0a 20 20 20 20 6e 65 74 32 6f d sec!. net2o
7f80: 2d 63 6f 64 65 30 0a 20 20 20 20 74 70 6b 63 20 -code0. tpkc
7f90: 6b 65 79 73 69 7a 65 20 24 2c 20 6f 6e 65 73 68 keysize $, onesh
7fa0: 6f 74 2d 74 6d 70 6b 65 79 0a 20 20 20 20 6e 65 ot-tmpkey. ne
7fb0: 73 74 5b 20 32 72 3e 20 24 2c 20 69 6e 76 69 74 st[ 2r> $, invit
7fc0: 65 20 5d 74 6d 70 6e 65 73 74 0a 20 20 20 20 63 e ]tmpnest. c
7fd0: 6f 6f 6b 69 65 2b 72 65 71 75 65 73 74 0a 20 20 ookie+request.
7fe0: 20 20 65 6e 64 2d 63 6f 64 65 7c 20 3b 0a 0a 5c end-code| ;..\
7ff0: 20 6b 65 79 20 61 70 69 20 68 65 6c 70 65 72 73 key api helpers
8000: 0a 0a 3a 20 64 65 6c 2d 6c 61 73 74 2d 6b 65 79 ..: del-last-key
8010: 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 73 ( -- ). keys
8020: 20 24 5b 5d 23 20 31 2d 20 6b 65 79 73 20 24 5b $[]# 1- keys $[
8030: 5d 20 73 65 63 2d 6f 66 66 0a 20 20 20 20 6b 65 ] sec-off. ke
8040: 79 73 20 24 40 6c 65 6e 20 63 65 6c 6c 2d 20 6b ys $@len cell- k
8050: 65 79 73 20 24 21 6c 65 6e 20 3b 0a 0a 3a 20 73 eys $!len ;..: s
8060: 74 6f 72 65 6b 65 79 21 20 28 20 2d 2d 20 29 0a torekey! ( -- ).
8070: 20 20 20 20 3e 73 65 63 6b 65 79 20 6b 65 79 73 >seckey keys
8080: 20 24 5b 5d 23 20 30 20 3f 44 4f 20 20 32 64 75 $[]# 0 ?DO 2du
8090: 70 20 49 20 6b 65 79 73 20 73 65 63 5b 5d 40 20 p I keys sec[]@
80a0: 73 74 72 3d 20 49 46 0a 09 20 20 20 20 49 20 6b str= IF.. I k
80b0: 65 79 73 20 73 65 63 5b 5d 40 20 64 72 6f 70 20 eys sec[]@ drop
80c0: 3e 73 74 6f 72 65 6b 65 79 20 21 20 20 4c 45 41 >storekey ! LEA
80d0: 56 45 20 20 54 48 45 4e 20 20 4c 4f 4f 50 20 20 VE THEN LOOP
80e0: 32 64 72 6f 70 20 3b 0a 0a 3a 20 63 68 6f 6f 73 2drop ;..: choos
80f0: 65 2d 6b 65 79 20 28 20 2d 2d 20 6f 20 29 0a 20 e-key ( -- o ).
8100: 20 20 20 30 20 42 45 47 49 4e 20 20 64 72 6f 70 0 BEGIN drop
8110: 0a 09 2e 22 20 43 68 6f 6f 73 65 20 6b 65 79 20 ..." Choose key
8120: 62 79 20 6e 75 6d 62 65 72 3a 22 20 63 72 20 2e by number:" cr .
8130: 73 65 63 72 65 74 2d 6e 69 63 6b 73 0a 09 42 45 secret-nicks..BE
8140: 47 49 4e 20 20 6b 65 79 20 64 75 70 20 62 6c 20 GIN key dup bl
8150: 3c 20 57 48 49 4c 45 20 20 64 72 6f 70 20 20 52 < WHILE drop R
8160: 45 50 45 41 54 20 5c 20 73 77 61 6c 6c 6f 77 20 EPEAT \ swallow
8170: 63 6f 6e 74 72 6f 6c 20 6b 65 79 73 0a 09 5b 27 control keys..['
8180: 5d 20 64 69 67 69 74 3f 20 23 33 36 20 62 61 73 ] digit? #36 bas
8190: 65 2d 65 78 65 63 75 74 65 20 30 3d 20 49 46 20 e-execute 0= IF
81a0: 2d 31 20 54 48 45 4e 0a 09 73 65 63 72 65 74 2d -1 THEN..secret-
81b0: 6b 65 79 20 64 75 70 20 30 3d 20 57 48 49 4c 45 key dup 0= WHILE
81c0: 0a 09 20 20 20 20 2e 22 20 50 6c 65 61 73 65 20 .. ." Please
81d0: 65 6e 74 65 72 20 61 20 62 61 73 65 2d 33 36 20 enter a base-36
81e0: 6e 75 6d 62 65 72 20 62 65 74 77 65 65 6e 20 30 number between 0
81f0: 20 61 6e 64 20 22 0a 09 20 20 20 20 73 65 63 72 and ".. secr
8200: 65 74 2d 6b 65 79 73 23 20 31 2d 20 5b 27 5d 20 et-keys# 1- [']
8210: 2e 20 23 33 36 20 62 61 73 65 2d 65 78 65 63 75 . #36 base-execu
8220: 74 65 20 63 72 20 20 72 64 72 6f 70 0a 20 20 20 te cr rdrop.
8230: 20 52 45 50 45 41 54 0a 20 20 20 20 64 75 70 20 REPEAT. dup
8240: 2e 73 74 6f 72 65 6b 65 79 21 20 20 3e 73 74 6f .storekey! >sto
8250: 72 65 6b 65 79 20 40 20 64 65 66 61 75 6c 74 6b rekey @ defaultk
8260: 65 79 20 21 0a 20 20 20 20 2e 22 20 3d 3d 3d 3d ey !. ." ====
8270: 20 6b 65 79 20 22 20 64 75 70 20 2e 2e 6e 69 63 key " dup ..nic
8280: 6b 20 2e 22 20 20 63 68 6f 73 65 6e 20 3d 3d 3d k ." chosen ===
8290: 3d 22 20 63 72 20 3b 0a 0a 5c 20 77 69 6c 6c 20 =" cr ;..\ will
82a0: 61 73 6b 20 66 6f 72 20 79 6f 75 72 20 70 61 73 ask for your pas
82b0: 73 77 6f 72 64 20 61 6e 64 20 69 66 20 70 6f 73 sword and if pos
82c0: 73 69 62 6c 65 20 61 75 74 6f 2d 73 65 6c 65 63 sible auto-selec
82d0: 74 20 79 6f 75 72 20 69 64 0a 0a 56 61 72 69 61 t your id..Varia
82e0: 62 6c 65 20 74 72 69 65 73 23 0a 23 31 30 20 56 ble tries#.#10 V
82f0: 61 6c 75 65 20 6d 61 78 74 72 69 65 73 23 0a 0a alue maxtries#..
8300: 3a 20 67 65 74 2d 73 6b 63 20 28 20 2d 2d 20 29 : get-skc ( -- )
8310: 0a 20 20 20 20 73 65 63 72 65 74 2d 6b 65 79 73 . secret-keys
8320: 23 20 3f 45 58 49 54 20 20 74 72 69 65 73 23 20 # ?EXIT tries#
8330: 6f 66 66 0a 20 20 20 20 64 65 62 75 67 2d 76 65 off. debug-ve
8340: 63 74 6f 72 20 40 20 6f 70 2d 76 65 63 74 6f 72 ctor @ op-vector
8350: 20 21 40 20 3e 72 20 3c 64 65 66 61 75 6c 74 3e !@ >r <default>
8360: 0a 20 20 20 20 73 65 63 72 65 74 2d 6b 65 79 73 . secret-keys
8370: 23 0a 20 20 20 20 42 45 47 49 4e 20 20 64 75 70 #. BEGIN dup
8380: 20 30 3d 20 74 72 69 65 73 23 20 40 20 6d 61 78 0= tries# @ max
8390: 74 72 69 65 73 23 20 75 3c 20 61 6e 64 20 20 57 tries# u< and W
83a0: 48 49 4c 45 20 64 72 6f 70 0a 09 20 20 20 20 73 HILE drop.. s
83b0: 22 20 50 61 73 73 70 68 72 61 73 65 3a 20 22 20 " Passphrase: "
83c0: 2b 70 61 73 73 70 68 72 61 73 65 20 20 20 21 74 +passphrase !t
83d0: 69 6d 65 0a 09 20 20 20 20 72 65 61 64 2d 6b 65 ime.. read-ke
83e0: 79 73 20 73 65 63 72 65 74 2d 6b 65 79 73 23 20 ys secret-keys#
83f0: 64 75 70 20 30 3d 20 49 46 0a 09 09 5c 20 66 61 dup 0= IF...\ fa
8400: 69 6c 20 72 69 67 68 74 20 61 66 74 65 72 20 74 il right after t
8410: 68 65 20 66 69 72 73 74 20 74 72 79 20 69 66 20 he first try if
8420: 50 41 53 53 50 48 52 41 53 45 20 69 73 20 75 73 PASSPHRASE is us
8430: 65 64 0a 09 09 5c 20 61 6e 64 20 67 69 76 65 20 ed...\ and give
8440: 74 68 65 20 6d 61 78 69 6d 75 6d 20 77 61 69 74 the maximum wait
8450: 69 6e 67 20 70 65 6e 61 6c 74 79 20 69 6e 20 74 ing penalty in t
8460: 68 61 74 20 63 61 73 65 0a 09 09 31 20 6d 61 78 hat case...1 max
8470: 74 72 69 65 73 23 20 73 22 20 50 41 53 53 50 48 tries# s" PASSPH
8480: 52 41 53 45 22 20 67 65 74 65 6e 76 20 64 30 3d RASE" getenv d0=
8490: 20 73 65 6c 65 63 74 20 74 72 69 65 73 23 20 2b select tries# +
84a0: 21 0a 09 09 3c 65 72 72 3e 20 2e 22 20 54 72 79 !...<err> ." Try
84b0: 23 20 22 20 74 72 69 65 73 23 20 40 20 30 20 2e # " tries# @ 0 .
84c0: 72 20 27 2f 27 20 65 6d 69 74 20 6d 61 78 74 72 r '/' emit maxtr
84d0: 69 65 73 23 20 2e 0a 09 09 2e 22 20 66 61 69 6c ies# ....." fail
84e0: 65 64 2c 20 6e 6f 20 6b 65 79 20 66 6f 75 6e 64 ed, no key found
84f0: 2c 20 77 61 69 74 69 6e 67 20 22 0a 09 09 23 31 , waiting "...#1
8500: 20 74 72 69 65 73 23 20 40 20 32 2a 20 6c 73 68 tries# @ 2* lsh
8510: 69 66 74 20 64 75 70 20 2e 20 2e 22 20 6d 73 2e ift dup . ." ms.
8520: 2e 2e 22 20 6d 73 20 20 3c 64 65 66 61 75 6c 74 .." ms <default
8530: 3e 20 63 72 0a 09 09 64 65 6c 2d 6c 61 73 74 2d > cr...del-last-
8540: 6b 65 79 0a 09 20 20 20 20 54 48 45 4e 0a 20 20 key.. THEN.
8550: 20 20 52 45 50 45 41 54 0a 20 20 20 20 64 75 70 REPEAT. dup
8560: 20 30 3d 20 49 46 20 20 23 2d 35 36 20 74 68 72 0= IF #-56 thr
8570: 6f 77 20 20 54 48 45 4e 0a 20 20 20 20 31 20 3d ow THEN. 1 =
8580: 20 49 46 20 20 30 20 73 65 63 72 65 74 2d 6b 65 IF 0 secret-ke
8590: 79 0a 09 2e 22 20 3d 3d 3d 3d 20 6f 70 65 6e 65 y..." ==== opene
85a0: 64 3a 20 22 20 64 75 70 20 2e 2e 6e 69 63 6b 20 d: " dup ..nick
85b0: 2e 22 20 20 69 6e 20 22 20 2e 74 69 6d 65 20 2e ." in " .time .
85c0: 22 20 3d 3d 3d 3d 22 20 63 72 0a 20 20 20 20 45 " ====" cr. E
85d0: 4c 53 45 20 20 2e 22 20 3d 3d 3d 3d 20 6f 70 65 LSE ." ==== ope
85e0: 6e 65 64 20 69 6e 20 22 20 2e 74 69 6d 65 20 2e ned in " .time .
85f0: 22 20 3d 3d 3d 3d 22 20 63 72 20 63 68 6f 6f 73 " ====" cr choos
8600: 65 2d 6b 65 79 20 20 54 48 45 4e 0a 20 20 20 20 e-key THEN.
8610: 3e 72 61 77 2d 6b 65 79 20 3f 72 73 6b 20 20 20 >raw-key ?rsk
8620: 72 3e 20 6f 70 2d 76 65 63 74 6f 72 20 21 20 3b r> op-vector ! ;
8630: 0a 0a 73 63 6f 70 65 3a 20 6e 32 6f 0a 46 6f 72 ..scope: n2o.For
8640: 77 61 72 64 20 68 65 6c 70 0a 7d 73 63 6f 70 65 ward help.}scope
8650: 0a 0a 3a 20 67 65 74 2d 6d 79 2d 6b 65 79 20 28 ..: get-my-key (
8660: 20 2d 2d 20 78 74 20 29 0a 20 20 20 20 67 65 6e -- xt ). gen
8670: 2d 6b 65 79 73 2d 64 69 72 20 20 22 73 65 63 6b -keys-dir "seck
8680: 65 79 73 2e 6b 32 6f 22 20 2e 6b 65 79 73 2f 20 eys.k2o" .keys/
8690: 32 64 75 70 20 66 69 6c 65 2d 73 74 61 74 75 73 2dup file-status
86a0: 20 6e 69 70 0a 20 20 20 20 30 3d 20 49 46 20 20 nip. 0= IF
86b0: 72 2f 6f 20 6f 70 65 6e 2d 66 69 6c 65 20 74 68 r/o open-file th
86c0: 72 6f 77 20 3e 72 20 72 40 20 66 69 6c 65 2d 73 row >r r@ file-s
86d0: 69 7a 65 20 74 68 72 6f 77 20 64 30 3d 0a 09 72 ize throw d0=..r
86e0: 3e 20 63 6c 6f 73 65 2d 66 69 6c 65 20 74 68 72 > close-file thr
86f0: 6f 77 20 20 45 4c 53 45 20 20 74 72 75 65 20 20 ow ELSE true
8700: 54 48 45 4e 0a 20 20 20 20 49 46 20 20 5b 3a 20 THEN. IF [:
8710: 2e 22 20 47 65 6e 65 72 61 74 65 20 61 20 6e 65 ." Generate a ne
8720: 77 20 6b 65 79 70 61 69 72 3a 22 20 63 72 0a 09 w keypair:" cr..
8730: 20 20 67 65 74 2d 6e 69 63 6b 20 64 75 70 20 30 get-nick dup 0
8740: 3d 20 23 2d 35 36 20 61 6e 64 20 74 68 72 6f 77 = #-56 and throw
8750: 20 5c 20 65 6d 70 74 79 20 6e 69 63 6b 3a 20 70 \ empty nick: p
8760: 72 65 74 65 6e 64 20 74 6f 20 71 75 69 74 0a 09 retend to quit..
8770: 20 20 6e 65 77 2d 6b 65 79 20 2e 6b 65 79 73 20 new-key .keys
8780: 3f 72 73 6b 20 3b 5d 0a 20 20 20 20 45 4c 53 45 ?rsk ;]. ELSE
8790: 20 20 5b 27 5d 20 67 65 74 2d 73 6b 63 20 20 54 ['] get-skc T
87a0: 48 45 4e 20 3b 0a 0a 3a 20 2e 6b 65 79 69 6e 66 HEN ;..: .keyinf
87b0: 6f 20 28 20 2d 2d 20 29 0a 20 20 20 20 3c 77 61 o ( -- ). <wa
87c0: 72 6e 3e 20 2e 22 20 3d 3d 3d 3d 20 4e 6f 20 6b rn> ." ==== No k
87d0: 65 79 20 6f 70 65 6e 65 64 20 3d 3d 3d 3d 22 20 ey opened ===="
87e0: 63 72 0a 20 20 20 20 3c 69 6e 66 6f 3e 20 2e 22 cr. <info> ."
87f0: 20 67 65 6e 65 72 61 74 65 20 61 20 6e 65 77 20 generate a new
8800: 6f 6e 65 20 77 69 74 68 20 27 6b 65 79 67 65 6e one with 'keygen
8810: 27 22 20 63 72 20 3c 64 65 66 61 75 6c 74 3e 20 '" cr <default>
8820: 3b 0a 0a 3a 20 67 65 74 2d 6d 65 20 28 20 2d 2d ;..: get-me ( --
8830: 20 29 0a 20 20 20 20 67 65 74 2d 6d 79 2d 6b 65 ). get-my-ke
8840: 79 20 63 61 74 63 68 20 64 75 70 20 23 2d 35 36 y catch dup #-56
8850: 20 3d 20 49 46 20 64 72 6f 70 20 2e 6b 65 79 69 = IF drop .keyi
8860: 6e 66 6f 20 45 4c 53 45 20 74 68 72 6f 77 20 54 nfo ELSE throw T
8870: 48 45 4e 20 3b 0a 0a 3a 20 3f 67 65 74 2d 6d 65 HEN ;..: ?get-me
8880: 20 28 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 74 ( -- ). \G t
8890: 68 69 73 20 76 65 72 73 69 6f 6e 20 6f 66 20 67 his version of g
88a0: 65 74 2d 6d 65 20 66 61 69 6c 73 20 68 61 72 64 et-me fails hard
88b0: 20 69 66 20 6e 6f 20 6b 65 79 20 69 73 20 6f 70 if no key is op
88c0: 65 6e 65 64 0a 20 20 20 20 67 65 74 2d 6d 79 2d ened. get-my-
88d0: 6b 65 79 20 63 61 74 63 68 20 23 2d 35 36 20 3d key catch #-56 =
88e0: 20 49 46 0a 09 2e 6b 65 79 69 6e 66 6f 20 74 72 IF...keyinfo tr
88f0: 75 65 20 21 21 6e 6f 2d 6b 65 79 2d 6f 70 65 6e ue !!no-key-open
8900: 21 21 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a 30 !!. THEN ;..0
8910: 20 5b 49 46 5d 0a 4c 6f 63 61 6c 20 56 61 72 69 [IF].Local Vari
8920: 61 62 6c 65 73 3a 0a 66 6f 72 74 68 2d 6c 6f 63 ables:.forth-loc
8930: 61 6c 2d 77 6f 72 64 73 3a 0a 20 20 20 20 28 0a al-words:. (.
8940: 20 20 20 20 20 28 28 22 6e 65 74 32 6f 3a 22 20 (("net2o:"
8950: 22 2b 6e 65 74 32 6f 3a 22 29 20 64 65 66 69 6e "+net2o:") defin
8960: 69 74 69 6f 6e 2d 73 74 61 72 74 65 72 20 28 66 ition-starter (f
8970: 6f 6e 74 2d 6c 6f 63 6b 2d 6b 65 79 77 6f 72 64 ont-lock-keyword
8980: 2d 66 61 63 65 20 2e 20 31 29 0a 20 20 20 20 20 -face . 1).
8990: 20 22 5b 20 5c 74 5c 6e 5d 22 20 74 20 6e 61 6d "[ \t\n]" t nam
89a0: 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 66 75 6e e (font-lock-fun
89b0: 63 74 69 6f 6e 2d 6e 61 6d 65 2d 66 61 63 65 20 ction-name-face
89c0: 2e 20 33 29 29 0a 20 20 20 20 20 28 28 22 64 65 . 3)). (("de
89d0: 62 75 67 3a 22 20 22 66 69 65 6c 64 3a 22 20 22 bug:" "field:" "
89e0: 32 66 69 65 6c 64 3a 22 20 22 73 66 66 69 65 6c 2field:" "sffiel
89f0: 64 3a 22 20 22 64 66 66 69 65 6c 64 3a 22 20 22 d:" "dffield:" "
8a00: 36 34 66 69 65 6c 64 3a 22 20 22 75 76 61 72 22 64field:" "uvar"
8a10: 20 22 75 76 61 6c 75 65 22 29 20 6e 6f 6e 2d 69 "uvalue") non-i
8a20: 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e 74 2d 6c mmediate (font-l
8a30: 6f 63 6b 2d 74 79 70 65 2d 66 61 63 65 20 2e 20 ock-type-face .
8a40: 32 29 0a 20 20 20 20 20 20 22 5b 20 5c 74 5c 6e 2). "[ \t\n
8a50: 5d 22 20 74 20 6e 61 6d 65 20 28 66 6f 6e 74 2d ]" t name (font-
8a60: 6c 6f 63 6b 2d 76 61 72 69 61 62 6c 65 2d 6e 61 lock-variable-na
8a70: 6d 65 2d 66 61 63 65 20 2e 20 33 29 29 0a 20 20 me-face . 3)).
8a80: 20 20 20 28 22 5b 61 2d 7a 30 2d 39 5d 2b 28 22 ("[a-z0-9]+("
8a90: 20 69 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e 74 immediate (font
8aa0: 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 -lock-comment-fa
8ab0: 63 65 20 2e 20 31 29 0a 20 20 20 20 20 20 22 29 ce . 1). ")
8ac0: 22 20 6e 69 6c 20 63 6f 6d 6d 65 6e 74 20 28 66 " nil comment (f
8ad0: 6f 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 ont-lock-comment
8ae0: 2d 66 61 63 65 20 2e 20 31 29 29 0a 20 20 20 20 -face . 1)).
8af0: 29 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 69 6e ).forth-local-in
8b00: 64 65 6e 74 2d 77 6f 72 64 73 3a 0a 20 20 20 20 dent-words:.
8b10: 28 0a 20 20 20 20 20 28 28 22 6e 65 74 32 6f 3a (. (("net2o:
8b20: 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20 28 30 20 " "+net2o:") (0
8b30: 2e 20 32 29 20 28 30 20 2e 20 32 29 20 6e 6f 6e . 2) (0 . 2) non
8b40: 2d 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 -immediate).
8b50: 20 28 28 22 5b 3a 22 20 22 6b 65 79 3a 63 6f 64 (("[:" "key:cod
8b60: 65 22 29 20 28 30 20 2e 20 31 29 20 28 30 20 2e e") (0 . 1) (0 .
8b70: 20 31 29 20 69 6d 6d 65 64 69 61 74 65 29 0a 20 1) immediate).
8b80: 20 20 20 20 28 28 22 3b 5d 22 20 22 65 6e 64 3a ((";]" "end:
8b90: 6b 65 79 22 29 20 28 2d 31 20 2e 20 30 29 20 28 key") (-1 . 0) (
8ba0: 30 20 2e 20 2d 31 29 20 69 6d 6d 65 64 69 61 74 0 . -1) immediat
8bb0: 65 29 0a 20 20 20 20 29 0a 45 6e 64 3a 0a 5b 54 e). ).End:.[T
8bc0: 48 45 4e 5d HEN]