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 31 new bounds DO..1
11c0: 20 49 20 69 6d 70 6f 72 74 73 24 20 2d 20 6c 73 I imports$ - ls
11d0: 68 69 66 74 20 3e 69 6d 2d 63 6f 6c 6f 72 0a 09 hift >im-color..
11e0: 64 75 70 20 31 20 61 6e 64 20 49 46 20 20 49 20 dup 1 and IF I
11f0: 63 40 20 65 6d 69 74 20 20 54 48 45 4e 20 20 32 c@ emit THEN 2
1200: 2f 20 4c 4f 4f 50 0a 20 20 20 20 64 72 6f 70 20 / LOOP. drop
1210: 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 0a 43 72 65 <default> ;..Cre
1220: 61 74 65 20 69 6d 70 6f 72 74 2d 6e 61 6d 65 24 ate import-name$
1230: 0a 22 49 20 6d 79 73 65 6c 66 22 20 73 2c 20 22 ."I myself" s, "
1240: 6d 61 6e 75 61 6c 22 20 73 2c 20 22 73 63 61 6e manual" s, "scan
1250: 22 20 73 2c 20 22 63 68 61 74 22 20 73 2c 20 22 " s, "chat" s, "
1260: 64 68 74 22 20 73 2c 20 22 69 6e 76 69 74 65 64 dht" s, "invited
1270: 22 20 73 2c 20 22 75 6e 74 72 75 73 74 65 64 22 " s, "untrusted"
1280: 20 73 2c 0a 0a 3a 20 2e 69 6d 70 6f 72 74 2d 63 s,..: .import-c
1290: 6f 6c 6f 72 73 20 28 20 2d 2d 20 29 0a 20 20 20 olors ( -- ).
12a0: 20 69 6d 70 6f 72 74 2d 6e 61 6d 65 24 0a 20 20 import-name$.
12b0: 20 20 69 6d 70 6f 72 74 23 75 6e 74 72 75 73 74 import#untrust
12c0: 65 64 20 31 2b 20 30 20 3f 44 4f 0a 09 31 20 49 ed 1+ 0 ?DO..1 I
12d0: 20 6c 73 68 69 66 74 20 3e 69 6d 2d 63 6f 6c 6f lshift >im-colo
12e0: 72 20 63 6f 75 6e 74 20 32 64 75 70 20 74 79 70 r count 2dup typ
12f0: 65 20 3c 64 65 66 61 75 6c 74 3e 20 73 70 61 63 e <default> spac
1300: 65 20 2b 20 61 6c 69 67 6e 65 64 0a 20 20 20 20 e + aligned.
1310: 4c 4f 4f 50 20 64 72 6f 70 20 3b 0a 0a 5c 20 73 LOOP drop ;..\ s
1320: 61 6d 70 6c 65 20 6b 65 79 0a 0a 6b 65 79 2d 65 ample key..key-e
1330: 6e 74 72 79 20 27 20 6e 65 77 20 73 74 61 74 69 ntry ' new stati
1340: 63 2d 61 20 77 69 74 68 2d 61 6c 6c 6f 63 61 74 c-a with-allocat
1350: 65 72 20 43 6f 6e 73 74 61 6e 74 20 73 61 6d 70 er Constant samp
1360: 6c 65 2d 6b 65 79 0a 0a 56 61 72 69 61 62 6c 65 le-key..Variable
1370: 20 6b 65 79 23 20 5c 20 6b 65 79 20 68 61 73 68 key# \ key hash
1380: 20 74 61 62 6c 65 0a 56 61 72 69 61 62 6c 65 20 table.Variable
1390: 6e 69 63 6b 23 20 5c 20 6e 69 63 6b 20 68 61 73 nick# \ nick has
13a0: 68 20 74 61 62 6c 65 0a 0a 36 34 56 61 72 69 61 h table..64Varia
13b0: 62 6c 65 20 6b 65 79 2d 72 65 61 64 2d 6f 66 66 ble key-read-off
13c0: 73 65 74 0a 0a 3a 20 63 75 72 72 65 6e 74 2d 6b set..: current-k
13d0: 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 6f ey ( addr u -- o
13e0: 20 29 0a 20 20 20 20 32 64 75 70 20 6b 65 79 7c ). 2dup key|
13f0: 20 6b 65 79 23 20 23 40 20 64 72 6f 70 0a 20 20 key# #@ drop.
1400: 20 20 64 75 70 20 30 3d 20 49 46 20 20 64 72 6f dup 0= IF dro
1410: 70 20 2e 22 20 75 6e 6b 6e 6f 77 6e 20 6b 65 79 p ." unknown key
1420: 3a 20 22 20 38 35 74 79 70 65 20 63 72 20 20 30 : " 85type cr 0
1430: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 EXIT THEN.
1440: 63 65 6c 6c 2b 20 3e 6f 20 6b 65 2d 70 6b 20 24 cell+ >o ke-pk $
1450: 21 20 6f 20 6f 3e 20 3b 0a 0a 56 61 72 69 61 62 ! o o> ;..Variab
1460: 6c 65 20 73 69 6d 2d 6e 69 63 6b 21 0a 0a 3a 20 le sim-nick!..:
1470: 6e 69 63 6b 21 20 28 20 2d 2d 20 29 20 73 69 6d nick! ( -- ) sim
1480: 2d 6e 69 63 6b 21 20 40 20 3f 45 58 49 54 20 20 -nick! @ ?EXIT
1490: 6f 20 7b 20 77 5e 20 6f 70 74 72 20 7d 0a 20 20 o { w^ optr }.
14a0: 20 20 6b 65 2d 6e 69 63 6b 20 24 40 20 6e 69 63 ke-nick $@ nic
14b0: 6b 23 20 23 40 20 64 30 3d 20 49 46 0a 09 6f 70 k# #@ d0= IF..op
14c0: 74 72 20 63 65 6c 6c 20 6b 65 2d 6e 69 63 6b 20 tr cell ke-nick
14d0: 24 40 20 6e 69 63 6b 23 20 23 21 20 30 0a 20 20 $@ nick# #! 0.
14e0: 20 20 45 4c 53 45 0a 09 6c 61 73 74 23 20 63 65 ELSE..last# ce
14f0: 6c 6c 2b 20 24 40 6c 65 6e 20 63 65 6c 6c 2f 0a ll+ $@len cell/.
1500: 09 6f 70 74 72 20 63 65 6c 6c 20 6c 61 73 74 23 .optr cell last#
1510: 20 63 65 6c 6c 2b 20 24 2b 21 0a 20 20 20 20 54 cell+ $+!. T
1520: 48 45 4e 20 20 6b 65 2d 6e 69 63 6b 23 20 21 20 HEN ke-nick# !
1530: 3b 0a 0a 3a 20 23 2e 6e 69 63 6b 20 28 20 68 61 ;..: #.nick ( ha
1540: 73 68 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 sh -- ). dup
1550: 24 40 20 74 79 70 65 20 27 23 27 20 65 6d 69 74 $@ type '#' emit
1560: 20 63 65 6c 6c 2b 20 24 40 6c 65 6e 20 63 65 6c cell+ $@len cel
1570: 6c 2f 20 2e 20 3b 0a 0a 3a 20 6c 61 73 74 2d 70 l/ . ;..: last-p
1580: 65 74 40 20 28 20 2d 2d 20 61 64 64 72 20 75 20 et@ ( -- addr u
1590: 29 0a 20 20 20 20 6b 65 2d 70 65 74 73 20 24 5b ). ke-pets $[
15a0: 5d 23 20 3f 64 75 70 2d 49 46 20 20 31 2d 20 6b ]# ?dup-IF 1- k
15b0: 65 2d 70 65 74 73 20 24 5b 5d 40 20 20 45 4c 53 e-pets $[]@ ELS
15c0: 45 20 20 23 30 2e 20 20 54 48 45 4e 20 3b 0a 0a E #0. THEN ;..
15d0: 3a 20 70 65 74 21 20 28 20 2d 2d 20 29 20 73 69 : pet! ( -- ) si
15e0: 6d 2d 6e 69 63 6b 21 20 40 20 3f 45 58 49 54 20 m-nick! @ ?EXIT
15f0: 20 6f 20 7b 20 77 5e 20 6f 70 74 72 20 7d 0a 20 o { w^ optr }.
1600: 20 20 20 6c 61 73 74 2d 70 65 74 40 20 6e 69 63 last-pet@ nic
1610: 6b 23 20 23 40 20 64 30 3d 20 49 46 0a 09 6f 70 k# #@ d0= IF..op
1620: 74 72 20 63 65 6c 6c 20 6c 61 73 74 2d 70 65 74 tr cell last-pet
1630: 40 20 6e 69 63 6b 23 20 23 21 20 30 0a 20 20 20 @ nick# #! 0.
1640: 20 45 4c 53 45 0a 09 6c 61 73 74 23 20 63 65 6c ELSE..last# cel
1650: 6c 2b 20 24 40 6c 65 6e 20 63 65 6c 6c 2f 0a 09 l+ $@len cell/..
1660: 6f 70 74 72 20 63 65 6c 6c 20 6c 61 73 74 23 20 optr cell last#
1670: 63 65 6c 6c 2b 20 24 2b 21 0a 20 20 20 20 54 48 cell+ $+!. TH
1680: 45 4e 20 20 6b 65 2d 70 65 74 73 20 24 5b 5d 23 EN ke-pets $[]#
1690: 20 31 2d 20 6b 65 2d 70 65 74 73 23 20 24 5b 5d 1- ke-pets# $[]
16a0: 20 21 20 3b 0a 0a 3a 20 6b 65 79 3a 6e 65 77 20 ! ;..: key:new
16b0: 28 20 61 64 64 72 20 75 20 2d 2d 20 6f 20 29 0a ( addr u -- o ).
16c0: 20 20 20 20 5c 47 20 63 72 65 61 74 65 20 6e 65 \G create ne
16d0: 77 20 6b 65 79 2c 20 61 64 64 72 20 75 20 69 73 w key, addr u is
16e0: 20 74 68 65 20 70 75 62 6c 69 63 20 6b 65 79 0a the public key.
16f0: 20 20 20 20 73 61 6d 70 6c 65 2d 6b 65 79 20 3e sample-key >
1700: 6f 20 20 6b 65 2d 73 6b 20 6b 65 2d 65 6e 64 20 o ke-sk ke-end
1710: 6f 76 65 72 20 2d 20 65 72 61 73 65 0a 20 20 20 over - erase.
1720: 20 6b 65 79 2d 65 6e 74 72 79 2d 74 61 62 6c 65 key-entry-table
1730: 20 40 20 74 6f 6b 65 6e 2d 74 61 62 6c 65 20 21 @ token-table !
1740: 0a 20 20 20 20 3e 73 74 6f 72 65 6b 65 79 20 40 . >storekey @
1750: 20 6b 65 2d 73 74 6f 72 65 6b 65 79 20 21 0a 20 ke-storekey !.
1760: 20 20 20 6b 65 79 2d 72 65 61 64 2d 6f 66 66 73 key-read-offs
1770: 65 74 20 36 34 40 20 6b 65 2d 6f 66 66 73 65 74 et 64@ ke-offset
1780: 20 36 34 21 0a 20 20 20 20 31 20 69 6d 70 6f 72 64!. 1 impor
1790: 74 2d 74 79 70 65 20 40 20 6c 73 68 69 66 74 20 t-type @ lshift
17a0: 5b 20 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c [ 1 import#new l
17b0: 73 68 69 66 74 20 5d 4c 20 6f 72 20 6b 65 2d 69 shift ]L or ke-i
17c0: 6d 70 6f 72 74 73 20 21 0a 20 20 20 20 6b 65 79 mports !. key
17d0: 70 61 63 6b 2d 61 6c 6c 23 20 6e 3e 36 34 20 6b pack-all# n>64 k
17e0: 65 79 2d 72 65 61 64 2d 6f 66 66 73 65 74 20 36 ey-read-offset 6
17f0: 34 2b 21 20 6f 20 63 65 6c 6c 2d 20 6b 65 2d 65 4+! o cell- ke-e
1800: 6e 64 20 6f 76 65 72 20 2d 0a 20 20 20 20 32 6f nd over -. 2o
1810: 76 65 72 20 6b 65 79 7c 20 6b 65 79 23 20 23 21 ver key| key# #!
1820: 20 6f 3e 0a 20 20 20 20 63 75 72 72 65 6e 74 2d o>. current-
1830: 6b 65 79 20 3b 0a 0a 30 20 56 61 6c 75 65 20 6c key ;..0 Value l
1840: 61 73 74 2d 6b 65 79 0a 0a 3a 20 6b 65 79 3f 6e ast-key..: key?n
1850: 65 77 20 28 20 61 64 64 72 20 75 20 2d 2d 20 6f ew ( addr u -- o
1860: 20 29 0a 20 20 20 20 5c 47 20 43 72 65 61 74 65 ). \G Create
1870: 20 6f 72 20 6c 6f 6f 6b 75 70 20 6e 65 77 20 6b or lookup new k
1880: 65 79 0a 20 20 20 20 32 64 75 70 20 6b 65 79 7c ey. 2dup key|
1890: 20 6b 65 79 23 20 23 40 20 64 72 6f 70 0a 20 20 key# #@ drop.
18a0: 20 20 64 75 70 20 30 3d 20 49 46 20 20 64 72 6f dup 0= IF dro
18b0: 70 20 6b 65 79 3a 6e 65 77 0a 20 20 20 20 45 4c p key:new. EL
18c0: 53 45 20 20 6e 69 70 20 6e 69 70 20 63 65 6c 6c SE nip nip cell
18d0: 2b 20 20 31 20 69 6d 70 6f 72 74 2d 74 79 70 65 + 1 import-type
18e0: 20 40 20 6c 73 68 69 66 74 20 6f 76 65 72 20 2e @ lshift over .
18f0: 6b 65 2d 69 6d 70 6f 72 74 73 20 6f 72 21 20 20 ke-imports or!
1900: 54 48 45 4e 0a 20 20 20 20 64 75 70 20 74 6f 20 THEN. dup to
1910: 6c 61 73 74 2d 6b 65 79 20 3b 0a 0a 5c 20 73 65 last-key ;..\ se
1920: 61 72 63 68 20 66 6f 72 20 6b 65 79 73 20 2d 20 arch for keys -
1930: 6e 6f 74 20 6f 70 74 69 6d 69 7a 65 64 0a 0a 3a not optimized..:
1940: 20 23 73 70 6c 69 74 20 28 20 61 64 64 72 20 75 #split ( addr u
1950: 20 2d 2d 20 61 64 64 72 20 75 20 6e 20 29 0a 20 -- addr u n ).
1960: 20 20 20 5b 3a 20 32 64 75 70 20 27 23 27 20 2d [: 2dup '#' -
1970: 73 63 61 6e 20 6e 69 70 20 3e 72 0a 20 20 20 20 scan nip >r.
1980: 20 20 72 40 20 30 3d 20 49 46 20 20 72 64 72 6f r@ 0= IF rdro
1990: 70 20 30 20 20 45 58 49 54 20 20 54 48 45 4e 0a p 0 EXIT THEN.
19a0: 20 20 20 20 20 20 23 30 2e 20 32 6f 76 65 72 20 #0. 2over
19b0: 72 40 20 2f 73 74 72 69 6e 67 20 3e 6e 75 6d 62 r@ /string >numb
19c0: 65 72 0a 20 20 20 20 20 20 30 3d 20 49 46 20 20 er. 0= IF
19d0: 6e 69 70 20 64 72 6f 70 20 6e 69 70 20 72 3e 20 nip drop nip r>
19e0: 31 2d 20 73 77 61 70 20 20 45 4c 53 45 0a 09 20 1- swap ELSE..
19f0: 20 72 64 72 6f 70 20 64 72 6f 70 20 32 64 72 6f rdrop drop 2dro
1a00: 70 20 30 20 20 20 54 48 45 4e 20 3b 5d 20 23 31 p 0 THEN ;] #1
1a10: 30 20 62 61 73 65 2d 65 78 65 63 75 74 65 20 3b 0 base-execute ;
1a20: 0a 0a 3a 20 6e 69 63 6b 2d 6b 65 79 20 28 20 61 ..: nick-key ( a
1a30: 64 64 72 20 75 20 2d 2d 20 6f 20 2f 20 30 20 29 ddr u -- o / 0 )
1a40: 20 5c 20 73 65 61 72 63 68 20 66 6f 72 20 6b 65 \ search for ke
1a50: 79 20 6e 69 63 6b 6e 61 6d 65 0a 20 20 20 20 23 y nickname. #
1a60: 73 70 6c 69 74 20 3e 72 20 6e 69 63 6b 23 20 23 split >r nick# #
1a70: 40 20 32 64 75 70 20 64 30 3d 20 49 46 20 20 72 @ 2dup d0= IF r
1a80: 64 72 6f 70 20 64 72 6f 70 20 20 45 58 49 54 20 drop drop EXIT
1a90: 20 54 48 45 4e 0a 20 20 20 20 72 3e 20 63 65 6c THEN. r> cel
1aa0: 6c 73 20 73 61 66 65 2f 73 74 72 69 6e 67 20 30 ls safe/string 0
1ab0: 3d 20 49 46 20 20 64 72 6f 70 20 30 20 20 45 58 = IF drop 0 EX
1ac0: 49 54 20 20 54 48 45 4e 20 20 40 20 3b 0a 0a 3a IT THEN @ ;..:
1ad0: 20 73 65 63 72 65 74 2d 6b 65 79 73 23 20 28 20 secret-keys# (
1ae0: 2d 2d 20 6e 20 29 0a 20 20 20 20 30 20 6b 65 79 -- n ). 0 key
1af0: 23 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 # [: cell+ $@ dr
1b00: 6f 70 20 63 65 6c 6c 2b 20 3e 6f 20 6b 65 2d 73 op cell+ >o ke-s
1b10: 6b 20 40 20 30 3c 3e 20 2d 20 6f 3e 20 3b 5d 20 k @ 0<> - o> ;]
1b20: 23 6d 61 70 20 3b 0a 3a 20 73 65 63 72 65 74 2d #map ;.: secret-
1b30: 6b 65 79 20 28 20 6e 20 2d 2d 20 6f 2f 30 20 29 key ( n -- o/0 )
1b40: 0a 20 20 20 20 30 20 74 75 63 6b 20 6b 65 79 23 . 0 tuck key#
1b50: 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f [: cell+ $@ dro
1b60: 70 20 63 65 6c 6c 2b 20 3e 6f 20 6b 65 2d 73 6b p cell+ >o ke-sk
1b70: 20 40 20 49 46 0a 09 20 20 32 64 75 70 20 3d 20 @ IF.. 2dup =
1b80: 49 46 20 20 72 6f 74 20 64 72 6f 70 20 6f 20 2d IF rot drop o -
1b90: 72 6f 74 20 20 54 48 45 4e 20 20 31 2b 0a 20 20 rot THEN 1+.
1ba0: 20 20 20 20 54 48 45 4e 20 20 6f 3e 20 3b 5d 20 THEN o> ;]
1bb0: 23 6d 61 70 20 32 64 72 6f 70 20 3b 0a 3a 20 2e #map 2drop ;.: .
1bc0: 23 20 28 20 6e 20 2d 2d 20 29 20 3f 64 75 70 2d # ( n -- ) ?dup-
1bd0: 49 46 20 20 27 23 27 20 65 6d 69 74 20 30 20 2e IF '#' emit 0 .
1be0: 72 20 20 54 48 45 4e 20 3b 0a 3a 20 2e 6e 69 63 r THEN ;.: .nic
1bf0: 6b 2d 62 61 73 65 20 28 20 6f 3a 6b 65 79 20 2d k-base ( o:key -
1c00: 2d 20 29 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 - ). ke-nick
1c10: 24 2e 20 20 6b 65 2d 6e 69 63 6b 23 20 40 20 2e $. ke-nick# @ .
1c20: 23 20 3b 0a 3a 20 2e 70 65 74 2d 62 61 73 65 20 # ;.: .pet-base
1c30: 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 ( o:key -- ).
1c40: 20 30 20 6b 65 2d 70 65 74 73 20 5b 3a 20 73 70 0 ke-pets [: sp
1c50: 61 63 65 20 74 79 70 65 0a 20 20 20 20 20 20 64 ace type. d
1c60: 75 70 20 6b 65 2d 70 65 74 73 23 20 24 5b 5d 20 up ke-pets# $[]
1c70: 40 20 2e 23 20 20 31 2b 20 3b 5d 20 24 5b 5d 6d @ .# 1+ ;] $[]m
1c80: 61 70 20 64 72 6f 70 20 3b 0a 3a 20 2e 70 65 74 ap drop ;.: .pet
1c90: 30 2d 62 61 73 65 20 28 20 6f 3a 6b 65 79 20 2d 0-base ( o:key -
1ca0: 2d 20 29 0a 20 20 20 20 6b 65 2d 70 65 74 73 20 - ). ke-pets
1cb0: 24 5b 5d 23 20 49 46 20 20 30 20 6b 65 2d 70 65 $[]# IF 0 ke-pe
1cc0: 74 73 20 24 5b 5d 40 20 74 79 70 65 20 30 20 6b ts $[]@ type 0 k
1cd0: 65 2d 70 65 74 73 23 20 24 5b 5d 20 40 20 2e 23 e-pets# $[] @ .#
1ce0: 0a 20 20 20 20 45 4c 53 45 20 20 2e 6e 69 63 6b . ELSE .nick
1cf0: 2d 62 61 73 65 20 20 54 48 45 4e 20 3b 0a 3a 20 -base THEN ;.:
1d00: 2e 72 65 61 6c 2d 6e 69 63 6b 20 28 20 6f 3a 6b .real-nick ( o:k
1d10: 65 79 20 2d 2d 20 29 20 20 20 6b 65 2d 69 6d 70 ey -- ) ke-imp
1d20: 6f 72 74 73 20 40 20 3e 69 6d 2d 63 6f 6c 6f 72 orts @ >im-color
1d30: 20 2e 6e 69 63 6b 2d 62 61 73 65 20 3c 64 65 66 .nick-base <def
1d40: 61 75 6c 74 3e 20 3b 0a 3a 20 2e 6e 69 63 6b 20 ault> ;.: .nick
1d50: 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 20 20 20 6b ( o:key -- ) k
1d60: 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e 69 6d 2d e-imports @ >im-
1d70: 63 6f 6c 6f 72 20 2e 70 65 74 30 2d 62 61 73 65 color .pet0-base
1d80: 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 3a 20 2e <default> ;.: .
1d90: 6e 69 63 6b 2b 70 65 74 20 28 20 6f 3a 6b 65 79 nick+pet ( o:key
1da0: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 69 6d 70 -- ). ke-imp
1db0: 6f 72 74 73 20 40 20 3e 69 6d 2d 63 6f 6c 6f 72 orts @ >im-color
1dc0: 20 2e 6e 69 63 6b 2d 62 61 73 65 20 2e 70 65 74 .nick-base .pet
1dd0: 2d 62 61 73 65 20 3c 64 65 66 61 75 6c 74 3e 20 -base <default>
1de0: 3b 0a 0a 3a 20 6e 69 63 6b 3e 70 6b 20 28 20 6e ;..: nick>pk ( n
1df0: 69 63 6b 20 75 20 2d 2d 20 70 6b 20 75 20 29 0a ick u -- pk u ).
1e00: 20 20 20 20 6e 69 63 6b 2d 6b 65 79 20 3f 64 75 nick-key ?du
1e10: 70 2d 49 46 20 2e 6b 65 2d 70 6b 20 24 40 20 45 p-IF .ke-pk $@ E
1e20: 4c 53 45 20 30 20 30 20 54 48 45 4e 20 3b 0a 3a LSE 0 0 THEN ;.:
1e30: 20 68 6f 73 74 2e 6e 69 63 6b 3e 70 6b 20 28 20 host.nick>pk (
1e40: 61 64 64 72 20 75 20 2d 2d 20 70 6b 20 75 27 20 addr u -- pk u'
1e50: 29 0a 20 20 20 20 27 2e 27 20 24 73 70 6c 69 74 ). '.' $split
1e60: 20 64 75 70 20 30 3d 20 49 46 20 20 32 73 77 61 dup 0= IF 2swa
1e70: 70 20 20 54 48 45 4e 20 5b 3a 20 6e 69 63 6b 3e p THEN [: nick>
1e80: 70 6b 20 74 79 70 65 20 74 79 70 65 20 3b 5d 20 pk type type ;]
1e90: 24 74 6d 70 20 3b 0a 0a 3a 20 6b 65 79 2d 65 78 $tmp ;..: key-ex
1ea0: 69 73 74 3f 20 28 20 61 64 64 72 20 75 20 2d 2d ist? ( addr u --
1eb0: 20 6f 2f 30 20 29 0a 20 20 20 20 6b 65 79 23 20 o/0 ). key#
1ec0: 23 40 20 49 46 20 20 63 65 6c 6c 2b 20 20 54 48 #@ IF cell+ TH
1ed0: 45 4e 20 3b 20 0a 0a 5c 20 70 65 72 6d 69 73 73 EN ; ..\ permiss
1ee0: 69 6f 6e 20 6d 6f 64 69 66 69 63 61 74 69 6f 6e ion modification
1ef0: 0a 0a 32 36 20 62 75 66 66 65 72 3a 20 70 65 72 ..26 buffer: per
1f00: 6d 2d 63 68 61 72 73 0a 30 20 70 65 72 6d 24 20 m-chars.0 perm$
1f10: 63 6f 75 6e 74 20 62 6f 75 6e 64 73 20 5b 44 4f count bounds [DO
1f20: 5d 20 64 75 70 20 5b 49 5d 20 63 40 20 27 61 27 ] dup [I] c@ 'a'
1f30: 20 2d 20 70 65 72 6d 2d 63 68 61 72 73 20 2b 20 - perm-chars +
1f40: 63 21 20 31 2b 20 5b 4c 4f 4f 50 5d 20 64 72 6f c! 1+ [LOOP] dro
1f50: 70 0a 0a 3a 20 2e 70 65 72 6d 20 28 20 70 65 72 p..: .perm ( per
1f60: 6d 69 73 73 69 6f 6e 20 2d 2d 20 29 20 20 31 20 mission -- ) 1
1f70: 70 65 72 6d 24 20 63 6f 75 6e 74 20 62 6f 75 6e perm$ count boun
1f80: 64 73 20 44 4f 0a 09 32 64 75 70 20 61 6e 64 20 ds DO..2dup and
1f90: 30 3c 3e 20 49 20 63 40 20 27 2d 27 20 72 6f 74 0<> I c@ '-' rot
1fa0: 20 73 65 6c 65 63 74 20 65 6d 69 74 20 32 2a 0a select emit 2*.
1fb0: 20 20 20 20 4c 4f 4f 50 20 20 32 64 72 6f 70 20 LOOP 2drop
1fc0: 3b 0a 3a 20 70 65 72 6d 61 6e 64 20 28 20 70 65 ;.: permand ( pe
1fd0: 72 6d 61 6e 64 20 70 65 72 6d 6f 72 20 6e 65 77 rmand permor new
1fe0: 20 2d 2d 20 70 65 72 6d 61 6e 64 27 20 70 65 72 -- permand' per
1ff0: 6d 6f 72 20 29 0a 20 20 20 20 69 6e 76 65 72 74 mor ). invert
2000: 20 74 75 63 6b 20 61 6e 64 20 3e 72 20 61 6e 64 tuck and >r and
2010: 20 72 3e 20 3b 0a 3a 20 3e 70 65 72 6d 2d 6d 6f r> ;.: >perm-mo
2020: 64 20 28 20 70 65 72 6d 61 6e 64 20 70 65 72 6d d ( permand perm
2030: 6f 72 20 2d 2d 20 70 65 72 6d 61 6e 64 27 20 70 or -- permand' p
2040: 65 72 6d 6f 72 20 29 0a 20 20 20 20 73 77 61 70 ermor ). swap
2050: 20 64 75 70 20 30 3d 20 49 46 20 20 64 72 6f 70 dup 0= IF drop
2060: 20 64 75 70 20 69 6e 76 65 72 74 20 20 54 48 45 dup invert THE
2070: 4e 20 73 77 61 70 20 3b 0a 3a 20 3e 70 65 72 6d N swap ;.: >perm
2080: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 70 65 72 ( addr u -- per
2090: 6d 61 6e 64 20 70 65 72 6d 6f 72 20 29 0a 20 20 mand permor ).
20a0: 20 20 5c 47 20 70 61 72 73 65 20 70 65 72 6d 69 \G parse permi
20b0: 73 73 69 6f 6e 73 3a 20 2b 20 61 64 64 73 2c 20 ssions: + adds,
20c0: 2d 20 72 65 6d 6f 76 65 73 20 70 65 72 6d 69 73 - removes permis
20d0: 73 69 6f 6e 73 2c 0a 20 20 20 20 5c 47 20 6e 6f sions,. \G no
20e0: 20 6d 6f 64 69 66 69 65 72 20 73 65 74 73 20 70 modifier sets p
20f0: 65 72 6d 69 73 73 6f 6e 73 2e 0a 20 20 20 20 30 ermissons.. 0
2100: 20 30 20 5b 27 5d 20 6f 72 20 7b 20 78 74 20 7d 0 ['] or { xt }
2110: 0a 20 20 20 20 32 73 77 61 70 20 62 6f 75 6e 64 . 2swap bound
2120: 73 20 3f 44 4f 0a 09 49 20 63 40 20 63 61 73 65 s ?DO..I c@ case
2130: 0a 09 20 20 20 20 27 2b 27 20 6f 66 20 20 3e 70 .. '+' of >p
2140: 65 72 6d 2d 6d 6f 64 20 5b 27 5d 20 6f 72 20 74 erm-mod ['] or t
2150: 6f 20 78 74 20 65 6e 64 6f 66 0a 09 20 20 20 20 o xt endof..
2160: 27 2d 27 20 6f 66 20 20 3e 70 65 72 6d 2d 6d 6f '-' of >perm-mo
2170: 64 20 5b 27 5d 20 70 65 72 6d 61 6e 64 20 74 6f d ['] permand to
2180: 20 78 74 20 20 65 6e 64 6f 66 0a 09 20 20 20 20 xt endof..
2190: 27 3d 27 20 6f 66 20 20 32 64 72 6f 70 20 70 65 '=' of 2drop pe
21a0: 72 6d 25 64 65 66 61 75 6c 74 20 64 75 70 20 5b rm%default dup [
21b0: 27 5d 20 6f 72 20 74 6f 20 78 74 20 20 65 6e 64 '] or to xt end
21c0: 6f 66 0a 09 20 20 20 20 27 61 27 20 2d 20 64 75 of.. 'a' - du
21d0: 70 20 27 7a 27 20 75 3c 3d 20 20 49 46 0a 09 09 p 'z' u<= IF...
21e0: 70 65 72 6d 2d 63 68 61 72 73 20 2b 20 63 40 20 perm-chars + c@
21f0: 31 20 73 77 61 70 20 6c 73 68 69 66 74 20 78 74 1 swap lshift xt
2200: 20 65 78 65 63 75 74 65 0a 09 09 30 20 28 20 64 execute...0 ( d
2210: 75 6d 6d 79 20 66 6f 72 20 65 6e 64 63 61 73 65 ummy for endcase
2220: 20 29 0a 09 20 20 20 20 54 48 45 4e 20 20 65 6e ).. THEN en
2230: 64 63 61 73 65 0a 20 20 20 20 4c 4f 4f 50 20 3b dcase. LOOP ;
2240: 0a 3a 20 2e 70 65 72 6d 61 6e 64 6f 72 20 28 20 .: .permandor (
2250: 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72 20 2d permand permor -
2260: 2d 20 29 0a 20 20 20 20 30 20 7b 20 2b 2d 20 7d - ). 0 { +- }
2270: 0a 20 20 20 20 31 20 70 65 72 6d 24 20 63 6f 75 . 1 perm$ cou
2280: 6e 74 20 62 6f 75 6e 64 73 20 44 4f 20 20 3e 72 nt bounds DO >r
2290: 0a 09 6f 76 65 72 20 72 40 20 61 6e 64 20 30 3d ..over r@ and 0=
22a0: 20 49 46 20 20 27 2d 27 20 64 75 70 20 2b 2d 20 IF '-' dup +-
22b0: 3c 3e 20 49 46 20 20 64 75 70 20 74 6f 20 2b 2d <> IF dup to +-
22c0: 20 65 6d 69 74 0a 09 20 20 20 20 45 4c 53 45 20 emit.. ELSE
22d0: 20 64 72 6f 70 20 20 54 48 45 4e 20 72 3e 20 20 drop THEN r>
22e0: 49 20 63 40 20 65 6d 69 74 20 20 3e 72 20 54 48 I c@ emit >r TH
22f0: 45 4e 0a 09 64 75 70 20 20 72 40 20 61 6e 64 20 EN..dup r@ and
2300: 20 20 20 49 46 20 20 27 2b 27 20 64 75 70 20 2b IF '+' dup +
2310: 2d 20 3c 3e 20 49 46 20 20 64 75 70 20 74 6f 20 - <> IF dup to
2320: 2b 2d 20 65 6d 69 74 0a 09 20 20 20 20 45 4c 53 +- emit.. ELS
2330: 45 20 20 64 72 6f 70 20 20 54 48 45 4e 20 72 3e E drop THEN r>
2340: 20 20 49 20 63 40 20 65 6d 69 74 20 20 3e 72 20 I c@ emit >r
2350: 54 48 45 4e 0a 09 72 3e 20 32 2a 0a 20 20 20 20 THEN..r> 2*.
2360: 4c 4f 4f 50 20 20 64 72 6f 70 20 32 64 72 6f 70 LOOP drop 2drop
2370: 20 3b 0a 0a 5c 20 72 65 61 64 20 69 6e 20 70 65 ;..\ read in pe
2380: 72 6d 69 73 73 69 6f 6e 20 67 72 6f 75 70 73 2c rmission groups,
2390: 20 67 72 6f 75 70 73 20 69 73 20 69 6e 20 74 68 groups is in th
23a0: 65 20 2e 6e 65 74 32 6f 20 64 69 72 65 63 74 6f e .net2o directo
23b0: 72 79 0a 0a 3a 20 3e 67 72 6f 75 70 2d 69 64 20 ry..: >group-id
23c0: 28 20 61 64 64 72 20 75 20 2d 2d 20 69 64 2f 2d ( addr u -- id/-
23d0: 31 20 29 0a 20 20 20 20 2d 31 20 30 20 67 72 6f 1 ). -1 0 gro
23e0: 75 70 73 5b 5d 20 5b 3a 20 32 73 77 61 70 20 32 ups[] [: 2swap 2
23f0: 3e 72 20 32 20 63 65 6c 6c 73 20 2f 73 74 72 69 >r 2 cells /stri
2400: 6e 67 0a 20 20 20 20 20 20 32 6f 76 65 72 20 73 ng. 2over s
2410: 74 72 69 6e 67 2d 70 72 65 66 69 78 3f 20 49 46 tring-prefix? IF
2420: 20 20 32 72 3e 20 6e 69 70 20 64 75 70 0a 20 20 2r> nip dup.
2430: 20 20 20 20 45 4c 53 45 20 20 32 72 3e 20 20 54 ELSE 2r> T
2440: 48 45 4e 20 20 31 2b 20 3b 5d 20 24 5b 5d 6d 61 HEN 1+ ;] $[]ma
2450: 70 0a 20 20 20 20 32 6e 69 70 20 64 72 6f 70 20 p. 2nip drop
2460: 3b 0a 0a 3a 20 3e 67 72 6f 75 70 73 20 28 20 61 ;..: >groups ( a
2470: 64 64 72 20 75 20 70 61 6e 64 20 70 6f 72 20 2d ddr u pand por -
2480: 2d 20 29 0a 20 20 20 20 73 22 20 22 20 67 72 6f - ). s" " gro
2490: 75 70 73 5b 5d 20 24 2b 5b 5d 21 0a 20 20 20 20 ups[] $+[]!.
24a0: 5b 3a 20 7b 20 64 5e 20 70 61 6e 64 6f 72 20 7d [: { d^ pandor }
24b0: 20 70 61 6e 64 6f 72 20 32 20 63 65 6c 6c 73 20 pandor 2 cells
24c0: 74 79 70 65 20 20 74 79 70 65 20 3b 5d 0a 20 20 type type ;].
24d0: 20 20 67 72 6f 75 70 73 5b 5d 20 64 75 70 20 24 groups[] dup $
24e0: 5b 5d 23 20 31 2d 20 73 77 61 70 20 24 5b 5d 20 []# 1- swap $[]
24f0: 24 65 78 65 63 20 3b 0a 0a 3a 20 69 6e 69 74 2d $exec ;..: init-
2500: 67 72 6f 75 70 73 20 28 20 2d 2d 20 29 0a 20 20 groups ( -- ).
2510: 20 20 22 6d 79 73 65 6c 66 22 20 20 70 65 72 6d "myself" perm
2520: 25 6d 79 73 65 6c 66 20 20 64 75 70 20 3e 67 72 %myself dup >gr
2530: 6f 75 70 73 0a 20 20 20 20 22 70 65 65 72 22 20 oups. "peer"
2540: 20 20 20 70 65 72 6d 25 64 65 66 61 75 6c 74 20 perm%default
2550: 64 75 70 20 3e 67 72 6f 75 70 73 0a 20 20 20 20 dup >groups.
2560: 22 64 68 74 22 20 20 20 20 20 70 65 72 6d 25 64 "dht" perm%d
2570: 68 74 72 6f 6f 74 20 64 75 70 20 3e 67 72 6f 75 htroot dup >grou
2580: 70 73 0a 20 20 20 20 22 75 6e 6b 6e 6f 77 6e 22 ps. "unknown"
2590: 20 70 65 72 6d 25 75 6e 6b 6e 6f 77 6e 20 64 75 perm%unknown du
25a0: 70 20 3e 67 72 6f 75 70 73 0a 20 20 20 20 22 62 p >groups. "b
25b0: 6c 6f 63 6b 65 64 22 20 70 65 72 6d 25 62 6c 6f locked" perm%blo
25c0: 63 6b 65 64 20 70 65 72 6d 25 69 6e 64 69 72 65 cked perm%indire
25d0: 63 74 20 6f 72 20 64 75 70 20 3e 67 72 6f 75 70 ct or dup >group
25e0: 73 20 3b 0a 0a 3a 20 2e 67 72 6f 75 70 73 20 28 s ;..: .groups (
25f0: 20 2d 2d 20 29 0a 20 20 20 20 67 72 6f 75 70 73 -- ). groups
2600: 5b 5d 20 5b 3a 20 32 64 75 70 20 32 20 63 65 6c [] [: 2dup 2 cel
2610: 6c 73 20 2f 73 74 72 69 6e 67 20 74 79 70 65 20 ls /string type
2620: 73 70 61 63 65 0a 20 20 20 20 20 20 64 72 6f 70 space. drop
2630: 20 32 40 20 2e 70 65 72 6d 61 6e 64 6f 72 20 63 2@ .permandor c
2640: 72 20 3b 5d 20 24 5b 5d 6d 61 70 20 3b 0a 0a 3a r ;] $[]map ;..:
2650: 20 2e 69 6e 2d 67 72 6f 75 70 73 20 28 20 61 64 .in-groups ( ad
2660: 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 62 6f dr u -- ). bo
2670: 75 6e 64 73 20 3f 44 4f 0a 09 49 20 70 40 2b 20 unds ?DO..I p@+
2680: 49 20 2d 20 3e 72 20 36 34 3e 6e 20 67 72 6f 75 I - >r 64>n grou
2690: 70 73 5b 5d 20 24 5b 5d 40 20 32 20 63 65 6c 6c ps[] $[]@ 2 cell
26a0: 73 20 2f 73 74 72 69 6e 67 20 73 70 61 63 65 20 s /string space
26b0: 74 79 70 65 0a 20 20 20 20 72 3e 20 2b 4c 4f 4f type. r> +LOO
26c0: 50 20 3b 0a 0a 3a 20 77 72 69 74 65 2d 67 72 6f P ;..: write-gro
26d0: 75 70 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 5b ups ( -- ). [
26e0: 3a 20 2e 22 20 67 72 6f 75 70 73 2b 22 20 67 65 : ." groups+" ge
26f0: 74 70 69 64 20 30 20 2e 72 20 3b 5d 20 24 74 6d tpid 0 .r ;] $tm
2700: 70 20 2e 6e 65 74 32 6f 2f 20 32 64 75 70 20 77 p .net2o/ 2dup w
2710: 2f 6f 20 63 72 65 61 74 65 2d 66 69 6c 65 20 74 /o create-file t
2720: 68 72 6f 77 20 3e 72 0a 20 20 20 20 5b 27 5d 20 hrow >r. [']
2730: 2e 67 72 6f 75 70 73 20 72 40 20 6f 75 74 66 69 .groups r@ outfi
2740: 6c 65 2d 65 78 65 63 75 74 65 0a 20 20 20 20 72 le-execute. r
2750: 3e 20 63 6c 6f 73 65 2d 66 69 6c 65 20 74 68 72 > close-file thr
2760: 6f 77 20 27 2b 27 20 2d 73 63 61 6e 20 31 2d 20 ow '+' -scan 1-
2770: 3e 62 61 63 6b 75 70 20 3b 0a 0a 3a 20 67 72 6f >backup ;..: gro
2780: 75 70 2d 6c 69 6e 65 20 28 20 2d 2d 20 29 0a 20 up-line ( -- ).
2790: 20 20 20 70 61 72 73 65 2d 6e 61 6d 65 20 70 61 parse-name pa
27a0: 72 73 65 2d 6e 61 6d 65 20 3e 70 65 72 6d 20 3e rse-name >perm >
27b0: 67 72 6f 75 70 73 20 3b 0a 0a 3a 20 72 65 61 64 groups ;..: read
27c0: 2d 67 72 6f 75 70 73 2d 6c 6f 6f 70 20 28 20 2d -groups-loop ( -
27d0: 2d 20 29 0a 20 20 20 20 42 45 47 49 4e 20 20 72 - ). BEGIN r
27e0: 65 66 69 6c 6c 20 20 57 48 49 4c 45 20 20 67 72 efill WHILE gr
27f0: 6f 75 70 2d 6c 69 6e 65 20 20 52 45 50 45 41 54 oup-line REPEAT
2800: 20 3b 0a 0a 3a 20 72 65 61 64 2d 67 72 6f 75 70 ;..: read-group
2810: 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 22 67 72 s ( -- ). "gr
2820: 6f 75 70 73 22 20 2e 6e 65 74 32 6f 2f 20 32 64 oups" .net2o/ 2d
2830: 75 70 20 66 69 6c 65 2d 73 74 61 74 75 73 20 6e up file-status n
2840: 69 70 20 6e 6f 2d 66 69 6c 65 23 20 3d 20 49 46 ip no-file# = IF
2850: 0a 09 69 6e 69 74 2d 67 72 6f 75 70 73 20 77 72 ..init-groups wr
2860: 69 74 65 2d 67 72 6f 75 70 73 20 32 64 72 6f 70 ite-groups 2drop
2870: 20 20 45 58 49 54 0a 20 20 20 20 54 48 45 4e 20 EXIT. THEN
2880: 20 3e 69 6e 63 6c 75 64 65 64 20 74 68 72 6f 77 >included throw
2890: 0a 20 20 20 20 5b 27 5d 20 72 65 61 64 2d 67 72 . ['] read-gr
28a0: 6f 75 70 73 2d 6c 6f 6f 70 20 65 78 65 63 75 74 oups-loop execut
28b0: 65 2d 70 61 72 73 69 6e 67 2d 6e 61 6d 65 64 2d e-parsing-named-
28c0: 66 69 6c 65 20 3b 0a 0a 3a 20 67 72 6f 75 70 73 file ;..: groups
28d0: 3e 6d 61 73 6b 20 28 20 61 64 64 72 20 75 20 2d >mask ( addr u -
28e0: 2d 20 6d 61 73 6b 20 29 0a 20 20 20 20 30 20 2d - mask ). 0 -
28f0: 72 6f 74 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 rot bounds ?DO..
2900: 49 20 70 40 2b 20 49 20 2d 20 3e 72 0a 09 36 34 I p@+ I - >r..64
2910: 3e 6e 20 64 75 70 20 67 72 6f 75 70 73 5b 5d 20 >n dup groups[]
2920: 24 5b 5d 23 20 75 3e 3d 20 21 21 6e 6f 2d 67 72 $[]# u>= !!no-gr
2930: 6f 75 70 21 21 0a 09 67 72 6f 75 70 73 5b 5d 20 oup!!..groups[]
2940: 24 5b 5d 40 20 64 72 6f 70 20 32 40 20 3e 72 20 $[]@ drop 2@ >r
2950: 61 6e 64 20 72 3e 20 6f 72 0a 20 20 20 20 72 3e and r> or. r>
2960: 20 2b 4c 4f 4f 50 20 3b 0a 0a 3a 20 3f 3e 67 72 +LOOP ;..: ?>gr
2970: 6f 75 70 73 20 28 20 6d 61 73 6b 20 2d 2d 20 6d oups ( mask -- m
2980: 61 73 6b 27 20 29 0a 20 20 20 20 6b 65 2d 67 72 ask' ). ke-gr
2990: 6f 75 70 73 20 24 40 6c 65 6e 20 30 3d 20 49 46 oups $@len 0= IF
29a0: 0a 09 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 23 20 ..groups[] $[]#
29b0: 30 20 44 4f 0a 09 20 20 20 20 64 75 70 20 49 20 0 DO.. dup I
29c0: 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 40 20 64 72 groups[] $[]@ dr
29d0: 6f 70 20 40 0a 09 20 20 20 20 6f 72 20 6f 76 65 op @.. or ove
29e0: 72 20 3d 20 49 46 0a 09 09 49 20 6b 65 2d 67 72 r = IF...I ke-gr
29f0: 6f 75 70 73 20 63 24 2b 21 0a 09 09 49 20 67 72 oups c$+!...I gr
2a00: 6f 75 70 73 5b 5d 20 24 5b 5d 40 20 64 72 6f 70 oups[] $[]@ drop
2a10: 20 63 65 6c 6c 2b 20 40 20 69 6e 76 65 72 74 20 cell+ @ invert
2a20: 61 6e 64 0a 09 20 20 20 20 54 48 45 4e 0a 09 4c and.. THEN..L
2a30: 4f 4f 50 0a 20 20 20 20 54 48 45 4e 20 20 64 72 OOP. THEN dr
2a40: 6f 70 20 3b 0a 0a 3a 6e 6f 6e 61 6d 65 20 64 65 op ;..:noname de
2a50: 66 65 72 73 20 27 63 6f 6c 64 20 20 67 72 6f 75 fers 'cold grou
2a60: 70 73 5b 5d 20 6f 66 66 20 72 65 61 64 2d 67 72 ps[] off read-gr
2a70: 6f 75 70 73 20 3b 20 69 73 20 27 63 6f 6c 64 0a oups ; is 'cold.
2a80: 0a 5c 20 6b 65 79 20 64 69 73 70 6c 61 79 0a 0a .\ key display..
2a90: 5b 49 46 55 4e 44 45 46 5d 20 6d 61 67 65 6e 74 [IFUNDEF] magent
2aa0: 61 20 20 62 72 6f 77 6e 20 63 6f 6e 73 74 61 6e a brown constan
2ab0: 74 20 6d 61 67 65 6e 74 61 20 5b 54 48 45 4e 5d t magenta [THEN]
2ac0: 0a 5b 49 46 44 45 46 5d 20 67 6c 2d 74 79 70 65 .[IFDEF] gl-type
2ad0: 20 3a 20 62 67 7c 20 3e 62 67 20 6f 72 20 3b 20 : bg| >bg or ;
2ae0: 5b 45 4c 53 45 5d 20 3a 20 62 67 7c 20 64 72 6f [ELSE] : bg| dro
2af0: 70 20 3b 20 5b 54 48 45 4e 5d 0a 0a 43 72 65 61 p ; [THEN]..Crea
2b00: 74 65 20 38 35 63 6f 6c 6f 72 73 2d 62 77 0a 30 te 85colors-bw.0
2b10: 20 2c 20 69 6e 76 65 72 73 20 2c 0a 69 6e 76 65 , invers ,.inve
2b20: 72 73 20 2c 20 30 20 2c 0a 30 20 2c 20 69 6e 76 rs , 0 ,.0 , inv
2b30: 65 72 73 20 2c 0a 69 6e 76 65 72 73 20 2c 20 30 ers ,.invers , 0
2b40: 20 2c 0a 43 72 65 61 74 65 20 38 35 63 6f 6c 6f ,.Create 85colo
2b50: 72 73 2d 63 6c 0a 79 65 6c 6c 6f 77 20 3e 66 67 rs-cl.yellow >fg
2b60: 20 62 6c 75 65 20 3e 62 67 20 6f 72 20 62 6f 6c blue >bg or bol
2b70: 64 20 6f 72 20 2c 20 72 65 64 20 3e 66 67 20 77 d or , red >fg w
2b80: 68 69 74 65 20 62 67 7c 20 2c 0a 62 6c 61 63 6b hite bg| ,.black
2b90: 20 3e 66 67 20 63 79 61 6e 20 62 67 7c 20 2c 20 >fg cyan bg| ,
2ba0: 67 72 65 65 6e 20 3e 66 67 20 62 6c 61 63 6b 20 green >fg black
2bb0: 3e 62 67 20 6f 72 20 62 6f 6c 64 20 6f 72 20 2c >bg or bold or ,
2bc0: 0a 77 68 69 74 65 20 3e 66 67 20 62 6c 61 63 6b .white >fg black
2bd0: 20 3e 62 67 20 6f 72 20 62 6f 6c 64 20 6f 72 20 >bg or bold or
2be0: 2c 20 6d 61 67 65 6e 74 61 20 3e 66 67 20 79 65 , magenta >fg ye
2bf0: 6c 6c 6f 77 20 62 67 7c 20 2c 0a 62 6c 75 65 20 llow bg| ,.blue
2c00: 3e 66 67 20 79 65 6c 6c 6f 77 20 62 67 7c 20 2c >fg yellow bg| ,
2c10: 20 63 79 61 6e 20 3e 66 67 20 72 65 64 20 3e 62 cyan >fg red >b
2c20: 67 20 6f 72 20 62 6f 6c 64 20 6f 72 20 2c 0a 0a g or bold or ,..
2c30: 5b 49 46 44 45 46 5d 20 67 6c 2d 74 79 70 65 20 [IFDEF] gl-type
2c40: 38 35 63 6f 6c 6f 72 73 2d 63 6c 20 5b 45 4c 53 85colors-cl [ELS
2c50: 45 5d 20 38 35 63 6f 6c 6f 72 73 2d 62 77 20 5b E] 85colors-bw [
2c60: 54 48 45 4e 5d 20 56 61 6c 75 65 20 38 35 63 6f THEN] Value 85co
2c70: 6c 6f 72 73 0a 0a 3a 20 2e 73 74 72 69 70 65 38 lors..: .stripe8
2c80: 35 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 5 ( addr u -- )
2c90: 20 30 20 2d 72 6f 74 20 62 6f 75 6e 64 73 20 3f 0 -rot bounds ?
2ca0: 44 4f 0a 09 64 75 70 20 63 65 6c 6c 73 20 38 35 DO..dup cells 85
2cb0: 63 6f 6c 6f 72 73 20 2b 20 40 20 61 74 74 72 21 colors + @ attr!
2cc0: 20 31 2b 0a 09 49 20 34 20 38 35 74 79 70 65 20 1+..I 4 85type
2cd0: 20 64 75 70 20 63 65 6c 6c 73 20 38 35 63 6f 6c dup cells 85col
2ce0: 6f 72 73 20 2b 20 40 20 61 74 74 72 21 20 31 2b ors + @ attr! 1+
2cf0: 0a 20 20 20 20 49 20 34 20 2b 20 34 20 38 35 74 . I 4 + 4 85t
2d00: 79 70 65 20 3c 64 65 66 61 75 6c 74 3e 20 63 72 ype <default> cr
2d10: 20 38 20 2b 4c 4f 4f 50 20 20 64 72 6f 70 20 3b 8 +LOOP drop ;
2d20: 0a 3a 20 2e 69 6d 70 6f 72 74 38 35 20 28 20 61 .: .import85 ( a
2d30: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 6b ddr u -- ). k
2d40: 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e 69 6d 2d e-imports @ >im-
2d50: 63 6f 6c 6f 72 20 38 35 74 79 70 65 20 3c 64 65 color 85type <de
2d60: 66 61 75 6c 74 3e 20 3b 0a 3a 20 2e 72 73 6b 20 fault> ;.: .rsk
2d70: 28 20 6e 69 63 6b 20 75 20 2d 2d 20 29 0a 20 20 ( nick u -- ).
2d80: 20 20 73 6b 72 65 76 20 24 32 30 20 2e 73 74 72 skrev $20 .str
2d90: 69 70 65 38 35 20 73 70 61 63 65 20 74 79 70 65 ipe85 space type
2da0: 20 2e 22 20 20 28 6b 65 65 70 20 6f 66 66 6c 69 ." (keep offli
2db0: 6e 65 20 63 6f 70 79 21 29 22 20 63 72 20 3b 0a ne copy!)" cr ;.
2dc0: 3a 20 2e 6b 65 79 20 28 20 61 64 64 72 20 75 20 : .key ( addr u
2dd0: 2d 2d 20 29 20 64 72 6f 70 20 63 65 6c 6c 2b 20 -- ) drop cell+
2de0: 3e 6f 0a 20 20 20 20 2e 22 20 6e 69 63 6b 3a 20 >o. ." nick:
2df0: 20 20 22 20 2e 6e 69 63 6b 20 63 72 0a 20 20 20 " .nick cr.
2e00: 20 2e 22 20 70 75 62 6b 65 79 3a 20 22 20 6b 65 ." pubkey: " ke
2e10: 2d 70 6b 20 24 40 20 38 35 74 79 70 65 20 63 72 -pk $@ 85type cr
2e20: 0a 20 20 20 20 6b 65 2d 73 6b 20 40 20 49 46 0a . ke-sk @ IF.
2e30: 09 2e 22 20 73 65 63 6b 65 79 3a 20 22 20 6b 65 .." seckey: " ke
2e40: 2d 73 6b 20 73 65 63 40 20 2e 62 6c 61 63 6b 38 -sk sec@ .black8
2e50: 35 20 2e 22 20 20 28 6b 65 65 70 20 73 65 63 72 5 ." (keep secr
2e60: 65 74 21 29 22 20 63 72 20 20 54 48 45 4e 0a 20 et!)" cr THEN.
2e70: 20 20 20 2e 22 20 76 61 6c 69 64 3a 20 20 22 20 ." valid: "
2e80: 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 20 2e 73 ke-selfsig $@ .s
2e90: 69 67 64 61 74 65 73 20 63 72 0a 20 20 20 20 2e igdates cr. .
2ea0: 22 20 67 72 6f 75 70 73 3a 20 22 20 6b 65 2d 67 " groups: " ke-g
2eb0: 72 6f 75 70 73 20 24 40 20 2e 69 6e 2d 67 72 6f roups $@ .in-gro
2ec0: 75 70 73 20 63 72 0a 20 20 20 20 2e 22 20 70 65 ups cr. ." pe
2ed0: 72 6d 3a 20 20 20 22 20 6b 65 2d 6d 61 73 6b 20 rm: " ke-mask
2ee0: 40 20 2e 70 65 72 6d 20 63 72 0a 20 20 20 20 6f @ .perm cr. o
2ef0: 3e 20 3b 0a 3a 20 2e 6b 65 79 2d 72 65 73 74 20 > ;.: .key-rest
2f00: 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b 65 79 ( o:key -- o:key
2f10: 20 29 0a 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 ). ke-pk $@
2f20: 6b 65 79 7c 20 2e 69 6d 70 6f 72 74 38 35 0a 20 key| .import85.
2f30: 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 ke-selfsig $@
2f40: 20 73 70 61 63 65 20 2e 73 69 67 64 61 74 65 73 space .sigdates
2f50: 0a 20 20 20 20 6b 65 2d 67 72 6f 75 70 73 20 24 . ke-groups $
2f60: 40 20 32 64 75 70 20 2e 69 6e 2d 67 72 6f 75 70 @ 2dup .in-group
2f70: 73 20 67 72 6f 75 70 73 3e 6d 61 73 6b 20 69 6e s groups>mask in
2f80: 76 65 72 74 0a 20 20 20 20 73 70 61 63 65 20 6b vert. space k
2f90: 65 2d 6d 61 73 6b 20 40 20 61 6e 64 20 2d 31 20 e-mask @ and -1
2fa0: 73 77 61 70 20 2e 70 65 72 6d 61 6e 64 6f 72 0a swap .permandor.
2fb0: 20 20 20 20 23 74 61 62 20 65 6d 69 74 20 6b 65 #tab emit ke
2fc0: 2d 69 6d 70 6f 72 74 73 20 40 20 2e 69 6d 70 6f -imports @ .impo
2fd0: 72 74 73 0a 20 20 20 20 73 70 61 63 65 20 2e 6e rts. space .n
2fe0: 69 63 6b 2b 70 65 74 20 3b 0a 3a 20 2e 6b 65 79 ick+pet ;.: .key
2ff0: 2d 6c 69 73 74 20 28 20 6f 3a 6b 65 79 20 2d 2d -list ( o:key --
3000: 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 6b 65 2d o:key ). ke-
3010: 6f 66 66 73 65 74 20 36 34 40 20 36 34 3e 64 20 offset 64@ 64>d
3020: 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 66 6d 2f keypack-all# fm/
3030: 6d 6f 64 20 6e 69 70 20 33 20 2e 72 20 73 70 61 mod nip 3 .r spa
3040: 63 65 0a 20 20 20 20 2e 6b 65 79 2d 72 65 73 74 ce. .key-rest
3050: 20 63 72 20 3b 0a 3a 20 2e 73 65 63 72 65 74 2d cr ;.: .secret-
3060: 6e 69 63 6b 73 20 28 20 2d 2d 20 29 0a 20 20 20 nicks ( -- ).
3070: 20 30 20 6b 65 79 23 20 5b 3a 20 63 65 6c 6c 2b 0 key# [: cell+
3080: 20 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3e $@ drop cell+ >
3090: 6f 20 6b 65 2d 73 6b 20 40 20 49 46 0a 09 20 20 o ke-sk @ IF..
30a0: 5b 3a 20 64 75 70 20 31 20 2e 72 20 3b 5d 20 23 [: dup 1 .r ;] #
30b0: 33 36 20 62 61 73 65 2d 65 78 65 63 75 74 65 20 36 base-execute
30c0: 73 70 61 63 65 20 2e 6b 65 79 2d 72 65 73 74 20 space .key-rest
30d0: 63 72 20 31 2b 0a 20 20 20 20 20 20 54 48 45 4e cr 1+. THEN
30e0: 20 6f 3e 20 3b 5d 20 23 6d 61 70 20 64 72 6f 70 o> ;] #map drop
30f0: 20 3b 0a 3a 20 2e 6b 65 79 2d 69 6e 76 69 74 65 ;.: .key-invite
3100: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b 65 ( o:key -- o:ke
3110: 79 20 29 0a 20 20 20 20 6b 65 2d 70 6b 20 24 40 y ). ke-pk $@
3120: 20 6b 65 79 73 69 7a 65 20 75 6d 69 6e 0a 20 20 keysize umin.
3130: 20 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e ke-imports @ >
3140: 69 6d 2d 63 6f 6c 6f 72 20 38 35 74 79 70 65 20 im-color 85type
3150: 3c 64 65 66 61 75 6c 74 3e 0a 20 20 20 20 73 70 <default>. sp
3160: 61 63 65 20 2e 6e 69 63 6b 20 73 70 61 63 65 20 ace .nick space
3170: 3b 0a 3a 20 2e 6b 65 79 2d 73 68 6f 72 74 20 28 ;.: .key-short (
3180: 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b 65 79 20 o:key -- o:key
3190: 29 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 24 2e ). ke-nick $.
31a0: 20 6b 65 2d 70 72 6f 66 20 24 40 6c 65 6e 20 49 ke-prof $@len I
31b0: 46 20 2e 22 20 20 70 72 6f 66 69 6c 65 3a 20 22 F ." profile: "
31c0: 20 6b 65 2d 70 72 6f 66 20 24 40 20 38 35 74 79 ke-prof $@ 85ty
31d0: 70 65 20 54 48 45 4e 20 3b 0a 3a 20 6c 69 73 74 pe THEN ;.: list
31e0: 2d 6b 65 79 73 20 28 20 2d 2d 20 29 0a 20 20 20 -keys ( -- ).
31f0: 20 2e 22 20 63 6f 6c 6f 72 73 3a 20 22 20 2e 69 ." colors: " .i
3200: 6d 70 6f 72 74 2d 63 6f 6c 6f 72 73 20 63 72 0a mport-colors cr.
3210: 20 20 20 20 2e 22 20 6e 75 6d 20 70 75 62 6b 65 ." num pubke
3220: 79 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 y
3230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3240: 20 20 20 20 64 61 74 65 20 20 20 20 20 20 20 20 date
3250: 20 20 20 20 20 20 20 20 20 20 20 20 20 67 72 70 grp
3260: 2b 70 65 72 6d 09 68 20 6e 69 63 6b 22 20 63 72 +perm.h nick" cr
3270: 0a 20 20 20 20 6b 65 79 23 20 5b 3a 20 63 65 6c . key# [: cel
3280: 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b l+ $@ drop cell+
3290: 20 2e 2e 6b 65 79 2d 6c 69 73 74 20 3b 5d 20 23 ..key-list ;] #
32a0: 6d 61 70 20 3b 0a 3a 20 6c 69 73 74 2d 6e 69 63 map ;.: list-nic
32b0: 6b 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 6e 69 ks ( -- ). ni
32c0: 63 6b 23 20 5b 3a 20 64 75 70 20 24 2e 20 2e 22 ck# [: dup $. ."
32d0: 20 3a 22 20 63 72 20 63 65 6c 6c 2b 20 24 40 20 :" cr cell+ $@
32e0: 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 20 20 49 20 bounds ?DO.. I
32f0: 40 20 2e 2e 6b 65 79 2d 6c 69 73 74 20 20 63 65 @ ..key-list ce
3300: 6c 6c 20 2b 4c 4f 4f 50 20 3b 5d 20 23 6d 61 70 ll +LOOP ;] #map
3310: 20 3b 0a 0a 3a 20 64 75 6d 70 6b 65 79 20 28 20 ;..: dumpkey (
3320: 61 64 64 72 20 75 20 2d 2d 20 29 20 64 72 6f 70 addr u -- ) drop
3330: 20 63 65 6c 6c 2b 20 3e 6f 0a 20 20 20 20 2e 5c cell+ >o. .\
3340: 22 20 78 5c 22 20 22 20 6b 65 2d 70 6b 20 24 40 " x\" " ke-pk $@
3350: 20 38 35 74 79 70 65 20 2e 5c 22 20 5c 22 20 6b 85type .\" \" k
3360: 65 79 3f 6e 65 77 22 20 63 72 0a 20 20 20 20 6b ey?new" cr. k
3370: 65 2d 73 6b 20 40 20 49 46 20 20 2e 5c 22 20 78 e-sk @ IF .\" x
3380: 5c 22 20 22 20 6b 65 2d 73 6b 20 40 20 6b 65 79 \" " ke-sk @ key
3390: 73 69 7a 65 20 38 35 74 79 70 65 20 2e 5c 22 20 size 85type .\"
33a0: 5c 22 20 6b 65 2d 73 6b 20 73 65 63 21 20 2b 73 \" ke-sk sec! +s
33b0: 65 63 6b 65 79 22 20 63 72 20 20 54 48 45 4e 0a eckey" cr THEN.
33c0: 20 20 20 20 27 22 27 20 65 6d 69 74 20 2e 6e 69 '"' emit .ni
33d0: 63 6b 20 2e 5c 22 20 5c 22 20 6b 65 2d 6e 69 63 ck .\" \" ke-nic
33e0: 6b 20 24 21 20 22 0a 20 20 20 20 6b 65 2d 73 65 k $! ". ke-se
33f0: 6c 66 73 69 67 20 24 40 20 64 72 6f 70 20 36 34 lfsig $@ drop 64
3400: 40 20 36 34 3e 64 20 5b 3a 20 27 24 27 20 65 6d @ 64>d [: '$' em
3410: 69 74 20 30 20 75 64 2e 72 20 3b 5d 20 24 31 30 it 0 ud.r ;] $10
3420: 20 62 61 73 65 2d 65 78 65 63 75 74 65 0a 20 20 base-execute.
3430: 20 20 2e 22 20 2e 20 64 3e 36 34 20 6b 65 2d 66 ." . d>64 ke-f
3440: 69 72 73 74 21 20 22 20 6b 65 2d 74 79 70 65 20 irst! " ke-type
3450: 40 20 2e 20 2e 22 20 6b 65 2d 74 79 70 65 20 21 @ . ." ke-type !
3460: 22 20 20 63 72 20 6f 3e 20 3b 0a 0a 3a 20 2e 6b " cr o> ;..: .k
3470: 65 79 73 20 28 20 2d 2d 20 29 20 6b 65 79 23 20 eys ( -- ) key#
3480: 5b 3a 20 2e 22 20 69 6e 64 65 78 3a 20 22 20 64 [: ." index: " d
3490: 75 70 20 24 40 20 38 35 74 79 70 65 20 63 72 20 up $@ 85type cr
34a0: 63 65 6c 6c 2b 20 24 40 20 2e 6b 65 79 20 3b 5d cell+ $@ .key ;]
34b0: 20 23 6d 61 70 20 3b 0a 3a 20 64 75 6d 70 6b 65 #map ;.: dumpke
34c0: 79 73 20 28 20 2d 2d 20 29 20 6b 65 79 23 20 5b ys ( -- ) key# [
34d0: 3a 20 63 65 6c 6c 2b 20 24 40 20 64 75 6d 70 6b : cell+ $@ dumpk
34e0: 65 79 20 3b 5d 20 23 6d 61 70 20 3b 0a 0a 3a 20 ey ;] #map ;..:
34f0: 6b 65 79 3e 6e 69 63 6b 20 28 20 61 64 64 72 6b key>nick ( addrk
3500: 65 79 20 75 31 20 2d 2d 20 6e 69 63 6b 20 75 32 ey u1 -- nick u2
3510: 20 29 0a 20 20 20 20 5c 47 20 63 6f 6e 76 65 72 ). \G conver
3520: 74 20 6b 65 79 20 74 6f 20 6e 69 63 6b 0a 20 20 t key to nick.
3530: 20 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 30 key| key# #@ 0
3540: 3d 20 49 46 20 20 64 72 6f 70 20 23 30 2e 20 20 = IF drop #0.
3550: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 63 EXIT THEN. c
3560: 65 6c 6c 2b 20 2e 6b 65 2d 6e 69 63 6b 20 24 40 ell+ .ke-nick $@
3570: 20 3b 0a 3a 20 6b 65 79 3e 6b 65 79 20 28 20 61 ;.: key>key ( a
3580: 64 64 72 6b 65 79 20 75 31 20 2d 2d 20 6b 65 79 ddrkey u1 -- key
3590: 20 75 32 20 29 0a 20 20 20 20 5c 47 20 65 78 70 u2 ). \G exp
35a0: 61 6e 64 20 6b 65 79 20 74 6f 20 66 75 6c 6c 20 and key to full
35b0: 73 69 7a 65 20 61 6e 64 20 63 68 65 63 6b 20 69 size and check i
35c0: 66 20 77 65 20 6b 6e 6f 77 20 69 74 0a 20 20 20 f we know it.
35d0: 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 30 3d key| key# #@ 0=
35e0: 20 49 46 20 20 64 72 6f 70 20 23 30 2e 20 20 45 IF drop #0. E
35f0: 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 63 65 XIT THEN. ce
3600: 6c 6c 2b 20 2e 6b 65 2d 70 6b 20 24 40 20 3b 0a ll+ .ke-pk $@ ;.
3610: 0a 3a 20 2e 6b 65 79 23 20 28 20 61 64 64 72 20 .: .key# ( addr
3620: 75 20 2d 2d 20 29 20 6b 65 79 7c 0a 20 20 20 20 u -- ) key|.
3630: 2e 22 20 4b 65 79 20 27 22 20 6b 65 79 23 20 23 ." Key '" key# #
3640: 40 20 30 3d 20 49 46 20 64 72 6f 70 20 45 58 49 @ 0= IF drop EXI
3650: 54 20 54 48 45 4e 0a 20 20 20 20 63 65 6c 6c 2b T THEN. cell+
3660: 20 2e 2e 6e 69 63 6b 20 2e 22 20 27 20 6f 6b 22 ..nick ." ' ok"
3670: 20 63 72 20 3b 0a 0a 44 65 66 65 72 20 64 68 74 cr ;..Defer dht
3680: 2d 6e 69 63 6b 3f 0a 65 76 65 6e 74 3a 20 2d 3e -nick?.event: ->
3690: 73 65 61 72 63 68 2d 6b 65 79 20 20 6b 65 79 7c search-key key|
36a0: 20 6f 76 65 72 20 3e 72 20 64 68 74 2d 6e 69 63 over >r dht-nic
36b0: 6b 3f 20 72 3e 20 66 72 65 65 20 74 68 72 6f 77 k? r> free throw
36c0: 20 3b 0a 0a 3a 20 2e 75 6e 6b 65 79 2d 69 64 20 ;..: .unkey-id
36d0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 3c 65 ( addr u -- ) <e
36e0: 72 72 3e 20 38 20 75 6d 69 6e 20 38 35 74 79 70 rr> 8 umin 85typ
36f0: 65 20 2e 22 20 28 75 6e 6b 6e 6f 77 6e 29 22 20 e ." (unknown)"
3700: 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 0a 56 61 72 <default> ;..Var
3710: 69 61 62 6c 65 20 75 6e 6b 65 79 2d 69 64 23 0a iable unkey-id#.
3720: 23 36 30 2e 30 30 30 2e 30 30 30 2e 30 30 30 20 #60.000.000.000
3730: 64 3e 36 34 20 36 34 43 6f 6e 73 74 61 6e 74 20 d>64 64Constant
3740: 75 6e 6b 65 79 2d 74 6f 23 0a 3a 20 3f 75 6e 6b unkey-to#.: ?unk
3750: 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 66 ey ( addr u -- f
3760: 6c 61 67 20 29 0a 20 20 20 20 75 6e 6b 65 79 2d lag ). unkey-
3770: 69 64 23 20 23 40 0a 20 20 20 20 49 46 20 20 36 id# #@. IF 6
3780: 34 40 20 75 6e 6b 65 79 2d 74 6f 23 20 36 34 2b 4@ unkey-to# 64+
3790: 20 74 69 63 6b 73 20 36 34 2d 20 36 34 2d 30 3e ticks 64- 64-0>
37a0: 3d 20 20 54 48 45 4e 20 20 30 3d 20 3b 0a 20 20 = THEN 0= ;.
37b0: 20 20 0a 3a 20 2e 6b 65 79 2d 69 64 20 28 20 61 .: .key-id ( a
37c0: 64 64 72 20 75 20 2d 2d 20 29 20 6b 65 79 7c 20 ddr u -- ) key|
37d0: 32 64 75 70 20 6b 65 79 23 20 23 40 20 30 3d 0a 2dup key# #@ 0=.
37e0: 20 20 20 20 49 46 20 20 64 72 6f 70 20 75 70 40 IF drop up@
37f0: 20 72 65 63 65 69 76 65 72 2d 74 61 73 6b 20 3d receiver-task =
3800: 20 49 46 0a 09 20 20 20 20 3c 65 76 65 6e 74 20 IF.. <event
3810: 32 64 75 70 20 73 61 76 65 2d 6d 65 6d 20 65 24 2dup save-mem e$
3820: 2c 20 2d 3e 73 65 61 72 63 68 2d 6b 65 79 20 6d , ->search-key m
3830: 61 69 6e 2d 75 70 40 20 65 76 65 6e 74 3e 0a 09 ain-up@ event>..
3840: 20 20 20 20 2e 75 6e 6b 65 79 2d 69 64 20 45 58 .unkey-id EX
3850: 49 54 20 20 54 48 45 4e 0a 09 32 64 75 70 20 3f IT THEN..2dup ?
3860: 75 6e 6b 65 79 20 20 49 46 0a 09 20 20 20 20 74 unkey IF.. t
3870: 69 63 6b 73 20 7b 20 36 34 5e 20 74 78 20 7d 20 icks { 64^ tx }
3880: 74 78 20 31 20 36 34 73 20 32 6f 76 65 72 20 75 tx 1 64s 2over u
3890: 6e 6b 65 79 2d 69 64 23 20 23 21 0a 09 20 20 20 nkey-id# #!..
38a0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 3e 72 20 32 connection >r 2
38b0: 64 75 70 20 5b 27 5d 20 64 68 74 2d 6e 69 63 6b dup ['] dht-nick
38c0: 3f 20 63 6d 64 2d 6e 65 73 74 20 72 3e 20 74 6f ? cmd-nest r> to
38d0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 0a 09 20 20 20 connection..
38e0: 20 32 64 75 70 20 6b 65 79 23 20 23 40 20 30 3d 2dup key# #@ 0=
38f0: 20 49 46 20 20 64 72 6f 70 20 2e 75 6e 6b 65 79 IF drop .unkey
3900: 2d 69 64 20 45 58 49 54 0a 09 20 20 20 20 45 4c -id EXIT.. EL
3910: 53 45 20 20 3e 72 20 32 64 75 70 20 75 6e 6b 65 SE >r 2dup unke
3920: 79 2d 69 64 23 20 23 6f 66 66 20 72 3e 20 20 54 y-id# #off r> T
3930: 48 45 4e 0a 09 45 4c 53 45 20 20 2e 75 6e 6b 65 HEN..ELSE .unke
3940: 79 2d 69 64 20 20 45 58 49 54 20 20 54 48 45 4e y-id EXIT THEN
3950: 0a 20 20 20 20 54 48 45 4e 0a 20 20 20 20 63 65 . THEN. ce
3960: 6c 6c 2b 20 2e 2e 6e 69 63 6b 20 32 64 72 6f 70 ll+ ..nick 2drop
3970: 20 3b 0a 0a 3a 20 2e 63 6f 6e 2d 69 64 20 28 20 ;..: .con-id (
3980: 6f 3a 63 6f 6e 6e 65 63 74 69 6f 6e 20 2d 2d 20 o:connection --
3990: 29 20 70 75 62 6b 65 79 20 24 40 20 2e 6b 65 79 ) pubkey $@ .key
39a0: 2d 69 64 20 3b 0a 0a 3a 20 2e 73 69 6d 70 6c 65 -id ;..: .simple
39b0: 2d 69 64 20 28 20 61 64 64 72 20 75 20 2d 2d 20 -id ( addr u --
39c0: 29 20 6b 65 79 3e 6e 69 63 6b 20 74 79 70 65 20 ) key>nick type
39d0: 3b 0a 0a 3a 20 63 68 65 63 6b 2d 6b 65 79 20 28 ;..: check-key (
39e0: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 addr u -- ).
39f0: 20 6f 20 49 46 20 20 70 75 62 6b 65 79 20 40 20 o IF pubkey @
3a00: 49 46 0a 09 20 20 20 20 32 64 75 70 20 70 75 62 IF.. 2dup pub
3a10: 6b 65 79 20 24 40 20 6b 65 79 7c 20 73 74 72 3d key $@ key| str=
3a20: 20 30 3d 20 49 46 0a 09 09 5b 3a 20 2e 22 20 77 0= IF...[: ." w
3a30: 61 6e 74 3a 20 22 20 70 75 62 6b 65 79 20 24 40 ant: " pubkey $@
3a40: 20 6b 65 79 7c 20 38 35 74 79 70 65 20 63 72 0a key| 85type cr.
3a50: 09 09 20 20 2e 22 20 67 6f 74 20 3a 20 22 20 32 .. ." got : " 2
3a60: 64 75 70 20 38 35 74 79 70 65 20 63 72 20 3b 5d dup 85type cr ;]
3a70: 20 24 65 72 72 0a 09 09 74 72 75 65 20 21 21 77 $err...true !!w
3a80: 72 6f 6e 67 2d 6b 65 79 21 21 0a 09 20 20 20 20 rong-key!!..
3a90: 54 48 45 4e 0a 09 20 20 20 20 63 6f 6e 6e 65 63 THEN.. connec
3aa0: 74 28 20 2e 6b 65 79 23 20 29 65 6c 73 65 28 20 t( .key# )else(
3ab0: 32 64 72 6f 70 20 29 20 20 45 58 49 54 0a 09 54 2drop ) EXIT..T
3ac0: 48 45 4e 20 20 54 48 45 4e 0a 20 20 20 20 32 64 HEN THEN. 2d
3ad0: 75 70 20 6b 65 79 2d 65 78 69 73 74 3f 0a 20 20 up key-exist?.
3ae0: 20 20 3f 64 75 70 2d 30 3d 2d 49 46 20 20 70 65 ?dup-0=-IF pe
3af0: 72 6d 25 75 6e 6b 6e 6f 77 6e 20 20 45 4c 53 45 rm%unknown ELSE
3b00: 20 20 2e 6b 65 2d 6d 61 73 6b 20 40 20 20 54 48 .ke-mask @ TH
3b10: 45 4e 20 20 74 6d 70 2d 70 65 72 6d 20 21 0a 20 EN tmp-perm !.
3b20: 20 20 20 63 6f 6e 6e 65 63 74 28 20 32 64 75 70 connect( 2dup
3b30: 20 2e 6b 65 79 23 20 29 0a 20 20 20 20 74 6d 70 .key# ). tmp
3b40: 2d 70 65 72 6d 20 40 20 70 65 72 6d 25 62 6c 6f -perm @ perm%blo
3b50: 63 6b 65 64 20 61 6e 64 20 49 46 0a 09 5b 3a 20 cked and IF..[:
3b60: 2e 22 20 55 6e 6b 6e 6f 77 6e 20 6b 65 79 2c 20 ." Unknown key,
3b70: 63 6f 6e 6e 65 63 74 69 6f 6e 20 72 65 66 75 73 connection refus
3b80: 65 64 3a 20 22 20 38 35 74 79 70 65 20 63 72 20 ed: " 85type cr
3b90: 3b 5d 20 24 65 72 72 0a 09 74 72 75 65 20 21 21 ;] $err..true !!
3ba0: 63 6f 6e 6e 65 63 74 2d 70 65 72 6d 21 21 0a 20 connect-perm!!.
3bb0: 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 ELSE 2drop
3bc0: 54 48 45 4e 20 3b 0a 0a 3a 20 73 65 61 72 63 68 THEN ;..: search
3bd0: 2d 6b 65 79 20 28 20 70 6b 63 20 2d 2d 20 73 6b -key ( pkc -- sk
3be0: 63 20 29 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 c ). keysize
3bf0: 6b 65 79 23 20 23 40 20 30 3d 20 21 21 75 6e 6b key# #@ 0= !!unk
3c00: 6e 6f 77 6e 2d 6b 65 79 21 21 0a 20 20 20 20 63 nown-key!!. c
3c10: 65 6c 6c 2b 20 2e 6b 65 2d 73 6b 20 73 65 63 40 ell+ .ke-sk sec@
3c20: 20 30 3d 20 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 0= !!unknown-ke
3c30: 79 21 21 20 3b 0a 0a 5c 20 61 70 70 6c 79 20 70 y!! ;..\ apply p
3c40: 65 72 6d 69 73 73 69 6f 6e 73 26 67 72 6f 75 70 ermissions&group
3c50: 73 0a 0a 3a 20 61 70 70 6c 79 2d 70 65 72 6d 69 s..: apply-permi
3c60: 73 73 69 6f 6e 20 28 20 70 65 72 6d 61 6e 64 20 ssion ( permand
3c70: 70 65 72 6d 6f 72 20 6f 3a 6b 65 79 20 2d 2d 20 permor o:key --
3c80: 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72 20 6f permand permor o
3c90: 3a 6b 65 79 20 29 0a 20 20 20 20 6f 76 65 72 20 :key ). over
3ca0: 6b 65 2d 6d 61 73 6b 20 40 20 61 6e 64 20 6f 76 ke-mask @ and ov
3cb0: 65 72 20 6f 72 20 6b 65 2d 6d 61 73 6b 20 21 20 er or ke-mask !
3cc0: 2e 6b 65 79 2d 6c 69 73 74 20 3b 0a 0a 3a 20 2d .key-list ;..: -
3cd0: 67 72 6f 75 70 2d 70 65 72 6d 20 28 20 6f 3a 6b group-perm ( o:k
3ce0: 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 67 ey -- ). ke-g
3cf0: 72 6f 75 70 73 20 24 40 20 67 72 6f 75 70 73 3e roups $@ groups>
3d00: 6d 61 73 6b 20 69 6e 76 65 72 74 20 6b 65 2d 6d mask invert ke-m
3d10: 61 73 6b 20 61 6e 64 21 20 3b 0a 3a 20 2b 67 72 ask and! ;.: +gr
3d20: 6f 75 70 2d 70 65 72 6d 20 28 20 6f 3a 6b 65 79 oup-perm ( o:key
3d30: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 67 72 6f -- ). ke-gro
3d40: 75 70 73 20 24 40 20 67 72 6f 75 70 73 3e 6d 61 ups $@ groups>ma
3d50: 73 6b 20 20 20 20 20 20 20 20 6b 65 2d 6d 61 73 sk ke-mas
3d60: 6b 20 6f 72 21 20 3b 0a 0a 3a 20 61 64 64 2d 67 k or! ;..: add-g
3d70: 72 6f 75 70 20 28 20 69 64 20 6f 3a 6b 65 79 20 roup ( id o:key
3d80: 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 2d 31 20 -- ). dup -1
3d90: 3d 20 21 21 6e 6f 2d 67 72 6f 75 70 21 21 20 2d = !!no-group!! -
3da0: 67 72 6f 75 70 2d 70 65 72 6d 20 75 3e 36 34 20 group-perm u>64
3db0: 63 6d 64 74 6d 70 24 20 6b 65 2d 67 72 6f 75 70 cmdtmp$ ke-group
3dc0: 73 20 24 2b 21 20 2b 67 72 6f 75 70 2d 70 65 72 s $+! +group-per
3dd0: 6d 20 3b 0a 3a 20 73 65 74 2d 67 72 6f 75 70 20 m ;.: set-group
3de0: 28 20 69 64 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a ( id o:key -- ).
3df0: 20 20 20 20 64 75 70 20 2d 31 20 3d 20 21 21 6e dup -1 = !!n
3e00: 6f 2d 67 72 6f 75 70 21 21 20 2d 67 72 6f 75 70 o-group!! -group
3e10: 2d 70 65 72 6d 20 75 3e 36 34 20 63 6d 64 74 6d -perm u>64 cmdtm
3e20: 70 24 20 6b 65 2d 67 72 6f 75 70 73 20 24 21 20 p$ ke-groups $!
3e30: 2b 67 72 6f 75 70 2d 70 65 72 6d 20 3b 0a 3a 20 +group-perm ;.:
3e40: 73 75 62 2d 67 72 6f 75 70 20 28 20 69 64 20 6f sub-group ( id o
3e50: 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 64 75 :key -- ). du
3e60: 70 20 2d 31 20 3d 20 21 21 6e 6f 2d 67 72 6f 75 p -1 = !!no-grou
3e70: 70 21 21 20 2d 67 72 6f 75 70 2d 70 65 72 6d 20 p!! -group-perm
3e80: 75 3e 36 34 20 63 6d 64 74 6d 70 24 20 6b 65 2d u>64 cmdtmp$ ke-
3e90: 67 72 6f 75 70 73 20 24 40 20 32 6f 76 65 72 20 groups $@ 2over
3ea0: 73 65 61 72 63 68 0a 20 20 20 20 49 46 20 20 20 search. IF
3eb0: 6e 69 70 20 3e 72 20 6e 69 70 20 6b 65 2d 67 72 nip >r nip ke-gr
3ec0: 6f 75 70 73 20 64 75 70 20 24 40 6c 65 6e 20 72 oups dup $@len r
3ed0: 3e 20 2d 20 72 6f 74 20 24 64 65 6c 0a 20 20 20 > - rot $del.
3ee0: 20 45 4c 53 45 20 20 32 64 72 6f 70 20 32 64 72 ELSE 2drop 2dr
3ef0: 6f 70 20 20 54 48 45 4e 20 2b 67 72 6f 75 70 2d op THEN +group-
3f00: 70 65 72 6d 20 3b 0a 0a 3a 20 61 70 70 6c 79 2d perm ;..: apply-
3f10: 67 72 6f 75 70 20 28 20 61 64 64 72 20 75 20 6f group ( addr u o
3f20: 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6f 76 :key -- ). ov
3f30: 65 72 20 63 40 20 27 2b 27 20 3d 20 49 46 20 20 er c@ '+' = IF
3f40: 31 20 2f 73 74 72 69 6e 67 20 3e 67 72 6f 75 70 1 /string >group
3f50: 2d 69 64 20 61 64 64 2d 67 72 6f 75 70 20 2e 6b -id add-group .k
3f60: 65 79 2d 6c 69 73 74 20 20 45 58 49 54 20 20 54 ey-list EXIT T
3f70: 48 45 4e 0a 20 20 20 20 6f 76 65 72 20 63 40 20 HEN. over c@
3f80: 27 2d 27 20 3d 20 49 46 20 20 31 20 2f 73 74 72 '-' = IF 1 /str
3f90: 69 6e 67 20 3e 67 72 6f 75 70 2d 69 64 20 73 75 ing >group-id su
3fa0: 62 2d 67 72 6f 75 70 20 2e 6b 65 79 2d 6c 69 73 b-group .key-lis
3fb0: 74 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 t EXIT THEN.
3fc0: 20 20 3e 67 72 6f 75 70 2d 69 64 20 73 65 74 2d >group-id set-
3fd0: 67 72 6f 75 70 20 2e 6b 65 79 2d 6c 69 73 74 20 group .key-list
3fe0: 3b 0a 0a 5c 20 67 65 74 20 70 61 73 73 70 68 72 ;..\ get passphr
3ff0: 61 73 65 0a 0a 33 20 56 61 6c 75 65 20 70 61 73 ase..3 Value pas
4000: 73 70 68 72 61 73 65 2d 72 65 74 72 79 23 0a 24 sphrase-retry#.$
4010: 31 30 30 20 43 6f 6e 73 74 61 6e 74 20 6d 61 78 100 Constant max
4020: 2d 70 61 73 73 70 68 72 61 73 65 23 20 5c 20 32 -passphrase# \ 2
4030: 35 36 20 63 68 61 72 61 63 74 65 72 73 20 73 68 56 characters sh
4040: 6f 75 6c 64 20 62 65 20 65 6e 6f 75 67 68 2e 2e ould be enough..
4050: 2e 0a 6d 61 78 2d 70 61 73 73 70 68 72 61 73 65 ..max-passphrase
4060: 23 20 62 75 66 66 65 72 3a 20 70 61 73 73 70 68 # buffer: passph
4070: 72 61 73 65 0a 0a 3a 20 70 61 73 73 70 68 72 61 rase..: passphra
4080: 73 65 2d 69 6e 20 28 20 61 64 64 72 20 75 20 2d se-in ( addr u -
4090: 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 22 - addr u ). "
40a0: 50 41 53 53 50 48 52 41 53 45 22 20 67 65 74 65 PASSPHRASE" gete
40b0: 6e 76 20 32 64 75 70 20 64 30 3d 20 49 46 20 20 nv 2dup d0= IF
40c0: 32 64 72 6f 70 20 74 79 70 65 0a 09 70 61 73 73 2drop type..pass
40d0: 70 68 72 61 73 65 20 64 75 70 20 6d 61 78 2d 70 phrase dup max-p
40e0: 61 73 73 70 68 72 61 73 65 23 20 61 63 63 65 70 assphrase# accep
40f0: 74 2a 20 63 72 0a 20 20 20 20 45 4c 53 45 20 20 t* cr. ELSE
4100: 32 6e 69 70 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 2nip THEN ;..:
4110: 3e 70 61 73 73 70 68 72 61 73 65 20 28 20 61 64 >passphrase ( ad
4120: 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 20 29 dr u -- addr u )
4130: 0a 20 20 20 20 5c 47 20 63 72 65 61 74 65 20 61 . \G create a
4140: 20 35 31 32 20 62 69 74 20 68 61 73 68 20 6f 66 512 bit hash of
4150: 20 74 68 65 20 70 61 73 73 70 68 72 61 73 65 0a the passphrase.
4160: 20 20 20 20 6e 6f 2d 6b 65 79 20 3e 63 3a 6b 65 no-key >c:ke
4170: 79 20 63 3a 68 61 73 68 0a 20 20 20 20 6b 65 63 y c:hash. kec
4180: 63 61 6b 2d 70 61 64 64 65 64 20 63 3a 6b 65 79 cak-padded c:key
4190: 3e 20 6b 65 63 63 61 6b 2d 70 61 64 64 65 64 20 > keccak-padded
41a0: 6b 65 63 63 61 6b 23 6d 61 78 20 32 2f 20 3b 0a keccak#max 2/ ;.
41b0: 0a 3a 20 67 65 74 2d 70 61 73 73 70 68 72 61 73 .: get-passphras
41c0: 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 e ( addr u -- ad
41d0: 64 72 20 75 20 29 0a 20 20 20 20 70 61 73 73 70 dr u ). passp
41e0: 68 72 61 73 65 2d 69 6e 20 3e 70 61 73 73 70 68 hrase-in >passph
41f0: 72 61 73 65 20 3b 0a 0a 56 61 72 69 61 62 6c 65 rase ;..Variable
4200: 20 6b 65 79 73 0a 0a 3a 20 6c 61 73 74 6b 65 79 keys..: lastkey
4210: 40 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 20 @ ( -- addr u )
4220: 6b 65 79 73 20 24 5b 5d 23 20 31 2d 20 6b 65 79 keys $[]# 1- key
4230: 73 20 73 65 63 5b 5d 40 20 3b 0a 3a 20 6b 65 79 s sec[]@ ;.: key
4240: 3e 64 65 66 61 75 6c 74 20 28 20 2d 2d 20 29 20 >default ( -- )
4250: 6c 61 73 74 6b 65 79 40 20 64 72 6f 70 20 3e 73 lastkey@ drop >s
4260: 74 6f 72 65 6b 65 79 20 21 20 3b 0a 3a 20 2b 6b torekey ! ;.: +k
4270: 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 ey ( addr u -- )
4280: 20 6b 65 79 73 20 73 65 63 2b 5b 5d 21 20 3b 0a keys sec+[]! ;.
4290: 3a 20 2b 70 61 73 73 70 68 72 61 73 65 20 28 20 : +passphrase (
42a0: 61 64 64 72 20 75 20 2d 2d 20 29 20 20 67 65 74 addr u -- ) get
42b0: 2d 70 61 73 73 70 68 72 61 73 65 20 2b 6b 65 79 -passphrase +key
42c0: 20 3b 0a 3a 20 2b 63 68 65 63 6b 70 68 72 61 73 ;.: +checkphras
42d0: 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 66 6c e ( addr u -- fl
42e0: 61 67 20 29 20 67 65 74 2d 70 61 73 73 70 68 72 ag ) get-passphr
42f0: 61 73 65 20 6c 61 73 74 6b 65 79 40 20 73 74 72 ase lastkey@ str
4300: 3d 20 3b 0a 3a 20 2b 6e 65 77 70 68 72 61 73 65 = ;.: +newphrase
4310: 20 28 20 2d 2d 20 29 0a 20 20 20 20 42 45 47 49 ( -- ). BEGI
4320: 4e 0a 09 73 22 20 50 61 73 73 70 68 72 61 73 65 N..s" Passphrase
4330: 3a 20 22 20 2b 70 61 73 73 70 68 72 61 73 65 0a : " +passphrase.
4340: 09 73 22 20 52 65 74 79 70 65 20 70 6c 73 3a 20 .s" Retype pls:
4350: 22 20 2b 63 68 65 63 6b 70 68 72 61 73 65 20 30 " +checkphrase 0
4360: 3d 20 57 48 49 4c 45 0a 09 20 20 20 20 63 72 20 = WHILE.. cr
4370: 2e 22 20 20 64 69 64 6e 27 74 20 6d 61 74 63 68 ." didn't match
4380: 2c 20 74 72 79 20 61 67 61 69 6e 20 70 6c 65 61 , try again plea
4390: 73 65 22 20 63 72 0a 20 20 20 20 52 45 50 45 41 se" cr. REPEA
43a0: 54 20 63 72 20 3b 0a 0a 3a 20 22 3e 70 61 73 73 T cr ;..: ">pass
43b0: 70 68 72 61 73 65 20 28 20 61 64 64 72 20 75 20 phrase ( addr u
43c0: 2d 2d 20 29 20 3e 70 61 73 73 70 68 72 61 73 65 -- ) >passphrase
43d0: 20 2b 6b 65 79 20 3b 0a 3a 20 3e 73 65 63 6b 65 +key ;.: >secke
43e0: 79 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 0a y ( -- addr u ).
43f0: 20 20 20 20 6b 65 2d 73 6b 20 40 20 6b 65 2d 70 ke-sk @ ke-p
4400: 6b 20 24 40 20 64 72 6f 70 20 6b 65 79 70 61 64 k $@ drop keypad
4410: 20 65 64 2d 64 68 20 3b 0a 3a 20 2b 73 65 63 6b ed-dh ;.: +seck
4420: 65 79 20 28 20 2d 2d 20 29 20 3e 73 65 63 6b 65 ey ( -- ) >secke
4430: 79 20 2b 6b 65 79 20 3b 0a 0a 5c 20 22 22 20 22 y +key ;..\ "" "
4440: 3e 70 61 73 73 70 68 72 61 73 65 20 5c 20 66 6f >passphrase \ fo
4450: 6c 6c 6f 77 69 6e 67 20 74 68 65 20 65 6e 63 72 llowing the encr
4460: 79 70 74 2d 65 76 65 72 79 74 68 69 6e 67 20 70 ypt-everything p
4470: 61 72 61 64 69 67 6d 2c 0a 5c 20 6e 6f 20 70 61 aradigm,.\ no pa
4480: 73 73 77 6f 72 64 20 69 73 20 74 68 65 20 65 6d ssword is the em
4490: 70 74 79 20 73 74 72 69 6e 67 21 20 20 49 74 27 pty string! It'
44a0: 73 20 73 74 69 6c 6c 20 65 6e 63 72 79 70 74 65 s still encrypte
44b0: 64 20 3b 2d 29 21 0a 0a 5c 20 61 20 73 65 63 72 d ;-)!..\ a secr
44c0: 65 74 20 6b 65 79 20 6a 75 73 74 20 6e 65 65 64 et key just need
44d0: 73 20 61 20 6e 69 63 6b 20 61 6e 64 20 61 20 74 s a nick and a t
44e0: 79 70 65 2e 0a 5c 20 53 65 63 72 65 74 20 6b 65 ype..\ Secret ke
44f0: 79 73 20 63 61 6e 20 62 65 20 70 65 72 73 6f 6e ys can be person
4500: 73 20 61 6e 64 20 67 72 6f 75 70 73 2e 0a 0a 5c s and groups...\
4510: 20 61 20 70 75 62 6c 69 63 20 6b 65 79 20 6e 65 a public key ne
4520: 65 64 73 20 6d 6f 72 65 3a 20 6e 69 63 6b 2c 20 eds more: nick,
4530: 74 79 70 65 2c 20 70 72 6f 66 69 6c 65 2e 0a 5c type, profile..\
4540: 20 54 68 65 20 70 72 6f 66 69 6c 65 20 69 73 20 The profile is
4550: 61 20 73 74 72 75 63 74 75 72 65 64 20 64 6f 63 a structured doc
4560: 75 6d 65 6e 74 2c 20 69 2e 65 2e 20 70 6f 69 6e ument, i.e. poin
4570: 74 65 64 20 74 6f 20 62 79 20 61 20 68 61 73 68 ted to by a hash
4580: 2e 0a 0a 5c 20 61 20 73 69 67 6e 61 74 75 72 65 ...\ a signature
4590: 20 63 6f 6e 74 61 69 6e 73 20 61 20 70 75 62 6b contains a pubk
45a0: 65 79 2c 20 61 20 63 68 65 63 6b 62 6f 78 20 62 ey, a checkbox b
45b0: 69 74 6d 61 73 6b 2c 0a 5c 20 61 20 64 61 74 65 itmask,.\ a date
45c0: 2c 20 61 6e 20 65 78 70 69 72 61 74 69 6f 6e 20 , an expiration
45d0: 64 61 74 65 2c 20 74 68 65 20 73 69 67 6e 65 72 date, the signer
45e0: 27 73 20 70 75 62 6b 65 79 20 61 6e 64 20 74 68 's pubkey and th
45f0: 65 20 73 69 67 6e 61 74 75 72 65 20 69 74 73 65 e signature itse
4600: 6c 66 0a 5c 20 28 72 2b 73 29 2e 20 20 54 68 65 lf.\ (r+s). The
4610: 72 65 20 69 73 20 61 6e 20 6f 70 74 69 6f 6e 61 re is an optiona
4620: 6c 20 73 69 67 6e 69 6e 67 20 70 72 6f 74 6f 63 l signing protoc
4630: 6f 6c 20 64 6f 63 75 6d 65 6e 74 20 28 68 61 73 ol document (has
4640: 68 29 2e 0a 0a 5c 20 77 65 20 73 74 6f 72 65 20 h)...\ we store
4650: 65 61 63 68 20 69 74 65 6d 20 69 6e 20 61 20 32 each item in a 2
4660: 35 36 20 62 79 74 65 73 20 65 6e 63 72 79 70 74 56 bytes encrypt
4670: 65 64 20 73 74 72 69 6e 67 2c 20 69 2e 65 2e 20 ed string, i.e.
4680: 77 69 74 68 20 61 20 31 36 0a 5c 20 62 79 74 65 with a 16.\ byte
4690: 20 73 61 6c 74 20 61 6e 64 20 61 20 31 36 20 62 salt and a 16 b
46a0: 79 74 65 20 63 68 65 63 6b 73 75 6d 2e 0a 0a 3a yte checksum...:
46b0: 20 6b 65 2d 6c 61 73 74 21 20 28 20 36 34 64 61 ke-last! ( 64da
46c0: 74 65 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 73 te -- ). ke-s
46d0: 65 6c 66 73 69 67 20 24 40 6c 65 6e 20 24 31 30 elfsig $@len $10
46e0: 20 75 6d 61 78 20 6b 65 2d 73 65 6c 66 73 69 67 umax ke-selfsig
46f0: 20 24 21 6c 65 6e 0a 20 20 20 20 6b 65 2d 73 65 $!len. ke-se
4700: 6c 66 73 69 67 20 24 40 20 64 72 6f 70 20 36 34 lfsig $@ drop 64
4710: 27 2b 20 36 34 21 20 3b 0a 3a 20 6b 65 2d 66 69 '+ 64! ;.: ke-fi
4720: 72 73 74 21 20 28 20 36 34 64 61 74 65 20 2d 2d rst! ( 64date --
4730: 20 29 20 36 34 23 2d 31 20 6b 65 2d 6c 61 73 74 ) 64#-1 ke-last
4740: 21 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 !. ke-selfsig
4750: 20 24 40 20 64 72 6f 70 20 36 34 21 20 3b 0a 0a $@ drop 64! ;..
4760: 73 63 6f 70 65 7b 20 6e 65 74 32 6f 2d 62 61 73 scope{ net2o-bas
4770: 65 0a 0a 63 6d 64 2d 74 61 62 6c 65 20 24 40 20 e..cmd-table $@
4780: 69 6e 68 65 72 69 74 2d 74 61 62 6c 65 20 6b 65 inherit-table ke
4790: 79 2d 65 6e 74 72 79 2d 74 61 62 6c 65 0a 5c 67 y-entry-table.\g
47a0: 20 0a 5c 67 20 23 23 23 20 6b 65 79 20 73 74 6f .\g ### key sto
47b0: 72 61 67 65 20 63 6f 6d 6d 61 6e 64 73 20 23 23 rage commands ##
47c0: 23 0a 5c 67 20 0a 24 31 31 20 6e 65 74 32 6f 3a #.\g .$11 net2o:
47d0: 20 70 72 69 76 6b 65 79 20 28 20 24 3a 73 74 72 privkey ( $:str
47e0: 69 6e 67 20 2d 2d 20 29 0a 20 20 20 20 5c 67 20 ing -- ). \g
47f0: 70 72 69 76 61 74 65 20 6b 65 79 0a 20 20 20 20 private key.
4800: 5c 20 64 6f 65 73 20 6e 6f 74 20 6e 65 65 64 20 \ does not need
4810: 74 6f 20 62 65 20 73 69 67 6e 65 64 2c 20 74 68 to be signed, th
4820: 65 20 73 65 63 72 65 74 20 6b 65 79 20 76 65 72 e secret key ver
4830: 69 66 69 65 73 20 69 74 73 65 6c 66 0a 20 20 20 ifies itself.
4840: 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 34 30 !!unsigned? $40
4850: 20 21 21 3e 3d 6f 72 64 65 72 3f 0a 20 20 20 20 !!>=order?.
4860: 6b 65 79 70 61 63 6b 20 63 40 20 24 46 20 61 6e keypack c@ $F an
4870: 64 20 6b 65 2d 70 77 6c 65 76 65 6c 20 21 0a 20 d ke-pwlevel !.
4880: 20 20 20 24 3e 20 6f 76 65 72 20 6b 65 79 70 61 $> over keypa
4890: 64 20 73 6b 3e 70 6b 20 5c 20 67 65 6e 65 72 61 d sk>pk \ genera
48a0: 74 65 20 70 75 62 6b 65 79 0a 20 20 20 20 6b 65 te pubkey. ke
48b0: 79 70 61 64 20 6b 65 2d 70 6b 20 24 40 20 64 72 ypad ke-pk $@ dr
48c0: 6f 70 20 6b 65 79 73 69 7a 65 20 74 75 63 6b 20 op keysize tuck
48d0: 73 74 72 3d 20 30 3d 20 21 21 77 72 6f 6e 67 2d str= 0= !!wrong-
48e0: 6b 65 79 21 21 0a 20 20 20 20 6b 65 2d 73 6b 20 key!!. ke-sk
48f0: 73 65 63 21 20 2b 73 65 63 6b 65 79 20 22 5c 30 sec! +seckey "\0
4900: 22 20 6b 65 2d 67 72 6f 75 70 73 20 24 21 20 30 " ke-groups $! 0
4910: 20 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 40 20 64 groups[] $[]@ d
4920: 72 6f 70 20 40 20 6b 65 2d 6d 61 73 6b 20 21 20 rop @ ke-mask !
4930: 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 74 79 70 ;.+net2o: keytyp
4940: 65 20 28 20 6e 20 2d 2d 20 29 20 20 20 20 20 20 e ( n -- )
4950: 20 20 20 20 20 21 21 73 69 67 6e 65 64 3f 20 20 !!signed?
4960: 20 31 20 21 21 3e 6f 72 64 65 72 3f 20 36 34 3e 1 !!>order? 64>
4970: 6e 20 6b 65 2d 74 79 70 65 20 21 20 3b 0a 20 20 n ke-type ! ;.
4980: 20 20 5c 67 20 6b 65 79 20 74 79 70 65 20 28 30 \g key type (0
4990: 3a 20 61 6e 6f 6e 2c 20 31 3a 20 75 73 65 72 2c : anon, 1: user,
49a0: 20 32 3a 20 67 72 6f 75 70 29 0a 2b 6e 65 74 32 2: group).+net2
49b0: 6f 3a 20 6b 65 79 6e 69 63 6b 20 28 20 24 3a 73 o: keynick ( $:s
49c0: 74 72 69 6e 67 20 2d 2d 20 29 20 20 20 20 21 21 tring -- ) !!
49d0: 73 69 67 6e 65 64 3f 20 20 20 32 20 21 21 3e 6f signed? 2 !!>o
49e0: 72 64 65 72 3f 20 24 3e 20 6b 65 2d 6e 69 63 6b rder? $> ke-nick
49f0: 20 24 21 0a 20 20 20 20 5c 67 20 6b 65 79 20 6e $!. \g key n
4a00: 69 63 6b 0a 20 20 20 20 6e 69 63 6b 21 20 3b 0a ick. nick! ;.
4a10: 2b 6e 65 74 32 6f 3a 20 6b 65 79 70 72 6f 66 69 +net2o: keyprofi
4a20: 6c 65 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d le ( $:string --
4a30: 20 29 20 21 21 73 69 67 6e 65 64 3f 20 20 20 34 ) !!signed? 4
4a40: 20 21 21 3e 6f 72 64 65 72 3f 20 24 3e 20 6b 65 !!>order? $> ke
4a50: 2d 70 72 6f 66 20 24 21 20 3b 0a 20 20 20 20 5c -prof $! ;. \
4a60: 67 20 6b 65 79 20 70 72 6f 66 69 6c 65 20 28 68 g key profile (h
4a70: 61 73 68 20 6f 66 20 61 20 72 65 73 6f 75 72 63 ash of a resourc
4a80: 65 29 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 6d 61 e).+net2o: keyma
4a90: 73 6b 20 28 20 78 20 2d 2d 20 29 20 20 20 20 20 sk ( x -- )
4aa0: 20 20 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 !!unsigned?
4ab0: 24 34 30 20 21 21 3e 3d 6f 72 64 65 72 3f 20 36 $40 !!>=order? 6
4ac0: 34 3e 6e 0a 20 20 20 20 5c 67 20 6b 65 79 20 61 4>n. \g key a
4ad0: 63 63 65 73 73 20 72 69 67 68 74 20 6d 61 73 6b ccess right mask
4ae0: 0a 20 20 20 20 31 20 69 6d 70 6f 72 74 2d 74 79 . 1 import-ty
4af0: 70 65 20 40 20 6c 73 68 69 66 74 0a 20 20 20 20 pe @ lshift.
4b00: 5b 20 31 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 [ 1 import#self
4b10: 6c 73 68 69 66 74 20 31 20 69 6d 70 6f 72 74 23 lshift 1 import#
4b20: 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 20 5d 4c new lshift or ]L
4b30: 0a 20 20 20 20 61 6e 64 20 30 3d 20 49 46 20 20 . and 0= IF
4b40: 64 72 6f 70 20 70 65 72 6d 25 64 65 66 61 75 6c drop perm%defaul
4b50: 74 20 20 54 48 45 4e 20 20 64 75 70 20 6b 65 2d t THEN dup ke-
4b60: 6d 61 73 6b 20 6f 72 21 20 3f 3e 67 72 6f 75 70 mask or! ?>group
4b70: 73 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 67 s ;.+net2o: keyg
4b80: 72 6f 75 70 73 20 28 20 24 3a 67 72 6f 75 70 73 roups ( $:groups
4b90: 20 2d 2d 20 29 20 21 21 75 6e 73 69 67 6e 65 64 -- ) !!unsigned
4ba0: 3f 20 24 32 30 20 21 21 3e 6f 72 64 65 72 3f 20 ? $20 !!>order?
4bb0: 24 3e 0a 20 20 20 20 5c 67 20 61 63 63 65 73 73 $>. \g access
4bc0: 20 67 72 6f 75 70 73 0a 20 20 20 20 31 20 69 6d groups. 1 im
4bd0: 70 6f 72 74 2d 74 79 70 65 20 40 20 6c 73 68 69 port-type @ lshi
4be0: 66 74 0a 20 20 20 20 5b 20 31 20 69 6d 70 6f 72 ft. [ 1 impor
4bf0: 74 23 73 65 6c 66 20 6c 73 68 69 66 74 20 31 20 t#self lshift 1
4c00: 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 import#new lshif
4c10: 74 20 6f 72 20 5d 4c 0a 20 20 20 20 61 6e 64 20 t or ]L. and
4c20: 30 3d 20 49 46 20 20 32 64 72 6f 70 20 22 5c 78 0= IF 2drop "\x
4c30: 30 31 22 20 20 54 48 45 4e 0a 20 20 20 20 32 64 01" THEN. 2d
4c40: 75 70 20 6b 65 2d 67 72 6f 75 70 73 20 24 21 20 up ke-groups $!
4c50: 67 72 6f 75 70 73 3e 6d 61 73 6b 20 6b 65 2d 6d groups>mask ke-m
4c60: 61 73 6b 20 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 ask ! ;.+net2o:
4c70: 2b 6b 65 79 73 69 67 20 28 20 24 3a 73 74 72 69 +keysig ( $:stri
4c80: 6e 67 20 2d 2d 20 29 20 20 21 21 75 6e 73 69 67 ng -- ) !!unsig
4c90: 6e 65 64 3f 20 24 31 30 20 21 21 3e 3d 6f 72 64 ned? $10 !!>=ord
4ca0: 65 72 3f 20 24 3e 20 6b 65 2d 73 69 67 73 20 24 er? $> ke-sigs $
4cb0: 2b 5b 5d 21 20 3b 0a 20 20 20 20 5c 67 20 61 64 +[]! ;. \g ad
4cc0: 64 20 61 20 6b 65 79 20 73 69 67 6e 61 74 75 72 d a key signatur
4cd0: 65 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 69 6d 70 e.+net2o: keyimp
4ce0: 6f 72 74 20 28 20 6e 20 2d 2d 20 29 20 20 20 20 ort ( n -- )
4cf0: 20 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 !!unsigned? $
4d00: 31 30 20 21 21 3e 3d 6f 72 64 65 72 3f 0a 20 20 10 !!>=order?.
4d10: 20 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76 65 config:pw-leve
4d20: 6c 23 20 40 20 30 3c 20 49 46 20 20 36 34 3e 6e l# @ 0< IF 64>n
4d30: 0a 09 64 75 70 20 5b 20 31 20 69 6d 70 6f 72 74 ..dup [ 1 import
4d40: 23 6e 65 77 20 6c 73 68 69 66 74 20 5d 4c 20 61 #new lshift ]L a
4d50: 6e 64 20 30 3d 20 49 46 0a 09 20 20 20 20 69 6d nd 0= IF.. im
4d60: 70 6f 72 74 23 75 6e 74 72 75 73 74 65 64 20 75 port#untrusted u
4d70: 6d 69 6e 20 31 20 73 77 61 70 20 6c 73 68 69 66 min 1 swap lshif
4d80: 74 20 5b 20 31 20 69 6d 70 6f 72 74 23 6e 65 77 t [ 1 import#new
4d90: 20 6c 73 68 69 66 74 20 5d 4c 20 6f 72 0a 09 45 lshift ]L or..E
4da0: 4c 53 45 0a 09 20 20 20 20 5b 20 32 20 69 6d 70 LSE.. [ 2 imp
4db0: 6f 72 74 23 75 6e 74 72 75 73 74 65 64 20 6c 73 ort#untrusted ls
4dc0: 68 69 66 74 20 31 2d 20 31 20 69 6d 70 6f 72 74 hift 1- 1 import
4dd0: 23 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 20 5d #new lshift or ]
4de0: 4c 20 61 6e 64 0a 09 54 48 45 4e 0a 09 6b 65 2d L and..THEN..ke-
4df0: 69 6d 70 6f 72 74 73 20 6f 72 21 0a 20 20 20 20 imports or!.
4e00: 45 4c 53 45 20 20 36 34 64 72 6f 70 20 20 54 48 ELSE 64drop TH
4e10: 45 4e 20 3b 0a 2b 6e 65 74 32 6f 3a 20 72 73 6b EN ;.+net2o: rsk
4e20: 6b 65 79 20 28 20 24 3a 73 74 72 69 6e 67 20 2d key ( $:string -
4e30: 2d 2d 20 29 0a 20 20 20 20 5c 67 20 72 65 76 6f -- ). \g revo
4e40: 6b 65 20 6b 65 79 2c 20 74 65 6d 70 6f 72 61 72 ke key, temporar
4e50: 69 6c 79 20 73 74 6f 72 65 64 0a 20 20 20 20 5c ily stored. \
4e60: 20 64 6f 65 73 20 6e 6f 74 20 6e 65 65 64 20 74 does not need t
4e70: 6f 20 62 65 20 73 69 67 6e 65 64 2c 20 74 68 65 o be signed, the
4e80: 20 72 65 76 6f 6b 65 20 6b 65 79 20 76 65 72 69 revoke key veri
4e90: 66 69 65 73 20 69 74 73 65 6c 66 0a 20 20 20 20 fies itself.
4ea0: 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 38 30 20 !!unsigned? $80
4eb0: 21 21 3e 3d 6f 72 64 65 72 3f 0a 20 20 20 20 24 !!>=order?. $
4ec0: 3e 20 32 64 75 70 20 73 6b 72 65 76 20 73 77 61 > 2dup skrev swa
4ed0: 70 20 6b 65 79 7c 20 6d 6f 76 65 20 6b 65 2d 70 p key| move ke-p
4ee0: 6b 20 24 40 20 64 72 6f 70 20 63 68 65 63 6b 2d k $@ drop check-
4ef0: 72 65 76 3f 20 30 3d 20 21 21 6e 6f 74 2d 6d 79 rev? 0= !!not-my
4f00: 2d 72 65 76 73 6b 21 21 0a 20 20 20 20 70 6b 72 -revsk!!. pkr
4f10: 65 76 20 6b 65 79 73 69 7a 65 32 20 65 72 61 73 ev keysize2 eras
4f20: 65 20 20 6b 65 2d 72 73 6b 20 73 65 63 21 20 3b e ke-rsk sec! ;
4f30: 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 70 65 74 20 .+net2o: keypet
4f40: 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 ( $:string -- )
4f50: 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 20 24 3e !!unsigned? $>
4f60: 0a 20 20 20 20 63 6f 6e 66 69 67 3a 70 77 2d 6c . config:pw-l
4f70: 65 76 65 6c 23 20 40 20 30 3c 20 49 46 20 20 6b evel# @ 0< IF k
4f80: 65 2d 70 65 74 73 20 24 2b 5b 5d 21 20 70 65 74 e-pets $+[]! pet
4f90: 21 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 ! ELSE 2drop
4fa0: 54 48 45 4e 20 3b 0a 7d 73 63 6f 70 65 0a 0a 67 THEN ;.}scope..g
4fb0: 65 6e 2d 74 61 62 6c 65 20 24 66 72 65 65 7a 65 en-table $freeze
4fc0: 0a 27 20 63 6f 6e 74 65 78 74 2d 74 61 62 6c 65 .' context-table
4fd0: 20 69 73 20 67 65 6e 2d 74 61 62 6c 65 0a 0a 3a is gen-table..:
4fe0: 20 6b 65 79 3a 6e 65 73 74 2d 73 69 67 20 28 20 key:nest-sig (
4ff0: 61 64 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 addr u -- addr u
5000: 27 20 66 6c 61 67 20 29 0a 20 20 20 20 70 6b 32 ' flag ). pk2
5010: 2d 73 69 67 3f 20 64 75 70 20 3f 45 58 49 54 20 -sig? dup ?EXIT
5020: 64 72 6f 70 0a 20 20 20 20 32 64 75 70 20 2b 20 drop. 2dup +
5030: 73 69 67 73 69 7a 65 23 20 2d 20 73 69 67 73 69 sigsize# - sigsi
5040: 7a 65 23 20 3e 24 0a 20 20 20 20 73 69 67 70 6b ze# >$. sigpk
5050: 32 73 69 7a 65 23 20 2d 20 32 64 75 70 20 2b 20 2size# - 2dup +
5060: 6b 65 79 73 69 7a 65 32 20 6b 65 79 3f 6e 65 77 keysize2 key?new
5070: 20 6e 3a 3e 6f 20 24 3e 20 6b 65 2d 73 65 6c 66 n:>o $> ke-self
5080: 73 69 67 20 24 21 0a 20 20 20 20 73 69 6d 2d 6e sig $!. sim-n
5090: 69 63 6b 21 20 6f 66 66 20 63 2d 73 74 61 74 65 ick! off c-state
50a0: 20 6f 66 66 20 73 69 67 2d 6f 6b 20 3b 0a 27 20 off sig-ok ;.'
50b0: 6b 65 79 3a 6e 65 73 74 2d 73 69 67 20 6b 65 79 key:nest-sig key
50c0: 2d 65 6e 74 72 79 20 74 6f 20 6e 65 73 74 2d 73 -entry to nest-s
50d0: 69 67 0a 0a 73 61 6d 70 6c 65 2d 6b 65 79 20 3e ig..sample-key >
50e0: 6f 20 6b 65 79 2d 65 6e 74 72 79 2d 74 61 62 6c o key-entry-tabl
50f0: 65 20 40 20 74 6f 6b 65 6e 2d 74 61 62 6c 65 20 e @ token-table
5100: 21 20 6f 3e 0a 0a 3a 20 6b 65 79 3a 63 6f 64 65 ! o>..: key:code
5110: 20 28 20 2d 2d 20 29 0a 20 20 20 20 63 6f 64 65 ( -- ). code
5120: 2d 6b 65 79 20 20 63 6d 64 6c 6f 63 6b 20 6c 6f -key cmdlock lo
5130: 63 6b 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 6b ck. keypack k
5140: 65 79 70 61 63 6b 2d 61 6c 6c 23 20 65 72 61 73 eypack-all# eras
5150: 65 0a 20 20 20 20 63 6d 64 72 65 73 65 74 20 69 e. cmdreset i
5160: 6e 69 74 2d 72 65 70 6c 79 20 61 6c 73 6f 20 6e nit-reply also n
5170: 65 74 32 6f 2d 62 61 73 65 20 3b 0a 63 6f 6d 70 et2o-base ;.comp
5180: 3a 20 3a 2c 20 61 6c 73 6f 20 6e 65 74 32 6f 2d : :, also net2o-
5190: 62 61 73 65 20 3b 0a 0a 73 63 6f 70 65 7b 20 6e base ;..scope{ n
51a0: 65 74 32 6f 2d 62 61 73 65 0a 0a 3a 20 65 6e 64 et2o-base..: end
51b0: 3a 6b 65 79 20 28 20 2d 2d 20 29 0a 20 20 20 20 :key ( -- ).
51c0: 65 6e 64 2d 77 69 74 68 20 70 72 65 76 69 6f 75 end-with previou
51d0: 73 20 63 6d 64 6c 6f 63 6b 20 75 6e 6c 6f 63 6b s cmdlock unlock
51e0: 20 3b 0a 63 6f 6d 70 3a 20 3a 2c 20 70 72 65 76 ;.comp: :, prev
51f0: 69 6f 75 73 20 3b 0a 0a 7d 73 63 6f 70 65 0a 0a ious ;..}scope..
5200: 3a 20 6b 65 79 2d 63 72 79 70 74 20 28 20 2d 2d : key-crypt ( --
5210: 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 6b ). keypack k
5220: 65 79 70 61 63 6b 2d 61 6c 6c 23 0a 20 20 20 20 eypack-all#.
5230: 3e 73 74 6f 72 65 6b 65 79 20 73 65 63 40 20 64 >storekey sec@ d
5240: 75 70 20 24 32 30 20 75 3c 3d 20 5c 20 69 73 20 up $20 u<= \ is
5250: 61 20 73 65 63 72 65 74 2c 20 6e 6f 20 6e 65 65 a secret, no nee
5260: 64 20 74 6f 20 62 65 20 73 6c 6f 77 0a 20 20 20 d to be slow.
5270: 20 49 46 20 20 65 6e 63 72 79 70 74 24 20 20 45 IF encrypt$ E
5280: 4c 53 45 20 20 63 6f 6e 66 69 67 3a 70 77 2d 6c LSE config:pw-l
5290: 65 76 65 6c 23 20 40 20 65 6e 63 72 79 70 74 2d evel# @ encrypt-
52a0: 70 77 24 20 20 54 48 45 4e 20 3b 0a 0a 30 20 56 pw$ THEN ;..0 V
52b0: 61 6c 75 65 20 6b 65 79 2d 73 66 64 20 5c 20 73 alue key-sfd \ s
52c0: 65 63 72 65 74 20 6b 65 79 73 0a 30 20 56 61 6c ecret keys.0 Val
52d0: 75 65 20 6b 65 79 2d 70 66 64 20 5c 20 70 75 62 ue key-pfd \ pub
52e0: 6b 65 79 73 0a 0a 5c 20 6c 65 67 61 63 79 20 66 keys..\ legacy f
52f0: 6f 72 20 65 61 72 6c 79 20 76 65 72 73 69 6f 6e or early version
5300: 73 20 6f 66 20 6e 65 74 32 6f 20 70 72 69 6f 72 s of net2o prior
5310: 20 32 30 31 36 30 36 30 36 0a 0a 3a 20 6e 65 74 20160606..: net
5320: 32 6f 3e 6b 65 79 73 20 7b 20 61 64 64 72 20 75 2o>keys { addr u
5330: 20 2d 2d 20 7d 0a 20 20 20 20 61 64 64 72 20 75 -- }. addr u
5340: 20 2e 6e 65 74 32 6f 2f 20 20 61 64 64 72 20 75 .net2o/ addr u
5350: 20 2e 6b 65 79 73 2f 20 72 65 6e 61 6d 65 2d 66 .keys/ rename-f
5360: 69 6c 65 20 64 72 6f 70 20 3b 0a 3a 20 3f 6c 65 ile drop ;.: ?le
5370: 67 61 63 79 2d 6b 65 79 73 20 28 20 66 6c 61 67 gacy-keys ( flag
5380: 20 2d 2d 20 29 0a 20 20 20 20 5c 20 21 21 46 49 -- ). \ !!FI
5390: 58 4d 45 21 21 20 6e 65 65 64 73 20 74 6f 20 62 XME!! needs to b
53a0: 65 20 72 65 6d 6f 76 65 64 20 77 68 65 6e 20 61 e removed when a
53b0: 6c 6c 20 63 75 72 72 65 6e 74 20 75 73 65 72 73 ll current users
53c0: 0a 20 20 20 20 5c 20 68 61 76 65 20 6d 69 67 72 . \ have migr
53d0: 61 74 65 64 0a 20 20 20 20 49 46 0a 09 22 70 75 ated. IF.."pu
53e0: 62 6b 65 79 73 2e 6b 32 6f 22 20 6e 65 74 32 6f bkeys.k2o" net2o
53f0: 3e 6b 65 79 73 0a 09 22 73 65 63 6b 65 79 73 2e >keys.."seckeys.
5400: 6b 32 6f 22 20 6e 65 74 32 6f 3e 6b 65 79 73 0a k2o" net2o>keys.
5410: 20 20 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 67 65 THEN ;..: ge
5420: 6e 2d 6b 65 79 73 2d 64 69 72 20 28 20 2d 2d 20 n-keys-dir ( --
5430: 29 0a 20 20 20 20 69 6e 69 74 2d 64 69 72 73 20 ). init-dirs
5440: 3f 2e 6e 65 74 32 6f 2f 6b 65 79 73 20 3f 6c 65 ?.net2o/keys ?le
5450: 67 61 63 79 2d 6b 65 79 73 0a 20 20 20 20 67 72 gacy-keys. gr
5460: 6f 75 70 73 5b 5d 20 24 5b 5d 23 20 30 3d 20 49 oups[] $[]# 0= I
5470: 46 20 20 72 65 61 64 2d 67 72 6f 75 70 73 20 20 F read-groups
5480: 54 48 45 4e 20 3b 0a 0a 3a 20 3f 66 64 2d 6b 65 THEN ;..: ?fd-ke
5490: 79 73 20 28 20 66 64 20 61 64 64 72 20 75 20 2d ys ( fd addr u -
54a0: 2d 20 66 64 27 20 29 20 7b 20 61 64 64 72 20 75 - fd' ) { addr u
54b0: 20 7d 20 64 75 70 20 3f 45 58 49 54 20 64 72 6f } dup ?EXIT dro
54c0: 70 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 2d 64 p. gen-keys-d
54d0: 69 72 0a 20 20 20 20 61 64 64 72 20 75 20 72 2f ir. addr u r/
54e0: 77 20 6f 70 65 6e 2d 66 69 6c 65 20 64 75 70 20 w open-file dup
54f0: 6e 6f 2d 66 69 6c 65 23 20 3d 20 49 46 0a 09 32 no-file# = IF..2
5500: 64 72 6f 70 20 61 64 64 72 20 75 20 72 2f 77 20 drop addr u r/w
5510: 63 72 65 61 74 65 2d 66 69 6c 65 0a 20 20 20 20 create-file.
5520: 54 48 45 4e 20 20 74 68 72 6f 77 20 3b 0a 0a 3a THEN throw ;..:
5530: 20 3f 6b 65 79 2d 73 66 64 20 28 20 2d 2d 20 66 ?key-sfd ( -- f
5540: 64 20 29 0a 20 20 20 20 6b 65 79 2d 73 66 64 20 d ). key-sfd
5550: 22 73 65 63 6b 65 79 73 2e 6b 32 6f 22 20 2e 6b "seckeys.k2o" .k
5560: 65 79 73 2f 20 3f 66 64 2d 6b 65 79 73 20 64 75 eys/ ?fd-keys du
5570: 70 20 74 6f 20 6b 65 79 2d 73 66 64 20 3b 0a 3a p to key-sfd ;.:
5580: 20 3f 6b 65 79 2d 70 66 64 20 28 20 2d 2d 20 66 ?key-pfd ( -- f
5590: 64 20 29 0a 20 20 20 20 6b 65 79 2d 70 66 64 20 d ). key-pfd
55a0: 22 70 75 62 6b 65 79 73 2e 6b 32 6f 22 20 2e 6b "pubkeys.k2o" .k
55b0: 65 79 73 2f 20 3f 66 64 2d 6b 65 79 73 20 64 75 eys/ ?fd-keys du
55c0: 70 20 74 6f 20 6b 65 79 2d 70 66 64 20 3b 0a 0a p to key-pfd ;..
55d0: 3a 20 6b 65 79 3e 73 66 69 6c 65 20 28 20 2d 2d : key>sfile ( --
55e0: 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 6b ). keypack k
55f0: 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3f 6b 65 79 eypack-all# ?key
5600: 2d 73 66 64 20 61 70 70 65 6e 64 2d 66 69 6c 65 -sfd append-file
5610: 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 21 20 3b ke-offset 64! ;
5620: 0a 3a 20 6b 65 79 3e 70 66 69 6c 65 20 28 20 2d .: key>pfile ( -
5630: 2d 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 - ). keypack
5640: 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3f 6b 65 keypack-all# ?ke
5650: 79 2d 70 66 64 20 61 70 70 65 6e 64 2d 66 69 6c y-pfd append-fil
5660: 65 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 21 20 e ke-offset 64!
5670: 3b 0a 0a 3a 20 6b 65 79 3e 73 66 69 6c 65 40 70 ;..: key>sfile@p
5680: 6f 73 20 28 20 36 34 70 6f 73 20 2d 2d 20 29 20 os ( 64pos -- )
5690: 36 34 64 75 70 20 36 34 23 2d 31 20 36 34 3d 20 64dup 64#-1 64=
56a0: 49 46 20 20 36 34 64 72 6f 70 20 6b 65 79 3e 73 IF 64drop key>s
56b0: 66 69 6c 65 0a 20 20 20 20 45 4c 53 45 20 20 36 file. ELSE 6
56c0: 34 3e 72 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 4>r keypack keyp
56d0: 61 63 6b 2d 61 6c 6c 23 20 36 34 72 3e 20 3f 6b ack-all# 64r> ?k
56e0: 65 79 2d 73 66 64 20 77 72 69 74 65 40 70 6f 73 ey-sfd write@pos
56f0: 2d 66 69 6c 65 20 20 54 48 45 4e 20 3b 0a 3a 20 -file THEN ;.:
5700: 6b 65 79 3e 70 66 69 6c 65 40 70 6f 73 20 28 20 key>pfile@pos (
5710: 36 34 70 6f 73 20 2d 2d 20 29 20 36 34 64 75 70 64pos -- ) 64dup
5720: 20 36 34 23 2d 31 20 36 34 3d 20 49 46 20 20 36 64#-1 64= IF 6
5730: 34 64 72 6f 70 20 6b 65 79 3e 70 66 69 6c 65 0a 4drop key>pfile.
5740: 20 20 20 20 45 4c 53 45 20 20 36 34 3e 72 20 6b ELSE 64>r k
5750: 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 eypack keypack-a
5760: 6c 6c 23 20 36 34 72 3e 20 3f 6b 65 79 2d 70 66 ll# 64r> ?key-pf
5770: 64 20 77 72 69 74 65 40 70 6f 73 2d 66 69 6c 65 d write@pos-file
5780: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 72 6e 64 3e THEN ;..: rnd>
5790: 73 66 69 6c 65 20 28 20 2d 2d 20 29 0a 20 20 20 sfile ( -- ).
57a0: 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b keypack keypack
57b0: 2d 61 6c 6c 23 20 3e 72 6e 67 24 20 6b 65 79 3e -all# >rng$ key>
57c0: 73 66 69 6c 65 20 3b 0a 3a 20 72 6e 64 3e 70 66 sfile ;.: rnd>pf
57d0: 69 6c 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b ile ( -- ). k
57e0: 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 eypack keypack-a
57f0: 6c 6c 23 20 3e 72 6e 67 24 20 6b 65 79 3e 70 66 ll# >rng$ key>pf
5800: 69 6c 65 20 3b 0a 0a 3a 20 3e 6b 65 79 73 20 28 ile ;..: >keys (
5810: 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 61 64 64 -- ). \G add
5820: 20 73 68 61 72 65 64 20 73 65 63 72 65 74 20 74 shared secret t
5830: 6f 20 6c 69 73 74 20 6f 66 20 70 6f 73 73 69 62 o list of possib
5840: 6c 65 20 6b 65 79 73 0a 20 20 20 20 73 6b 63 20 le keys. skc
5850: 70 6b 63 20 6b 65 79 70 61 64 20 65 64 2d 64 68 pkc keypad ed-dh
5860: 20 2b 6b 65 79 20 3b 0a 0a 5c 20 6b 65 79 20 67 +key ;..\ key g
5870: 65 6e 65 72 61 74 69 6f 6e 0a 5c 20 66 6f 72 20 eneration.\ for
5880: 72 65 70 72 6f 64 75 63 69 62 69 6c 69 74 79 20 reproducibility
5890: 6f 66 20 74 68 65 20 73 65 6c 66 73 69 67 2c 20 of the selfsig,
58a0: 61 6c 77 61 79 73 20 75 73 65 20 74 68 65 20 73 always use the s
58b0: 61 6d 65 20 6f 72 64 65 72 3a 0a 5c 20 22 70 75 ame order:.\ "pu
58c0: 62 6b 65 79 22 20 6e 65 77 6b 65 79 20 3c 6e 3e bkey" newkey <n>
58d0: 20 6b 65 79 74 79 70 65 20 22 6e 69 63 6b 22 20 keytype "nick"
58e0: 6b 65 79 6e 69 63 6b 20 22 73 69 67 22 20 6b 65 keynick "sig" ke
58f0: 79 73 65 6c 66 73 69 67 0a 0a 55 73 65 72 20 70 yselfsig..User p
5900: 6b 2b 73 69 67 24 0a 0a 6b 65 79 73 69 7a 65 32 k+sig$..keysize2
5910: 20 43 6f 6e 73 74 61 6e 74 20 70 6b 72 6b 23 0a Constant pkrk#.
5920: 0a 3a 20 5d 70 6b 2b 73 69 67 6e 20 28 20 61 64 .: ]pk+sign ( ad
5930: 64 72 20 75 20 2d 2d 20 29 20 2b 63 6d 64 62 75 dr u -- ) +cmdbu
5940: 66 20 5d 73 69 67 6e 20 3b 0a 0a 3a 20 70 61 63 f ]sign ;..: pac
5950: 6b 2d 6b 65 79 20 28 20 74 79 70 65 20 6e 69 63 k-key ( type nic
5960: 6b 20 75 20 2d 2d 20 29 0a 20 20 20 20 6e 6f 77 k u -- ). now
5970: 3e 6e 65 76 65 72 0a 20 20 20 20 6b 65 79 3a 63 >never. key:c
5980: 6f 64 65 0a 20 20 20 20 20 20 73 69 67 6e 5b 0a ode. sign[.
5990: 20 20 20 20 20 20 72 6f 74 20 75 6c 69 74 2c 20 rot ulit,
59a0: 6b 65 79 74 79 70 65 20 24 2c 20 6b 65 79 6e 69 keytype $, keyni
59b0: 63 6b 0a 20 20 20 20 20 20 70 6b 63 20 70 6b 72 ck. pkc pkr
59c0: 6b 23 20 5d 70 6b 2b 73 69 67 6e 0a 20 20 20 20 k# ]pk+sign.
59d0: 20 20 73 6b 63 20 6b 65 79 73 69 7a 65 20 73 65 skc keysize se
59e0: 63 24 2c 20 70 72 69 76 6b 65 79 0a 20 20 20 20 c$, privkey.
59f0: 65 6e 64 3a 6b 65 79 20 3b 0a 0a 61 6c 73 6f 20 end:key ;..also
5a00: 6e 65 74 32 6f 2d 62 61 73 65 0a 3a 20 70 61 63 net2o-base.: pac
5a10: 6b 2d 63 6f 72 65 20 28 20 6f 3a 6b 65 79 20 2d k-core ( o:key -
5a20: 2d 20 29 20 5c 20 63 6f 72 65 20 77 69 74 68 6f - ) \ core witho
5a30: 75 74 20 6b 65 79 0a 20 20 20 20 6b 65 2d 74 79 ut key. ke-ty
5a40: 70 65 20 40 20 75 6c 69 74 2c 20 6b 65 79 74 79 pe @ ulit, keyty
5a50: 70 65 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 24 pe. ke-nick $
5a60: 40 20 24 2c 20 6b 65 79 6e 69 63 6b 0a 20 20 20 @ $, keynick.
5a70: 20 6b 65 2d 70 72 6f 66 20 24 40 20 64 75 70 20 ke-prof $@ dup
5a80: 49 46 20 20 24 2c 20 6b 65 79 70 72 6f 66 69 6c IF $, keyprofil
5a90: 65 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 e ELSE 2drop
5aa0: 54 48 45 4e 20 3b 0a 0a 3a 20 70 61 63 6b 2d 73 THEN ;..: pack-s
5ab0: 69 67 6e 6b 65 79 20 28 20 6f 3a 6b 65 79 20 2d ignkey ( o:key -
5ac0: 2d 20 29 0a 20 20 20 20 73 69 67 6e 5b 0a 20 20 - ). sign[.
5ad0: 20 20 70 61 63 6b 2d 63 6f 72 65 0a 20 20 20 20 pack-core.
5ae0: 6b 65 2d 70 6b 20 24 40 20 2b 63 6d 64 62 75 66 ke-pk $@ +cmdbuf
5af0: 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 . ke-selfsig
5b00: 24 40 20 2b 63 6d 64 62 75 66 20 63 6d 64 2d 72 $@ +cmdbuf cmd-r
5b10: 65 73 6f 6c 76 65 3e 20 32 64 72 6f 70 20 6e 65 esolve> 2drop ne
5b20: 73 74 73 69 67 20 3b 0a 0a 3a 20 70 61 63 6b 2d stsig ;..: pack-
5b30: 63 6f 72 65 6b 65 79 20 28 20 6f 3a 6b 65 79 20 corekey ( o:key
5b40: 2d 2d 20 29 0a 20 20 20 20 70 61 63 6b 2d 73 69 -- ). pack-si
5b50: 67 6e 6b 65 79 0a 20 20 20 20 6b 65 2d 69 6d 70 gnkey. ke-imp
5b60: 6f 72 74 73 20 40 20 75 6c 69 74 2c 20 6b 65 79 orts @ ulit, key
5b70: 69 6d 70 6f 72 74 0a 20 20 20 20 6b 65 2d 6d 61 import. ke-ma
5b80: 73 6b 20 40 20 20 6b 65 2d 67 72 6f 75 70 73 20 sk @ ke-groups
5b90: 24 40 6c 65 6e 20 49 46 0a 09 6b 65 2d 67 72 6f $@len IF..ke-gro
5ba0: 75 70 73 20 24 40 20 32 64 75 70 20 24 2c 20 6b ups $@ 2dup $, k
5bb0: 65 79 67 72 6f 75 70 73 0a 09 67 72 6f 75 70 73 eygroups..groups
5bc0: 3e 6d 61 73 6b 20 69 6e 76 65 72 74 20 61 6e 64 >mask invert and
5bd0: 20 20 54 48 45 4e 0a 20 20 20 20 3f 64 75 70 2d THEN. ?dup-
5be0: 49 46 20 20 6e 6c 69 74 2c 20 6b 65 79 6d 61 73 IF nlit, keymas
5bf0: 6b 20 20 54 48 45 4e 0a 20 20 20 20 6b 65 2d 70 k THEN. ke-p
5c00: 65 74 73 20 5b 3a 20 24 2c 20 6b 65 79 70 65 74 ets [: $, keypet
5c10: 20 3b 5d 20 24 5b 5d 6d 61 70 0a 20 20 20 20 6b ;] $[]map. k
5c20: 65 2d 73 74 6f 72 65 6b 65 79 20 40 20 3e 73 74 e-storekey @ >st
5c30: 6f 72 65 6b 65 79 20 21 20 3b 0a 70 72 65 76 69 orekey ! ;.previ
5c40: 6f 75 73 0a 0a 3a 20 70 61 63 6b 2d 70 75 62 6b ous..: pack-pubk
5c50: 65 79 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a ey ( o:key -- ).
5c60: 20 20 20 20 6b 65 79 3a 63 6f 64 65 0a 20 20 20 key:code.
5c70: 20 20 20 70 61 63 6b 2d 63 6f 72 65 6b 65 79 0a pack-corekey.
5c80: 20 20 20 20 65 6e 64 3a 6b 65 79 20 3b 0a 3a 20 end:key ;.:
5c90: 70 61 63 6b 2d 6f 75 74 6b 65 79 20 28 20 6f 3a pack-outkey ( o:
5ca0: 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 key -- ). key
5cb0: 3a 63 6f 64 65 0a 20 20 20 20 20 20 22 6e 32 6f :code. "n2o
5cc0: 22 20 6e 65 74 32 6f 2d 62 61 73 65 3a 34 63 63 " net2o-base:4cc
5cd0: 2c 0a 20 20 20 20 20 20 70 61 63 6b 2d 73 69 67 ,. pack-sig
5ce0: 6e 6b 65 79 0a 20 20 20 20 65 6e 64 3a 6b 65 79 nkey. end:key
5cf0: 20 3b 0a 3a 20 70 61 63 6b 2d 73 65 63 6b 65 79 ;.: pack-seckey
5d00: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 ( o:key -- ).
5d10: 20 20 6b 65 79 3a 63 6f 64 65 0a 20 20 20 20 20 key:code.
5d20: 20 70 61 63 6b 2d 63 6f 72 65 6b 65 79 0a 20 20 pack-corekey.
5d30: 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 40 20 73 ke-sk sec@ s
5d40: 65 63 24 2c 20 70 72 69 76 6b 65 79 0a 20 20 20 ec$, privkey.
5d50: 20 20 20 6b 65 2d 72 73 6b 20 73 65 63 40 20 64 ke-rsk sec@ d
5d60: 75 70 20 49 46 20 20 73 65 63 24 2c 20 72 73 6b up IF sec$, rsk
5d70: 6b 65 79 20 20 45 4c 53 45 20 20 32 64 72 6f 70 key ELSE 2drop
5d80: 20 20 54 48 45 4e 0a 20 20 20 20 65 6e 64 3a 6b THEN. end:k
5d90: 65 79 20 3b 0a 3a 20 6b 65 79 6e 69 63 6b 24 20 ey ;.: keynick$
5da0: 28 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 64 72 20 ( o:key -- addr
5db0: 75 20 29 0a 20 20 20 20 5c 47 20 67 65 74 20 74 u ). \G get t
5dc0: 68 65 20 61 6e 6e 6f 74 61 74 69 6f 6e 73 20 77 he annotations w
5dd0: 69 74 68 20 73 69 67 6e 61 74 75 72 65 0a 20 20 ith signature.
5de0: 20 20 5b 27 5d 20 70 61 63 6b 2d 63 6f 72 65 20 ['] pack-core
5df0: 67 65 6e 2d 63 6d 64 24 20 32 64 72 6f 70 0a 20 gen-cmd$ 2drop.
5e00: 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 ke-selfsig $@
5e10: 20 74 6d 70 24 20 24 2b 21 20 74 6d 70 24 20 24 tmp$ $+! tmp$ $
5e20: 40 20 3b 0a 3a 20 6b 65 79 70 6b 32 6e 69 63 6b @ ;.: keypk2nick
5e30: 24 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 64 $ ( o:key -- add
5e40: 72 20 75 20 29 0a 20 20 20 20 5c 47 20 67 65 74 r u ). \G get
5e50: 20 74 68 65 20 61 6e 6e 6f 74 61 74 69 6f 6e 73 the annotations
5e60: 20 77 69 74 68 20 73 69 67 6e 61 74 75 72 65 0a with signature.
5e70: 20 20 20 20 5b 27 5d 20 70 61 63 6b 2d 63 6f 72 ['] pack-cor
5e80: 65 20 67 65 6e 2d 63 6d 64 24 20 32 64 72 6f 70 e gen-cmd$ 2drop
5e90: 0a 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 74 6d . ke-pk $@ tm
5ea0: 70 24 20 24 2b 21 20 6b 65 2d 73 65 6c 66 73 69 p$ $+! ke-selfsi
5eb0: 67 20 24 40 20 74 6d 70 24 20 24 2b 21 20 74 6d g $@ tmp$ $+! tm
5ec0: 70 24 20 24 40 20 3b 0a 3a 20 6d 79 6e 69 63 6b p$ $@ ;.: mynick
5ed0: 2d 6b 65 79 20 28 20 2d 2d 20 6f 20 29 0a 20 20 -key ( -- o ).
5ee0: 20 20 70 6b 63 20 6b 65 79 73 69 7a 65 20 6b 65 pkc keysize ke
5ef0: 79 23 20 23 40 20 64 72 6f 70 20 63 65 6c 6c 2b y# #@ drop cell+
5f00: 20 3b 0a 3a 20 6d 79 6e 69 63 6b 24 20 28 20 2d ;.: mynick$ ( -
5f10: 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 5c - addr u ). \
5f20: 47 20 67 65 74 20 6d 79 20 6e 69 63 6b 20 77 69 G get my nick wi
5f30: 74 68 20 73 69 67 6e 61 74 75 72 65 0a 20 20 20 th signature.
5f40: 20 6d 79 6e 69 63 6b 2d 6b 65 79 20 2e 6b 65 79 mynick-key .key
5f50: 6e 69 63 6b 24 20 3b 0a 3a 20 6d 79 70 6b 32 6e nick$ ;.: mypk2n
5f60: 69 63 6b 24 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 ick$ ( o:key --
5f70: 61 64 64 72 20 75 20 29 0a 20 20 20 20 5c 47 20 addr u ). \G
5f80: 67 65 74 20 6d 79 20 6e 69 63 6b 20 77 69 74 68 get my nick with
5f90: 20 73 69 67 6e 61 74 75 72 65 0a 20 20 20 20 6d signature. m
5fa0: 79 6e 69 63 6b 2d 6b 65 79 20 2e 6b 65 79 70 6b ynick-key .keypk
5fb0: 32 6e 69 63 6b 24 20 3b 0a 3a 20 6b 65 79 2d 73 2nick$ ;.: key-s
5fc0: 69 67 6e 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f ign ( o:key -- o
5fd0: 3a 6b 65 79 20 29 0a 20 20 20 20 5b 27 5d 20 70 :key ). ['] p
5fe0: 61 63 6b 2d 63 6f 72 65 20 67 65 6e 2d 63 6d 64 ack-core gen-cmd
5ff0: 24 0a 20 20 20 20 5b 3a 20 74 79 70 65 20 6b 65 $. [: type ke
6000: 2d 70 6b 20 24 40 20 74 79 70 65 20 3b 5d 20 24 -pk $@ type ;] $
6010: 74 6d 70 0a 20 20 20 20 6e 6f 77 3e 6e 65 76 65 tmp. now>neve
6020: 72 20 63 3a 30 6b 65 79 20 63 3a 68 61 73 68 20 r c:0key c:hash
6030: 5b 27 5d 20 2e 73 69 67 20 24 74 6d 70 20 6b 65 ['] .sig $tmp ke
6040: 2d 73 65 6c 66 73 69 67 20 24 21 20 3b 0a 0a 56 -selfsig $! ;..V
6050: 61 72 69 61 62 6c 65 20 63 70 2d 74 6d 70 0a 0a ariable cp-tmp..
6060: 3a 20 73 61 76 65 2d 70 75 62 6b 65 79 73 20 28 : save-pubkeys (
6070: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 2d 70 66 -- ). key-pf
6080: 64 20 3f 64 75 70 2d 49 46 20 20 63 6c 6f 73 65 d ?dup-IF close
6090: 2d 66 69 6c 65 20 74 68 72 6f 77 20 20 54 48 45 -file throw THE
60a0: 4e 0a 20 20 20 20 22 70 75 62 6b 65 79 73 2e 6b N. "pubkeys.k
60b0: 32 6f 22 20 2e 6b 65 79 73 2f 20 5b 3a 20 74 6f 2o" .keys/ [: to
60c0: 20 6b 65 79 2d 70 66 64 0a 20 20 20 20 20 20 6b key-pfd. k
60d0: 65 79 23 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 ey# [: cell+ $@
60e0: 64 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 0a 09 6b drop cell+ >o..k
60f0: 65 2d 73 6b 20 73 65 63 40 20 64 30 3d 20 49 46 e-sk sec@ d0= IF
6100: 20 20 70 61 63 6b 2d 70 75 62 6b 65 79 0a 09 20 pack-pubkey..
6110: 20 20 20 66 6c 75 73 68 28 20 2e 22 20 73 61 76 flush( ." sav
6120: 69 6e 67 20 22 20 2e 6e 69 63 6b 20 66 6f 72 74 ing " .nick fort
6130: 68 3a 63 72 20 29 0a 09 20 20 20 20 6b 65 79 2d h:cr ).. key-
6140: 63 72 79 70 74 20 6b 65 2d 6f 66 66 73 65 74 20 crypt ke-offset
6150: 36 34 40 20 6b 65 79 3e 70 66 69 6c 65 40 70 6f 64@ key>pfile@po
6160: 73 0a 09 54 48 45 4e 20 6f 3e 20 3b 5d 20 23 6d s..THEN o> ;] #m
6170: 61 70 0a 20 20 20 20 30 20 74 6f 20 6b 65 79 2d ap. 0 to key-
6180: 70 66 64 20 3b 5d 20 73 61 76 65 2d 66 69 6c 65 pfd ;] save-file
6190: 20 20 3f 6b 65 79 2d 70 66 64 20 64 72 6f 70 20 ?key-pfd drop
61a0: 3b 0a 0a 3a 20 73 61 76 65 2d 73 65 63 6b 65 79 ;..: save-seckey
61b0: 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 s ( -- ). key
61c0: 2d 73 66 64 20 3f 64 75 70 2d 49 46 20 20 63 6c -sfd ?dup-IF cl
61d0: 6f 73 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 20 ose-file throw
61e0: 54 48 45 4e 0a 20 20 20 20 22 73 65 63 6b 65 79 THEN. "seckey
61f0: 73 2e 6b 32 6f 22 20 2e 6b 65 79 73 2f 20 5b 3a s.k2o" .keys/ [:
6200: 20 74 6f 20 6b 65 79 2d 73 66 64 0a 20 20 20 20 to key-sfd.
6210: 20 20 6b 65 79 23 20 5b 3a 20 63 65 6c 6c 2b 20 key# [: cell+
6220: 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f $@ drop cell+ >o
6230: 0a 09 6b 65 2d 73 6b 20 73 65 63 40 20 64 30 3c ..ke-sk sec@ d0<
6240: 3e 20 49 46 20 20 70 61 63 6b 2d 73 65 63 6b 65 > IF pack-secke
6250: 79 0a 09 20 20 20 20 63 6f 6e 66 69 67 3a 70 77 y.. config:pw
6260: 2d 6c 65 76 65 6c 23 20 40 20 3e 72 20 20 6b 65 -level# @ >r ke
6270: 2d 70 77 6c 65 76 65 6c 20 40 20 63 6f 6e 66 69 -pwlevel @ confi
6280: 67 3a 70 77 2d 6c 65 76 65 6c 23 20 21 0a 09 20 g:pw-level# !..
6290: 20 20 20 6b 65 79 2d 63 72 79 70 74 20 6b 65 2d key-crypt ke-
62a0: 6f 66 66 73 65 74 20 36 34 40 20 6b 65 79 3e 73 offset 64@ key>s
62b0: 66 69 6c 65 40 70 6f 73 0a 09 20 20 20 20 72 3e file@pos.. r>
62c0: 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76 65 6c config:pw-level
62d0: 23 20 21 0a 09 54 48 45 4e 20 6f 3e 20 3b 5d 20 # !..THEN o> ;]
62e0: 23 6d 61 70 0a 20 20 20 20 30 20 74 6f 20 6b 65 #map. 0 to ke
62f0: 79 2d 73 66 64 20 3b 5d 20 73 61 76 65 2d 66 69 y-sfd ;] save-fi
6300: 6c 65 20 20 3f 6b 65 79 2d 73 66 64 20 64 72 6f le ?key-sfd dro
6310: 70 20 3b 0a 0a 3a 20 73 61 76 65 2d 6b 65 79 73 p ;..: save-keys
6320: 20 28 20 2d 2d 20 29 20 20 3f 2e 6e 65 74 32 6f ( -- ) ?.net2o
6330: 2f 6b 65 79 73 0a 20 20 20 20 73 61 76 65 2d 70 /keys. save-p
6340: 75 62 6b 65 79 73 20 73 61 76 65 2d 73 65 63 6b ubkeys save-seck
6350: 65 79 73 20 3b 0a 0a 5c 20 72 65 73 70 6f 6e 64 eys ;..\ respond
6360: 20 74 6f 20 73 63 61 6e 6e 69 6e 67 20 6b 65 79 to scanning key
6370: 73 0a 0a 3a 20 73 63 61 6e 6e 65 64 2d 6b 65 79 s..: scanned-key
6380: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 ( addr u -- ).
6390: 20 20 20 2e 22 20 73 63 61 6e 6e 65 64 20 22 20 ." scanned "
63a0: 20 32 64 75 70 20 2e 6b 65 79 2d 69 64 20 63 72 2dup .key-id cr
63b0: 0a 20 20 20 20 6b 65 79 7c 20 6b 65 79 23 20 23 . key| key# #
63c0: 40 20 49 46 0a 09 63 65 6c 6c 2b 20 3e 6f 20 5b @ IF..cell+ >o [
63d0: 20 31 20 69 6d 70 6f 72 74 23 73 63 61 6e 20 6c 1 import#scan l
63e0: 73 68 69 66 74 20 5d 4c 20 6b 65 2d 69 6d 70 6f shift ]L ke-impo
63f0: 72 74 73 20 6f 72 21 20 2e 6b 65 79 2d 6c 69 73 rts or! .key-lis
6400: 74 20 63 72 20 6f 3e 0a 09 73 61 76 65 2d 6b 65 t cr o>..save-ke
6410: 79 73 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a 5c ys. THEN ;..\
6420: 20 67 65 6e 65 72 61 74 65 20 6b 65 79 73 0a 0a generate keys..
6430: 3a 20 2b 67 65 6e 2d 6b 65 79 73 20 28 20 6e 69 : +gen-keys ( ni
6440: 63 6b 20 75 20 74 79 70 65 20 2d 2d 20 29 0a 20 ck u type -- ).
6450: 20 20 20 67 65 6e 2d 6b 65 79 73 20 20 36 34 23 gen-keys 64#
6460: 2d 31 20 6b 65 79 2d 72 65 61 64 2d 6f 66 66 73 -1 key-read-offs
6470: 65 74 20 36 34 21 20 20 70 6b 63 20 6b 65 79 73 et 64! pkc keys
6480: 69 7a 65 32 20 6b 65 79 3a 6e 65 77 20 3e 6f 0a ize2 key:new >o.
6490: 20 20 20 20 5b 20 31 20 69 6d 70 6f 72 74 23 73 [ 1 import#s
64a0: 65 6c 66 20 6c 73 68 69 66 74 20 31 20 69 6d 70 elf lshift 1 imp
64b0: 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 6f ort#new lshift o
64c0: 72 20 5d 4c 20 6b 65 2d 69 6d 70 6f 72 74 73 20 r ]L ke-imports
64d0: 21 0a 20 20 20 20 6b 65 2d 74 79 70 65 20 21 20 !. ke-type !
64e0: 20 6b 65 2d 6e 69 63 6b 20 24 21 20 20 6e 69 63 ke-nick $! nic
64f0: 6b 21 0a 20 20 20 20 63 6f 6e 66 69 67 3a 70 77 k!. config:pw
6500: 2d 6c 65 76 65 6c 23 20 40 20 6b 65 2d 70 77 6c -level# @ ke-pwl
6510: 65 76 65 6c 20 21 20 20 70 65 72 6d 25 6d 79 73 evel ! perm%mys
6520: 65 6c 66 20 6b 65 2d 6d 61 73 6b 20 21 0a 20 20 elf ke-mask !.
6530: 20 20 73 6b 63 20 6b 65 79 73 69 7a 65 20 6b 65 skc keysize ke
6540: 2d 73 6b 20 73 65 63 21 20 20 2b 73 65 63 6b 65 -sk sec! +secke
6550: 79 0a 20 20 20 20 73 6b 72 65 76 20 6b 65 79 73 y. skrev keys
6560: 69 7a 65 20 6b 65 2d 72 73 6b 20 73 65 63 21 0a ize ke-rsk sec!.
6570: 20 20 20 20 6b 65 79 2d 73 69 67 6e 20 6f 3e 20 key-sign o>
6580: 3b 0a 0a 24 34 30 20 62 75 66 66 65 72 3a 20 6e ;..$40 buffer: n
6590: 69 63 6b 2d 62 75 66 0a 0a 3a 20 67 65 74 2d 6e ick-buf..: get-n
65a0: 69 63 6b 20 28 20 2d 2d 20 61 64 64 72 20 75 20 ick ( -- addr u
65b0: 29 0a 20 20 20 20 2e 22 20 6e 69 63 6b 3a 20 22 ). ." nick: "
65c0: 20 6e 69 63 6b 2d 62 75 66 20 24 34 30 20 61 63 nick-buf $40 ac
65d0: 63 65 70 74 20 6e 69 63 6b 2d 62 75 66 20 73 77 cept nick-buf sw
65e0: 61 70 20 2d 74 72 61 69 6c 69 6e 67 20 63 72 20 ap -trailing cr
65f0: 3b 0a 0a 66 61 6c 73 65 20 76 61 6c 75 65 20 3f ;..false value ?
6600: 79 65 73 0a 3a 20 79 65 73 3f 20 28 20 61 64 64 yes.: yes? ( add
6610: 72 20 75 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 r u -- flag ).
6620: 20 20 3f 79 65 73 20 49 46 20 20 32 64 72 6f 70 ?yes IF 2drop
6630: 20 74 72 75 65 20 20 45 4c 53 45 20 20 74 79 70 true ELSE typ
6640: 65 20 2e 22 20 20 28 79 2f 4e 29 22 20 6b 65 79 e ." (y/N)" key
6650: 20 63 72 20 27 79 27 20 3d 20 20 54 48 45 4e 20 cr 'y' = THEN
6660: 3b 0a 0a 3a 20 3f 72 73 6b 20 28 20 2d 2d 20 29 ;..: ?rsk ( -- )
6670: 0a 20 20 20 20 70 6b 63 20 6b 65 79 73 69 7a 65 . pkc keysize
6680: 20 6b 65 79 2d 65 78 69 73 74 3f 20 64 75 70 20 key-exist? dup
6690: 30 3d 20 49 46 20 20 64 72 6f 70 20 20 45 58 49 0= IF drop EXI
66a0: 54 20 20 54 48 45 4e 0a 20 20 20 20 3e 6f 20 6b T THEN. >o k
66b0: 65 2d 72 73 6b 20 73 65 63 40 20 64 75 70 20 30 e-rsk sec@ dup 0
66c0: 3d 20 49 46 20 20 32 64 72 6f 70 20 6f 3e 20 20 = IF 2drop o>
66d0: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 2e EXIT THEN. .
66e0: 22 20 59 6f 75 20 73 74 69 6c 6c 20 68 61 76 65 " You still have
66f0: 6e 27 74 20 73 74 6f 72 65 64 20 79 6f 75 72 20 n't stored your
6700: 72 65 76 6f 6b 65 20 6b 65 79 20 73 65 63 75 72 revoke key secur
6710: 65 6c 79 20 6f 66 66 2d 6c 69 6e 65 2e 22 20 63 ely off-line." c
6720: 72 0a 20 20 20 20 73 22 20 50 61 70 65 72 20 61 r. s" Paper a
6730: 6e 64 20 70 65 6e 63 69 6c 20 72 65 61 64 79 3f nd pencil ready?
6740: 22 20 79 65 73 3f 20 49 46 0a 09 2e 73 74 72 69 " yes? IF...stri
6750: 70 65 38 35 0a 09 73 22 20 57 72 69 74 74 65 6e pe85..s" Written
6760: 20 64 6f 77 6e 3f 22 20 79 65 73 3f 20 49 46 0a down?" yes? IF.
6770: 09 20 20 20 20 73 22 20 59 6f 75 20 77 6f 6e 27 . s" You won'
6780: 74 20 73 65 65 20 74 68 69 73 20 61 67 61 69 6e t see this again
6790: 21 20 44 65 6c 65 74 65 3f 22 20 79 65 73 3f 0a ! Delete?" yes?.
67a0: 09 20 20 20 20 49 46 20 6b 65 2d 72 73 6b 20 73 . IF ke-rsk s
67b0: 65 63 2d 6f 66 66 20 20 73 61 76 65 2d 6b 65 79 ec-off save-key
67c0: 73 0a 09 09 2e 22 20 72 65 76 6f 6b 65 20 6b 65 s...." revoke ke
67d0: 79 20 64 65 6c 65 74 65 64 2e 22 20 63 72 20 6f y deleted." cr o
67e0: 3e 20 20 45 58 49 54 20 20 54 48 45 4e 20 20 54 > EXIT THEN T
67f0: 48 45 4e 0a 20 20 20 20 45 4c 53 45 20 20 32 64 HEN. ELSE 2d
6800: 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 2e 22 rop THEN. ."
6810: 20 49 27 6d 20 6b 65 65 70 69 6e 67 20 79 6f 75 I'm keeping you
6820: 72 20 72 65 76 6f 6b 65 20 6b 65 79 2e 20 20 54 r revoke key. T
6830: 68 69 73 20 77 69 6c 6c 20 73 68 6f 77 20 75 70 his will show up
6840: 20 61 67 61 69 6e 2e 22 20 63 72 20 6f 3e 20 3b again." cr o> ;
6850: 0a 0a 5c 20 72 65 61 64 20 6b 65 79 20 66 69 6c ..\ read key fil
6860: 65 0a 0a 3a 20 74 72 79 2d 64 65 63 72 79 70 74 e..: try-decrypt
6870: 2d 6b 65 79 20 28 20 6b 65 79 20 75 31 20 2d 2d -key ( key u1 --
6880: 20 61 64 64 72 20 75 32 20 66 6c 61 67 20 29 0a addr u2 flag ).
6890: 20 20 20 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 keypack keyp
68a0: 61 63 6b 2d 64 20 6b 65 79 70 61 63 6b 2d 61 6c ack-d keypack-al
68b0: 6c 23 20 6d 6f 76 65 0a 20 20 20 20 6b 65 79 70 l# move. keyp
68c0: 61 63 6b 2d 64 20 6b 65 79 70 61 63 6b 2d 61 6c ack-d keypack-al
68d0: 6c 23 20 32 73 77 61 70 0a 20 20 20 20 64 75 70 l# 2swap. dup
68e0: 20 24 32 30 20 3d 20 49 46 20 20 64 65 63 72 79 $20 = IF decry
68f0: 70 74 24 20 20 45 4c 53 45 0a 09 6b 65 79 70 61 pt$ ELSE..keypa
6900: 63 6b 20 63 40 20 24 46 20 61 6e 64 20 63 6f 6e ck c@ $F and con
6910: 66 69 67 3a 70 77 2d 6d 61 78 6c 65 76 65 6c 23 fig:pw-maxlevel#
6920: 20 40 20 3c 3d 0a 09 49 46 20 20 64 65 63 72 79 @ <=..IF decry
6930: 70 74 2d 70 77 24 20 20 45 4c 53 45 20 20 32 64 pt-pw$ ELSE 2d
6940: 72 6f 70 20 66 61 6c 73 65 20 20 54 48 45 4e 0a rop false THEN.
6950: 20 20 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 74 72 THEN ;..: tr
6960: 79 2d 64 65 63 72 79 70 74 20 28 20 66 6c 61 67 y-decrypt ( flag
6970: 20 2d 2d 20 61 64 64 72 20 75 20 2f 20 30 20 30 -- addr u / 0 0
6980: 20 29 20 7b 20 66 6c 61 67 20 7d 0a 20 20 20 20 ) { flag }.
6990: 6b 65 79 73 20 24 5b 5d 23 20 30 20 3f 44 4f 0a keys $[]# 0 ?DO.
69a0: 09 49 20 6b 65 79 73 20 73 65 63 5b 5d 40 20 64 .I keys sec[]@ d
69b0: 75 70 20 6b 65 79 73 69 7a 65 20 3d 20 66 6c 61 up keysize = fla
69c0: 67 20 78 6f 72 20 49 46 0a 09 20 20 20 20 74 72 g xor IF.. tr
69d0: 79 2d 64 65 63 72 79 70 74 2d 6b 65 79 20 49 46 y-decrypt-key IF
69e0: 0a 09 09 49 20 6b 65 79 73 20 24 5b 5d 20 40 20 ...I keys $[] @
69f0: 64 75 70 20 3e 73 74 6f 72 65 6b 65 79 20 21 20 dup >storekey !
6a00: 64 65 66 61 75 6c 74 6b 65 79 20 21 0a 09 09 75 defaultkey !...u
6a10: 6e 6c 6f 6f 70 20 20 45 58 49 54 20 20 54 48 45 nloop EXIT THE
6a20: 4e 20 20 54 48 45 4e 0a 09 32 64 72 6f 70 0a 20 N THEN..2drop.
6a30: 20 20 20 4c 4f 4f 50 20 20 30 20 30 20 3b 0a 0a LOOP 0 0 ;..
6a40: 3a 20 3f 70 65 72 6d 20 28 20 6f 3a 6b 65 79 20 : ?perm ( o:key
6a50: 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 73 6b 20 73 -- ). ke-sk s
6a60: 65 63 40 20 6e 69 70 20 64 75 70 20 49 46 20 20 ec@ nip dup IF
6a70: 70 65 72 6d 25 6d 79 73 65 6c 66 20 20 45 4c 53 perm%myself ELS
6a80: 45 20 20 70 65 72 6d 25 64 65 66 61 75 6c 74 20 E perm%default
6a90: 20 54 48 45 4e 20 20 6b 65 2d 6d 61 73 6b 20 21 THEN ke-mask !
6aa0: 0a 20 20 20 20 49 46 20 20 22 5c 78 30 30 22 20 . IF "\x00"
6ab0: 20 45 4c 53 45 20 20 22 5c 78 30 31 22 20 20 54 ELSE "\x01" T
6ac0: 48 45 4e 20 20 6b 65 2d 67 72 6f 75 70 73 20 24 HEN ke-groups $
6ad0: 21 20 3b 0a 0a 3a 20 64 6f 2d 6b 65 79 20 28 20 ! ;..: do-key (
6ae0: 61 64 64 72 20 75 20 2f 20 30 20 30 20 20 2d 2d addr u / 0 0 --
6af0: 20 29 0a 20 20 20 20 64 75 70 20 30 3d 20 49 46 ). dup 0= IF
6b00: 20 20 32 64 72 6f 70 20 20 45 58 49 54 20 20 54 2drop EXIT T
6b10: 48 45 4e 0a 20 20 20 20 73 61 6d 70 6c 65 2d 6b HEN. sample-k
6b20: 65 79 20 3e 6f 20 6b 65 2d 73 6b 20 6b 65 2d 65 ey >o ke-sk ke-e
6b30: 6e 64 20 6f 76 65 72 20 2d 20 65 72 61 73 65 20 nd over - erase
6b40: 20 64 6f 2d 63 6d 64 2d 6c 6f 6f 70 20 6f 3e 20 do-cmd-loop o>
6b50: 3b 0a 0a 3a 20 2e 6b 65 79 24 20 28 20 61 64 64 ;..: .key$ ( add
6b60: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 73 61 6d r u -- ). sam
6b70: 70 6c 65 2d 6b 65 79 20 3e 6f 20 20 6b 65 2d 73 ple-key >o ke-s
6b80: 6b 20 6b 65 2d 65 6e 64 20 6f 76 65 72 20 2d 20 k ke-end over -
6b90: 65 72 61 73 65 0a 20 20 20 20 73 69 67 6e 65 64 erase. signed
6ba0: 2d 76 61 6c 20 76 61 6c 69 64 61 74 65 64 20 6f -val validated o
6bb0: 72 21 20 20 63 2d 73 74 61 74 65 20 6f 66 66 20 r! c-state off
6bc0: 20 6e 65 73 74 2d 63 6d 64 2d 6c 6f 6f 70 0a 20 nest-cmd-loop.
6bd0: 20 20 20 73 69 67 6e 65 64 2d 76 61 6c 20 69 6e signed-val in
6be0: 76 65 72 74 20 76 61 6c 69 64 61 74 65 64 20 61 vert validated a
6bf0: 6e 64 21 0a 20 20 20 20 2e 6b 65 79 2d 73 68 6f nd!. .key-sho
6c00: 72 74 20 66 72 65 65 2d 6b 65 79 20 6f 3e 20 3b rt free-key o> ;
6c10: 0a 0a 3a 20 72 65 61 64 2d 6b 65 79 73 2d 6c 6f ..: read-keys-lo
6c20: 6f 70 20 28 20 66 64 20 2d 2d 20 29 20 20 63 6f op ( fd -- ) co
6c30: 64 65 2d 6b 65 79 0a 20 20 20 20 3e 72 20 23 30 de-key. >r #0
6c40: 2e 20 72 40 20 72 65 70 6f 73 69 74 69 6f 6e 2d . r@ reposition-
6c50: 66 69 6c 65 20 74 68 72 6f 77 0a 20 20 20 20 42 file throw. B
6c60: 45 47 49 4e 0a 09 72 40 20 66 69 6c 65 2d 70 6f EGIN..r@ file-po
6c70: 73 69 74 69 6f 6e 20 74 68 72 6f 77 20 64 3e 36 sition throw d>6
6c80: 34 20 6b 65 79 2d 72 65 61 64 2d 6f 66 66 73 65 4 key-read-offse
6c90: 74 20 36 34 21 0a 09 6b 65 79 70 61 63 6b 20 6b t 64!..keypack k
6ca0: 65 79 70 61 63 6b 2d 61 6c 6c 23 20 72 40 20 72 eypack-all# r@ r
6cb0: 65 61 64 2d 66 69 6c 65 20 74 68 72 6f 77 0a 09 ead-file throw..
6cc0: 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3d 20 57 keypack-all# = W
6cd0: 48 49 4c 45 0a 09 20 20 20 20 69 6d 70 6f 72 74 HILE.. import
6ce0: 2d 74 79 70 65 20 40 20 69 6d 70 6f 72 74 23 73 -type @ import#s
6cf0: 65 6c 66 20 3d 20 74 72 79 2d 64 65 63 72 79 70 elf = try-decryp
6d00: 74 20 64 6f 2d 6b 65 79 0a 20 20 20 20 52 45 50 t do-key. REP
6d10: 45 41 54 20 20 72 64 72 6f 70 20 20 63 6f 64 65 EAT rdrop code
6d20: 30 2d 62 75 66 20 3b 0a 3a 20 72 65 61 64 2d 6b 0-buf ;.: read-k
6d30: 65 79 2d 6c 6f 6f 70 20 28 20 2d 2d 20 29 0a 20 ey-loop ( -- ).
6d40: 20 20 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 69 import#self i
6d50: 6d 70 6f 72 74 2d 74 79 70 65 20 21 0a 20 20 20 mport-type !.
6d60: 20 3f 6b 65 79 2d 73 66 64 20 72 65 61 64 2d 6b ?key-sfd read-k
6d70: 65 79 73 2d 6c 6f 6f 70 20 3b 0a 3a 20 72 65 61 eys-loop ;.: rea
6d80: 64 2d 70 6b 65 79 2d 6c 6f 6f 70 20 28 20 2d 2d d-pkey-loop ( --
6d90: 20 29 0a 20 20 20 20 6c 61 73 74 6b 65 79 40 20 ). lastkey@
6da0: 64 72 6f 70 20 64 65 66 61 75 6c 74 6b 65 79 20 drop defaultkey
6db0: 21 20 5c 20 61 74 20 6c 65 61 73 74 20 6f 6e 65 ! \ at least one
6dc0: 20 64 65 66 61 75 6c 74 20 6b 65 79 20 61 76 61 default key ava
6dd0: 69 6c 61 62 6c 65 0a 20 20 20 20 2d 31 20 63 6f ilable. -1 co
6de0: 6e 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23 0a 20 nfig:pw-level#.
6df0: 20 20 20 5b 3a 20 69 6d 70 6f 72 74 23 6e 65 77 [: import#new
6e00: 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 3f import-type ! ?
6e10: 6b 65 79 2d 70 66 64 20 72 65 61 64 2d 6b 65 79 key-pfd read-key
6e20: 73 2d 6c 6f 6f 70 20 3b 5d 20 21 77 72 61 70 70 s-loop ;] !wrapp
6e30: 65 72 20 3b 0a 0a 3a 20 72 65 61 64 2d 6b 65 79 er ;..: read-key
6e40: 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 72 65 61 s ( -- ). rea
6e50: 64 2d 6b 65 79 2d 6c 6f 6f 70 20 72 65 61 64 2d d-key-loop read-
6e60: 70 6b 65 79 2d 6c 6f 6f 70 20 69 6d 70 6f 72 74 pkey-loop import
6e70: 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 79 70 65 #new import-type
6e80: 20 21 20 3b 0a 0a 3a 20 72 65 61 64 2d 70 6b 32 ! ;..: read-pk2
6e90: 6b 65 79 24 20 28 20 61 64 64 72 20 75 20 2d 2d key$ ( addr u --
6ea0: 20 29 0a 20 20 20 20 5c 67 20 72 65 61 64 20 61 ). \g read a
6eb0: 20 6e 65 73 74 65 64 20 6b 65 79 20 69 6e 74 6f nested key into
6ec0: 20 73 61 6d 70 6c 65 2d 6b 65 79 0a 20 20 20 20 sample-key.
6ed0: 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 63 2d sample-key >o c-
6ee0: 73 74 61 74 65 20 6f 66 66 20 20 73 69 6d 2d 6e state off sim-n
6ef0: 69 63 6b 21 20 6f 6e 0a 20 20 20 20 70 6b 32 2d ick! on. pk2-
6f00: 73 69 67 3f 20 21 21 73 69 67 21 21 20 73 69 67 sig? !!sig!! sig
6f10: 70 6b 32 73 69 7a 65 23 20 2d 20 32 64 75 70 20 pk2size# - 2dup
6f20: 2b 20 3e 72 20 64 6f 2d 6e 65 73 74 73 69 67 0a + >r do-nestsig.
6f30: 20 20 20 20 72 40 20 6b 65 79 73 69 7a 65 32 20 r@ keysize2
6f40: 6b 65 2d 70 6b 20 24 21 0a 20 20 20 20 72 3e 20 ke-pk $!. r>
6f50: 6b 65 79 73 69 7a 65 32 20 2b 20 73 69 67 73 69 keysize2 + sigsi
6f60: 7a 65 23 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 ze# ke-selfsig $
6f70: 21 0a 20 20 20 20 6f 3e 20 20 73 69 6d 2d 6e 69 !. o> sim-ni
6f80: 63 6b 21 20 6f 66 66 20 3b 0a 0a 3a 20 2e 70 6b ck! off ;..: .pk
6f90: 32 6b 65 79 24 20 28 20 61 64 64 72 20 75 20 2d 2key$ ( addr u -
6fa0: 2d 20 29 0a 20 20 20 20 72 65 61 64 2d 70 6b 32 - ). read-pk2
6fb0: 6b 65 79 24 20 73 61 6d 70 6c 65 2d 6b 65 79 20 key$ sample-key
6fc0: 3e 6f 0a 20 20 20 20 5b 20 31 20 69 6d 70 6f 72 >o. [ 1 impor
6fd0: 74 23 69 6e 76 69 74 65 64 20 6c 73 68 69 66 74 t#invited lshift
6fe0: 20 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 1 import#new ls
6ff0: 68 69 66 74 20 6f 72 20 5d 4c 20 6b 65 2d 69 6d hift or ]L ke-im
7000: 70 6f 72 74 73 20 21 0a 20 20 20 20 2e 6b 65 79 ports !. .key
7010: 2d 69 6e 76 69 74 65 20 66 72 65 65 2d 6b 65 79 -invite free-key
7020: 20 6f 3e 20 3b 0a 0a 5c 20 73 65 6c 65 63 74 20 o> ;..\ select
7030: 6b 65 79 20 62 79 20 6e 69 63 6b 0a 0a 3a 20 3e key by nick..: >
7040: 72 61 77 2d 6b 65 79 20 28 20 6f 20 2d 2d 20 29 raw-key ( o -- )
7050: 0a 20 20 20 20 64 75 70 20 30 3d 20 21 21 6e 6f . dup 0= !!no
7060: 2d 6e 69 63 6b 21 21 20 3e 6f 0a 20 20 20 20 6b -nick!! >o. k
7070: 65 2d 70 6b 20 24 40 20 70 6b 63 20 70 6b 72 6b e-pk $@ pkc pkrk
7080: 23 20 73 6d 6f 76 65 0a 20 20 20 20 6b 65 2d 73 # smove. ke-s
7090: 6b 20 73 65 63 40 20 73 6b 63 20 73 77 61 70 20 k sec@ skc swap
70a0: 6b 65 79 7c 20 6d 6f 76 65 0a 20 20 20 20 3e 73 key| move. >s
70b0: 6b 73 69 67 20 6f 3e 20 3b 0a 0a 3a 20 3e 6b 65 ksig o> ;..: >ke
70c0: 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a y ( addr u -- ).
70d0: 20 20 20 20 6b 65 79 23 20 40 20 30 3d 20 49 46 key# @ 0= IF
70e0: 20 20 72 65 61 64 2d 6b 65 79 73 20 20 54 48 45 read-keys THE
70f0: 4e 0a 20 20 20 20 6e 69 63 6b 2d 6b 65 79 20 3e N. nick-key >
7100: 72 61 77 2d 6b 65 79 20 3b 0a 0a 3a 20 69 27 6d raw-key ;..: i'm
7110: 20 28 20 22 6e 61 6d 65 22 20 2d 2d 20 29 20 70 ( "name" -- ) p
7120: 61 72 73 65 2d 6e 61 6d 65 20 3e 6b 65 79 20 3b arse-name >key ;
7130: 0a 3a 20 70 6b 27 20 28 20 22 6e 61 6d 65 22 20 .: pk' ( "name"
7140: 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 -- addr u ).
7150: 70 61 72 73 65 2d 6e 61 6d 65 20 6e 69 63 6b 3e parse-name nick>
7160: 70 6b 20 3b 0a 0a 3a 20 64 65 73 74 2d 6b 65 79 pk ;..: dest-key
7170: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 64 ( addr u -- ) d
7180: 75 70 20 30 3d 20 49 46 20 20 32 64 72 6f 70 20 up 0= IF 2drop
7190: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 EXIT THEN.
71a0: 6e 69 63 6b 2d 6b 65 79 20 3e 6f 20 6f 20 30 3d nick-key >o o 0=
71b0: 20 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21 !!unknown-key!!
71c0: 0a 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 6f 3e . ke-pk $@ o>
71d0: 0a 20 20 20 20 70 75 62 6b 65 79 20 24 21 20 3b . pubkey $! ;
71e0: 0a 0a 3a 20 64 65 73 74 2d 70 6b 20 28 20 61 64 ..: dest-pk ( ad
71f0: 64 72 20 75 20 2d 2d 20 29 20 6b 65 79 32 7c 20 dr u -- ) key2|
7200: 32 64 75 70 20 6b 65 79 7c 20 6b 65 79 23 20 23 2dup key| key# #
7210: 40 20 30 3d 20 49 46 0a 09 64 72 6f 70 20 70 75 @ 0= IF..drop pu
7220: 62 6b 65 79 20 24 21 20 20 70 65 72 6d 25 75 6e bkey $! perm%un
7230: 6b 6e 6f 77 6e 20 70 65 72 6d 2d 6d 61 73 6b 20 known perm-mask
7240: 21 0a 20 20 20 20 45 4c 53 45 20 20 63 65 6c 6c !. ELSE cell
7250: 2b 20 3e 6f 0a 09 6b 65 2d 6d 61 73 6b 20 40 0a + >o..ke-mask @.
7260: 09 6b 65 2d 70 6b 20 24 40 20 6f 3e 0a 09 70 75 .ke-pk $@ o>..pu
7270: 62 6b 65 79 20 24 21 20 20 70 65 72 6d 2d 6d 61 bkey $! perm-ma
7280: 73 6b 20 21 20 20 32 64 72 6f 70 20 20 54 48 45 sk ! 2drop THE
7290: 4e 20 3b 0a 0a 3a 20 72 65 70 6c 61 63 65 2d 6b N ;..: replace-k
72a0: 65 79 20 31 20 2f 73 74 72 69 6e 67 20 7b 20 72 ey 1 /string { r
72b0: 65 76 2d 61 64 64 72 20 75 20 2d 2d 20 6f 20 7d ev-addr u -- o }
72c0: 20 5c 20 72 65 76 6f 63 61 74 69 6f 6e 20 74 69 \ revocation ti
72d0: 63 6b 65 74 0a 20 20 20 20 6b 65 79 28 20 2e 22 cket. key( ."
72e0: 20 52 65 70 6c 61 63 65 3a 22 20 63 72 20 6f 20 Replace:" cr o
72f0: 63 65 6c 6c 2d 20 30 20 2e 6b 65 79 20 29 0a 20 cell- 0 .key ).
7300: 20 20 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 69 import#self i
7310: 6d 70 6f 72 74 2d 74 79 70 65 20 21 0a 20 20 20 mport-type !.
7320: 20 73 22 20 23 72 65 76 6f 6b 65 64 22 20 64 75 s" #revoked" du
7330: 70 20 3e 72 20 6b 65 2d 6e 69 63 6b 20 24 2b 21 p >r ke-nick $+!
7340: 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 24 40 20 . ke-nick $@
7350: 72 3e 20 2d 20 6b 65 2d 70 72 6f 66 20 24 40 20 r> - ke-prof $@
7360: 6b 65 2d 73 69 67 73 20 6b 65 2d 74 79 70 65 20 ke-sigs ke-type
7370: 40 0a 20 20 20 20 72 65 76 2d 61 64 64 72 20 70 @. rev-addr p
7380: 6b 72 6b 23 20 6b 65 79 3f 6e 65 77 20 3e 6f 0a krk# key?new >o.
7390: 20 20 20 20 6b 65 2d 74 79 70 65 20 21 20 5b 3a ke-type ! [:
73a0: 20 6b 65 2d 73 69 67 73 20 24 2b 5b 5d 21 20 3b ke-sigs $+[]! ;
73b0: 5d 20 24 5b 5d 6d 61 70 20 6b 65 2d 70 72 6f 66 ] $[]map ke-prof
73c0: 20 24 21 20 6b 65 2d 6e 69 63 6b 20 24 21 0a 20 $! ke-nick $!.
73d0: 20 20 20 72 65 76 2d 61 64 64 72 20 70 6b 72 6b rev-addr pkrk
73e0: 23 20 6b 65 2d 70 6b 20 24 21 0a 20 20 20 20 72 # ke-pk $!. r
73f0: 65 76 2d 61 64 64 72 20 75 20 2b 20 31 2d 20 64 ev-addr u + 1- d
7400: 75 70 20 63 40 20 32 2a 20 2d 20 24 31 30 20 2d up c@ 2* - $10 -
7410: 20 24 31 30 20 6b 65 2d 73 65 6c 66 73 69 67 20 $10 ke-selfsig
7420: 24 21 0a 20 20 20 20 6b 65 79 28 20 2e 22 20 77 $!. key( ." w
7430: 69 74 68 3a 22 20 63 72 20 6f 20 63 65 6c 6c 2d ith:" cr o cell-
7440: 20 30 20 2e 6b 65 79 20 29 20 6f 20 6f 3e 0a 20 0 .key ) o o>.
7450: 20 20 20 69 6d 70 6f 72 74 23 6e 65 77 20 69 6d import#new im
7460: 70 6f 72 74 2d 74 79 70 65 20 21 20 3b 0a 0a 3a port-type ! ;..:
7470: 20 72 65 6e 65 77 2d 6b 65 79 20 28 20 72 65 76 renew-key ( rev
7480: 61 64 64 72 20 75 31 20 6b 65 79 61 64 64 72 20 addr u1 keyaddr
7490: 75 32 20 2d 2d 20 6f 20 29 0a 20 20 20 20 63 75 u2 -- o ). cu
74a0: 72 72 65 6e 74 2d 6b 65 79 20 3e 6f 20 72 65 70 rrent-key >o rep
74b0: 6c 61 63 65 2d 6b 65 79 20 6f 3e 0a 20 20 20 20 lace-key o>.
74c0: 3e 6f 20 73 6b 63 20 6b 65 79 73 69 7a 65 20 6b >o skc keysize k
74d0: 65 2d 73 6b 20 73 65 63 21 20 6f 20 6f 3e 20 3b e-sk sec! o o> ;
74e0: 0a 0a 5c 20 67 65 6e 65 72 61 74 65 20 6e 65 77 ..\ generate new
74f0: 20 6b 65 79 0a 0a 3a 20 6f 75 74 2d 6b 65 79 20 key..: out-key
7500: 28 20 6f 20 2d 2d 20 29 0a 20 20 20 20 3e 6f 20 ( o -- ). >o
7510: 70 61 63 6b 2d 6f 75 74 6b 65 79 20 5b 27 5d 20 pack-outkey [']
7520: 2e 6e 69 63 6b 2d 62 61 73 65 20 24 74 6d 70 20 .nick-base $tmp
7530: 66 6e 2d 73 61 6e 69 74 69 7a 65 20 6f 3e 0a 20 fn-sanitize o>.
7540: 20 20 20 5b 3a 20 2e 22 20 7e 2f 22 20 74 79 70 [: ." ~/" typ
7550: 65 20 2e 22 20 2e 6e 32 6f 22 20 3b 5d 20 24 74 e ." .n2o" ;] $t
7560: 6d 70 20 77 2f 6f 20 63 72 65 61 74 65 2d 66 69 mp w/o create-fi
7570: 6c 65 20 74 68 72 6f 77 0a 20 20 20 20 3e 72 20 le throw. >r
7580: 63 6d 64 62 75 66 24 20 72 40 20 77 72 69 74 65 cmdbuf$ r@ write
7590: 2d 66 69 6c 65 20 74 68 72 6f 77 20 72 3e 20 63 -file throw r> c
75a0: 6c 6f 73 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 lose-file throw
75b0: 3b 0a 3a 20 6f 75 74 2d 6d 65 20 28 20 2d 2d 20 ;.: out-me ( --
75c0: 29 0a 20 20 20 20 70 6b 63 20 6b 65 79 73 69 7a ). pkc keysiz
75d0: 65 20 6b 65 79 23 20 23 40 20 30 3d 20 21 21 75 e key# #@ 0= !!u
75e0: 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21 0a 20 20 20 nknown-key!!.
75f0: 20 63 65 6c 6c 2b 20 6f 75 74 2d 6b 65 79 20 3b cell+ out-key ;
7600: 0a 0a 56 61 72 69 61 62 6c 65 20 64 68 74 72 6f ..Variable dhtro
7610: 6f 74 2e 6e 32 6f 0a 0a 3a 20 2b 64 68 74 72 6f ot.n2o..: +dhtro
7620: 6f 74 20 28 20 2d 2d 20 29 0a 20 20 20 20 64 65 ot ( -- ). de
7630: 66 61 75 6c 74 6b 65 79 20 40 20 3e 73 74 6f 72 faultkey @ >stor
7640: 65 6b 65 79 20 21 0a 20 20 20 20 69 6d 70 6f 72 ekey !. impor
7650: 74 23 6d 61 6e 75 61 6c 20 69 6d 70 6f 72 74 2d t#manual import-
7660: 74 79 70 65 20 21 20 20 36 34 23 2d 31 20 6b 65 type ! 64#-1 ke
7670: 79 2d 72 65 61 64 2d 6f 66 66 73 65 74 20 36 34 y-read-offset 64
7680: 21 0a 20 20 20 20 64 68 74 72 6f 6f 74 2e 6e 32 !. dhtroot.n2
7690: 6f 20 24 40 20 64 6f 2d 6b 65 79 0a 20 20 20 20 o $@ do-key.
76a0: 6c 61 73 74 2d 6b 65 79 20 3e 6f 20 22 5c 78 30 last-key >o "\x0
76b0: 32 22 20 6b 65 2d 67 72 6f 75 70 73 20 24 21 20 2" ke-groups $!
76c0: 70 65 72 6d 25 64 68 74 72 6f 6f 74 20 6b 65 2d perm%dhtroot ke-
76d0: 6d 61 73 6b 20 21 20 6f 3e 0a 20 20 20 20 69 6d mask ! o>. im
76e0: 70 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d port#new import-
76f0: 74 79 70 65 20 21 20 3b 0a 0a 3a 20 6e 65 77 2d type ! ;..: new-
7700: 6b 65 79 20 28 20 6e 69 63 6b 61 64 64 72 20 75 key ( nickaddr u
7710: 20 2d 2d 20 29 0a 20 20 20 20 3f 63 68 65 63 6b -- ). ?check
7720: 2d 72 6e 67 20 5c 20 62 65 66 6f 72 65 20 67 65 -rng \ before ge
7730: 6e 65 72 61 74 69 6e 67 20 61 20 6b 65 79 2c 20 nerating a key,
7740: 63 68 65 63 6b 20 74 68 65 20 72 6e 67 20 66 6f check the rng fo
7750: 72 20 68 65 61 6c 74 68 0a 20 20 20 20 2b 6e 65 r health. +ne
7760: 77 70 68 72 61 73 65 20 6b 65 79 3e 64 65 66 61 wphrase key>defa
7770: 75 6c 74 0a 20 20 20 20 6b 65 79 23 75 73 65 72 ult. key#user
7780: 20 2b 67 65 6e 2d 6b 65 79 73 0a 20 20 20 20 73 +gen-keys. s
7790: 65 63 72 65 74 2d 6b 65 79 73 23 20 31 2d 20 73 ecret-keys# 1- s
77a0: 65 63 72 65 74 2d 6b 65 79 20 3e 72 61 77 2d 6b ecret-key >raw-k
77b0: 65 79 20 20 6c 61 73 74 6b 65 79 40 20 64 72 6f ey lastkey@ dro
77c0: 70 20 64 65 66 61 75 6c 74 6b 65 79 20 21 0a 20 p defaultkey !.
77d0: 20 20 20 6f 75 74 2d 6d 65 20 2b 64 68 74 72 6f out-me +dhtro
77e0: 6f 74 20 73 61 76 65 2d 6b 65 79 73 20 3b 0a 0a ot save-keys ;..
77f0: 5c 20 72 65 76 6f 6b 61 74 69 6f 6e 0a 0a 34 20 \ revokation..4
7800: 64 61 74 65 73 69 7a 65 23 20 2b 20 6b 65 79 73 datesize# + keys
7810: 69 7a 65 20 39 20 2a 20 2b 20 43 6f 6e 73 74 61 ize 9 * + Consta
7820: 6e 74 20 72 65 76 73 69 7a 65 23 0a 0a 56 61 72 nt revsize#..Var
7830: 69 61 62 6c 65 20 72 65 76 74 6f 6b 65 6e 0a 0a iable revtoken..
7840: 3a 20 30 6f 6c 64 6b 65 79 20 28 20 2d 2d 20 29 : 0oldkey ( -- )
7850: 20 5c 20 70 75 62 6b 65 79 73 20 63 61 6e 20 73 \ pubkeys can s
7860: 74 61 79 0a 20 20 20 20 6f 6c 64 73 6b 63 20 6b tay. oldskc k
7870: 65 79 73 69 7a 65 20 65 72 61 73 65 20 20 6f 6c eysize erase ol
7880: 64 73 6b 72 65 76 20 6b 65 79 73 69 7a 65 20 65 dskrev keysize e
7890: 72 61 73 65 20 3b 0a 0a 3a 20 6b 65 79 6d 6f 76 rase ;..: keymov
78a0: 65 20 28 20 61 64 64 72 31 20 61 64 64 72 32 20 e ( addr1 addr2
78b0: 2d 2d 20 29 20 20 6b 65 79 73 69 7a 65 20 6d 6f -- ) keysize mo
78c0: 76 65 20 3b 0a 0a 3a 20 72 65 76 6f 6b 65 2d 76 ve ;..: revoke-v
78d0: 65 72 69 66 79 20 28 20 61 64 64 72 20 75 31 20 erify ( addr u1
78e0: 70 6b 20 73 74 72 69 6e 67 20 75 32 20 2d 2d 20 pk string u2 --
78f0: 61 64 64 72 20 75 20 66 6c 61 67 20 29 20 72 6f addr u flag ) ro
7900: 74 20 3e 72 20 32 3e 72 20 63 3a 30 6b 65 79 0a t >r 2>r c:0key.
7910: 20 20 20 20 73 69 67 6f 6e 6c 79 73 69 7a 65 23 sigonlysize#
7920: 20 2d 20 32 64 75 70 20 32 72 3e 20 3e 6b 65 79 - 2dup 2r> >key
7930: 65 64 2d 68 61 73 68 0a 20 20 20 20 73 69 67 64 ed-hash. sigd
7940: 61 74 65 20 2b 64 61 74 65 0a 20 20 20 20 32 64 ate +date. 2d
7950: 75 70 20 2b 20 72 3e 20 65 64 2d 76 65 72 69 66 up + r> ed-verif
7960: 79 20 3b 0a 0a 3a 20 3e 72 65 76 6f 6b 65 20 28 y ;..: >revoke (
7970: 20 73 6b 72 65 76 20 2d 2d 20 29 20 20 73 6b 72 skrev -- ) skr
7980: 65 76 20 6b 65 79 6d 6f 76 65 20 20 70 6b 63 20 ev keymove pkc
7990: 63 68 65 63 6b 2d 72 65 76 3f 20 30 3d 20 21 21 check-rev? 0= !!
79a0: 6e 6f 74 2d 6d 79 2d 72 65 76 73 6b 21 21 20 3b not-my-revsk!! ;
79b0: 0a 0a 3a 20 2b 72 65 76 73 69 67 6e 20 28 20 73 ..: +revsign ( s
79c0: 6b 20 70 6b 20 2d 2d 20 29 20 20 73 6b 73 69 67 k pk -- ) sksig
79d0: 20 2d 72 6f 74 20 65 64 2d 73 69 67 6e 20 72 65 -rot ed-sign re
79e0: 76 74 6f 6b 65 6e 20 24 2b 21 20 62 6c 20 72 65 vtoken $+! bl re
79f0: 76 74 6f 6b 65 6e 20 63 24 2b 21 20 3b 0a 0a 3a vtoken c$+! ;..:
7a00: 20 73 69 67 6e 2d 74 6f 6b 65 6e 2c 20 28 20 73 sign-token, ( s
7a10: 6b 20 70 6b 20 73 74 72 69 6e 67 20 75 32 20 2d k pk string u2 -
7a20: 2d 20 29 0a 20 20 20 20 63 3a 30 6b 65 79 20 72 - ). c:0key r
7a30: 65 76 74 6f 6b 65 6e 20 24 40 20 32 73 77 61 70 evtoken $@ 2swap
7a40: 20 3e 6b 65 79 65 64 2d 68 61 73 68 0a 20 20 20 >keyed-hash.
7a50: 20 73 69 67 64 61 74 65 20 2b 64 61 74 65 20 2b sigdate +date +
7a60: 72 65 76 73 69 67 6e 20 3b 0a 0a 3a 20 72 65 76 revsign ;..: rev
7a70: 6f 6b 65 2d 6b 65 79 20 28 20 2d 2d 20 61 64 64 oke-key ( -- add
7a80: 72 20 75 20 29 0a 20 20 20 20 73 6b 63 20 6f 6c r u ). skc ol
7a90: 64 73 6b 63 20 6b 65 79 6d 6f 76 65 20 20 70 6b dskc keymove pk
7aa0: 63 20 6f 6c 64 70 6b 63 20 6b 65 79 6d 6f 76 65 c oldpkc keymove
7ab0: 20 20 73 6b 72 65 76 20 6f 6c 64 73 6b 72 65 76 skrev oldskrev
7ac0: 20 6b 65 79 6d 6f 76 65 0a 20 20 20 20 20 20 20 keymove.
7ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7af0: 20 20 20 20 5c 20 62 61 63 6b 75 70 20 6b 65 79 \ backup key
7b00: 73 0a 20 20 20 20 6f 6c 64 73 6b 72 65 76 20 6f s. oldskrev o
7b10: 6c 64 70 6b 72 65 76 20 73 6b 3e 70 6b 20 20 20 ldpkrev sk>pk
7b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 5c 20 67 \ g
7b30: 65 6e 65 72 61 74 65 20 72 65 76 6f 6b 61 74 69 enerate revokati
7b40: 6f 6e 20 70 75 62 6b 65 79 0a 20 20 20 20 67 65 on pubkey. ge
7b50: 6e 2d 6b 65 79 73 20 20 20 20 20 20 20 20 20 20 n-keys
7b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b70: 20 20 20 20 20 5c 20 67 65 6e 65 72 61 74 65 20 \ generate
7b80: 6e 65 77 20 6b 65 79 73 0a 20 20 20 20 70 6b 63 new keys. pkc
7b90: 20 6b 65 79 73 69 7a 65 32 20 72 65 76 74 6f 6b keysize2 revtok
7ba0: 65 6e 20 24 21 20 20 20 20 20 20 20 20 20 20 20 en $!
7bb0: 20 20 20 20 5c 20 6d 79 20 6e 65 77 20 6b 65 79 \ my new key
7bc0: 0a 20 20 20 20 6f 6c 64 70 6b 72 65 76 20 6b 65 . oldpkrev ke
7bd0: 79 73 69 7a 65 20 72 65 76 74 6f 6b 65 6e 20 24 ysize revtoken $
7be0: 2b 21 20 20 20 20 20 20 20 20 20 20 5c 20 72 65 +! \ re
7bf0: 76 6f 6b 65 20 74 6f 6b 65 6e 0a 20 20 20 20 6f voke token. o
7c00: 6c 64 73 6b 72 65 76 20 6f 6c 64 70 6b 72 65 76 ldskrev oldpkrev
7c10: 20 22 72 65 76 6f 6b 65 22 20 73 69 67 6e 2d 74 "revoke" sign-t
7c20: 6f 6b 65 6e 2c 20 5c 20 72 65 76 6f 6b 65 20 73 oken, \ revoke s
7c30: 69 67 6e 61 74 75 72 65 0a 20 20 20 20 73 6b 63 ignature. skc
7c40: 20 70 6b 63 20 22 73 65 6c 66 73 69 67 6e 22 20 pkc "selfsign"
7c50: 73 69 67 6e 2d 74 6f 6b 65 6e 2c 20 20 20 20 20 sign-token,
7c60: 20 20 20 20 5c 20 73 65 6c 66 20 73 69 67 6e 65 \ self signe
7c70: 64 20 77 69 74 68 20 6e 65 77 20 6b 65 79 0a 20 d with new key.
7c80: 20 20 20 22 21 22 20 72 65 76 74 6f 6b 65 6e 20 "!" revtoken
7c90: 30 20 24 69 6e 73 20 20 20 20 20 20 20 20 20 20 0 $ins
7ca0: 20 20 20 20 20 20 20 20 20 20 5c 20 22 21 22 20 \ "!"
7cb0: 2b 20 6f 6c 64 6b 65 79 6c 65 6e 2b 6e 65 77 6b + oldkeylen+newk
7cc0: 65 79 6c 65 6e 20 74 6f 20 66 6c 61 67 20 72 65 eylen to flag re
7cd0: 76 6f 6b 61 74 69 6f 6e 0a 20 20 20 20 72 65 76 vokation. rev
7ce0: 74 6f 6b 65 6e 20 24 40 20 67 65 6e 3e 68 6f 73 token $@ gen>hos
7cf0: 74 20 32 64 72 6f 70 20 20 20 20 20 20 20 20 20 t 2drop
7d00: 20 20 20 20 5c 20 73 69 67 6e 20 68 6f 73 74 20 \ sign host
7d10: 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 77 69 74 68 information with
7d20: 20 6f 6c 64 20 6b 65 79 0a 20 20 20 20 73 69 67 old key. sig
7d30: 64 61 74 65 20 2b 64 61 74 65 20 73 69 67 64 61 date +date sigda
7d40: 74 65 20 64 61 74 65 73 69 7a 65 23 20 72 65 76 te datesize# rev
7d50: 74 6f 6b 65 6e 20 24 2b 21 0a 20 20 20 20 6f 6c token $+!. ol
7d60: 64 73 6b 63 20 6f 6c 64 70 6b 63 20 2b 72 65 76 dskc oldpkc +rev
7d70: 73 69 67 6e 0a 20 20 20 20 30 6f 6c 64 6b 65 79 sign. 0oldkey
7d80: 20 72 65 76 74 6f 6b 65 6e 20 24 40 20 3b 0a 0a revtoken $@ ;..
7d90: 5c 20 69 6e 76 69 74 61 74 69 6f 6e 0a 0a 56 61 \ invitation..Va
7da0: 72 69 61 62 6c 65 20 69 6e 76 69 74 61 74 69 6f riable invitatio
7db0: 6e 73 0a 0a 65 76 65 6e 74 3a 20 2d 3e 69 6e 76 ns..event: ->inv
7dc0: 69 74 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 ite ( addr u --
7dd0: 29 0a 20 20 20 20 2e 22 20 69 6e 76 69 74 65 20 ). ." invite
7de0: 6d 65 3a 20 22 20 6f 76 65 72 20 3e 72 20 2e 70 me: " over >r .p
7df0: 6b 32 6b 65 79 24 20 63 72 20 72 3e 20 66 72 65 k2key$ cr r> fre
7e00: 65 20 74 68 72 6f 77 20 63 74 72 6c 20 4c 20 69 e throw ctrl L i
7e10: 6e 73 6b 65 79 20 3b 0a 65 76 65 6e 74 3a 20 2d nskey ;.event: -
7e20: 3e 77 61 6b 65 6d 65 20 28 20 6f 20 2d 2d 20 29 >wakeme ( o -- )
7e30: 20 3c 65 76 65 6e 74 20 2d 3e 77 61 6b 65 20 65 <event ->wake e
7e40: 76 65 6e 74 3e 20 3b 0a 0a 3a 20 70 6b 32 6b 65 vent> ;..: pk2ke
7e50: 79 24 2d 61 64 64 20 28 20 61 64 64 72 20 75 20 y$-add ( addr u
7e60: 70 65 72 6d 20 2d 2d 20 29 20 7b 20 70 65 72 6d perm -- ) { perm
7e70: 20 7d 0a 20 20 20 20 73 61 6d 70 6c 65 2d 6b 65 }. sample-ke
7e80: 79 20 3e 6f 20 69 6d 70 6f 72 74 23 69 6e 76 69 y >o import#invi
7e90: 74 65 64 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 ted import-type
7ea0: 21 20 63 6d 64 3a 6e 65 73 74 73 69 67 0a 20 20 ! cmd:nestsig.
7eb0: 20 20 70 65 72 6d 20 6b 65 2d 6d 61 73 6b 20 21 perm ke-mask !
7ec0: 0a 20 20 20 20 69 6d 70 6f 72 74 23 6e 65 77 20 . import#new
7ed0: 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 20 73 import-type ! s
7ee0: 61 76 65 2d 70 75 62 6b 65 79 73 20 6f 3e 20 3b ave-pubkeys o> ;
7ef0: 0a 0a 3a 20 78 2d 65 72 61 73 65 20 28 20 6c 65 ..: x-erase ( le
7f00: 6e 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 78 n -- ). dup x
7f10: 62 61 63 6b 2d 72 65 73 74 6f 72 65 20 20 64 75 back-restore du
7f20: 70 20 73 70 61 63 65 73 20 20 78 62 61 63 6b 2d p spaces xback-
7f30: 72 65 73 74 6f 72 65 20 3b 0a 0a 3a 20 69 6e 76 restore ;..: inv
7f40: 69 74 65 2d 6b 65 79 20 28 20 61 64 64 72 20 75 ite-key ( addr u
7f50: 20 2d 2d 20 6b 65 79 20 29 0a 20 20 20 20 32 64 -- key ). 2d
7f60: 75 70 20 78 2d 77 69 64 74 68 20 7b 20 61 64 64 up x-width { add
7f70: 72 20 75 20 6c 65 6e 20 7d 0a 20 20 20 20 42 45 r u len }. BE
7f80: 47 49 4e 20 20 61 64 64 72 20 75 20 74 79 70 65 GIN addr u type
7f90: 20 6b 65 79 20 20 6c 65 6e 20 78 2d 65 72 61 73 key len x-eras
7fa0: 65 0a 09 64 75 70 20 63 74 72 6c 20 5a 20 3d 0a e..dup ctrl Z =.
7fb0: 20 20 20 20 57 48 49 4c 45 20 20 64 72 6f 70 20 WHILE drop
7fc0: 20 42 45 47 49 4e 20 20 6b 65 79 20 63 74 72 6c BEGIN key ctrl
7fd0: 20 4c 20 3d 20 20 55 4e 54 49 4c 20 20 52 45 50 L = UNTIL REP
7fe0: 45 41 54 20 3b 0a 0a 3a 20 70 72 6f 63 65 73 73 EAT ;..: process
7ff0: 2d 69 6e 76 69 74 61 74 69 6f 6e 20 28 20 61 64 -invitation ( ad
8000: 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 73 22 dr u -- ). s"
8010: 20 69 6e 76 69 74 65 20 28 79 2f 6e 2f 62 29 3f invite (y/n/b)?
8020: 22 20 69 6e 76 69 74 65 2d 6b 65 79 0a 20 20 20 " invite-key.
8030: 20 63 61 73 65 0a 09 27 79 27 20 6f 66 20 20 70 case..'y' of p
8040: 65 72 6d 25 64 65 66 61 75 6c 74 20 70 6b 32 6b erm%default pk2k
8050: 65 79 24 2d 61 64 64 20 20 2e 22 20 61 64 64 65 ey$-add ." adde
8060: 64 22 20 63 72 20 20 20 65 6e 64 6f 66 0a 09 27 d" cr endof..'
8070: 62 27 20 6f 66 20 20 70 65 72 6d 25 62 6c 6f 63 b' of perm%bloc
8080: 6b 65 64 20 70 6b 32 6b 65 79 24 2d 61 64 64 20 ked pk2key$-add
8090: 20 2e 22 20 62 6c 6f 63 6b 65 64 22 20 63 72 20 ." blocked" cr
80a0: 65 6e 64 6f 66 0a 09 32 64 72 6f 70 20 2e 22 20 endof..2drop ."
80b0: 69 67 6e 6f 72 65 64 22 20 63 72 0a 20 20 20 20 ignored" cr.
80c0: 65 6e 64 63 61 73 65 20 3b 0a 0a 3a 20 66 69 6c endcase ;..: fil
80d0: 74 65 72 2d 69 6e 76 69 74 61 74 69 6f 6e 3f 20 ter-invitation?
80e0: 28 20 61 64 64 72 20 75 20 2d 2d 20 66 6c 61 67 ( addr u -- flag
80f0: 20 29 0a 20 20 20 20 73 69 67 70 6b 32 73 69 7a ). sigpk2siz
8100: 65 23 20 2d 20 2b 20 6b 65 79 73 69 7a 65 20 6b e# - + keysize k
8110: 65 79 23 20 23 40 20 64 30 3c 3e 20 3b 20 5c 20 ey# #@ d0<> ; \
8120: 61 6c 72 65 61 64 79 20 74 68 65 72 65 0a 0a 3a already there..:
8130: 20 2e 69 6e 76 69 74 61 74 69 6f 6e 73 20 28 20 .invitations (
8140: 2d 2d 20 29 0a 20 20 20 20 69 6e 76 69 74 61 74 -- ). invitat
8150: 69 6f 6e 73 20 5b 3a 20 32 64 75 70 20 2e 70 6b ions [: 2dup .pk
8160: 32 6b 65 79 24 20 63 72 20 70 72 6f 63 65 73 73 2key$ cr process
8170: 2d 69 6e 76 69 74 61 74 69 6f 6e 20 3b 5d 20 24 -invitation ;] $
8180: 5b 5d 6d 61 70 0a 20 20 20 20 69 6e 76 69 74 61 []map. invita
8190: 74 69 6f 6e 73 20 24 5b 5d 6f 66 66 20 3b 0a 0a tions $[]off ;..
81a0: 3a 20 3e 69 6e 76 69 74 61 74 69 6f 6e 73 20 28 : >invitations (
81b0: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 addr u -- ).
81c0: 20 32 64 75 70 20 66 69 6c 74 65 72 2d 69 6e 76 2dup filter-inv
81d0: 69 74 61 74 69 6f 6e 3f 20 49 46 20 20 32 64 72 itation? IF 2dr
81e0: 6f 70 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 op EXIT THEN.
81f0: 20 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 24 5b invitations $[
8200: 5d 23 20 3e 72 0a 20 20 20 20 32 64 75 70 20 69 ]# >r. 2dup i
8210: 6e 76 69 74 61 74 69 6f 6e 73 20 24 69 6e 73 5b nvitations $ins[
8220: 5d 73 69 67 20 64 72 6f 70 0a 20 20 20 20 69 6e ]sig drop. in
8230: 76 69 74 61 74 69 6f 6e 73 20 24 5b 5d 23 20 72 vitations $[]# r
8240: 3e 20 3c 3e 20 49 46 0a 09 73 61 76 65 2d 6d 65 > <> IF..save-me
8250: 6d 20 6d 61 69 6e 2d 75 70 40 20 3c 68 69 64 65 m main-up@ <hide
8260: 3e 0a 09 3c 65 76 65 6e 74 20 65 24 2c 20 2d 3e >..<event e$, ->
8270: 69 6e 76 69 74 65 20 75 70 40 20 65 6c 69 74 2c invite up@ elit,
8280: 20 2d 3e 77 61 6b 65 6d 65 20 6d 61 69 6e 2d 75 ->wakeme main-u
8290: 70 40 20 65 76 65 6e 74 3e 20 73 74 6f 70 0a 20 p@ event> stop.
82a0: 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 ELSE 2drop
82b0: 54 48 45 4e 20 3b 0a 0a 3a 20 73 65 6e 64 2d 69 THEN ;..: send-i
82c0: 6e 76 69 74 61 74 69 6f 6e 20 28 20 70 6b 20 75 nvitation ( pk u
82d0: 20 2d 2d 20 29 0a 20 20 20 20 73 65 74 75 70 21 -- ). setup!
82e0: 20 6d 79 70 6b 32 6e 69 63 6b 24 20 32 3e 72 0a mypk2nick$ 2>r.
82f0: 20 20 20 20 67 65 6e 2d 74 6d 70 6b 65 79 73 20 gen-tmpkeys
8300: 64 72 6f 70 20 74 73 6b 63 20 73 77 61 70 20 6b drop tskc swap k
8310: 65 79 70 61 64 20 65 64 2d 64 68 20 64 6f 2d 6b eypad ed-dh do-k
8320: 65 79 70 61 64 20 73 65 63 21 0a 20 20 20 20 6e eypad sec!. n
8330: 65 74 32 6f 2d 63 6f 64 65 30 0a 20 20 20 20 74 et2o-code0. t
8340: 70 6b 63 20 6b 65 79 73 69 7a 65 20 24 2c 20 6f pkc keysize $, o
8350: 6e 65 73 68 6f 74 2d 74 6d 70 6b 65 79 0a 20 20 neshot-tmpkey.
8360: 20 20 6e 65 73 74 5b 20 32 72 3e 20 24 2c 20 69 nest[ 2r> $, i
8370: 6e 76 69 74 65 20 5d 74 6d 70 6e 65 73 74 0a 20 nvite ]tmpnest.
8380: 20 20 20 63 6f 6f 6b 69 65 2b 72 65 71 75 65 73 cookie+reques
8390: 74 0a 20 20 20 20 65 6e 64 2d 63 6f 64 65 7c 20 t. end-code|
83a0: 3b 0a 0a 5c 20 6b 65 79 20 61 70 69 20 68 65 6c ;..\ key api hel
83b0: 70 65 72 73 0a 0a 3a 20 64 65 6c 2d 6c 61 73 74 pers..: del-last
83c0: 2d 6b 65 79 20 28 20 2d 2d 20 29 0a 20 20 20 20 -key ( -- ).
83d0: 6b 65 79 73 20 24 5b 5d 23 20 31 2d 20 6b 65 79 keys $[]# 1- key
83e0: 73 20 24 5b 5d 20 73 65 63 2d 6f 66 66 0a 20 20 s $[] sec-off.
83f0: 20 20 6b 65 79 73 20 24 40 6c 65 6e 20 63 65 6c keys $@len cel
8400: 6c 2d 20 6b 65 79 73 20 24 21 6c 65 6e 20 3b 0a l- keys $!len ;.
8410: 0a 3a 20 73 74 6f 72 65 6b 65 79 21 20 28 20 2d .: storekey! ( -
8420: 2d 20 29 0a 20 20 20 20 3e 73 65 63 6b 65 79 20 - ). >seckey
8430: 6b 65 79 73 20 24 5b 5d 23 20 30 20 3f 44 4f 20 keys $[]# 0 ?DO
8440: 20 32 64 75 70 20 49 20 6b 65 79 73 20 73 65 63 2dup I keys sec
8450: 5b 5d 40 20 73 74 72 3d 20 49 46 0a 09 20 20 20 []@ str= IF..
8460: 20 49 20 6b 65 79 73 20 73 65 63 5b 5d 40 20 64 I keys sec[]@ d
8470: 72 6f 70 20 3e 73 74 6f 72 65 6b 65 79 20 21 20 rop >storekey !
8480: 20 4c 45 41 56 45 20 20 54 48 45 4e 20 20 4c 4f LEAVE THEN LO
8490: 4f 50 20 20 32 64 72 6f 70 20 3b 0a 0a 3a 20 63 OP 2drop ;..: c
84a0: 68 6f 6f 73 65 2d 6b 65 79 20 28 20 2d 2d 20 6f hoose-key ( -- o
84b0: 20 29 0a 20 20 20 20 30 20 42 45 47 49 4e 20 20 ). 0 BEGIN
84c0: 64 72 6f 70 0a 09 2e 22 20 43 68 6f 6f 73 65 20 drop..." Choose
84d0: 6b 65 79 20 62 79 20 6e 75 6d 62 65 72 3a 22 20 key by number:"
84e0: 63 72 20 2e 73 65 63 72 65 74 2d 6e 69 63 6b 73 cr .secret-nicks
84f0: 0a 09 42 45 47 49 4e 20 20 6b 65 79 20 64 75 70 ..BEGIN key dup
8500: 20 62 6c 20 3c 20 57 48 49 4c 45 20 20 64 72 6f bl < WHILE dro
8510: 70 20 20 52 45 50 45 41 54 20 5c 20 73 77 61 6c p REPEAT \ swal
8520: 6c 6f 77 20 63 6f 6e 74 72 6f 6c 20 6b 65 79 73 low control keys
8530: 0a 09 5b 27 5d 20 64 69 67 69 74 3f 20 23 33 36 ..['] digit? #36
8540: 20 62 61 73 65 2d 65 78 65 63 75 74 65 20 30 3d base-execute 0=
8550: 20 49 46 20 2d 31 20 54 48 45 4e 0a 09 73 65 63 IF -1 THEN..sec
8560: 72 65 74 2d 6b 65 79 20 64 75 70 20 30 3d 20 57 ret-key dup 0= W
8570: 48 49 4c 45 0a 09 20 20 20 20 2e 22 20 50 6c 65 HILE.. ." Ple
8580: 61 73 65 20 65 6e 74 65 72 20 61 20 62 61 73 65 ase enter a base
8590: 2d 33 36 20 6e 75 6d 62 65 72 20 62 65 74 77 65 -36 number betwe
85a0: 65 6e 20 30 20 61 6e 64 20 22 0a 09 20 20 20 20 en 0 and "..
85b0: 73 65 63 72 65 74 2d 6b 65 79 73 23 20 31 2d 20 secret-keys# 1-
85c0: 5b 27 5d 20 2e 20 23 33 36 20 62 61 73 65 2d 65 ['] . #36 base-e
85d0: 78 65 63 75 74 65 20 63 72 20 20 72 64 72 6f 70 xecute cr rdrop
85e0: 0a 20 20 20 20 52 45 50 45 41 54 0a 20 20 20 20 . REPEAT.
85f0: 64 75 70 20 2e 73 74 6f 72 65 6b 65 79 21 20 20 dup .storekey!
8600: 3e 73 74 6f 72 65 6b 65 79 20 40 20 64 65 66 61 >storekey @ defa
8610: 75 6c 74 6b 65 79 20 21 0a 20 20 20 20 2e 22 20 ultkey !. ."
8620: 3d 3d 3d 3d 20 6b 65 79 20 22 20 64 75 70 20 2e ==== key " dup .
8630: 2e 6e 69 63 6b 20 2e 22 20 20 63 68 6f 73 65 6e .nick ." chosen
8640: 20 3d 3d 3d 3d 22 20 63 72 20 3b 0a 0a 5c 20 77 ====" cr ;..\ w
8650: 69 6c 6c 20 61 73 6b 20 66 6f 72 20 79 6f 75 72 ill ask for your
8660: 20 70 61 73 73 77 6f 72 64 20 61 6e 64 20 69 66 password and if
8670: 20 70 6f 73 73 69 62 6c 65 20 61 75 74 6f 2d 73 possible auto-s
8680: 65 6c 65 63 74 20 79 6f 75 72 20 69 64 0a 0a 56 elect your id..V
8690: 61 72 69 61 62 6c 65 20 74 72 69 65 73 23 0a 23 ariable tries#.#
86a0: 31 30 20 56 61 6c 75 65 20 6d 61 78 74 72 69 65 10 Value maxtrie
86b0: 73 23 0a 0a 3a 20 67 65 74 2d 73 6b 63 20 28 20 s#..: get-skc (
86c0: 2d 2d 20 29 0a 20 20 20 20 73 65 63 72 65 74 2d -- ). secret-
86d0: 6b 65 79 73 23 20 3f 45 58 49 54 20 20 74 72 69 keys# ?EXIT tri
86e0: 65 73 23 20 6f 66 66 0a 20 20 20 20 64 65 62 75 es# off. debu
86f0: 67 2d 76 65 63 74 6f 72 20 40 20 6f 70 2d 76 65 g-vector @ op-ve
8700: 63 74 6f 72 20 21 40 20 3e 72 20 3c 64 65 66 61 ctor !@ >r <defa
8710: 75 6c 74 3e 0a 20 20 20 20 73 65 63 72 65 74 2d ult>. secret-
8720: 6b 65 79 73 23 0a 20 20 20 20 42 45 47 49 4e 20 keys#. BEGIN
8730: 20 64 75 70 20 30 3d 20 74 72 69 65 73 23 20 40 dup 0= tries# @
8740: 20 6d 61 78 74 72 69 65 73 23 20 75 3c 20 61 6e maxtries# u< an
8750: 64 20 20 57 48 49 4c 45 20 64 72 6f 70 0a 09 20 d WHILE drop..
8760: 20 20 20 73 22 20 50 61 73 73 70 68 72 61 73 65 s" Passphrase
8770: 3a 20 22 20 2b 70 61 73 73 70 68 72 61 73 65 20 : " +passphrase
8780: 20 20 21 74 69 6d 65 0a 09 20 20 20 20 72 65 61 !time.. rea
8790: 64 2d 6b 65 79 73 20 73 65 63 72 65 74 2d 6b 65 d-keys secret-ke
87a0: 79 73 23 20 64 75 70 20 30 3d 20 49 46 0a 09 09 ys# dup 0= IF...
87b0: 5c 20 66 61 69 6c 20 72 69 67 68 74 20 61 66 74 \ fail right aft
87c0: 65 72 20 74 68 65 20 66 69 72 73 74 20 74 72 79 er the first try
87d0: 20 69 66 20 50 41 53 53 50 48 52 41 53 45 20 69 if PASSPHRASE i
87e0: 73 20 75 73 65 64 0a 09 09 5c 20 61 6e 64 20 67 s used...\ and g
87f0: 69 76 65 20 74 68 65 20 6d 61 78 69 6d 75 6d 20 ive the maximum
8800: 77 61 69 74 69 6e 67 20 70 65 6e 61 6c 74 79 20 waiting penalty
8810: 69 6e 20 74 68 61 74 20 63 61 73 65 0a 09 09 31 in that case...1
8820: 20 6d 61 78 74 72 69 65 73 23 20 73 22 20 50 41 maxtries# s" PA
8830: 53 53 50 48 52 41 53 45 22 20 67 65 74 65 6e 76 SSPHRASE" getenv
8840: 20 64 30 3d 20 73 65 6c 65 63 74 20 74 72 69 65 d0= select trie
8850: 73 23 20 2b 21 0a 09 09 3c 65 72 72 3e 20 2e 22 s# +!...<err> ."
8860: 20 54 72 79 23 20 22 20 74 72 69 65 73 23 20 40 Try# " tries# @
8870: 20 30 20 2e 72 20 27 2f 27 20 65 6d 69 74 20 6d 0 .r '/' emit m
8880: 61 78 74 72 69 65 73 23 20 2e 0a 09 09 2e 22 20 axtries# ....."
8890: 66 61 69 6c 65 64 2c 20 6e 6f 20 6b 65 79 20 66 failed, no key f
88a0: 6f 75 6e 64 2c 20 77 61 69 74 69 6e 67 20 22 0a ound, waiting ".
88b0: 09 09 23 31 20 74 72 69 65 73 23 20 40 20 32 2a ..#1 tries# @ 2*
88c0: 20 6c 73 68 69 66 74 20 64 75 70 20 2e 20 2e 22 lshift dup . ."
88d0: 20 6d 73 2e 2e 2e 22 20 6d 73 20 20 3c 64 65 66 ms..." ms <def
88e0: 61 75 6c 74 3e 20 63 72 0a 09 09 64 65 6c 2d 6c ault> cr...del-l
88f0: 61 73 74 2d 6b 65 79 0a 09 20 20 20 20 54 48 45 ast-key.. THE
8900: 4e 0a 20 20 20 20 52 45 50 45 41 54 0a 20 20 20 N. REPEAT.
8910: 20 64 75 70 20 30 3d 20 49 46 20 20 23 2d 35 36 dup 0= IF #-56
8920: 20 74 68 72 6f 77 20 20 54 48 45 4e 0a 20 20 20 throw THEN.
8930: 20 31 20 3d 20 49 46 20 20 30 20 73 65 63 72 65 1 = IF 0 secre
8940: 74 2d 6b 65 79 0a 09 2e 22 20 3d 3d 3d 3d 20 6f t-key..." ==== o
8950: 70 65 6e 65 64 3a 20 22 20 64 75 70 20 2e 2e 6e pened: " dup ..n
8960: 69 63 6b 20 2e 22 20 20 69 6e 20 22 20 2e 74 69 ick ." in " .ti
8970: 6d 65 20 2e 22 20 3d 3d 3d 3d 22 20 63 72 0a 20 me ." ====" cr.
8980: 20 20 20 45 4c 53 45 20 20 2e 22 20 3d 3d 3d 3d ELSE ." ====
8990: 20 6f 70 65 6e 65 64 20 69 6e 20 22 20 2e 74 69 opened in " .ti
89a0: 6d 65 20 2e 22 20 3d 3d 3d 3d 22 20 63 72 20 63 me ." ====" cr c
89b0: 68 6f 6f 73 65 2d 6b 65 79 20 20 54 48 45 4e 0a hoose-key THEN.
89c0: 20 20 20 20 3e 72 61 77 2d 6b 65 79 20 3f 72 73 >raw-key ?rs
89d0: 6b 20 20 20 72 3e 20 6f 70 2d 76 65 63 74 6f 72 k r> op-vector
89e0: 20 21 20 3b 0a 0a 73 63 6f 70 65 3a 20 6e 32 6f ! ;..scope: n2o
89f0: 0a 46 6f 72 77 61 72 64 20 68 65 6c 70 0a 7d 73 .Forward help.}s
8a00: 63 6f 70 65 0a 0a 3a 20 67 65 74 2d 6d 79 2d 6b cope..: get-my-k
8a10: 65 79 20 28 20 2d 2d 20 78 74 20 29 0a 20 20 20 ey ( -- xt ).
8a20: 20 67 65 6e 2d 6b 65 79 73 2d 64 69 72 20 20 22 gen-keys-dir "
8a30: 73 65 63 6b 65 79 73 2e 6b 32 6f 22 20 2e 6b 65 seckeys.k2o" .ke
8a40: 79 73 2f 20 32 64 75 70 20 66 69 6c 65 2d 73 74 ys/ 2dup file-st
8a50: 61 74 75 73 20 6e 69 70 0a 20 20 20 20 30 3d 20 atus nip. 0=
8a60: 49 46 20 20 72 2f 6f 20 6f 70 65 6e 2d 66 69 6c IF r/o open-fil
8a70: 65 20 74 68 72 6f 77 20 3e 72 20 72 40 20 66 69 e throw >r r@ fi
8a80: 6c 65 2d 73 69 7a 65 20 74 68 72 6f 77 20 64 30 le-size throw d0
8a90: 3d 0a 09 72 3e 20 63 6c 6f 73 65 2d 66 69 6c 65 =..r> close-file
8aa0: 20 74 68 72 6f 77 20 20 45 4c 53 45 20 20 74 72 throw ELSE tr
8ab0: 75 65 20 20 54 48 45 4e 0a 20 20 20 20 49 46 20 ue THEN. IF
8ac0: 20 5b 3a 20 2e 22 20 47 65 6e 65 72 61 74 65 20 [: ." Generate
8ad0: 61 20 6e 65 77 20 6b 65 79 70 61 69 72 3a 22 20 a new keypair:"
8ae0: 63 72 0a 09 20 20 67 65 74 2d 6e 69 63 6b 20 64 cr.. get-nick d
8af0: 75 70 20 30 3d 20 23 2d 35 36 20 61 6e 64 20 74 up 0= #-56 and t
8b00: 68 72 6f 77 20 5c 20 65 6d 70 74 79 20 6e 69 63 hrow \ empty nic
8b10: 6b 3a 20 70 72 65 74 65 6e 64 20 74 6f 20 71 75 k: pretend to qu
8b20: 69 74 0a 09 20 20 6e 65 77 2d 6b 65 79 20 2e 6b it.. new-key .k
8b30: 65 79 73 20 3f 72 73 6b 20 3b 5d 0a 20 20 20 20 eys ?rsk ;].
8b40: 45 4c 53 45 20 20 5b 27 5d 20 67 65 74 2d 73 6b ELSE ['] get-sk
8b50: 63 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 2e 6b 65 c THEN ;..: .ke
8b60: 79 69 6e 66 6f 20 28 20 2d 2d 20 29 0a 20 20 20 yinfo ( -- ).
8b70: 20 3c 77 61 72 6e 3e 20 2e 22 20 3d 3d 3d 3d 20 <warn> ." ====
8b80: 4e 6f 20 6b 65 79 20 6f 70 65 6e 65 64 20 3d 3d No key opened ==
8b90: 3d 3d 22 20 63 72 0a 20 20 20 20 3c 69 6e 66 6f ==" cr. <info
8ba0: 3e 20 2e 22 20 67 65 6e 65 72 61 74 65 20 61 20 > ." generate a
8bb0: 6e 65 77 20 6f 6e 65 20 77 69 74 68 20 27 6b 65 new one with 'ke
8bc0: 79 67 65 6e 27 22 20 63 72 20 3c 64 65 66 61 75 ygen'" cr <defau
8bd0: 6c 74 3e 20 3b 0a 0a 3a 20 67 65 74 2d 6d 65 20 lt> ;..: get-me
8be0: 28 20 2d 2d 20 29 0a 20 20 20 20 67 65 74 2d 6d ( -- ). get-m
8bf0: 79 2d 6b 65 79 20 63 61 74 63 68 20 64 75 70 20 y-key catch dup
8c00: 23 2d 35 36 20 3d 20 49 46 20 64 72 6f 70 20 2e #-56 = IF drop .
8c10: 6b 65 79 69 6e 66 6f 20 45 4c 53 45 20 74 68 72 keyinfo ELSE thr
8c20: 6f 77 20 54 48 45 4e 20 3b 0a 0a 3a 20 3f 67 65 ow THEN ;..: ?ge
8c30: 74 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 t-me ( -- ).
8c40: 5c 47 20 74 68 69 73 20 76 65 72 73 69 6f 6e 20 \G this version
8c50: 6f 66 20 67 65 74 2d 6d 65 20 66 61 69 6c 73 20 of get-me fails
8c60: 68 61 72 64 20 69 66 20 6e 6f 20 6b 65 79 20 69 hard if no key i
8c70: 73 20 6f 70 65 6e 65 64 0a 20 20 20 20 67 65 74 s opened. get
8c80: 2d 6d 79 2d 6b 65 79 20 63 61 74 63 68 20 23 2d -my-key catch #-
8c90: 35 36 20 3d 20 49 46 0a 09 2e 6b 65 79 69 6e 66 56 = IF...keyinf
8ca0: 6f 20 74 72 75 65 20 21 21 6e 6f 2d 6b 65 79 2d o true !!no-key-
8cb0: 6f 70 65 6e 21 21 0a 20 20 20 20 54 48 45 4e 20 open!!. THEN
8cc0: 3b 0a 0a 30 20 5b 49 46 5d 0a 4c 6f 63 61 6c 20 ;..0 [IF].Local
8cd0: 56 61 72 69 61 62 6c 65 73 3a 0a 66 6f 72 74 68 Variables:.forth
8ce0: 2d 6c 6f 63 61 6c 2d 77 6f 72 64 73 3a 0a 20 20 -local-words:.
8cf0: 20 20 28 0a 20 20 20 20 20 28 28 22 6e 65 74 32 (. (("net2
8d00: 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20 64 o:" "+net2o:") d
8d10: 65 66 69 6e 69 74 69 6f 6e 2d 73 74 61 72 74 65 efinition-starte
8d20: 72 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 6b 65 79 r (font-lock-key
8d30: 77 6f 72 64 2d 66 61 63 65 20 2e 20 31 29 0a 20 word-face . 1).
8d40: 20 20 20 20 20 22 5b 20 5c 74 5c 6e 5d 22 20 74 "[ \t\n]" t
8d50: 20 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b name (font-lock
8d60: 2d 66 75 6e 63 74 69 6f 6e 2d 6e 61 6d 65 2d 66 -function-name-f
8d70: 61 63 65 20 2e 20 33 29 29 0a 20 20 20 20 20 28 ace . 3)). (
8d80: 28 22 64 65 62 75 67 3a 22 20 22 66 69 65 6c 64 ("debug:" "field
8d90: 3a 22 20 22 32 66 69 65 6c 64 3a 22 20 22 73 66 :" "2field:" "sf
8da0: 66 69 65 6c 64 3a 22 20 22 64 66 66 69 65 6c 64 field:" "dffield
8db0: 3a 22 20 22 36 34 66 69 65 6c 64 3a 22 20 22 75 :" "64field:" "u
8dc0: 76 61 72 22 20 22 75 76 61 6c 75 65 22 29 20 6e var" "uvalue") n
8dd0: 6f 6e 2d 69 6d 6d 65 64 69 61 74 65 20 28 66 6f on-immediate (fo
8de0: 6e 74 2d 6c 6f 63 6b 2d 74 79 70 65 2d 66 61 63 nt-lock-type-fac
8df0: 65 20 2e 20 32 29 0a 20 20 20 20 20 20 22 5b 20 e . 2). "[
8e00: 5c 74 5c 6e 5d 22 20 74 20 6e 61 6d 65 20 28 66 \t\n]" t name (f
8e10: 6f 6e 74 2d 6c 6f 63 6b 2d 76 61 72 69 61 62 6c ont-lock-variabl
8e20: 65 2d 6e 61 6d 65 2d 66 61 63 65 20 2e 20 33 29 e-name-face . 3)
8e30: 29 0a 20 20 20 20 20 28 22 5b 61 2d 7a 30 2d 39 ). ("[a-z0-9
8e40: 5d 2b 28 22 20 69 6d 6d 65 64 69 61 74 65 20 28 ]+(" immediate (
8e50: 66 6f 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e font-lock-commen
8e60: 74 2d 66 61 63 65 20 2e 20 31 29 0a 20 20 20 20 t-face . 1).
8e70: 20 20 22 29 22 20 6e 69 6c 20 63 6f 6d 6d 65 6e ")" nil commen
8e80: 74 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d t (font-lock-com
8e90: 6d 65 6e 74 2d 66 61 63 65 20 2e 20 31 29 29 0a ment-face . 1)).
8ea0: 20 20 20 20 29 0a 66 6f 72 74 68 2d 6c 6f 63 61 ).forth-loca
8eb0: 6c 2d 69 6e 64 65 6e 74 2d 77 6f 72 64 73 3a 0a l-indent-words:.
8ec0: 20 20 20 20 28 0a 20 20 20 20 20 28 28 22 6e 65 (. (("ne
8ed0: 74 32 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29 t2o:" "+net2o:")
8ee0: 20 28 30 20 2e 20 32 29 20 28 30 20 2e 20 32 29 (0 . 2) (0 . 2)
8ef0: 20 6e 6f 6e 2d 69 6d 6d 65 64 69 61 74 65 29 0a non-immediate).
8f00: 20 20 20 20 20 28 28 22 5b 3a 22 20 22 6b 65 79 (("[:" "key
8f10: 3a 63 6f 64 65 22 29 20 28 30 20 2e 20 31 29 20 :code") (0 . 1)
8f20: 28 30 20 2e 20 31 29 20 69 6d 6d 65 64 69 61 74 (0 . 1) immediat
8f30: 65 29 0a 20 20 20 20 20 28 28 22 3b 5d 22 20 22 e). ((";]" "
8f40: 65 6e 64 3a 6b 65 79 22 29 20 28 2d 31 20 2e 20 end:key") (-1 .
8f50: 30 29 20 28 30 20 2e 20 2d 31 29 20 69 6d 6d 65 0) (0 . -1) imme
8f60: 64 69 61 74 65 29 0a 20 20 20 20 29 0a 45 6e 64 diate). ).End
8f70: 3a 0a 5b 54 48 45 4e 5d :.[THEN]