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 69 @ IF..cell+ >o i
63d0: 6d 70 6f 72 74 23 73 63 61 6e 20 6b 65 2d 69 6d mport#scan ke-im
63e0: 70 6f 72 74 73 20 6f 72 21 20 6f 3e 20 20 73 61 ports or! o> sa
63f0: 76 65 2d 6b 65 79 73 0a 20 20 20 20 54 48 45 4e ve-keys. THEN
6400: 20 3b 0a 0a 5c 20 67 65 6e 65 72 61 74 65 20 6b ;..\ generate k
6410: 65 79 73 0a 0a 3a 20 2b 67 65 6e 2d 6b 65 79 73 eys..: +gen-keys
6420: 20 28 20 6e 69 63 6b 20 75 20 74 79 70 65 20 2d ( nick u type -
6430: 2d 20 29 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 - ). gen-keys
6440: 20 20 36 34 23 2d 31 20 6b 65 79 2d 72 65 61 64 64#-1 key-read
6450: 2d 6f 66 66 73 65 74 20 36 34 21 20 20 70 6b 63 -offset 64! pkc
6460: 20 6b 65 79 73 69 7a 65 32 20 6b 65 79 3a 6e 65 keysize2 key:ne
6470: 77 20 3e 6f 0a 20 20 20 20 5b 20 31 20 69 6d 70 w >o. [ 1 imp
6480: 6f 72 74 23 73 65 6c 66 20 6c 73 68 69 66 74 20 ort#self lshift
6490: 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 1 import#new lsh
64a0: 69 66 74 20 6f 72 20 5d 4c 20 6b 65 2d 69 6d 70 ift or ]L ke-imp
64b0: 6f 72 74 73 20 21 0a 20 20 20 20 6b 65 2d 74 79 orts !. ke-ty
64c0: 70 65 20 21 20 20 6b 65 2d 6e 69 63 6b 20 24 21 pe ! ke-nick $!
64d0: 20 20 6e 69 63 6b 21 0a 20 20 20 20 63 6f 6e 66 nick!. conf
64e0: 69 67 3a 70 77 2d 6c 65 76 65 6c 23 20 40 20 6b ig:pw-level# @ k
64f0: 65 2d 70 77 6c 65 76 65 6c 20 21 20 20 70 65 72 e-pwlevel ! per
6500: 6d 25 6d 79 73 65 6c 66 20 6b 65 2d 6d 61 73 6b m%myself ke-mask
6510: 20 21 0a 20 20 20 20 73 6b 63 20 6b 65 79 73 69 !. skc keysi
6520: 7a 65 20 6b 65 2d 73 6b 20 73 65 63 21 20 20 2b ze ke-sk sec! +
6530: 73 65 63 6b 65 79 0a 20 20 20 20 73 6b 72 65 76 seckey. skrev
6540: 20 6b 65 79 73 69 7a 65 20 6b 65 2d 72 73 6b 20 keysize ke-rsk
6550: 73 65 63 21 0a 20 20 20 20 6b 65 79 2d 73 69 67 sec!. key-sig
6560: 6e 20 6f 3e 20 3b 0a 0a 24 34 30 20 62 75 66 66 n o> ;..$40 buff
6570: 65 72 3a 20 6e 69 63 6b 2d 62 75 66 0a 0a 3a 20 er: nick-buf..:
6580: 67 65 74 2d 6e 69 63 6b 20 28 20 2d 2d 20 61 64 get-nick ( -- ad
6590: 64 72 20 75 20 29 0a 20 20 20 20 2e 22 20 6e 69 dr u ). ." ni
65a0: 63 6b 3a 20 22 20 6e 69 63 6b 2d 62 75 66 20 24 ck: " nick-buf $
65b0: 34 30 20 61 63 63 65 70 74 20 6e 69 63 6b 2d 62 40 accept nick-b
65c0: 75 66 20 73 77 61 70 20 2d 74 72 61 69 6c 69 6e uf swap -trailin
65d0: 67 20 63 72 20 3b 0a 0a 66 61 6c 73 65 20 76 61 g cr ;..false va
65e0: 6c 75 65 20 3f 79 65 73 0a 3a 20 79 65 73 3f 20 lue ?yes.: yes?
65f0: 28 20 61 64 64 72 20 75 20 2d 2d 20 66 6c 61 67 ( addr u -- flag
6600: 20 29 0a 20 20 20 20 3f 79 65 73 20 49 46 20 20 ). ?yes IF
6610: 32 64 72 6f 70 20 74 72 75 65 20 20 45 4c 53 45 2drop true ELSE
6620: 20 20 74 79 70 65 20 2e 22 20 20 28 79 2f 4e 29 type ." (y/N)
6630: 22 20 6b 65 79 20 63 72 20 27 79 27 20 3d 20 20 " key cr 'y' =
6640: 54 48 45 4e 20 3b 0a 0a 3a 20 3f 72 73 6b 20 28 THEN ;..: ?rsk (
6650: 20 2d 2d 20 29 0a 20 20 20 20 70 6b 63 20 6b 65 -- ). pkc ke
6660: 79 73 69 7a 65 20 6b 65 79 2d 65 78 69 73 74 3f ysize key-exist?
6670: 20 64 75 70 20 30 3d 20 49 46 20 20 64 72 6f 70 dup 0= IF drop
6680: 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 EXIT THEN.
6690: 20 3e 6f 20 6b 65 2d 72 73 6b 20 73 65 63 40 20 >o ke-rsk sec@
66a0: 64 75 70 20 30 3d 20 49 46 20 20 32 64 72 6f 70 dup 0= IF 2drop
66b0: 20 6f 3e 20 20 45 58 49 54 20 20 54 48 45 4e 0a o> EXIT THEN.
66c0: 20 20 20 20 2e 22 20 59 6f 75 20 73 74 69 6c 6c ." You still
66d0: 20 68 61 76 65 6e 27 74 20 73 74 6f 72 65 64 20 haven't stored
66e0: 79 6f 75 72 20 72 65 76 6f 6b 65 20 6b 65 79 20 your revoke key
66f0: 73 65 63 75 72 65 6c 79 20 6f 66 66 2d 6c 69 6e securely off-lin
6700: 65 2e 22 20 63 72 0a 20 20 20 20 73 22 20 50 61 e." cr. s" Pa
6710: 70 65 72 20 61 6e 64 20 70 65 6e 63 69 6c 20 72 per and pencil r
6720: 65 61 64 79 3f 22 20 79 65 73 3f 20 49 46 0a 09 eady?" yes? IF..
6730: 2e 73 74 72 69 70 65 38 35 0a 09 73 22 20 57 72 .stripe85..s" Wr
6740: 69 74 74 65 6e 20 64 6f 77 6e 3f 22 20 79 65 73 itten down?" yes
6750: 3f 20 49 46 0a 09 20 20 20 20 73 22 20 59 6f 75 ? IF.. s" You
6760: 20 77 6f 6e 27 74 20 73 65 65 20 74 68 69 73 20 won't see this
6770: 61 67 61 69 6e 21 20 44 65 6c 65 74 65 3f 22 20 again! Delete?"
6780: 79 65 73 3f 0a 09 20 20 20 20 49 46 20 6b 65 2d yes?.. IF ke-
6790: 72 73 6b 20 73 65 63 2d 6f 66 66 20 20 73 61 76 rsk sec-off sav
67a0: 65 2d 6b 65 79 73 0a 09 09 2e 22 20 72 65 76 6f e-keys...." revo
67b0: 6b 65 20 6b 65 79 20 64 65 6c 65 74 65 64 2e 22 ke key deleted."
67c0: 20 63 72 20 6f 3e 20 20 45 58 49 54 20 20 54 48 cr o> EXIT TH
67d0: 45 4e 20 20 54 48 45 4e 0a 20 20 20 20 45 4c 53 EN THEN. ELS
67e0: 45 20 20 32 64 72 6f 70 20 20 54 48 45 4e 0a 20 E 2drop THEN.
67f0: 20 20 20 2e 22 20 49 27 6d 20 6b 65 65 70 69 6e ." I'm keepin
6800: 67 20 79 6f 75 72 20 72 65 76 6f 6b 65 20 6b 65 g your revoke ke
6810: 79 2e 20 20 54 68 69 73 20 77 69 6c 6c 20 73 68 y. This will sh
6820: 6f 77 20 75 70 20 61 67 61 69 6e 2e 22 20 63 72 ow up again." cr
6830: 20 6f 3e 20 3b 0a 0a 5c 20 72 65 61 64 20 6b 65 o> ;..\ read ke
6840: 79 20 66 69 6c 65 0a 0a 3a 20 74 72 79 2d 64 65 y file..: try-de
6850: 63 72 79 70 74 2d 6b 65 79 20 28 20 6b 65 79 20 crypt-key ( key
6860: 75 31 20 2d 2d 20 61 64 64 72 20 75 32 20 66 6c u1 -- addr u2 fl
6870: 61 67 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b ag ). keypack
6880: 20 6b 65 79 70 61 63 6b 2d 64 20 6b 65 79 70 61 keypack-d keypa
6890: 63 6b 2d 61 6c 6c 23 20 6d 6f 76 65 0a 20 20 20 ck-all# move.
68a0: 20 6b 65 79 70 61 63 6b 2d 64 20 6b 65 79 70 61 keypack-d keypa
68b0: 63 6b 2d 61 6c 6c 23 20 32 73 77 61 70 0a 20 20 ck-all# 2swap.
68c0: 20 20 64 75 70 20 24 32 30 20 3d 20 49 46 20 20 dup $20 = IF
68d0: 64 65 63 72 79 70 74 24 20 20 45 4c 53 45 0a 09 decrypt$ ELSE..
68e0: 6b 65 79 70 61 63 6b 20 63 40 20 24 46 20 61 6e keypack c@ $F an
68f0: 64 20 63 6f 6e 66 69 67 3a 70 77 2d 6d 61 78 6c d config:pw-maxl
6900: 65 76 65 6c 23 20 40 20 3c 3d 0a 09 49 46 20 20 evel# @ <=..IF
6910: 64 65 63 72 79 70 74 2d 70 77 24 20 20 45 4c 53 decrypt-pw$ ELS
6920: 45 20 20 32 64 72 6f 70 20 66 61 6c 73 65 20 20 E 2drop false
6930: 54 48 45 4e 0a 20 20 20 20 54 48 45 4e 20 3b 0a THEN. THEN ;.
6940: 0a 3a 20 74 72 79 2d 64 65 63 72 79 70 74 20 28 .: try-decrypt (
6950: 20 66 6c 61 67 20 2d 2d 20 61 64 64 72 20 75 20 flag -- addr u
6960: 2f 20 30 20 30 20 29 20 7b 20 66 6c 61 67 20 7d / 0 0 ) { flag }
6970: 0a 20 20 20 20 6b 65 79 73 20 24 5b 5d 23 20 30 . keys $[]# 0
6980: 20 3f 44 4f 0a 09 49 20 6b 65 79 73 20 73 65 63 ?DO..I keys sec
6990: 5b 5d 40 20 64 75 70 20 6b 65 79 73 69 7a 65 20 []@ dup keysize
69a0: 3d 20 66 6c 61 67 20 78 6f 72 20 49 46 0a 09 20 = flag xor IF..
69b0: 20 20 20 74 72 79 2d 64 65 63 72 79 70 74 2d 6b try-decrypt-k
69c0: 65 79 20 49 46 0a 09 09 49 20 6b 65 79 73 20 24 ey IF...I keys $
69d0: 5b 5d 20 40 20 64 75 70 20 3e 73 74 6f 72 65 6b [] @ dup >storek
69e0: 65 79 20 21 20 64 65 66 61 75 6c 74 6b 65 79 20 ey ! defaultkey
69f0: 21 0a 09 09 75 6e 6c 6f 6f 70 20 20 45 58 49 54 !...unloop EXIT
6a00: 20 20 54 48 45 4e 20 20 54 48 45 4e 0a 09 32 64 THEN THEN..2d
6a10: 72 6f 70 0a 20 20 20 20 4c 4f 4f 50 20 20 30 20 rop. LOOP 0
6a20: 30 20 3b 0a 0a 3a 20 3f 70 65 72 6d 20 28 20 6f 0 ;..: ?perm ( o
6a30: 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 :key -- ). ke
6a40: 2d 73 6b 20 73 65 63 40 20 6e 69 70 20 64 75 70 -sk sec@ nip dup
6a50: 20 49 46 20 20 70 65 72 6d 25 6d 79 73 65 6c 66 IF perm%myself
6a60: 20 20 45 4c 53 45 20 20 70 65 72 6d 25 64 65 66 ELSE perm%def
6a70: 61 75 6c 74 20 20 54 48 45 4e 20 20 6b 65 2d 6d ault THEN ke-m
6a80: 61 73 6b 20 21 0a 20 20 20 20 49 46 20 20 22 5c ask !. IF "\
6a90: 78 30 30 22 20 20 45 4c 53 45 20 20 22 5c 78 30 x00" ELSE "\x0
6aa0: 31 22 20 20 54 48 45 4e 20 20 6b 65 2d 67 72 6f 1" THEN ke-gro
6ab0: 75 70 73 20 24 21 20 3b 0a 0a 3a 20 64 6f 2d 6b ups $! ;..: do-k
6ac0: 65 79 20 28 20 61 64 64 72 20 75 20 2f 20 30 20 ey ( addr u / 0
6ad0: 30 20 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 0 -- ). dup
6ae0: 30 3d 20 49 46 20 20 32 64 72 6f 70 20 20 45 58 0= IF 2drop EX
6af0: 49 54 20 20 54 48 45 4e 0a 20 20 20 20 73 61 6d IT THEN. sam
6b00: 70 6c 65 2d 6b 65 79 20 3e 6f 20 6b 65 2d 73 6b ple-key >o ke-sk
6b10: 20 6b 65 2d 65 6e 64 20 6f 76 65 72 20 2d 20 65 ke-end over - e
6b20: 72 61 73 65 20 20 64 6f 2d 63 6d 64 2d 6c 6f 6f rase do-cmd-loo
6b30: 70 20 6f 3e 20 3b 0a 0a 3a 20 2e 6b 65 79 24 20 p o> ;..: .key$
6b40: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 ( addr u -- ).
6b50: 20 20 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 sample-key >o
6b60: 20 6b 65 2d 73 6b 20 6b 65 2d 65 6e 64 20 6f 76 ke-sk ke-end ov
6b70: 65 72 20 2d 20 65 72 61 73 65 0a 20 20 20 20 73 er - erase. s
6b80: 69 67 6e 65 64 2d 76 61 6c 20 76 61 6c 69 64 61 igned-val valida
6b90: 74 65 64 20 6f 72 21 20 20 63 2d 73 74 61 74 65 ted or! c-state
6ba0: 20 6f 66 66 20 20 6e 65 73 74 2d 63 6d 64 2d 6c off nest-cmd-l
6bb0: 6f 6f 70 0a 20 20 20 20 73 69 67 6e 65 64 2d 76 oop. signed-v
6bc0: 61 6c 20 69 6e 76 65 72 74 20 76 61 6c 69 64 61 al invert valida
6bd0: 74 65 64 20 61 6e 64 21 0a 20 20 20 20 2e 6b 65 ted and!. .ke
6be0: 79 2d 73 68 6f 72 74 20 66 72 65 65 2d 6b 65 79 y-short free-key
6bf0: 20 6f 3e 20 3b 0a 0a 3a 20 72 65 61 64 2d 6b 65 o> ;..: read-ke
6c00: 79 73 2d 6c 6f 6f 70 20 28 20 66 64 20 2d 2d 20 ys-loop ( fd --
6c10: 29 20 20 63 6f 64 65 2d 6b 65 79 0a 20 20 20 20 ) code-key.
6c20: 3e 72 20 23 30 2e 20 72 40 20 72 65 70 6f 73 69 >r #0. r@ reposi
6c30: 74 69 6f 6e 2d 66 69 6c 65 20 74 68 72 6f 77 0a tion-file throw.
6c40: 20 20 20 20 42 45 47 49 4e 0a 09 72 40 20 66 69 BEGIN..r@ fi
6c50: 6c 65 2d 70 6f 73 69 74 69 6f 6e 20 74 68 72 6f le-position thro
6c60: 77 20 64 3e 36 34 20 6b 65 79 2d 72 65 61 64 2d w d>64 key-read-
6c70: 6f 66 66 73 65 74 20 36 34 21 0a 09 6b 65 79 70 offset 64!..keyp
6c80: 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 ack keypack-all#
6c90: 20 72 40 20 72 65 61 64 2d 66 69 6c 65 20 74 68 r@ read-file th
6ca0: 72 6f 77 0a 09 6b 65 79 70 61 63 6b 2d 61 6c 6c row..keypack-all
6cb0: 23 20 3d 20 57 48 49 4c 45 0a 09 20 20 20 20 69 # = WHILE.. i
6cc0: 6d 70 6f 72 74 2d 74 79 70 65 20 40 20 69 6d 70 mport-type @ imp
6cd0: 6f 72 74 23 73 65 6c 66 20 3d 20 74 72 79 2d 64 ort#self = try-d
6ce0: 65 63 72 79 70 74 20 64 6f 2d 6b 65 79 0a 20 20 ecrypt do-key.
6cf0: 20 20 52 45 50 45 41 54 20 20 72 64 72 6f 70 20 REPEAT rdrop
6d00: 20 63 6f 64 65 30 2d 62 75 66 20 3b 0a 3a 20 72 code0-buf ;.: r
6d10: 65 61 64 2d 6b 65 79 2d 6c 6f 6f 70 20 28 20 2d ead-key-loop ( -
6d20: 2d 20 29 0a 20 20 20 20 69 6d 70 6f 72 74 23 73 - ). import#s
6d30: 65 6c 66 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 elf import-type
6d40: 21 0a 20 20 20 20 3f 6b 65 79 2d 73 66 64 20 72 !. ?key-sfd r
6d50: 65 61 64 2d 6b 65 79 73 2d 6c 6f 6f 70 20 3b 0a ead-keys-loop ;.
6d60: 3a 20 72 65 61 64 2d 70 6b 65 79 2d 6c 6f 6f 70 : read-pkey-loop
6d70: 20 28 20 2d 2d 20 29 0a 20 20 20 20 6c 61 73 74 ( -- ). last
6d80: 6b 65 79 40 20 64 72 6f 70 20 64 65 66 61 75 6c key@ drop defaul
6d90: 74 6b 65 79 20 21 20 5c 20 61 74 20 6c 65 61 73 tkey ! \ at leas
6da0: 74 20 6f 6e 65 20 64 65 66 61 75 6c 74 20 6b 65 t one default ke
6db0: 79 20 61 76 61 69 6c 61 62 6c 65 0a 20 20 20 20 y available.
6dc0: 2d 31 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76 -1 config:pw-lev
6dd0: 65 6c 23 0a 20 20 20 20 5b 3a 20 69 6d 70 6f 72 el#. [: impor
6de0: 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 79 70 t#new import-typ
6df0: 65 20 21 20 3f 6b 65 79 2d 70 66 64 20 72 65 61 e ! ?key-pfd rea
6e00: 64 2d 6b 65 79 73 2d 6c 6f 6f 70 20 3b 5d 20 21 d-keys-loop ;] !
6e10: 77 72 61 70 70 65 72 20 3b 0a 0a 3a 20 72 65 61 wrapper ;..: rea
6e20: 64 2d 6b 65 79 73 20 28 20 2d 2d 20 29 0a 20 20 d-keys ( -- ).
6e30: 20 20 72 65 61 64 2d 6b 65 79 2d 6c 6f 6f 70 20 read-key-loop
6e40: 72 65 61 64 2d 70 6b 65 79 2d 6c 6f 6f 70 20 69 read-pkey-loop i
6e50: 6d 70 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 mport#new import
6e60: 2d 74 79 70 65 20 21 20 3b 0a 0a 3a 20 72 65 61 -type ! ;..: rea
6e70: 64 2d 70 6b 32 6b 65 79 24 20 28 20 61 64 64 72 d-pk2key$ ( addr
6e80: 20 75 20 2d 2d 20 29 0a 20 20 20 20 5c 67 20 72 u -- ). \g r
6e90: 65 61 64 20 61 20 6e 65 73 74 65 64 20 6b 65 79 ead a nested key
6ea0: 20 69 6e 74 6f 20 73 61 6d 70 6c 65 2d 6b 65 79 into sample-key
6eb0: 0a 20 20 20 20 73 61 6d 70 6c 65 2d 6b 65 79 20 . sample-key
6ec0: 3e 6f 20 63 2d 73 74 61 74 65 20 6f 66 66 20 20 >o c-state off
6ed0: 73 69 6d 2d 6e 69 63 6b 21 20 6f 6e 0a 20 20 20 sim-nick! on.
6ee0: 20 70 6b 32 2d 73 69 67 3f 20 21 21 73 69 67 21 pk2-sig? !!sig!
6ef0: 21 20 73 69 67 70 6b 32 73 69 7a 65 23 20 2d 20 ! sigpk2size# -
6f00: 32 64 75 70 20 2b 20 3e 72 20 64 6f 2d 6e 65 73 2dup + >r do-nes
6f10: 74 73 69 67 0a 20 20 20 20 72 40 20 6b 65 79 73 tsig. r@ keys
6f20: 69 7a 65 32 20 6b 65 2d 70 6b 20 24 21 0a 20 20 ize2 ke-pk $!.
6f30: 20 20 72 3e 20 6b 65 79 73 69 7a 65 32 20 2b 20 r> keysize2 +
6f40: 73 69 67 73 69 7a 65 23 20 6b 65 2d 73 65 6c 66 sigsize# ke-self
6f50: 73 69 67 20 24 21 0a 20 20 20 20 6f 3e 20 20 73 sig $!. o> s
6f60: 69 6d 2d 6e 69 63 6b 21 20 6f 66 66 20 3b 0a 0a im-nick! off ;..
6f70: 3a 20 2e 70 6b 32 6b 65 79 24 20 28 20 61 64 64 : .pk2key$ ( add
6f80: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 72 65 61 r u -- ). rea
6f90: 64 2d 70 6b 32 6b 65 79 24 20 73 61 6d 70 6c 65 d-pk2key$ sample
6fa0: 2d 6b 65 79 20 3e 6f 0a 20 20 20 20 5b 20 31 20 -key >o. [ 1
6fb0: 69 6d 70 6f 72 74 23 69 6e 76 69 74 65 64 20 6c import#invited l
6fc0: 73 68 69 66 74 20 31 20 69 6d 70 6f 72 74 23 6e shift 1 import#n
6fd0: 65 77 20 6c 73 68 69 66 74 20 6f 72 20 5d 4c 20 ew lshift or ]L
6fe0: 6b 65 2d 69 6d 70 6f 72 74 73 20 21 0a 20 20 20 ke-imports !.
6ff0: 20 2e 6b 65 79 2d 69 6e 76 69 74 65 20 66 72 65 .key-invite fre
7000: 65 2d 6b 65 79 20 6f 3e 20 3b 0a 0a 5c 20 73 65 e-key o> ;..\ se
7010: 6c 65 63 74 20 6b 65 79 20 62 79 20 6e 69 63 6b lect key by nick
7020: 0a 0a 3a 20 3e 72 61 77 2d 6b 65 79 20 28 20 6f ..: >raw-key ( o
7030: 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 30 3d -- ). dup 0=
7040: 20 21 21 6e 6f 2d 6e 69 63 6b 21 21 20 3e 6f 0a !!no-nick!! >o.
7050: 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 70 6b 63 ke-pk $@ pkc
7060: 20 70 6b 72 6b 23 20 73 6d 6f 76 65 0a 20 20 20 pkrk# smove.
7070: 20 6b 65 2d 73 6b 20 73 65 63 40 20 73 6b 63 20 ke-sk sec@ skc
7080: 73 77 61 70 20 6b 65 79 7c 20 6d 6f 76 65 0a 20 swap key| move.
7090: 20 20 20 3e 73 6b 73 69 67 20 6f 3e 20 3b 0a 0a >sksig o> ;..
70a0: 3a 20 3e 6b 65 79 20 28 20 61 64 64 72 20 75 20 : >key ( addr u
70b0: 2d 2d 20 29 0a 20 20 20 20 6b 65 79 23 20 40 20 -- ). key# @
70c0: 30 3d 20 49 46 20 20 72 65 61 64 2d 6b 65 79 73 0= IF read-keys
70d0: 20 20 54 48 45 4e 0a 20 20 20 20 6e 69 63 6b 2d THEN. nick-
70e0: 6b 65 79 20 3e 72 61 77 2d 6b 65 79 20 3b 0a 0a key >raw-key ;..
70f0: 3a 20 69 27 6d 20 28 20 22 6e 61 6d 65 22 20 2d : i'm ( "name" -
7100: 2d 20 29 20 70 61 72 73 65 2d 6e 61 6d 65 20 3e - ) parse-name >
7110: 6b 65 79 20 3b 0a 3a 20 70 6b 27 20 28 20 22 6e key ;.: pk' ( "n
7120: 61 6d 65 22 20 2d 2d 20 61 64 64 72 20 75 20 29 ame" -- addr u )
7130: 0a 20 20 20 20 70 61 72 73 65 2d 6e 61 6d 65 20 . parse-name
7140: 6e 69 63 6b 3e 70 6b 20 3b 0a 0a 3a 20 64 65 73 nick>pk ;..: des
7150: 74 2d 6b 65 79 20 28 20 61 64 64 72 20 75 20 2d t-key ( addr u -
7160: 2d 20 29 20 64 75 70 20 30 3d 20 49 46 20 20 32 - ) dup 0= IF 2
7170: 64 72 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e drop EXIT THEN
7180: 0a 20 20 20 20 6e 69 63 6b 2d 6b 65 79 20 3e 6f . nick-key >o
7190: 20 6f 20 30 3d 20 21 21 75 6e 6b 6e 6f 77 6e 2d o 0= !!unknown-
71a0: 6b 65 79 21 21 0a 20 20 20 20 6b 65 2d 70 6b 20 key!!. ke-pk
71b0: 24 40 20 6f 3e 0a 20 20 20 20 70 75 62 6b 65 79 $@ o>. pubkey
71c0: 20 24 21 20 3b 0a 0a 3a 20 64 65 73 74 2d 70 6b $! ;..: dest-pk
71d0: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 6b ( addr u -- ) k
71e0: 65 79 32 7c 20 32 64 75 70 20 6b 65 79 7c 20 6b ey2| 2dup key| k
71f0: 65 79 23 20 23 40 20 30 3d 20 49 46 0a 09 64 72 ey# #@ 0= IF..dr
7200: 6f 70 20 70 75 62 6b 65 79 20 24 21 20 20 70 65 op pubkey $! pe
7210: 72 6d 25 75 6e 6b 6e 6f 77 6e 20 70 65 72 6d 2d rm%unknown perm-
7220: 6d 61 73 6b 20 21 0a 20 20 20 20 45 4c 53 45 20 mask !. ELSE
7230: 20 63 65 6c 6c 2b 20 3e 6f 0a 09 6b 65 2d 6d 61 cell+ >o..ke-ma
7240: 73 6b 20 40 0a 09 6b 65 2d 70 6b 20 24 40 20 6f sk @..ke-pk $@ o
7250: 3e 0a 09 70 75 62 6b 65 79 20 24 21 20 20 70 65 >..pubkey $! pe
7260: 72 6d 2d 6d 61 73 6b 20 21 20 20 32 64 72 6f 70 rm-mask ! 2drop
7270: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 72 65 70 6c THEN ;..: repl
7280: 61 63 65 2d 6b 65 79 20 31 20 2f 73 74 72 69 6e ace-key 1 /strin
7290: 67 20 7b 20 72 65 76 2d 61 64 64 72 20 75 20 2d g { rev-addr u -
72a0: 2d 20 6f 20 7d 20 5c 20 72 65 76 6f 63 61 74 69 - o } \ revocati
72b0: 6f 6e 20 74 69 63 6b 65 74 0a 20 20 20 20 6b 65 on ticket. ke
72c0: 79 28 20 2e 22 20 52 65 70 6c 61 63 65 3a 22 20 y( ." Replace:"
72d0: 63 72 20 6f 20 63 65 6c 6c 2d 20 30 20 2e 6b 65 cr o cell- 0 .ke
72e0: 79 20 29 0a 20 20 20 20 69 6d 70 6f 72 74 23 73 y ). import#s
72f0: 65 6c 66 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 elf import-type
7300: 21 0a 20 20 20 20 73 22 20 23 72 65 76 6f 6b 65 !. s" #revoke
7310: 64 22 20 64 75 70 20 3e 72 20 6b 65 2d 6e 69 63 d" dup >r ke-nic
7320: 6b 20 24 2b 21 0a 20 20 20 20 6b 65 2d 6e 69 63 k $+!. ke-nic
7330: 6b 20 24 40 20 72 3e 20 2d 20 6b 65 2d 70 72 6f k $@ r> - ke-pro
7340: 66 20 24 40 20 6b 65 2d 73 69 67 73 20 6b 65 2d f $@ ke-sigs ke-
7350: 74 79 70 65 20 40 0a 20 20 20 20 72 65 76 2d 61 type @. rev-a
7360: 64 64 72 20 70 6b 72 6b 23 20 6b 65 79 3f 6e 65 ddr pkrk# key?ne
7370: 77 20 3e 6f 0a 20 20 20 20 6b 65 2d 74 79 70 65 w >o. ke-type
7380: 20 21 20 5b 3a 20 6b 65 2d 73 69 67 73 20 24 2b ! [: ke-sigs $+
7390: 5b 5d 21 20 3b 5d 20 24 5b 5d 6d 61 70 20 6b 65 []! ;] $[]map ke
73a0: 2d 70 72 6f 66 20 24 21 20 6b 65 2d 6e 69 63 6b -prof $! ke-nick
73b0: 20 24 21 0a 20 20 20 20 72 65 76 2d 61 64 64 72 $!. rev-addr
73c0: 20 70 6b 72 6b 23 20 6b 65 2d 70 6b 20 24 21 0a pkrk# ke-pk $!.
73d0: 20 20 20 20 72 65 76 2d 61 64 64 72 20 75 20 2b rev-addr u +
73e0: 20 31 2d 20 64 75 70 20 63 40 20 32 2a 20 2d 20 1- dup c@ 2* -
73f0: 24 31 30 20 2d 20 24 31 30 20 6b 65 2d 73 65 6c $10 - $10 ke-sel
7400: 66 73 69 67 20 24 21 0a 20 20 20 20 6b 65 79 28 fsig $!. key(
7410: 20 2e 22 20 77 69 74 68 3a 22 20 63 72 20 6f 20 ." with:" cr o
7420: 63 65 6c 6c 2d 20 30 20 2e 6b 65 79 20 29 20 6f cell- 0 .key ) o
7430: 20 6f 3e 0a 20 20 20 20 69 6d 70 6f 72 74 23 6e o>. import#n
7440: 65 77 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 ew import-type !
7450: 20 3b 0a 0a 3a 20 72 65 6e 65 77 2d 6b 65 79 20 ;..: renew-key
7460: 28 20 72 65 76 61 64 64 72 20 75 31 20 6b 65 79 ( revaddr u1 key
7470: 61 64 64 72 20 75 32 20 2d 2d 20 6f 20 29 0a 20 addr u2 -- o ).
7480: 20 20 20 63 75 72 72 65 6e 74 2d 6b 65 79 20 3e current-key >
7490: 6f 20 72 65 70 6c 61 63 65 2d 6b 65 79 20 6f 3e o replace-key o>
74a0: 0a 20 20 20 20 3e 6f 20 73 6b 63 20 6b 65 79 73 . >o skc keys
74b0: 69 7a 65 20 6b 65 2d 73 6b 20 73 65 63 21 20 6f ize ke-sk sec! o
74c0: 20 6f 3e 20 3b 0a 0a 5c 20 67 65 6e 65 72 61 74 o> ;..\ generat
74d0: 65 20 6e 65 77 20 6b 65 79 0a 0a 3a 20 6f 75 74 e new key..: out
74e0: 2d 6b 65 79 20 28 20 6f 20 2d 2d 20 29 0a 20 20 -key ( o -- ).
74f0: 20 20 3e 6f 20 70 61 63 6b 2d 6f 75 74 6b 65 79 >o pack-outkey
7500: 20 5b 27 5d 20 2e 6e 69 63 6b 2d 62 61 73 65 20 ['] .nick-base
7510: 24 74 6d 70 20 66 6e 2d 73 61 6e 69 74 69 7a 65 $tmp fn-sanitize
7520: 20 6f 3e 0a 20 20 20 20 5b 3a 20 2e 22 20 7e 2f o>. [: ." ~/
7530: 22 20 74 79 70 65 20 2e 22 20 2e 6e 32 6f 22 20 " type ." .n2o"
7540: 3b 5d 20 24 74 6d 70 20 77 2f 6f 20 63 72 65 61 ;] $tmp w/o crea
7550: 74 65 2d 66 69 6c 65 20 74 68 72 6f 77 0a 20 20 te-file throw.
7560: 20 20 3e 72 20 63 6d 64 62 75 66 24 20 72 40 20 >r cmdbuf$ r@
7570: 77 72 69 74 65 2d 66 69 6c 65 20 74 68 72 6f 77 write-file throw
7580: 20 72 3e 20 63 6c 6f 73 65 2d 66 69 6c 65 20 74 r> close-file t
7590: 68 72 6f 77 20 3b 0a 3a 20 6f 75 74 2d 6d 65 20 hrow ;.: out-me
75a0: 28 20 2d 2d 20 29 0a 20 20 20 20 70 6b 63 20 6b ( -- ). pkc k
75b0: 65 79 73 69 7a 65 20 6b 65 79 23 20 23 40 20 30 eysize key# #@ 0
75c0: 3d 20 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 = !!unknown-key!
75d0: 21 0a 20 20 20 20 63 65 6c 6c 2b 20 6f 75 74 2d !. cell+ out-
75e0: 6b 65 79 20 3b 0a 0a 56 61 72 69 61 62 6c 65 20 key ;..Variable
75f0: 64 68 74 72 6f 6f 74 2e 6e 32 6f 0a 0a 3a 20 2b dhtroot.n2o..: +
7600: 64 68 74 72 6f 6f 74 20 28 20 2d 2d 20 29 0a 20 dhtroot ( -- ).
7610: 20 20 20 64 65 66 61 75 6c 74 6b 65 79 20 40 20 defaultkey @
7620: 3e 73 74 6f 72 65 6b 65 79 20 21 0a 20 20 20 20 >storekey !.
7630: 69 6d 70 6f 72 74 23 6d 61 6e 75 61 6c 20 69 6d import#manual im
7640: 70 6f 72 74 2d 74 79 70 65 20 21 20 20 36 34 23 port-type ! 64#
7650: 2d 31 20 6b 65 79 2d 72 65 61 64 2d 6f 66 66 73 -1 key-read-offs
7660: 65 74 20 36 34 21 0a 20 20 20 20 64 68 74 72 6f et 64!. dhtro
7670: 6f 74 2e 6e 32 6f 20 24 40 20 64 6f 2d 6b 65 79 ot.n2o $@ do-key
7680: 0a 20 20 20 20 6c 61 73 74 2d 6b 65 79 20 3e 6f . last-key >o
7690: 20 22 5c 78 30 32 22 20 6b 65 2d 67 72 6f 75 70 "\x02" ke-group
76a0: 73 20 24 21 20 70 65 72 6d 25 64 68 74 72 6f 6f s $! perm%dhtroo
76b0: 74 20 6b 65 2d 6d 61 73 6b 20 21 20 6f 3e 0a 20 t ke-mask ! o>.
76c0: 20 20 20 69 6d 70 6f 72 74 23 6e 65 77 20 69 6d import#new im
76d0: 70 6f 72 74 2d 74 79 70 65 20 21 20 3b 0a 0a 3a port-type ! ;..:
76e0: 20 6e 65 77 2d 6b 65 79 20 28 20 6e 69 63 6b 61 new-key ( nicka
76f0: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 3f ddr u -- ). ?
7700: 63 68 65 63 6b 2d 72 6e 67 20 5c 20 62 65 66 6f check-rng \ befo
7710: 72 65 20 67 65 6e 65 72 61 74 69 6e 67 20 61 20 re generating a
7720: 6b 65 79 2c 20 63 68 65 63 6b 20 74 68 65 20 72 key, check the r
7730: 6e 67 20 66 6f 72 20 68 65 61 6c 74 68 0a 20 20 ng for health.
7740: 20 20 2b 6e 65 77 70 68 72 61 73 65 20 6b 65 79 +newphrase key
7750: 3e 64 65 66 61 75 6c 74 0a 20 20 20 20 6b 65 79 >default. key
7760: 23 75 73 65 72 20 2b 67 65 6e 2d 6b 65 79 73 0a #user +gen-keys.
7770: 20 20 20 20 73 65 63 72 65 74 2d 6b 65 79 73 23 secret-keys#
7780: 20 31 2d 20 73 65 63 72 65 74 2d 6b 65 79 20 3e 1- secret-key >
7790: 72 61 77 2d 6b 65 79 20 20 6c 61 73 74 6b 65 79 raw-key lastkey
77a0: 40 20 64 72 6f 70 20 64 65 66 61 75 6c 74 6b 65 @ drop defaultke
77b0: 79 20 21 0a 20 20 20 20 6f 75 74 2d 6d 65 20 2b y !. out-me +
77c0: 64 68 74 72 6f 6f 74 20 73 61 76 65 2d 6b 65 79 dhtroot save-key
77d0: 73 20 3b 0a 0a 5c 20 72 65 76 6f 6b 61 74 69 6f s ;..\ revokatio
77e0: 6e 0a 0a 34 20 64 61 74 65 73 69 7a 65 23 20 2b n..4 datesize# +
77f0: 20 6b 65 79 73 69 7a 65 20 39 20 2a 20 2b 20 43 keysize 9 * + C
7800: 6f 6e 73 74 61 6e 74 20 72 65 76 73 69 7a 65 23 onstant revsize#
7810: 0a 0a 56 61 72 69 61 62 6c 65 20 72 65 76 74 6f ..Variable revto
7820: 6b 65 6e 0a 0a 3a 20 30 6f 6c 64 6b 65 79 20 28 ken..: 0oldkey (
7830: 20 2d 2d 20 29 20 5c 20 70 75 62 6b 65 79 73 20 -- ) \ pubkeys
7840: 63 61 6e 20 73 74 61 79 0a 20 20 20 20 6f 6c 64 can stay. old
7850: 73 6b 63 20 6b 65 79 73 69 7a 65 20 65 72 61 73 skc keysize eras
7860: 65 20 20 6f 6c 64 73 6b 72 65 76 20 6b 65 79 73 e oldskrev keys
7870: 69 7a 65 20 65 72 61 73 65 20 3b 0a 0a 3a 20 6b ize erase ;..: k
7880: 65 79 6d 6f 76 65 20 28 20 61 64 64 72 31 20 61 eymove ( addr1 a
7890: 64 64 72 32 20 2d 2d 20 29 20 20 6b 65 79 73 69 ddr2 -- ) keysi
78a0: 7a 65 20 6d 6f 76 65 20 3b 0a 0a 3a 20 72 65 76 ze move ;..: rev
78b0: 6f 6b 65 2d 76 65 72 69 66 79 20 28 20 61 64 64 oke-verify ( add
78c0: 72 20 75 31 20 70 6b 20 73 74 72 69 6e 67 20 75 r u1 pk string u
78d0: 32 20 2d 2d 20 61 64 64 72 20 75 20 66 6c 61 67 2 -- addr u flag
78e0: 20 29 20 72 6f 74 20 3e 72 20 32 3e 72 20 63 3a ) rot >r 2>r c:
78f0: 30 6b 65 79 0a 20 20 20 20 73 69 67 6f 6e 6c 79 0key. sigonly
7900: 73 69 7a 65 23 20 2d 20 32 64 75 70 20 32 72 3e size# - 2dup 2r>
7910: 20 3e 6b 65 79 65 64 2d 68 61 73 68 0a 20 20 20 >keyed-hash.
7920: 20 73 69 67 64 61 74 65 20 2b 64 61 74 65 0a 20 sigdate +date.
7930: 20 20 20 32 64 75 70 20 2b 20 72 3e 20 65 64 2d 2dup + r> ed-
7940: 76 65 72 69 66 79 20 3b 0a 0a 3a 20 3e 72 65 76 verify ;..: >rev
7950: 6f 6b 65 20 28 20 73 6b 72 65 76 20 2d 2d 20 29 oke ( skrev -- )
7960: 20 20 73 6b 72 65 76 20 6b 65 79 6d 6f 76 65 20 skrev keymove
7970: 20 70 6b 63 20 63 68 65 63 6b 2d 72 65 76 3f 20 pkc check-rev?
7980: 30 3d 20 21 21 6e 6f 74 2d 6d 79 2d 72 65 76 73 0= !!not-my-revs
7990: 6b 21 21 20 3b 0a 0a 3a 20 2b 72 65 76 73 69 67 k!! ;..: +revsig
79a0: 6e 20 28 20 73 6b 20 70 6b 20 2d 2d 20 29 20 20 n ( sk pk -- )
79b0: 73 6b 73 69 67 20 2d 72 6f 74 20 65 64 2d 73 69 sksig -rot ed-si
79c0: 67 6e 20 72 65 76 74 6f 6b 65 6e 20 24 2b 21 20 gn revtoken $+!
79d0: 62 6c 20 72 65 76 74 6f 6b 65 6e 20 63 24 2b 21 bl revtoken c$+!
79e0: 20 3b 0a 0a 3a 20 73 69 67 6e 2d 74 6f 6b 65 6e ;..: sign-token
79f0: 2c 20 28 20 73 6b 20 70 6b 20 73 74 72 69 6e 67 , ( sk pk string
7a00: 20 75 32 20 2d 2d 20 29 0a 20 20 20 20 63 3a 30 u2 -- ). c:0
7a10: 6b 65 79 20 72 65 76 74 6f 6b 65 6e 20 24 40 20 key revtoken $@
7a20: 32 73 77 61 70 20 3e 6b 65 79 65 64 2d 68 61 73 2swap >keyed-has
7a30: 68 0a 20 20 20 20 73 69 67 64 61 74 65 20 2b 64 h. sigdate +d
7a40: 61 74 65 20 2b 72 65 76 73 69 67 6e 20 3b 0a 0a ate +revsign ;..
7a50: 3a 20 72 65 76 6f 6b 65 2d 6b 65 79 20 28 20 2d : revoke-key ( -
7a60: 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 73 - addr u ). s
7a70: 6b 63 20 6f 6c 64 73 6b 63 20 6b 65 79 6d 6f 76 kc oldskc keymov
7a80: 65 20 20 70 6b 63 20 6f 6c 64 70 6b 63 20 6b 65 e pkc oldpkc ke
7a90: 79 6d 6f 76 65 20 20 73 6b 72 65 76 20 6f 6c 64 ymove skrev old
7aa0: 73 6b 72 65 76 20 6b 65 79 6d 6f 76 65 0a 20 20 skrev keymove.
7ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ad0: 20 20 20 20 20 20 20 20 20 5c 20 62 61 63 6b 75 \ backu
7ae0: 70 20 6b 65 79 73 0a 20 20 20 20 6f 6c 64 73 6b p keys. oldsk
7af0: 72 65 76 20 6f 6c 64 70 6b 72 65 76 20 73 6b 3e rev oldpkrev sk>
7b00: 70 6b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 pk
7b10: 20 20 5c 20 67 65 6e 65 72 61 74 65 20 72 65 76 \ generate rev
7b20: 6f 6b 61 74 69 6f 6e 20 70 75 62 6b 65 79 0a 20 okation pubkey.
7b30: 20 20 20 67 65 6e 2d 6b 65 79 73 20 20 20 20 20 gen-keys
7b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b50: 20 20 20 20 20 20 20 20 20 20 5c 20 67 65 6e 65 \ gene
7b60: 72 61 74 65 20 6e 65 77 20 6b 65 79 73 0a 20 20 rate new keys.
7b70: 20 20 70 6b 63 20 6b 65 79 73 69 7a 65 32 20 72 pkc keysize2 r
7b80: 65 76 74 6f 6b 65 6e 20 24 21 20 20 20 20 20 20 evtoken $!
7b90: 20 20 20 20 20 20 20 20 20 5c 20 6d 79 20 6e 65 \ my ne
7ba0: 77 20 6b 65 79 0a 20 20 20 20 6f 6c 64 70 6b 72 w key. oldpkr
7bb0: 65 76 20 6b 65 79 73 69 7a 65 20 72 65 76 74 6f ev keysize revto
7bc0: 6b 65 6e 20 24 2b 21 20 20 20 20 20 20 20 20 20 ken $+!
7bd0: 20 5c 20 72 65 76 6f 6b 65 20 74 6f 6b 65 6e 0a \ revoke token.
7be0: 20 20 20 20 6f 6c 64 73 6b 72 65 76 20 6f 6c 64 oldskrev old
7bf0: 70 6b 72 65 76 20 22 72 65 76 6f 6b 65 22 20 73 pkrev "revoke" s
7c00: 69 67 6e 2d 74 6f 6b 65 6e 2c 20 5c 20 72 65 76 ign-token, \ rev
7c10: 6f 6b 65 20 73 69 67 6e 61 74 75 72 65 0a 20 20 oke signature.
7c20: 20 20 73 6b 63 20 70 6b 63 20 22 73 65 6c 66 73 skc pkc "selfs
7c30: 69 67 6e 22 20 73 69 67 6e 2d 74 6f 6b 65 6e 2c ign" sign-token,
7c40: 20 20 20 20 20 20 20 20 20 5c 20 73 65 6c 66 20 \ self
7c50: 73 69 67 6e 65 64 20 77 69 74 68 20 6e 65 77 20 signed with new
7c60: 6b 65 79 0a 20 20 20 20 22 21 22 20 72 65 76 74 key. "!" revt
7c70: 6f 6b 65 6e 20 30 20 24 69 6e 73 20 20 20 20 20 oken 0 $ins
7c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5c \
7c90: 20 22 21 22 20 2b 20 6f 6c 64 6b 65 79 6c 65 6e "!" + oldkeylen
7ca0: 2b 6e 65 77 6b 65 79 6c 65 6e 20 74 6f 20 66 6c +newkeylen to fl
7cb0: 61 67 20 72 65 76 6f 6b 61 74 69 6f 6e 0a 20 20 ag revokation.
7cc0: 20 20 72 65 76 74 6f 6b 65 6e 20 24 40 20 67 65 revtoken $@ ge
7cd0: 6e 3e 68 6f 73 74 20 32 64 72 6f 70 20 20 20 20 n>host 2drop
7ce0: 20 20 20 20 20 20 20 20 20 5c 20 73 69 67 6e 20 \ sign
7cf0: 68 6f 73 74 20 69 6e 66 6f 72 6d 61 74 69 6f 6e host information
7d00: 20 77 69 74 68 20 6f 6c 64 20 6b 65 79 0a 20 20 with old key.
7d10: 20 20 73 69 67 64 61 74 65 20 2b 64 61 74 65 20 sigdate +date
7d20: 73 69 67 64 61 74 65 20 64 61 74 65 73 69 7a 65 sigdate datesize
7d30: 23 20 72 65 76 74 6f 6b 65 6e 20 24 2b 21 0a 20 # revtoken $+!.
7d40: 20 20 20 6f 6c 64 73 6b 63 20 6f 6c 64 70 6b 63 oldskc oldpkc
7d50: 20 2b 72 65 76 73 69 67 6e 0a 20 20 20 20 30 6f +revsign. 0o
7d60: 6c 64 6b 65 79 20 72 65 76 74 6f 6b 65 6e 20 24 ldkey revtoken $
7d70: 40 20 3b 0a 0a 5c 20 69 6e 76 69 74 61 74 69 6f @ ;..\ invitatio
7d80: 6e 0a 0a 56 61 72 69 61 62 6c 65 20 69 6e 76 69 n..Variable invi
7d90: 74 61 74 69 6f 6e 73 0a 0a 65 76 65 6e 74 3a 20 tations..event:
7da0: 2d 3e 69 6e 76 69 74 65 20 28 20 61 64 64 72 20 ->invite ( addr
7db0: 75 20 2d 2d 20 29 0a 20 20 20 20 2e 22 20 69 6e u -- ). ." in
7dc0: 76 69 74 65 20 6d 65 3a 20 22 20 6f 76 65 72 20 vite me: " over
7dd0: 3e 72 20 2e 70 6b 32 6b 65 79 24 20 63 72 20 72 >r .pk2key$ cr r
7de0: 3e 20 66 72 65 65 20 74 68 72 6f 77 20 63 74 72 > free throw ctr
7df0: 6c 20 4c 20 69 6e 73 6b 65 79 20 3b 0a 65 76 65 l L inskey ;.eve
7e00: 6e 74 3a 20 2d 3e 77 61 6b 65 6d 65 20 28 20 6f nt: ->wakeme ( o
7e10: 20 2d 2d 20 29 20 3c 65 76 65 6e 74 20 2d 3e 77 -- ) <event ->w
7e20: 61 6b 65 20 65 76 65 6e 74 3e 20 3b 0a 0a 3a 20 ake event> ;..:
7e30: 70 6b 32 6b 65 79 24 2d 61 64 64 20 28 20 61 64 pk2key$-add ( ad
7e40: 64 72 20 75 20 70 65 72 6d 20 2d 2d 20 29 20 7b dr u perm -- ) {
7e50: 20 70 65 72 6d 20 7d 0a 20 20 20 20 73 61 6d 70 perm }. samp
7e60: 6c 65 2d 6b 65 79 20 3e 6f 20 69 6d 70 6f 72 74 le-key >o import
7e70: 23 69 6e 76 69 74 65 64 20 69 6d 70 6f 72 74 2d #invited import-
7e80: 74 79 70 65 20 21 20 63 6d 64 3a 6e 65 73 74 73 type ! cmd:nests
7e90: 69 67 0a 20 20 20 20 70 65 72 6d 20 6b 65 2d 6d ig. perm ke-m
7ea0: 61 73 6b 20 21 0a 20 20 20 20 69 6d 70 6f 72 74 ask !. import
7eb0: 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 79 70 65 #new import-type
7ec0: 20 21 20 20 73 61 76 65 2d 70 75 62 6b 65 79 73 ! save-pubkeys
7ed0: 20 6f 3e 20 3b 0a 0a 3a 20 78 2d 65 72 61 73 65 o> ;..: x-erase
7ee0: 20 28 20 6c 65 6e 20 2d 2d 20 29 0a 20 20 20 20 ( len -- ).
7ef0: 64 75 70 20 78 62 61 63 6b 2d 72 65 73 74 6f 72 dup xback-restor
7f00: 65 20 20 64 75 70 20 73 70 61 63 65 73 20 20 78 e dup spaces x
7f10: 62 61 63 6b 2d 72 65 73 74 6f 72 65 20 3b 0a 0a back-restore ;..
7f20: 3a 20 69 6e 76 69 74 65 2d 6b 65 79 20 28 20 61 : invite-key ( a
7f30: 64 64 72 20 75 20 2d 2d 20 6b 65 79 20 29 0a 20 ddr u -- key ).
7f40: 20 20 20 32 64 75 70 20 78 2d 77 69 64 74 68 20 2dup x-width
7f50: 7b 20 61 64 64 72 20 75 20 6c 65 6e 20 7d 0a 20 { addr u len }.
7f60: 20 20 20 42 45 47 49 4e 20 20 61 64 64 72 20 75 BEGIN addr u
7f70: 20 74 79 70 65 20 6b 65 79 20 20 6c 65 6e 20 78 type key len x
7f80: 2d 65 72 61 73 65 0a 09 64 75 70 20 63 74 72 6c -erase..dup ctrl
7f90: 20 5a 20 3d 0a 20 20 20 20 57 48 49 4c 45 20 20 Z =. WHILE
7fa0: 64 72 6f 70 20 20 42 45 47 49 4e 20 20 6b 65 79 drop BEGIN key
7fb0: 20 63 74 72 6c 20 4c 20 3d 20 20 55 4e 54 49 4c ctrl L = UNTIL
7fc0: 20 20 52 45 50 45 41 54 20 3b 0a 0a 3a 20 70 72 REPEAT ;..: pr
7fd0: 6f 63 65 73 73 2d 69 6e 76 69 74 61 74 69 6f 6e ocess-invitation
7fe0: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 ( addr u -- ).
7ff0: 20 20 20 73 22 20 69 6e 76 69 74 65 20 28 79 2f s" invite (y/
8000: 6e 2f 62 29 3f 22 20 69 6e 76 69 74 65 2d 6b 65 n/b)?" invite-ke
8010: 79 0a 20 20 20 20 63 61 73 65 0a 09 27 79 27 20 y. case..'y'
8020: 6f 66 20 20 70 65 72 6d 25 64 65 66 61 75 6c 74 of perm%default
8030: 20 70 6b 32 6b 65 79 24 2d 61 64 64 20 20 2e 22 pk2key$-add ."
8040: 20 61 64 64 65 64 22 20 63 72 20 20 20 65 6e 64 added" cr end
8050: 6f 66 0a 09 27 62 27 20 6f 66 20 20 70 65 72 6d of..'b' of perm
8060: 25 62 6c 6f 63 6b 65 64 20 70 6b 32 6b 65 79 24 %blocked pk2key$
8070: 2d 61 64 64 20 20 2e 22 20 62 6c 6f 63 6b 65 64 -add ." blocked
8080: 22 20 63 72 20 65 6e 64 6f 66 0a 09 32 64 72 6f " cr endof..2dro
8090: 70 20 2e 22 20 69 67 6e 6f 72 65 64 22 20 63 72 p ." ignored" cr
80a0: 0a 20 20 20 20 65 6e 64 63 61 73 65 20 3b 0a 0a . endcase ;..
80b0: 3a 20 66 69 6c 74 65 72 2d 69 6e 76 69 74 61 74 : filter-invitat
80c0: 69 6f 6e 3f 20 28 20 61 64 64 72 20 75 20 2d 2d ion? ( addr u --
80d0: 20 66 6c 61 67 20 29 0a 20 20 20 20 73 69 67 70 flag ). sigp
80e0: 6b 32 73 69 7a 65 23 20 2d 20 2b 20 6b 65 79 73 k2size# - + keys
80f0: 69 7a 65 20 6b 65 79 23 20 23 40 20 64 30 3c 3e ize key# #@ d0<>
8100: 20 3b 20 5c 20 61 6c 72 65 61 64 79 20 74 68 65 ; \ already the
8110: 72 65 0a 0a 3a 20 2e 69 6e 76 69 74 61 74 69 6f re..: .invitatio
8120: 6e 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 69 6e ns ( -- ). in
8130: 76 69 74 61 74 69 6f 6e 73 20 5b 3a 20 32 64 75 vitations [: 2du
8140: 70 20 2e 70 6b 32 6b 65 79 24 20 63 72 20 70 72 p .pk2key$ cr pr
8150: 6f 63 65 73 73 2d 69 6e 76 69 74 61 74 69 6f 6e ocess-invitation
8160: 20 3b 5d 20 24 5b 5d 6d 61 70 0a 20 20 20 20 69 ;] $[]map. i
8170: 6e 76 69 74 61 74 69 6f 6e 73 20 24 5b 5d 6f 66 nvitations $[]of
8180: 66 20 3b 0a 0a 3a 20 3e 69 6e 76 69 74 61 74 69 f ;..: >invitati
8190: 6f 6e 73 20 28 20 61 64 64 72 20 75 20 2d 2d 20 ons ( addr u --
81a0: 29 0a 20 20 20 20 32 64 75 70 20 66 69 6c 74 65 ). 2dup filte
81b0: 72 2d 69 6e 76 69 74 61 74 69 6f 6e 3f 20 49 46 r-invitation? IF
81c0: 20 20 32 64 72 6f 70 20 45 58 49 54 20 20 54 48 2drop EXIT TH
81d0: 45 4e 0a 20 20 20 20 69 6e 76 69 74 61 74 69 6f EN. invitatio
81e0: 6e 73 20 24 5b 5d 23 20 3e 72 0a 20 20 20 20 32 ns $[]# >r. 2
81f0: 64 75 70 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 dup invitations
8200: 24 69 6e 73 5b 5d 73 69 67 20 64 72 6f 70 0a 20 $ins[]sig drop.
8210: 20 20 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 24 invitations $
8220: 5b 5d 23 20 72 3e 20 3c 3e 20 49 46 0a 09 73 61 []# r> <> IF..sa
8230: 76 65 2d 6d 65 6d 20 6d 61 69 6e 2d 75 70 40 20 ve-mem main-up@
8240: 3c 68 69 64 65 3e 0a 09 3c 65 76 65 6e 74 20 65 <hide>..<event e
8250: 24 2c 20 2d 3e 69 6e 76 69 74 65 20 75 70 40 20 $, ->invite up@
8260: 65 6c 69 74 2c 20 2d 3e 77 61 6b 65 6d 65 20 6d elit, ->wakeme m
8270: 61 69 6e 2d 75 70 40 20 65 76 65 6e 74 3e 20 73 ain-up@ event> s
8280: 74 6f 70 0a 20 20 20 20 45 4c 53 45 20 20 32 64 top. ELSE 2d
8290: 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 73 rop THEN ;..: s
82a0: 65 6e 64 2d 69 6e 76 69 74 61 74 69 6f 6e 20 28 end-invitation (
82b0: 20 70 6b 20 75 20 2d 2d 20 29 0a 20 20 20 20 73 pk u -- ). s
82c0: 65 74 75 70 21 20 6d 79 70 6b 32 6e 69 63 6b 24 etup! mypk2nick$
82d0: 20 32 3e 72 0a 20 20 20 20 67 65 6e 2d 74 6d 70 2>r. gen-tmp
82e0: 6b 65 79 73 20 64 72 6f 70 20 74 73 6b 63 20 73 keys drop tskc s
82f0: 77 61 70 20 6b 65 79 70 61 64 20 65 64 2d 64 68 wap keypad ed-dh
8300: 20 64 6f 2d 6b 65 79 70 61 64 20 73 65 63 21 0a do-keypad sec!.
8310: 20 20 20 20 6e 65 74 32 6f 2d 63 6f 64 65 30 0a net2o-code0.
8320: 20 20 20 20 74 70 6b 63 20 6b 65 79 73 69 7a 65 tpkc keysize
8330: 20 24 2c 20 6f 6e 65 73 68 6f 74 2d 74 6d 70 6b $, oneshot-tmpk
8340: 65 79 0a 20 20 20 20 6e 65 73 74 5b 20 32 72 3e ey. nest[ 2r>
8350: 20 24 2c 20 69 6e 76 69 74 65 20 5d 74 6d 70 6e $, invite ]tmpn
8360: 65 73 74 0a 20 20 20 20 63 6f 6f 6b 69 65 2b 72 est. cookie+r
8370: 65 71 75 65 73 74 0a 20 20 20 20 65 6e 64 2d 63 equest. end-c
8380: 6f 64 65 7c 20 3b 0a 0a 5c 20 6b 65 79 20 61 70 ode| ;..\ key ap
8390: 69 20 68 65 6c 70 65 72 73 0a 0a 3a 20 64 65 6c i helpers..: del
83a0: 2d 6c 61 73 74 2d 6b 65 79 20 28 20 2d 2d 20 29 -last-key ( -- )
83b0: 0a 20 20 20 20 6b 65 79 73 20 24 5b 5d 23 20 31 . keys $[]# 1
83c0: 2d 20 6b 65 79 73 20 24 5b 5d 20 73 65 63 2d 6f - keys $[] sec-o
83d0: 66 66 0a 20 20 20 20 6b 65 79 73 20 24 40 6c 65 ff. keys $@le
83e0: 6e 20 63 65 6c 6c 2d 20 6b 65 79 73 20 24 21 6c n cell- keys $!l
83f0: 65 6e 20 3b 0a 0a 3a 20 73 74 6f 72 65 6b 65 79 en ;..: storekey
8400: 21 20 28 20 2d 2d 20 29 0a 20 20 20 20 3e 73 65 ! ( -- ). >se
8410: 63 6b 65 79 20 6b 65 79 73 20 24 5b 5d 23 20 30 ckey keys $[]# 0
8420: 20 3f 44 4f 20 20 32 64 75 70 20 49 20 6b 65 79 ?DO 2dup I key
8430: 73 20 73 65 63 5b 5d 40 20 73 74 72 3d 20 49 46 s sec[]@ str= IF
8440: 0a 09 20 20 20 20 49 20 6b 65 79 73 20 73 65 63 .. I keys sec
8450: 5b 5d 40 20 64 72 6f 70 20 3e 73 74 6f 72 65 6b []@ drop >storek
8460: 65 79 20 21 20 20 4c 45 41 56 45 20 20 54 48 45 ey ! LEAVE THE
8470: 4e 20 20 4c 4f 4f 50 20 20 32 64 72 6f 70 20 3b N LOOP 2drop ;
8480: 0a 0a 3a 20 63 68 6f 6f 73 65 2d 6b 65 79 20 28 ..: choose-key (
8490: 20 2d 2d 20 6f 20 29 0a 20 20 20 20 30 20 42 45 -- o ). 0 BE
84a0: 47 49 4e 20 20 64 72 6f 70 0a 09 2e 22 20 43 68 GIN drop..." Ch
84b0: 6f 6f 73 65 20 6b 65 79 20 62 79 20 6e 75 6d 62 oose key by numb
84c0: 65 72 3a 22 20 63 72 20 2e 73 65 63 72 65 74 2d er:" cr .secret-
84d0: 6e 69 63 6b 73 0a 09 42 45 47 49 4e 20 20 6b 65 nicks..BEGIN ke
84e0: 79 20 64 75 70 20 62 6c 20 3c 20 57 48 49 4c 45 y dup bl < WHILE
84f0: 20 20 64 72 6f 70 20 20 52 45 50 45 41 54 20 5c drop REPEAT \
8500: 20 73 77 61 6c 6c 6f 77 20 63 6f 6e 74 72 6f 6c swallow control
8510: 20 6b 65 79 73 0a 09 5b 27 5d 20 64 69 67 69 74 keys..['] digit
8520: 3f 20 23 33 36 20 62 61 73 65 2d 65 78 65 63 75 ? #36 base-execu
8530: 74 65 20 30 3d 20 49 46 20 2d 31 20 54 48 45 4e te 0= IF -1 THEN
8540: 0a 09 73 65 63 72 65 74 2d 6b 65 79 20 64 75 70 ..secret-key dup
8550: 20 30 3d 20 57 48 49 4c 45 0a 09 20 20 20 20 2e 0= WHILE.. .
8560: 22 20 50 6c 65 61 73 65 20 65 6e 74 65 72 20 61 " Please enter a
8570: 20 62 61 73 65 2d 33 36 20 6e 75 6d 62 65 72 20 base-36 number
8580: 62 65 74 77 65 65 6e 20 30 20 61 6e 64 20 22 0a between 0 and ".
8590: 09 20 20 20 20 73 65 63 72 65 74 2d 6b 65 79 73 . secret-keys
85a0: 23 20 31 2d 20 5b 27 5d 20 2e 20 23 33 36 20 62 # 1- ['] . #36 b
85b0: 61 73 65 2d 65 78 65 63 75 74 65 20 63 72 20 20 ase-execute cr
85c0: 72 64 72 6f 70 0a 20 20 20 20 52 45 50 45 41 54 rdrop. REPEAT
85d0: 0a 20 20 20 20 64 75 70 20 2e 73 74 6f 72 65 6b . dup .storek
85e0: 65 79 21 20 20 3e 73 74 6f 72 65 6b 65 79 20 40 ey! >storekey @
85f0: 20 64 65 66 61 75 6c 74 6b 65 79 20 21 0a 20 20 defaultkey !.
8600: 20 20 2e 22 20 3d 3d 3d 3d 20 6b 65 79 20 22 20 ." ==== key "
8610: 64 75 70 20 2e 2e 6e 69 63 6b 20 2e 22 20 20 63 dup ..nick ." c
8620: 68 6f 73 65 6e 20 3d 3d 3d 3d 22 20 63 72 20 3b hosen ====" cr ;
8630: 0a 0a 5c 20 77 69 6c 6c 20 61 73 6b 20 66 6f 72 ..\ will ask for
8640: 20 79 6f 75 72 20 70 61 73 73 77 6f 72 64 20 61 your password a
8650: 6e 64 20 69 66 20 70 6f 73 73 69 62 6c 65 20 61 nd if possible a
8660: 75 74 6f 2d 73 65 6c 65 63 74 20 79 6f 75 72 20 uto-select your
8670: 69 64 0a 0a 56 61 72 69 61 62 6c 65 20 74 72 69 id..Variable tri
8680: 65 73 23 0a 23 31 30 20 56 61 6c 75 65 20 6d 61 es#.#10 Value ma
8690: 78 74 72 69 65 73 23 0a 0a 3a 20 67 65 74 2d 73 xtries#..: get-s
86a0: 6b 63 20 28 20 2d 2d 20 29 0a 20 20 20 20 73 65 kc ( -- ). se
86b0: 63 72 65 74 2d 6b 65 79 73 23 20 3f 45 58 49 54 cret-keys# ?EXIT
86c0: 20 20 74 72 69 65 73 23 20 6f 66 66 0a 20 20 20 tries# off.
86d0: 20 64 65 62 75 67 2d 76 65 63 74 6f 72 20 40 20 debug-vector @
86e0: 6f 70 2d 76 65 63 74 6f 72 20 21 40 20 3e 72 20 op-vector !@ >r
86f0: 3c 64 65 66 61 75 6c 74 3e 0a 20 20 20 20 73 65 <default>. se
8700: 63 72 65 74 2d 6b 65 79 73 23 0a 20 20 20 20 42 cret-keys#. B
8710: 45 47 49 4e 20 20 64 75 70 20 30 3d 20 74 72 69 EGIN dup 0= tri
8720: 65 73 23 20 40 20 6d 61 78 74 72 69 65 73 23 20 es# @ maxtries#
8730: 75 3c 20 61 6e 64 20 20 57 48 49 4c 45 20 64 72 u< and WHILE dr
8740: 6f 70 0a 09 20 20 20 20 73 22 20 50 61 73 73 70 op.. s" Passp
8750: 68 72 61 73 65 3a 20 22 20 2b 70 61 73 73 70 68 hrase: " +passph
8760: 72 61 73 65 20 20 20 21 74 69 6d 65 0a 09 20 20 rase !time..
8770: 20 20 72 65 61 64 2d 6b 65 79 73 20 73 65 63 72 read-keys secr
8780: 65 74 2d 6b 65 79 73 23 20 64 75 70 20 30 3d 20 et-keys# dup 0=
8790: 49 46 0a 09 09 5c 20 66 61 69 6c 20 72 69 67 68 IF...\ fail righ
87a0: 74 20 61 66 74 65 72 20 74 68 65 20 66 69 72 73 t after the firs
87b0: 74 20 74 72 79 20 69 66 20 50 41 53 53 50 48 52 t try if PASSPHR
87c0: 41 53 45 20 69 73 20 75 73 65 64 0a 09 09 5c 20 ASE is used...\
87d0: 61 6e 64 20 67 69 76 65 20 74 68 65 20 6d 61 78 and give the max
87e0: 69 6d 75 6d 20 77 61 69 74 69 6e 67 20 70 65 6e imum waiting pen
87f0: 61 6c 74 79 20 69 6e 20 74 68 61 74 20 63 61 73 alty in that cas
8800: 65 0a 09 09 31 20 6d 61 78 74 72 69 65 73 23 20 e...1 maxtries#
8810: 73 22 20 50 41 53 53 50 48 52 41 53 45 22 20 67 s" PASSPHRASE" g
8820: 65 74 65 6e 76 20 64 30 3d 20 73 65 6c 65 63 74 etenv d0= select
8830: 20 74 72 69 65 73 23 20 2b 21 0a 09 09 3c 65 72 tries# +!...<er
8840: 72 3e 20 2e 22 20 54 72 79 23 20 22 20 74 72 69 r> ." Try# " tri
8850: 65 73 23 20 40 20 30 20 2e 72 20 27 2f 27 20 65 es# @ 0 .r '/' e
8860: 6d 69 74 20 6d 61 78 74 72 69 65 73 23 20 2e 0a mit maxtries# ..
8870: 09 09 2e 22 20 66 61 69 6c 65 64 2c 20 6e 6f 20 ..." failed, no
8880: 6b 65 79 20 66 6f 75 6e 64 2c 20 77 61 69 74 69 key found, waiti
8890: 6e 67 20 22 0a 09 09 23 31 20 74 72 69 65 73 23 ng "...#1 tries#
88a0: 20 40 20 32 2a 20 6c 73 68 69 66 74 20 64 75 70 @ 2* lshift dup
88b0: 20 2e 20 2e 22 20 6d 73 2e 2e 2e 22 20 6d 73 20 . ." ms..." ms
88c0: 20 3c 64 65 66 61 75 6c 74 3e 20 63 72 0a 09 09 <default> cr...
88d0: 64 65 6c 2d 6c 61 73 74 2d 6b 65 79 0a 09 20 20 del-last-key..
88e0: 20 20 54 48 45 4e 0a 20 20 20 20 52 45 50 45 41 THEN. REPEA
88f0: 54 0a 20 20 20 20 64 75 70 20 30 3d 20 49 46 20 T. dup 0= IF
8900: 20 23 2d 35 36 20 74 68 72 6f 77 20 20 54 48 45 #-56 throw THE
8910: 4e 0a 20 20 20 20 31 20 3d 20 49 46 20 20 30 20 N. 1 = IF 0
8920: 73 65 63 72 65 74 2d 6b 65 79 0a 09 2e 22 20 3d secret-key..." =
8930: 3d 3d 3d 20 6f 70 65 6e 65 64 3a 20 22 20 64 75 === opened: " du
8940: 70 20 2e 2e 6e 69 63 6b 20 2e 22 20 20 69 6e 20 p ..nick ." in
8950: 22 20 2e 74 69 6d 65 20 2e 22 20 3d 3d 3d 3d 22 " .time ." ===="
8960: 20 63 72 0a 20 20 20 20 45 4c 53 45 20 20 2e 22 cr. ELSE ."
8970: 20 3d 3d 3d 3d 20 6f 70 65 6e 65 64 20 69 6e 20 ==== opened in
8980: 22 20 2e 74 69 6d 65 20 2e 22 20 3d 3d 3d 3d 22 " .time ." ===="
8990: 20 63 72 20 63 68 6f 6f 73 65 2d 6b 65 79 20 20 cr choose-key
89a0: 54 48 45 4e 0a 20 20 20 20 3e 72 61 77 2d 6b 65 THEN. >raw-ke
89b0: 79 20 3f 72 73 6b 20 20 20 72 3e 20 6f 70 2d 76 y ?rsk r> op-v
89c0: 65 63 74 6f 72 20 21 20 3b 0a 0a 73 63 6f 70 65 ector ! ;..scope
89d0: 3a 20 6e 32 6f 0a 46 6f 72 77 61 72 64 20 68 65 : n2o.Forward he
89e0: 6c 70 0a 7d 73 63 6f 70 65 0a 0a 3a 20 67 65 74 lp.}scope..: get
89f0: 2d 6d 79 2d 6b 65 79 20 28 20 2d 2d 20 78 74 20 -my-key ( -- xt
8a00: 29 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 2d 64 ). gen-keys-d
8a10: 69 72 20 20 22 73 65 63 6b 65 79 73 2e 6b 32 6f ir "seckeys.k2o
8a20: 22 20 2e 6b 65 79 73 2f 20 32 64 75 70 20 66 69 " .keys/ 2dup fi
8a30: 6c 65 2d 73 74 61 74 75 73 20 6e 69 70 0a 20 20 le-status nip.
8a40: 20 20 30 3d 20 49 46 20 20 72 2f 6f 20 6f 70 65 0= IF r/o ope
8a50: 6e 2d 66 69 6c 65 20 74 68 72 6f 77 20 3e 72 20 n-file throw >r
8a60: 72 40 20 66 69 6c 65 2d 73 69 7a 65 20 74 68 72 r@ file-size thr
8a70: 6f 77 20 64 30 3d 0a 09 72 3e 20 63 6c 6f 73 65 ow d0=..r> close
8a80: 2d 66 69 6c 65 20 74 68 72 6f 77 20 20 45 4c 53 -file throw ELS
8a90: 45 20 20 74 72 75 65 20 20 54 48 45 4e 0a 20 20 E true THEN.
8aa0: 20 20 49 46 20 20 5b 3a 20 2e 22 20 47 65 6e 65 IF [: ." Gene
8ab0: 72 61 74 65 20 61 20 6e 65 77 20 6b 65 79 70 61 rate a new keypa
8ac0: 69 72 3a 22 20 63 72 0a 09 20 20 67 65 74 2d 6e ir:" cr.. get-n
8ad0: 69 63 6b 20 64 75 70 20 30 3d 20 23 2d 35 36 20 ick dup 0= #-56
8ae0: 61 6e 64 20 74 68 72 6f 77 20 5c 20 65 6d 70 74 and throw \ empt
8af0: 79 20 6e 69 63 6b 3a 20 70 72 65 74 65 6e 64 20 y nick: pretend
8b00: 74 6f 20 71 75 69 74 0a 09 20 20 6e 65 77 2d 6b to quit.. new-k
8b10: 65 79 20 2e 6b 65 79 73 20 3f 72 73 6b 20 3b 5d ey .keys ?rsk ;]
8b20: 0a 20 20 20 20 45 4c 53 45 20 20 5b 27 5d 20 67 . ELSE ['] g
8b30: 65 74 2d 73 6b 63 20 20 54 48 45 4e 20 3b 0a 0a et-skc THEN ;..
8b40: 3a 20 2e 6b 65 79 69 6e 66 6f 20 28 20 2d 2d 20 : .keyinfo ( --
8b50: 29 0a 20 20 20 20 3c 77 61 72 6e 3e 20 2e 22 20 ). <warn> ."
8b60: 3d 3d 3d 3d 20 4e 6f 20 6b 65 79 20 6f 70 65 6e ==== No key open
8b70: 65 64 20 3d 3d 3d 3d 22 20 63 72 0a 20 20 20 20 ed ====" cr.
8b80: 3c 69 6e 66 6f 3e 20 2e 22 20 67 65 6e 65 72 61 <info> ." genera
8b90: 74 65 20 61 20 6e 65 77 20 6f 6e 65 20 77 69 74 te a new one wit
8ba0: 68 20 27 6b 65 79 67 65 6e 27 22 20 63 72 20 3c h 'keygen'" cr <
8bb0: 64 65 66 61 75 6c 74 3e 20 3b 0a 0a 3a 20 67 65 default> ;..: ge
8bc0: 74 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 t-me ( -- ).
8bd0: 67 65 74 2d 6d 79 2d 6b 65 79 20 63 61 74 63 68 get-my-key catch
8be0: 20 64 75 70 20 23 2d 35 36 20 3d 20 49 46 20 64 dup #-56 = IF d
8bf0: 72 6f 70 20 2e 6b 65 79 69 6e 66 6f 20 45 4c 53 rop .keyinfo ELS
8c00: 45 20 74 68 72 6f 77 20 54 48 45 4e 20 3b 0a 0a E throw THEN ;..
8c10: 3a 20 3f 67 65 74 2d 6d 65 20 28 20 2d 2d 20 29 : ?get-me ( -- )
8c20: 0a 20 20 20 20 5c 47 20 74 68 69 73 20 76 65 72 . \G this ver
8c30: 73 69 6f 6e 20 6f 66 20 67 65 74 2d 6d 65 20 66 sion of get-me f
8c40: 61 69 6c 73 20 68 61 72 64 20 69 66 20 6e 6f 20 ails hard if no
8c50: 6b 65 79 20 69 73 20 6f 70 65 6e 65 64 0a 20 20 key is opened.
8c60: 20 20 67 65 74 2d 6d 79 2d 6b 65 79 20 63 61 74 get-my-key cat
8c70: 63 68 20 23 2d 35 36 20 3d 20 49 46 0a 09 2e 6b ch #-56 = IF...k
8c80: 65 79 69 6e 66 6f 20 74 72 75 65 20 21 21 6e 6f eyinfo true !!no
8c90: 2d 6b 65 79 2d 6f 70 65 6e 21 21 0a 20 20 20 20 -key-open!!.
8ca0: 54 48 45 4e 20 3b 0a 0a 30 20 5b 49 46 5d 0a 4c THEN ;..0 [IF].L
8cb0: 6f 63 61 6c 20 56 61 72 69 61 62 6c 65 73 3a 0a ocal Variables:.
8cc0: 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 77 6f 72 64 forth-local-word
8cd0: 73 3a 0a 20 20 20 20 28 0a 20 20 20 20 20 28 28 s:. (. ((
8ce0: 22 6e 65 74 32 6f 3a 22 20 22 2b 6e 65 74 32 6f "net2o:" "+net2o
8cf0: 3a 22 29 20 64 65 66 69 6e 69 74 69 6f 6e 2d 73 :") definition-s
8d00: 74 61 72 74 65 72 20 28 66 6f 6e 74 2d 6c 6f 63 tarter (font-loc
8d10: 6b 2d 6b 65 79 77 6f 72 64 2d 66 61 63 65 20 2e k-keyword-face .
8d20: 20 31 29 0a 20 20 20 20 20 20 22 5b 20 5c 74 5c 1). "[ \t\
8d30: 6e 5d 22 20 74 20 6e 61 6d 65 20 28 66 6f 6e 74 n]" t name (font
8d40: 2d 6c 6f 63 6b 2d 66 75 6e 63 74 69 6f 6e 2d 6e -lock-function-n
8d50: 61 6d 65 2d 66 61 63 65 20 2e 20 33 29 29 0a 20 ame-face . 3)).
8d60: 20 20 20 20 28 28 22 64 65 62 75 67 3a 22 20 22 (("debug:" "
8d70: 66 69 65 6c 64 3a 22 20 22 32 66 69 65 6c 64 3a field:" "2field:
8d80: 22 20 22 73 66 66 69 65 6c 64 3a 22 20 22 64 66 " "sffield:" "df
8d90: 66 69 65 6c 64 3a 22 20 22 36 34 66 69 65 6c 64 field:" "64field
8da0: 3a 22 20 22 75 76 61 72 22 20 22 75 76 61 6c 75 :" "uvar" "uvalu
8db0: 65 22 29 20 6e 6f 6e 2d 69 6d 6d 65 64 69 61 74 e") non-immediat
8dc0: 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 74 79 70 e (font-lock-typ
8dd0: 65 2d 66 61 63 65 20 2e 20 32 29 0a 20 20 20 20 e-face . 2).
8de0: 20 20 22 5b 20 5c 74 5c 6e 5d 22 20 74 20 6e 61 "[ \t\n]" t na
8df0: 6d 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 76 61 me (font-lock-va
8e00: 72 69 61 62 6c 65 2d 6e 61 6d 65 2d 66 61 63 65 riable-name-face
8e10: 20 2e 20 33 29 29 0a 20 20 20 20 20 28 22 5b 61 . 3)). ("[a
8e20: 2d 7a 30 2d 39 5d 2b 28 22 20 69 6d 6d 65 64 69 -z0-9]+(" immedi
8e30: 61 74 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 63 ate (font-lock-c
8e40: 6f 6d 6d 65 6e 74 2d 66 61 63 65 20 2e 20 31 29 omment-face . 1)
8e50: 0a 20 20 20 20 20 20 22 29 22 20 6e 69 6c 20 63 . ")" nil c
8e60: 6f 6d 6d 65 6e 74 20 28 66 6f 6e 74 2d 6c 6f 63 omment (font-loc
8e70: 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 65 20 2e k-comment-face .
8e80: 20 31 29 29 0a 20 20 20 20 29 0a 66 6f 72 74 68 1)). ).forth
8e90: 2d 6c 6f 63 61 6c 2d 69 6e 64 65 6e 74 2d 77 6f -local-indent-wo
8ea0: 72 64 73 3a 0a 20 20 20 20 28 0a 20 20 20 20 20 rds:. (.
8eb0: 28 28 22 6e 65 74 32 6f 3a 22 20 22 2b 6e 65 74 (("net2o:" "+net
8ec0: 32 6f 3a 22 29 20 28 30 20 2e 20 32 29 20 28 30 2o:") (0 . 2) (0
8ed0: 20 2e 20 32 29 20 6e 6f 6e 2d 69 6d 6d 65 64 69 . 2) non-immedi
8ee0: 61 74 65 29 0a 20 20 20 20 20 28 28 22 5b 3a 22 ate). (("[:"
8ef0: 20 22 6b 65 79 3a 63 6f 64 65 22 29 20 28 30 20 "key:code") (0
8f00: 2e 20 31 29 20 28 30 20 2e 20 31 29 20 69 6d 6d . 1) (0 . 1) imm
8f10: 65 64 69 61 74 65 29 0a 20 20 20 20 20 28 28 22 ediate). (("
8f20: 3b 5d 22 20 22 65 6e 64 3a 6b 65 79 22 29 20 28 ;]" "end:key") (
8f30: 2d 31 20 2e 20 30 29 20 28 30 20 2e 20 2d 31 29 -1 . 0) (0 . -1)
8f40: 20 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 immediate).
8f50: 29 0a 45 6e 64 3a 0a 5b 54 48 45 4e 5d ).End:.[THEN]