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 3a 20 2e 67 72 6f 75 70 73 20 28 20 2d ;..: .groups ( -
24a0: 2d 20 29 0a 20 20 20 20 67 72 6f 75 70 73 5b 5d - ). groups[]
24b0: 20 5b 3a 20 32 64 75 70 20 32 20 63 65 6c 6c 73 [: 2dup 2 cells
24c0: 20 2f 73 74 72 69 6e 67 20 74 79 70 65 20 73 70 /string type sp
24d0: 61 63 65 0a 20 20 20 20 20 20 64 72 6f 70 20 32 ace. drop 2
24e0: 40 20 2e 70 65 72 6d 61 6e 64 6f 72 20 63 72 20 @ .permandor cr
24f0: 3b 5d 20 24 5b 5d 6d 61 70 20 3b 0a 0a 3a 20 2e ;] $[]map ;..: .
2500: 69 6e 2d 67 72 6f 75 70 73 20 28 20 61 64 64 72 in-groups ( addr
2510: 20 75 20 2d 2d 20 29 0a 20 20 20 20 62 6f 75 6e u -- ). boun
2520: 64 73 20 3f 44 4f 0a 09 49 20 70 40 2b 20 49 20 ds ?DO..I p@+ I
2530: 2d 20 3e 72 20 36 34 3e 6e 20 67 72 6f 75 70 73 - >r 64>n groups
2540: 5b 5d 20 24 5b 5d 40 20 32 20 63 65 6c 6c 73 20 [] $[]@ 2 cells
2550: 2f 73 74 72 69 6e 67 20 73 70 61 63 65 20 74 79 /string space ty
2560: 70 65 0a 20 20 20 20 72 3e 20 2b 4c 4f 4f 50 20 pe. r> +LOOP
2570: 3b 0a 0a 3a 20 77 72 69 74 65 2d 67 72 6f 75 70 ;..: write-group
2580: 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 22 67 72 s ( -- ). "gr
2590: 6f 75 70 73 22 20 2e 6e 65 74 32 6f 2f 20 77 2f oups" .net2o/ w/
25a0: 6f 20 63 72 65 61 74 65 2d 66 69 6c 65 20 74 68 o create-file th
25b0: 72 6f 77 20 3e 72 0a 20 20 20 20 5b 27 5d 20 2e row >r. ['] .
25c0: 67 72 6f 75 70 73 20 72 40 20 6f 75 74 66 69 6c groups r@ outfil
25d0: 65 2d 65 78 65 63 75 74 65 0a 20 20 20 20 72 3e e-execute. r>
25e0: 20 63 6c 6f 73 65 2d 66 69 6c 65 20 74 68 72 6f close-file thro
25f0: 77 20 3b 0a 0a 3a 20 67 72 6f 75 70 2d 6c 69 6e w ;..: group-lin
2600: 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 70 61 72 e ( -- ). par
2610: 73 65 2d 6e 61 6d 65 20 70 61 72 73 65 2d 6e 61 se-name parse-na
2620: 6d 65 20 3e 70 65 72 6d 20 3e 67 72 6f 75 70 73 me >perm >groups
2630: 20 3b 0a 0a 3a 20 72 65 61 64 2d 67 72 6f 75 70 ;..: read-group
2640: 73 2d 6c 6f 6f 70 20 28 20 2d 2d 20 29 0a 20 20 s-loop ( -- ).
2650: 20 20 42 45 47 49 4e 20 20 72 65 66 69 6c 6c 20 BEGIN refill
2660: 20 57 48 49 4c 45 20 20 67 72 6f 75 70 2d 6c 69 WHILE group-li
2670: 6e 65 20 20 52 45 50 45 41 54 20 3b 0a 0a 3a 20 ne REPEAT ;..:
2680: 72 65 61 64 2d 67 72 6f 75 70 73 20 28 20 2d 2d read-groups ( --
2690: 20 29 0a 20 20 20 20 22 67 72 6f 75 70 73 22 20 ). "groups"
26a0: 2e 6e 65 74 32 6f 2f 20 32 64 75 70 20 66 69 6c .net2o/ 2dup fil
26b0: 65 2d 73 74 61 74 75 73 20 6e 69 70 20 6e 6f 2d e-status nip no-
26c0: 66 69 6c 65 23 20 3d 20 49 46 0a 09 69 6e 69 74 file# = IF..init
26d0: 2d 67 72 6f 75 70 73 20 77 72 69 74 65 2d 67 72 -groups write-gr
26e0: 6f 75 70 73 0a 20 20 20 20 54 48 45 4e 20 20 3e oups. THEN >
26f0: 69 6e 63 6c 75 64 65 64 20 74 68 72 6f 77 0a 20 included throw.
2700: 20 20 20 5b 27 5d 20 72 65 61 64 2d 67 72 6f 75 ['] read-grou
2710: 70 73 2d 6c 6f 6f 70 20 65 78 65 63 75 74 65 2d ps-loop execute-
2720: 70 61 72 73 69 6e 67 2d 6e 61 6d 65 64 2d 66 69 parsing-named-fi
2730: 6c 65 20 3b 0a 0a 72 65 61 64 2d 67 72 6f 75 70 le ;..read-group
2740: 73 0a 0a 3a 20 67 72 6f 75 70 73 3e 6d 61 73 6b s..: 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 3a 6e 6f 6e 61 6d 65 drop ;..:noname
28c0: 20 64 65 66 65 72 73 20 27 63 6f 6c 64 20 20 67 defers 'cold g
28d0: 72 6f 75 70 73 5b 5d 20 6f 66 66 20 72 65 61 64 roups[] off read
28e0: 2d 67 72 6f 75 70 73 20 3b 20 69 73 20 27 63 6f -groups ; is 'co
28f0: 6c 64 0a 0a 5c 20 6b 65 79 20 64 69 73 70 6c 61 ld..\ key displa
2900: 79 0a 0a 5b 49 46 55 4e 44 45 46 5d 20 6d 61 67 y..[IFUNDEF] mag
2910: 65 6e 74 61 20 20 62 72 6f 77 6e 20 63 6f 6e 73 enta brown cons
2920: 74 61 6e 74 20 6d 61 67 65 6e 74 61 20 5b 54 48 tant magenta [TH
2930: 45 4e 5d 0a 5b 49 46 44 45 46 5d 20 67 6c 2d 74 EN].[IFDEF] gl-t
2940: 79 70 65 20 3a 20 62 67 7c 20 3e 62 67 20 6f 72 ype : bg| >bg or
2950: 20 3b 20 5b 45 4c 53 45 5d 20 3a 20 62 67 7c 20 ; [ELSE] : bg|
2960: 64 72 6f 70 20 3b 20 5b 54 48 45 4e 5d 0a 0a 43 drop ; [THEN]..C
2970: 72 65 61 74 65 20 38 35 63 6f 6c 6f 72 73 2d 62 reate 85colors-b
2980: 77 0a 30 20 2c 20 69 6e 76 65 72 73 20 2c 0a 69 w.0 , invers ,.i
2990: 6e 76 65 72 73 20 2c 20 30 20 2c 0a 30 20 2c 20 nvers , 0 ,.0 ,
29a0: 69 6e 76 65 72 73 20 2c 0a 69 6e 76 65 72 73 20 invers ,.invers
29b0: 2c 20 30 20 2c 0a 43 72 65 61 74 65 20 38 35 63 , 0 ,.Create 85c
29c0: 6f 6c 6f 72 73 2d 63 6c 0a 79 65 6c 6c 6f 77 20 olors-cl.yellow
29d0: 3e 66 67 20 62 6c 75 65 20 3e 62 67 20 6f 72 20 >fg blue >bg or
29e0: 62 6f 6c 64 20 6f 72 20 2c 20 72 65 64 20 3e 66 bold or , red >f
29f0: 67 20 77 68 69 74 65 20 62 67 7c 20 2c 0a 62 6c g white bg| ,.bl
2a00: 61 63 6b 20 3e 66 67 20 63 79 61 6e 20 62 67 7c ack >fg cyan bg|
2a10: 20 2c 20 67 72 65 65 6e 20 3e 66 67 20 62 6c 61 , green >fg bla
2a20: 63 6b 20 3e 62 67 20 6f 72 20 62 6f 6c 64 20 6f ck >bg or bold o
2a30: 72 20 2c 0a 77 68 69 74 65 20 3e 66 67 20 62 6c r ,.white >fg bl
2a40: 61 63 6b 20 3e 62 67 20 6f 72 20 62 6f 6c 64 20 ack >bg or bold
2a50: 6f 72 20 2c 20 6d 61 67 65 6e 74 61 20 3e 66 67 or , magenta >fg
2a60: 20 79 65 6c 6c 6f 77 20 62 67 7c 20 2c 0a 62 6c yellow bg| ,.bl
2a70: 75 65 20 3e 66 67 20 79 65 6c 6c 6f 77 20 62 67 ue >fg yellow bg
2a80: 7c 20 2c 20 63 79 61 6e 20 3e 66 67 20 72 65 64 | , cyan >fg red
2a90: 20 3e 62 67 20 6f 72 20 62 6f 6c 64 20 6f 72 20 >bg or bold or
2aa0: 2c 0a 0a 5b 49 46 44 45 46 5d 20 67 6c 2d 74 79 ,..[IFDEF] gl-ty
2ab0: 70 65 20 38 35 63 6f 6c 6f 72 73 2d 63 6c 20 5b pe 85colors-cl [
2ac0: 45 4c 53 45 5d 20 38 35 63 6f 6c 6f 72 73 2d 62 ELSE] 85colors-b
2ad0: 77 20 5b 54 48 45 4e 5d 20 56 61 6c 75 65 20 38 w [THEN] Value 8
2ae0: 35 63 6f 6c 6f 72 73 0a 0a 3a 20 2e 73 74 72 69 5colors..: .stri
2af0: 70 65 38 35 20 28 20 61 64 64 72 20 75 20 2d 2d pe85 ( addr u --
2b00: 20 29 20 20 30 20 2d 72 6f 74 20 62 6f 75 6e 64 ) 0 -rot bound
2b10: 73 20 3f 44 4f 0a 09 64 75 70 20 63 65 6c 6c 73 s ?DO..dup cells
2b20: 20 38 35 63 6f 6c 6f 72 73 20 2b 20 40 20 61 74 85colors + @ at
2b30: 74 72 21 20 31 2b 0a 09 49 20 34 20 38 35 74 79 tr! 1+..I 4 85ty
2b40: 70 65 20 20 64 75 70 20 63 65 6c 6c 73 20 38 35 pe dup cells 85
2b50: 63 6f 6c 6f 72 73 20 2b 20 40 20 61 74 74 72 21 colors + @ attr!
2b60: 20 31 2b 0a 20 20 20 20 49 20 34 20 2b 20 34 20 1+. I 4 + 4
2b70: 38 35 74 79 70 65 20 3c 64 65 66 61 75 6c 74 3e 85type <default>
2b80: 20 63 72 20 38 20 2b 4c 4f 4f 50 20 20 64 72 6f cr 8 +LOOP dro
2b90: 70 20 3b 0a 3a 20 2e 69 6d 70 6f 72 74 38 35 20 p ;.: .import85
2ba0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 ( addr u -- ).
2bb0: 20 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e ke-imports @ >
2bc0: 69 6d 2d 63 6f 6c 6f 72 20 38 35 74 79 70 65 20 im-color 85type
2bd0: 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 3a 20 2e 72 <default> ;.: .r
2be0: 73 6b 20 28 20 6e 69 63 6b 20 75 20 2d 2d 20 29 sk ( nick u -- )
2bf0: 0a 20 20 20 20 73 6b 72 65 76 20 24 32 30 20 2e . skrev $20 .
2c00: 73 74 72 69 70 65 38 35 20 73 70 61 63 65 20 74 stripe85 space t
2c10: 79 70 65 20 2e 22 20 20 28 6b 65 65 70 20 6f 66 ype ." (keep of
2c20: 66 6c 69 6e 65 20 63 6f 70 79 21 29 22 20 63 72 fline copy!)" cr
2c30: 20 3b 0a 3a 20 2e 6b 65 79 20 28 20 61 64 64 72 ;.: .key ( addr
2c40: 20 75 20 2d 2d 20 29 20 64 72 6f 70 20 63 65 6c u -- ) drop cel
2c50: 6c 2b 20 3e 6f 0a 20 20 20 20 2e 22 20 6e 69 63 l+ >o. ." nic
2c60: 6b 3a 20 20 20 22 20 2e 6e 69 63 6b 20 63 72 0a k: " .nick cr.
2c70: 20 20 20 20 2e 22 20 70 75 62 6b 65 79 3a 20 22 ." pubkey: "
2c80: 20 6b 65 2d 70 6b 20 24 40 20 38 35 74 79 70 65 ke-pk $@ 85type
2c90: 20 63 72 0a 20 20 20 20 6b 65 2d 73 6b 20 40 20 cr. ke-sk @
2ca0: 49 46 0a 09 2e 22 20 73 65 63 6b 65 79 3a 20 22 IF..." seckey: "
2cb0: 20 6b 65 2d 73 6b 20 73 65 63 40 20 2e 62 6c 61 ke-sk sec@ .bla
2cc0: 63 6b 38 35 20 2e 22 20 20 28 6b 65 65 70 20 73 ck85 ." (keep s
2cd0: 65 63 72 65 74 21 29 22 20 63 72 20 20 54 48 45 ecret!)" cr THE
2ce0: 4e 0a 20 20 20 20 2e 22 20 76 61 6c 69 64 3a 20 N. ." valid:
2cf0: 20 22 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 " ke-selfsig $@
2d00: 20 2e 73 69 67 64 61 74 65 73 20 63 72 0a 20 20 .sigdates cr.
2d10: 20 20 2e 22 20 67 72 6f 75 70 73 3a 20 22 20 6b ." groups: " k
2d20: 65 2d 67 72 6f 75 70 73 20 24 40 20 2e 69 6e 2d e-groups $@ .in-
2d30: 67 72 6f 75 70 73 20 63 72 0a 20 20 20 20 2e 22 groups cr. ."
2d40: 20 70 65 72 6d 3a 20 20 20 22 20 6b 65 2d 6d 61 perm: " ke-ma
2d50: 73 6b 20 40 20 2e 70 65 72 6d 20 63 72 0a 20 20 sk @ .perm cr.
2d60: 20 20 6f 3e 20 3b 0a 3a 20 2e 6b 65 79 2d 72 65 o> ;.: .key-re
2d70: 73 74 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a st ( o:key -- o:
2d80: 6b 65 79 20 29 0a 20 20 20 20 6b 65 2d 70 6b 20 key ). ke-pk
2d90: 24 40 20 6b 65 79 7c 20 2e 69 6d 70 6f 72 74 38 $@ key| .import8
2da0: 35 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 5. ke-selfsig
2db0: 20 24 40 20 73 70 61 63 65 20 2e 73 69 67 64 61 $@ space .sigda
2dc0: 74 65 73 0a 20 20 20 20 6b 65 2d 67 72 6f 75 70 tes. ke-group
2dd0: 73 20 24 40 20 32 64 75 70 20 2e 69 6e 2d 67 72 s $@ 2dup .in-gr
2de0: 6f 75 70 73 20 67 72 6f 75 70 73 3e 6d 61 73 6b oups groups>mask
2df0: 20 69 6e 76 65 72 74 0a 20 20 20 20 73 70 61 63 invert. spac
2e00: 65 20 6b 65 2d 6d 61 73 6b 20 40 20 61 6e 64 20 e ke-mask @ and
2e10: 2d 31 20 73 77 61 70 20 2e 70 65 72 6d 61 6e 64 -1 swap .permand
2e20: 6f 72 0a 20 20 20 20 23 74 61 62 20 65 6d 69 74 or. #tab emit
2e30: 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 2e 69 ke-imports @ .i
2e40: 6d 70 6f 72 74 73 0a 20 20 20 20 73 70 61 63 65 mports. space
2e50: 20 2e 6e 69 63 6b 2b 70 65 74 20 3b 0a 3a 20 2e .nick+pet ;.: .
2e60: 6b 65 79 2d 6c 69 73 74 20 28 20 6f 3a 6b 65 79 key-list ( o:key
2e70: 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 -- o:key ).
2e80: 6b 65 2d 6f 66 66 73 65 74 20 36 34 40 20 36 34 ke-offset 64@ 64
2e90: 3e 64 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 >d keypack-all#
2ea0: 66 6d 2f 6d 6f 64 20 6e 69 70 20 33 20 2e 72 20 fm/mod nip 3 .r
2eb0: 73 70 61 63 65 0a 20 20 20 20 2e 6b 65 79 2d 72 space. .key-r
2ec0: 65 73 74 20 63 72 20 3b 0a 3a 20 2e 73 65 63 72 est cr ;.: .secr
2ed0: 65 74 2d 6e 69 63 6b 73 20 28 20 2d 2d 20 29 0a et-nicks ( -- ).
2ee0: 20 20 20 20 30 20 6b 65 79 23 20 5b 3a 20 63 65 0 key# [: ce
2ef0: 6c 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 6c 6c ll+ $@ drop cell
2f00: 2b 20 3e 6f 20 6b 65 2d 73 6b 20 40 20 49 46 0a + >o ke-sk @ IF.
2f10: 09 20 20 5b 3a 20 64 75 70 20 31 20 2e 72 20 3b . [: dup 1 .r ;
2f20: 5d 20 23 33 36 20 62 61 73 65 2d 65 78 65 63 75 ] #36 base-execu
2f30: 74 65 20 73 70 61 63 65 20 2e 6b 65 79 2d 72 65 te space .key-re
2f40: 73 74 20 63 72 20 31 2b 0a 20 20 20 20 20 20 54 st cr 1+. T
2f50: 48 45 4e 20 6f 3e 20 3b 5d 20 23 6d 61 70 20 64 HEN o> ;] #map d
2f60: 72 6f 70 20 3b 0a 3a 20 2e 6b 65 79 2d 69 6e 76 rop ;.: .key-inv
2f70: 69 74 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f ite ( o:key -- o
2f80: 3a 6b 65 79 20 29 0a 20 20 20 20 6b 65 2d 70 6b :key ). ke-pk
2f90: 20 24 40 20 6b 65 79 73 69 7a 65 20 75 6d 69 6e $@ keysize umin
2fa0: 0a 20 20 20 20 6b 65 2d 69 6d 70 6f 72 74 73 20 . ke-imports
2fb0: 40 20 3e 69 6d 2d 63 6f 6c 6f 72 20 38 35 74 79 @ >im-color 85ty
2fc0: 70 65 20 3c 64 65 66 61 75 6c 74 3e 0a 20 20 20 pe <default>.
2fd0: 20 73 70 61 63 65 20 2e 6e 69 63 6b 20 73 70 61 space .nick spa
2fe0: 63 65 20 3b 0a 3a 20 2e 6b 65 79 2d 73 68 6f 72 ce ;.: .key-shor
2ff0: 74 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b t ( o:key -- o:k
3000: 65 79 20 29 0a 20 20 20 20 6b 65 2d 6e 69 63 6b ey ). ke-nick
3010: 20 24 2e 20 6b 65 2d 70 72 6f 66 20 24 40 6c 65 $. ke-prof $@le
3020: 6e 20 49 46 20 2e 22 20 20 70 72 6f 66 69 6c 65 n IF ." profile
3030: 3a 20 22 20 6b 65 2d 70 72 6f 66 20 24 40 20 38 : " ke-prof $@ 8
3040: 35 74 79 70 65 20 54 48 45 4e 20 3b 0a 3a 20 6c 5type THEN ;.: l
3050: 69 73 74 2d 6b 65 79 73 20 28 20 2d 2d 20 29 0a ist-keys ( -- ).
3060: 20 20 20 20 2e 22 20 6e 75 6d 20 70 75 62 6b 65 ." num pubke
3070: 79 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 y
3080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3090: 20 20 20 20 64 61 74 65 20 20 20 20 20 20 20 20 date
30a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 67 72 70 grp
30b0: 2b 70 65 72 6d 09 68 20 6e 69 63 6b 22 20 63 72 +perm.h nick" cr
30c0: 0a 20 20 20 20 6b 65 79 23 20 5b 3a 20 63 65 6c . key# [: cel
30d0: 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b l+ $@ drop cell+
30e0: 20 2e 2e 6b 65 79 2d 6c 69 73 74 20 3b 5d 20 23 ..key-list ;] #
30f0: 6d 61 70 20 3b 0a 3a 20 6c 69 73 74 2d 6e 69 63 map ;.: list-nic
3100: 6b 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 6e 69 ks ( -- ). ni
3110: 63 6b 23 20 5b 3a 20 64 75 70 20 24 2e 20 2e 22 ck# [: dup $. ."
3120: 20 3a 22 20 63 72 20 63 65 6c 6c 2b 20 24 40 20 :" cr cell+ $@
3130: 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 20 20 49 20 bounds ?DO.. I
3140: 40 20 2e 2e 6b 65 79 2d 6c 69 73 74 20 20 63 65 @ ..key-list ce
3150: 6c 6c 20 2b 4c 4f 4f 50 20 3b 5d 20 23 6d 61 70 ll +LOOP ;] #map
3160: 20 3b 0a 0a 3a 20 64 75 6d 70 6b 65 79 20 28 20 ;..: dumpkey (
3170: 61 64 64 72 20 75 20 2d 2d 20 29 20 64 72 6f 70 addr u -- ) drop
3180: 20 63 65 6c 6c 2b 20 3e 6f 0a 20 20 20 20 2e 5c cell+ >o. .\
3190: 22 20 78 5c 22 20 22 20 6b 65 2d 70 6b 20 24 40 " x\" " ke-pk $@
31a0: 20 38 35 74 79 70 65 20 2e 5c 22 20 5c 22 20 6b 85type .\" \" k
31b0: 65 79 3f 6e 65 77 22 20 63 72 0a 20 20 20 20 6b ey?new" cr. k
31c0: 65 2d 73 6b 20 40 20 49 46 20 20 2e 5c 22 20 78 e-sk @ IF .\" x
31d0: 5c 22 20 22 20 6b 65 2d 73 6b 20 40 20 6b 65 79 \" " ke-sk @ key
31e0: 73 69 7a 65 20 38 35 74 79 70 65 20 2e 5c 22 20 size 85type .\"
31f0: 5c 22 20 6b 65 2d 73 6b 20 73 65 63 21 20 2b 73 \" ke-sk sec! +s
3200: 65 63 6b 65 79 22 20 63 72 20 20 54 48 45 4e 0a eckey" cr THEN.
3210: 20 20 20 20 27 22 27 20 65 6d 69 74 20 2e 6e 69 '"' emit .ni
3220: 63 6b 20 2e 5c 22 20 5c 22 20 6b 65 2d 6e 69 63 ck .\" \" ke-nic
3230: 6b 20 24 21 20 22 0a 20 20 20 20 6b 65 2d 73 65 k $! ". ke-se
3240: 6c 66 73 69 67 20 24 40 20 64 72 6f 70 20 36 34 lfsig $@ drop 64
3250: 40 20 36 34 3e 64 20 5b 3a 20 27 24 27 20 65 6d @ 64>d [: '$' em
3260: 69 74 20 30 20 75 64 2e 72 20 3b 5d 20 24 31 30 it 0 ud.r ;] $10
3270: 20 62 61 73 65 2d 65 78 65 63 75 74 65 0a 20 20 base-execute.
3280: 20 20 2e 22 20 2e 20 64 3e 36 34 20 6b 65 2d 66 ." . d>64 ke-f
3290: 69 72 73 74 21 20 22 20 6b 65 2d 74 79 70 65 20 irst! " ke-type
32a0: 40 20 2e 20 2e 22 20 6b 65 2d 74 79 70 65 20 21 @ . ." ke-type !
32b0: 22 20 20 63 72 20 6f 3e 20 3b 0a 0a 3a 20 2e 6b " cr o> ;..: .k
32c0: 65 79 73 20 28 20 2d 2d 20 29 20 6b 65 79 23 20 eys ( -- ) key#
32d0: 5b 3a 20 2e 22 20 69 6e 64 65 78 3a 20 22 20 64 [: ." index: " d
32e0: 75 70 20 24 40 20 38 35 74 79 70 65 20 63 72 20 up $@ 85type cr
32f0: 63 65 6c 6c 2b 20 24 40 20 2e 6b 65 79 20 3b 5d cell+ $@ .key ;]
3300: 20 23 6d 61 70 20 3b 0a 3a 20 64 75 6d 70 6b 65 #map ;.: dumpke
3310: 79 73 20 28 20 2d 2d 20 29 20 6b 65 79 23 20 5b ys ( -- ) key# [
3320: 3a 20 63 65 6c 6c 2b 20 24 40 20 64 75 6d 70 6b : cell+ $@ dumpk
3330: 65 79 20 3b 5d 20 23 6d 61 70 20 3b 0a 0a 3a 20 ey ;] #map ;..:
3340: 6b 65 79 3e 6e 69 63 6b 20 28 20 61 64 64 72 6b key>nick ( addrk
3350: 65 79 20 75 31 20 2d 2d 20 6e 69 63 6b 20 75 32 ey u1 -- nick u2
3360: 20 29 0a 20 20 20 20 5c 47 20 63 6f 6e 76 65 72 ). \G conver
3370: 74 20 6b 65 79 20 74 6f 20 6e 69 63 6b 0a 20 20 t key to nick.
3380: 20 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 30 key| key# #@ 0
3390: 3d 20 49 46 20 20 64 72 6f 70 20 23 30 2e 20 20 = IF drop #0.
33a0: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 63 EXIT THEN. c
33b0: 65 6c 6c 2b 20 2e 6b 65 2d 6e 69 63 6b 20 24 40 ell+ .ke-nick $@
33c0: 20 3b 0a 3a 20 6b 65 79 3e 6b 65 79 20 28 20 61 ;.: key>key ( a
33d0: 64 64 72 6b 65 79 20 75 31 20 2d 2d 20 6b 65 79 ddrkey u1 -- key
33e0: 20 75 32 20 29 0a 20 20 20 20 5c 47 20 65 78 70 u2 ). \G exp
33f0: 61 6e 64 20 6b 65 79 20 74 6f 20 66 75 6c 6c 20 and key to full
3400: 73 69 7a 65 20 61 6e 64 20 63 68 65 63 6b 20 69 size and check i
3410: 66 20 77 65 20 6b 6e 6f 77 20 69 74 0a 20 20 20 f we know it.
3420: 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 30 3d key| key# #@ 0=
3430: 20 49 46 20 20 64 72 6f 70 20 23 30 2e 20 20 45 IF drop #0. E
3440: 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 63 65 XIT THEN. ce
3450: 6c 6c 2b 20 2e 6b 65 2d 70 6b 20 24 40 20 3b 0a ll+ .ke-pk $@ ;.
3460: 0a 3a 20 2e 6b 65 79 23 20 28 20 61 64 64 72 20 .: .key# ( addr
3470: 75 20 2d 2d 20 29 20 6b 65 79 7c 0a 20 20 20 20 u -- ) key|.
3480: 2e 22 20 4b 65 79 20 27 22 20 6b 65 79 23 20 23 ." Key '" key# #
3490: 40 20 30 3d 20 49 46 20 64 72 6f 70 20 45 58 49 @ 0= IF drop EXI
34a0: 54 20 54 48 45 4e 0a 20 20 20 20 63 65 6c 6c 2b T THEN. cell+
34b0: 20 2e 2e 6e 69 63 6b 20 2e 22 20 27 20 6f 6b 22 ..nick ." ' ok"
34c0: 20 63 72 20 3b 0a 0a 44 65 66 65 72 20 64 68 74 cr ;..Defer dht
34d0: 2d 6e 69 63 6b 3f 0a 65 76 65 6e 74 3a 20 2d 3e -nick?.event: ->
34e0: 73 65 61 72 63 68 2d 6b 65 79 20 20 6b 65 79 7c search-key key|
34f0: 20 6f 76 65 72 20 3e 72 20 64 68 74 2d 6e 69 63 over >r dht-nic
3500: 6b 3f 20 72 3e 20 66 72 65 65 20 74 68 72 6f 77 k? r> free throw
3510: 20 3b 0a 0a 3a 20 2e 75 6e 6b 65 79 2d 69 64 20 ;..: .unkey-id
3520: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 3c 65 ( addr u -- ) <e
3530: 72 72 3e 20 38 20 75 6d 69 6e 20 38 35 74 79 70 rr> 8 umin 85typ
3540: 65 20 2e 22 20 28 75 6e 6b 6e 6f 77 6e 29 22 20 e ." (unknown)"
3550: 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 0a 56 61 72 <default> ;..Var
3560: 69 61 62 6c 65 20 75 6e 6b 65 79 2d 69 64 23 0a iable unkey-id#.
3570: 23 36 30 2e 30 30 30 2e 30 30 30 2e 30 30 30 20 #60.000.000.000
3580: 64 3e 36 34 20 36 34 43 6f 6e 73 74 61 6e 74 20 d>64 64Constant
3590: 75 6e 6b 65 79 2d 74 6f 23 0a 3a 20 3f 75 6e 6b unkey-to#.: ?unk
35a0: 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 66 ey ( addr u -- f
35b0: 6c 61 67 20 29 0a 20 20 20 20 75 6e 6b 65 79 2d lag ). unkey-
35c0: 69 64 23 20 23 40 0a 20 20 20 20 49 46 20 20 36 id# #@. IF 6
35d0: 34 40 20 75 6e 6b 65 79 2d 74 6f 23 20 36 34 2b 4@ unkey-to# 64+
35e0: 20 74 69 63 6b 73 20 36 34 2d 20 36 34 2d 30 3e ticks 64- 64-0>
35f0: 3d 20 20 54 48 45 4e 20 20 30 3d 20 3b 0a 20 20 = THEN 0= ;.
3600: 20 20 0a 3a 20 2e 6b 65 79 2d 69 64 20 28 20 61 .: .key-id ( a
3610: 64 64 72 20 75 20 2d 2d 20 29 20 6b 65 79 7c 20 ddr u -- ) key|
3620: 32 64 75 70 20 6b 65 79 23 20 23 40 20 30 3d 0a 2dup key# #@ 0=.
3630: 20 20 20 20 49 46 20 20 64 72 6f 70 20 75 70 40 IF drop up@
3640: 20 72 65 63 65 69 76 65 72 2d 74 61 73 6b 20 3d receiver-task =
3650: 20 49 46 0a 09 20 20 20 20 3c 65 76 65 6e 74 20 IF.. <event
3660: 32 64 75 70 20 73 61 76 65 2d 6d 65 6d 20 65 24 2dup save-mem e$
3670: 2c 20 2d 3e 73 65 61 72 63 68 2d 6b 65 79 20 6d , ->search-key m
3680: 61 69 6e 2d 75 70 40 20 65 76 65 6e 74 3e 0a 09 ain-up@ event>..
3690: 20 20 20 20 2e 75 6e 6b 65 79 2d 69 64 20 45 58 .unkey-id EX
36a0: 49 54 20 20 54 48 45 4e 0a 09 32 64 75 70 20 3f IT THEN..2dup ?
36b0: 75 6e 6b 65 79 20 20 49 46 0a 09 20 20 20 20 74 unkey IF.. t
36c0: 69 63 6b 73 20 7b 20 36 34 5e 20 74 78 20 7d 20 icks { 64^ tx }
36d0: 74 78 20 31 20 36 34 73 20 32 6f 76 65 72 20 75 tx 1 64s 2over u
36e0: 6e 6b 65 79 2d 69 64 23 20 23 21 0a 09 20 20 20 nkey-id# #!..
36f0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 3e 72 20 32 connection >r 2
3700: 64 75 70 20 5b 27 5d 20 64 68 74 2d 6e 69 63 6b dup ['] dht-nick
3710: 3f 20 63 6d 64 2d 6e 65 73 74 20 72 3e 20 74 6f ? cmd-nest r> to
3720: 20 63 6f 6e 6e 65 63 74 69 6f 6e 0a 09 20 20 20 connection..
3730: 20 32 64 75 70 20 6b 65 79 23 20 23 40 20 30 3d 2dup key# #@ 0=
3740: 20 49 46 20 20 64 72 6f 70 20 2e 75 6e 6b 65 79 IF drop .unkey
3750: 2d 69 64 20 45 58 49 54 0a 09 20 20 20 20 45 4c -id EXIT.. EL
3760: 53 45 20 20 3e 72 20 32 64 75 70 20 75 6e 6b 65 SE >r 2dup unke
3770: 79 2d 69 64 23 20 23 6f 66 66 20 72 3e 20 20 54 y-id# #off r> T
3780: 48 45 4e 0a 09 45 4c 53 45 20 20 2e 75 6e 6b 65 HEN..ELSE .unke
3790: 79 2d 69 64 20 20 45 58 49 54 20 20 54 48 45 4e y-id EXIT THEN
37a0: 0a 20 20 20 20 54 48 45 4e 0a 20 20 20 20 63 65 . THEN. ce
37b0: 6c 6c 2b 20 2e 2e 6e 69 63 6b 20 32 64 72 6f 70 ll+ ..nick 2drop
37c0: 20 3b 0a 0a 3a 20 2e 63 6f 6e 2d 69 64 20 28 20 ;..: .con-id (
37d0: 6f 3a 63 6f 6e 6e 65 63 74 69 6f 6e 20 2d 2d 20 o:connection --
37e0: 29 20 70 75 62 6b 65 79 20 24 40 20 2e 6b 65 79 ) pubkey $@ .key
37f0: 2d 69 64 20 3b 0a 0a 3a 20 2e 73 69 6d 70 6c 65 -id ;..: .simple
3800: 2d 69 64 20 28 20 61 64 64 72 20 75 20 2d 2d 20 -id ( addr u --
3810: 29 20 6b 65 79 3e 6e 69 63 6b 20 74 79 70 65 20 ) key>nick type
3820: 3b 0a 0a 3a 20 63 68 65 63 6b 2d 6b 65 79 20 28 ;..: check-key (
3830: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 addr u -- ).
3840: 20 6f 20 49 46 20 20 70 75 62 6b 65 79 20 40 20 o IF pubkey @
3850: 49 46 0a 09 20 20 20 20 32 64 75 70 20 70 75 62 IF.. 2dup pub
3860: 6b 65 79 20 24 40 20 6b 65 79 7c 20 73 74 72 3d key $@ key| str=
3870: 20 30 3d 20 49 46 0a 09 09 5b 3a 20 2e 22 20 77 0= IF...[: ." w
3880: 61 6e 74 3a 20 22 20 70 75 62 6b 65 79 20 24 40 ant: " pubkey $@
3890: 20 6b 65 79 7c 20 38 35 74 79 70 65 20 63 72 0a key| 85type cr.
38a0: 09 09 20 20 2e 22 20 67 6f 74 20 3a 20 22 20 32 .. ." got : " 2
38b0: 64 75 70 20 38 35 74 79 70 65 20 63 72 20 3b 5d dup 85type cr ;]
38c0: 20 24 65 72 72 0a 09 09 74 72 75 65 20 21 21 77 $err...true !!w
38d0: 72 6f 6e 67 2d 6b 65 79 21 21 0a 09 20 20 20 20 rong-key!!..
38e0: 54 48 45 4e 0a 09 20 20 20 20 63 6f 6e 6e 65 63 THEN.. connec
38f0: 74 28 20 2e 6b 65 79 23 20 29 65 6c 73 65 28 20 t( .key# )else(
3900: 32 64 72 6f 70 20 29 20 20 45 58 49 54 0a 09 54 2drop ) EXIT..T
3910: 48 45 4e 20 20 54 48 45 4e 0a 20 20 20 20 32 64 HEN THEN. 2d
3920: 75 70 20 6b 65 79 2d 65 78 69 73 74 3f 0a 20 20 up key-exist?.
3930: 20 20 3f 64 75 70 2d 30 3d 2d 49 46 20 20 70 65 ?dup-0=-IF pe
3940: 72 6d 25 75 6e 6b 6e 6f 77 6e 20 20 45 4c 53 45 rm%unknown ELSE
3950: 20 20 2e 6b 65 2d 6d 61 73 6b 20 40 20 20 54 48 .ke-mask @ TH
3960: 45 4e 20 20 74 6d 70 2d 70 65 72 6d 20 21 0a 20 EN tmp-perm !.
3970: 20 20 20 63 6f 6e 6e 65 63 74 28 20 32 64 75 70 connect( 2dup
3980: 20 2e 6b 65 79 23 20 29 0a 20 20 20 20 74 6d 70 .key# ). tmp
3990: 2d 70 65 72 6d 20 40 20 70 65 72 6d 25 62 6c 6f -perm @ perm%blo
39a0: 63 6b 65 64 20 61 6e 64 20 49 46 0a 09 5b 3a 20 cked and IF..[:
39b0: 2e 22 20 55 6e 6b 6e 6f 77 6e 20 6b 65 79 2c 20 ." Unknown key,
39c0: 63 6f 6e 6e 65 63 74 69 6f 6e 20 72 65 66 75 73 connection refus
39d0: 65 64 3a 20 22 20 38 35 74 79 70 65 20 63 72 20 ed: " 85type cr
39e0: 3b 5d 20 24 65 72 72 0a 09 74 72 75 65 20 21 21 ;] $err..true !!
39f0: 63 6f 6e 6e 65 63 74 2d 70 65 72 6d 21 21 0a 20 connect-perm!!.
3a00: 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 ELSE 2drop
3a10: 54 48 45 4e 20 3b 0a 0a 3a 20 73 65 61 72 63 68 THEN ;..: search
3a20: 2d 6b 65 79 20 28 20 70 6b 63 20 2d 2d 20 73 6b -key ( pkc -- sk
3a30: 63 20 29 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 c ). keysize
3a40: 6b 65 79 23 20 23 40 20 30 3d 20 21 21 75 6e 6b key# #@ 0= !!unk
3a50: 6e 6f 77 6e 2d 6b 65 79 21 21 0a 20 20 20 20 63 nown-key!!. c
3a60: 65 6c 6c 2b 20 2e 6b 65 2d 73 6b 20 73 65 63 40 ell+ .ke-sk sec@
3a70: 20 30 3d 20 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 0= !!unknown-ke
3a80: 79 21 21 20 3b 0a 0a 5c 20 61 70 70 6c 79 20 70 y!! ;..\ apply p
3a90: 65 72 6d 69 73 73 69 6f 6e 73 26 67 72 6f 75 70 ermissions&group
3aa0: 73 0a 0a 3a 20 61 70 70 6c 79 2d 70 65 72 6d 69 s..: apply-permi
3ab0: 73 73 69 6f 6e 20 28 20 70 65 72 6d 61 6e 64 20 ssion ( permand
3ac0: 70 65 72 6d 6f 72 20 6f 3a 6b 65 79 20 2d 2d 20 permor o:key --
3ad0: 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72 20 6f permand permor o
3ae0: 3a 6b 65 79 20 29 0a 20 20 20 20 6f 76 65 72 20 :key ). over
3af0: 6b 65 2d 6d 61 73 6b 20 40 20 61 6e 64 20 6f 76 ke-mask @ and ov
3b00: 65 72 20 6f 72 20 6b 65 2d 6d 61 73 6b 20 21 20 er or ke-mask !
3b10: 2e 6b 65 79 2d 6c 69 73 74 20 3b 0a 0a 3a 20 2d .key-list ;..: -
3b20: 67 72 6f 75 70 2d 70 65 72 6d 20 28 20 6f 3a 6b group-perm ( o:k
3b30: 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 67 ey -- ). ke-g
3b40: 72 6f 75 70 73 20 24 40 20 67 72 6f 75 70 73 3e roups $@ groups>
3b50: 6d 61 73 6b 20 69 6e 76 65 72 74 20 6b 65 2d 6d mask invert ke-m
3b60: 61 73 6b 20 61 6e 64 21 20 3b 0a 3a 20 2b 67 72 ask and! ;.: +gr
3b70: 6f 75 70 2d 70 65 72 6d 20 28 20 6f 3a 6b 65 79 oup-perm ( o:key
3b80: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 67 72 6f -- ). ke-gro
3b90: 75 70 73 20 24 40 20 67 72 6f 75 70 73 3e 6d 61 ups $@ groups>ma
3ba0: 73 6b 20 20 20 20 20 20 20 20 6b 65 2d 6d 61 73 sk ke-mas
3bb0: 6b 20 6f 72 21 20 3b 0a 0a 3a 20 61 64 64 2d 67 k or! ;..: add-g
3bc0: 72 6f 75 70 20 28 20 69 64 20 6f 3a 6b 65 79 20 roup ( id o:key
3bd0: 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 2d 31 20 -- ). dup -1
3be0: 3d 20 21 21 6e 6f 2d 67 72 6f 75 70 21 21 20 2d = !!no-group!! -
3bf0: 67 72 6f 75 70 2d 70 65 72 6d 20 63 6d 64 74 6d group-perm cmdtm
3c00: 70 24 20 6b 65 2d 67 72 6f 75 70 73 20 24 2b 21 p$ ke-groups $+!
3c10: 20 2b 67 72 6f 75 70 2d 70 65 72 6d 20 3b 0a 3a +group-perm ;.:
3c20: 20 73 65 74 2d 67 72 6f 75 70 20 28 20 69 64 20 set-group ( id
3c30: 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 64 o:key -- ). d
3c40: 75 70 20 2d 31 20 3d 20 21 21 6e 6f 2d 67 72 6f up -1 = !!no-gro
3c50: 75 70 21 21 20 2d 67 72 6f 75 70 2d 70 65 72 6d up!! -group-perm
3c60: 20 63 6d 64 74 6d 70 24 20 6b 65 2d 67 72 6f 75 cmdtmp$ ke-grou
3c70: 70 73 20 24 21 20 2b 67 72 6f 75 70 2d 70 65 72 ps $! +group-per
3c80: 6d 20 3b 0a 3a 20 73 75 62 2d 67 72 6f 75 70 20 m ;.: sub-group
3c90: 28 20 69 64 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a ( id o:key -- ).
3ca0: 20 20 20 20 64 75 70 20 2d 31 20 3d 20 21 21 6e dup -1 = !!n
3cb0: 6f 2d 67 72 6f 75 70 21 21 20 2d 67 72 6f 75 70 o-group!! -group
3cc0: 2d 70 65 72 6d 20 63 6d 64 74 6d 70 24 20 6b 65 -perm cmdtmp$ ke
3cd0: 2d 67 72 6f 75 70 73 20 24 40 20 32 6f 76 65 72 -groups $@ 2over
3ce0: 20 73 65 61 72 63 68 0a 20 20 20 20 49 46 20 20 search. IF
3cf0: 20 6e 69 70 20 3e 72 20 6e 69 70 20 6b 65 2d 67 nip >r nip ke-g
3d00: 72 6f 75 70 73 20 64 75 70 20 24 40 6c 65 6e 20 roups dup $@len
3d10: 72 3e 20 2d 20 72 6f 74 20 24 64 65 6c 0a 20 20 r> - rot $del.
3d20: 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 32 64 ELSE 2drop 2d
3d30: 72 6f 70 20 20 54 48 45 4e 20 2b 67 72 6f 75 70 rop THEN +group
3d40: 2d 70 65 72 6d 20 3b 0a 0a 3a 20 61 70 70 6c 79 -perm ;..: apply
3d50: 2d 67 72 6f 75 70 20 28 20 61 64 64 72 20 75 20 -group ( addr u
3d60: 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6f o:key -- ). o
3d70: 76 65 72 20 63 40 20 27 2b 27 20 3d 20 49 46 20 ver c@ '+' = IF
3d80: 20 31 20 2f 73 74 72 69 6e 67 20 3e 67 72 6f 75 1 /string >grou
3d90: 70 2d 69 64 20 61 64 64 2d 67 72 6f 75 70 20 2e p-id add-group .
3da0: 6b 65 79 2d 6c 69 73 74 20 20 45 58 49 54 20 20 key-list EXIT
3db0: 54 48 45 4e 0a 20 20 20 20 6f 76 65 72 20 63 40 THEN. over c@
3dc0: 20 27 2d 27 20 3d 20 49 46 20 20 31 20 2f 73 74 '-' = IF 1 /st
3dd0: 72 69 6e 67 20 3e 67 72 6f 75 70 2d 69 64 20 73 ring >group-id s
3de0: 75 62 2d 67 72 6f 75 70 20 2e 6b 65 79 2d 6c 69 ub-group .key-li
3df0: 73 74 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 st EXIT THEN.
3e00: 20 20 20 3e 67 72 6f 75 70 2d 69 64 20 73 65 74 >group-id set
3e10: 2d 67 72 6f 75 70 20 2e 6b 65 79 2d 6c 69 73 74 -group .key-list
3e20: 20 3b 0a 0a 5c 20 67 65 74 20 70 61 73 73 70 68 ;..\ get passph
3e30: 72 61 73 65 0a 0a 33 20 56 61 6c 75 65 20 70 61 rase..3 Value pa
3e40: 73 73 70 68 72 61 73 65 2d 72 65 74 72 79 23 0a ssphrase-retry#.
3e50: 24 31 30 30 20 43 6f 6e 73 74 61 6e 74 20 6d 61 $100 Constant ma
3e60: 78 2d 70 61 73 73 70 68 72 61 73 65 23 20 5c 20 x-passphrase# \
3e70: 32 35 36 20 63 68 61 72 61 63 74 65 72 73 20 73 256 characters s
3e80: 68 6f 75 6c 64 20 62 65 20 65 6e 6f 75 67 68 2e hould be enough.
3e90: 2e 2e 0a 6d 61 78 2d 70 61 73 73 70 68 72 61 73 ...max-passphras
3ea0: 65 23 20 62 75 66 66 65 72 3a 20 70 61 73 73 70 e# buffer: passp
3eb0: 68 72 61 73 65 0a 0a 3a 20 70 61 73 73 70 68 72 hrase..: passphr
3ec0: 61 73 65 2d 69 6e 20 28 20 61 64 64 72 20 75 20 ase-in ( addr u
3ed0: 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 -- addr u ).
3ee0: 22 50 41 53 53 50 48 52 41 53 45 22 20 67 65 74 "PASSPHRASE" get
3ef0: 65 6e 76 20 32 64 75 70 20 64 30 3d 20 49 46 20 env 2dup d0= IF
3f00: 20 32 64 72 6f 70 20 74 79 70 65 0a 09 70 61 73 2drop type..pas
3f10: 73 70 68 72 61 73 65 20 64 75 70 20 6d 61 78 2d sphrase dup max-
3f20: 70 61 73 73 70 68 72 61 73 65 23 20 61 63 63 65 passphrase# acce
3f30: 70 74 2a 20 63 72 0a 20 20 20 20 45 4c 53 45 20 pt* cr. ELSE
3f40: 20 32 6e 69 70 20 20 54 48 45 4e 20 3b 0a 0a 3a 2nip THEN ;..:
3f50: 20 3e 70 61 73 73 70 68 72 61 73 65 20 28 20 61 >passphrase ( a
3f60: 64 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 20 ddr u -- addr u
3f70: 29 0a 20 20 20 20 5c 47 20 63 72 65 61 74 65 20 ). \G create
3f80: 61 20 35 31 32 20 62 69 74 20 68 61 73 68 20 6f a 512 bit hash o
3f90: 66 20 74 68 65 20 70 61 73 73 70 68 72 61 73 65 f the passphrase
3fa0: 0a 20 20 20 20 6e 6f 2d 6b 65 79 20 3e 63 3a 6b . no-key >c:k
3fb0: 65 79 20 63 3a 68 61 73 68 0a 20 20 20 20 6b 65 ey c:hash. ke
3fc0: 63 63 61 6b 2d 70 61 64 64 65 64 20 63 3a 6b 65 ccak-padded c:ke
3fd0: 79 3e 20 6b 65 63 63 61 6b 2d 70 61 64 64 65 64 y> keccak-padded
3fe0: 20 6b 65 63 63 61 6b 23 6d 61 78 20 32 2f 20 3b keccak#max 2/ ;
3ff0: 0a 0a 3a 20 67 65 74 2d 70 61 73 73 70 68 72 61 ..: get-passphra
4000: 73 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 61 se ( addr u -- a
4010: 64 64 72 20 75 20 29 0a 20 20 20 20 70 61 73 73 ddr u ). pass
4020: 70 68 72 61 73 65 2d 69 6e 20 3e 70 61 73 73 70 phrase-in >passp
4030: 68 72 61 73 65 20 3b 0a 0a 56 61 72 69 61 62 6c hrase ;..Variabl
4040: 65 20 6b 65 79 73 0a 0a 3a 20 6c 61 73 74 6b 65 e keys..: lastke
4050: 79 40 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 y@ ( -- addr u )
4060: 20 6b 65 79 73 20 24 5b 5d 23 20 31 2d 20 6b 65 keys $[]# 1- ke
4070: 79 73 20 73 65 63 5b 5d 40 20 3b 0a 3a 20 6b 65 ys sec[]@ ;.: ke
4080: 79 3e 64 65 66 61 75 6c 74 20 28 20 2d 2d 20 29 y>default ( -- )
4090: 20 6c 61 73 74 6b 65 79 40 20 64 72 6f 70 20 3e lastkey@ drop >
40a0: 73 74 6f 72 65 6b 65 79 20 21 20 3b 0a 3a 20 2b storekey ! ;.: +
40b0: 6b 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 key ( addr u --
40c0: 29 20 6b 65 79 73 20 73 65 63 2b 5b 5d 21 20 3b ) keys sec+[]! ;
40d0: 0a 3a 20 2b 70 61 73 73 70 68 72 61 73 65 20 28 .: +passphrase (
40e0: 20 61 64 64 72 20 75 20 2d 2d 20 29 20 20 67 65 addr u -- ) ge
40f0: 74 2d 70 61 73 73 70 68 72 61 73 65 20 2b 6b 65 t-passphrase +ke
4100: 79 20 3b 0a 3a 20 2b 63 68 65 63 6b 70 68 72 61 y ;.: +checkphra
4110: 73 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 66 se ( addr u -- f
4120: 6c 61 67 20 29 20 67 65 74 2d 70 61 73 73 70 68 lag ) get-passph
4130: 72 61 73 65 20 6c 61 73 74 6b 65 79 40 20 73 74 rase lastkey@ st
4140: 72 3d 20 3b 0a 3a 20 2b 6e 65 77 70 68 72 61 73 r= ;.: +newphras
4150: 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 42 45 47 e ( -- ). BEG
4160: 49 4e 0a 09 73 22 20 50 61 73 73 70 68 72 61 73 IN..s" Passphras
4170: 65 3a 20 22 20 2b 70 61 73 73 70 68 72 61 73 65 e: " +passphrase
4180: 0a 09 73 22 20 52 65 74 79 70 65 20 70 6c 73 3a ..s" Retype pls:
4190: 20 22 20 2b 63 68 65 63 6b 70 68 72 61 73 65 20 " +checkphrase
41a0: 30 3d 20 57 48 49 4c 45 0a 09 20 20 20 20 63 72 0= WHILE.. cr
41b0: 20 2e 22 20 20 64 69 64 6e 27 74 20 6d 61 74 63 ." didn't matc
41c0: 68 2c 20 74 72 79 20 61 67 61 69 6e 20 70 6c 65 h, try again ple
41d0: 61 73 65 22 20 63 72 0a 20 20 20 20 52 45 50 45 ase" cr. REPE
41e0: 41 54 20 63 72 20 3b 0a 0a 3a 20 22 3e 70 61 73 AT cr ;..: ">pas
41f0: 73 70 68 72 61 73 65 20 28 20 61 64 64 72 20 75 sphrase ( addr u
4200: 20 2d 2d 20 29 20 3e 70 61 73 73 70 68 72 61 73 -- ) >passphras
4210: 65 20 2b 6b 65 79 20 3b 0a 3a 20 3e 73 65 63 6b e +key ;.: >seck
4220: 65 79 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 ey ( -- addr u )
4230: 0a 20 20 20 20 6b 65 2d 73 6b 20 40 20 6b 65 2d . ke-sk @ ke-
4240: 70 6b 20 24 40 20 64 72 6f 70 20 6b 65 79 70 61 pk $@ drop keypa
4250: 64 20 65 64 2d 64 68 20 3b 0a 3a 20 2b 73 65 63 d ed-dh ;.: +sec
4260: 6b 65 79 20 28 20 2d 2d 20 29 20 3e 73 65 63 6b key ( -- ) >seck
4270: 65 79 20 2b 6b 65 79 20 3b 0a 0a 5c 20 22 22 20 ey +key ;..\ ""
4280: 22 3e 70 61 73 73 70 68 72 61 73 65 20 5c 20 66 ">passphrase \ f
4290: 6f 6c 6c 6f 77 69 6e 67 20 74 68 65 20 65 6e 63 ollowing the enc
42a0: 72 79 70 74 2d 65 76 65 72 79 74 68 69 6e 67 20 rypt-everything
42b0: 70 61 72 61 64 69 67 6d 2c 0a 5c 20 6e 6f 20 70 paradigm,.\ no p
42c0: 61 73 73 77 6f 72 64 20 69 73 20 74 68 65 20 65 assword is the e
42d0: 6d 70 74 79 20 73 74 72 69 6e 67 21 20 20 49 74 mpty string! It
42e0: 27 73 20 73 74 69 6c 6c 20 65 6e 63 72 79 70 74 's still encrypt
42f0: 65 64 20 3b 2d 29 21 0a 0a 5c 20 61 20 73 65 63 ed ;-)!..\ a sec
4300: 72 65 74 20 6b 65 79 20 6a 75 73 74 20 6e 65 65 ret key just nee
4310: 64 73 20 61 20 6e 69 63 6b 20 61 6e 64 20 61 20 ds a nick and a
4320: 74 79 70 65 2e 0a 5c 20 53 65 63 72 65 74 20 6b type..\ Secret k
4330: 65 79 73 20 63 61 6e 20 62 65 20 70 65 72 73 6f eys can be perso
4340: 6e 73 20 61 6e 64 20 67 72 6f 75 70 73 2e 0a 0a ns and groups...
4350: 5c 20 61 20 70 75 62 6c 69 63 20 6b 65 79 20 6e \ a public key n
4360: 65 65 64 73 20 6d 6f 72 65 3a 20 6e 69 63 6b 2c eeds more: nick,
4370: 20 74 79 70 65 2c 20 70 72 6f 66 69 6c 65 2e 0a type, profile..
4380: 5c 20 54 68 65 20 70 72 6f 66 69 6c 65 20 69 73 \ The profile is
4390: 20 61 20 73 74 72 75 63 74 75 72 65 64 20 64 6f a structured do
43a0: 63 75 6d 65 6e 74 2c 20 69 2e 65 2e 20 70 6f 69 cument, i.e. poi
43b0: 6e 74 65 64 20 74 6f 20 62 79 20 61 20 68 61 73 nted to by a has
43c0: 68 2e 0a 0a 5c 20 61 20 73 69 67 6e 61 74 75 72 h...\ a signatur
43d0: 65 20 63 6f 6e 74 61 69 6e 73 20 61 20 70 75 62 e contains a pub
43e0: 6b 65 79 2c 20 61 20 63 68 65 63 6b 62 6f 78 20 key, a checkbox
43f0: 62 69 74 6d 61 73 6b 2c 0a 5c 20 61 20 64 61 74 bitmask,.\ a dat
4400: 65 2c 20 61 6e 20 65 78 70 69 72 61 74 69 6f 6e e, an expiration
4410: 20 64 61 74 65 2c 20 74 68 65 20 73 69 67 6e 65 date, the signe
4420: 72 27 73 20 70 75 62 6b 65 79 20 61 6e 64 20 74 r's pubkey and t
4430: 68 65 20 73 69 67 6e 61 74 75 72 65 20 69 74 73 he signature its
4440: 65 6c 66 0a 5c 20 28 72 2b 73 29 2e 20 20 54 68 elf.\ (r+s). Th
4450: 65 72 65 20 69 73 20 61 6e 20 6f 70 74 69 6f 6e ere is an option
4460: 61 6c 20 73 69 67 6e 69 6e 67 20 70 72 6f 74 6f al signing proto
4470: 63 6f 6c 20 64 6f 63 75 6d 65 6e 74 20 28 68 61 col document (ha
4480: 73 68 29 2e 0a 0a 5c 20 77 65 20 73 74 6f 72 65 sh)...\ we store
4490: 20 65 61 63 68 20 69 74 65 6d 20 69 6e 20 61 20 each item in a
44a0: 32 35 36 20 62 79 74 65 73 20 65 6e 63 72 79 70 256 bytes encryp
44b0: 74 65 64 20 73 74 72 69 6e 67 2c 20 69 2e 65 2e ted string, i.e.
44c0: 20 77 69 74 68 20 61 20 31 36 0a 5c 20 62 79 74 with a 16.\ byt
44d0: 65 20 73 61 6c 74 20 61 6e 64 20 61 20 31 36 20 e salt and a 16
44e0: 62 79 74 65 20 63 68 65 63 6b 73 75 6d 2e 0a 0a byte checksum...
44f0: 3a 20 6b 65 2d 6c 61 73 74 21 20 28 20 36 34 64 : ke-last! ( 64d
4500: 61 74 65 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d ate -- ). ke-
4510: 73 65 6c 66 73 69 67 20 24 40 6c 65 6e 20 24 31 selfsig $@len $1
4520: 30 20 75 6d 61 78 20 6b 65 2d 73 65 6c 66 73 69 0 umax ke-selfsi
4530: 67 20 24 21 6c 65 6e 0a 20 20 20 20 6b 65 2d 73 g $!len. ke-s
4540: 65 6c 66 73 69 67 20 24 40 20 64 72 6f 70 20 36 elfsig $@ drop 6
4550: 34 27 2b 20 36 34 21 20 3b 0a 3a 20 6b 65 2d 66 4'+ 64! ;.: ke-f
4560: 69 72 73 74 21 20 28 20 36 34 64 61 74 65 20 2d irst! ( 64date -
4570: 2d 20 29 20 36 34 23 2d 31 20 6b 65 2d 6c 61 73 - ) 64#-1 ke-las
4580: 74 21 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73 69 t!. ke-selfsi
4590: 67 20 24 40 20 64 72 6f 70 20 36 34 21 20 3b 0a g $@ drop 64! ;.
45a0: 0a 73 63 6f 70 65 7b 20 6e 65 74 32 6f 2d 62 61 .scope{ net2o-ba
45b0: 73 65 0a 0a 63 6d 64 2d 74 61 62 6c 65 20 24 40 se..cmd-table $@
45c0: 20 69 6e 68 65 72 69 74 2d 74 61 62 6c 65 20 6b inherit-table k
45d0: 65 79 2d 65 6e 74 72 79 2d 74 61 62 6c 65 0a 5c ey-entry-table.\
45e0: 67 20 0a 5c 67 20 23 23 23 20 6b 65 79 20 73 74 g .\g ### key st
45f0: 6f 72 61 67 65 20 63 6f 6d 6d 61 6e 64 73 20 23 orage commands #
4600: 23 23 0a 5c 67 20 0a 24 31 31 20 6e 65 74 32 6f ##.\g .$11 net2o
4610: 3a 20 70 72 69 76 6b 65 79 20 28 20 24 3a 73 74 : privkey ( $:st
4620: 72 69 6e 67 20 2d 2d 20 29 0a 20 20 20 20 5c 67 ring -- ). \g
4630: 20 70 72 69 76 61 74 65 20 6b 65 79 0a 20 20 20 private key.
4640: 20 5c 20 64 6f 65 73 20 6e 6f 74 20 6e 65 65 64 \ does not need
4650: 20 74 6f 20 62 65 20 73 69 67 6e 65 64 2c 20 74 to be signed, t
4660: 68 65 20 73 65 63 72 65 74 20 6b 65 79 20 76 65 he secret key ve
4670: 72 69 66 69 65 73 20 69 74 73 65 6c 66 0a 20 20 rifies itself.
4680: 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 34 !!unsigned? $4
4690: 30 20 21 21 3e 3d 6f 72 64 65 72 3f 0a 20 20 20 0 !!>=order?.
46a0: 20 6b 65 79 70 61 63 6b 20 63 40 20 24 46 20 61 keypack c@ $F a
46b0: 6e 64 20 6b 65 2d 70 77 6c 65 76 65 6c 20 21 0a nd ke-pwlevel !.
46c0: 20 20 20 20 24 3e 20 6f 76 65 72 20 6b 65 79 70 $> over keyp
46d0: 61 64 20 73 6b 3e 70 6b 20 5c 20 67 65 6e 65 72 ad sk>pk \ gener
46e0: 61 74 65 20 70 75 62 6b 65 79 0a 20 20 20 20 6b ate pubkey. k
46f0: 65 79 70 61 64 20 6b 65 2d 70 6b 20 24 40 20 64 eypad ke-pk $@ d
4700: 72 6f 70 20 6b 65 79 73 69 7a 65 20 74 75 63 6b rop keysize tuck
4710: 20 73 74 72 3d 20 30 3d 20 21 21 77 72 6f 6e 67 str= 0= !!wrong
4720: 2d 6b 65 79 21 21 0a 20 20 20 20 6b 65 2d 73 6b -key!!. ke-sk
4730: 20 73 65 63 21 20 2b 73 65 63 6b 65 79 20 3b 0a sec! +seckey ;.
4740: 2b 6e 65 74 32 6f 3a 20 6b 65 79 74 79 70 65 20 +net2o: keytype
4750: 28 20 6e 20 2d 2d 20 29 20 20 20 20 20 20 20 20 ( n -- )
4760: 20 20 20 21 21 73 69 67 6e 65 64 3f 20 20 20 31 !!signed? 1
4770: 20 21 21 3e 6f 72 64 65 72 3f 20 36 34 3e 6e 20 !!>order? 64>n
4780: 6b 65 2d 74 79 70 65 20 21 20 3b 0a 20 20 20 20 ke-type ! ;.
4790: 5c 67 20 6b 65 79 20 74 79 70 65 20 28 30 3a 20 \g key type (0:
47a0: 61 6e 6f 6e 2c 20 31 3a 20 75 73 65 72 2c 20 32 anon, 1: user, 2
47b0: 3a 20 67 72 6f 75 70 29 0a 2b 6e 65 74 32 6f 3a : group).+net2o:
47c0: 20 6b 65 79 6e 69 63 6b 20 28 20 24 3a 73 74 72 keynick ( $:str
47d0: 69 6e 67 20 2d 2d 20 29 20 20 20 20 21 21 73 69 ing -- ) !!si
47e0: 67 6e 65 64 3f 20 20 20 32 20 21 21 3e 6f 72 64 gned? 2 !!>ord
47f0: 65 72 3f 20 24 3e 20 6b 65 2d 6e 69 63 6b 20 24 er? $> ke-nick $
4800: 21 0a 20 20 20 20 5c 67 20 6b 65 79 20 6e 69 63 !. \g key nic
4810: 6b 0a 20 20 20 20 6e 69 63 6b 21 20 3b 0a 2b 6e k. nick! ;.+n
4820: 65 74 32 6f 3a 20 6b 65 79 70 72 6f 66 69 6c 65 et2o: keyprofile
4830: 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 ( $:string -- )
4840: 20 21 21 73 69 67 6e 65 64 3f 20 20 20 34 20 21 !!signed? 4 !
4850: 21 3e 6f 72 64 65 72 3f 20 24 3e 20 6b 65 2d 70 !>order? $> ke-p
4860: 72 6f 66 20 24 21 20 3b 0a 20 20 20 20 5c 67 20 rof $! ;. \g
4870: 6b 65 79 20 70 72 6f 66 69 6c 65 20 28 68 61 73 key profile (has
4880: 68 20 6f 66 20 61 20 72 65 73 6f 75 72 63 65 29 h of a resource)
4890: 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 6d 61 73 6b .+net2o: keymask
48a0: 20 28 20 78 20 2d 2d 20 29 20 20 20 20 20 20 20 ( x -- )
48b0: 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 34 !!unsigned? $4
48c0: 30 20 21 21 3e 3d 6f 72 64 65 72 3f 20 36 34 3e 0 !!>=order? 64>
48d0: 6e 0a 20 20 20 20 5c 67 20 6b 65 79 20 61 63 63 n. \g key acc
48e0: 65 73 73 20 72 69 67 68 74 20 6d 61 73 6b 0a 20 ess right mask.
48f0: 20 20 20 31 20 69 6d 70 6f 72 74 2d 74 79 70 65 1 import-type
4900: 20 40 20 6c 73 68 69 66 74 0a 20 20 20 20 5b 20 @ lshift. [
4910: 31 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 6c 73 1 import#self ls
4920: 68 69 66 74 20 31 20 69 6d 70 6f 72 74 23 6e 65 hift 1 import#ne
4930: 77 20 6c 73 68 69 66 74 20 6f 72 20 5d 4c 0a 20 w lshift or ]L.
4940: 20 20 20 61 6e 64 20 49 46 20 20 64 75 70 20 6b and IF dup k
4950: 65 2d 6d 61 73 6b 20 6f 72 21 20 3f 3e 67 72 6f e-mask or! ?>gro
4960: 75 70 73 20 20 45 4c 53 45 20 20 64 72 6f 70 20 ups ELSE drop
4970: 20 54 48 45 4e 20 3b 0a 2b 6e 65 74 32 6f 3a 20 THEN ;.+net2o:
4980: 6b 65 79 67 72 6f 75 70 73 20 28 20 24 3a 67 72 keygroups ( $:gr
4990: 6f 75 70 73 20 2d 2d 20 29 20 21 21 75 6e 73 69 oups -- ) !!unsi
49a0: 67 6e 65 64 3f 20 24 32 30 20 21 21 3e 6f 72 64 gned? $20 !!>ord
49b0: 65 72 3f 20 24 3e 0a 20 20 20 20 5c 67 20 61 63 er? $>. \g ac
49c0: 63 65 73 73 20 67 72 6f 75 70 73 0a 20 20 20 20 cess groups.
49d0: 31 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 40 20 1 import-type @
49e0: 6c 73 68 69 66 74 0a 20 20 20 20 5b 20 31 20 69 lshift. [ 1 i
49f0: 6d 70 6f 72 74 23 73 65 6c 66 20 6c 73 68 69 66 mport#self lshif
4a00: 74 20 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c t 1 import#new l
4a10: 73 68 69 66 74 20 6f 72 20 5d 4c 0a 20 20 20 20 shift or ]L.
4a20: 61 6e 64 20 49 46 20 20 20 32 64 75 70 20 6b 65 and IF 2dup ke
4a30: 2d 67 72 6f 75 70 73 20 24 21 20 67 72 6f 75 70 -groups $! group
4a40: 73 3e 6d 61 73 6b 20 6b 65 2d 6d 61 73 6b 20 21 s>mask ke-mask !
4a50: 0a 20 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70 . ELSE 2drop
4a60: 20 20 54 48 45 4e 20 3b 0a 2b 6e 65 74 32 6f 3a THEN ;.+net2o:
4a70: 20 2b 6b 65 79 73 69 67 20 28 20 24 3a 73 74 72 +keysig ( $:str
4a80: 69 6e 67 20 2d 2d 20 29 20 20 21 21 75 6e 73 69 ing -- ) !!unsi
4a90: 67 6e 65 64 3f 20 24 31 30 20 21 21 3e 3d 6f 72 gned? $10 !!>=or
4aa0: 64 65 72 3f 20 24 3e 20 6b 65 2d 73 69 67 73 20 der? $> ke-sigs
4ab0: 24 2b 5b 5d 21 20 3b 0a 20 20 20 20 5c 67 20 61 $+[]! ;. \g a
4ac0: 64 64 20 61 20 6b 65 79 20 73 69 67 6e 61 74 75 dd a key signatu
4ad0: 72 65 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 69 6d re.+net2o: keyim
4ae0: 70 6f 72 74 20 28 20 6e 20 2d 2d 20 29 20 20 20 port ( n -- )
4af0: 20 20 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 !!unsigned?
4b00: 24 31 30 20 21 21 3e 3d 6f 72 64 65 72 3f 0a 20 $10 !!>=order?.
4b10: 20 20 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76 config:pw-lev
4b20: 65 6c 23 20 40 20 30 3c 20 49 46 20 20 36 34 3e el# @ 0< IF 64>
4b30: 6e 0a 09 64 75 70 20 5b 20 31 20 69 6d 70 6f 72 n..dup [ 1 impor
4b40: 74 23 6e 65 77 20 6c 73 68 69 66 74 20 5d 4c 20 t#new lshift ]L
4b50: 61 6e 64 20 30 3d 20 49 46 0a 09 20 20 20 20 69 and 0= IF.. i
4b60: 6d 70 6f 72 74 23 75 6e 74 72 75 73 74 65 64 20 mport#untrusted
4b70: 75 6d 69 6e 20 31 20 73 77 61 70 20 6c 73 68 69 umin 1 swap lshi
4b80: 66 74 20 5b 20 31 20 69 6d 70 6f 72 74 23 6e 65 ft [ 1 import#ne
4b90: 77 20 6c 73 68 69 66 74 20 5d 4c 20 6f 72 0a 09 w lshift ]L or..
4ba0: 45 4c 53 45 0a 09 20 20 20 20 5b 20 32 20 69 6d ELSE.. [ 2 im
4bb0: 70 6f 72 74 23 75 6e 74 72 75 73 74 65 64 20 6c port#untrusted l
4bc0: 73 68 69 66 74 20 31 2d 20 31 20 69 6d 70 6f 72 shift 1- 1 impor
4bd0: 74 23 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 20 t#new lshift or
4be0: 5d 4c 20 61 6e 64 0a 09 54 48 45 4e 0a 09 6b 65 ]L and..THEN..ke
4bf0: 2d 69 6d 70 6f 72 74 73 20 6f 72 21 0a 20 20 20 -imports or!.
4c00: 20 45 4c 53 45 20 20 36 34 64 72 6f 70 20 20 54 ELSE 64drop T
4c10: 48 45 4e 20 3b 0a 2b 6e 65 74 32 6f 3a 20 72 73 HEN ;.+net2o: rs
4c20: 6b 6b 65 79 20 28 20 24 3a 73 74 72 69 6e 67 20 kkey ( $:string
4c30: 2d 2d 2d 20 29 0a 20 20 20 20 5c 67 20 72 65 76 --- ). \g rev
4c40: 6f 6b 65 20 6b 65 79 2c 20 74 65 6d 70 6f 72 61 oke key, tempora
4c50: 72 69 6c 79 20 73 74 6f 72 65 64 0a 20 20 20 20 rily stored.
4c60: 5c 20 64 6f 65 73 20 6e 6f 74 20 6e 65 65 64 20 \ does not need
4c70: 74 6f 20 62 65 20 73 69 67 6e 65 64 2c 20 74 68 to be signed, th
4c80: 65 20 72 65 76 6f 6b 65 20 6b 65 79 20 76 65 72 e revoke key ver
4c90: 69 66 69 65 73 20 69 74 73 65 6c 66 0a 20 20 20 ifies itself.
4ca0: 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 38 30 !!unsigned? $80
4cb0: 20 21 21 3e 3d 6f 72 64 65 72 3f 0a 20 20 20 20 !!>=order?.
4cc0: 24 3e 20 32 64 75 70 20 73 6b 72 65 76 20 73 77 $> 2dup skrev sw
4cd0: 61 70 20 6b 65 79 7c 20 6d 6f 76 65 20 6b 65 2d ap key| move ke-
4ce0: 70 6b 20 24 40 20 64 72 6f 70 20 63 68 65 63 6b pk $@ drop check
4cf0: 2d 72 65 76 3f 20 30 3d 20 21 21 6e 6f 74 2d 6d -rev? 0= !!not-m
4d00: 79 2d 72 65 76 73 6b 21 21 0a 20 20 20 20 70 6b y-revsk!!. pk
4d10: 72 65 76 20 6b 65 79 73 69 7a 65 32 20 65 72 61 rev keysize2 era
4d20: 73 65 20 20 6b 65 2d 72 73 6b 20 73 65 63 21 20 se ke-rsk sec!
4d30: 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 70 65 74 ;.+net2o: keypet
4d40: 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 ( $:string -- )
4d50: 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 20 24 !!unsigned? $
4d60: 3e 0a 20 20 20 20 63 6f 6e 66 69 67 3a 70 77 2d >. config:pw-
4d70: 6c 65 76 65 6c 23 20 40 20 30 3c 20 49 46 20 20 level# @ 0< IF
4d80: 6b 65 2d 70 65 74 73 20 24 2b 5b 5d 21 20 70 65 ke-pets $+[]! pe
4d90: 74 21 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 t! ELSE 2drop
4da0: 20 54 48 45 4e 20 3b 0a 7d 73 63 6f 70 65 0a 0a THEN ;.}scope..
4db0: 67 65 6e 2d 74 61 62 6c 65 20 24 66 72 65 65 7a gen-table $freez
4dc0: 65 0a 27 20 63 6f 6e 74 65 78 74 2d 74 61 62 6c e.' context-tabl
4dd0: 65 20 69 73 20 67 65 6e 2d 74 61 62 6c 65 0a 0a e is gen-table..
4de0: 3a 20 6b 65 79 3a 6e 65 73 74 2d 73 69 67 20 28 : key:nest-sig (
4df0: 20 61 64 64 72 20 75 20 2d 2d 20 61 64 64 72 20 addr u -- addr
4e00: 75 27 20 66 6c 61 67 20 29 0a 20 20 20 20 70 6b u' flag ). pk
4e10: 32 2d 73 69 67 3f 20 64 75 70 20 3f 45 58 49 54 2-sig? dup ?EXIT
4e20: 20 64 72 6f 70 0a 20 20 20 20 32 64 75 70 20 2b drop. 2dup +
4e30: 20 73 69 67 73 69 7a 65 23 20 2d 20 73 69 67 73 sigsize# - sigs
4e40: 69 7a 65 23 20 3e 24 0a 20 20 20 20 73 69 67 70 ize# >$. sigp
4e50: 6b 32 73 69 7a 65 23 20 2d 20 32 64 75 70 20 2b k2size# - 2dup +
4e60: 20 6b 65 79 73 69 7a 65 32 20 6b 65 79 3f 6e 65 keysize2 key?ne
4e70: 77 20 6e 3a 3e 6f 20 24 3e 20 6b 65 2d 73 65 6c w n:>o $> ke-sel
4e80: 66 73 69 67 20 24 21 0a 20 20 20 20 73 69 6d 2d fsig $!. sim-
4e90: 6e 69 63 6b 21 20 6f 66 66 20 63 2d 73 74 61 74 nick! off c-stat
4ea0: 65 20 6f 66 66 20 73 69 67 2d 6f 6b 20 3b 0a 27 e off sig-ok ;.'
4eb0: 20 6b 65 79 3a 6e 65 73 74 2d 73 69 67 20 6b 65 key:nest-sig ke
4ec0: 79 2d 65 6e 74 72 79 20 74 6f 20 6e 65 73 74 2d y-entry to nest-
4ed0: 73 69 67 0a 0a 73 61 6d 70 6c 65 2d 6b 65 79 20 sig..sample-key
4ee0: 3e 6f 20 6b 65 79 2d 65 6e 74 72 79 2d 74 61 62 >o key-entry-tab
4ef0: 6c 65 20 40 20 74 6f 6b 65 6e 2d 74 61 62 6c 65 le @ token-table
4f00: 20 21 20 6f 3e 0a 0a 3a 20 6b 65 79 3a 63 6f 64 ! o>..: key:cod
4f10: 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 63 6f 64 e ( -- ). cod
4f20: 65 2d 6b 65 79 20 20 63 6d 64 6c 6f 63 6b 20 6c e-key cmdlock l
4f30: 6f 63 6b 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 ock. keypack
4f40: 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 65 72 61 keypack-all# era
4f50: 73 65 0a 20 20 20 20 63 6d 64 72 65 73 65 74 20 se. cmdreset
4f60: 69 6e 69 74 2d 72 65 70 6c 79 20 61 6c 73 6f 20 init-reply also
4f70: 6e 65 74 32 6f 2d 62 61 73 65 20 3b 0a 63 6f 6d net2o-base ;.com
4f80: 70 3a 20 3a 2c 20 61 6c 73 6f 20 6e 65 74 32 6f p: :, also net2o
4f90: 2d 62 61 73 65 20 3b 0a 0a 73 63 6f 70 65 7b 20 -base ;..scope{
4fa0: 6e 65 74 32 6f 2d 62 61 73 65 0a 0a 3a 20 65 6e net2o-base..: en
4fb0: 64 3a 6b 65 79 20 28 20 2d 2d 20 29 0a 20 20 20 d:key ( -- ).
4fc0: 20 65 6e 64 2d 77 69 74 68 20 70 72 65 76 69 6f end-with previo
4fd0: 75 73 20 63 6d 64 6c 6f 63 6b 20 75 6e 6c 6f 63 us cmdlock unloc
4fe0: 6b 20 3b 0a 63 6f 6d 70 3a 20 3a 2c 20 70 72 65 k ;.comp: :, pre
4ff0: 76 69 6f 75 73 20 3b 0a 0a 7d 73 63 6f 70 65 0a vious ;..}scope.
5000: 0a 3a 20 6b 65 79 2d 63 72 79 70 74 20 28 20 2d .: key-crypt ( -
5010: 2d 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 - ). keypack
5020: 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 0a 20 20 20 keypack-all#.
5030: 20 3e 73 74 6f 72 65 6b 65 79 20 73 65 63 40 20 >storekey sec@
5040: 64 75 70 20 24 32 30 20 75 3c 3d 20 5c 20 69 73 dup $20 u<= \ is
5050: 20 61 20 73 65 63 72 65 74 2c 20 6e 6f 20 6e 65 a secret, no ne
5060: 65 64 20 74 6f 20 62 65 20 73 6c 6f 77 0a 20 20 ed to be slow.
5070: 20 20 49 46 20 20 65 6e 63 72 79 70 74 24 20 20 IF encrypt$
5080: 45 4c 53 45 20 20 63 6f 6e 66 69 67 3a 70 77 2d ELSE config:pw-
5090: 6c 65 76 65 6c 23 20 40 20 65 6e 63 72 79 70 74 level# @ encrypt
50a0: 2d 70 77 24 20 20 54 48 45 4e 20 3b 0a 0a 30 20 -pw$ THEN ;..0
50b0: 56 61 6c 75 65 20 6b 65 79 2d 73 66 64 20 5c 20 Value key-sfd \
50c0: 73 65 63 72 65 74 20 6b 65 79 73 0a 30 20 56 61 secret keys.0 Va
50d0: 6c 75 65 20 6b 65 79 2d 70 66 64 20 5c 20 70 75 lue key-pfd \ pu
50e0: 62 6b 65 79 73 0a 0a 5c 20 6c 65 67 61 63 79 20 bkeys..\ legacy
50f0: 66 6f 72 20 65 61 72 6c 79 20 76 65 72 73 69 6f for early versio
5100: 6e 73 20 6f 66 20 6e 65 74 32 6f 20 70 72 69 6f ns of net2o prio
5110: 72 20 32 30 31 36 30 36 30 36 0a 0a 3a 20 6e 65 r 20160606..: ne
5120: 74 32 6f 3e 6b 65 79 73 20 7b 20 61 64 64 72 20 t2o>keys { addr
5130: 75 20 2d 2d 20 7d 0a 20 20 20 20 61 64 64 72 20 u -- }. addr
5140: 75 20 2e 6e 65 74 32 6f 2f 20 20 61 64 64 72 20 u .net2o/ addr
5150: 75 20 2e 6b 65 79 73 2f 20 72 65 6e 61 6d 65 2d u .keys/ rename-
5160: 66 69 6c 65 20 64 72 6f 70 20 3b 0a 3a 20 3f 6c file drop ;.: ?l
5170: 65 67 61 63 79 2d 6b 65 79 73 20 28 20 66 6c 61 egacy-keys ( fla
5180: 67 20 2d 2d 20 29 0a 20 20 20 20 5c 20 21 21 46 g -- ). \ !!F
5190: 49 58 4d 45 21 21 20 6e 65 65 64 73 20 74 6f 20 IXME!! needs to
51a0: 62 65 20 72 65 6d 6f 76 65 64 20 77 68 65 6e 20 be removed when
51b0: 61 6c 6c 20 63 75 72 72 65 6e 74 20 75 73 65 72 all current user
51c0: 73 0a 20 20 20 20 5c 20 68 61 76 65 20 6d 69 67 s. \ have mig
51d0: 72 61 74 65 64 0a 20 20 20 20 49 46 0a 09 22 70 rated. IF.."p
51e0: 75 62 6b 65 79 73 2e 6b 32 6f 22 20 6e 65 74 32 ubkeys.k2o" net2
51f0: 6f 3e 6b 65 79 73 0a 09 22 73 65 63 6b 65 79 73 o>keys.."seckeys
5200: 2e 6b 32 6f 22 20 6e 65 74 32 6f 3e 6b 65 79 73 .k2o" net2o>keys
5210: 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 67 . THEN ;..: g
5220: 65 6e 2d 6b 65 79 73 2d 64 69 72 20 28 20 2d 2d en-keys-dir ( --
5230: 20 29 0a 20 20 20 20 69 6e 69 74 2d 64 69 72 73 ). init-dirs
5240: 20 3f 2e 6e 65 74 32 6f 2f 6b 65 79 73 20 3f 6c ?.net2o/keys ?l
5250: 65 67 61 63 79 2d 6b 65 79 73 20 3b 0a 0a 3a 20 egacy-keys ;..:
5260: 3f 66 64 2d 6b 65 79 73 20 28 20 66 64 20 61 64 ?fd-keys ( fd ad
5270: 64 72 20 75 20 2d 2d 20 66 64 27 20 29 20 7b 20 dr u -- fd' ) {
5280: 61 64 64 72 20 75 20 7d 20 64 75 70 20 3f 45 58 addr u } dup ?EX
5290: 49 54 20 64 72 6f 70 0a 20 20 20 20 67 65 6e 2d IT drop. gen-
52a0: 6b 65 79 73 2d 64 69 72 0a 20 20 20 20 61 64 64 keys-dir. add
52b0: 72 20 75 20 72 2f 77 20 6f 70 65 6e 2d 66 69 6c r u r/w open-fil
52c0: 65 20 64 75 70 20 6e 6f 2d 66 69 6c 65 23 20 3d e dup no-file# =
52d0: 20 49 46 0a 09 32 64 72 6f 70 20 61 64 64 72 20 IF..2drop addr
52e0: 75 20 72 2f 77 20 63 72 65 61 74 65 2d 66 69 6c u r/w create-fil
52f0: 65 0a 20 20 20 20 54 48 45 4e 20 20 74 68 72 6f e. THEN thro
5300: 77 20 3b 0a 0a 3a 20 3f 6b 65 79 2d 73 66 64 20 w ;..: ?key-sfd
5310: 28 20 2d 2d 20 66 64 20 29 0a 20 20 20 20 6b 65 ( -- fd ). ke
5320: 79 2d 73 66 64 20 22 73 65 63 6b 65 79 73 2e 6b y-sfd "seckeys.k
5330: 32 6f 22 20 2e 6b 65 79 73 2f 20 3f 66 64 2d 6b 2o" .keys/ ?fd-k
5340: 65 79 73 20 64 75 70 20 74 6f 20 6b 65 79 2d 73 eys dup to key-s
5350: 66 64 20 3b 0a 3a 20 3f 6b 65 79 2d 70 66 64 20 fd ;.: ?key-pfd
5360: 28 20 2d 2d 20 66 64 20 29 0a 20 20 20 20 6b 65 ( -- fd ). ke
5370: 79 2d 70 66 64 20 22 70 75 62 6b 65 79 73 2e 6b y-pfd "pubkeys.k
5380: 32 6f 22 20 2e 6b 65 79 73 2f 20 3f 66 64 2d 6b 2o" .keys/ ?fd-k
5390: 65 79 73 20 64 75 70 20 74 6f 20 6b 65 79 2d 70 eys dup to key-p
53a0: 66 64 20 3b 0a 0a 3a 20 6b 65 79 3e 73 66 69 6c fd ;..: key>sfil
53b0: 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 e ( -- ). key
53c0: 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c pack keypack-all
53d0: 23 20 3f 6b 65 79 2d 73 66 64 20 61 70 70 65 6e # ?key-sfd appen
53e0: 64 2d 66 69 6c 65 20 6b 65 2d 6f 66 66 73 65 74 d-file ke-offset
53f0: 20 36 34 21 20 3b 0a 3a 20 6b 65 79 3e 70 66 69 64! ;.: key>pfi
5400: 6c 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 le ( -- ). ke
5410: 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 6c ypack keypack-al
5420: 6c 23 20 3f 6b 65 79 2d 70 66 64 20 61 70 70 65 l# ?key-pfd appe
5430: 6e 64 2d 66 69 6c 65 20 6b 65 2d 6f 66 66 73 65 nd-file ke-offse
5440: 74 20 36 34 21 20 3b 0a 0a 3a 20 6b 65 79 3e 73 t 64! ;..: key>s
5450: 66 69 6c 65 40 70 6f 73 20 28 20 36 34 70 6f 73 file@pos ( 64pos
5460: 20 2d 2d 20 29 20 36 34 64 75 70 20 36 34 23 2d -- ) 64dup 64#-
5470: 31 20 36 34 3d 20 49 46 20 20 36 34 64 72 6f 70 1 64= IF 64drop
5480: 20 6b 65 79 3e 73 66 69 6c 65 0a 20 20 20 20 45 key>sfile. E
5490: 4c 53 45 20 20 36 34 3e 72 20 6b 65 79 70 61 63 LSE 64>r keypac
54a0: 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 36 k keypack-all# 6
54b0: 34 72 3e 20 3f 6b 65 79 2d 73 66 64 20 77 72 69 4r> ?key-sfd wri
54c0: 74 65 40 70 6f 73 2d 66 69 6c 65 20 20 54 48 45 te@pos-file THE
54d0: 4e 20 3b 0a 3a 20 6b 65 79 3e 70 66 69 6c 65 40 N ;.: key>pfile@
54e0: 70 6f 73 20 28 20 36 34 70 6f 73 20 2d 2d 20 29 pos ( 64pos -- )
54f0: 20 36 34 64 75 70 20 36 34 23 2d 31 20 36 34 3d 64dup 64#-1 64=
5500: 20 49 46 20 20 36 34 64 72 6f 70 20 6b 65 79 3e IF 64drop key>
5510: 70 66 69 6c 65 0a 20 20 20 20 45 4c 53 45 20 20 pfile. ELSE
5520: 36 34 3e 72 20 6b 65 79 70 61 63 6b 20 6b 65 79 64>r keypack key
5530: 70 61 63 6b 2d 61 6c 6c 23 20 36 34 72 3e 20 3f pack-all# 64r> ?
5540: 6b 65 79 2d 70 66 64 20 77 72 69 74 65 40 70 6f key-pfd write@po
5550: 73 2d 66 69 6c 65 20 20 54 48 45 4e 20 3b 0a 0a s-file THEN ;..
5560: 3a 20 72 6e 64 3e 73 66 69 6c 65 20 28 20 2d 2d : rnd>sfile ( --
5570: 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 6b ). keypack k
5580: 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3e 72 6e 67 eypack-all# >rng
5590: 24 20 6b 65 79 3e 73 66 69 6c 65 20 3b 0a 3a 20 $ key>sfile ;.:
55a0: 72 6e 64 3e 70 66 69 6c 65 20 28 20 2d 2d 20 29 rnd>pfile ( -- )
55b0: 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 6b 65 79 . keypack key
55c0: 70 61 63 6b 2d 61 6c 6c 23 20 3e 72 6e 67 24 20 pack-all# >rng$
55d0: 6b 65 79 3e 70 66 69 6c 65 20 3b 0a 0a 3a 20 3e key>pfile ;..: >
55e0: 6b 65 79 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 keys ( -- ).
55f0: 5c 47 20 61 64 64 20 73 68 61 72 65 64 20 73 65 \G add shared se
5600: 63 72 65 74 20 74 6f 20 6c 69 73 74 20 6f 66 20 cret to list of
5610: 70 6f 73 73 69 62 6c 65 20 6b 65 79 73 0a 20 20 possible keys.
5620: 20 20 73 6b 63 20 70 6b 63 20 6b 65 79 70 61 64 skc pkc keypad
5630: 20 65 64 2d 64 68 20 2b 6b 65 79 20 3b 0a 0a 5c ed-dh +key ;..\
5640: 20 6b 65 79 20 67 65 6e 65 72 61 74 69 6f 6e 0a key generation.
5650: 5c 20 66 6f 72 20 72 65 70 72 6f 64 75 63 69 62 \ for reproducib
5660: 69 6c 69 74 79 20 6f 66 20 74 68 65 20 73 65 6c ility of the sel
5670: 66 73 69 67 2c 20 61 6c 77 61 79 73 20 75 73 65 fsig, always use
5680: 20 74 68 65 20 73 61 6d 65 20 6f 72 64 65 72 3a the same order:
5690: 0a 5c 20 22 70 75 62 6b 65 79 22 20 6e 65 77 6b .\ "pubkey" newk
56a0: 65 79 20 3c 6e 3e 20 6b 65 79 74 79 70 65 20 22 ey <n> keytype "
56b0: 6e 69 63 6b 22 20 6b 65 79 6e 69 63 6b 20 22 73 nick" keynick "s
56c0: 69 67 22 20 6b 65 79 73 65 6c 66 73 69 67 0a 0a ig" keyselfsig..
56d0: 55 73 65 72 20 70 6b 2b 73 69 67 24 0a 0a 6b 65 User pk+sig$..ke
56e0: 79 73 69 7a 65 32 20 43 6f 6e 73 74 61 6e 74 20 ysize2 Constant
56f0: 70 6b 72 6b 23 0a 0a 3a 20 5d 70 6b 2b 73 69 67 pkrk#..: ]pk+sig
5700: 6e 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 n ( addr u -- )
5710: 2b 63 6d 64 62 75 66 20 5d 73 69 67 6e 20 3b 0a +cmdbuf ]sign ;.
5720: 0a 3a 20 70 61 63 6b 2d 6b 65 79 20 28 20 74 79 .: pack-key ( ty
5730: 70 65 20 6e 69 63 6b 20 75 20 2d 2d 20 29 0a 20 pe nick u -- ).
5740: 20 20 20 6e 6f 77 3e 6e 65 76 65 72 0a 20 20 20 now>never.
5750: 20 6b 65 79 3a 63 6f 64 65 0a 20 20 20 20 20 20 key:code.
5760: 73 69 67 6e 5b 0a 20 20 20 20 20 20 72 6f 74 20 sign[. rot
5770: 75 6c 69 74 2c 20 6b 65 79 74 79 70 65 20 24 2c ulit, keytype $,
5780: 20 6b 65 79 6e 69 63 6b 0a 20 20 20 20 20 20 70 keynick. p
5790: 6b 63 20 70 6b 72 6b 23 20 5d 70 6b 2b 73 69 67 kc pkrk# ]pk+sig
57a0: 6e 0a 20 20 20 20 20 20 73 6b 63 20 6b 65 79 73 n. skc keys
57b0: 69 7a 65 20 73 65 63 24 2c 20 70 72 69 76 6b 65 ize sec$, privke
57c0: 79 0a 20 20 20 20 65 6e 64 3a 6b 65 79 20 3b 0a y. end:key ;.
57d0: 0a 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73 65 .also net2o-base
57e0: 0a 3a 20 70 61 63 6b 2d 63 6f 72 65 20 28 20 6f .: pack-core ( o
57f0: 3a 6b 65 79 20 2d 2d 20 29 20 5c 20 63 6f 72 65 :key -- ) \ core
5800: 20 77 69 74 68 6f 75 74 20 6b 65 79 0a 20 20 20 without key.
5810: 20 6b 65 2d 74 79 70 65 20 40 20 75 6c 69 74 2c ke-type @ ulit,
5820: 20 6b 65 79 74 79 70 65 0a 20 20 20 20 6b 65 2d keytype. ke-
5830: 6e 69 63 6b 20 24 40 20 24 2c 20 6b 65 79 6e 69 nick $@ $, keyni
5840: 63 6b 0a 20 20 20 20 6b 65 2d 70 72 6f 66 20 24 ck. ke-prof $
5850: 40 20 64 75 70 20 49 46 20 20 24 2c 20 6b 65 79 @ dup IF $, key
5860: 70 72 6f 66 69 6c 65 20 20 45 4c 53 45 20 20 32 profile ELSE 2
5870: 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 drop THEN ;..:
5880: 70 61 63 6b 2d 73 69 67 6e 6b 65 79 20 28 20 6f pack-signkey ( o
5890: 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 73 69 :key -- ). si
58a0: 67 6e 5b 0a 20 20 20 20 70 61 63 6b 2d 63 6f 72 gn[. pack-cor
58b0: 65 0a 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 2b e. ke-pk $@ +
58c0: 63 6d 64 62 75 66 0a 20 20 20 20 6b 65 2d 73 65 cmdbuf. ke-se
58d0: 6c 66 73 69 67 20 24 40 20 2b 63 6d 64 62 75 66 lfsig $@ +cmdbuf
58e0: 20 63 6d 64 2d 72 65 73 6f 6c 76 65 3e 20 32 64 cmd-resolve> 2d
58f0: 72 6f 70 20 6e 65 73 74 73 69 67 20 3b 0a 0a 3a rop nestsig ;..:
5900: 20 70 61 63 6b 2d 63 6f 72 65 6b 65 79 20 28 20 pack-corekey (
5910: 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 70 o:key -- ). p
5920: 61 63 6b 2d 73 69 67 6e 6b 65 79 0a 20 20 20 20 ack-signkey.
5930: 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 75 6c 69 ke-imports @ uli
5940: 74 2c 20 6b 65 79 69 6d 70 6f 72 74 0a 20 20 20 t, keyimport.
5950: 20 6b 65 2d 6d 61 73 6b 20 40 20 20 6b 65 2d 67 ke-mask @ ke-g
5960: 72 6f 75 70 73 20 24 40 6c 65 6e 20 49 46 0a 09 roups $@len IF..
5970: 6b 65 2d 67 72 6f 75 70 73 20 24 40 20 32 64 75 ke-groups $@ 2du
5980: 70 20 24 2c 20 6b 65 79 67 72 6f 75 70 73 0a 09 p $, keygroups..
5990: 67 72 6f 75 70 73 3e 6d 61 73 6b 20 69 6e 76 65 groups>mask inve
59a0: 72 74 20 61 6e 64 20 20 54 48 45 4e 0a 20 20 20 rt and THEN.
59b0: 20 3f 64 75 70 2d 49 46 20 20 6e 6c 69 74 2c 20 ?dup-IF nlit,
59c0: 6b 65 79 6d 61 73 6b 20 20 54 48 45 4e 0a 20 20 keymask THEN.
59d0: 20 20 6b 65 2d 70 65 74 73 20 5b 3a 20 24 2c 20 ke-pets [: $,
59e0: 6b 65 79 70 65 74 20 3b 5d 20 24 5b 5d 6d 61 70 keypet ;] $[]map
59f0: 0a 20 20 20 20 6b 65 2d 73 74 6f 72 65 6b 65 79 . ke-storekey
5a00: 20 40 20 3e 73 74 6f 72 65 6b 65 79 20 21 20 3b @ >storekey ! ;
5a10: 0a 70 72 65 76 69 6f 75 73 0a 0a 3a 20 70 61 63 .previous..: pac
5a20: 6b 2d 70 75 62 6b 65 79 20 28 20 6f 3a 6b 65 79 k-pubkey ( o:key
5a30: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 3a 63 6f -- ). key:co
5a40: 64 65 0a 20 20 20 20 20 20 70 61 63 6b 2d 63 6f de. pack-co
5a50: 72 65 6b 65 79 0a 20 20 20 20 65 6e 64 3a 6b 65 rekey. end:ke
5a60: 79 20 3b 0a 3a 20 70 61 63 6b 2d 6f 75 74 6b 65 y ;.: pack-outke
5a70: 79 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 y ( o:key -- ).
5a80: 20 20 20 6b 65 79 3a 63 6f 64 65 0a 20 20 20 20 key:code.
5a90: 20 20 22 6e 32 6f 22 20 6e 65 74 32 6f 2d 62 61 "n2o" net2o-ba
5aa0: 73 65 3a 34 63 63 2c 0a 20 20 20 20 20 20 70 61 se:4cc,. pa
5ab0: 63 6b 2d 73 69 67 6e 6b 65 79 0a 20 20 20 20 65 ck-signkey. e
5ac0: 6e 64 3a 6b 65 79 20 3b 0a 3a 20 70 61 63 6b 2d nd:key ;.: pack-
5ad0: 73 65 63 6b 65 79 20 28 20 6f 3a 6b 65 79 20 2d seckey ( o:key -
5ae0: 2d 20 29 0a 20 20 20 20 6b 65 79 3a 63 6f 64 65 - ). key:code
5af0: 0a 20 20 20 20 20 20 70 61 63 6b 2d 63 6f 72 65 . pack-core
5b00: 6b 65 79 0a 20 20 20 20 20 20 6b 65 2d 73 6b 20 key. ke-sk
5b10: 73 65 63 40 20 73 65 63 24 2c 20 70 72 69 76 6b sec@ sec$, privk
5b20: 65 79 0a 20 20 20 20 20 20 6b 65 2d 72 73 6b 20 ey. ke-rsk
5b30: 73 65 63 40 20 64 75 70 20 49 46 20 20 73 65 63 sec@ dup IF sec
5b40: 24 2c 20 72 73 6b 6b 65 79 20 20 45 4c 53 45 20 $, rskkey ELSE
5b50: 20 32 64 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 2drop THEN.
5b60: 20 65 6e 64 3a 6b 65 79 20 3b 0a 3a 20 6b 65 79 end:key ;.: key
5b70: 6e 69 63 6b 24 20 28 20 6f 3a 6b 65 79 20 2d 2d nick$ ( o:key --
5b80: 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 5c 47 addr u ). \G
5b90: 20 67 65 74 20 74 68 65 20 61 6e 6e 6f 74 61 74 get the annotat
5ba0: 69 6f 6e 73 20 77 69 74 68 20 73 69 67 6e 61 74 ions with signat
5bb0: 75 72 65 0a 20 20 20 20 5b 27 5d 20 70 61 63 6b ure. ['] pack
5bc0: 2d 63 6f 72 65 20 67 65 6e 2d 63 6d 64 24 20 32 -core gen-cmd$ 2
5bd0: 64 72 6f 70 0a 20 20 20 20 6b 65 2d 73 65 6c 66 drop. ke-self
5be0: 73 69 67 20 24 40 20 74 6d 70 24 20 24 2b 21 20 sig $@ tmp$ $+!
5bf0: 74 6d 70 24 20 24 40 20 3b 0a 3a 20 6b 65 79 70 tmp$ $@ ;.: keyp
5c00: 6b 32 6e 69 63 6b 24 20 28 20 6f 3a 6b 65 79 20 k2nick$ ( o:key
5c10: 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 -- addr u ).
5c20: 5c 47 20 67 65 74 20 74 68 65 20 61 6e 6e 6f 74 \G get the annot
5c30: 61 74 69 6f 6e 73 20 77 69 74 68 20 73 69 67 6e ations with sign
5c40: 61 74 75 72 65 0a 20 20 20 20 5b 27 5d 20 70 61 ature. ['] pa
5c50: 63 6b 2d 63 6f 72 65 20 67 65 6e 2d 63 6d 64 24 ck-core gen-cmd$
5c60: 20 32 64 72 6f 70 0a 20 20 20 20 6b 65 2d 70 6b 2drop. ke-pk
5c70: 20 24 40 20 74 6d 70 24 20 24 2b 21 20 6b 65 2d $@ tmp$ $+! ke-
5c80: 73 65 6c 66 73 69 67 20 24 40 20 74 6d 70 24 20 selfsig $@ tmp$
5c90: 24 2b 21 20 74 6d 70 24 20 24 40 20 3b 0a 3a 20 $+! tmp$ $@ ;.:
5ca0: 6d 79 6e 69 63 6b 2d 6b 65 79 20 28 20 2d 2d 20 mynick-key ( --
5cb0: 6f 20 29 0a 20 20 20 20 70 6b 63 20 6b 65 79 73 o ). pkc keys
5cc0: 69 7a 65 20 6b 65 79 23 20 23 40 20 64 72 6f 70 ize key# #@ drop
5cd0: 20 63 65 6c 6c 2b 20 3b 0a 3a 20 6d 79 6e 69 63 cell+ ;.: mynic
5ce0: 6b 24 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 k$ ( -- addr u )
5cf0: 0a 20 20 20 20 5c 47 20 67 65 74 20 6d 79 20 6e . \G get my n
5d00: 69 63 6b 20 77 69 74 68 20 73 69 67 6e 61 74 75 ick with signatu
5d10: 72 65 0a 20 20 20 20 6d 79 6e 69 63 6b 2d 6b 65 re. mynick-ke
5d20: 79 20 2e 6b 65 79 6e 69 63 6b 24 20 3b 0a 3a 20 y .keynick$ ;.:
5d30: 6d 79 70 6b 32 6e 69 63 6b 24 20 28 20 6f 3a 6b mypk2nick$ ( o:k
5d40: 65 79 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 ey -- addr u ).
5d50: 20 20 20 5c 47 20 67 65 74 20 6d 79 20 6e 69 63 \G get my nic
5d60: 6b 20 77 69 74 68 20 73 69 67 6e 61 74 75 72 65 k with signature
5d70: 0a 20 20 20 20 6d 79 6e 69 63 6b 2d 6b 65 79 20 . mynick-key
5d80: 2e 6b 65 79 70 6b 32 6e 69 63 6b 24 20 3b 0a 3a .keypk2nick$ ;.:
5d90: 20 6b 65 79 2d 73 69 67 6e 20 28 20 6f 3a 6b 65 key-sign ( o:ke
5da0: 79 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 20 20 y -- o:key ).
5db0: 20 5b 27 5d 20 70 61 63 6b 2d 63 6f 72 65 20 67 ['] pack-core g
5dc0: 65 6e 2d 63 6d 64 24 0a 20 20 20 20 5b 3a 20 74 en-cmd$. [: t
5dd0: 79 70 65 20 6b 65 2d 70 6b 20 24 40 20 74 79 70 ype ke-pk $@ typ
5de0: 65 20 3b 5d 20 24 74 6d 70 0a 20 20 20 20 6e 6f e ;] $tmp. no
5df0: 77 3e 6e 65 76 65 72 20 63 3a 30 6b 65 79 20 63 w>never c:0key c
5e00: 3a 68 61 73 68 20 5b 27 5d 20 2e 73 69 67 20 24 :hash ['] .sig $
5e10: 74 6d 70 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 tmp ke-selfsig $
5e20: 21 20 3b 0a 0a 56 61 72 69 61 62 6c 65 20 63 70 ! ;..Variable cp
5e30: 2d 74 6d 70 0a 0a 3a 20 73 61 76 65 2d 70 75 62 -tmp..: save-pub
5e40: 6b 65 79 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 keys ( -- ).
5e50: 6b 65 79 2d 70 66 64 20 3f 64 75 70 2d 49 46 20 key-pfd ?dup-IF
5e60: 20 63 6c 6f 73 65 2d 66 69 6c 65 20 74 68 72 6f close-file thro
5e70: 77 20 20 54 48 45 4e 0a 20 20 20 20 22 70 75 62 w THEN. "pub
5e80: 6b 65 79 73 2e 6b 32 6f 22 20 2e 6b 65 79 73 2f keys.k2o" .keys/
5e90: 20 5b 3a 20 74 6f 20 6b 65 79 2d 70 66 64 0a 20 [: to key-pfd.
5ea0: 20 20 20 20 20 6b 65 79 23 20 5b 3a 20 63 65 6c key# [: cel
5eb0: 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b l+ $@ drop cell+
5ec0: 20 3e 6f 0a 09 6b 65 2d 73 6b 20 73 65 63 40 20 >o..ke-sk sec@
5ed0: 64 30 3d 20 49 46 20 20 70 61 63 6b 2d 70 75 62 d0= IF pack-pub
5ee0: 6b 65 79 0a 09 20 20 20 20 66 6c 75 73 68 28 20 key.. flush(
5ef0: 2e 22 20 73 61 76 69 6e 67 20 22 20 2e 6e 69 63 ." saving " .nic
5f00: 6b 20 66 6f 72 74 68 3a 63 72 20 29 0a 09 20 20 k forth:cr )..
5f10: 20 20 6b 65 79 2d 63 72 79 70 74 20 6b 65 2d 6f key-crypt ke-o
5f20: 66 66 73 65 74 20 36 34 40 20 6b 65 79 3e 70 66 ffset 64@ key>pf
5f30: 69 6c 65 40 70 6f 73 0a 09 54 48 45 4e 20 6f 3e ile@pos..THEN o>
5f40: 20 3b 5d 20 23 6d 61 70 0a 20 20 20 20 30 20 74 ;] #map. 0 t
5f50: 6f 20 6b 65 79 2d 70 66 64 20 3b 5d 20 73 61 76 o key-pfd ;] sav
5f60: 65 2d 66 69 6c 65 20 20 3f 6b 65 79 2d 70 66 64 e-file ?key-pfd
5f70: 20 64 72 6f 70 20 3b 0a 0a 3a 20 73 61 76 65 2d drop ;..: save-
5f80: 73 65 63 6b 65 79 73 20 28 20 2d 2d 20 29 0a 20 seckeys ( -- ).
5f90: 20 20 20 6b 65 79 2d 73 66 64 20 3f 64 75 70 2d key-sfd ?dup-
5fa0: 49 46 20 20 63 6c 6f 73 65 2d 66 69 6c 65 20 74 IF close-file t
5fb0: 68 72 6f 77 20 20 54 48 45 4e 0a 20 20 20 20 22 hrow THEN. "
5fc0: 73 65 63 6b 65 79 73 2e 6b 32 6f 22 20 2e 6b 65 seckeys.k2o" .ke
5fd0: 79 73 2f 20 5b 3a 20 74 6f 20 6b 65 79 2d 73 66 ys/ [: to key-sf
5fe0: 64 0a 20 20 20 20 20 20 6b 65 79 23 20 5b 3a 20 d. key# [:
5ff0: 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 cell+ $@ drop ce
6000: 6c 6c 2b 20 3e 6f 0a 09 6b 65 2d 73 6b 20 73 65 ll+ >o..ke-sk se
6010: 63 40 20 64 30 3c 3e 20 49 46 20 20 70 61 63 6b c@ d0<> IF pack
6020: 2d 73 65 63 6b 65 79 0a 09 20 20 20 20 63 6f 6e -seckey.. con
6030: 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23 20 40 20 fig:pw-level# @
6040: 3e 72 20 20 6b 65 2d 70 77 6c 65 76 65 6c 20 40 >r ke-pwlevel @
6050: 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76 65 6c config:pw-level
6060: 23 20 21 0a 09 20 20 20 20 6b 65 79 2d 63 72 79 # !.. key-cry
6070: 70 74 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 40 pt ke-offset 64@
6080: 20 6b 65 79 3e 73 66 69 6c 65 40 70 6f 73 0a 09 key>sfile@pos..
6090: 20 20 20 20 72 3e 20 63 6f 6e 66 69 67 3a 70 77 r> config:pw
60a0: 2d 6c 65 76 65 6c 23 20 21 0a 09 54 48 45 4e 20 -level# !..THEN
60b0: 6f 3e 20 3b 5d 20 23 6d 61 70 0a 20 20 20 20 30 o> ;] #map. 0
60c0: 20 74 6f 20 6b 65 79 2d 73 66 64 20 3b 5d 20 73 to key-sfd ;] s
60d0: 61 76 65 2d 66 69 6c 65 20 20 3f 6b 65 79 2d 73 ave-file ?key-s
60e0: 66 64 20 64 72 6f 70 20 3b 0a 0a 3a 20 73 61 76 fd drop ;..: sav
60f0: 65 2d 6b 65 79 73 20 28 20 2d 2d 20 29 20 20 3f e-keys ( -- ) ?
6100: 2e 6e 65 74 32 6f 2f 6b 65 79 73 0a 20 20 20 20 .net2o/keys.
6110: 73 61 76 65 2d 70 75 62 6b 65 79 73 20 73 61 76 save-pubkeys sav
6120: 65 2d 73 65 63 6b 65 79 73 20 3b 0a 0a 3a 20 2b e-seckeys ;..: +
6130: 67 65 6e 2d 6b 65 79 73 20 28 20 6e 69 63 6b 20 gen-keys ( nick
6140: 75 20 74 79 70 65 20 2d 2d 20 29 0a 20 20 20 20 u type -- ).
6150: 67 65 6e 2d 6b 65 79 73 20 20 36 34 23 2d 31 20 gen-keys 64#-1
6160: 6b 65 79 2d 72 65 61 64 2d 6f 66 66 73 65 74 20 key-read-offset
6170: 36 34 21 20 20 70 6b 63 20 6b 65 79 73 69 7a 65 64! pkc keysize
6180: 32 20 6b 65 79 3a 6e 65 77 20 3e 6f 0a 20 20 20 2 key:new >o.
6190: 20 5b 20 31 20 69 6d 70 6f 72 74 23 73 65 6c 66 [ 1 import#self
61a0: 20 6c 73 68 69 66 74 20 31 20 69 6d 70 6f 72 74 lshift 1 import
61b0: 23 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 20 5d #new lshift or ]
61c0: 4c 20 6b 65 2d 69 6d 70 6f 72 74 73 20 21 0a 20 L ke-imports !.
61d0: 20 20 20 6b 65 2d 74 79 70 65 20 21 20 20 6b 65 ke-type ! ke
61e0: 2d 6e 69 63 6b 20 24 21 20 20 6e 69 63 6b 21 0a -nick $! nick!.
61f0: 20 20 20 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 config:pw-le
6200: 76 65 6c 23 20 40 20 6b 65 2d 70 77 6c 65 76 65 vel# @ ke-pwleve
6210: 6c 20 21 20 20 70 65 72 6d 25 6d 79 73 65 6c 66 l ! perm%myself
6220: 20 6b 65 2d 6d 61 73 6b 20 21 0a 20 20 20 20 73 ke-mask !. s
6230: 6b 63 20 6b 65 79 73 69 7a 65 20 6b 65 2d 73 6b kc keysize ke-sk
6240: 20 73 65 63 21 20 20 2b 73 65 63 6b 65 79 0a 20 sec! +seckey.
6250: 20 20 20 73 6b 72 65 76 20 6b 65 79 73 69 7a 65 skrev keysize
6260: 20 6b 65 2d 72 73 6b 20 73 65 63 21 0a 20 20 20 ke-rsk sec!.
6270: 20 6b 65 79 2d 73 69 67 6e 20 6f 3e 20 3b 0a 0a key-sign o> ;..
6280: 24 34 30 20 62 75 66 66 65 72 3a 20 6e 69 63 6b $40 buffer: nick
6290: 2d 62 75 66 0a 0a 3a 20 67 65 74 2d 6e 69 63 6b -buf..: get-nick
62a0: 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 ( -- addr u ).
62b0: 20 20 20 2e 22 20 6e 69 63 6b 3a 20 22 20 6e 69 ." nick: " ni
62c0: 63 6b 2d 62 75 66 20 24 34 30 20 61 63 63 65 70 ck-buf $40 accep
62d0: 74 20 6e 69 63 6b 2d 62 75 66 20 73 77 61 70 20 t nick-buf swap
62e0: 2d 74 72 61 69 6c 69 6e 67 20 63 72 20 3b 0a 0a -trailing cr ;..
62f0: 66 61 6c 73 65 20 76 61 6c 75 65 20 3f 79 65 73 false value ?yes
6300: 0a 3a 20 79 65 73 3f 20 28 20 61 64 64 72 20 75 .: yes? ( addr u
6310: 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 3f -- flag ). ?
6320: 79 65 73 20 49 46 20 20 32 64 72 6f 70 20 74 72 yes IF 2drop tr
6330: 75 65 20 20 45 4c 53 45 20 20 74 79 70 65 20 2e ue ELSE type .
6340: 22 20 20 28 79 2f 4e 29 22 20 6b 65 79 20 63 72 " (y/N)" key cr
6350: 20 27 79 27 20 3d 20 20 54 48 45 4e 20 3b 0a 0a 'y' = THEN ;..
6360: 3a 20 3f 72 73 6b 20 28 20 2d 2d 20 29 0a 20 20 : ?rsk ( -- ).
6370: 20 20 70 6b 63 20 6b 65 79 73 69 7a 65 20 6b 65 pkc keysize ke
6380: 79 2d 65 78 69 73 74 3f 20 64 75 70 20 30 3d 20 y-exist? dup 0=
6390: 49 46 20 20 64 72 6f 70 20 20 45 58 49 54 20 20 IF drop EXIT
63a0: 54 48 45 4e 0a 20 20 20 20 3e 6f 20 6b 65 2d 72 THEN. >o ke-r
63b0: 73 6b 20 73 65 63 40 20 64 75 70 20 30 3d 20 49 sk sec@ dup 0= I
63c0: 46 20 20 32 64 72 6f 70 20 6f 3e 20 20 45 58 49 F 2drop o> EXI
63d0: 54 20 20 54 48 45 4e 0a 20 20 20 20 2e 22 20 59 T THEN. ." Y
63e0: 6f 75 20 73 74 69 6c 6c 20 68 61 76 65 6e 27 74 ou still haven't
63f0: 20 73 74 6f 72 65 64 20 79 6f 75 72 20 72 65 76 stored your rev
6400: 6f 6b 65 20 6b 65 79 20 73 65 63 75 72 65 6c 79 oke key securely
6410: 20 6f 66 66 2d 6c 69 6e 65 2e 22 20 63 72 0a 20 off-line." cr.
6420: 20 20 20 73 22 20 50 61 70 65 72 20 61 6e 64 20 s" Paper and
6430: 70 65 6e 63 69 6c 20 72 65 61 64 79 3f 22 20 79 pencil ready?" y
6440: 65 73 3f 20 49 46 0a 09 2e 73 74 72 69 70 65 38 es? IF...stripe8
6450: 35 0a 09 73 22 20 57 72 69 74 74 65 6e 20 64 6f 5..s" Written do
6460: 77 6e 3f 22 20 79 65 73 3f 20 49 46 0a 09 20 20 wn?" yes? IF..
6470: 20 20 73 22 20 59 6f 75 20 77 6f 6e 27 74 20 73 s" You won't s
6480: 65 65 20 74 68 69 73 20 61 67 61 69 6e 21 20 44 ee this again! D
6490: 65 6c 65 74 65 3f 22 20 79 65 73 3f 0a 09 20 20 elete?" yes?..
64a0: 20 20 49 46 20 6b 65 2d 72 73 6b 20 73 65 63 2d IF ke-rsk sec-
64b0: 6f 66 66 20 20 73 61 76 65 2d 6b 65 79 73 0a 09 off save-keys..
64c0: 09 2e 22 20 72 65 76 6f 6b 65 20 6b 65 79 20 64 .." revoke key d
64d0: 65 6c 65 74 65 64 2e 22 20 63 72 20 6f 3e 20 20 eleted." cr o>
64e0: 45 58 49 54 20 20 54 48 45 4e 20 20 54 48 45 4e EXIT THEN THEN
64f0: 0a 20 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70 . ELSE 2drop
6500: 20 20 54 48 45 4e 0a 20 20 20 20 2e 22 20 49 27 THEN. ." I'
6510: 6d 20 6b 65 65 70 69 6e 67 20 79 6f 75 72 20 72 m keeping your r
6520: 65 76 6f 6b 65 20 6b 65 79 2e 20 20 54 68 69 73 evoke key. This
6530: 20 77 69 6c 6c 20 73 68 6f 77 20 75 70 20 61 67 will show up ag
6540: 61 69 6e 2e 22 20 63 72 20 6f 3e 20 3b 0a 0a 5c ain." cr o> ;..\
6550: 20 72 65 61 64 20 6b 65 79 20 66 69 6c 65 0a 0a read key file..
6560: 3a 20 74 72 79 2d 64 65 63 72 79 70 74 2d 6b 65 : try-decrypt-ke
6570: 79 20 28 20 6b 65 79 20 75 31 20 2d 2d 20 61 64 y ( key u1 -- ad
6580: 64 72 20 75 32 20 66 6c 61 67 20 29 0a 20 20 20 dr u2 flag ).
6590: 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b keypack keypack
65a0: 2d 64 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 -d keypack-all#
65b0: 6d 6f 76 65 0a 20 20 20 20 6b 65 79 70 61 63 6b move. keypack
65c0: 2d 64 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 -d keypack-all#
65d0: 32 73 77 61 70 0a 20 20 20 20 64 75 70 20 24 32 2swap. dup $2
65e0: 30 20 3d 20 49 46 20 20 64 65 63 72 79 70 74 24 0 = IF decrypt$
65f0: 20 20 45 4c 53 45 0a 09 6b 65 79 70 61 63 6b 20 ELSE..keypack
6600: 63 40 20 24 46 20 61 6e 64 20 63 6f 6e 66 69 67 c@ $F and config
6610: 3a 70 77 2d 6d 61 78 6c 65 76 65 6c 23 20 40 20 :pw-maxlevel# @
6620: 3c 3d 0a 09 49 46 20 20 64 65 63 72 79 70 74 2d <=..IF decrypt-
6630: 70 77 24 20 20 45 4c 53 45 20 20 32 64 72 6f 70 pw$ ELSE 2drop
6640: 20 66 61 6c 73 65 20 20 54 48 45 4e 0a 20 20 20 false THEN.
6650: 20 54 48 45 4e 20 3b 0a 0a 3a 20 74 72 79 2d 64 THEN ;..: try-d
6660: 65 63 72 79 70 74 20 28 20 66 6c 61 67 20 2d 2d ecrypt ( flag --
6670: 20 61 64 64 72 20 75 20 2f 20 30 20 30 20 29 20 addr u / 0 0 )
6680: 7b 20 66 6c 61 67 20 7d 0a 20 20 20 20 6b 65 79 { flag }. key
6690: 73 20 24 5b 5d 23 20 30 20 3f 44 4f 0a 09 49 20 s $[]# 0 ?DO..I
66a0: 6b 65 79 73 20 73 65 63 5b 5d 40 20 64 75 70 20 keys sec[]@ dup
66b0: 6b 65 79 73 69 7a 65 20 3d 20 66 6c 61 67 20 78 keysize = flag x
66c0: 6f 72 20 49 46 0a 09 20 20 20 20 74 72 79 2d 64 or IF.. try-d
66d0: 65 63 72 79 70 74 2d 6b 65 79 20 49 46 0a 09 09 ecrypt-key IF...
66e0: 49 20 6b 65 79 73 20 24 5b 5d 20 40 20 64 75 70 I keys $[] @ dup
66f0: 20 3e 73 74 6f 72 65 6b 65 79 20 21 20 64 65 66 >storekey ! def
6700: 61 75 6c 74 6b 65 79 20 21 0a 09 09 75 6e 6c 6f aultkey !...unlo
6710: 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e 20 20 op EXIT THEN
6720: 54 48 45 4e 0a 09 32 64 72 6f 70 0a 20 20 20 20 THEN..2drop.
6730: 4c 4f 4f 50 20 20 30 20 30 20 3b 0a 0a 3a 20 3f LOOP 0 0 ;..: ?
6740: 70 65 72 6d 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 perm ( o:key --
6750: 29 0a 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 40 ). ke-sk sec@
6760: 20 6e 69 70 20 49 46 20 20 70 65 72 6d 25 6d 79 nip IF perm%my
6770: 73 65 6c 66 20 20 45 4c 53 45 20 20 70 65 72 6d self ELSE perm
6780: 25 64 65 66 61 75 6c 74 20 20 54 48 45 4e 20 20 %default THEN
6790: 6b 65 2d 6d 61 73 6b 20 21 20 3b 0a 0a 3a 20 64 ke-mask ! ;..: d
67a0: 6f 2d 6b 65 79 20 28 20 61 64 64 72 20 75 20 2f o-key ( addr u /
67b0: 20 30 20 30 20 20 2d 2d 20 29 0a 20 20 20 20 64 0 0 -- ). d
67c0: 75 70 20 30 3d 20 49 46 20 20 32 64 72 6f 70 20 up 0= IF 2drop
67d0: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 EXIT THEN.
67e0: 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 6b 65 sample-key >o ke
67f0: 2d 73 6b 20 6b 65 2d 65 6e 64 20 6f 76 65 72 20 -sk ke-end over
6800: 2d 20 65 72 61 73 65 20 20 64 6f 2d 63 6d 64 2d - erase do-cmd-
6810: 6c 6f 6f 70 20 6f 3e 20 3b 0a 0a 3a 20 2e 6b 65 loop o> ;..: .ke
6820: 79 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 y$ ( addr u -- )
6830: 0a 20 20 20 20 73 61 6d 70 6c 65 2d 6b 65 79 20 . sample-key
6840: 3e 6f 20 20 6b 65 2d 73 6b 20 6b 65 2d 65 6e 64 >o ke-sk ke-end
6850: 20 6f 76 65 72 20 2d 20 65 72 61 73 65 0a 20 20 over - erase.
6860: 20 20 73 69 67 6e 65 64 2d 76 61 6c 20 76 61 6c signed-val val
6870: 69 64 61 74 65 64 20 6f 72 21 20 20 63 2d 73 74 idated or! c-st
6880: 61 74 65 20 6f 66 66 20 20 6e 65 73 74 2d 63 6d ate off nest-cm
6890: 64 2d 6c 6f 6f 70 0a 20 20 20 20 73 69 67 6e 65 d-loop. signe
68a0: 64 2d 76 61 6c 20 69 6e 76 65 72 74 20 76 61 6c d-val invert val
68b0: 69 64 61 74 65 64 20 61 6e 64 21 0a 20 20 20 20 idated and!.
68c0: 2e 6b 65 79 2d 73 68 6f 72 74 20 66 72 65 65 2d .key-short free-
68d0: 6b 65 79 20 6f 3e 20 3b 0a 0a 3a 20 72 65 61 64 key o> ;..: read
68e0: 2d 6b 65 79 73 2d 6c 6f 6f 70 20 28 20 66 64 20 -keys-loop ( fd
68f0: 2d 2d 20 29 20 20 63 6f 64 65 2d 6b 65 79 0a 20 -- ) code-key.
6900: 20 20 20 3e 72 20 23 30 2e 20 72 40 20 72 65 70 >r #0. r@ rep
6910: 6f 73 69 74 69 6f 6e 2d 66 69 6c 65 20 74 68 72 osition-file thr
6920: 6f 77 0a 20 20 20 20 42 45 47 49 4e 0a 09 72 40 ow. BEGIN..r@
6930: 20 66 69 6c 65 2d 70 6f 73 69 74 69 6f 6e 20 74 file-position t
6940: 68 72 6f 77 20 64 3e 36 34 20 6b 65 79 2d 72 65 hrow d>64 key-re
6950: 61 64 2d 6f 66 66 73 65 74 20 36 34 21 0a 09 6b ad-offset 64!..k
6960: 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 eypack keypack-a
6970: 6c 6c 23 20 72 40 20 72 65 61 64 2d 66 69 6c 65 ll# r@ read-file
6980: 20 74 68 72 6f 77 0a 09 6b 65 79 70 61 63 6b 2d throw..keypack-
6990: 61 6c 6c 23 20 3d 20 57 48 49 4c 45 0a 09 20 20 all# = WHILE..
69a0: 20 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 40 20 import-type @
69b0: 69 6d 70 6f 72 74 23 73 65 6c 66 20 3d 20 74 72 import#self = tr
69c0: 79 2d 64 65 63 72 79 70 74 20 64 6f 2d 6b 65 79 y-decrypt do-key
69d0: 0a 20 20 20 20 52 45 50 45 41 54 20 20 72 64 72 . REPEAT rdr
69e0: 6f 70 20 20 63 6f 64 65 30 2d 62 75 66 20 3b 0a op code0-buf ;.
69f0: 3a 20 72 65 61 64 2d 6b 65 79 2d 6c 6f 6f 70 20 : read-key-loop
6a00: 28 20 2d 2d 20 29 0a 20 20 20 20 69 6d 70 6f 72 ( -- ). impor
6a10: 74 23 73 65 6c 66 20 69 6d 70 6f 72 74 2d 74 79 t#self import-ty
6a20: 70 65 20 21 0a 20 20 20 20 3f 6b 65 79 2d 73 66 pe !. ?key-sf
6a30: 64 20 72 65 61 64 2d 6b 65 79 73 2d 6c 6f 6f 70 d read-keys-loop
6a40: 20 3b 0a 3a 20 72 65 61 64 2d 70 6b 65 79 2d 6c ;.: read-pkey-l
6a50: 6f 6f 70 20 28 20 2d 2d 20 29 0a 20 20 20 20 6c oop ( -- ). l
6a60: 61 73 74 6b 65 79 40 20 64 72 6f 70 20 64 65 66 astkey@ drop def
6a70: 61 75 6c 74 6b 65 79 20 21 20 5c 20 61 74 20 6c aultkey ! \ at l
6a80: 65 61 73 74 20 6f 6e 65 20 64 65 66 61 75 6c 74 east one default
6a90: 20 6b 65 79 20 61 76 61 69 6c 61 62 6c 65 0a 20 key available.
6aa0: 20 20 20 2d 31 20 63 6f 6e 66 69 67 3a 70 77 2d -1 config:pw-
6ab0: 6c 65 76 65 6c 23 0a 20 20 20 20 5b 3a 20 69 6d level#. [: im
6ac0: 70 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d port#new import-
6ad0: 74 79 70 65 20 21 20 3f 6b 65 79 2d 70 66 64 20 type ! ?key-pfd
6ae0: 72 65 61 64 2d 6b 65 79 73 2d 6c 6f 6f 70 20 3b read-keys-loop ;
6af0: 5d 20 21 77 72 61 70 70 65 72 20 3b 0a 0a 3a 20 ] !wrapper ;..:
6b00: 72 65 61 64 2d 6b 65 79 73 20 28 20 2d 2d 20 29 read-keys ( -- )
6b10: 0a 20 20 20 20 72 65 61 64 2d 6b 65 79 2d 6c 6f . read-key-lo
6b20: 6f 70 20 72 65 61 64 2d 70 6b 65 79 2d 6c 6f 6f op read-pkey-loo
6b30: 70 20 69 6d 70 6f 72 74 23 6e 65 77 20 69 6d 70 p import#new imp
6b40: 6f 72 74 2d 74 79 70 65 20 21 20 3b 0a 0a 3a 20 ort-type ! ;..:
6b50: 72 65 61 64 2d 70 6b 32 6b 65 79 24 20 28 20 61 read-pk2key$ ( a
6b60: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 5c ddr u -- ). \
6b70: 67 20 72 65 61 64 20 61 20 6e 65 73 74 65 64 20 g read a nested
6b80: 6b 65 79 20 69 6e 74 6f 20 73 61 6d 70 6c 65 2d key into sample-
6b90: 6b 65 79 0a 20 20 20 20 73 61 6d 70 6c 65 2d 6b key. sample-k
6ba0: 65 79 20 3e 6f 20 63 2d 73 74 61 74 65 20 6f 66 ey >o c-state of
6bb0: 66 20 20 73 69 6d 2d 6e 69 63 6b 21 20 6f 6e 0a f sim-nick! on.
6bc0: 20 20 20 20 70 6b 32 2d 73 69 67 3f 20 21 21 73 pk2-sig? !!s
6bd0: 69 67 21 21 20 73 69 67 70 6b 32 73 69 7a 65 23 ig!! sigpk2size#
6be0: 20 2d 20 32 64 75 70 20 2b 20 3e 72 20 64 6f 2d - 2dup + >r do-
6bf0: 6e 65 73 74 73 69 67 0a 20 20 20 20 72 40 20 6b nestsig. r@ k
6c00: 65 79 73 69 7a 65 32 20 6b 65 2d 70 6b 20 24 21 eysize2 ke-pk $!
6c10: 0a 20 20 20 20 72 3e 20 6b 65 79 73 69 7a 65 32 . r> keysize2
6c20: 20 2b 20 73 69 67 73 69 7a 65 23 20 6b 65 2d 73 + sigsize# ke-s
6c30: 65 6c 66 73 69 67 20 24 21 0a 20 20 20 20 6f 3e elfsig $!. o>
6c40: 20 20 73 69 6d 2d 6e 69 63 6b 21 20 6f 66 66 20 sim-nick! off
6c50: 3b 0a 0a 3a 20 2e 70 6b 32 6b 65 79 24 20 28 20 ;..: .pk2key$ (
6c60: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 addr u -- ).
6c70: 72 65 61 64 2d 70 6b 32 6b 65 79 24 20 73 61 6d read-pk2key$ sam
6c80: 70 6c 65 2d 6b 65 79 20 3e 6f 0a 20 20 20 20 5b ple-key >o. [
6c90: 20 31 20 69 6d 70 6f 72 74 23 69 6e 76 69 74 65 1 import#invite
6ca0: 64 20 6c 73 68 69 66 74 20 31 20 69 6d 70 6f 72 d lshift 1 impor
6cb0: 74 23 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 20 t#new lshift or
6cc0: 5d 4c 20 6b 65 2d 69 6d 70 6f 72 74 73 20 21 0a ]L ke-imports !.
6cd0: 20 20 20 20 2e 6b 65 79 2d 69 6e 76 69 74 65 20 .key-invite
6ce0: 66 72 65 65 2d 6b 65 79 20 6f 3e 20 3b 0a 0a 5c free-key o> ;..\
6cf0: 20 73 65 6c 65 63 74 20 6b 65 79 20 62 79 20 6e select key by n
6d00: 69 63 6b 0a 0a 3a 20 3e 72 61 77 2d 6b 65 79 20 ick..: >raw-key
6d10: 28 20 6f 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 ( o -- ). dup
6d20: 20 30 3d 20 21 21 6e 6f 2d 6e 69 63 6b 21 21 20 0= !!no-nick!!
6d30: 3e 6f 0a 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 >o. ke-pk $@
6d40: 70 6b 63 20 70 6b 72 6b 23 20 73 6d 6f 76 65 0a pkc pkrk# smove.
6d50: 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 40 20 73 ke-sk sec@ s
6d60: 6b 63 20 73 77 61 70 20 6b 65 79 7c 20 6d 6f 76 kc swap key| mov
6d70: 65 0a 20 20 20 20 3e 73 6b 73 69 67 20 6f 3e 20 e. >sksig o>
6d80: 3b 0a 0a 3a 20 3e 6b 65 79 20 28 20 61 64 64 72 ;..: >key ( addr
6d90: 20 75 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 23 u -- ). key#
6da0: 20 40 20 30 3d 20 49 46 20 20 72 65 61 64 2d 6b @ 0= IF read-k
6db0: 65 79 73 20 20 54 48 45 4e 0a 20 20 20 20 6e 69 eys THEN. ni
6dc0: 63 6b 2d 6b 65 79 20 3e 72 61 77 2d 6b 65 79 20 ck-key >raw-key
6dd0: 3b 0a 0a 3a 20 69 27 6d 20 28 20 22 6e 61 6d 65 ;..: i'm ( "name
6de0: 22 20 2d 2d 20 29 20 70 61 72 73 65 2d 6e 61 6d " -- ) parse-nam
6df0: 65 20 3e 6b 65 79 20 3b 0a 3a 20 70 6b 27 20 28 e >key ;.: pk' (
6e00: 20 22 6e 61 6d 65 22 20 2d 2d 20 61 64 64 72 20 "name" -- addr
6e10: 75 20 29 0a 20 20 20 20 70 61 72 73 65 2d 6e 61 u ). parse-na
6e20: 6d 65 20 6e 69 63 6b 3e 70 6b 20 3b 0a 0a 3a 20 me nick>pk ;..:
6e30: 64 65 73 74 2d 6b 65 79 20 28 20 61 64 64 72 20 dest-key ( addr
6e40: 75 20 2d 2d 20 29 20 64 75 70 20 30 3d 20 49 46 u -- ) dup 0= IF
6e50: 20 20 32 64 72 6f 70 20 20 45 58 49 54 20 20 54 2drop EXIT T
6e60: 48 45 4e 0a 20 20 20 20 6e 69 63 6b 2d 6b 65 79 HEN. nick-key
6e70: 20 3e 6f 20 6f 20 30 3d 20 21 21 75 6e 6b 6e 6f >o o 0= !!unkno
6e80: 77 6e 2d 6b 65 79 21 21 0a 20 20 20 20 6b 65 2d wn-key!!. ke-
6e90: 70 6b 20 24 40 20 6f 3e 0a 20 20 20 20 70 75 62 pk $@ o>. pub
6ea0: 6b 65 79 20 24 21 20 3b 0a 0a 3a 20 64 65 73 74 key $! ;..: dest
6eb0: 2d 70 6b 20 28 20 61 64 64 72 20 75 20 2d 2d 20 -pk ( addr u --
6ec0: 29 20 6b 65 79 32 7c 20 32 64 75 70 20 6b 65 79 ) key2| 2dup key
6ed0: 7c 20 6b 65 79 23 20 23 40 20 30 3d 20 49 46 0a | key# #@ 0= IF.
6ee0: 09 64 72 6f 70 20 70 75 62 6b 65 79 20 24 21 20 .drop pubkey $!
6ef0: 20 70 65 72 6d 25 75 6e 6b 6e 6f 77 6e 20 70 65 perm%unknown pe
6f00: 72 6d 2d 6d 61 73 6b 20 21 0a 20 20 20 20 45 4c rm-mask !. EL
6f10: 53 45 20 20 63 65 6c 6c 2b 20 3e 6f 0a 09 6b 65 SE cell+ >o..ke
6f20: 2d 6d 61 73 6b 20 40 0a 09 6b 65 2d 70 6b 20 24 -mask @..ke-pk $
6f30: 40 20 6f 3e 0a 09 70 75 62 6b 65 79 20 24 21 20 @ o>..pubkey $!
6f40: 20 70 65 72 6d 2d 6d 61 73 6b 20 21 20 20 32 64 perm-mask ! 2d
6f50: 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 72 rop THEN ;..: r
6f60: 65 70 6c 61 63 65 2d 6b 65 79 20 31 20 2f 73 74 eplace-key 1 /st
6f70: 72 69 6e 67 20 7b 20 72 65 76 2d 61 64 64 72 20 ring { rev-addr
6f80: 75 20 2d 2d 20 6f 20 7d 20 5c 20 72 65 76 6f 63 u -- o } \ revoc
6f90: 61 74 69 6f 6e 20 74 69 63 6b 65 74 0a 20 20 20 ation ticket.
6fa0: 20 6b 65 79 28 20 2e 22 20 52 65 70 6c 61 63 65 key( ." Replace
6fb0: 3a 22 20 63 72 20 6f 20 63 65 6c 6c 2d 20 30 20 :" cr o cell- 0
6fc0: 2e 6b 65 79 20 29 0a 20 20 20 20 69 6d 70 6f 72 .key ). impor
6fd0: 74 23 73 65 6c 66 20 69 6d 70 6f 72 74 2d 74 79 t#self import-ty
6fe0: 70 65 20 21 0a 20 20 20 20 73 22 20 23 72 65 76 pe !. s" #rev
6ff0: 6f 6b 65 64 22 20 64 75 70 20 3e 72 20 6b 65 2d oked" dup >r ke-
7000: 6e 69 63 6b 20 24 2b 21 0a 20 20 20 20 6b 65 2d nick $+!. ke-
7010: 6e 69 63 6b 20 24 40 20 72 3e 20 2d 20 6b 65 2d nick $@ r> - ke-
7020: 70 72 6f 66 20 24 40 20 6b 65 2d 73 69 67 73 20 prof $@ ke-sigs
7030: 6b 65 2d 74 79 70 65 20 40 0a 20 20 20 20 72 65 ke-type @. re
7040: 76 2d 61 64 64 72 20 70 6b 72 6b 23 20 6b 65 79 v-addr pkrk# key
7050: 3f 6e 65 77 20 3e 6f 0a 20 20 20 20 6b 65 2d 74 ?new >o. ke-t
7060: 79 70 65 20 21 20 5b 3a 20 6b 65 2d 73 69 67 73 ype ! [: ke-sigs
7070: 20 24 2b 5b 5d 21 20 3b 5d 20 24 5b 5d 6d 61 70 $+[]! ;] $[]map
7080: 20 6b 65 2d 70 72 6f 66 20 24 21 20 6b 65 2d 6e ke-prof $! ke-n
7090: 69 63 6b 20 24 21 0a 20 20 20 20 72 65 76 2d 61 ick $!. rev-a
70a0: 64 64 72 20 70 6b 72 6b 23 20 6b 65 2d 70 6b 20 ddr pkrk# ke-pk
70b0: 24 21 0a 20 20 20 20 72 65 76 2d 61 64 64 72 20 $!. rev-addr
70c0: 75 20 2b 20 31 2d 20 64 75 70 20 63 40 20 32 2a u + 1- dup c@ 2*
70d0: 20 2d 20 24 31 30 20 2d 20 24 31 30 20 6b 65 2d - $10 - $10 ke-
70e0: 73 65 6c 66 73 69 67 20 24 21 0a 20 20 20 20 6b selfsig $!. k
70f0: 65 79 28 20 2e 22 20 77 69 74 68 3a 22 20 63 72 ey( ." with:" cr
7100: 20 6f 20 63 65 6c 6c 2d 20 30 20 2e 6b 65 79 20 o cell- 0 .key
7110: 29 20 6f 20 6f 3e 0a 20 20 20 20 69 6d 70 6f 72 ) o o>. impor
7120: 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 79 70 t#new import-typ
7130: 65 20 21 20 3b 0a 0a 3a 20 72 65 6e 65 77 2d 6b e ! ;..: renew-k
7140: 65 79 20 28 20 72 65 76 61 64 64 72 20 75 31 20 ey ( revaddr u1
7150: 6b 65 79 61 64 64 72 20 75 32 20 2d 2d 20 6f 20 keyaddr u2 -- o
7160: 29 0a 20 20 20 20 63 75 72 72 65 6e 74 2d 6b 65 ). current-ke
7170: 79 20 3e 6f 20 72 65 70 6c 61 63 65 2d 6b 65 79 y >o replace-key
7180: 20 6f 3e 0a 20 20 20 20 3e 6f 20 73 6b 63 20 6b o>. >o skc k
7190: 65 79 73 69 7a 65 20 6b 65 2d 73 6b 20 73 65 63 eysize ke-sk sec
71a0: 21 20 6f 20 6f 3e 20 3b 0a 0a 5c 20 67 65 6e 65 ! o o> ;..\ gene
71b0: 72 61 74 65 20 6e 65 77 20 6b 65 79 0a 0a 3a 20 rate new key..:
71c0: 6f 75 74 2d 6b 65 79 20 28 20 6f 20 2d 2d 20 29 out-key ( o -- )
71d0: 0a 20 20 20 20 3e 6f 20 70 61 63 6b 2d 6f 75 74 . >o pack-out
71e0: 6b 65 79 20 5b 27 5d 20 2e 6e 69 63 6b 2d 62 61 key ['] .nick-ba
71f0: 73 65 20 24 74 6d 70 20 66 6e 2d 73 61 6e 69 74 se $tmp fn-sanit
7200: 69 7a 65 20 6f 3e 0a 20 20 20 20 5b 3a 20 2e 22 ize o>. [: ."
7210: 20 7e 2f 22 20 74 79 70 65 20 2e 22 20 2e 6e 32 ~/" type ." .n2
7220: 6f 22 20 3b 5d 20 24 74 6d 70 20 77 2f 6f 20 63 o" ;] $tmp w/o c
7230: 72 65 61 74 65 2d 66 69 6c 65 20 74 68 72 6f 77 reate-file throw
7240: 0a 20 20 20 20 3e 72 20 63 6d 64 62 75 66 24 20 . >r cmdbuf$
7250: 72 40 20 77 72 69 74 65 2d 66 69 6c 65 20 74 68 r@ write-file th
7260: 72 6f 77 20 72 3e 20 63 6c 6f 73 65 2d 66 69 6c row r> close-fil
7270: 65 20 74 68 72 6f 77 20 3b 0a 3a 20 6f 75 74 2d e throw ;.: out-
7280: 6d 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 70 6b me ( -- ). pk
7290: 63 20 6b 65 79 73 69 7a 65 20 6b 65 79 23 20 23 c keysize key# #
72a0: 40 20 30 3d 20 21 21 75 6e 6b 6e 6f 77 6e 2d 6b @ 0= !!unknown-k
72b0: 65 79 21 21 0a 20 20 20 20 63 65 6c 6c 2b 20 6f ey!!. cell+ o
72c0: 75 74 2d 6b 65 79 20 3b 0a 0a 56 61 72 69 61 62 ut-key ;..Variab
72d0: 6c 65 20 64 68 74 72 6f 6f 74 2e 6e 32 6f 0a 0a le dhtroot.n2o..
72e0: 3a 20 2b 64 68 74 72 6f 6f 74 20 28 20 2d 2d 20 : +dhtroot ( --
72f0: 29 0a 20 20 20 20 64 65 66 61 75 6c 74 6b 65 79 ). defaultkey
7300: 20 40 20 3e 73 74 6f 72 65 6b 65 79 20 21 0a 20 @ >storekey !.
7310: 20 20 20 69 6d 70 6f 72 74 23 6d 61 6e 75 61 6c import#manual
7320: 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 20 import-type !
7330: 36 34 23 2d 31 20 6b 65 79 2d 72 65 61 64 2d 6f 64#-1 key-read-o
7340: 66 66 73 65 74 20 36 34 21 0a 20 20 20 20 64 68 ffset 64!. dh
7350: 74 72 6f 6f 74 2e 6e 32 6f 20 24 40 20 64 6f 2d troot.n2o $@ do-
7360: 6b 65 79 20 20 69 6d 70 6f 72 74 23 6e 65 77 20 key import#new
7370: 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 3b 0a import-type ! ;.
7380: 0a 3a 20 6e 65 77 2d 6b 65 79 20 28 20 6e 69 63 .: new-key ( nic
7390: 6b 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 kaddr u -- ).
73a0: 20 3f 63 68 65 63 6b 2d 72 6e 67 20 5c 20 62 65 ?check-rng \ be
73b0: 66 6f 72 65 20 67 65 6e 65 72 61 74 69 6e 67 20 fore generating
73c0: 61 20 6b 65 79 2c 20 63 68 65 63 6b 20 74 68 65 a key, check the
73d0: 20 72 6e 67 20 66 6f 72 20 68 65 61 6c 74 68 0a rng for health.
73e0: 20 20 20 20 2b 6e 65 77 70 68 72 61 73 65 20 6b +newphrase k
73f0: 65 79 3e 64 65 66 61 75 6c 74 0a 20 20 20 20 6b ey>default. k
7400: 65 79 23 75 73 65 72 20 2b 67 65 6e 2d 6b 65 79 ey#user +gen-key
7410: 73 0a 20 20 20 20 73 65 63 72 65 74 2d 6b 65 79 s. secret-key
7420: 73 23 20 31 2d 20 73 65 63 72 65 74 2d 6b 65 79 s# 1- secret-key
7430: 20 3e 72 61 77 2d 6b 65 79 20 20 6c 61 73 74 6b >raw-key lastk
7440: 65 79 40 20 64 72 6f 70 20 64 65 66 61 75 6c 74 ey@ drop default
7450: 6b 65 79 20 21 0a 20 20 20 20 6f 75 74 2d 6d 65 key !. out-me
7460: 20 2b 64 68 74 72 6f 6f 74 20 73 61 76 65 2d 6b +dhtroot save-k
7470: 65 79 73 20 3b 0a 0a 5c 20 72 65 76 6f 6b 61 74 eys ;..\ revokat
7480: 69 6f 6e 0a 0a 34 20 64 61 74 65 73 69 7a 65 23 ion..4 datesize#
7490: 20 2b 20 6b 65 79 73 69 7a 65 20 39 20 2a 20 2b + keysize 9 * +
74a0: 20 43 6f 6e 73 74 61 6e 74 20 72 65 76 73 69 7a Constant revsiz
74b0: 65 23 0a 0a 56 61 72 69 61 62 6c 65 20 72 65 76 e#..Variable rev
74c0: 74 6f 6b 65 6e 0a 0a 3a 20 30 6f 6c 64 6b 65 79 token..: 0oldkey
74d0: 20 28 20 2d 2d 20 29 20 5c 20 70 75 62 6b 65 79 ( -- ) \ pubkey
74e0: 73 20 63 61 6e 20 73 74 61 79 0a 20 20 20 20 6f s can stay. o
74f0: 6c 64 73 6b 63 20 6b 65 79 73 69 7a 65 20 65 72 ldskc keysize er
7500: 61 73 65 20 20 6f 6c 64 73 6b 72 65 76 20 6b 65 ase oldskrev ke
7510: 79 73 69 7a 65 20 65 72 61 73 65 20 3b 0a 0a 3a ysize erase ;..:
7520: 20 6b 65 79 6d 6f 76 65 20 28 20 61 64 64 72 31 keymove ( addr1
7530: 20 61 64 64 72 32 20 2d 2d 20 29 20 20 6b 65 79 addr2 -- ) key
7540: 73 69 7a 65 20 6d 6f 76 65 20 3b 0a 0a 3a 20 72 size move ;..: r
7550: 65 76 6f 6b 65 2d 76 65 72 69 66 79 20 28 20 61 evoke-verify ( a
7560: 64 64 72 20 75 31 20 70 6b 20 73 74 72 69 6e 67 ddr u1 pk string
7570: 20 75 32 20 2d 2d 20 61 64 64 72 20 75 20 66 6c u2 -- addr u fl
7580: 61 67 20 29 20 72 6f 74 20 3e 72 20 32 3e 72 20 ag ) rot >r 2>r
7590: 63 3a 30 6b 65 79 0a 20 20 20 20 73 69 67 6f 6e c:0key. sigon
75a0: 6c 79 73 69 7a 65 23 20 2d 20 32 64 75 70 20 32 lysize# - 2dup 2
75b0: 72 3e 20 3e 6b 65 79 65 64 2d 68 61 73 68 0a 20 r> >keyed-hash.
75c0: 20 20 20 73 69 67 64 61 74 65 20 2b 64 61 74 65 sigdate +date
75d0: 0a 20 20 20 20 32 64 75 70 20 2b 20 72 3e 20 65 . 2dup + r> e
75e0: 64 2d 76 65 72 69 66 79 20 3b 0a 0a 3a 20 3e 72 d-verify ;..: >r
75f0: 65 76 6f 6b 65 20 28 20 73 6b 72 65 76 20 2d 2d evoke ( skrev --
7600: 20 29 20 20 73 6b 72 65 76 20 6b 65 79 6d 6f 76 ) skrev keymov
7610: 65 20 20 70 6b 63 20 63 68 65 63 6b 2d 72 65 76 e pkc check-rev
7620: 3f 20 30 3d 20 21 21 6e 6f 74 2d 6d 79 2d 72 65 ? 0= !!not-my-re
7630: 76 73 6b 21 21 20 3b 0a 0a 3a 20 2b 72 65 76 73 vsk!! ;..: +revs
7640: 69 67 6e 20 28 20 73 6b 20 70 6b 20 2d 2d 20 29 ign ( sk pk -- )
7650: 20 20 73 6b 73 69 67 20 2d 72 6f 74 20 65 64 2d sksig -rot ed-
7660: 73 69 67 6e 20 72 65 76 74 6f 6b 65 6e 20 24 2b sign revtoken $+
7670: 21 20 62 6c 20 72 65 76 74 6f 6b 65 6e 20 63 24 ! bl revtoken c$
7680: 2b 21 20 3b 0a 0a 3a 20 73 69 67 6e 2d 74 6f 6b +! ;..: sign-tok
7690: 65 6e 2c 20 28 20 73 6b 20 70 6b 20 73 74 72 69 en, ( sk pk stri
76a0: 6e 67 20 75 32 20 2d 2d 20 29 0a 20 20 20 20 63 ng u2 -- ). c
76b0: 3a 30 6b 65 79 20 72 65 76 74 6f 6b 65 6e 20 24 :0key revtoken $
76c0: 40 20 32 73 77 61 70 20 3e 6b 65 79 65 64 2d 68 @ 2swap >keyed-h
76d0: 61 73 68 0a 20 20 20 20 73 69 67 64 61 74 65 20 ash. sigdate
76e0: 2b 64 61 74 65 20 2b 72 65 76 73 69 67 6e 20 3b +date +revsign ;
76f0: 0a 0a 3a 20 72 65 76 6f 6b 65 2d 6b 65 79 20 28 ..: revoke-key (
7700: 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 -- addr u ).
7710: 20 73 6b 63 20 6f 6c 64 73 6b 63 20 6b 65 79 6d skc oldskc keym
7720: 6f 76 65 20 20 70 6b 63 20 6f 6c 64 70 6b 63 20 ove pkc oldpkc
7730: 6b 65 79 6d 6f 76 65 20 20 73 6b 72 65 76 20 6f keymove skrev o
7740: 6c 64 73 6b 72 65 76 20 6b 65 79 6d 6f 76 65 0a ldskrev keymove.
7750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7770: 20 20 20 20 20 20 20 20 20 20 20 5c 20 62 61 63 \ bac
7780: 6b 75 70 20 6b 65 79 73 0a 20 20 20 20 6f 6c 64 kup keys. old
7790: 73 6b 72 65 76 20 6f 6c 64 70 6b 72 65 76 20 73 skrev oldpkrev s
77a0: 6b 3e 70 6b 20 20 20 20 20 20 20 20 20 20 20 20 k>pk
77b0: 20 20 20 20 5c 20 67 65 6e 65 72 61 74 65 20 72 \ generate r
77c0: 65 76 6f 6b 61 74 69 6f 6e 20 70 75 62 6b 65 79 evokation pubkey
77d0: 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 20 20 20 . gen-keys
77e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
77f0: 20 20 20 20 20 20 20 20 20 20 20 20 5c 20 67 65 \ ge
7800: 6e 65 72 61 74 65 20 6e 65 77 20 6b 65 79 73 0a nerate new keys.
7810: 20 20 20 20 70 6b 63 20 6b 65 79 73 69 7a 65 32 pkc keysize2
7820: 20 72 65 76 74 6f 6b 65 6e 20 24 21 20 20 20 20 revtoken $!
7830: 20 20 20 20 20 20 20 20 20 20 20 5c 20 6d 79 20 \ my
7840: 6e 65 77 20 6b 65 79 0a 20 20 20 20 6f 6c 64 70 new key. oldp
7850: 6b 72 65 76 20 6b 65 79 73 69 7a 65 20 72 65 76 krev keysize rev
7860: 74 6f 6b 65 6e 20 24 2b 21 20 20 20 20 20 20 20 token $+!
7870: 20 20 20 5c 20 72 65 76 6f 6b 65 20 74 6f 6b 65 \ revoke toke
7880: 6e 0a 20 20 20 20 6f 6c 64 73 6b 72 65 76 20 6f n. oldskrev o
7890: 6c 64 70 6b 72 65 76 20 22 72 65 76 6f 6b 65 22 ldpkrev "revoke"
78a0: 20 73 69 67 6e 2d 74 6f 6b 65 6e 2c 20 5c 20 72 sign-token, \ r
78b0: 65 76 6f 6b 65 20 73 69 67 6e 61 74 75 72 65 0a evoke signature.
78c0: 20 20 20 20 73 6b 63 20 70 6b 63 20 22 73 65 6c skc pkc "sel
78d0: 66 73 69 67 6e 22 20 73 69 67 6e 2d 74 6f 6b 65 fsign" sign-toke
78e0: 6e 2c 20 20 20 20 20 20 20 20 20 5c 20 73 65 6c n, \ sel
78f0: 66 20 73 69 67 6e 65 64 20 77 69 74 68 20 6e 65 f signed with ne
7900: 77 20 6b 65 79 0a 20 20 20 20 22 21 22 20 72 65 w key. "!" re
7910: 76 74 6f 6b 65 6e 20 30 20 24 69 6e 73 20 20 20 vtoken 0 $ins
7920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7930: 20 5c 20 22 21 22 20 2b 20 6f 6c 64 6b 65 79 6c \ "!" + oldkeyl
7940: 65 6e 2b 6e 65 77 6b 65 79 6c 65 6e 20 74 6f 20 en+newkeylen to
7950: 66 6c 61 67 20 72 65 76 6f 6b 61 74 69 6f 6e 0a flag revokation.
7960: 20 20 20 20 72 65 76 74 6f 6b 65 6e 20 24 40 20 revtoken $@
7970: 67 65 6e 3e 68 6f 73 74 20 32 64 72 6f 70 20 20 gen>host 2drop
7980: 20 20 20 20 20 20 20 20 20 20 20 5c 20 73 69 67 \ sig
7990: 6e 20 68 6f 73 74 20 69 6e 66 6f 72 6d 61 74 69 n host informati
79a0: 6f 6e 20 77 69 74 68 20 6f 6c 64 20 6b 65 79 0a on with old key.
79b0: 20 20 20 20 73 69 67 64 61 74 65 20 2b 64 61 74 sigdate +dat
79c0: 65 20 73 69 67 64 61 74 65 20 64 61 74 65 73 69 e sigdate datesi
79d0: 7a 65 23 20 72 65 76 74 6f 6b 65 6e 20 24 2b 21 ze# revtoken $+!
79e0: 0a 20 20 20 20 6f 6c 64 73 6b 63 20 6f 6c 64 70 . oldskc oldp
79f0: 6b 63 20 2b 72 65 76 73 69 67 6e 0a 20 20 20 20 kc +revsign.
7a00: 30 6f 6c 64 6b 65 79 20 72 65 76 74 6f 6b 65 6e 0oldkey revtoken
7a10: 20 24 40 20 3b 0a 0a 5c 20 69 6e 76 69 74 61 74 $@ ;..\ invitat
7a20: 69 6f 6e 0a 0a 56 61 72 69 61 62 6c 65 20 69 6e ion..Variable in
7a30: 76 69 74 61 74 69 6f 6e 73 0a 0a 65 76 65 6e 74 vitations..event
7a40: 3a 20 2d 3e 69 6e 76 69 74 65 20 28 20 61 64 64 : ->invite ( add
7a50: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 2e 22 20 r u -- ). ."
7a60: 69 6e 76 69 74 65 20 6d 65 3a 20 22 20 6f 76 65 invite me: " ove
7a70: 72 20 3e 72 20 2e 70 6b 32 6b 65 79 24 20 63 72 r >r .pk2key$ cr
7a80: 20 72 3e 20 66 72 65 65 20 74 68 72 6f 77 20 63 r> free throw c
7a90: 74 72 6c 20 4c 20 69 6e 73 6b 65 79 20 3b 0a 65 trl L inskey ;.e
7aa0: 76 65 6e 74 3a 20 2d 3e 77 61 6b 65 6d 65 20 28 vent: ->wakeme (
7ab0: 20 6f 20 2d 2d 20 29 20 3c 65 76 65 6e 74 20 2d o -- ) <event -
7ac0: 3e 77 61 6b 65 20 65 76 65 6e 74 3e 20 3b 0a 0a >wake event> ;..
7ad0: 3a 20 70 6b 32 6b 65 79 24 2d 61 64 64 20 28 20 : pk2key$-add (
7ae0: 61 64 64 72 20 75 20 70 65 72 6d 20 2d 2d 20 29 addr u perm -- )
7af0: 20 7b 20 70 65 72 6d 20 7d 0a 20 20 20 20 73 61 { perm }. sa
7b00: 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 69 6d 70 6f mple-key >o impo
7b10: 72 74 23 69 6e 76 69 74 65 64 20 69 6d 70 6f 72 rt#invited impor
7b20: 74 2d 74 79 70 65 20 21 20 63 6d 64 3a 6e 65 73 t-type ! cmd:nes
7b30: 74 73 69 67 0a 20 20 20 20 70 65 72 6d 20 6b 65 tsig. perm ke
7b40: 2d 6d 61 73 6b 20 21 0a 20 20 20 20 69 6d 70 6f -mask !. impo
7b50: 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 79 rt#new import-ty
7b60: 70 65 20 21 20 20 73 61 76 65 2d 70 75 62 6b 65 pe ! save-pubke
7b70: 79 73 20 6f 3e 20 3b 0a 0a 3a 20 78 2d 65 72 61 ys o> ;..: x-era
7b80: 73 65 20 28 20 6c 65 6e 20 2d 2d 20 29 0a 20 20 se ( len -- ).
7b90: 20 20 64 75 70 20 78 62 61 63 6b 2d 72 65 73 74 dup xback-rest
7ba0: 6f 72 65 20 20 64 75 70 20 73 70 61 63 65 73 20 ore dup spaces
7bb0: 20 78 62 61 63 6b 2d 72 65 73 74 6f 72 65 20 3b xback-restore ;
7bc0: 0a 0a 3a 20 69 6e 76 69 74 65 2d 6b 65 79 20 28 ..: invite-key (
7bd0: 20 61 64 64 72 20 75 20 2d 2d 20 6b 65 79 20 29 addr u -- key )
7be0: 0a 20 20 20 20 32 64 75 70 20 78 2d 77 69 64 74 . 2dup x-widt
7bf0: 68 20 7b 20 61 64 64 72 20 75 20 6c 65 6e 20 7d h { addr u len }
7c00: 0a 20 20 20 20 42 45 47 49 4e 20 20 61 64 64 72 . BEGIN addr
7c10: 20 75 20 74 79 70 65 20 6b 65 79 20 20 6c 65 6e u type key len
7c20: 20 78 2d 65 72 61 73 65 0a 09 64 75 70 20 63 74 x-erase..dup ct
7c30: 72 6c 20 5a 20 3d 0a 20 20 20 20 57 48 49 4c 45 rl Z =. WHILE
7c40: 20 20 64 72 6f 70 20 20 42 45 47 49 4e 20 20 6b drop BEGIN k
7c50: 65 79 20 63 74 72 6c 20 4c 20 3d 20 20 55 4e 54 ey ctrl L = UNT
7c60: 49 4c 20 20 52 45 50 45 41 54 20 3b 0a 0a 3a 20 IL REPEAT ;..:
7c70: 70 72 6f 63 65 73 73 2d 69 6e 76 69 74 61 74 69 process-invitati
7c80: 6f 6e 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 on ( addr u -- )
7c90: 0a 20 20 20 20 73 22 20 69 6e 76 69 74 65 20 28 . s" invite (
7ca0: 79 2f 6e 2f 62 29 3f 22 20 69 6e 76 69 74 65 2d y/n/b)?" invite-
7cb0: 6b 65 79 0a 20 20 20 20 63 61 73 65 0a 09 27 79 key. case..'y
7cc0: 27 20 6f 66 20 20 70 65 72 6d 25 64 65 66 61 75 ' of perm%defau
7cd0: 6c 74 20 70 6b 32 6b 65 79 24 2d 61 64 64 20 20 lt pk2key$-add
7ce0: 2e 22 20 61 64 64 65 64 22 20 63 72 20 20 20 65 ." added" cr e
7cf0: 6e 64 6f 66 0a 09 27 62 27 20 6f 66 20 20 70 65 ndof..'b' of pe
7d00: 72 6d 25 62 6c 6f 63 6b 65 64 20 70 6b 32 6b 65 rm%blocked pk2ke
7d10: 79 24 2d 61 64 64 20 20 2e 22 20 62 6c 6f 63 6b y$-add ." block
7d20: 65 64 22 20 63 72 20 65 6e 64 6f 66 0a 09 32 64 ed" cr endof..2d
7d30: 72 6f 70 20 2e 22 20 69 67 6e 6f 72 65 64 22 20 rop ." ignored"
7d40: 63 72 0a 20 20 20 20 65 6e 64 63 61 73 65 20 3b cr. endcase ;
7d50: 0a 0a 3a 20 66 69 6c 74 65 72 2d 69 6e 76 69 74 ..: filter-invit
7d60: 61 74 69 6f 6e 3f 20 28 20 61 64 64 72 20 75 20 ation? ( addr u
7d70: 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 73 69 -- flag ). si
7d80: 67 70 6b 32 73 69 7a 65 23 20 2d 20 2b 20 6b 65 gpk2size# - + ke
7d90: 79 73 69 7a 65 20 6b 65 79 23 20 23 40 20 64 30 ysize key# #@ d0
7da0: 3c 3e 20 3b 20 5c 20 61 6c 72 65 61 64 79 20 74 <> ; \ already t
7db0: 68 65 72 65 0a 0a 3a 20 2e 69 6e 76 69 74 61 74 here..: .invitat
7dc0: 69 6f 6e 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 ions ( -- ).
7dd0: 69 6e 76 69 74 61 74 69 6f 6e 73 20 5b 3a 20 32 invitations [: 2
7de0: 64 75 70 20 2e 70 6b 32 6b 65 79 24 20 63 72 20 dup .pk2key$ cr
7df0: 70 72 6f 63 65 73 73 2d 69 6e 76 69 74 61 74 69 process-invitati
7e00: 6f 6e 20 3b 5d 20 24 5b 5d 6d 61 70 0a 20 20 20 on ;] $[]map.
7e10: 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 24 5b 5d invitations $[]
7e20: 6f 66 66 20 3b 0a 0a 3a 20 3e 69 6e 76 69 74 61 off ;..: >invita
7e30: 74 69 6f 6e 73 20 28 20 61 64 64 72 20 75 20 2d tions ( addr u -
7e40: 2d 20 29 0a 20 20 20 20 32 64 75 70 20 66 69 6c - ). 2dup fil
7e50: 74 65 72 2d 69 6e 76 69 74 61 74 69 6f 6e 3f 20 ter-invitation?
7e60: 49 46 20 20 32 64 72 6f 70 20 45 58 49 54 20 20 IF 2drop EXIT
7e70: 54 48 45 4e 0a 20 20 20 20 69 6e 76 69 74 61 74 THEN. invitat
7e80: 69 6f 6e 73 20 24 5b 5d 23 20 3e 72 0a 20 20 20 ions $[]# >r.
7e90: 20 32 64 75 70 20 69 6e 76 69 74 61 74 69 6f 6e 2dup invitation
7ea0: 73 20 24 69 6e 73 5b 5d 73 69 67 20 64 72 6f 70 s $ins[]sig drop
7eb0: 0a 20 20 20 20 69 6e 76 69 74 61 74 69 6f 6e 73 . invitations
7ec0: 20 24 5b 5d 23 20 72 3e 20 3c 3e 20 49 46 0a 09 $[]# r> <> IF..
7ed0: 73 61 76 65 2d 6d 65 6d 20 6d 61 69 6e 2d 75 70 save-mem main-up
7ee0: 40 20 3c 68 69 64 65 3e 0a 09 3c 65 76 65 6e 74 @ <hide>..<event
7ef0: 20 65 24 2c 20 2d 3e 69 6e 76 69 74 65 20 75 70 e$, ->invite up
7f00: 40 20 65 6c 69 74 2c 20 2d 3e 77 61 6b 65 6d 65 @ elit, ->wakeme
7f10: 20 6d 61 69 6e 2d 75 70 40 20 65 76 65 6e 74 3e main-up@ event>
7f20: 20 73 74 6f 70 0a 20 20 20 20 45 4c 53 45 20 20 stop. ELSE
7f30: 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 3a 2drop THEN ;..:
7f40: 20 73 65 6e 64 2d 69 6e 76 69 74 61 74 69 6f 6e send-invitation
7f50: 20 28 20 70 6b 20 75 20 2d 2d 20 29 0a 20 20 20 ( pk u -- ).
7f60: 20 73 65 74 75 70 21 20 6d 79 70 6b 32 6e 69 63 setup! mypk2nic
7f70: 6b 24 20 32 3e 72 0a 20 20 20 20 67 65 6e 2d 74 k$ 2>r. gen-t
7f80: 6d 70 6b 65 79 73 20 64 72 6f 70 20 74 73 6b 63 mpkeys drop tskc
7f90: 20 73 77 61 70 20 6b 65 79 70 61 64 20 65 64 2d swap keypad ed-
7fa0: 64 68 20 64 6f 2d 6b 65 79 70 61 64 20 73 65 63 dh do-keypad sec
7fb0: 21 0a 20 20 20 20 6e 65 74 32 6f 2d 63 6f 64 65 !. net2o-code
7fc0: 30 0a 20 20 20 20 74 70 6b 63 20 6b 65 79 73 69 0. tpkc keysi
7fd0: 7a 65 20 24 2c 20 6f 6e 65 73 68 6f 74 2d 74 6d ze $, oneshot-tm
7fe0: 70 6b 65 79 0a 20 20 20 20 6e 65 73 74 5b 20 32 pkey. nest[ 2
7ff0: 72 3e 20 24 2c 20 69 6e 76 69 74 65 20 5d 74 6d r> $, invite ]tm
8000: 70 6e 65 73 74 0a 20 20 20 20 63 6f 6f 6b 69 65 pnest. cookie
8010: 2b 72 65 71 75 65 73 74 0a 20 20 20 20 65 6e 64 +request. end
8020: 2d 63 6f 64 65 7c 20 3b 0a 0a 5c 20 6b 65 79 20 -code| ;..\ key
8030: 61 70 69 20 68 65 6c 70 65 72 73 0a 0a 3a 20 64 api helpers..: d
8040: 65 6c 2d 6c 61 73 74 2d 6b 65 79 20 28 20 2d 2d el-last-key ( --
8050: 20 29 0a 20 20 20 20 6b 65 79 73 20 24 5b 5d 23 ). keys $[]#
8060: 20 31 2d 20 6b 65 79 73 20 24 5b 5d 20 73 65 63 1- keys $[] sec
8070: 2d 6f 66 66 0a 20 20 20 20 6b 65 79 73 20 24 40 -off. keys $@
8080: 6c 65 6e 20 63 65 6c 6c 2d 20 6b 65 79 73 20 24 len cell- keys $
8090: 21 6c 65 6e 20 3b 0a 0a 3a 20 73 74 6f 72 65 6b !len ;..: storek
80a0: 65 79 21 20 28 20 2d 2d 20 29 0a 20 20 20 20 3e ey! ( -- ). >
80b0: 73 65 63 6b 65 79 20 6b 65 79 73 20 24 5b 5d 23 seckey keys $[]#
80c0: 20 30 20 3f 44 4f 20 20 32 64 75 70 20 49 20 6b 0 ?DO 2dup I k
80d0: 65 79 73 20 73 65 63 5b 5d 40 20 73 74 72 3d 20 eys sec[]@ str=
80e0: 49 46 0a 09 20 20 20 20 49 20 6b 65 79 73 20 73 IF.. I keys s
80f0: 65 63 5b 5d 40 20 64 72 6f 70 20 3e 73 74 6f 72 ec[]@ drop >stor
8100: 65 6b 65 79 20 21 20 20 4c 45 41 56 45 20 20 54 ekey ! LEAVE T
8110: 48 45 4e 20 20 4c 4f 4f 50 20 20 32 64 72 6f 70 HEN LOOP 2drop
8120: 20 3b 0a 0a 3a 20 63 68 6f 6f 73 65 2d 6b 65 79 ;..: choose-key
8130: 20 28 20 2d 2d 20 6f 20 29 0a 20 20 20 20 30 20 ( -- o ). 0
8140: 42 45 47 49 4e 20 20 64 72 6f 70 0a 09 2e 22 20 BEGIN drop..."
8150: 43 68 6f 6f 73 65 20 6b 65 79 20 62 79 20 6e 75 Choose key by nu
8160: 6d 62 65 72 3a 22 20 63 72 20 2e 73 65 63 72 65 mber:" cr .secre
8170: 74 2d 6e 69 63 6b 73 0a 09 42 45 47 49 4e 20 20 t-nicks..BEGIN
8180: 6b 65 79 20 64 75 70 20 62 6c 20 3c 20 57 48 49 key dup bl < WHI
8190: 4c 45 20 20 64 72 6f 70 20 20 52 45 50 45 41 54 LE drop REPEAT
81a0: 20 5c 20 73 77 61 6c 6c 6f 77 20 63 6f 6e 74 72 \ swallow contr
81b0: 6f 6c 20 6b 65 79 73 0a 09 5b 27 5d 20 64 69 67 ol keys..['] dig
81c0: 69 74 3f 20 23 33 36 20 62 61 73 65 2d 65 78 65 it? #36 base-exe
81d0: 63 75 74 65 20 30 3d 20 49 46 20 2d 31 20 54 48 cute 0= IF -1 TH
81e0: 45 4e 0a 09 73 65 63 72 65 74 2d 6b 65 79 20 64 EN..secret-key d
81f0: 75 70 20 30 3d 20 57 48 49 4c 45 0a 09 20 20 20 up 0= WHILE..
8200: 20 2e 22 20 50 6c 65 61 73 65 20 65 6e 74 65 72 ." Please enter
8210: 20 61 20 62 61 73 65 2d 33 36 20 6e 75 6d 62 65 a base-36 numbe
8220: 72 20 62 65 74 77 65 65 6e 20 30 20 61 6e 64 20 r between 0 and
8230: 22 0a 09 20 20 20 20 73 65 63 72 65 74 2d 6b 65 ".. secret-ke
8240: 79 73 23 20 31 2d 20 5b 27 5d 20 2e 20 23 33 36 ys# 1- ['] . #36
8250: 20 62 61 73 65 2d 65 78 65 63 75 74 65 20 63 72 base-execute cr
8260: 20 20 72 64 72 6f 70 0a 20 20 20 20 52 45 50 45 rdrop. REPE
8270: 41 54 0a 20 20 20 20 64 75 70 20 2e 73 74 6f 72 AT. dup .stor
8280: 65 6b 65 79 21 20 20 3e 73 74 6f 72 65 6b 65 79 ekey! >storekey
8290: 20 40 20 64 65 66 61 75 6c 74 6b 65 79 20 21 0a @ defaultkey !.
82a0: 20 20 20 20 2e 22 20 3d 3d 3d 3d 20 6b 65 79 20 ." ==== key
82b0: 22 20 64 75 70 20 2e 2e 6e 69 63 6b 20 2e 22 20 " dup ..nick ."
82c0: 20 63 68 6f 73 65 6e 20 3d 3d 3d 3d 22 20 63 72 chosen ====" cr
82d0: 20 3b 0a 0a 5c 20 77 69 6c 6c 20 61 73 6b 20 66 ;..\ will ask f
82e0: 6f 72 20 79 6f 75 72 20 70 61 73 73 77 6f 72 64 or your password
82f0: 20 61 6e 64 20 69 66 20 70 6f 73 73 69 62 6c 65 and if possible
8300: 20 61 75 74 6f 2d 73 65 6c 65 63 74 20 79 6f 75 auto-select you
8310: 72 20 69 64 0a 0a 56 61 72 69 61 62 6c 65 20 74 r id..Variable t
8320: 72 69 65 73 23 0a 23 31 30 20 56 61 6c 75 65 20 ries#.#10 Value
8330: 6d 61 78 74 72 69 65 73 23 0a 0a 3a 20 67 65 74 maxtries#..: get
8340: 2d 73 6b 63 20 28 20 2d 2d 20 29 0a 20 20 20 20 -skc ( -- ).
8350: 73 65 63 72 65 74 2d 6b 65 79 73 23 20 3f 45 58 secret-keys# ?EX
8360: 49 54 20 20 74 72 69 65 73 23 20 6f 66 66 0a 20 IT tries# off.
8370: 20 20 20 64 65 62 75 67 2d 76 65 63 74 6f 72 20 debug-vector
8380: 40 20 6f 70 2d 76 65 63 74 6f 72 20 21 40 20 3e @ op-vector !@ >
8390: 72 20 3c 64 65 66 61 75 6c 74 3e 0a 20 20 20 20 r <default>.
83a0: 73 65 63 72 65 74 2d 6b 65 79 73 23 0a 20 20 20 secret-keys#.
83b0: 20 42 45 47 49 4e 20 20 64 75 70 20 30 3d 20 74 BEGIN dup 0= t
83c0: 72 69 65 73 23 20 40 20 6d 61 78 74 72 69 65 73 ries# @ maxtries
83d0: 23 20 75 3c 20 61 6e 64 20 20 57 48 49 4c 45 20 # u< and WHILE
83e0: 64 72 6f 70 0a 09 20 20 20 20 73 22 20 50 61 73 drop.. s" Pas
83f0: 73 70 68 72 61 73 65 3a 20 22 20 2b 70 61 73 73 sphrase: " +pass
8400: 70 68 72 61 73 65 20 20 20 21 74 69 6d 65 0a 09 phrase !time..
8410: 20 20 20 20 72 65 61 64 2d 6b 65 79 73 20 73 65 read-keys se
8420: 63 72 65 74 2d 6b 65 79 73 23 20 64 75 70 20 30 cret-keys# dup 0
8430: 3d 20 49 46 0a 09 09 5c 20 66 61 69 6c 20 72 69 = IF...\ fail ri
8440: 67 68 74 20 61 66 74 65 72 20 74 68 65 20 66 69 ght after the fi
8450: 72 73 74 20 74 72 79 20 69 66 20 50 41 53 53 50 rst try if PASSP
8460: 48 52 41 53 45 20 69 73 20 75 73 65 64 0a 09 09 HRASE is used...
8470: 5c 20 61 6e 64 20 67 69 76 65 20 74 68 65 20 6d \ and give the m
8480: 61 78 69 6d 75 6d 20 77 61 69 74 69 6e 67 20 70 aximum waiting p
8490: 65 6e 61 6c 74 79 20 69 6e 20 74 68 61 74 20 63 enalty in that c
84a0: 61 73 65 0a 09 09 31 20 6d 61 78 74 72 69 65 73 ase...1 maxtries
84b0: 23 20 73 22 20 50 41 53 53 50 48 52 41 53 45 22 # s" PASSPHRASE"
84c0: 20 67 65 74 65 6e 76 20 64 30 3d 20 73 65 6c 65 getenv d0= sele
84d0: 63 74 20 74 72 69 65 73 23 20 2b 21 0a 09 09 3c ct tries# +!...<
84e0: 65 72 72 3e 20 2e 22 20 54 72 79 23 20 22 20 74 err> ." Try# " t
84f0: 72 69 65 73 23 20 40 20 30 20 2e 72 20 27 2f 27 ries# @ 0 .r '/'
8500: 20 65 6d 69 74 20 6d 61 78 74 72 69 65 73 23 20 emit maxtries#
8510: 2e 0a 09 09 2e 22 20 66 61 69 6c 65 64 2c 20 6e ....." failed, n
8520: 6f 20 6b 65 79 20 66 6f 75 6e 64 2c 20 77 61 69 o key found, wai
8530: 74 69 6e 67 20 22 0a 09 09 23 31 20 74 72 69 65 ting "...#1 trie
8540: 73 23 20 40 20 32 2a 20 6c 73 68 69 66 74 20 64 s# @ 2* lshift d
8550: 75 70 20 2e 20 2e 22 20 6d 73 2e 2e 2e 22 20 6d up . ." ms..." m
8560: 73 20 20 3c 64 65 66 61 75 6c 74 3e 20 63 72 0a s <default> cr.
8570: 09 09 64 65 6c 2d 6c 61 73 74 2d 6b 65 79 0a 09 ..del-last-key..
8580: 20 20 20 20 54 48 45 4e 0a 20 20 20 20 52 45 50 THEN. REP
8590: 45 41 54 0a 20 20 20 20 64 75 70 20 30 3d 20 49 EAT. dup 0= I
85a0: 46 20 20 23 2d 35 36 20 74 68 72 6f 77 20 20 54 F #-56 throw T
85b0: 48 45 4e 0a 20 20 20 20 31 20 3d 20 49 46 20 20 HEN. 1 = IF
85c0: 30 20 73 65 63 72 65 74 2d 6b 65 79 0a 09 2e 22 0 secret-key..."
85d0: 20 3d 3d 3d 3d 20 6f 70 65 6e 65 64 3a 20 22 20 ==== opened: "
85e0: 64 75 70 20 2e 2e 6e 69 63 6b 20 2e 22 20 20 69 dup ..nick ." i
85f0: 6e 20 22 20 2e 74 69 6d 65 20 2e 22 20 3d 3d 3d n " .time ." ===
8600: 3d 22 20 63 72 0a 20 20 20 20 45 4c 53 45 20 20 =" cr. ELSE
8610: 2e 22 20 3d 3d 3d 3d 20 6f 70 65 6e 65 64 20 69 ." ==== opened i
8620: 6e 20 22 20 2e 74 69 6d 65 20 2e 22 20 3d 3d 3d n " .time ." ===
8630: 3d 22 20 63 72 20 63 68 6f 6f 73 65 2d 6b 65 79 =" cr choose-key
8640: 20 20 54 48 45 4e 0a 20 20 20 20 3e 72 61 77 2d THEN. >raw-
8650: 6b 65 79 20 3f 72 73 6b 20 20 20 72 3e 20 6f 70 key ?rsk r> op
8660: 2d 76 65 63 74 6f 72 20 21 20 3b 0a 0a 73 63 6f -vector ! ;..sco
8670: 70 65 3a 20 6e 32 6f 0a 46 6f 72 77 61 72 64 20 pe: n2o.Forward
8680: 68 65 6c 70 0a 7d 73 63 6f 70 65 0a 0a 3a 20 67 help.}scope..: g
8690: 65 74 2d 6d 79 2d 6b 65 79 20 28 20 2d 2d 20 78 et-my-key ( -- x
86a0: 74 20 29 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 t ). gen-keys
86b0: 2d 64 69 72 20 20 22 73 65 63 6b 65 79 73 2e 6b -dir "seckeys.k
86c0: 32 6f 22 20 2e 6b 65 79 73 2f 20 32 64 75 70 20 2o" .keys/ 2dup
86d0: 66 69 6c 65 2d 73 74 61 74 75 73 20 6e 69 70 0a file-status nip.
86e0: 20 20 20 20 30 3d 20 49 46 20 20 72 2f 6f 20 6f 0= IF r/o o
86f0: 70 65 6e 2d 66 69 6c 65 20 74 68 72 6f 77 20 3e pen-file throw >
8700: 72 20 72 40 20 66 69 6c 65 2d 73 69 7a 65 20 74 r r@ file-size t
8710: 68 72 6f 77 20 64 30 3d 0a 09 72 3e 20 63 6c 6f hrow d0=..r> clo
8720: 73 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 20 45 se-file throw E
8730: 4c 53 45 20 20 74 72 75 65 20 20 54 48 45 4e 0a LSE true THEN.
8740: 20 20 20 20 49 46 20 20 5b 3a 20 2e 22 20 47 65 IF [: ." Ge
8750: 6e 65 72 61 74 65 20 61 20 6e 65 77 20 6b 65 79 nerate a new key
8760: 70 61 69 72 3a 22 20 63 72 0a 09 20 20 67 65 74 pair:" cr.. get
8770: 2d 6e 69 63 6b 20 64 75 70 20 30 3d 20 23 2d 35 -nick dup 0= #-5
8780: 36 20 61 6e 64 20 74 68 72 6f 77 20 5c 20 65 6d 6 and throw \ em
8790: 70 74 79 20 6e 69 63 6b 3a 20 70 72 65 74 65 6e pty nick: preten
87a0: 64 20 74 6f 20 71 75 69 74 0a 09 20 20 6e 65 77 d to quit.. new
87b0: 2d 6b 65 79 20 2e 6b 65 79 73 20 3f 72 73 6b 20 -key .keys ?rsk
87c0: 3b 5d 0a 20 20 20 20 45 4c 53 45 20 20 5b 27 5d ;]. ELSE [']
87d0: 20 67 65 74 2d 73 6b 63 20 20 54 48 45 4e 20 3b get-skc THEN ;
87e0: 0a 0a 3a 20 2e 6b 65 79 69 6e 66 6f 20 28 20 2d ..: .keyinfo ( -
87f0: 2d 20 29 0a 20 20 20 20 3c 77 61 72 6e 3e 20 2e - ). <warn> .
8800: 22 20 3d 3d 3d 3d 20 4e 6f 20 6b 65 79 20 6f 70 " ==== No key op
8810: 65 6e 65 64 20 3d 3d 3d 3d 22 20 63 72 0a 20 20 ened ====" cr.
8820: 20 20 3c 69 6e 66 6f 3e 20 2e 22 20 67 65 6e 65 <info> ." gene
8830: 72 61 74 65 20 61 20 6e 65 77 20 6f 6e 65 20 77 rate a new one w
8840: 69 74 68 20 27 6b 65 79 67 65 6e 27 22 20 63 72 ith 'keygen'" cr
8850: 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 0a 3a 20 <default> ;..:
8860: 67 65 74 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 20 get-me ( -- ).
8870: 20 20 67 65 74 2d 6d 79 2d 6b 65 79 20 63 61 74 get-my-key cat
8880: 63 68 20 64 75 70 20 23 2d 35 36 20 3d 20 49 46 ch dup #-56 = IF
8890: 20 64 72 6f 70 20 2e 6b 65 79 69 6e 66 6f 20 45 drop .keyinfo E
88a0: 4c 53 45 20 74 68 72 6f 77 20 54 48 45 4e 20 3b LSE throw THEN ;
88b0: 0a 0a 3a 20 3f 67 65 74 2d 6d 65 20 28 20 2d 2d ..: ?get-me ( --
88c0: 20 29 0a 20 20 20 20 5c 47 20 74 68 69 73 20 76 ). \G this v
88d0: 65 72 73 69 6f 6e 20 6f 66 20 67 65 74 2d 6d 65 ersion of get-me
88e0: 20 66 61 69 6c 73 20 68 61 72 64 20 69 66 20 6e fails hard if n
88f0: 6f 20 6b 65 79 20 69 73 20 6f 70 65 6e 65 64 0a o key is opened.
8900: 20 20 20 20 67 65 74 2d 6d 79 2d 6b 65 79 20 63 get-my-key c
8910: 61 74 63 68 20 23 2d 35 36 20 3d 20 49 46 0a 09 atch #-56 = IF..
8920: 2e 6b 65 79 69 6e 66 6f 20 74 72 75 65 20 21 21 .keyinfo true !!
8930: 6e 6f 2d 6b 65 79 2d 6f 70 65 6e 21 21 0a 20 20 no-key-open!!.
8940: 20 20 54 48 45 4e 20 3b 0a 0a 30 20 5b 49 46 5d THEN ;..0 [IF]
8950: 0a 4c 6f 63 61 6c 20 56 61 72 69 61 62 6c 65 73 .Local Variables
8960: 3a 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 77 6f :.forth-local-wo
8970: 72 64 73 3a 0a 20 20 20 20 28 0a 20 20 20 20 20 rds:. (.
8980: 28 28 22 6e 65 74 32 6f 3a 22 20 22 2b 6e 65 74 (("net2o:" "+net
8990: 32 6f 3a 22 29 20 64 65 66 69 6e 69 74 69 6f 6e 2o:") definition
89a0: 2d 73 74 61 72 74 65 72 20 28 66 6f 6e 74 2d 6c -starter (font-l
89b0: 6f 63 6b 2d 6b 65 79 77 6f 72 64 2d 66 61 63 65 ock-keyword-face
89c0: 20 2e 20 31 29 0a 20 20 20 20 20 20 22 5b 20 5c . 1). "[ \
89d0: 74 5c 6e 5d 22 20 74 20 6e 61 6d 65 20 28 66 6f t\n]" t name (fo
89e0: 6e 74 2d 6c 6f 63 6b 2d 66 75 6e 63 74 69 6f 6e nt-lock-function
89f0: 2d 6e 61 6d 65 2d 66 61 63 65 20 2e 20 33 29 29 -name-face . 3))
8a00: 0a 20 20 20 20 20 28 28 22 64 65 62 75 67 3a 22 . (("debug:"
8a10: 20 22 66 69 65 6c 64 3a 22 20 22 32 66 69 65 6c "field:" "2fiel
8a20: 64 3a 22 20 22 73 66 66 69 65 6c 64 3a 22 20 22 d:" "sffield:" "
8a30: 64 66 66 69 65 6c 64 3a 22 20 22 36 34 66 69 65 dffield:" "64fie
8a40: 6c 64 3a 22 20 22 75 76 61 72 22 20 22 75 76 61 ld:" "uvar" "uva
8a50: 6c 75 65 22 29 20 6e 6f 6e 2d 69 6d 6d 65 64 69 lue") non-immedi
8a60: 61 74 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 74 ate (font-lock-t
8a70: 79 70 65 2d 66 61 63 65 20 2e 20 32 29 0a 20 20 ype-face . 2).
8a80: 20 20 20 20 22 5b 20 5c 74 5c 6e 5d 22 20 74 20 "[ \t\n]" t
8a90: 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d name (font-lock-
8aa0: 76 61 72 69 61 62 6c 65 2d 6e 61 6d 65 2d 66 61 variable-name-fa
8ab0: 63 65 20 2e 20 33 29 29 0a 20 20 20 20 20 28 22 ce . 3)). ("
8ac0: 5b 61 2d 7a 30 2d 39 5d 2b 28 22 20 69 6d 6d 65 [a-z0-9]+(" imme
8ad0: 64 69 61 74 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b diate (font-lock
8ae0: 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 65 20 2e 20 -comment-face .
8af0: 31 29 0a 20 20 20 20 20 20 22 29 22 20 6e 69 6c 1). ")" nil
8b00: 20 63 6f 6d 6d 65 6e 74 20 28 66 6f 6e 74 2d 6c comment (font-l
8b10: 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 65 ock-comment-face
8b20: 20 2e 20 31 29 29 0a 20 20 20 20 29 0a 66 6f 72 . 1)). ).for
8b30: 74 68 2d 6c 6f 63 61 6c 2d 69 6e 64 65 6e 74 2d th-local-indent-
8b40: 77 6f 72 64 73 3a 0a 20 20 20 20 28 0a 20 20 20 words:. (.
8b50: 20 20 28 28 22 6e 65 74 32 6f 3a 22 20 22 2b 6e (("net2o:" "+n
8b60: 65 74 32 6f 3a 22 29 20 28 30 20 2e 20 32 29 20 et2o:") (0 . 2)
8b70: 28 30 20 2e 20 32 29 20 6e 6f 6e 2d 69 6d 6d 65 (0 . 2) non-imme
8b80: 64 69 61 74 65 29 0a 20 20 20 20 20 28 28 22 5b diate). (("[
8b90: 3a 22 20 22 6b 65 79 3a 63 6f 64 65 22 29 20 28 :" "key:code") (
8ba0: 30 20 2e 20 31 29 20 28 30 20 2e 20 31 29 20 69 0 . 1) (0 . 1) i
8bb0: 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 20 28 mmediate). (
8bc0: 28 22 3b 5d 22 20 22 65 6e 64 3a 6b 65 79 22 29 (";]" "end:key")
8bd0: 20 28 2d 31 20 2e 20 30 29 20 28 30 20 2e 20 2d (-1 . 0) (0 . -
8be0: 31 29 20 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 1) immediate).
8bf0: 20 20 29 0a 45 6e 64 3a 0a 5b 54 48 45 4e 5d ).End:.[THEN]