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: 61 6e 64 72 6f 69 64 78 78 78 20 27 2a 27 20 5b androidxxx '*' [
03b0: 45 4c 53 45 5d 20 27 e2 80 a2 27 20 5b 54 48 45 ELSE] '•' [THE
03c0: 4e 5d 20 43 6f 6e 73 74 61 6e 74 20 70 77 2a 0a N] Constant pw*.
03d0: 0a 78 63 2d 76 65 63 74 6f 72 20 75 70 40 20 2d .xc-vector up@ -
03e0: 20 63 6c 61 73 73 2d 6f 20 21 0a 0a 30 20 63 65 class-o !..0 ce
03f0: 6c 6c 20 75 76 61 72 20 65 73 63 2d 73 74 61 74 ll uvar esc-stat
0400: 65 20 64 72 6f 70 0a 0a 44 65 66 65 72 20 6f 6c e drop..Defer ol
0410: 64 2d 65 6d 69 74 20 20 77 68 61 74 27 73 20 65 d-emit what's e
0420: 6d 69 74 20 69 73 20 6f 6c 64 2d 65 6d 69 74 0a mit is old-emit.
0430: 0a 68 65 72 65 0a 78 63 2d 76 65 63 74 6f 72 20 .here.xc-vector
0440: 40 20 63 65 6c 6c 2d 20 64 75 70 20 40 20 74 75 @ cell- dup @ tu
0450: 63 6b 20 2d 20 68 65 72 65 20 73 77 61 70 20 64 ck - here swap d
0460: 75 70 20 61 6c 6c 6f 74 20 6d 6f 76 65 0a 2c 20 up allot move.,
0470: 68 65 72 65 20 30 20 2c 20 43 6f 6e 73 74 61 6e here 0 , Constan
0480: 74 20 75 74 66 2d 38 2a 0a 0a 78 63 2d 76 65 63 t utf-8*..xc-vec
0490: 74 6f 72 20 40 20 20 75 74 66 2d 38 2a 20 78 63 tor @ utf-8* xc
04a0: 2d 76 65 63 74 6f 72 20 21 20 27 20 2a 2d 77 69 -vector ! ' *-wi
04b0: 64 74 68 20 69 73 20 78 2d 77 69 64 74 68 20 20 dth is x-width
04c0: 78 63 2d 76 65 63 74 6f 72 20 21 0a 0a 3a 20 65 xc-vector !..: e
04d0: 6d 69 74 2d 70 77 2a 20 28 20 6e 20 2d 2d 20 29 mit-pw* ( n -- )
04e0: 0a 20 20 20 20 64 75 70 20 23 65 73 63 20 3d 20 . dup #esc =
04f0: 49 46 20 20 65 73 63 2d 73 74 61 74 65 20 6f 6e IF esc-state on
0500: 20 20 54 48 45 4e 0a 20 20 20 20 64 75 70 20 62 THEN. dup b
0510: 6c 20 3c 20 49 46 20 20 6f 6c 64 2d 65 6d 69 74 l < IF old-emit
0520: 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 EXIT THEN.
0530: 20 65 73 63 2d 73 74 61 74 65 20 40 20 49 46 20 esc-state @ IF
0540: 20 64 75 70 20 6f 6c 64 2d 65 6d 69 74 0a 20 20 dup old-emit.
0550: 20 20 45 4c 53 45 20 20 64 75 70 20 24 43 30 20 ELSE dup $C0
0560: 24 38 30 20 77 69 74 68 69 6e 20 49 46 0a 09 20 $80 within IF..
0570: 20 20 20 5b 20 70 77 2a 20 27 20 78 65 6d 69 74 [ pw* ' xemit
0580: 20 24 74 6d 70 0a 09 20 20 20 20 62 6f 75 6e 64 $tmp.. bound
0590: 73 20 5b 3f 44 4f 5d 20 5b 49 5d 20 63 40 20 5d s [?DO] [I] c@ ]
05a0: 4c 20 6f 6c 64 2d 65 6d 69 74 20 5b 20 5b 4c 4f L old-emit [ [LO
05b0: 4f 50 5d 20 5d 0a 09 54 48 45 4e 0a 20 20 20 20 OP] ]..THEN.
05c0: 54 48 45 4e 0a 20 20 20 20 74 6f 75 70 70 65 72 THEN. toupper
05d0: 20 27 41 27 20 27 5b 27 20 77 69 74 68 69 6e 20 'A' '[' within
05e0: 49 46 20 20 65 73 63 2d 73 74 61 74 65 20 6f 66 IF esc-state of
05f0: 66 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 74 79 70 f THEN ;..: typ
0600: 65 2d 70 77 2a 20 28 20 61 64 64 72 20 75 20 2d e-pw* ( addr u -
0610: 2d 20 29 20 20 32 64 75 70 20 62 6c 20 73 6b 69 - ) 2dup bl ski
0620: 70 20 6e 69 70 20 30 3d 0a 20 20 20 20 49 46 20 p nip 0=. IF
0630: 20 20 20 62 6f 75 6e 64 73 20 55 2b 44 4f 20 20 bounds U+DO
0640: 62 6c 20 6f 6c 64 2d 65 6d 69 74 20 20 20 20 4c bl old-emit L
0650: 4f 4f 50 0a 20 20 20 20 45 4c 53 45 20 20 62 6f OOP. ELSE bo
0660: 75 6e 64 73 20 55 2b 44 4f 20 20 49 20 63 40 20 unds U+DO I c@
0670: 65 6d 69 74 2d 70 77 2a 20 20 4c 4f 4f 50 20 20 emit-pw* LOOP
0680: 54 48 45 4e 20 3b 0a 0a 3a 20 61 63 63 65 70 74 THEN ;..: accept
0690: 2a 20 28 20 61 64 64 72 20 75 20 2d 2d 20 75 27 * ( addr u -- u'
06a0: 20 29 0a 20 20 20 20 5c 47 20 61 63 63 65 70 74 ). \G accept
06b0: 2d 6c 69 6b 65 20 69 6e 70 75 74 2c 20 62 75 74 -like input, but
06c0: 20 74 79 70 65 73 20 2a 20 69 6e 73 74 65 61 64 types * instead
06d0: 20 6f 66 20 74 68 65 20 63 68 61 72 61 63 74 65 of the characte
06e0: 72 0a 20 20 20 20 5c 47 20 64 6f 6e 27 74 20 73 r. \G don't s
06f0: 61 76 65 20 69 6e 74 6f 20 68 69 73 74 6f 72 79 ave into history
0700: 0a 20 20 20 20 68 69 73 74 6f 72 79 20 3e 72 20 . history >r
0710: 20 77 68 61 74 27 73 20 74 79 70 65 20 3e 72 20 what's type >r
0720: 20 77 68 61 74 27 73 20 65 6d 69 74 20 69 73 20 what's emit is
0730: 6f 6c 64 2d 65 6d 69 74 0a 20 20 20 20 75 74 66 old-emit. utf
0740: 2d 38 2a 20 78 63 2d 76 65 63 74 6f 72 20 21 40 -8* xc-vector !@
0750: 20 3e 72 20 20 5b 27 5d 20 74 79 70 65 2d 70 77 >r ['] type-pw
0760: 2a 20 69 73 20 74 79 70 65 20 20 5b 27 5d 20 65 * is type ['] e
0770: 6d 69 74 2d 70 77 2a 20 69 73 20 65 6d 69 74 0a mit-pw* is emit.
0780: 20 20 20 20 30 20 74 6f 20 68 69 73 74 6f 72 79 0 to history
0790: 0a 20 20 20 20 5b 27 5d 20 61 63 63 65 70 74 20 . ['] accept
07a0: 63 61 74 63 68 0a 20 20 20 20 72 3e 20 78 63 2d catch. r> xc-
07b0: 76 65 63 74 6f 72 20 21 20 20 77 68 61 74 27 73 vector ! what's
07c0: 20 6f 6c 64 2d 65 6d 69 74 20 69 73 20 65 6d 69 old-emit is emi
07d0: 74 20 20 72 3e 20 69 73 20 74 79 70 65 20 20 72 t r> is type r
07e0: 3e 20 74 6f 20 68 69 73 74 6f 72 79 0a 20 20 20 > to history.
07f0: 20 74 68 72 6f 77 20 2d 31 20 30 20 61 74 2d 64 throw -1 0 at-d
0800: 65 6c 74 61 78 79 20 73 70 61 63 65 20 3b 0a 0a eltaxy space ;..
0810: 5c 20 4b 65 79 73 20 61 72 65 20 70 61 73 73 77 \ Keys are passw
0820: 6f 72 64 73 20 61 6e 64 20 70 72 69 76 61 74 65 ords and private
0830: 20 6b 65 79 73 20 28 73 65 6c 66 2d 6b 65 79 65 keys (self-keye
0840: 64 2c 20 69 2e 65 2e 20 70 72 69 76 61 74 65 2a d, i.e. private*
0850: 70 75 62 6c 69 63 20 6b 65 79 29 0a 0a 63 6d 64 public key)..cmd
0860: 2d 62 75 66 30 20 75 63 6c 61 73 73 20 63 6d 64 -buf0 uclass cmd
0870: 62 75 66 2d 6f 0a 20 20 20 20 6d 61 78 64 61 74 buf-o. maxdat
0880: 61 20 2d 0a 20 20 20 20 6b 65 79 2d 73 61 6c 74 a -. key-salt
0890: 23 20 75 76 61 72 20 6b 65 79 70 61 63 6b 0a 20 # uvar keypack.
08a0: 20 20 20 6b 65 79 70 61 63 6b 23 20 20 75 76 61 keypack# uva
08b0: 72 20 6b 65 79 70 61 63 6b 2d 62 75 66 0a 20 20 r keypack-buf.
08c0: 20 20 6b 65 79 2d 63 6b 73 75 6d 23 20 75 76 61 key-cksum# uva
08d0: 72 20 6b 65 79 70 61 63 6b 2d 63 68 6b 73 75 6d r keypack-chksum
08e0: 0a 65 6e 64 2d 63 6c 61 73 73 20 63 6d 64 2d 6b .end-class cmd-k
08f0: 65 79 62 75 66 2d 63 0a 0a 63 6d 64 2d 6b 65 79 eybuf-c..cmd-key
0900: 62 75 66 2d 63 20 27 20 6e 65 77 20 73 74 61 74 buf-c ' new stat
0910: 69 63 2d 61 20 77 69 74 68 2d 61 6c 6c 6f 63 61 ic-a with-alloca
0920: 74 65 72 20 63 6f 64 65 2d 6b 65 79 5e 20 21 0a ter code-key^ !.
0930: 27 20 63 6f 64 65 2d 6b 65 79 5e 20 63 6d 64 62 ' code-key^ cmdb
0940: 75 66 3a 20 63 6f 64 65 2d 6b 65 79 0a 0a 63 6f uf: code-key..co
0950: 64 65 2d 6b 65 79 0a 63 6d 64 30 6c 6f 63 6b 20 de-key.cmd0lock
0960: 30 20 70 74 68 72 65 61 64 5f 6d 75 74 65 78 5f 0 pthread_mutex_
0970: 69 6e 69 74 20 64 72 6f 70 0a 0a 3a 6e 6f 6e 61 init drop..:nona
0980: 6d 65 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 me ( -- addr u )
0990: 20 6b 65 79 70 61 63 6b 2d 62 75 66 20 63 6d 64 keypack-buf cmd
09a0: 62 75 66 23 20 40 20 3b 20 74 6f 20 63 6d 64 62 buf# @ ; to cmdb
09b0: 75 66 24 0a 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d uf$.:noname ( --
09c0: 20 6e 20 29 20 20 6b 65 79 70 61 63 6b 23 20 63 n ) keypack# c
09d0: 6d 64 62 75 66 23 20 40 20 2d 20 3b 20 74 6f 20 mdbuf# @ - ; to
09e0: 6d 61 78 73 74 72 69 6e 67 0a 0a 63 6f 64 65 30 maxstring..code0
09f0: 2d 62 75 66 0a 0a 3a 6e 6f 6e 61 6d 65 20 64 65 -buf..:noname de
0a00: 66 65 72 73 20 61 6c 6c 6f 63 2d 63 6f 64 65 2d fers alloc-code-
0a10: 62 75 66 73 0a 20 20 20 20 63 6d 64 2d 6b 65 79 bufs. cmd-key
0a20: 62 75 66 2d 63 20 6e 65 77 20 63 6f 64 65 2d 6b buf-c new code-k
0a30: 65 79 5e 20 21 20 3b 20 69 73 20 61 6c 6c 6f 63 ey^ ! ; is alloc
0a40: 2d 63 6f 64 65 2d 62 75 66 73 0a 3a 6e 6f 6e 61 -code-bufs.:nona
0a50: 6d 65 20 64 65 66 65 72 73 20 66 72 65 65 2d 63 me defers free-c
0a60: 6f 64 65 2d 62 75 66 73 0a 20 20 20 20 63 6f 64 ode-bufs. cod
0a70: 65 2d 6b 65 79 5e 20 40 20 2e 64 69 73 70 6f 73 e-key^ @ .dispos
0a80: 65 20 3b 20 69 73 20 66 72 65 65 2d 63 6f 64 65 e ; is free-code
0a90: 2d 62 75 66 73 0a 0a 5c 20 68 61 73 68 65 64 20 -bufs..\ hashed
0aa0: 6b 65 79 20 64 61 74 61 20 62 61 73 65 0a 0a 56 key data base..V
0ab0: 61 72 69 61 62 6c 65 20 67 72 6f 75 70 73 5b 5d ariable groups[]
0ac0: 20 5c 20 6e 61 6d 65 73 20 6f 66 20 67 72 6f 75 \ names of grou
0ad0: 70 73 2c 20 73 6f 72 74 65 64 20 62 79 20 6f 72 ps, sorted by or
0ae0: 64 65 72 20 69 6e 20 67 72 6f 75 70 73 20 66 69 der in groups fi
0af0: 6c 65 0a 0a 55 73 65 72 20 3e 73 74 6f 72 65 6b le..User >storek
0b00: 65 79 0a 56 61 72 69 61 62 6c 65 20 64 65 66 61 ey.Variable defa
0b10: 75 6c 74 6b 65 79 0a 0a 63 6d 64 2d 63 6c 61 73 ultkey..cmd-clas
0b20: 73 20 63 6c 61 73 73 0a 20 20 20 20 66 69 65 6c s class. fiel
0b30: 64 3a 20 6b 65 2d 73 6b 20 20 20 20 20 20 20 5c d: ke-sk \
0b40: 20 73 65 63 72 65 74 20 6b 65 79 0a 20 20 20 20 secret key.
0b50: 66 69 65 6c 64 3a 20 6b 65 2d 70 6b 20 20 20 20 field: ke-pk
0b60: 20 20 20 5c 20 70 75 62 6c 69 63 20 6b 65 79 0a \ public key.
0b70: 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 2d 72 73 field: ke-rs
0b80: 6b 20 20 20 20 20 20 5c 20 72 65 76 6f 6b 65 20 k \ revoke
0b90: 73 65 63 72 65 74 20 28 74 65 6d 70 6f 72 61 72 secret (temporar
0ba0: 69 6c 79 20 73 74 6f 72 65 64 29 0a 20 20 20 20 ily stored).
0bb0: 66 69 65 6c 64 3a 20 6b 65 2d 74 79 70 65 20 20 field: ke-type
0bc0: 20 20 20 5c 20 6b 65 79 20 74 79 70 65 0a 20 20 \ key type.
0bd0: 20 20 66 69 65 6c 64 3a 20 6b 65 2d 6e 69 63 6b field: ke-nick
0be0: 20 20 20 20 20 5c 20 6b 65 79 20 6e 69 63 6b 0a \ key nick.
0bf0: 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 2d 6e 69 field: ke-ni
0c00: 63 6b 23 20 20 20 20 5c 20 74 6f 20 61 76 6f 69 ck# \ to avoi
0c10: 64 20 63 6f 6c 69 73 73 69 6f 6e 73 2c 20 61 64 d colissions, ad
0c20: 64 20 61 20 6e 75 6d 62 65 72 20 68 65 72 65 0a d a number here.
0c30: 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 2d 70 65 field: ke-pe
0c40: 74 73 20 20 20 20 20 5c 20 6b 65 79 20 70 65 74 ts \ key pet
0c50: 6e 61 6d 65 73 0a 20 20 20 20 66 69 65 6c 64 3a names. field:
0c60: 20 6b 65 2d 70 65 74 73 23 20 20 20 20 5c 20 74 ke-pets# \ t
0c70: 6f 20 61 76 6f 69 64 20 63 6f 6c 69 73 73 69 6f o avoid colissio
0c80: 6e 73 2c 20 61 64 64 20 61 20 6e 75 6d 62 65 72 ns, add a number
0c90: 20 68 65 72 65 0a 20 20 20 20 66 69 65 6c 64 3a here. field:
0ca0: 20 6b 65 2d 70 72 6f 66 20 20 20 20 20 5c 20 70 ke-prof \ p
0cb0: 72 6f 66 69 6c 65 20 6f 62 6a 65 63 74 0a 20 20 rofile object.
0cc0: 20 20 66 69 65 6c 64 3a 20 6b 65 2d 73 65 6c 66 field: ke-self
0cd0: 73 69 67 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b sig. field: k
0ce0: 65 2d 73 69 67 73 0a 20 20 20 20 66 69 65 6c 64 e-sigs. field
0cf0: 3a 20 6b 65 2d 69 6d 70 6f 72 74 73 20 20 5c 20 : ke-imports \
0d00: 62 69 74 6d 61 73 6b 20 6f 66 20 6b 65 79 20 69 bitmask of key i
0d10: 6d 70 6f 72 74 0a 20 20 20 20 66 69 65 6c 64 3a mport. field:
0d20: 20 6b 65 2d 73 74 6f 72 65 6b 65 79 20 5c 20 75 ke-storekey \ u
0d30: 73 65 64 20 74 6f 20 65 6e 63 72 79 70 74 20 6f sed to encrypt o
0d40: 6e 20 73 74 6f 72 61 67 65 0a 20 20 20 20 66 69 n storage. fi
0d50: 65 6c 64 3a 20 6b 65 2d 6d 61 73 6b 20 20 20 20 eld: ke-mask
0d60: 20 5c 20 70 65 72 6d 69 73 73 69 6f 6e 20 6d 61 \ permission ma
0d70: 73 6b 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 sk. field: ke
0d80: 2d 67 72 6f 75 70 73 20 20 20 5c 20 70 72 65 6d -groups \ prem
0d90: 69 73 73 69 6f 6e 20 67 72 6f 75 70 73 0a 20 20 ission groups.
0da0: 20 20 36 34 66 69 65 6c 64 3a 20 6b 65 2d 6f 66 64field: ke-of
0db0: 66 73 65 74 20 5c 20 6f 66 66 73 65 74 20 69 6e fset \ offset in
0dc0: 20 6b 65 79 20 66 69 6c 65 0a 20 20 20 20 66 69 key file. fi
0dd0: 65 6c 64 3a 20 6b 65 2d 70 77 6c 65 76 65 6c 20 eld: ke-pwlevel
0de0: 20 5c 20 70 61 73 73 77 6f 72 64 20 73 74 72 65 \ password stre
0df0: 6e 67 74 68 20 6c 65 76 65 6c 0a 20 20 20 20 30 ngth level. 0
0e00: 20 2b 66 69 65 6c 64 20 6b 65 2d 65 6e 64 0a 65 +field ke-end.e
0e10: 6e 64 2d 63 6c 61 73 73 20 6b 65 79 2d 65 6e 74 nd-class key-ent
0e20: 72 79 0a 0a 3a 20 66 72 65 65 2d 6b 65 79 20 28 ry..: free-key (
0e30: 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b 65 79 20 o:key -- o:key
0e40: 29 0a 20 20 20 20 5c 67 20 66 72 65 65 20 61 6c ). \g free al
0e50: 6c 20 70 61 72 74 73 20 6f 66 20 74 68 65 20 73 l parts of the s
0e60: 75 62 6b 65 79 0a 20 20 20 20 6b 65 2d 73 6b 20 ubkey. ke-sk
0e70: 73 65 63 2d 6f 66 66 0a 20 20 20 20 6b 65 2d 70 sec-off. ke-p
0e80: 6b 20 24 6f 66 66 0a 20 20 20 20 6b 65 2d 6e 69 k $off. ke-ni
0e90: 63 6b 20 24 6f 66 66 0a 20 20 20 20 6b 65 2d 73 ck $off. ke-s
0ea0: 65 6c 66 73 69 67 20 24 6f 66 66 0a 20 20 20 20 elfsig $off.
0eb0: 6b 65 2d 73 69 67 73 20 24 5b 5d 6f 66 66 0a 20 ke-sigs $[]off.
0ec0: 20 20 20 6b 65 2d 70 65 74 73 20 24 5b 5d 6f 66 ke-pets $[]of
0ed0: 66 0a 20 20 20 20 6b 65 2d 70 65 74 73 23 20 24 f. ke-pets# $
0ee0: 6f 66 66 20 3b 0a 0a 5c 20 6b 65 79 20 63 6c 61 off ;..\ key cla
0ef0: 73 73 0a 0a 30 0a 65 6e 75 6d 20 6b 65 79 23 61 ss..0.enum key#a
0f00: 6e 6f 6e 0a 65 6e 75 6d 20 6b 65 79 23 75 73 65 non.enum key#use
0f10: 72 0a 65 6e 75 6d 20 6b 65 79 23 67 72 6f 75 70 r.enum key#group
0f20: 0a 64 72 6f 70 0a 0a 5c 20 6b 65 79 20 69 6d 70 .drop..\ key imp
0f30: 6f 72 74 20 74 79 70 65 0a 0a 30 0a 65 6e 75 6d ort type..0.enum
0f40: 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 20 20 20 import#self
0f50: 20 20 5c 20 70 72 69 76 61 74 65 20 6b 65 79 0a \ private key.
0f60: 65 6e 75 6d 20 69 6d 70 6f 72 74 23 6d 61 6e 75 enum import#manu
0f70: 61 6c 20 20 20 20 5c 20 6d 61 6e 75 61 6c 20 69 al \ manual i
0f80: 6d 70 6f 72 74 0a 65 6e 75 6d 20 69 6d 70 6f 72 mport.enum impor
0f90: 74 23 73 63 61 6e 20 20 20 20 20 20 5c 20 73 63 t#scan \ sc
0fa0: 61 6e 20 69 6d 70 6f 72 74 0a 65 6e 75 6d 20 69 an import.enum i
0fb0: 6d 70 6f 72 74 23 63 68 61 74 20 20 20 20 20 20 mport#chat
0fc0: 5c 20 73 65 65 6e 20 69 6e 20 63 68 61 74 0a 65 \ seen in chat.e
0fd0: 6e 75 6d 20 69 6d 70 6f 72 74 23 64 68 74 20 20 num import#dht
0fe0: 20 20 20 20 20 5c 20 64 68 74 20 69 6d 70 6f 72 \ dht impor
0ff0: 74 0a 65 6e 75 6d 20 69 6d 70 6f 72 74 23 69 6e t.enum import#in
1000: 76 69 74 65 64 20 20 20 5c 20 69 6e 76 69 74 61 vited \ invita
1010: 74 69 6f 6e 20 69 6d 70 6f 72 74 0a 65 6e 75 6d tion import.enum
1020: 20 69 6d 70 6f 72 74 23 75 6e 74 72 75 73 74 65 import#untruste
1030: 64 20 5c 20 6d 75 73 74 20 62 65 20 6c 61 73 74 d \ must be last
1040: 0a 64 72 6f 70 0a 24 31 46 20 65 6e 75 6d 20 69 .drop.$1F enum i
1050: 6d 70 6f 72 74 23 6e 65 77 20 20 20 5c 20 6e 65 mport#new \ ne
1060: 77 20 66 6f 72 6d 61 74 0a 64 72 6f 70 0a 0a 43 w format.drop..C
1070: 72 65 61 74 65 20 69 6d 70 6f 72 74 73 24 20 24 reate imports$ $
1080: 32 30 20 61 6c 6c 6f 74 20 69 6d 70 6f 72 74 73 20 allot imports
1090: 24 20 24 32 30 20 62 6c 20 66 69 6c 6c 0a 22 49 $ $20 bl fill."I
10a0: 6d 73 63 64 69 75 22 20 69 6d 70 6f 72 74 73 24 mscdiu" imports$
10b0: 20 73 77 61 70 20 6d 6f 76 65 0a 0a 56 61 72 69 swap move..Vari
10c0: 61 62 6c 65 20 69 6d 70 6f 72 74 2d 74 79 70 65 able import-type
10d0: 20 20 69 6d 70 6f 72 74 23 6e 65 77 20 69 6d 70 import#new imp
10e0: 6f 72 74 2d 74 79 70 65 20 21 0a 0a 43 72 65 61 ort-type !..Crea
10f0: 74 65 20 3e 69 6d 2d 63 6f 6c 6f 72 20 20 24 42 te >im-color $B
1100: 36 30 20 2c 20 24 44 36 30 20 2c 20 24 39 36 30 60 , $D60 , $960
1110: 20 2c 20 24 43 36 30 20 2c 20 24 41 36 30 20 2c , $C60 , $A60 ,
1120: 20 24 38 42 31 20 2c 20 24 45 36 30 20 2c 0a 44 $8B1 , $E60 ,.D
1130: 4f 45 53 3e 20 73 77 61 70 20 38 20 63 65 6c 6c OES> swap 8 cell
1140: 73 20 30 20 44 4f 20 20 64 75 70 20 31 20 61 6e s 0 DO dup 1 an
1150: 64 20 49 46 20 20 64 72 6f 70 20 49 20 4c 45 41 d IF drop I LEA
1160: 56 45 20 20 54 48 45 4e 20 20 32 2f 20 20 4c 4f VE THEN 2/ LO
1170: 4f 50 0a 20 20 63 65 6c 6c 73 20 2b 20 40 20 61 OP. cells + @ a
1180: 74 74 72 21 20 3b 0a 0a 3a 20 2e 69 6d 70 6f 72 ttr! ;..: .impor
1190: 74 73 20 28 20 6d 61 73 6b 20 2d 2d 20 29 0a 20 ts ( mask -- ).
11a0: 20 20 20 69 6d 70 6f 72 74 73 24 20 69 6d 70 6f imports$ impo
11b0: 72 74 23 6e 65 77 20 62 6f 75 6e 64 73 20 44 4f rt#new bounds DO
11c0: 0a 09 64 75 70 20 31 20 61 6e 64 20 49 46 20 20 ..dup 1 and IF
11d0: 49 20 63 40 20 65 6d 69 74 20 20 54 48 45 4e 20 I c@ emit THEN
11e0: 20 32 2f 20 4c 4f 4f 50 0a 20 20 20 20 64 72 6f 2/ LOOP. dro
11f0: 70 20 3b 0a 0a 5c 20 73 61 6d 70 6c 65 20 6b 65 p ;..\ sample ke
1200: 79 0a 0a 6b 65 79 2d 65 6e 74 72 79 20 27 20 6e y..key-entry ' n
1210: 65 77 20 73 74 61 74 69 63 2d 61 20 77 69 74 68 ew static-a with
1220: 2d 61 6c 6c 6f 63 61 74 65 72 20 43 6f 6e 73 74 -allocater Const
1230: 61 6e 74 20 73 61 6d 70 6c 65 2d 6b 65 79 0a 0a ant sample-key..
1240: 56 61 72 69 61 62 6c 65 20 6b 65 79 23 20 5c 20 Variable key# \
1250: 6b 65 79 20 68 61 73 68 20 74 61 62 6c 65 0a 56 key hash table.V
1260: 61 72 69 61 62 6c 65 20 6e 69 63 6b 23 20 5c 20 ariable nick# \
1270: 6e 69 63 6b 20 68 61 73 68 20 74 61 62 6c 65 0a nick hash table.
1280: 0a 36 34 56 61 72 69 61 62 6c 65 20 6b 65 79 2d .64Variable key-
1290: 72 65 61 64 2d 6f 66 66 73 65 74 0a 0a 3a 20 63 read-offset..: c
12a0: 75 72 72 65 6e 74 2d 6b 65 79 20 28 20 61 64 64 urrent-key ( add
12b0: 72 20 75 20 2d 2d 20 6f 20 29 0a 20 20 20 20 32 r u -- o ). 2
12c0: 64 75 70 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 dup key| key# #@
12d0: 20 64 72 6f 70 0a 20 20 20 20 64 75 70 20 30 3d drop. dup 0=
12e0: 20 49 46 20 20 64 72 6f 70 20 2e 22 20 75 6e 6b IF drop ." unk
12f0: 6e 6f 77 6e 20 6b 65 79 3a 20 22 20 38 35 74 79 nown key: " 85ty
1300: 70 65 20 63 72 20 20 30 20 45 58 49 54 20 20 54 pe cr 0 EXIT T
1310: 48 45 4e 0a 20 20 20 20 63 65 6c 6c 2b 20 3e 6f HEN. cell+ >o
1320: 20 6b 65 2d 70 6b 20 24 21 20 6f 20 6f 3e 20 3b ke-pk $! o o> ;
1330: 0a 0a 56 61 72 69 61 62 6c 65 20 73 69 6d 2d 6e ..Variable sim-n
1340: 69 63 6b 21 0a 0a 3a 20 6e 69 63 6b 21 20 28 20 ick!..: nick! (
1350: 2d 2d 20 29 20 73 69 6d 2d 6e 69 63 6b 21 20 40 -- ) sim-nick! @
1360: 20 3f 45 58 49 54 20 20 6f 20 7b 20 77 5e 20 6f ?EXIT o { w^ o
1370: 70 74 72 20 7d 0a 20 20 20 20 6b 65 2d 6e 69 63 ptr }. ke-nic
1380: 6b 20 24 40 20 6e 69 63 6b 23 20 23 40 20 64 30 k $@ nick# #@ d0
1390: 3d 20 49 46 0a 09 6f 70 74 72 20 63 65 6c 6c 20 = IF..optr cell
13a0: 6b 65 2d 6e 69 63 6b 20 24 40 20 6e 69 63 6b 23 ke-nick $@ nick#
13b0: 20 23 21 20 30 0a 20 20 20 20 45 4c 53 45 0a 09 #! 0. ELSE..
13c0: 6c 61 73 74 23 20 63 65 6c 6c 2b 20 24 40 6c 65 last# cell+ $@le
13d0: 6e 20 63 65 6c 6c 2f 0a 09 6f 70 74 72 20 63 65 n cell/..optr ce
13e0: 6c 6c 20 6c 61 73 74 23 20 63 65 6c 6c 2b 20 24 ll last# cell+ $
13f0: 2b 21 0a 20 20 20 20 54 48 45 4e 20 20 6b 65 2d +!. THEN ke-
1400: 6e 69 63 6b 23 20 21 20 3b 0a 0a 3a 20 23 2e 6e nick# ! ;..: #.n
1410: 69 63 6b 20 28 20 68 61 73 68 20 2d 2d 20 29 0a ick ( hash -- ).
1420: 20 20 20 20 64 75 70 20 24 40 20 74 79 70 65 20 dup $@ type
1430: 27 23 27 20 65 6d 69 74 20 63 65 6c 6c 2b 20 24 '#' emit cell+ $
1440: 40 6c 65 6e 20 63 65 6c 6c 2f 20 2e 20 3b 0a 0a @len cell/ . ;..
1450: 3a 20 6c 61 73 74 2d 70 65 74 40 20 28 20 2d 2d : last-pet@ ( --
1460: 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 6b 65 addr u ). ke
1470: 2d 70 65 74 73 20 24 5b 5d 23 20 3f 64 75 70 2d -pets $[]# ?dup-
1480: 49 46 20 20 31 2d 20 6b 65 2d 70 65 74 73 20 24 IF 1- ke-pets $
1490: 5b 5d 40 20 20 45 4c 53 45 20 20 23 30 2e 20 20 []@ ELSE #0.
14a0: 54 48 45 4e 20 3b 0a 0a 3a 20 70 65 74 21 20 28 THEN ;..: pet! (
14b0: 20 2d 2d 20 29 20 73 69 6d 2d 6e 69 63 6b 21 20 -- ) sim-nick!
14c0: 40 20 3f 45 58 49 54 20 20 6f 20 7b 20 77 5e 20 @ ?EXIT o { w^
14d0: 6f 70 74 72 20 7d 0a 20 20 20 20 6c 61 73 74 2d optr }. last-
14e0: 70 65 74 40 20 6e 69 63 6b 23 20 23 40 20 64 30 pet@ nick# #@ d0
14f0: 3d 20 49 46 0a 09 6f 70 74 72 20 63 65 6c 6c 20 = IF..optr cell
1500: 6c 61 73 74 2d 70 65 74 40 20 6e 69 63 6b 23 20 last-pet@ nick#
1510: 23 21 20 30 0a 20 20 20 20 45 4c 53 45 0a 09 6c #! 0. ELSE..l
1520: 61 73 74 23 20 63 65 6c 6c 2b 20 24 40 6c 65 6e ast# cell+ $@len
1530: 20 63 65 6c 6c 2f 0a 09 6f 70 74 72 20 63 65 6c cell/..optr cel
1540: 6c 20 6c 61 73 74 23 20 63 65 6c 6c 2b 20 24 2b l last# cell+ $+
1550: 21 0a 20 20 20 20 54 48 45 4e 20 20 6b 65 2d 70 !. THEN ke-p
1560: 65 74 73 20 24 5b 5d 23 20 31 2d 20 6b 65 2d 70 ets $[]# 1- ke-p
1570: 65 74 73 23 20 24 5b 5d 20 21 20 3b 0a 0a 3a 20 ets# $[] ! ;..:
1580: 6b 65 79 3a 6e 65 77 20 28 20 61 64 64 72 20 75 key:new ( addr u
1590: 20 2d 2d 20 6f 20 29 0a 20 20 20 20 5c 47 20 63 -- o ). \G c
15a0: 72 65 61 74 65 20 6e 65 77 20 6b 65 79 2c 20 61 reate new key, a
15b0: 64 64 72 20 75 20 69 73 20 74 68 65 20 70 75 62 ddr u is the pub
15c0: 6c 69 63 20 6b 65 79 0a 20 20 20 20 73 61 6d 70 lic key. samp
15d0: 6c 65 2d 6b 65 79 20 3e 6f 20 20 6b 65 2d 73 6b le-key >o ke-sk
15e0: 20 6b 65 2d 65 6e 64 20 6f 76 65 72 20 2d 20 65 ke-end over - e
15f0: 72 61 73 65 0a 20 20 20 20 6b 65 79 2d 65 6e 74 rase. key-ent
1600: 72 79 2d 74 61 62 6c 65 20 40 20 74 6f 6b 65 6e ry-table @ token
1610: 2d 74 61 62 6c 65 20 21 0a 20 20 20 20 3e 73 74 -table !. >st
1620: 6f 72 65 6b 65 79 20 40 20 6b 65 2d 73 74 6f 72 orekey @ ke-stor
1630: 65 6b 65 79 20 21 0a 20 20 20 20 6b 65 79 2d 72 ekey !. key-r
1640: 65 61 64 2d 6f 66 66 73 65 74 20 36 34 40 20 6b ead-offset 64@ k
1650: 65 2d 6f 66 66 73 65 74 20 36 34 21 0a 20 20 20 e-offset 64!.
1660: 20 31 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 40 1 import-type @
1670: 20 6c 73 68 69 66 74 20 5b 20 31 20 69 6d 70 6f lshift [ 1 impo
1680: 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 5d 4c rt#new lshift ]L
1690: 20 6f 72 20 6b 65 2d 69 6d 70 6f 72 74 73 20 21 or ke-imports !
16a0: 0a 20 20 20 20 6b 65 79 70 61 63 6b 2d 61 6c 6c . keypack-all
16b0: 23 20 6e 3e 36 34 20 6b 65 79 2d 72 65 61 64 2d # n>64 key-read-
16c0: 6f 66 66 73 65 74 20 36 34 2b 21 20 6f 20 63 65 offset 64+! o ce
16d0: 6c 6c 2d 20 6b 65 2d 65 6e 64 20 6f 76 65 72 20 ll- ke-end over
16e0: 2d 0a 20 20 20 20 32 6f 76 65 72 20 6b 65 79 7c -. 2over key|
16f0: 20 6b 65 79 23 20 23 21 20 6f 3e 0a 20 20 20 20 key# #! o>.
1700: 63 75 72 72 65 6e 74 2d 6b 65 79 20 3b 0a 0a 30 current-key ;..0
1710: 20 56 61 6c 75 65 20 6c 61 73 74 2d 6b 65 79 0a Value last-key.
1720: 0a 3a 20 6b 65 79 3f 6e 65 77 20 28 20 61 64 64 .: key?new ( add
1730: 72 20 75 20 2d 2d 20 6f 20 29 0a 20 20 20 20 5c r u -- o ). \
1740: 47 20 43 72 65 61 74 65 20 6f 72 20 6c 6f 6f 6b G Create or look
1750: 75 70 20 6e 65 77 20 6b 65 79 0a 20 20 20 20 32 up new key. 2
1760: 64 75 70 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 dup key| key# #@
1770: 20 64 72 6f 70 0a 20 20 20 20 64 75 70 20 30 3d drop. dup 0=
1780: 20 49 46 20 20 64 72 6f 70 20 6b 65 79 3a 6e 65 IF drop key:ne
1790: 77 0a 20 20 20 20 45 4c 53 45 20 20 6e 69 70 20 w. ELSE nip
17a0: 6e 69 70 20 63 65 6c 6c 2b 20 20 31 20 69 6d 70 nip cell+ 1 imp
17b0: 6f 72 74 2d 74 79 70 65 20 40 20 6c 73 68 69 66 ort-type @ lshif
17c0: 74 20 6f 76 65 72 20 2e 6b 65 2d 69 6d 70 6f 72 t over .ke-impor
17d0: 74 73 20 6f 72 21 20 20 54 48 45 4e 0a 20 20 20 ts or! THEN.
17e0: 20 64 75 70 20 74 6f 20 6c 61 73 74 2d 6b 65 79 dup to last-key
17f0: 20 3b 0a 0a 5c 20 73 65 61 72 63 68 20 66 6f 72 ;..\ search for
1800: 20 6b 65 79 73 20 2d 20 6e 6f 74 20 6f 70 74 69 keys - not opti
1810: 6d 69 7a 65 64 0a 0a 3a 20 23 73 70 6c 69 74 20 mized..: #split
1820: 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 64 72 ( addr u -- addr
1830: 20 75 20 6e 20 29 0a 20 20 20 20 5b 3a 20 32 64 u n ). [: 2d
1840: 75 70 20 27 23 27 20 2d 73 63 61 6e 20 6e 69 70 up '#' -scan nip
1850: 20 3e 72 0a 20 20 20 20 20 20 72 40 20 30 3d 20 >r. r@ 0=
1860: 49 46 20 20 72 64 72 6f 70 20 30 20 20 45 58 49 IF rdrop 0 EXI
1870: 54 20 20 54 48 45 4e 0a 20 20 20 20 20 20 23 30 T THEN. #0
1880: 2e 20 32 6f 76 65 72 20 72 40 20 2f 73 74 72 69 . 2over r@ /stri
1890: 6e 67 20 3e 6e 75 6d 62 65 72 0a 20 20 20 20 20 ng >number.
18a0: 20 30 3d 20 49 46 20 20 6e 69 70 20 64 72 6f 70 0= IF nip drop
18b0: 20 6e 69 70 20 72 3e 20 31 2d 20 73 77 61 70 20 nip r> 1- swap
18c0: 20 45 4c 53 45 0a 09 20 20 72 64 72 6f 70 20 64 ELSE.. rdrop d
18d0: 72 6f 70 20 32 64 72 6f 70 20 30 20 20 20 54 48 rop 2drop 0 TH
18e0: 45 4e 20 3b 5d 20 23 31 30 20 62 61 73 65 2d 65 EN ;] #10 base-e
18f0: 78 65 63 75 74 65 20 3b 0a 0a 3a 20 6e 69 63 6b xecute ;..: nick
1900: 2d 6b 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d -key ( addr u --
1910: 20 6f 20 2f 20 30 20 29 20 5c 20 73 65 61 72 63 o / 0 ) \ searc
1920: 68 20 66 6f 72 20 6b 65 79 20 6e 69 63 6b 6e 61 h for key nickna
1930: 6d 65 0a 20 20 20 20 23 73 70 6c 69 74 20 3e 72 me. #split >r
1940: 20 6e 69 63 6b 23 20 23 40 20 32 64 75 70 20 64 nick# #@ 2dup d
1950: 30 3d 20 49 46 20 20 72 64 72 6f 70 20 64 72 6f 0= IF rdrop dro
1960: 70 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 p EXIT THEN.
1970: 20 20 72 3e 20 63 65 6c 6c 73 20 73 61 66 65 2f r> cells safe/
1980: 73 74 72 69 6e 67 20 30 3d 20 49 46 20 20 64 72 string 0= IF dr
1990: 6f 70 20 30 20 20 45 58 49 54 20 20 54 48 45 4e op 0 EXIT THEN
19a0: 20 20 40 20 3b 0a 0a 3a 20 73 65 63 72 65 74 2d @ ;..: secret-
19b0: 6b 65 79 73 23 20 28 20 2d 2d 20 6e 20 29 0a 20 keys# ( -- n ).
19c0: 20 20 20 30 20 6b 65 79 23 20 5b 3a 20 63 65 6c 0 key# [: cel
19d0: 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b l+ $@ drop cell+
19e0: 20 3e 6f 20 6b 65 2d 73 6b 20 40 20 30 3c 3e 20 >o ke-sk @ 0<>
19f0: 2d 20 6f 3e 20 3b 5d 20 23 6d 61 70 20 3b 0a 3a - o> ;] #map ;.:
1a00: 20 73 65 63 72 65 74 2d 6b 65 79 20 28 20 6e 20 secret-key ( n
1a10: 2d 2d 20 6f 2f 30 20 29 0a 20 20 20 20 30 20 74 -- o/0 ). 0 t
1a20: 75 63 6b 20 6b 65 79 23 20 5b 3a 20 63 65 6c 6c uck key# [: cell
1a30: 2b 20 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 + $@ drop cell+
1a40: 3e 6f 20 6b 65 2d 73 6b 20 40 20 49 46 0a 09 20 >o ke-sk @ IF..
1a50: 20 32 64 75 70 20 3d 20 49 46 20 20 72 6f 74 20 2dup = IF rot
1a60: 64 72 6f 70 20 6f 20 2d 72 6f 74 20 20 54 48 45 drop o -rot THE
1a70: 4e 20 20 31 2b 0a 20 20 20 20 20 20 54 48 45 4e N 1+. THEN
1a80: 20 20 6f 3e 20 3b 5d 20 23 6d 61 70 20 32 64 72 o> ;] #map 2dr
1a90: 6f 70 20 3b 0a 3a 20 2e 23 20 28 20 6e 20 2d 2d op ;.: .# ( n --
1aa0: 20 29 20 3f 64 75 70 2d 49 46 20 20 27 23 27 20 ) ?dup-IF '#'
1ab0: 65 6d 69 74 20 30 20 2e 72 20 20 54 48 45 4e 20 emit 0 .r THEN
1ac0: 3b 0a 3a 20 2e 6e 69 63 6b 2d 62 61 73 65 20 28 ;.: .nick-base (
1ad0: 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 o:key -- ).
1ae0: 6b 65 2d 6e 69 63 6b 20 24 2e 20 20 6b 65 2d 6e ke-nick $. ke-n
1af0: 69 63 6b 23 20 40 20 2e 23 20 3b 0a 3a 20 2e 70 ick# @ .# ;.: .p
1b00: 65 74 2d 62 61 73 65 20 28 20 6f 3a 6b 65 79 20 et-base ( o:key
1b10: 2d 2d 20 29 0a 20 20 20 20 30 20 6b 65 2d 70 65 -- ). 0 ke-pe
1b20: 74 73 20 5b 3a 20 73 70 61 63 65 20 74 79 70 65 ts [: space type
1b30: 0a 20 20 20 20 20 20 64 75 70 20 6b 65 2d 70 65 . dup ke-pe
1b40: 74 73 23 20 24 5b 5d 20 40 20 2e 23 20 20 31 2b ts# $[] @ .# 1+
1b50: 20 3b 5d 20 24 5b 5d 6d 61 70 20 64 72 6f 70 20 ;] $[]map drop
1b60: 3b 0a 3a 20 2e 70 65 74 30 2d 62 61 73 65 20 28 ;.: .pet0-base (
1b70: 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 o:key -- ).
1b80: 6b 65 2d 70 65 74 73 20 24 5b 5d 23 20 49 46 20 ke-pets $[]# IF
1b90: 20 30 20 6b 65 2d 70 65 74 73 20 24 5b 5d 40 20 0 ke-pets $[]@
1ba0: 74 79 70 65 20 30 20 6b 65 2d 70 65 74 73 23 20 type 0 ke-pets#
1bb0: 24 5b 5d 20 40 20 2e 23 0a 20 20 20 20 45 4c 53 $[] @ .#. ELS
1bc0: 45 20 20 2e 6e 69 63 6b 2d 62 61 73 65 20 20 54 E .nick-base T
1bd0: 48 45 4e 20 3b 0a 3a 20 2e 72 65 61 6c 2d 6e 69 HEN ;.: .real-ni
1be0: 63 6b 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 20 ck ( o:key -- )
1bf0: 20 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e ke-imports @ >
1c00: 69 6d 2d 63 6f 6c 6f 72 20 2e 6e 69 63 6b 2d 62 im-color .nick-b
1c10: 61 73 65 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a ase <default> ;.
1c20: 3a 20 2e 6e 69 63 6b 20 28 20 6f 3a 6b 65 79 20 : .nick ( o:key
1c30: 2d 2d 20 29 20 20 20 6b 65 2d 69 6d 70 6f 72 74 -- ) ke-import
1c40: 73 20 40 20 3e 69 6d 2d 63 6f 6c 6f 72 20 2e 70 s @ >im-color .p
1c50: 65 74 30 2d 62 61 73 65 20 3c 64 65 66 61 75 6c et0-base <defaul
1c60: 74 3e 20 3b 0a 3a 20 2e 6e 69 63 6b 2b 70 65 74 t> ;.: .nick+pet
1c70: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 ( o:key -- ).
1c80: 20 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e ke-imports @ >
1c90: 69 6d 2d 63 6f 6c 6f 72 20 2e 6e 69 63 6b 2d 62 im-color .nick-b
1ca0: 61 73 65 20 2e 70 65 74 2d 62 61 73 65 20 3c 64 ase .pet-base <d
1cb0: 65 66 61 75 6c 74 3e 20 3b 0a 0a 3a 20 6e 69 63 efault> ;..: nic
1cc0: 6b 3e 70 6b 20 28 20 6e 69 63 6b 20 75 20 2d 2d k>pk ( nick u --
1cd0: 20 70 6b 20 75 20 29 0a 20 20 20 20 6e 69 63 6b pk u ). nick
1ce0: 2d 6b 65 79 20 3f 64 75 70 2d 49 46 20 2e 6b 65 -key ?dup-IF .ke
1cf0: 2d 70 6b 20 24 40 20 45 4c 53 45 20 30 20 30 20 -pk $@ ELSE 0 0
1d00: 54 48 45 4e 20 3b 0a 3a 20 68 6f 73 74 2e 6e 69 THEN ;.: host.ni
1d10: 63 6b 3e 70 6b 20 28 20 61 64 64 72 20 75 20 2d ck>pk ( addr u -
1d20: 2d 20 70 6b 20 75 27 20 29 0a 20 20 20 20 27 2e - pk u' ). '.
1d30: 27 20 24 73 70 6c 69 74 20 64 75 70 20 30 3d 20 ' $split dup 0=
1d40: 49 46 20 20 32 73 77 61 70 20 20 54 48 45 4e 20 IF 2swap THEN
1d50: 5b 3a 20 6e 69 63 6b 3e 70 6b 20 74 79 70 65 20 [: nick>pk type
1d60: 74 79 70 65 20 3b 5d 20 24 74 6d 70 20 3b 0a 0a type ;] $tmp ;..
1d70: 3a 20 6b 65 79 2d 65 78 69 73 74 3f 20 28 20 61 : key-exist? ( a
1d80: 64 64 72 20 75 20 2d 2d 20 6f 2f 30 20 29 0a 20 ddr u -- o/0 ).
1d90: 20 20 20 6b 65 79 23 20 23 40 20 49 46 20 20 63 key# #@ IF c
1da0: 65 6c 6c 2b 20 20 54 48 45 4e 20 3b 20 0a 0a 5c ell+ THEN ; ..\
1db0: 20 70 65 72 6d 69 73 73 69 6f 6e 20 6d 6f 64 69 permission modi
1dc0: 66 69 63 61 74 69 6f 6e 0a 0a 32 36 20 62 75 66 fication..26 buf
1dd0: 66 65 72 3a 20 70 65 72 6d 2d 63 68 61 72 73 0a fer: perm-chars.
1de0: 30 20 70 65 72 6d 24 20 63 6f 75 6e 74 20 62 6f 0 perm$ count bo
1df0: 75 6e 64 73 20 5b 44 4f 5d 20 64 75 70 20 5b 49 unds [DO] dup [I
1e00: 5d 20 63 40 20 27 61 27 20 2d 20 70 65 72 6d 2d ] c@ 'a' - perm-
1e10: 63 68 61 72 73 20 2b 20 63 21 20 31 2b 20 5b 4c chars + c! 1+ [L
1e20: 4f 4f 50 5d 20 64 72 6f 70 0a 0a 3a 20 2e 70 65 OOP] drop..: .pe
1e30: 72 6d 20 28 20 70 65 72 6d 69 73 73 69 6f 6e 20 rm ( permission
1e40: 2d 2d 20 29 20 20 31 20 70 65 72 6d 24 20 63 6f -- ) 1 perm$ co
1e50: 75 6e 74 20 62 6f 75 6e 64 73 20 44 4f 0a 09 32 unt bounds DO..2
1e60: 64 75 70 20 61 6e 64 20 30 3c 3e 20 49 20 63 40 dup and 0<> I c@
1e70: 20 27 2d 27 20 72 6f 74 20 73 65 6c 65 63 74 20 '-' rot select
1e80: 65 6d 69 74 20 32 2a 0a 20 20 20 20 4c 4f 4f 50 emit 2*. LOOP
1e90: 20 20 32 64 72 6f 70 20 3b 0a 3a 20 70 65 72 6d 2drop ;.: perm
1ea0: 61 6e 64 20 28 20 70 65 72 6d 61 6e 64 20 70 65 and ( permand pe
1eb0: 72 6d 6f 72 20 6e 65 77 20 2d 2d 20 70 65 72 6d rmor new -- perm
1ec0: 61 6e 64 27 20 70 65 72 6d 6f 72 20 29 0a 20 20 and' permor ).
1ed0: 20 20 69 6e 76 65 72 74 20 74 75 63 6b 20 61 6e invert tuck an
1ee0: 64 20 3e 72 20 61 6e 64 20 72 3e 20 3b 0a 3a 20 d >r and r> ;.:
1ef0: 3e 70 65 72 6d 2d 6d 6f 64 20 28 20 70 65 72 6d >perm-mod ( perm
1f00: 61 6e 64 20 70 65 72 6d 6f 72 20 2d 2d 20 70 65 and permor -- pe
1f10: 72 6d 61 6e 64 27 20 70 65 72 6d 6f 72 20 29 0a rmand' permor ).
1f20: 20 20 20 20 73 77 61 70 20 64 75 70 20 30 3d 20 swap dup 0=
1f30: 49 46 20 20 64 72 6f 70 20 64 75 70 20 69 6e 76 IF drop dup inv
1f40: 65 72 74 20 20 54 48 45 4e 20 73 77 61 70 20 3b ert THEN swap ;
1f50: 0a 3a 20 3e 70 65 72 6d 20 28 20 61 64 64 72 20 .: >perm ( addr
1f60: 75 20 2d 2d 20 70 65 72 6d 61 6e 64 20 70 65 72 u -- permand per
1f70: 6d 6f 72 20 29 0a 20 20 20 20 5c 47 20 70 61 72 mor ). \G par
1f80: 73 65 20 70 65 72 6d 69 73 73 69 6f 6e 73 3a 20 se permissions:
1f90: 2b 20 61 64 64 73 2c 20 2d 20 72 65 6d 6f 76 65 + adds, - remove
1fa0: 73 20 70 65 72 6d 69 73 73 69 6f 6e 73 2c 0a 20 s permissions,.
1fb0: 20 20 20 5c 47 20 6e 6f 20 6d 6f 64 69 66 69 65 \G no modifie
1fc0: 72 20 73 65 74 73 20 70 65 72 6d 69 73 73 6f 6e r sets permisson
1fd0: 73 2e 0a 20 20 20 20 30 20 30 20 5b 27 5d 20 6f s.. 0 0 ['] o
1fe0: 72 20 7b 20 78 74 20 7d 0a 20 20 20 20 32 73 77 r { xt }. 2sw
1ff0: 61 70 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 ap bounds ?DO..I
2000: 20 63 40 20 63 61 73 65 0a 09 20 20 20 20 27 2b c@ case.. '+
2010: 27 20 6f 66 20 20 3e 70 65 72 6d 2d 6d 6f 64 20 ' of >perm-mod
2020: 5b 27 5d 20 6f 72 20 74 6f 20 78 74 20 65 6e 64 ['] or to xt end
2030: 6f 66 0a 09 20 20 20 20 27 2d 27 20 6f 66 20 20 of.. '-' of
2040: 3e 70 65 72 6d 2d 6d 6f 64 20 5b 27 5d 20 70 65 >perm-mod ['] pe
2050: 72 6d 61 6e 64 20 74 6f 20 78 74 20 20 65 6e 64 rmand to xt end
2060: 6f 66 0a 09 20 20 20 20 27 3d 27 20 6f 66 20 20 of.. '=' of
2070: 32 64 72 6f 70 20 70 65 72 6d 25 64 65 66 61 75 2drop perm%defau
2080: 6c 74 20 64 75 70 20 5b 27 5d 20 6f 72 20 74 6f lt dup ['] or to
2090: 20 78 74 20 20 65 6e 64 6f 66 0a 09 20 20 20 20 xt endof..
20a0: 27 61 27 20 2d 20 64 75 70 20 27 7a 27 20 75 3c 'a' - dup 'z' u<
20b0: 3d 20 20 49 46 0a 09 09 70 65 72 6d 2d 63 68 61 = IF...perm-cha
20c0: 72 73 20 2b 20 63 40 20 31 20 73 77 61 70 20 6c rs + c@ 1 swap l
20d0: 73 68 69 66 74 20 78 74 20 65 78 65 63 75 74 65 shift xt execute
20e0: 0a 09 09 30 20 28 20 64 75 6d 6d 79 20 66 6f 72 ...0 ( dummy for
20f0: 20 65 6e 64 63 61 73 65 20 29 0a 09 20 20 20 20 endcase )..
2100: 54 48 45 4e 20 20 65 6e 64 63 61 73 65 0a 20 20 THEN endcase.
2110: 20 20 4c 4f 4f 50 20 3b 0a 3a 20 2e 70 65 72 6d LOOP ;.: .perm
2120: 61 6e 64 6f 72 20 28 20 70 65 72 6d 61 6e 64 20 andor ( permand
2130: 70 65 72 6d 6f 72 20 2d 2d 20 29 0a 20 20 20 20 permor -- ).
2140: 30 20 7b 20 2b 2d 20 7d 0a 20 20 20 20 31 20 70 0 { +- }. 1 p
2150: 65 72 6d 24 20 63 6f 75 6e 74 20 62 6f 75 6e 64 erm$ count bound
2160: 73 20 44 4f 20 20 3e 72 0a 09 6f 76 65 72 20 72 s DO >r..over r
2170: 40 20 61 6e 64 20 30 3d 20 49 46 20 20 27 2d 27 @ and 0= IF '-'
2180: 20 64 75 70 20 2b 2d 20 3c 3e 20 49 46 20 20 64 dup +- <> IF d
2190: 75 70 20 74 6f 20 2b 2d 20 65 6d 69 74 0a 09 20 up to +- emit..
21a0: 20 20 20 45 4c 53 45 20 20 64 72 6f 70 20 20 54 ELSE drop T
21b0: 48 45 4e 20 72 3e 20 20 49 20 63 40 20 65 6d 69 HEN r> I c@ emi
21c0: 74 20 20 3e 72 20 54 48 45 4e 0a 09 64 75 70 20 t >r THEN..dup
21d0: 20 72 40 20 61 6e 64 20 20 20 20 49 46 20 20 27 r@ and IF '
21e0: 2b 27 20 64 75 70 20 2b 2d 20 3c 3e 20 49 46 20 +' dup +- <> IF
21f0: 20 64 75 70 20 74 6f 20 2b 2d 20 65 6d 69 74 0a dup to +- emit.
2200: 09 20 20 20 20 45 4c 53 45 20 20 64 72 6f 70 20 . ELSE drop
2210: 20 54 48 45 4e 20 72 3e 20 20 49 20 63 40 20 65 THEN r> I c@ e
2220: 6d 69 74 20 20 3e 72 20 54 48 45 4e 0a 09 72 3e mit >r THEN..r>
2230: 20 32 2a 0a 20 20 20 20 4c 4f 4f 50 20 20 64 72 2*. LOOP dr
2240: 6f 70 20 32 64 72 6f 70 20 3b 0a 0a 5c 20 72 65 op 2drop ;..\ re
2250: 61 64 20 69 6e 20 70 65 72 6d 69 73 73 69 6f 6e ad in permission
2260: 20 67 72 6f 75 70 73 2c 20 67 72 6f 75 70 73 20 groups, groups
2270: 69 73 20 69 6e 20 74 68 65 20 2e 6e 65 74 32 6f is in the .net2o
2280: 20 64 69 72 65 63 74 6f 72 79 0a 0a 3a 20 3e 67 directory..: >g
2290: 72 6f 75 70 2d 69 64 20 28 20 61 64 64 72 20 75 roup-id ( addr u
22a0: 20 2d 2d 20 69 64 2f 2d 31 20 29 0a 20 20 20 20 -- id/-1 ).
22b0: 2d 31 20 30 20 67 72 6f 75 70 73 5b 5d 20 5b 3a -1 0 groups[] [:
22c0: 20 32 73 77 61 70 20 32 3e 72 20 32 20 63 65 6c 2swap 2>r 2 cel
22d0: 6c 73 20 2f 73 74 72 69 6e 67 0a 20 20 20 20 20 ls /string.
22e0: 20 32 6f 76 65 72 20 73 74 72 69 6e 67 2d 70 72 2over string-pr
22f0: 65 66 69 78 3f 20 49 46 20 20 32 72 3e 20 6e 69 efix? IF 2r> ni
2300: 70 20 64 75 70 0a 20 20 20 20 20 20 45 4c 53 45 p dup. ELSE
2310: 20 20 32 72 3e 20 20 54 48 45 4e 20 20 31 2b 20 2r> THEN 1+
2320: 3b 5d 20 24 5b 5d 6d 61 70 0a 20 20 20 20 32 6e ;] $[]map. 2n
2330: 69 70 20 64 72 6f 70 20 3b 0a 0a 3a 20 3e 67 72 ip drop ;..: >gr
2340: 6f 75 70 73 20 28 20 61 64 64 72 20 75 20 70 61 oups ( addr u pa
2350: 6e 64 20 70 6f 72 20 2d 2d 20 29 0a 20 20 20 20 nd por -- ).
2360: 73 22 20 22 20 67 72 6f 75 70 73 5b 5d 20 24 2b s" " groups[] $+
2370: 5b 5d 21 0a 20 20 20 20 5b 3a 20 7b 20 64 5e 20 []!. [: { d^
2380: 70 61 6e 64 6f 72 20 7d 20 70 61 6e 64 6f 72 20 pandor } pandor
2390: 32 20 63 65 6c 6c 73 20 74 79 70 65 20 20 74 79 2 cells type ty
23a0: 70 65 20 3b 5d 0a 20 20 20 20 67 72 6f 75 70 73 pe ;]. groups
23b0: 5b 5d 20 64 75 70 20 24 5b 5d 23 20 31 2d 20 73 [] dup $[]# 1- s
23c0: 77 61 70 20 24 5b 5d 20 24 65 78 65 63 20 3b 0a wap $[] $exec ;.
23d0: 0a 3a 20 69 6e 69 74 2d 67 72 6f 75 70 73 20 28 .: init-groups (
23e0: 20 2d 2d 20 29 0a 20 20 20 20 22 6d 79 73 65 6c -- ). "mysel
23f0: 66 22 20 20 70 65 72 6d 25 6d 79 73 65 6c 66 20 f" perm%myself
2400: 20 64 75 70 20 3e 67 72 6f 75 70 73 0a 20 20 20 dup >groups.
2410: 20 22 70 65 65 72 22 20 20 20 20 70 65 72 6d 25 "peer" perm%
2420: 64 65 66 61 75 6c 74 20 64 75 70 20 3e 67 72 6f default dup >gro
2430: 75 70 73 0a 20 20 20 20 22 75 6e 6b 6e 6f 77 6e ups. "unknown
2440: 22 20 70 65 72 6d 25 75 6e 6b 6e 6f 77 6e 20 64 " perm%unknown d
2450: 75 70 20 3e 67 72 6f 75 70 73 0a 20 20 20 20 22 up >groups. "
2460: 62 6c 6f 63 6b 65 64 22 20 70 65 72 6d 25 62 6c blocked" perm%bl
2470: 6f 63 6b 65 64 20 70 65 72 6d 25 69 6e 64 69 72 ocked perm%indir
2480: 65 63 74 20 6f 72 20 64 75 70 20 3e 67 72 6f 75 ect or dup >grou
2490: 70 73 20 3b 0a 0a 69 6e 69 74 2d 67 72 6f 75 70 ps ;..init-group
24a0: 73 0a 0a 3a 20 2e 67 72 6f 75 70 73 20 28 20 2d s..: .groups ( -
24b0: 2d 20 29 0a 20 20 20 20 67 72 6f 75 70 73 5b 5d - ). groups[]
24c0: 20 5b 3a 20 32 64 75 70 20 32 20 63 65 6c 6c 73 [: 2dup 2 cells
24d0: 20 2f 73 74 72 69 6e 67 20 74 79 70 65 20 73 70 /string type sp
24e0: 61 63 65 0a 20 20 20 20 20 20 64 72 6f 70 20 32 ace. drop 2
24f0: 40 20 2e 70 65 72 6d 61 6e 64 6f 72 20 63 72 20 @ .permandor cr
2500: 3b 5d 20 24 5b 5d 6d 61 70 20 3b 0a 0a 3a 20 2e ;] $[]map ;..: .
2510: 69 6e 2d 67 72 6f 75 70 73 20 28 20 61 64 64 72 in-groups ( addr
2520: 20 75 20 2d 2d 20 29 0a 20 20 20 20 62 6f 75 6e u -- ). boun
2530: 64 73 20 3f 44 4f 0a 09 49 20 70 40 2b 20 49 20 ds ?DO..I p@+ I
2540: 2d 20 3e 72 20 36 34 3e 6e 20 67 72 6f 75 70 73 - >r 64>n groups
2550: 5b 5d 20 24 5b 5d 40 20 32 20 63 65 6c 6c 73 20 [] $[]@ 2 cells
2560: 2f 73 74 72 69 6e 67 20 73 70 61 63 65 20 74 79 /string space ty
2570: 70 65 0a 20 20 20 20 72 3e 20 2b 4c 4f 4f 50 20 pe. r> +LOOP
2580: 3b 0a 0a 3a 20 77 72 69 74 65 2d 67 72 6f 75 70 ;..: write-group
2590: 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 22 67 72 s ( -- ). "gr
25a0: 6f 75 70 73 22 20 2e 6e 65 74 32 6f 2f 20 77 2f oups" .net2o/ w/
25b0: 6f 20 63 72 65 61 74 65 2d 66 69 6c 65 20 74 68 o create-file th
25c0: 72 6f 77 20 3e 72 0a 20 20 20 20 5b 27 5d 20 2e row >r. ['] .
25d0: 67 72 6f 75 70 73 20 72 40 20 6f 75 74 66 69 6c groups r@ outfil
25e0: 65 2d 65 78 65 63 75 74 65 0a 20 20 20 20 72 3e e-execute. r>
25f0: 20 63 6c 6f 73 65 2d 66 69 6c 65 20 74 68 72 6f close-file thro
2600: 77 20 3b 0a 0a 3a 20 67 72 6f 75 70 2d 6c 69 6e w ;..: group-lin
2610: 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 70 61 72 e ( -- ). par
2620: 73 65 2d 6e 61 6d 65 20 70 61 72 73 65 2d 6e 61 se-name parse-na
2630: 6d 65 20 3e 70 65 72 6d 20 3e 67 72 6f 75 70 73 me >perm >groups
2640: 20 3b 0a 0a 3a 20 72 65 61 64 2d 67 72 6f 75 70 ;..: read-group
2650: 73 2d 6c 6f 6f 70 20 28 20 2d 2d 20 29 0a 20 20 s-loop ( -- ).
2660: 20 20 42 45 47 49 4e 20 20 72 65 66 69 6c 6c 20 BEGIN refill
2670: 20 57 48 49 4c 45 20 20 67 72 6f 75 70 2d 6c 69 WHILE group-li
2680: 6e 65 20 20 52 45 50 45 41 54 20 3b 0a 0a 3a 20 ne REPEAT ;..:
2690: 72 65 61 64 2d 67 72 6f 75 70 73 20 28 20 2d 2d read-groups ( --
26a0: 20 29 0a 20 20 20 20 22 67 72 6f 75 70 73 22 20 ). "groups"
26b0: 2e 6e 65 74 32 6f 2f 20 32 64 75 70 20 66 69 6c .net2o/ 2dup fil
26c0: 65 2d 73 74 61 74 75 73 20 6e 69 70 20 6e 6f 2d e-status nip no-
26d0: 66 69 6c 65 23 20 3d 20 49 46 0a 09 69 6e 69 74 file# = IF..init
26e0: 2d 67 72 6f 75 70 73 20 77 72 69 74 65 2d 67 72 -groups write-gr
26f0: 6f 75 70 73 0a 20 20 20 20 54 48 45 4e 20 20 3e oups. THEN >
2700: 69 6e 63 6c 75 64 65 64 20 74 68 72 6f 77 0a 20 included throw.
2710: 20 20 20 5b 27 5d 20 72 65 61 64 2d 67 72 6f 75 ['] read-grou
2720: 70 73 2d 6c 6f 6f 70 20 65 78 65 63 75 74 65 2d ps-loop execute-
2730: 70 61 72 73 69 6e 67 2d 6e 61 6d 65 64 2d 66 69 parsing-named-fi
2740: 6c 65 20 3b 0a 0a 3a 20 67 72 6f 75 70 73 3e 6d le ;..: groups>m
2750: 61 73 6b 20 28 20 61 64 64 72 20 75 20 2d 2d 20 ask ( addr u --
2760: 6d 61 73 6b 20 29 0a 20 20 20 20 30 20 2d 72 6f mask ). 0 -ro
2770: 74 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 20 t bounds ?DO..I
2780: 70 40 2b 20 49 20 2d 20 3e 72 0a 09 36 34 3e 6e p@+ I - >r..64>n
2790: 20 64 75 70 20 67 72 6f 75 70 73 5b 5d 20 24 5b dup groups[] $[
27a0: 5d 23 20 75 3e 3d 20 21 21 6e 6f 2d 67 72 6f 75 ]# u>= !!no-grou
27b0: 70 21 21 0a 09 67 72 6f 75 70 73 5b 5d 20 24 5b p!!..groups[] $[
27c0: 5d 40 20 64 72 6f 70 20 32 40 20 3e 72 20 61 6e ]@ drop 2@ >r an
27d0: 64 20 72 3e 20 6f 72 0a 20 20 20 20 72 3e 20 2b d r> or. r> +
27e0: 4c 4f 4f 50 20 3b 0a 0a 3a 20 3f 3e 67 72 6f 75 LOOP ;..: ?>grou
27f0: 70 73 20 28 20 6d 61 73 6b 20 2d 2d 20 6d 61 73 ps ( mask -- mas
2800: 6b 27 20 29 0a 20 20 20 20 6b 65 2d 67 72 6f 75 k' ). ke-grou
2810: 70 73 20 24 40 6c 65 6e 20 30 3d 20 49 46 0a 09 ps $@len 0= IF..
2820: 34 20 30 20 44 4f 0a 09 20 20 20 20 64 75 70 20 4 0 DO.. dup
2830: 49 20 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 40 20 I groups[] $[]@
2840: 64 72 6f 70 20 63 65 6c 6c 2b 20 40 0a 09 20 20 drop cell+ @..
2850: 20 20 6f 72 20 6f 76 65 72 20 3d 20 49 46 0a 09 or over = IF..
2860: 09 49 20 6b 65 2d 67 72 6f 75 70 73 20 63 24 2b .I ke-groups c$+
2870: 21 20 49 20 67 72 6f 75 70 73 5b 5d 20 24 5b 5d ! I groups[] $[]
2880: 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 40 20 69 @ drop cell+ @ i
2890: 6e 76 65 72 74 20 61 6e 64 0a 09 20 20 20 20 54 nvert and.. T
28a0: 48 45 4e 0a 09 4c 4f 4f 50 0a 20 20 20 20 54 48 HEN..LOOP. TH
28b0: 45 4e 20 20 64 72 6f 70 20 3b 0a 0a 5c 20 6b 65 EN drop ;..\ ke
28c0: 79 20 64 69 73 70 6c 61 79 0a 0a 5b 49 46 55 4e y display..[IFUN
28d0: 44 45 46 5d 20 6d 61 67 65 6e 74 61 20 20 62 72 DEF] magenta br
28e0: 6f 77 6e 20 63 6f 6e 73 74 61 6e 74 20 6d 61 67 own constant mag
28f0: 65 6e 74 61 20 5b 54 48 45 4e 5d 0a 5b 49 46 44 enta [THEN].[IFD
2900: 45 46 5d 20 67 6c 2d 74 79 70 65 20 3a 20 62 67 EF] gl-type : bg
2910: 7c 20 3e 62 67 20 6f 72 20 3b 20 5b 45 4c 53 45 | >bg or ; [ELSE
2920: 5d 20 3a 20 62 67 7c 20 64 72 6f 70 20 3b 20 5b ] : bg| drop ; [
2930: 54 48 45 4e 5d 0a 0a 43 72 65 61 74 65 20 38 35 THEN]..Create 85
2940: 63 6f 6c 6f 72 73 2d 62 77 0a 30 20 2c 20 69 6e colors-bw.0 , in
2950: 76 65 72 73 20 2c 0a 69 6e 76 65 72 73 20 2c 20 vers ,.invers ,
2960: 30 20 2c 0a 30 20 2c 20 69 6e 76 65 72 73 20 2c 0 ,.0 , invers ,
2970: 0a 69 6e 76 65 72 73 20 2c 20 30 20 2c 0a 43 72 .invers , 0 ,.Cr
2980: 65 61 74 65 20 38 35 63 6f 6c 6f 72 73 2d 63 6c eate 85colors-cl
2990: 0a 79 65 6c 6c 6f 77 20 3e 66 67 20 62 6c 75 65 .yellow >fg blue
29a0: 20 3e 62 67 20 6f 72 20 62 6f 6c 64 20 6f 72 20 >bg or bold or
29b0: 2c 20 72 65 64 20 3e 66 67 20 77 68 69 74 65 20 , red >fg white
29c0: 62 67 7c 20 2c 0a 62 6c 61 63 6b 20 3e 66 67 20 bg| ,.black >fg
29d0: 63 79 61 6e 20 62 67 7c 20 2c 20 67 72 65 65 6e cyan bg| , green
29e0: 20 3e 66 67 20 62 6c 61 63 6b 20 3e 62 67 20 6f >fg black >bg o
29f0: 72 20 62 6f 6c 64 20 6f 72 20 2c 0a 77 68 69 74 r bold or ,.whit
2a00: 65 20 3e 66 67 20 62 6c 61 63 6b 20 3e 62 67 20 e >fg black >bg
2a10: 6f 72 20 62 6f 6c 64 20 6f 72 20 2c 20 6d 61 67 or bold or , mag
2a20: 65 6e 74 61 20 3e 66 67 20 79 65 6c 6c 6f 77 20 enta >fg yellow
2a30: 62 67 7c 20 2c 0a 62 6c 75 65 20 3e 66 67 20 79 bg| ,.blue >fg y
2a40: 65 6c 6c 6f 77 20 62 67 7c 20 2c 20 63 79 61 6e ellow bg| , cyan
2a50: 20 3e 66 67 20 72 65 64 20 3e 62 67 20 6f 72 20 >fg red >bg or
2a60: 62 6f 6c 64 20 6f 72 20 2c 0a 0a 5b 49 46 44 45 bold or ,..[IFDE
2a70: 46 5d 20 67 6c 2d 74 79 70 65 20 38 35 63 6f 6c F] gl-type 85col
2a80: 6f 72 73 2d 63 6c 20 5b 45 4c 53 45 5d 20 38 35 ors-cl [ELSE] 85
2a90: 63 6f 6c 6f 72 73 2d 62 77 20 5b 54 48 45 4e 5d colors-bw [THEN]
2aa0: 20 56 61 6c 75 65 20 38 35 63 6f 6c 6f 72 73 0a Value 85colors.
2ab0: 0a 3a 20 2e 73 74 72 69 70 65 38 35 20 28 20 61 .: .stripe85 ( a
2ac0: 64 64 72 20 75 20 2d 2d 20 29 20 20 30 20 2d 72 ddr u -- ) 0 -r
2ad0: 6f 74 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 64 ot bounds ?DO..d
2ae0: 75 70 20 63 65 6c 6c 73 20 38 35 63 6f 6c 6f 72 up cells 85color
2af0: 73 20 2b 20 40 20 61 74 74 72 21 20 31 2b 0a 09 s + @ attr! 1+..
2b00: 49 20 34 20 38 35 74 79 70 65 20 20 64 75 70 20 I 4 85type dup
2b10: 63 65 6c 6c 73 20 38 35 63 6f 6c 6f 72 73 20 2b cells 85colors +
2b20: 20 40 20 61 74 74 72 21 20 31 2b 0a 20 20 20 20 @ attr! 1+.
2b30: 49 20 34 20 2b 20 34 20 38 35 74 79 70 65 20 3c I 4 + 4 85type <
2b40: 64 65 66 61 75 6c 74 3e 20 63 72 20 38 20 2b 4c default> cr 8 +L
2b50: 4f 4f 50 20 20 64 72 6f 70 20 3b 0a 3a 20 2e 69 OOP drop ;.: .i
2b60: 6d 70 6f 72 74 38 35 20 28 20 61 64 64 72 20 75 mport85 ( addr u
2b70: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 69 6d 70 -- ). ke-imp
2b80: 6f 72 74 73 20 40 20 3e 69 6d 2d 63 6f 6c 6f 72 orts @ >im-color
2b90: 20 38 35 74 79 70 65 20 3c 64 65 66 61 75 6c 74 85type <default
2ba0: 3e 20 3b 0a 3a 20 2e 72 73 6b 20 28 20 6e 69 63 > ;.: .rsk ( nic
2bb0: 6b 20 75 20 2d 2d 20 29 0a 20 20 20 20 73 6b 72 k u -- ). skr
2bc0: 65 76 20 24 32 30 20 2e 73 74 72 69 70 65 38 35 ev $20 .stripe85
2bd0: 20 73 70 61 63 65 20 74 79 70 65 20 2e 22 20 20 space type ."
2be0: 28 6b 65 65 70 20 6f 66 66 6c 69 6e 65 20 63 6f (keep offline co
2bf0: 70 79 21 29 22 20 63 72 20 3b 0a 3a 20 2e 6b 65 py!)" cr ;.: .ke
2c00: 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 y ( addr u -- )
2c10: 64 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 0a 20 20 drop cell+ >o.
2c20: 20 20 2e 22 20 6e 69 63 6b 3a 20 20 20 22 20 2e ." nick: " .
2c30: 6e 69 63 6b 20 63 72 0a 20 20 20 20 2e 22 20 70 nick cr. ." p
2c40: 75 62 6b 65 79 3a 20 22 20 6b 65 2d 70 6b 20 24 ubkey: " ke-pk $
2c50: 40 20 38 35 74 79 70 65 20 63 72 0a 20 20 20 20 @ 85type cr.
2c60: 6b 65 2d 73 6b 20 40 20 49 46 0a 09 2e 22 20 73 ke-sk @ IF..." s
2c70: 65 63 6b 65 79 3a 20 22 20 6b 65 2d 73 6b 20 73 eckey: " ke-sk s
2c80: 65 63 40 20 2e 62 6c 61 63 6b 38 35 20 2e 22 20 ec@ .black85 ."
2c90: 20 28 6b 65 65 70 20 73 65 63 72 65 74 21 29 22 (keep secret!)"
2ca0: 20 63 72 20 20 54 48 45 4e 0a 20 20 20 20 2e 22 cr THEN. ."
2cb0: 20 76 61 6c 69 64 3a 20 20 22 20 6b 65 2d 73 65 valid: " ke-se
2cc0: 6c 66 73 69 67 20 24 40 20 2e 73 69 67 64 61 74 lfsig $@ .sigdat
2cd0: 65 73 20 63 72 0a 20 20 20 20 2e 22 20 67 72 6f es cr. ." gro
2ce0: 75 70 73 3a 20 22 20 6b 65 2d 67 72 6f 75 70 73 ups: " ke-groups
2cf0: 20 24 40 20 2e 69 6e 2d 67 72 6f 75 70 73 20 63 $@ .in-groups c
2d00: 72 0a 20 20 20 20 2e 22 20 70 65 72 6d 3a 20 20 r. ." perm:
2d10: 20 22 20 6b 65 2d 6d 61 73 6b 20 40 20 2e 70 65 " ke-mask @ .pe
2d20: 72 6d 20 63 72 0a 20 20 20 20 6f 3e 20 3b 0a 3a rm cr. o> ;.:
2d30: 20 2e 6b 65 79 2d 72 65 73 74 20 28 20 6f 3a 6b .key-rest ( o:k
2d40: 65 79 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 20 ey -- o:key ).
2d50: 20 20 6b 65 2d 70 6b 20 24 40 20 6b 65 79 7c 20 ke-pk $@ key|
2d60: 2e 69 6d 70 6f 72 74 38 35 0a 20 20 20 20 6b 65 .import85. ke
2d70: 2d 73 65 6c 66 73 69 67 20 24 40 20 73 70 61 63 -selfsig $@ spac
2d80: 65 20 2e 73 69 67 64 61 74 65 73 0a 20 20 20 20 e .sigdates.
2d90: 6b 65 2d 67 72 6f 75 70 73 20 24 40 20 32 64 75 ke-groups $@ 2du
2da0: 70 20 2e 69 6e 2d 67 72 6f 75 70 73 20 67 72 6f p .in-groups gro
2db0: 75 70 73 3e 6d 61 73 6b 20 69 6e 76 65 72 74 0a ups>mask invert.
2dc0: 20 20 20 20 73 70 61 63 65 20 6b 65 2d 6d 61 73 space ke-mas
2dd0: 6b 20 40 20 61 6e 64 20 2d 31 20 73 77 61 70 20 k @ and -1 swap
2de0: 2e 70 65 72 6d 61 6e 64 6f 72 0a 20 20 20 20 23 .permandor. #
2df0: 74 61 62 20 65 6d 69 74 20 6b 65 2d 69 6d 70 6f tab emit ke-impo
2e00: 72 74 73 20 40 20 2e 69 6d 70 6f 72 74 73 0a 20 rts @ .imports.
2e10: 20 20 20 73 70 61 63 65 20 2e 6e 69 63 6b 2b 70 space .nick+p
2e20: 65 74 20 3b 0a 3a 20 2e 6b 65 79 2d 6c 69 73 74 et ;.: .key-list
2e30: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b 65 ( o:key -- o:ke
2e40: 79 20 29 0a 20 20 20 20 6b 65 2d 6f 66 66 73 65 y ). ke-offse
2e50: 74 20 36 34 40 20 36 34 3e 64 20 6b 65 79 70 61 t 64@ 64>d keypa
2e60: 63 6b 2d 61 6c 6c 23 20 66 6d 2f 6d 6f 64 20 6e ck-all# fm/mod n
2e70: 69 70 20 33 20 2e 72 20 73 70 61 63 65 0a 20 20 ip 3 .r space.
2e80: 20 20 2e 6b 65 79 2d 72 65 73 74 20 63 72 20 3b .key-rest cr ;
2e90: 0a 3a 20 2e 73 65 63 72 65 74 2d 6e 69 63 6b 73 .: .secret-nicks
2ea0: 20 28 20 2d 2d 20 29 0a 20 20 20 20 30 20 6b 65 ( -- ). 0 ke
2eb0: 79 23 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 y# [: cell+ $@ d
2ec0: 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 20 6b 65 2d rop cell+ >o ke-
2ed0: 73 6b 20 40 20 49 46 0a 09 20 20 5b 3a 20 64 75 sk @ IF.. [: du
2ee0: 70 20 31 20 2e 72 20 3b 5d 20 23 33 36 20 62 61 p 1 .r ;] #36 ba
2ef0: 73 65 2d 65 78 65 63 75 74 65 20 73 70 61 63 65 se-execute space
2f00: 20 2e 6b 65 79 2d 72 65 73 74 20 63 72 20 31 2b .key-rest cr 1+
2f10: 0a 20 20 20 20 20 20 54 48 45 4e 20 6f 3e 20 3b . THEN o> ;
2f20: 5d 20 23 6d 61 70 20 64 72 6f 70 20 3b 0a 3a 20 ] #map drop ;.:
2f30: 2e 6b 65 79 2d 69 6e 76 69 74 65 20 28 20 6f 3a .key-invite ( o:
2f40: 6b 65 79 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 key -- o:key ).
2f50: 20 20 20 6b 65 2d 70 6b 20 24 40 20 6b 65 79 73 ke-pk $@ keys
2f60: 69 7a 65 20 75 6d 69 6e 0a 20 20 20 20 6b 65 2d ize umin. ke-
2f70: 69 6d 70 6f 72 74 73 20 40 20 3e 69 6d 2d 63 6f imports @ >im-co
2f80: 6c 6f 72 20 38 35 74 79 70 65 20 3c 64 65 66 61 lor 85type <defa
2f90: 75 6c 74 3e 0a 20 20 20 20 73 70 61 63 65 20 2e ult>. space .
2fa0: 6e 69 63 6b 20 73 70 61 63 65 20 3b 0a 3a 20 2e nick space ;.: .
2fb0: 6b 65 79 2d 73 68 6f 72 74 20 28 20 6f 3a 6b 65 key-short ( o:ke
2fc0: 79 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 20 20 y -- o:key ).
2fd0: 20 6b 65 2d 6e 69 63 6b 20 24 2e 20 6b 65 2d 70 ke-nick $. ke-p
2fe0: 72 6f 66 20 24 40 6c 65 6e 20 49 46 20 2e 22 20 rof $@len IF ."
2ff0: 20 70 72 6f 66 69 6c 65 3a 20 22 20 6b 65 2d 70 profile: " ke-p
3000: 72 6f 66 20 24 40 20 38 35 74 79 70 65 20 54 48 rof $@ 85type TH
3010: 45 4e 20 3b 0a 3a 20 6c 69 73 74 2d 6b 65 79 73 EN ;.: list-keys
3020: 20 28 20 2d 2d 20 29 0a 20 20 20 20 2e 22 20 6e ( -- ). ." n
3030: 75 6d 20 70 75 62 6b 65 79 20 20 20 20 20 20 20 um pubkey
3040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3050: 20 20 20 20 20 20 20 20 20 20 20 20 64 61 74 65 date
3060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3070: 20 20 20 20 20 67 72 70 2b 70 65 72 6d 09 68 20 grp+perm.h
3080: 6e 69 63 6b 22 20 63 72 0a 20 20 20 20 6b 65 79 nick" cr. key
3090: 23 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 # [: cell+ $@ dr
30a0: 6f 70 20 63 65 6c 6c 2b 20 2e 2e 6b 65 79 2d 6c op cell+ ..key-l
30b0: 69 73 74 20 3b 5d 20 23 6d 61 70 20 3b 0a 3a 20 ist ;] #map ;.:
30c0: 6c 69 73 74 2d 6e 69 63 6b 73 20 28 20 2d 2d 20 list-nicks ( --
30d0: 29 0a 20 20 20 20 6e 69 63 6b 23 20 5b 3a 20 64 ). nick# [: d
30e0: 75 70 20 24 2e 20 2e 22 20 3a 22 20 63 72 20 63 up $. ." :" cr c
30f0: 65 6c 6c 2b 20 24 40 20 62 6f 75 6e 64 73 20 3f ell+ $@ bounds ?
3100: 44 4f 0a 09 20 20 49 20 40 20 2e 2e 6b 65 79 2d DO.. I @ ..key-
3110: 6c 69 73 74 20 20 63 65 6c 6c 20 2b 4c 4f 4f 50 list cell +LOOP
3120: 20 3b 5d 20 23 6d 61 70 20 3b 0a 0a 3a 20 64 75 ;] #map ;..: du
3130: 6d 70 6b 65 79 20 28 20 61 64 64 72 20 75 20 2d mpkey ( addr u -
3140: 2d 20 29 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3e - ) drop cell+ >
3150: 6f 0a 20 20 20 20 2e 5c 22 20 78 5c 22 20 22 20 o. .\" x\" "
3160: 6b 65 2d 70 6b 20 24 40 20 38 35 74 79 70 65 20 ke-pk $@ 85type
3170: 2e 5c 22 20 5c 22 20 6b 65 79 3f 6e 65 77 22 20 .\" \" key?new"
3180: 63 72 0a 20 20 20 20 6b 65 2d 73 6b 20 40 20 49 cr. ke-sk @ I
3190: 46 20 20 2e 5c 22 20 78 5c 22 20 22 20 6b 65 2d F .\" x\" " ke-
31a0: 73 6b 20 40 20 6b 65 79 73 69 7a 65 20 38 35 74 sk @ keysize 85t
31b0: 79 70 65 20 2e 5c 22 20 5c 22 20 6b 65 2d 73 6b ype .\" \" ke-sk
31c0: 20 73 65 63 21 20 2b 73 65 63 6b 65 79 22 20 63 sec! +seckey" c
31d0: 72 20 20 54 48 45 4e 0a 20 20 20 20 27 22 27 20 r THEN. '"'
31e0: 65 6d 69 74 20 2e 6e 69 63 6b 20 2e 5c 22 20 5c emit .nick .\" \
31f0: 22 20 6b 65 2d 6e 69 63 6b 20 24 21 20 22 0a 20 " ke-nick $! ".
3200: 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 ke-selfsig $@
3210: 20 64 72 6f 70 20 36 34 40 20 36 34 3e 64 20 5b drop 64@ 64>d [
3220: 3a 20 27 24 27 20 65 6d 69 74 20 30 20 75 64 2e : '$' emit 0 ud.
3230: 72 20 3b 5d 20 24 31 30 20 62 61 73 65 2d 65 78 r ;] $10 base-ex
3240: 65 63 75 74 65 0a 20 20 20 20 2e 22 20 2e 20 64 ecute. ." . d
3250: 3e 36 34 20 6b 65 2d 66 69 72 73 74 21 20 22 20 >64 ke-first! "
3260: 6b 65 2d 74 79 70 65 20 40 20 2e 20 2e 22 20 6b ke-type @ . ." k
3270: 65 2d 74 79 70 65 20 21 22 20 20 63 72 20 6f 3e e-type !" cr o>
3280: 20 3b 0a 0a 3a 20 2e 6b 65 79 73 20 28 20 2d 2d ;..: .keys ( --
3290: 20 29 20 6b 65 79 23 20 5b 3a 20 2e 22 20 69 6e ) key# [: ." in
32a0: 64 65 78 3a 20 22 20 64 75 70 20 24 40 20 38 35 dex: " dup $@ 85
32b0: 74 79 70 65 20 63 72 20 63 65 6c 6c 2b 20 24 40 type cr cell+ $@
32c0: 20 2e 6b 65 79 20 3b 5d 20 23 6d 61 70 20 3b 0a .key ;] #map ;.
32d0: 3a 20 64 75 6d 70 6b 65 79 73 20 28 20 2d 2d 20 : dumpkeys ( --
32e0: 29 20 6b 65 79 23 20 5b 3a 20 63 65 6c 6c 2b 20 ) key# [: cell+
32f0: 24 40 20 64 75 6d 70 6b 65 79 20 3b 5d 20 23 6d $@ dumpkey ;] #m
3300: 61 70 20 3b 0a 0a 3a 20 6b 65 79 3e 6e 69 63 6b ap ;..: key>nick
3310: 20 28 20 61 64 64 72 6b 65 79 20 75 31 20 2d 2d ( addrkey u1 --
3320: 20 6e 69 63 6b 20 75 32 20 29 0a 20 20 20 20 5c nick u2 ). \
3330: 47 20 63 6f 6e 76 65 72 74 20 6b 65 79 20 74 6f G convert key to
3340: 20 6e 69 63 6b 0a 20 20 20 20 6b 65 79 7c 20 6b nick. key| k
3350: 65 79 23 20 23 40 20 30 3d 20 49 46 20 20 64 72 ey# #@ 0= IF dr
3360: 6f 70 20 23 30 2e 20 20 45 58 49 54 20 20 54 48 op #0. EXIT TH
3370: 45 4e 0a 20 20 20 20 63 65 6c 6c 2b 20 2e 6b 65 EN. cell+ .ke
3380: 2d 6e 69 63 6b 20 24 40 20 3b 0a 3a 20 6b 65 79 -nick $@ ;.: key
3390: 3e 6b 65 79 20 28 20 61 64 64 72 6b 65 79 20 75 >key ( addrkey u
33a0: 31 20 2d 2d 20 6b 65 79 20 75 32 20 29 0a 20 20 1 -- key u2 ).
33b0: 20 20 5c 47 20 65 78 70 61 6e 64 20 6b 65 79 20 \G expand key
33c0: 74 6f 20 66 75 6c 6c 20 73 69 7a 65 20 61 6e 64 to full size and
33d0: 20 63 68 65 63 6b 20 69 66 20 77 65 20 6b 6e 6f check if we kno
33e0: 77 20 69 74 0a 20 20 20 20 6b 65 79 7c 20 6b 65 w it. key| ke
33f0: 79 23 20 23 40 20 30 3d 20 49 46 20 20 64 72 6f y# #@ 0= IF dro
3400: 70 20 23 30 2e 20 20 45 58 49 54 20 20 54 48 45 p #0. EXIT THE
3410: 4e 0a 20 20 20 20 63 65 6c 6c 2b 20 2e 6b 65 2d N. cell+ .ke-
3420: 70 6b 20 24 40 20 3b 0a 0a 3a 20 2e 6b 65 79 23 pk $@ ;..: .key#
3430: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 6b ( addr u -- ) k
3440: 65 79 7c 0a 20 20 20 20 2e 22 20 4b 65 79 20 27 ey|. ." Key '
3450: 22 20 6b 65 79 23 20 23 40 20 30 3d 20 49 46 20 " key# #@ 0= IF
3460: 64 72 6f 70 20 45 58 49 54 20 54 48 45 4e 0a 20 drop EXIT THEN.
3470: 20 20 20 63 65 6c 6c 2b 20 2e 2e 6e 69 63 6b 20 cell+ ..nick
3480: 2e 22 20 27 20 6f 6b 22 20 63 72 20 3b 0a 0a 44 ." ' ok" cr ;..D
3490: 65 66 65 72 20 64 68 74 2d 6e 69 63 6b 3f 0a 65 efer dht-nick?.e
34a0: 76 65 6e 74 3a 20 2d 3e 73 65 61 72 63 68 2d 6b vent: ->search-k
34b0: 65 79 20 20 6b 65 79 7c 20 6f 76 65 72 20 3e 72 ey key| over >r
34c0: 20 64 68 74 2d 6e 69 63 6b 3f 20 72 3e 20 66 72 dht-nick? r> fr
34d0: 65 65 20 74 68 72 6f 77 20 3b 0a 0a 3a 20 2e 75 ee throw ;..: .u
34e0: 6e 6b 65 79 2d 69 64 20 28 20 61 64 64 72 20 75 nkey-id ( addr u
34f0: 20 2d 2d 20 29 20 3c 65 72 72 3e 20 38 20 75 6d -- ) <err> 8 um
3500: 69 6e 20 38 35 74 79 70 65 20 2e 22 20 28 75 6e in 85type ." (un
3510: 6b 6e 6f 77 6e 29 22 20 3c 64 65 66 61 75 6c 74 known)" <default
3520: 3e 20 3b 0a 0a 56 61 72 69 61 62 6c 65 20 75 6e > ;..Variable un
3530: 6b 65 79 2d 69 64 23 0a 23 36 30 2e 30 30 30 2e key-id#.#60.000.
3540: 30 30 30 2e 30 30 30 20 64 3e 36 34 20 36 34 43 000.000 d>64 64C
3550: 6f 6e 73 74 61 6e 74 20 75 6e 6b 65 79 2d 74 6f onstant unkey-to
3560: 23 0a 3a 20 3f 75 6e 6b 65 79 20 28 20 61 64 64 #.: ?unkey ( add
3570: 72 20 75 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 r u -- flag ).
3580: 20 20 75 6e 6b 65 79 2d 69 64 23 20 23 40 0a 20 unkey-id# #@.
3590: 20 20 20 49 46 20 20 36 34 40 20 75 6e 6b 65 79 IF 64@ unkey
35a0: 2d 74 6f 23 20 36 34 2b 20 74 69 63 6b 73 20 36 -to# 64+ ticks 6
35b0: 34 2d 20 36 34 2d 30 3e 3d 20 20 54 48 45 4e 20 4- 64-0>= THEN
35c0: 20 30 3d 20 3b 0a 20 20 20 20 0a 3a 20 2e 6b 65 0= ;. .: .ke
35d0: 79 2d 69 64 20 28 20 61 64 64 72 20 75 20 2d 2d y-id ( addr u --
35e0: 20 29 20 6b 65 79 7c 20 32 64 75 70 20 6b 65 79 ) key| 2dup key
35f0: 23 20 23 40 20 30 3d 0a 20 20 20 20 49 46 20 20 # #@ 0=. IF
3600: 64 72 6f 70 20 75 70 40 20 72 65 63 65 69 76 65 drop up@ receive
3610: 72 2d 74 61 73 6b 20 3d 20 49 46 0a 09 20 20 20 r-task = IF..
3620: 20 3c 65 76 65 6e 74 20 32 64 75 70 20 73 61 76 <event 2dup sav
3630: 65 2d 6d 65 6d 20 65 24 2c 20 2d 3e 73 65 61 72 e-mem e$, ->sear
3640: 63 68 2d 6b 65 79 20 6d 61 69 6e 2d 75 70 40 20 ch-key main-up@
3650: 65 76 65 6e 74 3e 0a 09 20 20 20 20 2e 75 6e 6b event>.. .unk
3660: 65 79 2d 69 64 20 45 58 49 54 20 20 54 48 45 4e ey-id EXIT THEN
3670: 0a 09 32 64 75 70 20 3f 75 6e 6b 65 79 20 20 49 ..2dup ?unkey I
3680: 46 0a 09 20 20 20 20 74 69 63 6b 73 20 7b 20 36 F.. ticks { 6
3690: 34 5e 20 74 78 20 7d 20 74 78 20 31 20 36 34 73 4^ tx } tx 1 64s
36a0: 20 32 6f 76 65 72 20 75 6e 6b 65 79 2d 69 64 23 2over unkey-id#
36b0: 20 23 21 0a 09 20 20 20 20 63 6f 6e 6e 65 63 74 #!.. connect
36c0: 69 6f 6e 20 3e 72 20 32 64 75 70 20 5b 27 5d 20 ion >r 2dup [']
36d0: 64 68 74 2d 6e 69 63 6b 3f 20 63 6d 64 2d 6e 65 dht-nick? cmd-ne
36e0: 73 74 20 72 3e 20 74 6f 20 63 6f 6e 6e 65 63 74 st r> to connect
36f0: 69 6f 6e 0a 09 20 20 20 20 32 64 75 70 20 6b 65 ion.. 2dup ke
3700: 79 23 20 23 40 20 30 3d 20 49 46 20 20 64 72 6f y# #@ 0= IF dro
3710: 70 20 2e 75 6e 6b 65 79 2d 69 64 20 45 58 49 54 p .unkey-id EXIT
3720: 0a 09 20 20 20 20 45 4c 53 45 20 20 3e 72 20 32 .. ELSE >r 2
3730: 64 75 70 20 75 6e 6b 65 79 2d 69 64 23 20 23 6f dup unkey-id# #o
3740: 66 66 20 72 3e 20 20 54 48 45 4e 0a 09 45 4c 53 ff r> THEN..ELS
3750: 45 20 20 2e 75 6e 6b 65 79 2d 69 64 20 20 45 58 E .unkey-id EX
3760: 49 54 20 20 54 48 45 4e 0a 20 20 20 20 54 48 45 IT THEN. THE
3770: 4e 0a 20 20 20 20 63 65 6c 6c 2b 20 2e 2e 6e 69 N. cell+ ..ni
3780: 63 6b 20 32 64 72 6f 70 20 3b 0a 0a 3a 20 2e 63 ck 2drop ;..: .c
3790: 6f 6e 2d 69 64 20 28 20 6f 3a 63 6f 6e 6e 65 63 on-id ( o:connec
37a0: 74 69 6f 6e 20 2d 2d 20 29 20 70 75 62 6b 65 79 tion -- ) pubkey
37b0: 20 24 40 20 2e 6b 65 79 2d 69 64 20 3b 0a 0a 3a $@ .key-id ;..:
37c0: 20 2e 73 69 6d 70 6c 65 2d 69 64 20 28 20 61 64 .simple-id ( ad
37d0: 64 72 20 75 20 2d 2d 20 29 20 6b 65 79 3e 6e 69 dr u -- ) key>ni
37e0: 63 6b 20 74 79 70 65 20 3b 0a 0a 3a 20 63 68 65 ck type ;..: che
37f0: 63 6b 2d 6b 65 79 20 28 20 61 64 64 72 20 75 20 ck-key ( addr u
3800: 2d 2d 20 29 0a 20 20 20 20 6f 20 49 46 20 20 70 -- ). o IF p
3810: 75 62 6b 65 79 20 40 20 49 46 0a 09 20 20 20 20 ubkey @ IF..
3820: 32 64 75 70 20 70 75 62 6b 65 79 20 24 40 20 6b 2dup pubkey $@ k
3830: 65 79 7c 20 73 74 72 3d 20 30 3d 20 49 46 0a 09 ey| str= 0= IF..
3840: 09 5b 3a 20 2e 22 20 77 61 6e 74 3a 20 22 20 70 .[: ." want: " p
3850: 75 62 6b 65 79 20 24 40 20 6b 65 79 7c 20 38 35 ubkey $@ key| 85
3860: 74 79 70 65 20 63 72 0a 09 09 20 20 2e 22 20 67 type cr... ." g
3870: 6f 74 20 3a 20 22 20 32 64 75 70 20 38 35 74 79 ot : " 2dup 85ty
3880: 70 65 20 63 72 20 3b 5d 20 24 65 72 72 0a 09 09 pe cr ;] $err...
3890: 74 72 75 65 20 21 21 77 72 6f 6e 67 2d 6b 65 79 true !!wrong-key
38a0: 21 21 0a 09 20 20 20 20 54 48 45 4e 0a 09 20 20 !!.. THEN..
38b0: 20 20 63 6f 6e 6e 65 63 74 28 20 2e 6b 65 79 23 connect( .key#
38c0: 20 29 65 6c 73 65 28 20 32 64 72 6f 70 20 29 20 )else( 2drop )
38d0: 20 45 58 49 54 0a 09 54 48 45 4e 20 20 54 48 45 EXIT..THEN THE
38e0: 4e 0a 20 20 20 20 32 64 75 70 20 6b 65 79 2d 65 N. 2dup key-e
38f0: 78 69 73 74 3f 0a 20 20 20 20 3f 64 75 70 2d 30 xist?. ?dup-0
3900: 3d 2d 49 46 20 20 70 65 72 6d 25 75 6e 6b 6e 6f =-IF perm%unkno
3910: 77 6e 20 20 45 4c 53 45 20 20 2e 6b 65 2d 6d 61 wn ELSE .ke-ma
3920: 73 6b 20 40 20 20 54 48 45 4e 20 20 74 6d 70 2d sk @ THEN tmp-
3930: 70 65 72 6d 20 21 0a 20 20 20 20 63 6f 6e 6e 65 perm !. conne
3940: 63 74 28 20 32 64 75 70 20 2e 6b 65 79 23 20 29 ct( 2dup .key# )
3950: 0a 20 20 20 20 74 6d 70 2d 70 65 72 6d 20 40 20 . tmp-perm @
3960: 70 65 72 6d 25 62 6c 6f 63 6b 65 64 20 61 6e 64 perm%blocked and
3970: 20 49 46 0a 09 5b 3a 20 2e 22 20 55 6e 6b 6e 6f IF..[: ." Unkno
3980: 77 6e 20 6b 65 79 2c 20 63 6f 6e 6e 65 63 74 69 wn key, connecti
3990: 6f 6e 20 72 65 66 75 73 65 64 3a 20 22 20 38 35 on refused: " 85
39a0: 74 79 70 65 20 63 72 20 3b 5d 20 24 65 72 72 0a type cr ;] $err.
39b0: 09 74 72 75 65 20 21 21 63 6f 6e 6e 65 63 74 2d .true !!connect-
39c0: 70 65 72 6d 21 21 0a 20 20 20 20 45 4c 53 45 20 perm!!. ELSE
39d0: 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 2drop THEN ;..
39e0: 3a 20 73 65 61 72 63 68 2d 6b 65 79 20 28 20 70 : search-key ( p
39f0: 6b 63 20 2d 2d 20 73 6b 63 20 29 0a 20 20 20 20 kc -- skc ).
3a00: 6b 65 79 73 69 7a 65 20 6b 65 79 23 20 23 40 20 keysize key# #@
3a10: 30 3d 20 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 79 0= !!unknown-key
3a20: 21 21 0a 20 20 20 20 63 65 6c 6c 2b 20 2e 6b 65 !!. cell+ .ke
3a30: 2d 73 6b 20 73 65 63 40 20 30 3d 20 21 21 75 6e -sk sec@ 0= !!un
3a40: 6b 6e 6f 77 6e 2d 6b 65 79 21 21 20 3b 0a 0a 5c known-key!! ;..\
3a50: 20 61 70 70 6c 79 20 70 65 72 6d 69 73 73 69 6f apply permissio
3a60: 6e 73 26 67 72 6f 75 70 73 0a 0a 3a 20 61 70 70 ns&groups..: app
3a70: 6c 79 2d 70 65 72 6d 69 73 73 69 6f 6e 20 28 20 ly-permission (
3a80: 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72 20 6f permand permor o
3a90: 3a 6b 65 79 20 2d 2d 20 70 65 72 6d 61 6e 64 20 :key -- permand
3aa0: 70 65 72 6d 6f 72 20 6f 3a 6b 65 79 20 29 0a 20 permor o:key ).
3ab0: 20 20 20 6f 76 65 72 20 6b 65 2d 6d 61 73 6b 20 over ke-mask
3ac0: 40 20 61 6e 64 20 6f 76 65 72 20 6f 72 20 6b 65 @ and over or ke
3ad0: 2d 6d 61 73 6b 20 21 20 2e 6b 65 79 2d 6c 69 73 -mask ! .key-lis
3ae0: 74 20 3b 0a 0a 3a 20 2d 67 72 6f 75 70 2d 70 65 t ;..: -group-pe
3af0: 72 6d 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a rm ( o:key -- ).
3b00: 20 20 20 20 6b 65 2d 67 72 6f 75 70 73 20 24 40 ke-groups $@
3b10: 20 67 72 6f 75 70 73 3e 6d 61 73 6b 20 69 6e 76 groups>mask inv
3b20: 65 72 74 20 6b 65 2d 6d 61 73 6b 20 61 6e 64 21 ert ke-mask and!
3b30: 20 3b 0a 3a 20 2b 67 72 6f 75 70 2d 70 65 72 6d ;.: +group-perm
3b40: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 ( o:key -- ).
3b50: 20 20 6b 65 2d 67 72 6f 75 70 73 20 24 40 20 67 ke-groups $@ g
3b60: 72 6f 75 70 73 3e 6d 61 73 6b 20 20 20 20 20 20 roups>mask
3b70: 20 20 6b 65 2d 6d 61 73 6b 20 6f 72 21 20 3b 0a ke-mask or! ;.
3b80: 0a 3a 20 61 64 64 2d 67 72 6f 75 70 20 28 20 69 .: add-group ( i
3b90: 64 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 d o:key -- ).
3ba0: 20 64 75 70 20 2d 31 20 3d 20 21 21 6e 6f 2d 67 dup -1 = !!no-g
3bb0: 72 6f 75 70 21 21 20 2d 67 72 6f 75 70 2d 70 65 roup!! -group-pe
3bc0: 72 6d 20 63 6d 64 74 6d 70 24 20 6b 65 2d 67 72 rm cmdtmp$ ke-gr
3bd0: 6f 75 70 73 20 24 2b 21 20 2b 67 72 6f 75 70 2d oups $+! +group-
3be0: 70 65 72 6d 20 3b 0a 3a 20 73 65 74 2d 67 72 6f perm ;.: set-gro
3bf0: 75 70 20 28 20 69 64 20 6f 3a 6b 65 79 20 2d 2d up ( id o:key --
3c00: 20 29 0a 20 20 20 20 64 75 70 20 2d 31 20 3d 20 ). dup -1 =
3c10: 21 21 6e 6f 2d 67 72 6f 75 70 21 21 20 2d 67 72 !!no-group!! -gr
3c20: 6f 75 70 2d 70 65 72 6d 20 63 6d 64 74 6d 70 24 oup-perm cmdtmp$
3c30: 20 6b 65 2d 67 72 6f 75 70 73 20 24 21 20 2b 67 ke-groups $! +g
3c40: 72 6f 75 70 2d 70 65 72 6d 20 3b 0a 3a 20 73 75 roup-perm ;.: su
3c50: 62 2d 67 72 6f 75 70 20 28 20 69 64 20 6f 3a 6b b-group ( id o:k
3c60: 65 79 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 ey -- ). dup
3c70: 2d 31 20 3d 20 21 21 6e 6f 2d 67 72 6f 75 70 21 -1 = !!no-group!
3c80: 21 20 2d 67 72 6f 75 70 2d 70 65 72 6d 20 63 6d ! -group-perm cm
3c90: 64 74 6d 70 24 20 6b 65 2d 67 72 6f 75 70 73 20 dtmp$ ke-groups
3ca0: 24 40 20 32 6f 76 65 72 20 73 65 61 72 63 68 0a $@ 2over search.
3cb0: 20 20 20 20 49 46 20 20 20 6e 69 70 20 3e 72 20 IF nip >r
3cc0: 6e 69 70 20 6b 65 2d 67 72 6f 75 70 73 20 64 75 nip ke-groups du
3cd0: 70 20 24 40 6c 65 6e 20 72 3e 20 2d 20 72 6f 74 p $@len r> - rot
3ce0: 20 24 64 65 6c 0a 20 20 20 20 45 4c 53 45 20 20 $del. ELSE
3cf0: 32 64 72 6f 70 20 32 64 72 6f 70 20 20 54 48 45 2drop 2drop THE
3d00: 4e 20 2b 67 72 6f 75 70 2d 70 65 72 6d 20 3b 0a N +group-perm ;.
3d10: 0a 3a 20 61 70 70 6c 79 2d 67 72 6f 75 70 20 28 .: apply-group (
3d20: 20 61 64 64 72 20 75 20 6f 3a 6b 65 79 20 2d 2d addr u o:key --
3d30: 20 29 0a 20 20 20 20 6f 76 65 72 20 63 40 20 27 ). over c@ '
3d40: 2b 27 20 3d 20 49 46 20 20 31 20 2f 73 74 72 69 +' = IF 1 /stri
3d50: 6e 67 20 3e 67 72 6f 75 70 2d 69 64 20 61 64 64 ng >group-id add
3d60: 2d 67 72 6f 75 70 20 2e 6b 65 79 2d 6c 69 73 74 -group .key-list
3d70: 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 EXIT THEN.
3d80: 20 6f 76 65 72 20 63 40 20 27 2d 27 20 3d 20 49 over c@ '-' = I
3d90: 46 20 20 31 20 2f 73 74 72 69 6e 67 20 3e 67 72 F 1 /string >gr
3da0: 6f 75 70 2d 69 64 20 73 75 62 2d 67 72 6f 75 70 oup-id sub-group
3db0: 20 2e 6b 65 79 2d 6c 69 73 74 20 20 45 58 49 54 .key-list EXIT
3dc0: 20 20 54 48 45 4e 0a 20 20 20 20 3e 67 72 6f 75 THEN. >grou
3dd0: 70 2d 69 64 20 73 65 74 2d 67 72 6f 75 70 20 2e p-id set-group .
3de0: 6b 65 79 2d 6c 69 73 74 20 3b 0a 0a 5c 20 67 65 key-list ;..\ ge
3df0: 74 20 70 61 73 73 70 68 72 61 73 65 0a 0a 33 20 t passphrase..3
3e00: 56 61 6c 75 65 20 70 61 73 73 70 68 72 61 73 65 Value passphrase
3e10: 2d 72 65 74 72 79 23 0a 24 31 30 30 20 43 6f 6e -retry#.$100 Con
3e20: 73 74 61 6e 74 20 6d 61 78 2d 70 61 73 73 70 68 stant max-passph
3e30: 72 61 73 65 23 20 5c 20 32 35 36 20 63 68 61 72 rase# \ 256 char
3e40: 61 63 74 65 72 73 20 73 68 6f 75 6c 64 20 62 65 acters should be
3e50: 20 65 6e 6f 75 67 68 2e 2e 2e 0a 6d 61 78 2d 70 enough....max-p
3e60: 61 73 73 70 68 72 61 73 65 23 20 62 75 66 66 65 assphrase# buffe
3e70: 72 3a 20 70 61 73 73 70 68 72 61 73 65 0a 0a 3a r: passphrase..:
3e80: 20 70 61 73 73 70 68 72 61 73 65 2d 69 6e 20 28 passphrase-in (
3e90: 20 61 64 64 72 20 75 20 2d 2d 20 61 64 64 72 20 addr u -- addr
3ea0: 75 20 29 0a 20 20 20 20 22 50 41 53 53 50 48 52 u ). "PASSPHR
3eb0: 41 53 45 22 20 67 65 74 65 6e 76 20 32 64 75 70 ASE" getenv 2dup
3ec0: 20 64 30 3d 20 49 46 20 20 32 64 72 6f 70 20 74 d0= IF 2drop t
3ed0: 79 70 65 0a 09 70 61 73 73 70 68 72 61 73 65 20 ype..passphrase
3ee0: 64 75 70 20 6d 61 78 2d 70 61 73 73 70 68 72 61 dup max-passphra
3ef0: 73 65 23 20 61 63 63 65 70 74 2a 20 63 72 0a 20 se# accept* cr.
3f00: 20 20 20 45 4c 53 45 20 20 32 6e 69 70 20 20 54 ELSE 2nip T
3f10: 48 45 4e 20 3b 0a 0a 3a 20 3e 70 61 73 73 70 68 HEN ;..: >passph
3f20: 72 61 73 65 20 28 20 61 64 64 72 20 75 20 2d 2d rase ( addr u --
3f30: 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 5c 47 addr u ). \G
3f40: 20 63 72 65 61 74 65 20 61 20 35 31 32 20 62 69 create a 512 bi
3f50: 74 20 68 61 73 68 20 6f 66 20 74 68 65 20 70 61 t hash of the pa
3f60: 73 73 70 68 72 61 73 65 0a 20 20 20 20 6e 6f 2d ssphrase. no-
3f70: 6b 65 79 20 3e 63 3a 6b 65 79 20 63 3a 68 61 73 key >c:key c:has
3f80: 68 0a 20 20 20 20 6b 65 63 63 61 6b 2d 70 61 64 h. keccak-pad
3f90: 64 65 64 20 63 3a 6b 65 79 3e 20 6b 65 63 63 61 ded c:key> kecca
3fa0: 6b 2d 70 61 64 64 65 64 20 6b 65 63 63 61 6b 23 k-padded keccak#
3fb0: 6d 61 78 20 32 2f 20 3b 0a 0a 3a 20 67 65 74 2d max 2/ ;..: get-
3fc0: 70 61 73 73 70 68 72 61 73 65 20 28 20 61 64 64 passphrase ( add
3fd0: 72 20 75 20 2d 2d 20 61 64 64 72 20 75 20 29 0a r u -- addr u ).
3fe0: 20 20 20 20 70 61 73 73 70 68 72 61 73 65 2d 69 passphrase-i
3ff0: 6e 20 3e 70 61 73 73 70 68 72 61 73 65 20 3b 0a n >passphrase ;.
4000: 0a 56 61 72 69 61 62 6c 65 20 6b 65 79 73 0a 0a .Variable keys..
4010: 3a 20 6c 61 73 74 6b 65 79 40 20 28 20 2d 2d 20 : lastkey@ ( --
4020: 61 64 64 72 20 75 20 29 20 6b 65 79 73 20 24 5b addr u ) keys $[
4030: 5d 23 20 31 2d 20 6b 65 79 73 20 73 65 63 5b 5d ]# 1- keys sec[]
4040: 40 20 3b 0a 3a 20 6b 65 79 3e 64 65 66 61 75 6c @ ;.: key>defaul
4050: 74 20 28 20 2d 2d 20 29 20 6c 61 73 74 6b 65 79 t ( -- ) lastkey
4060: 40 20 64 72 6f 70 20 3e 73 74 6f 72 65 6b 65 79 @ drop >storekey
4070: 20 21 20 3b 0a 3a 20 2b 6b 65 79 20 28 20 61 64 ! ;.: +key ( ad
4080: 64 72 20 75 20 2d 2d 20 29 20 6b 65 79 73 20 73 dr u -- ) keys s
4090: 65 63 2b 5b 5d 21 20 3b 0a 3a 20 2b 70 61 73 73 ec+[]! ;.: +pass
40a0: 70 68 72 61 73 65 20 28 20 61 64 64 72 20 75 20 phrase ( addr u
40b0: 2d 2d 20 29 20 20 67 65 74 2d 70 61 73 73 70 68 -- ) get-passph
40c0: 72 61 73 65 20 2b 6b 65 79 20 3b 0a 3a 20 2b 63 rase +key ;.: +c
40d0: 68 65 63 6b 70 68 72 61 73 65 20 28 20 61 64 64 heckphrase ( add
40e0: 72 20 75 20 2d 2d 20 66 6c 61 67 20 29 20 67 65 r u -- flag ) ge
40f0: 74 2d 70 61 73 73 70 68 72 61 73 65 20 6c 61 73 t-passphrase las
4100: 74 6b 65 79 40 20 73 74 72 3d 20 3b 0a 3a 20 2b tkey@ str= ;.: +
4110: 6e 65 77 70 68 72 61 73 65 20 28 20 2d 2d 20 29 newphrase ( -- )
4120: 0a 20 20 20 20 42 45 47 49 4e 0a 09 73 22 20 50 . BEGIN..s" P
4130: 61 73 73 70 68 72 61 73 65 3a 20 22 20 2b 70 61 assphrase: " +pa
4140: 73 73 70 68 72 61 73 65 0a 09 73 22 20 52 65 74 ssphrase..s" Ret
4150: 79 70 65 20 70 6c 73 3a 20 22 20 2b 63 68 65 63 ype pls: " +chec
4160: 6b 70 68 72 61 73 65 20 30 3d 20 57 48 49 4c 45 kphrase 0= WHILE
4170: 0a 09 20 20 20 20 63 72 20 2e 22 20 20 64 69 64 .. cr ." did
4180: 6e 27 74 20 6d 61 74 63 68 2c 20 74 72 79 20 61 n't match, try a
4190: 67 61 69 6e 20 70 6c 65 61 73 65 22 20 63 72 0a gain please" cr.
41a0: 20 20 20 20 52 45 50 45 41 54 20 63 72 20 3b 0a REPEAT cr ;.
41b0: 0a 3a 20 22 3e 70 61 73 73 70 68 72 61 73 65 20 .: ">passphrase
41c0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 3e 70 ( addr u -- ) >p
41d0: 61 73 73 70 68 72 61 73 65 20 2b 6b 65 79 20 3b assphrase +key ;
41e0: 0a 3a 20 3e 73 65 63 6b 65 79 20 28 20 2d 2d 20 .: >seckey ( --
41f0: 61 64 64 72 20 75 20 29 0a 20 20 20 20 6b 65 2d addr u ). ke-
4200: 73 6b 20 40 20 6b 65 2d 70 6b 20 24 40 20 64 72 sk @ ke-pk $@ dr
4210: 6f 70 20 6b 65 79 70 61 64 20 65 64 2d 64 68 20 op keypad ed-dh
4220: 3b 0a 3a 20 2b 73 65 63 6b 65 79 20 28 20 2d 2d ;.: +seckey ( --
4230: 20 29 20 3e 73 65 63 6b 65 79 20 2b 6b 65 79 20 ) >seckey +key
4240: 3b 0a 0a 5c 20 22 22 20 22 3e 70 61 73 73 70 68 ;..\ "" ">passph
4250: 72 61 73 65 20 5c 20 66 6f 6c 6c 6f 77 69 6e 67 rase \ following
4260: 20 74 68 65 20 65 6e 63 72 79 70 74 2d 65 76 65 the encrypt-eve
4270: 72 79 74 68 69 6e 67 20 70 61 72 61 64 69 67 6d rything paradigm
4280: 2c 0a 5c 20 6e 6f 20 70 61 73 73 77 6f 72 64 20 ,.\ no password
4290: 69 73 20 74 68 65 20 65 6d 70 74 79 20 73 74 72 is the empty str
42a0: 69 6e 67 21 20 20 49 74 27 73 20 73 74 69 6c 6c ing! It's still
42b0: 20 65 6e 63 72 79 70 74 65 64 20 3b 2d 29 21 0a encrypted ;-)!.
42c0: 0a 5c 20 61 20 73 65 63 72 65 74 20 6b 65 79 20 .\ a secret key
42d0: 6a 75 73 74 20 6e 65 65 64 73 20 61 20 6e 69 63 just needs a nic
42e0: 6b 20 61 6e 64 20 61 20 74 79 70 65 2e 0a 5c 20 k and a type..\
42f0: 53 65 63 72 65 74 20 6b 65 79 73 20 63 61 6e 20 Secret keys can
4300: 62 65 20 70 65 72 73 6f 6e 73 20 61 6e 64 20 67 be persons and g
4310: 72 6f 75 70 73 2e 0a 0a 5c 20 61 20 70 75 62 6c roups...\ a publ
4320: 69 63 20 6b 65 79 20 6e 65 65 64 73 20 6d 6f 72 ic key needs mor
4330: 65 3a 20 6e 69 63 6b 2c 20 74 79 70 65 2c 20 70 e: nick, type, p
4340: 72 6f 66 69 6c 65 2e 0a 5c 20 54 68 65 20 70 72 rofile..\ The pr
4350: 6f 66 69 6c 65 20 69 73 20 61 20 73 74 72 75 63 ofile is a struc
4360: 74 75 72 65 64 20 64 6f 63 75 6d 65 6e 74 2c 20 tured document,
4370: 69 2e 65 2e 20 70 6f 69 6e 74 65 64 20 74 6f 20 i.e. pointed to
4380: 62 79 20 61 20 68 61 73 68 2e 0a 0a 5c 20 61 20 by a hash...\ a
4390: 73 69 67 6e 61 74 75 72 65 20 63 6f 6e 74 61 69 signature contai
43a0: 6e 73 20 61 20 70 75 62 6b 65 79 2c 20 61 20 63 ns a pubkey, a c
43b0: 68 65 63 6b 62 6f 78 20 62 69 74 6d 61 73 6b 2c heckbox bitmask,
43c0: 0a 5c 20 61 20 64 61 74 65 2c 20 61 6e 20 65 78 .\ a date, an ex
43d0: 70 69 72 61 74 69 6f 6e 20 64 61 74 65 2c 20 74 piration date, t
43e0: 68 65 20 73 69 67 6e 65 72 27 73 20 70 75 62 6b he signer's pubk
43f0: 65 79 20 61 6e 64 20 74 68 65 20 73 69 67 6e 61 ey and the signa
4400: 74 75 72 65 20 69 74 73 65 6c 66 0a 5c 20 28 72 ture itself.\ (r
4410: 2b 73 29 2e 20 20 54 68 65 72 65 20 69 73 20 61 +s). There is a
4420: 6e 20 6f 70 74 69 6f 6e 61 6c 20 73 69 67 6e 69 n optional signi
4430: 6e 67 20 70 72 6f 74 6f 63 6f 6c 20 64 6f 63 75 ng protocol docu
4440: 6d 65 6e 74 20 28 68 61 73 68 29 2e 0a 0a 5c 20 ment (hash)...\
4450: 77 65 20 73 74 6f 72 65 20 65 61 63 68 20 69 74 we store each it
4460: 65 6d 20 69 6e 20 61 20 32 35 36 20 62 79 74 65 em in a 256 byte
4470: 73 20 65 6e 63 72 79 70 74 65 64 20 73 74 72 69 s encrypted stri
4480: 6e 67 2c 20 69 2e 65 2e 20 77 69 74 68 20 61 20 ng, i.e. with a
4490: 31 36 0a 5c 20 62 79 74 65 20 73 61 6c 74 20 61 16.\ byte salt a
44a0: 6e 64 20 61 20 31 36 20 62 79 74 65 20 63 68 65 nd a 16 byte che
44b0: 63 6b 73 75 6d 2e 0a 0a 3a 20 6b 65 2d 6c 61 73 cksum...: ke-las
44c0: 74 21 20 28 20 36 34 64 61 74 65 20 2d 2d 20 29 t! ( 64date -- )
44d0: 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 . ke-selfsig
44e0: 24 40 6c 65 6e 20 24 31 30 20 75 6d 61 78 20 6b $@len $10 umax k
44f0: 65 2d 73 65 6c 66 73 69 67 20 24 21 6c 65 6e 0a e-selfsig $!len.
4500: 20 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 ke-selfsig $
4510: 40 20 64 72 6f 70 20 36 34 27 2b 20 36 34 21 20 @ drop 64'+ 64!
4520: 3b 0a 3a 20 6b 65 2d 66 69 72 73 74 21 20 28 20 ;.: ke-first! (
4530: 36 34 64 61 74 65 20 2d 2d 20 29 20 36 34 23 2d 64date -- ) 64#-
4540: 31 20 6b 65 2d 6c 61 73 74 21 0a 20 20 20 20 6b 1 ke-last!. k
4550: 65 2d 73 65 6c 66 73 69 67 20 24 40 20 64 72 6f e-selfsig $@ dro
4560: 70 20 36 34 21 20 3b 0a 0a 73 63 6f 70 65 7b 20 p 64! ;..scope{
4570: 6e 65 74 32 6f 2d 62 61 73 65 0a 0a 63 6d 64 2d net2o-base..cmd-
4580: 74 61 62 6c 65 20 24 40 20 69 6e 68 65 72 69 74 table $@ inherit
4590: 2d 74 61 62 6c 65 20 6b 65 79 2d 65 6e 74 72 79 -table key-entry
45a0: 2d 74 61 62 6c 65 0a 5c 67 20 0a 5c 67 20 23 23 -table.\g .\g ##
45b0: 23 20 6b 65 79 20 73 74 6f 72 61 67 65 20 63 6f # key storage co
45c0: 6d 6d 61 6e 64 73 20 23 23 23 0a 5c 67 20 0a 24 mmands ###.\g .$
45d0: 31 31 20 6e 65 74 32 6f 3a 20 70 72 69 76 6b 65 11 net2o: privke
45e0: 79 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 y ( $:string --
45f0: 29 0a 20 20 20 20 5c 67 20 70 72 69 76 61 74 65 ). \g private
4600: 20 6b 65 79 0a 20 20 20 20 5c 20 64 6f 65 73 20 key. \ does
4610: 6e 6f 74 20 6e 65 65 64 20 74 6f 20 62 65 20 73 not need to be s
4620: 69 67 6e 65 64 2c 20 74 68 65 20 73 65 63 72 65 igned, the secre
4630: 74 20 6b 65 79 20 76 65 72 69 66 69 65 73 20 69 t key verifies i
4640: 74 73 65 6c 66 0a 20 20 20 20 21 21 75 6e 73 69 tself. !!unsi
4650: 67 6e 65 64 3f 20 24 34 30 20 21 21 3e 3d 6f 72 gned? $40 !!>=or
4660: 64 65 72 3f 0a 20 20 20 20 6b 65 79 70 61 63 6b der?. keypack
4670: 20 63 40 20 24 46 20 61 6e 64 20 6b 65 2d 70 77 c@ $F and ke-pw
4680: 6c 65 76 65 6c 20 21 0a 20 20 20 20 24 3e 20 6f level !. $> o
4690: 76 65 72 20 6b 65 79 70 61 64 20 73 6b 3e 70 6b ver keypad sk>pk
46a0: 20 5c 20 67 65 6e 65 72 61 74 65 20 70 75 62 6b \ generate pubk
46b0: 65 79 0a 20 20 20 20 6b 65 79 70 61 64 20 6b 65 ey. keypad ke
46c0: 2d 70 6b 20 24 40 20 64 72 6f 70 20 6b 65 79 73 -pk $@ drop keys
46d0: 69 7a 65 20 74 75 63 6b 20 73 74 72 3d 20 30 3d ize tuck str= 0=
46e0: 20 21 21 77 72 6f 6e 67 2d 6b 65 79 21 21 0a 20 !!wrong-key!!.
46f0: 20 20 20 6b 65 2d 73 6b 20 73 65 63 21 20 2b 73 ke-sk sec! +s
4700: 65 63 6b 65 79 20 3b 0a 2b 6e 65 74 32 6f 3a 20 eckey ;.+net2o:
4710: 6b 65 79 74 79 70 65 20 28 20 6e 20 2d 2d 20 29 keytype ( n -- )
4720: 20 20 20 20 20 20 20 20 20 20 20 21 21 73 69 67 !!sig
4730: 6e 65 64 3f 20 20 20 31 20 21 21 3e 6f 72 64 65 ned? 1 !!>orde
4740: 72 3f 20 36 34 3e 6e 20 6b 65 2d 74 79 70 65 20 r? 64>n ke-type
4750: 21 20 3b 0a 20 20 20 20 5c 67 20 6b 65 79 20 74 ! ;. \g key t
4760: 79 70 65 20 28 30 3a 20 61 6e 6f 6e 2c 20 31 3a ype (0: anon, 1:
4770: 20 75 73 65 72 2c 20 32 3a 20 67 72 6f 75 70 29 user, 2: group)
4780: 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 6e 69 63 6b .+net2o: keynick
4790: 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 ( $:string -- )
47a0: 20 20 20 20 21 21 73 69 67 6e 65 64 3f 20 20 20 !!signed?
47b0: 32 20 21 21 3e 6f 72 64 65 72 3f 20 24 3e 20 6b 2 !!>order? $> k
47c0: 65 2d 6e 69 63 6b 20 24 21 0a 20 20 20 20 5c 67 e-nick $!. \g
47d0: 20 6b 65 79 20 6e 69 63 6b 0a 20 20 20 20 6e 69 key nick. ni
47e0: 63 6b 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 ck! ;.+net2o: ke
47f0: 79 70 72 6f 66 69 6c 65 20 28 20 24 3a 73 74 72 yprofile ( $:str
4800: 69 6e 67 20 2d 2d 20 29 20 21 21 73 69 67 6e 65 ing -- ) !!signe
4810: 64 3f 20 20 20 34 20 21 21 3e 6f 72 64 65 72 3f d? 4 !!>order?
4820: 20 24 3e 20 6b 65 2d 70 72 6f 66 20 24 21 20 3b $> ke-prof $! ;
4830: 0a 20 20 20 20 5c 67 20 6b 65 79 20 70 72 6f 66 . \g key prof
4840: 69 6c 65 20 28 68 61 73 68 20 6f 66 20 61 20 72 ile (hash of a r
4850: 65 73 6f 75 72 63 65 29 0a 2b 6e 65 74 32 6f 3a esource).+net2o:
4860: 20 6b 65 79 6d 61 73 6b 20 28 20 78 20 2d 2d 20 keymask ( x --
4870: 29 20 20 20 20 20 20 20 20 20 21 21 75 6e 73 69 ) !!unsi
4880: 67 6e 65 64 3f 20 24 34 30 20 21 21 3e 3d 6f 72 gned? $40 !!>=or
4890: 64 65 72 3f 20 36 34 3e 6e 0a 20 20 20 20 5c 67 der? 64>n. \g
48a0: 20 6b 65 79 20 61 63 63 65 73 73 20 72 69 67 68 key access righ
48b0: 74 20 6d 61 73 6b 0a 20 20 20 20 31 20 69 6d 70 t mask. 1 imp
48c0: 6f 72 74 2d 74 79 70 65 20 40 20 6c 73 68 69 66 ort-type @ lshif
48d0: 74 0a 20 20 20 20 5b 20 31 20 69 6d 70 6f 72 74 t. [ 1 import
48e0: 23 73 65 6c 66 20 6c 73 68 69 66 74 20 31 20 69 #self lshift 1 i
48f0: 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 74 mport#new lshift
4900: 20 6f 72 20 5d 4c 0a 20 20 20 20 61 6e 64 20 49 or ]L. and I
4910: 46 20 20 64 75 70 20 6b 65 2d 6d 61 73 6b 20 6f F dup ke-mask o
4920: 72 21 20 3f 3e 67 72 6f 75 70 73 20 20 45 4c 53 r! ?>groups ELS
4930: 45 20 20 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a E drop THEN ;.
4940: 2b 6e 65 74 32 6f 3a 20 6b 65 79 67 72 6f 75 70 +net2o: keygroup
4950: 73 20 28 20 24 3a 67 72 6f 75 70 73 20 2d 2d 20 s ( $:groups --
4960: 29 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 32 ) !!unsigned? $2
4970: 30 20 21 21 3e 6f 72 64 65 72 3f 20 24 3e 0a 20 0 !!>order? $>.
4980: 20 20 20 5c 67 20 61 63 63 65 73 73 20 67 72 6f \g access gro
4990: 75 70 73 0a 20 20 20 20 31 20 69 6d 70 6f 72 74 ups. 1 import
49a0: 2d 74 79 70 65 20 40 20 6c 73 68 69 66 74 0a 20 -type @ lshift.
49b0: 20 20 20 5b 20 31 20 69 6d 70 6f 72 74 23 73 65 [ 1 import#se
49c0: 6c 66 20 6c 73 68 69 66 74 20 31 20 69 6d 70 6f lf lshift 1 impo
49d0: 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 rt#new lshift or
49e0: 20 5d 4c 0a 20 20 20 20 61 6e 64 20 49 46 20 20 ]L. and IF
49f0: 20 32 64 75 70 20 6b 65 2d 67 72 6f 75 70 73 20 2dup ke-groups
4a00: 24 21 20 67 72 6f 75 70 73 3e 6d 61 73 6b 20 6b $! groups>mask k
4a10: 65 2d 6d 61 73 6b 20 21 0a 20 20 20 20 45 4c 53 e-mask !. ELS
4a20: 45 20 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b E 2drop THEN ;
4a30: 0a 2b 6e 65 74 32 6f 3a 20 2b 6b 65 79 73 69 67 .+net2o: +keysig
4a40: 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 ( $:string -- )
4a50: 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 31 !!unsigned? $1
4a60: 30 20 21 21 3e 3d 6f 72 64 65 72 3f 20 24 3e 20 0 !!>=order? $>
4a70: 6b 65 2d 73 69 67 73 20 24 2b 5b 5d 21 20 3b 0a ke-sigs $+[]! ;.
4a80: 20 20 20 20 5c 67 20 61 64 64 20 61 20 6b 65 79 \g add a key
4a90: 20 73 69 67 6e 61 74 75 72 65 0a 2b 6e 65 74 32 signature.+net2
4aa0: 6f 3a 20 6b 65 79 69 6d 70 6f 72 74 20 28 20 6e o: keyimport ( n
4ab0: 20 2d 2d 20 29 20 20 20 20 20 20 20 21 21 75 6e -- ) !!un
4ac0: 73 69 67 6e 65 64 3f 20 24 31 30 20 21 21 3e 3d signed? $10 !!>=
4ad0: 6f 72 64 65 72 3f 0a 20 20 20 20 63 6f 6e 66 69 order?. confi
4ae0: 67 3a 70 77 2d 6c 65 76 65 6c 23 20 40 20 30 3c g:pw-level# @ 0<
4af0: 20 49 46 20 20 36 34 3e 6e 0a 09 64 75 70 20 5b IF 64>n..dup [
4b00: 20 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 1 import#new ls
4b10: 68 69 66 74 20 5d 4c 20 61 6e 64 20 30 3d 20 49 hift ]L and 0= I
4b20: 46 0a 09 20 20 20 20 69 6d 70 6f 72 74 23 75 6e F.. import#un
4b30: 74 72 75 73 74 65 64 20 75 6d 69 6e 20 31 20 73 trusted umin 1 s
4b40: 77 61 70 20 6c 73 68 69 66 74 20 5b 20 31 20 69 wap lshift [ 1 i
4b50: 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 74 mport#new lshift
4b60: 20 5d 4c 20 6f 72 0a 09 45 4c 53 45 0a 09 20 20 ]L or..ELSE..
4b70: 20 20 5b 20 32 20 69 6d 70 6f 72 74 23 75 6e 74 [ 2 import#unt
4b80: 72 75 73 74 65 64 20 6c 73 68 69 66 74 20 31 2d rusted lshift 1-
4b90: 20 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 1 import#new ls
4ba0: 68 69 66 74 20 6f 72 20 5d 4c 20 61 6e 64 0a 09 hift or ]L and..
4bb0: 54 48 45 4e 0a 09 6b 65 2d 69 6d 70 6f 72 74 73 THEN..ke-imports
4bc0: 20 6f 72 21 0a 20 20 20 20 45 4c 53 45 20 20 36 or!. ELSE 6
4bd0: 34 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 2b 6e 4drop THEN ;.+n
4be0: 65 74 32 6f 3a 20 72 73 6b 6b 65 79 20 28 20 24 et2o: rskkey ( $
4bf0: 3a 73 74 72 69 6e 67 20 2d 2d 2d 20 29 0a 20 20 :string --- ).
4c00: 20 20 5c 67 20 72 65 76 6f 6b 65 20 6b 65 79 2c \g revoke key,
4c10: 20 74 65 6d 70 6f 72 61 72 69 6c 79 20 73 74 6f temporarily sto
4c20: 72 65 64 0a 20 20 20 20 5c 20 64 6f 65 73 20 6e red. \ does n
4c30: 6f 74 20 6e 65 65 64 20 74 6f 20 62 65 20 73 69 ot need to be si
4c40: 67 6e 65 64 2c 20 74 68 65 20 72 65 76 6f 6b 65 gned, the revoke
4c50: 20 6b 65 79 20 76 65 72 69 66 69 65 73 20 69 74 key verifies it
4c60: 73 65 6c 66 0a 20 20 20 20 21 21 75 6e 73 69 67 self. !!unsig
4c70: 6e 65 64 3f 20 24 38 30 20 21 21 3e 3d 6f 72 64 ned? $80 !!>=ord
4c80: 65 72 3f 0a 20 20 20 20 24 3e 20 32 64 75 70 20 er?. $> 2dup
4c90: 73 6b 72 65 76 20 73 77 61 70 20 6b 65 79 7c 20 skrev swap key|
4ca0: 6d 6f 76 65 20 6b 65 2d 70 6b 20 24 40 20 64 72 move ke-pk $@ dr
4cb0: 6f 70 20 63 68 65 63 6b 2d 72 65 76 3f 20 30 3d op check-rev? 0=
4cc0: 20 21 21 6e 6f 74 2d 6d 79 2d 72 65 76 73 6b 21 !!not-my-revsk!
4cd0: 21 0a 20 20 20 20 70 6b 72 65 76 20 6b 65 79 73 !. pkrev keys
4ce0: 69 7a 65 32 20 65 72 61 73 65 20 20 6b 65 2d 72 ize2 erase ke-r
4cf0: 73 6b 20 73 65 63 21 20 3b 0a 2b 6e 65 74 32 6f sk sec! ;.+net2o
4d00: 3a 20 6b 65 79 70 65 74 20 28 20 24 3a 73 74 72 : keypet ( $:str
4d10: 69 6e 67 20 2d 2d 20 29 20 20 21 21 75 6e 73 69 ing -- ) !!unsi
4d20: 67 6e 65 64 3f 20 20 24 3e 0a 20 20 20 20 63 6f gned? $>. co
4d30: 6e 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23 20 40 nfig:pw-level# @
4d40: 20 30 3c 20 49 46 20 20 6b 65 2d 70 65 74 73 20 0< IF ke-pets
4d50: 24 2b 5b 5d 21 20 70 65 74 21 20 20 45 4c 53 45 $+[]! pet! ELSE
4d60: 20 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 2drop THEN ;.
4d70: 7d 73 63 6f 70 65 0a 0a 67 65 6e 2d 74 61 62 6c }scope..gen-tabl
4d80: 65 20 24 66 72 65 65 7a 65 0a 27 20 63 6f 6e 74 e $freeze.' cont
4d90: 65 78 74 2d 74 61 62 6c 65 20 69 73 20 67 65 6e ext-table is gen
4da0: 2d 74 61 62 6c 65 0a 0a 3a 20 6b 65 79 3a 6e 65 -table..: key:ne
4db0: 73 74 2d 73 69 67 20 28 20 61 64 64 72 20 75 20 st-sig ( addr u
4dc0: 2d 2d 20 61 64 64 72 20 75 27 20 66 6c 61 67 20 -- addr u' flag
4dd0: 29 0a 20 20 20 20 70 6b 32 2d 73 69 67 3f 20 64 ). pk2-sig? d
4de0: 75 70 20 3f 45 58 49 54 20 64 72 6f 70 0a 20 20 up ?EXIT drop.
4df0: 20 20 32 64 75 70 20 2b 20 73 69 67 73 69 7a 65 2dup + sigsize
4e00: 23 20 2d 20 73 69 67 73 69 7a 65 23 20 3e 24 0a # - sigsize# >$.
4e10: 20 20 20 20 73 69 67 70 6b 32 73 69 7a 65 23 20 sigpk2size#
4e20: 2d 20 32 64 75 70 20 2b 20 6b 65 79 73 69 7a 65 - 2dup + keysize
4e30: 32 20 6b 65 79 3f 6e 65 77 20 6e 3a 3e 6f 20 24 2 key?new n:>o $
4e40: 3e 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 21 0a > ke-selfsig $!.
4e50: 20 20 20 20 73 69 6d 2d 6e 69 63 6b 21 20 6f 66 sim-nick! of
4e60: 66 20 63 2d 73 74 61 74 65 20 6f 66 66 20 73 69 f c-state off si
4e70: 67 2d 6f 6b 20 3b 0a 27 20 6b 65 79 3a 6e 65 73 g-ok ;.' key:nes
4e80: 74 2d 73 69 67 20 6b 65 79 2d 65 6e 74 72 79 20 t-sig key-entry
4e90: 74 6f 20 6e 65 73 74 2d 73 69 67 0a 0a 73 61 6d to nest-sig..sam
4ea0: 70 6c 65 2d 6b 65 79 20 3e 6f 20 6b 65 79 2d 65 ple-key >o key-e
4eb0: 6e 74 72 79 2d 74 61 62 6c 65 20 40 20 74 6f 6b ntry-table @ tok
4ec0: 65 6e 2d 74 61 62 6c 65 20 21 20 6f 3e 0a 0a 3a en-table ! o>..:
4ed0: 20 6b 65 79 3a 63 6f 64 65 20 28 20 2d 2d 20 29 key:code ( -- )
4ee0: 0a 20 20 20 20 63 6f 64 65 2d 6b 65 79 20 20 63 . code-key c
4ef0: 6d 64 6c 6f 63 6b 20 6c 6f 63 6b 0a 20 20 20 20 mdlock lock.
4f00: 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d keypack keypack-
4f10: 61 6c 6c 23 20 65 72 61 73 65 0a 20 20 20 20 63 all# erase. c
4f20: 6d 64 72 65 73 65 74 20 69 6e 69 74 2d 72 65 70 mdreset init-rep
4f30: 6c 79 20 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 ly also net2o-ba
4f40: 73 65 20 3b 0a 63 6f 6d 70 3a 20 3a 2c 20 61 6c se ;.comp: :, al
4f50: 73 6f 20 6e 65 74 32 6f 2d 62 61 73 65 20 3b 0a so net2o-base ;.
4f60: 0a 73 63 6f 70 65 7b 20 6e 65 74 32 6f 2d 62 61 .scope{ net2o-ba
4f70: 73 65 0a 0a 3a 20 65 6e 64 3a 6b 65 79 20 28 20 se..: end:key (
4f80: 2d 2d 20 29 0a 20 20 20 20 65 6e 64 2d 77 69 74 -- ). end-wit
4f90: 68 20 70 72 65 76 69 6f 75 73 20 63 6d 64 6c 6f h previous cmdlo
4fa0: 63 6b 20 75 6e 6c 6f 63 6b 20 3b 0a 63 6f 6d 70 ck unlock ;.comp
4fb0: 3a 20 3a 2c 20 70 72 65 76 69 6f 75 73 20 3b 0a : :, previous ;.
4fc0: 0a 7d 73 63 6f 70 65 0a 0a 3a 20 6b 65 79 2d 63 .}scope..: key-c
4fd0: 72 79 70 74 20 28 20 2d 2d 20 29 0a 20 20 20 20 rypt ( -- ).
4fe0: 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d keypack keypack-
4ff0: 61 6c 6c 23 0a 20 20 20 20 3e 73 74 6f 72 65 6b all#. >storek
5000: 65 79 20 73 65 63 40 20 64 75 70 20 24 32 30 20 ey sec@ dup $20
5010: 75 3c 3d 20 5c 20 69 73 20 61 20 73 65 63 72 65 u<= \ is a secre
5020: 74 2c 20 6e 6f 20 6e 65 65 64 20 74 6f 20 62 65 t, no need to be
5030: 20 73 6c 6f 77 0a 20 20 20 20 49 46 20 20 65 6e slow. IF en
5040: 63 72 79 70 74 24 20 20 45 4c 53 45 20 20 63 6f crypt$ ELSE co
5050: 6e 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23 20 40 nfig:pw-level# @
5060: 20 65 6e 63 72 79 70 74 2d 70 77 24 20 20 54 48 encrypt-pw$ TH
5070: 45 4e 20 3b 0a 0a 30 20 56 61 6c 75 65 20 6b 65 EN ;..0 Value ke
5080: 79 2d 73 66 64 20 5c 20 73 65 63 72 65 74 20 6b y-sfd \ secret k
5090: 65 79 73 0a 30 20 56 61 6c 75 65 20 6b 65 79 2d eys.0 Value key-
50a0: 70 66 64 20 5c 20 70 75 62 6b 65 79 73 0a 0a 5c pfd \ pubkeys..\
50b0: 20 6c 65 67 61 63 79 20 66 6f 72 20 65 61 72 6c legacy for earl
50c0: 79 20 76 65 72 73 69 6f 6e 73 20 6f 66 20 6e 65 y versions of ne
50d0: 74 32 6f 20 70 72 69 6f 72 20 32 30 31 36 30 36 t2o prior 201606
50e0: 30 36 0a 0a 3a 20 6e 65 74 32 6f 3e 6b 65 79 73 06..: net2o>keys
50f0: 20 7b 20 61 64 64 72 20 75 20 2d 2d 20 7d 0a 20 { addr u -- }.
5100: 20 20 20 61 64 64 72 20 75 20 2e 6e 65 74 32 6f addr u .net2o
5110: 2f 20 20 61 64 64 72 20 75 20 2e 6b 65 79 73 2f / addr u .keys/
5120: 20 72 65 6e 61 6d 65 2d 66 69 6c 65 20 64 72 6f rename-file dro
5130: 70 20 3b 0a 3a 20 3f 6c 65 67 61 63 79 2d 6b 65 p ;.: ?legacy-ke
5140: 79 73 20 28 20 66 6c 61 67 20 2d 2d 20 29 0a 20 ys ( flag -- ).
5150: 20 20 20 5c 20 21 21 46 49 58 4d 45 21 21 20 6e \ !!FIXME!! n
5160: 65 65 64 73 20 74 6f 20 62 65 20 72 65 6d 6f 76 eeds to be remov
5170: 65 64 20 77 68 65 6e 20 61 6c 6c 20 63 75 72 72 ed when all curr
5180: 65 6e 74 20 75 73 65 72 73 0a 20 20 20 20 5c 20 ent users. \
5190: 68 61 76 65 20 6d 69 67 72 61 74 65 64 0a 20 20 have migrated.
51a0: 20 20 49 46 0a 09 22 70 75 62 6b 65 79 73 2e 6b IF.."pubkeys.k
51b0: 32 6f 22 20 6e 65 74 32 6f 3e 6b 65 79 73 0a 09 2o" net2o>keys..
51c0: 22 73 65 63 6b 65 79 73 2e 6b 32 6f 22 20 6e 65 "seckeys.k2o" ne
51d0: 74 32 6f 3e 6b 65 79 73 0a 20 20 20 20 54 48 45 t2o>keys. THE
51e0: 4e 20 3b 0a 0a 3a 20 67 65 6e 2d 6b 65 79 73 2d N ;..: gen-keys-
51f0: 64 69 72 20 28 20 2d 2d 20 29 0a 20 20 20 20 69 dir ( -- ). i
5200: 6e 69 74 2d 64 69 72 73 20 3f 2e 6e 65 74 32 6f nit-dirs ?.net2o
5210: 2f 6b 65 79 73 20 3f 6c 65 67 61 63 79 2d 6b 65 /keys ?legacy-ke
5220: 79 73 20 3b 0a 0a 3a 20 3f 66 64 2d 6b 65 79 73 ys ;..: ?fd-keys
5230: 20 28 20 66 64 20 61 64 64 72 20 75 20 2d 2d 20 ( fd addr u --
5240: 66 64 27 20 29 20 7b 20 61 64 64 72 20 75 20 7d fd' ) { addr u }
5250: 20 64 75 70 20 3f 45 58 49 54 20 64 72 6f 70 0a dup ?EXIT drop.
5260: 20 20 20 20 67 65 6e 2d 6b 65 79 73 2d 64 69 72 gen-keys-dir
5270: 0a 20 20 20 20 61 64 64 72 20 75 20 72 2f 77 20 . addr u r/w
5280: 6f 70 65 6e 2d 66 69 6c 65 20 64 75 70 20 6e 6f open-file dup no
5290: 2d 66 69 6c 65 23 20 3d 20 49 46 0a 09 32 64 72 -file# = IF..2dr
52a0: 6f 70 20 61 64 64 72 20 75 20 72 2f 77 20 63 72 op addr u r/w cr
52b0: 65 61 74 65 2d 66 69 6c 65 0a 20 20 20 20 54 48 eate-file. TH
52c0: 45 4e 20 20 74 68 72 6f 77 20 3b 0a 0a 3a 20 3f EN throw ;..: ?
52d0: 6b 65 79 2d 73 66 64 20 28 20 2d 2d 20 66 64 20 key-sfd ( -- fd
52e0: 29 0a 20 20 20 20 6b 65 79 2d 73 66 64 20 22 73 ). key-sfd "s
52f0: 65 63 6b 65 79 73 2e 6b 32 6f 22 20 2e 6b 65 79 eckeys.k2o" .key
5300: 73 2f 20 3f 66 64 2d 6b 65 79 73 20 64 75 70 20 s/ ?fd-keys dup
5310: 74 6f 20 6b 65 79 2d 73 66 64 20 3b 0a 3a 20 3f to key-sfd ;.: ?
5320: 6b 65 79 2d 70 66 64 20 28 20 2d 2d 20 66 64 20 key-pfd ( -- fd
5330: 29 0a 20 20 20 20 6b 65 79 2d 70 66 64 20 22 70 ). key-pfd "p
5340: 75 62 6b 65 79 73 2e 6b 32 6f 22 20 2e 6b 65 79 ubkeys.k2o" .key
5350: 73 2f 20 3f 66 64 2d 6b 65 79 73 20 64 75 70 20 s/ ?fd-keys dup
5360: 74 6f 20 6b 65 79 2d 70 66 64 20 3b 0a 0a 3a 20 to key-pfd ;..:
5370: 6b 65 79 3e 73 66 69 6c 65 20 28 20 2d 2d 20 29 key>sfile ( -- )
5380: 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 6b 65 79 . keypack key
5390: 70 61 63 6b 2d 61 6c 6c 23 20 3f 6b 65 79 2d 73 pack-all# ?key-s
53a0: 66 64 20 61 70 70 65 6e 64 2d 66 69 6c 65 20 6b fd append-file k
53b0: 65 2d 6f 66 66 73 65 74 20 36 34 21 20 3b 0a 3a e-offset 64! ;.:
53c0: 20 6b 65 79 3e 70 66 69 6c 65 20 28 20 2d 2d 20 key>pfile ( --
53d0: 29 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 6b 65 ). keypack ke
53e0: 79 70 61 63 6b 2d 61 6c 6c 23 20 3f 6b 65 79 2d ypack-all# ?key-
53f0: 70 66 64 20 61 70 70 65 6e 64 2d 66 69 6c 65 20 pfd append-file
5400: 6b 65 2d 6f 66 66 73 65 74 20 36 34 21 20 3b 0a ke-offset 64! ;.
5410: 0a 3a 20 6b 65 79 3e 73 66 69 6c 65 40 70 6f 73 .: key>sfile@pos
5420: 20 28 20 36 34 70 6f 73 20 2d 2d 20 29 20 36 34 ( 64pos -- ) 64
5430: 64 75 70 20 36 34 23 2d 31 20 36 34 3d 20 49 46 dup 64#-1 64= IF
5440: 20 20 36 34 64 72 6f 70 20 6b 65 79 3e 73 66 69 64drop key>sfi
5450: 6c 65 0a 20 20 20 20 45 4c 53 45 20 20 36 34 3e le. ELSE 64>
5460: 72 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 r keypack keypac
5470: 6b 2d 61 6c 6c 23 20 36 34 72 3e 20 3f 6b 65 79 k-all# 64r> ?key
5480: 2d 73 66 64 20 77 72 69 74 65 40 70 6f 73 2d 66 -sfd write@pos-f
5490: 69 6c 65 20 20 54 48 45 4e 20 3b 0a 3a 20 6b 65 ile THEN ;.: ke
54a0: 79 3e 70 66 69 6c 65 40 70 6f 73 20 28 20 36 34 y>pfile@pos ( 64
54b0: 70 6f 73 20 2d 2d 20 29 20 36 34 64 75 70 20 36 pos -- ) 64dup 6
54c0: 34 23 2d 31 20 36 34 3d 20 49 46 20 20 36 34 64 4#-1 64= IF 64d
54d0: 72 6f 70 20 6b 65 79 3e 70 66 69 6c 65 0a 20 20 rop key>pfile.
54e0: 20 20 45 4c 53 45 20 20 36 34 3e 72 20 6b 65 79 ELSE 64>r key
54f0: 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c pack keypack-all
5500: 23 20 36 34 72 3e 20 3f 6b 65 79 2d 70 66 64 20 # 64r> ?key-pfd
5510: 77 72 69 74 65 40 70 6f 73 2d 66 69 6c 65 20 20 write@pos-file
5520: 54 48 45 4e 20 3b 0a 0a 3a 20 72 6e 64 3e 73 66 THEN ;..: rnd>sf
5530: 69 6c 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b ile ( -- ). k
5540: 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 eypack keypack-a
5550: 6c 6c 23 20 3e 72 6e 67 24 20 6b 65 79 3e 73 66 ll# >rng$ key>sf
5560: 69 6c 65 20 3b 0a 3a 20 72 6e 64 3e 70 66 69 6c ile ;.: rnd>pfil
5570: 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 e ( -- ). key
5580: 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c pack keypack-all
5590: 23 20 3e 72 6e 67 24 20 6b 65 79 3e 70 66 69 6c # >rng$ key>pfil
55a0: 65 20 3b 0a 0a 3a 20 3e 6b 65 79 73 20 28 20 2d e ;..: >keys ( -
55b0: 2d 20 29 0a 20 20 20 20 5c 47 20 61 64 64 20 73 - ). \G add s
55c0: 68 61 72 65 64 20 73 65 63 72 65 74 20 74 6f 20 hared secret to
55d0: 6c 69 73 74 20 6f 66 20 70 6f 73 73 69 62 6c 65 list of possible
55e0: 20 6b 65 79 73 0a 20 20 20 20 73 6b 63 20 70 6b keys. skc pk
55f0: 63 20 6b 65 79 70 61 64 20 65 64 2d 64 68 20 2b c keypad ed-dh +
5600: 6b 65 79 20 3b 0a 0a 5c 20 6b 65 79 20 67 65 6e key ;..\ key gen
5610: 65 72 61 74 69 6f 6e 0a 5c 20 66 6f 72 20 72 65 eration.\ for re
5620: 70 72 6f 64 75 63 69 62 69 6c 69 74 79 20 6f 66 producibility of
5630: 20 74 68 65 20 73 65 6c 66 73 69 67 2c 20 61 6c the selfsig, al
5640: 77 61 79 73 20 75 73 65 20 74 68 65 20 73 61 6d ways use the sam
5650: 65 20 6f 72 64 65 72 3a 0a 5c 20 22 70 75 62 6b e order:.\ "pubk
5660: 65 79 22 20 6e 65 77 6b 65 79 20 3c 6e 3e 20 6b ey" newkey <n> k
5670: 65 79 74 79 70 65 20 22 6e 69 63 6b 22 20 6b 65 eytype "nick" ke
5680: 79 6e 69 63 6b 20 22 73 69 67 22 20 6b 65 79 73 ynick "sig" keys
5690: 65 6c 66 73 69 67 0a 0a 55 73 65 72 20 70 6b 2b elfsig..User pk+
56a0: 73 69 67 24 0a 0a 6b 65 79 73 69 7a 65 32 20 43 sig$..keysize2 C
56b0: 6f 6e 73 74 61 6e 74 20 70 6b 72 6b 23 0a 0a 3a onstant pkrk#..:
56c0: 20 5d 70 6b 2b 73 69 67 6e 20 28 20 61 64 64 72 ]pk+sign ( addr
56d0: 20 75 20 2d 2d 20 29 20 2b 63 6d 64 62 75 66 20 u -- ) +cmdbuf
56e0: 5d 73 69 67 6e 20 3b 0a 0a 3a 20 70 61 63 6b 2d ]sign ;..: pack-
56f0: 6b 65 79 20 28 20 74 79 70 65 20 6e 69 63 6b 20 key ( type nick
5700: 75 20 2d 2d 20 29 0a 20 20 20 20 6e 6f 77 3e 6e u -- ). now>n
5710: 65 76 65 72 0a 20 20 20 20 6b 65 79 3a 63 6f 64 ever. key:cod
5720: 65 0a 20 20 20 20 20 20 73 69 67 6e 5b 0a 20 20 e. sign[.
5730: 20 20 20 20 72 6f 74 20 75 6c 69 74 2c 20 6b 65 rot ulit, ke
5740: 79 74 79 70 65 20 24 2c 20 6b 65 79 6e 69 63 6b ytype $, keynick
5750: 0a 20 20 20 20 20 20 70 6b 63 20 70 6b 72 6b 23 . pkc pkrk#
5760: 20 5d 70 6b 2b 73 69 67 6e 0a 20 20 20 20 20 20 ]pk+sign.
5770: 73 6b 63 20 6b 65 79 73 69 7a 65 20 73 65 63 24 skc keysize sec$
5780: 2c 20 70 72 69 76 6b 65 79 0a 20 20 20 20 65 6e , privkey. en
5790: 64 3a 6b 65 79 20 3b 0a 0a 61 6c 73 6f 20 6e 65 d:key ;..also ne
57a0: 74 32 6f 2d 62 61 73 65 0a 3a 20 70 61 63 6b 2d t2o-base.: pack-
57b0: 63 6f 72 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 core ( o:key --
57c0: 29 20 5c 20 63 6f 72 65 20 77 69 74 68 6f 75 74 ) \ core without
57d0: 20 6b 65 79 0a 20 20 20 20 6b 65 2d 74 79 70 65 key. ke-type
57e0: 20 40 20 75 6c 69 74 2c 20 6b 65 79 74 79 70 65 @ ulit, keytype
57f0: 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 24 40 20 . ke-nick $@
5800: 24 2c 20 6b 65 79 6e 69 63 6b 0a 20 20 20 20 6b $, keynick. k
5810: 65 2d 70 72 6f 66 20 24 40 20 64 75 70 20 49 46 e-prof $@ dup IF
5820: 20 20 24 2c 20 6b 65 79 70 72 6f 66 69 6c 65 20 $, keyprofile
5830: 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 ELSE 2drop TH
5840: 45 4e 20 3b 0a 0a 3a 20 70 61 63 6b 2d 73 69 67 EN ;..: pack-sig
5850: 6e 6b 65 79 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 nkey ( o:key --
5860: 29 0a 20 20 20 20 73 69 67 6e 5b 0a 20 20 20 20 ). sign[.
5870: 70 61 63 6b 2d 63 6f 72 65 0a 20 20 20 20 6b 65 pack-core. ke
5880: 2d 70 6b 20 24 40 20 2b 63 6d 64 62 75 66 0a 20 -pk $@ +cmdbuf.
5890: 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 ke-selfsig $@
58a0: 20 2b 63 6d 64 62 75 66 20 63 6d 64 2d 72 65 73 +cmdbuf cmd-res
58b0: 6f 6c 76 65 3e 20 32 64 72 6f 70 20 6e 65 73 74 olve> 2drop nest
58c0: 73 69 67 20 3b 0a 0a 3a 20 70 61 63 6b 2d 63 6f sig ;..: pack-co
58d0: 72 65 6b 65 79 20 28 20 6f 3a 6b 65 79 20 2d 2d rekey ( o:key --
58e0: 20 29 0a 20 20 20 20 70 61 63 6b 2d 73 69 67 6e ). pack-sign
58f0: 6b 65 79 0a 20 20 20 20 6b 65 2d 69 6d 70 6f 72 key. ke-impor
5900: 74 73 20 40 20 75 6c 69 74 2c 20 6b 65 79 69 6d ts @ ulit, keyim
5910: 70 6f 72 74 0a 20 20 20 20 6b 65 2d 6d 61 73 6b port. ke-mask
5920: 20 40 20 20 6b 65 2d 67 72 6f 75 70 73 20 24 40 @ ke-groups $@
5930: 6c 65 6e 20 49 46 0a 09 6b 65 2d 67 72 6f 75 70 len IF..ke-group
5940: 73 20 24 40 20 32 64 75 70 20 24 2c 20 6b 65 79 s $@ 2dup $, key
5950: 67 72 6f 75 70 73 0a 09 67 72 6f 75 70 73 3e 6d groups..groups>m
5960: 61 73 6b 20 69 6e 76 65 72 74 20 61 6e 64 20 20 ask invert and
5970: 54 48 45 4e 0a 20 20 20 20 3f 64 75 70 2d 49 46 THEN. ?dup-IF
5980: 20 20 6e 6c 69 74 2c 20 6b 65 79 6d 61 73 6b 20 nlit, keymask
5990: 20 54 48 45 4e 0a 20 20 20 20 6b 65 2d 70 65 74 THEN. ke-pet
59a0: 73 20 5b 3a 20 24 2c 20 6b 65 79 70 65 74 20 3b s [: $, keypet ;
59b0: 5d 20 24 5b 5d 6d 61 70 0a 20 20 20 20 6b 65 2d ] $[]map. ke-
59c0: 73 74 6f 72 65 6b 65 79 20 40 20 3e 73 74 6f 72 storekey @ >stor
59d0: 65 6b 65 79 20 21 20 3b 0a 70 72 65 76 69 6f 75 ekey ! ;.previou
59e0: 73 0a 0a 3a 20 70 61 63 6b 2d 70 75 62 6b 65 79 s..: pack-pubkey
59f0: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 ( o:key -- ).
5a00: 20 20 6b 65 79 3a 63 6f 64 65 0a 20 20 20 20 20 key:code.
5a10: 20 70 61 63 6b 2d 63 6f 72 65 6b 65 79 0a 20 20 pack-corekey.
5a20: 20 20 65 6e 64 3a 6b 65 79 20 3b 0a 3a 20 70 61 end:key ;.: pa
5a30: 63 6b 2d 6f 75 74 6b 65 79 20 28 20 6f 3a 6b 65 ck-outkey ( o:ke
5a40: 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 3a 63 y -- ). key:c
5a50: 6f 64 65 0a 20 20 20 20 20 20 22 6e 32 6f 22 20 ode. "n2o"
5a60: 6e 65 74 32 6f 2d 62 61 73 65 3a 34 63 63 2c 0a net2o-base:4cc,.
5a70: 20 20 20 20 20 20 70 61 63 6b 2d 73 69 67 6e 6b pack-signk
5a80: 65 79 0a 20 20 20 20 65 6e 64 3a 6b 65 79 20 3b ey. end:key ;
5a90: 0a 3a 20 70 61 63 6b 2d 73 65 63 6b 65 79 20 28 .: pack-seckey (
5aa0: 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 o:key -- ).
5ab0: 6b 65 79 3a 63 6f 64 65 0a 20 20 20 20 20 20 70 key:code. p
5ac0: 61 63 6b 2d 63 6f 72 65 6b 65 79 0a 20 20 20 20 ack-corekey.
5ad0: 20 20 6b 65 2d 73 6b 20 73 65 63 40 20 73 65 63 ke-sk sec@ sec
5ae0: 24 2c 20 70 72 69 76 6b 65 79 0a 20 20 20 20 20 $, privkey.
5af0: 20 6b 65 2d 72 73 6b 20 73 65 63 40 20 64 75 70 ke-rsk sec@ dup
5b00: 20 49 46 20 20 73 65 63 24 2c 20 72 73 6b 6b 65 IF sec$, rskke
5b10: 79 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 y ELSE 2drop
5b20: 54 48 45 4e 0a 20 20 20 20 65 6e 64 3a 6b 65 79 THEN. end:key
5b30: 20 3b 0a 3a 20 6b 65 79 6e 69 63 6b 24 20 28 20 ;.: keynick$ (
5b40: 6f 3a 6b 65 79 20 2d 2d 20 61 64 64 72 20 75 20 o:key -- addr u
5b50: 29 0a 20 20 20 20 5c 47 20 67 65 74 20 74 68 65 ). \G get the
5b60: 20 61 6e 6e 6f 74 61 74 69 6f 6e 73 20 77 69 74 annotations wit
5b70: 68 20 73 69 67 6e 61 74 75 72 65 0a 20 20 20 20 h signature.
5b80: 5b 27 5d 20 70 61 63 6b 2d 63 6f 72 65 20 67 65 ['] pack-core ge
5b90: 6e 2d 63 6d 64 24 20 32 64 72 6f 70 0a 20 20 20 n-cmd$ 2drop.
5ba0: 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 20 74 ke-selfsig $@ t
5bb0: 6d 70 24 20 24 2b 21 20 74 6d 70 24 20 24 40 20 mp$ $+! tmp$ $@
5bc0: 3b 0a 3a 20 6b 65 79 70 6b 32 6e 69 63 6b 24 20 ;.: keypk2nick$
5bd0: 28 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 64 72 20 ( o:key -- addr
5be0: 75 20 29 0a 20 20 20 20 5c 47 20 67 65 74 20 74 u ). \G get t
5bf0: 68 65 20 61 6e 6e 6f 74 61 74 69 6f 6e 73 20 77 he annotations w
5c00: 69 74 68 20 73 69 67 6e 61 74 75 72 65 0a 20 20 ith signature.
5c10: 20 20 5b 27 5d 20 70 61 63 6b 2d 63 6f 72 65 20 ['] pack-core
5c20: 67 65 6e 2d 63 6d 64 24 20 32 64 72 6f 70 0a 20 gen-cmd$ 2drop.
5c30: 20 20 20 6b 65 2d 70 6b 20 24 40 20 74 6d 70 24 ke-pk $@ tmp$
5c40: 20 24 2b 21 20 6b 65 2d 73 65 6c 66 73 69 67 20 $+! ke-selfsig
5c50: 24 40 20 74 6d 70 24 20 24 2b 21 20 74 6d 70 24 $@ tmp$ $+! tmp$
5c60: 20 24 40 20 3b 0a 3a 20 6d 79 6e 69 63 6b 2d 6b $@ ;.: mynick-k
5c70: 65 79 20 28 20 2d 2d 20 6f 20 29 0a 20 20 20 20 ey ( -- o ).
5c80: 70 6b 63 20 6b 65 79 73 69 7a 65 20 6b 65 79 23 pkc keysize key#
5c90: 20 23 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3b #@ drop cell+ ;
5ca0: 0a 3a 20 6d 79 6e 69 63 6b 24 20 28 20 2d 2d 20 .: mynick$ ( --
5cb0: 61 64 64 72 20 75 20 29 0a 20 20 20 20 5c 47 20 addr u ). \G
5cc0: 67 65 74 20 6d 79 20 6e 69 63 6b 20 77 69 74 68 get my nick with
5cd0: 20 73 69 67 6e 61 74 75 72 65 0a 20 20 20 20 6d signature. m
5ce0: 79 6e 69 63 6b 2d 6b 65 79 20 2e 6b 65 79 6e 69 ynick-key .keyni
5cf0: 63 6b 24 20 3b 0a 3a 20 6d 79 70 6b 32 6e 69 63 ck$ ;.: mypk2nic
5d00: 6b 24 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 k$ ( o:key -- ad
5d10: 64 72 20 75 20 29 0a 20 20 20 20 5c 47 20 67 65 dr u ). \G ge
5d20: 74 20 6d 79 20 6e 69 63 6b 20 77 69 74 68 20 73 t my nick with s
5d30: 69 67 6e 61 74 75 72 65 0a 20 20 20 20 6d 79 6e ignature. myn
5d40: 69 63 6b 2d 6b 65 79 20 2e 6b 65 79 70 6b 32 6e ick-key .keypk2n
5d50: 69 63 6b 24 20 3b 0a 3a 20 6b 65 79 2d 73 69 67 ick$ ;.: key-sig
5d60: 6e 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b n ( o:key -- o:k
5d70: 65 79 20 29 0a 20 20 20 20 5b 27 5d 20 70 61 63 ey ). ['] pac
5d80: 6b 2d 63 6f 72 65 20 67 65 6e 2d 63 6d 64 24 0a k-core gen-cmd$.
5d90: 20 20 20 20 5b 3a 20 74 79 70 65 20 6b 65 2d 70 [: type ke-p
5da0: 6b 20 24 40 20 74 79 70 65 20 3b 5d 20 24 74 6d k $@ type ;] $tm
5db0: 70 0a 20 20 20 20 6e 6f 77 3e 6e 65 76 65 72 20 p. now>never
5dc0: 63 3a 30 6b 65 79 20 63 3a 68 61 73 68 20 5b 27 c:0key c:hash ['
5dd0: 5d 20 2e 73 69 67 20 24 74 6d 70 20 6b 65 2d 73 ] .sig $tmp ke-s
5de0: 65 6c 66 73 69 67 20 24 21 20 3b 0a 0a 56 61 72 elfsig $! ;..Var
5df0: 69 61 62 6c 65 20 63 70 2d 74 6d 70 0a 0a 3a 20 iable cp-tmp..:
5e00: 73 61 76 65 2d 70 75 62 6b 65 79 73 20 28 20 2d save-pubkeys ( -
5e10: 2d 20 29 0a 20 20 20 20 6b 65 79 2d 70 66 64 20 - ). key-pfd
5e20: 3f 64 75 70 2d 49 46 20 20 63 6c 6f 73 65 2d 66 ?dup-IF close-f
5e30: 69 6c 65 20 74 68 72 6f 77 20 20 54 48 45 4e 0a ile throw THEN.
5e40: 20 20 20 20 22 70 75 62 6b 65 79 73 2e 6b 32 6f "pubkeys.k2o
5e50: 22 20 2e 6b 65 79 73 2f 20 5b 3a 20 74 6f 20 6b " .keys/ [: to k
5e60: 65 79 2d 70 66 64 0a 20 20 20 20 20 20 6b 65 79 ey-pfd. key
5e70: 23 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 # [: cell+ $@ dr
5e80: 6f 70 20 63 65 6c 6c 2b 20 3e 6f 0a 09 6b 65 2d op cell+ >o..ke-
5e90: 73 6b 20 73 65 63 40 20 64 30 3d 20 49 46 20 20 sk sec@ d0= IF
5ea0: 70 61 63 6b 2d 70 75 62 6b 65 79 0a 09 20 20 20 pack-pubkey..
5eb0: 20 66 6c 75 73 68 28 20 2e 22 20 73 61 76 69 6e flush( ." savin
5ec0: 67 20 22 20 2e 6e 69 63 6b 20 66 6f 72 74 68 3a g " .nick forth:
5ed0: 63 72 20 29 0a 09 20 20 20 20 6b 65 79 2d 63 72 cr ).. key-cr
5ee0: 79 70 74 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 ypt ke-offset 64
5ef0: 40 20 6b 65 79 3e 70 66 69 6c 65 40 70 6f 73 0a @ key>pfile@pos.
5f00: 09 54 48 45 4e 20 6f 3e 20 3b 5d 20 23 6d 61 70 .THEN o> ;] #map
5f10: 0a 20 20 20 20 30 20 74 6f 20 6b 65 79 2d 70 66 . 0 to key-pf
5f20: 64 20 3b 5d 20 73 61 76 65 2d 66 69 6c 65 20 20 d ;] save-file
5f30: 3f 6b 65 79 2d 70 66 64 20 64 72 6f 70 20 3b 0a ?key-pfd drop ;.
5f40: 0a 3a 20 73 61 76 65 2d 73 65 63 6b 65 79 73 20 .: save-seckeys
5f50: 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 2d 73 ( -- ). key-s
5f60: 66 64 20 3f 64 75 70 2d 49 46 20 20 63 6c 6f 73 fd ?dup-IF clos
5f70: 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 20 54 48 e-file throw TH
5f80: 45 4e 0a 20 20 20 20 22 73 65 63 6b 65 79 73 2e EN. "seckeys.
5f90: 6b 32 6f 22 20 2e 6b 65 79 73 2f 20 5b 3a 20 74 k2o" .keys/ [: t
5fa0: 6f 20 6b 65 79 2d 73 66 64 0a 20 20 20 20 20 20 o key-sfd.
5fb0: 6b 65 79 23 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 key# [: cell+ $@
5fc0: 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 0a 09 drop cell+ >o..
5fd0: 6b 65 2d 73 6b 20 73 65 63 40 20 64 30 3c 3e 20 ke-sk sec@ d0<>
5fe0: 49 46 20 20 70 61 63 6b 2d 73 65 63 6b 65 79 0a IF pack-seckey.
5ff0: 09 20 20 20 20 63 6f 6e 66 69 67 3a 70 77 2d 6c . config:pw-l
6000: 65 76 65 6c 23 20 40 20 3e 72 20 20 6b 65 2d 70 evel# @ >r ke-p
6010: 77 6c 65 76 65 6c 20 40 20 63 6f 6e 66 69 67 3a wlevel @ config:
6020: 70 77 2d 6c 65 76 65 6c 23 20 21 0a 09 20 20 20 pw-level# !..
6030: 20 6b 65 79 2d 63 72 79 70 74 20 6b 65 2d 6f 66 key-crypt ke-of
6040: 66 73 65 74 20 36 34 40 20 6b 65 79 3e 73 66 69 fset 64@ key>sfi
6050: 6c 65 40 70 6f 73 0a 09 20 20 20 20 72 3e 20 63 le@pos.. r> c
6060: 6f 6e 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23 20 onfig:pw-level#
6070: 21 0a 09 54 48 45 4e 20 6f 3e 20 3b 5d 20 23 6d !..THEN o> ;] #m
6080: 61 70 0a 20 20 20 20 30 20 74 6f 20 6b 65 79 2d ap. 0 to key-
6090: 73 66 64 20 3b 5d 20 73 61 76 65 2d 66 69 6c 65 sfd ;] save-file
60a0: 20 20 3f 6b 65 79 2d 73 66 64 20 64 72 6f 70 20 ?key-sfd drop
60b0: 3b 0a 0a 3a 20 73 61 76 65 2d 6b 65 79 73 20 28 ;..: save-keys (
60c0: 20 2d 2d 20 29 20 20 3f 2e 6e 65 74 32 6f 2f 6b -- ) ?.net2o/k
60d0: 65 79 73 0a 20 20 20 20 73 61 76 65 2d 70 75 62 eys. save-pub
60e0: 6b 65 79 73 20 73 61 76 65 2d 73 65 63 6b 65 79 keys save-seckey
60f0: 73 20 3b 0a 0a 3a 20 2b 67 65 6e 2d 6b 65 79 73 s ;..: +gen-keys
6100: 20 28 20 6e 69 63 6b 20 75 20 74 79 70 65 20 2d ( nick u type -
6110: 2d 20 29 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 - ). gen-keys
6120: 20 20 36 34 23 2d 31 20 6b 65 79 2d 72 65 61 64 64#-1 key-read
6130: 2d 6f 66 66 73 65 74 20 36 34 21 20 20 70 6b 63 -offset 64! pkc
6140: 20 6b 65 79 73 69 7a 65 32 20 6b 65 79 3a 6e 65 keysize2 key:ne
6150: 77 20 3e 6f 0a 20 20 20 20 5b 20 31 20 69 6d 70 w >o. [ 1 imp
6160: 6f 72 74 23 73 65 6c 66 20 6c 73 68 69 66 74 20 ort#self lshift
6170: 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 1 import#new lsh
6180: 69 66 74 20 6f 72 20 5d 4c 20 6b 65 2d 69 6d 70 ift or ]L ke-imp
6190: 6f 72 74 73 20 21 0a 20 20 20 20 6b 65 2d 74 79 orts !. ke-ty
61a0: 70 65 20 21 20 20 6b 65 2d 6e 69 63 6b 20 24 21 pe ! ke-nick $!
61b0: 20 20 6e 69 63 6b 21 0a 20 20 20 20 63 6f 6e 66 nick!. conf
61c0: 69 67 3a 70 77 2d 6c 65 76 65 6c 23 20 40 20 6b ig:pw-level# @ k
61d0: 65 2d 70 77 6c 65 76 65 6c 20 21 20 20 70 65 72 e-pwlevel ! per
61e0: 6d 25 6d 79 73 65 6c 66 20 6b 65 2d 6d 61 73 6b m%myself ke-mask
61f0: 20 21 0a 20 20 20 20 73 6b 63 20 6b 65 79 73 69 !. skc keysi
6200: 7a 65 20 6b 65 2d 73 6b 20 73 65 63 21 20 20 2b ze ke-sk sec! +
6210: 73 65 63 6b 65 79 0a 20 20 20 20 73 6b 72 65 76 seckey. skrev
6220: 20 6b 65 79 73 69 7a 65 20 6b 65 2d 72 73 6b 20 keysize ke-rsk
6230: 73 65 63 21 0a 20 20 20 20 6b 65 79 2d 73 69 67 sec!. key-sig
6240: 6e 20 6f 3e 20 3b 0a 0a 24 34 30 20 62 75 66 66 n o> ;..$40 buff
6250: 65 72 3a 20 6e 69 63 6b 2d 62 75 66 0a 0a 3a 20 er: nick-buf..:
6260: 67 65 74 2d 6e 69 63 6b 20 28 20 2d 2d 20 61 64 get-nick ( -- ad
6270: 64 72 20 75 20 29 0a 20 20 20 20 2e 22 20 6e 69 dr u ). ." ni
6280: 63 6b 3a 20 22 20 6e 69 63 6b 2d 62 75 66 20 24 ck: " nick-buf $
6290: 34 30 20 61 63 63 65 70 74 20 6e 69 63 6b 2d 62 40 accept nick-b
62a0: 75 66 20 73 77 61 70 20 2d 74 72 61 69 6c 69 6e uf swap -trailin
62b0: 67 20 63 72 20 3b 0a 0a 66 61 6c 73 65 20 76 61 g cr ;..false va
62c0: 6c 75 65 20 3f 79 65 73 0a 3a 20 79 65 73 3f 20 lue ?yes.: yes?
62d0: 28 20 61 64 64 72 20 75 20 2d 2d 20 66 6c 61 67 ( addr u -- flag
62e0: 20 29 0a 20 20 20 20 3f 79 65 73 20 49 46 20 20 ). ?yes IF
62f0: 32 64 72 6f 70 20 74 72 75 65 20 20 45 4c 53 45 2drop true ELSE
6300: 20 20 74 79 70 65 20 2e 22 20 20 28 79 2f 4e 29 type ." (y/N)
6310: 22 20 6b 65 79 20 63 72 20 27 79 27 20 3d 20 20 " key cr 'y' =
6320: 54 48 45 4e 20 3b 0a 0a 3a 20 3f 72 73 6b 20 28 THEN ;..: ?rsk (
6330: 20 2d 2d 20 29 0a 20 20 20 20 70 6b 63 20 6b 65 -- ). pkc ke
6340: 79 73 69 7a 65 20 6b 65 79 2d 65 78 69 73 74 3f ysize key-exist?
6350: 20 64 75 70 20 30 3d 20 49 46 20 20 64 72 6f 70 dup 0= IF drop
6360: 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 EXIT THEN.
6370: 20 3e 6f 20 6b 65 2d 72 73 6b 20 73 65 63 40 20 >o ke-rsk sec@
6380: 64 75 70 20 30 3d 20 49 46 20 20 32 64 72 6f 70 dup 0= IF 2drop
6390: 20 6f 3e 20 20 45 58 49 54 20 20 54 48 45 4e 0a o> EXIT THEN.
63a0: 20 20 20 20 2e 22 20 59 6f 75 20 73 74 69 6c 6c ." You still
63b0: 20 68 61 76 65 6e 27 74 20 73 74 6f 72 65 64 20 haven't stored
63c0: 79 6f 75 72 20 72 65 76 6f 6b 65 20 6b 65 79 20 your revoke key
63d0: 73 65 63 75 72 65 6c 79 20 6f 66 66 2d 6c 69 6e securely off-lin
63e0: 65 2e 22 20 63 72 0a 20 20 20 20 73 22 20 50 61 e." cr. s" Pa
63f0: 70 65 72 20 61 6e 64 20 70 65 6e 63 69 6c 20 72 per and pencil r
6400: 65 61 64 79 3f 22 20 79 65 73 3f 20 49 46 0a 09 eady?" yes? IF..
6410: 2e 73 74 72 69 70 65 38 35 0a 09 73 22 20 57 72 .stripe85..s" Wr
6420: 69 74 74 65 6e 20 64 6f 77 6e 3f 22 20 79 65 73 itten down?" yes
6430: 3f 20 49 46 0a 09 20 20 20 20 73 22 20 59 6f 75 ? IF.. s" You
6440: 20 77 6f 6e 27 74 20 73 65 65 20 74 68 69 73 20 won't see this
6450: 61 67 61 69 6e 21 20 44 65 6c 65 74 65 3f 22 20 again! Delete?"
6460: 79 65 73 3f 0a 09 20 20 20 20 49 46 20 6b 65 2d yes?.. IF ke-
6470: 72 73 6b 20 73 65 63 2d 6f 66 66 20 20 73 61 76 rsk sec-off sav
6480: 65 2d 6b 65 79 73 0a 09 09 2e 22 20 72 65 76 6f e-keys...." revo
6490: 6b 65 20 6b 65 79 20 64 65 6c 65 74 65 64 2e 22 ke key deleted."
64a0: 20 63 72 20 6f 3e 20 20 45 58 49 54 20 20 54 48 cr o> EXIT TH
64b0: 45 4e 20 20 54 48 45 4e 0a 20 20 20 20 45 4c 53 EN THEN. ELS
64c0: 45 20 20 32 64 72 6f 70 20 20 54 48 45 4e 0a 20 E 2drop THEN.
64d0: 20 20 20 2e 22 20 49 27 6d 20 6b 65 65 70 69 6e ." I'm keepin
64e0: 67 20 79 6f 75 72 20 72 65 76 6f 6b 65 20 6b 65 g your revoke ke
64f0: 79 2e 20 20 54 68 69 73 20 77 69 6c 6c 20 73 68 y. This will sh
6500: 6f 77 20 75 70 20 61 67 61 69 6e 2e 22 20 63 72 ow up again." cr
6510: 20 6f 3e 20 3b 0a 0a 5c 20 72 65 61 64 20 6b 65 o> ;..\ read ke
6520: 79 20 66 69 6c 65 0a 0a 3a 20 74 72 79 2d 64 65 y file..: try-de
6530: 63 72 79 70 74 2d 6b 65 79 20 28 20 6b 65 79 20 crypt-key ( key
6540: 75 31 20 2d 2d 20 61 64 64 72 20 75 32 20 66 6c u1 -- addr u2 fl
6550: 61 67 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b ag ). keypack
6560: 20 6b 65 79 70 61 63 6b 2d 64 20 6b 65 79 70 61 keypack-d keypa
6570: 63 6b 2d 61 6c 6c 23 20 6d 6f 76 65 0a 20 20 20 ck-all# move.
6580: 20 6b 65 79 70 61 63 6b 2d 64 20 6b 65 79 70 61 keypack-d keypa
6590: 63 6b 2d 61 6c 6c 23 20 32 73 77 61 70 0a 20 20 ck-all# 2swap.
65a0: 20 20 64 75 70 20 24 32 30 20 3d 20 49 46 20 20 dup $20 = IF
65b0: 64 65 63 72 79 70 74 24 20 20 45 4c 53 45 0a 09 decrypt$ ELSE..
65c0: 6b 65 79 70 61 63 6b 20 63 40 20 24 46 20 61 6e keypack c@ $F an
65d0: 64 20 63 6f 6e 66 69 67 3a 70 77 2d 6d 61 78 6c d config:pw-maxl
65e0: 65 76 65 6c 23 20 40 20 3c 3d 0a 09 49 46 20 20 evel# @ <=..IF
65f0: 64 65 63 72 79 70 74 2d 70 77 24 20 20 45 4c 53 decrypt-pw$ ELS
6600: 45 20 20 32 64 72 6f 70 20 66 61 6c 73 65 20 20 E 2drop false
6610: 54 48 45 4e 0a 20 20 20 20 54 48 45 4e 20 3b 0a THEN. THEN ;.
6620: 0a 3a 20 74 72 79 2d 64 65 63 72 79 70 74 20 28 .: try-decrypt (
6630: 20 66 6c 61 67 20 2d 2d 20 61 64 64 72 20 75 20 flag -- addr u
6640: 2f 20 30 20 30 20 29 20 7b 20 66 6c 61 67 20 7d / 0 0 ) { flag }
6650: 0a 20 20 20 20 6b 65 79 73 20 24 5b 5d 23 20 30 . keys $[]# 0
6660: 20 3f 44 4f 0a 09 49 20 6b 65 79 73 20 73 65 63 ?DO..I keys sec
6670: 5b 5d 40 20 64 75 70 20 6b 65 79 73 69 7a 65 20 []@ dup keysize
6680: 3d 20 66 6c 61 67 20 78 6f 72 20 49 46 0a 09 20 = flag xor IF..
6690: 20 20 20 74 72 79 2d 64 65 63 72 79 70 74 2d 6b try-decrypt-k
66a0: 65 79 20 49 46 0a 09 09 49 20 6b 65 79 73 20 24 ey IF...I keys $
66b0: 5b 5d 20 40 20 64 75 70 20 3e 73 74 6f 72 65 6b [] @ dup >storek
66c0: 65 79 20 21 20 64 65 66 61 75 6c 74 6b 65 79 20 ey ! defaultkey
66d0: 21 0a 09 09 75 6e 6c 6f 6f 70 20 20 45 58 49 54 !...unloop EXIT
66e0: 20 20 54 48 45 4e 20 20 54 48 45 4e 0a 09 32 64 THEN THEN..2d
66f0: 72 6f 70 0a 20 20 20 20 4c 4f 4f 50 20 20 30 20 rop. LOOP 0
6700: 30 20 3b 0a 0a 3a 20 3f 70 65 72 6d 20 28 20 6f 0 ;..: ?perm ( o
6710: 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 :key -- ). ke
6720: 2d 73 6b 20 73 65 63 40 20 6e 69 70 20 49 46 20 -sk sec@ nip IF
6730: 20 70 65 72 6d 25 6d 79 73 65 6c 66 20 20 45 4c perm%myself EL
6740: 53 45 20 20 70 65 72 6d 25 64 65 66 61 75 6c 74 SE perm%default
6750: 20 20 54 48 45 4e 20 20 6b 65 2d 6d 61 73 6b 20 THEN ke-mask
6760: 21 20 3b 0a 0a 3a 20 64 6f 2d 6b 65 79 20 28 20 ! ;..: do-key (
6770: 61 64 64 72 20 75 20 2f 20 30 20 30 20 20 2d 2d addr u / 0 0 --
6780: 20 29 0a 20 20 20 20 64 75 70 20 30 3d 20 49 46 ). dup 0= IF
6790: 20 20 32 64 72 6f 70 20 20 45 58 49 54 20 20 54 2drop EXIT T
67a0: 48 45 4e 0a 20 20 20 20 73 61 6d 70 6c 65 2d 6b HEN. sample-k
67b0: 65 79 20 3e 6f 20 6b 65 2d 73 6b 20 6b 65 2d 65 ey >o ke-sk ke-e
67c0: 6e 64 20 6f 76 65 72 20 2d 20 65 72 61 73 65 20 nd over - erase
67d0: 20 64 6f 2d 63 6d 64 2d 6c 6f 6f 70 20 6f 3e 20 do-cmd-loop o>
67e0: 3b 0a 0a 3a 20 2e 6b 65 79 24 20 28 20 61 64 64 ;..: .key$ ( add
67f0: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 73 61 6d r u -- ). sam
6800: 70 6c 65 2d 6b 65 79 20 3e 6f 20 20 6b 65 2d 73 ple-key >o ke-s
6810: 6b 20 6b 65 2d 65 6e 64 20 6f 76 65 72 20 2d 20 k ke-end over -
6820: 65 72 61 73 65 0a 20 20 20 20 73 69 67 6e 65 64 erase. signed
6830: 2d 76 61 6c 20 76 61 6c 69 64 61 74 65 64 20 6f -val validated o
6840: 72 21 20 20 63 2d 73 74 61 74 65 20 6f 66 66 20 r! c-state off
6850: 20 6e 65 73 74 2d 63 6d 64 2d 6c 6f 6f 70 0a 20 nest-cmd-loop.
6860: 20 20 20 73 69 67 6e 65 64 2d 76 61 6c 20 69 6e signed-val in
6870: 76 65 72 74 20 76 61 6c 69 64 61 74 65 64 20 61 vert validated a
6880: 6e 64 21 0a 20 20 20 20 2e 6b 65 79 2d 73 68 6f nd!. .key-sho
6890: 72 74 20 66 72 65 65 2d 6b 65 79 20 6f 3e 20 3b rt free-key o> ;
68a0: 0a 0a 3a 20 72 65 61 64 2d 6b 65 79 73 2d 6c 6f ..: read-keys-lo
68b0: 6f 70 20 28 20 66 64 20 2d 2d 20 29 20 20 63 6f op ( fd -- ) co
68c0: 64 65 2d 6b 65 79 0a 20 20 20 20 3e 72 20 23 30 de-key. >r #0
68d0: 2e 20 72 40 20 72 65 70 6f 73 69 74 69 6f 6e 2d . r@ reposition-
68e0: 66 69 6c 65 20 74 68 72 6f 77 0a 20 20 20 20 42 file throw. B
68f0: 45 47 49 4e 0a 09 72 40 20 66 69 6c 65 2d 70 6f EGIN..r@ file-po
6900: 73 69 74 69 6f 6e 20 74 68 72 6f 77 20 64 3e 36 sition throw d>6
6910: 34 20 6b 65 79 2d 72 65 61 64 2d 6f 66 66 73 65 4 key-read-offse
6920: 74 20 36 34 21 0a 09 6b 65 79 70 61 63 6b 20 6b t 64!..keypack k
6930: 65 79 70 61 63 6b 2d 61 6c 6c 23 20 72 40 20 72 eypack-all# r@ r
6940: 65 61 64 2d 66 69 6c 65 20 74 68 72 6f 77 0a 09 ead-file throw..
6950: 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3d 20 57 keypack-all# = W
6960: 48 49 4c 45 0a 09 20 20 20 20 69 6d 70 6f 72 74 HILE.. import
6970: 2d 74 79 70 65 20 40 20 69 6d 70 6f 72 74 23 73 -type @ import#s
6980: 65 6c 66 20 3d 20 74 72 79 2d 64 65 63 72 79 70 elf = try-decryp
6990: 74 20 64 6f 2d 6b 65 79 0a 20 20 20 20 52 45 50 t do-key. REP
69a0: 45 41 54 20 20 72 64 72 6f 70 20 20 63 6f 64 65 EAT rdrop code
69b0: 30 2d 62 75 66 20 3b 0a 3a 20 72 65 61 64 2d 6b 0-buf ;.: read-k
69c0: 65 79 2d 6c 6f 6f 70 20 28 20 2d 2d 20 29 0a 20 ey-loop ( -- ).
69d0: 20 20 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 69 import#self i
69e0: 6d 70 6f 72 74 2d 74 79 70 65 20 21 0a 20 20 20 mport-type !.
69f0: 20 3f 6b 65 79 2d 73 66 64 20 72 65 61 64 2d 6b ?key-sfd read-k
6a00: 65 79 73 2d 6c 6f 6f 70 20 3b 0a 3a 20 72 65 61 eys-loop ;.: rea
6a10: 64 2d 70 6b 65 79 2d 6c 6f 6f 70 20 28 20 2d 2d d-pkey-loop ( --
6a20: 20 29 0a 20 20 20 20 6c 61 73 74 6b 65 79 40 20 ). lastkey@
6a30: 64 72 6f 70 20 64 65 66 61 75 6c 74 6b 65 79 20 drop defaultkey
6a40: 21 20 5c 20 61 74 20 6c 65 61 73 74 20 6f 6e 65 ! \ at least one
6a50: 20 64 65 66 61 75 6c 74 20 6b 65 79 20 61 76 61 default key ava
6a60: 69 6c 61 62 6c 65 0a 20 20 20 20 2d 31 20 63 6f ilable. -1 co
6a70: 6e 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23 0a 20 nfig:pw-level#.
6a80: 20 20 20 5b 3a 20 69 6d 70 6f 72 74 23 6e 65 77 [: import#new
6a90: 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 3f import-type ! ?
6aa0: 6b 65 79 2d 70 66 64 20 72 65 61 64 2d 6b 65 79 key-pfd read-key
6ab0: 73 2d 6c 6f 6f 70 20 3b 5d 20 21 77 72 61 70 70 s-loop ;] !wrapp
6ac0: 65 72 20 3b 0a 0a 3a 20 72 65 61 64 2d 6b 65 79 er ;..: read-key
6ad0: 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 72 65 61 s ( -- ). rea
6ae0: 64 2d 6b 65 79 2d 6c 6f 6f 70 20 72 65 61 64 2d d-key-loop read-
6af0: 70 6b 65 79 2d 6c 6f 6f 70 20 69 6d 70 6f 72 74 pkey-loop import
6b00: 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 79 70 65 #new import-type
6b10: 20 21 20 3b 0a 0a 3a 20 72 65 61 64 2d 70 6b 32 ! ;..: read-pk2
6b20: 6b 65 79 24 20 28 20 61 64 64 72 20 75 20 2d 2d key$ ( addr u --
6b30: 20 29 0a 20 20 20 20 5c 67 20 72 65 61 64 20 61 ). \g read a
6b40: 20 6e 65 73 74 65 64 20 6b 65 79 20 69 6e 74 6f nested key into
6b50: 20 73 61 6d 70 6c 65 2d 6b 65 79 0a 20 20 20 20 sample-key.
6b60: 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 63 2d sample-key >o c-
6b70: 73 74 61 74 65 20 6f 66 66 20 20 73 69 6d 2d 6e state off sim-n
6b80: 69 63 6b 21 20 6f 6e 0a 20 20 20 20 70 6b 32 2d ick! on. pk2-
6b90: 73 69 67 3f 20 21 21 73 69 67 21 21 20 73 69 67 sig? !!sig!! sig
6ba0: 70 6b 32 73 69 7a 65 23 20 2d 20 32 64 75 70 20 pk2size# - 2dup
6bb0: 2b 20 3e 72 20 64 6f 2d 6e 65 73 74 73 69 67 0a + >r do-nestsig.
6bc0: 20 20 20 20 72 40 20 6b 65 79 73 69 7a 65 32 20 r@ keysize2
6bd0: 6b 65 2d 70 6b 20 24 21 0a 20 20 20 20 72 3e 20 ke-pk $!. r>
6be0: 6b 65 79 73 69 7a 65 32 20 2b 20 73 69 67 73 69 keysize2 + sigsi
6bf0: 7a 65 23 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 ze# ke-selfsig $
6c00: 21 0a 20 20 20 20 6f 3e 20 20 73 69 6d 2d 6e 69 !. o> sim-ni
6c10: 63 6b 21 20 6f 66 66 20 3b 0a 0a 3a 20 2e 70 6b ck! off ;..: .pk
6c20: 32 6b 65 79 24 20 28 20 61 64 64 72 20 75 20 2d 2key$ ( addr u -
6c30: 2d 20 29 0a 20 20 20 20 72 65 61 64 2d 70 6b 32 - ). read-pk2
6c40: 6b 65 79 24 20 73 61 6d 70 6c 65 2d 6b 65 79 20 key$ sample-key
6c50: 3e 6f 0a 20 20 20 20 5b 20 31 20 69 6d 70 6f 72 >o. [ 1 impor
6c60: 74 23 69 6e 76 69 74 65 64 20 6c 73 68 69 66 74 t#invited lshift
6c70: 20 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 1 import#new ls
6c80: 68 69 66 74 20 6f 72 20 5d 4c 20 6b 65 2d 69 6d hift or ]L ke-im
6c90: 70 6f 72 74 73 20 21 0a 20 20 20 20 2e 6b 65 79 ports !. .key
6ca0: 2d 69 6e 76 69 74 65 20 66 72 65 65 2d 6b 65 79 -invite free-key
6cb0: 20 6f 3e 20 3b 0a 0a 5c 20 73 65 6c 65 63 74 20 o> ;..\ select
6cc0: 6b 65 79 20 62 79 20 6e 69 63 6b 0a 0a 3a 20 3e key by nick..: >
6cd0: 72 61 77 2d 6b 65 79 20 28 20 6f 20 2d 2d 20 29 raw-key ( o -- )
6ce0: 0a 20 20 20 20 64 75 70 20 30 3d 20 21 21 6e 6f . dup 0= !!no
6cf0: 2d 6e 69 63 6b 21 21 20 3e 6f 0a 20 20 20 20 6b -nick!! >o. k
6d00: 65 2d 70 6b 20 24 40 20 70 6b 63 20 70 6b 72 6b e-pk $@ pkc pkrk
6d10: 23 20 73 6d 6f 76 65 0a 20 20 20 20 6b 65 2d 73 # smove. ke-s
6d20: 6b 20 73 65 63 40 20 73 6b 63 20 73 77 61 70 20 k sec@ skc swap
6d30: 6b 65 79 7c 20 6d 6f 76 65 0a 20 20 20 20 3e 73 key| move. >s
6d40: 6b 73 69 67 20 6f 3e 20 3b 0a 0a 3a 20 3e 6b 65 ksig o> ;..: >ke
6d50: 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a y ( addr u -- ).
6d60: 20 20 20 20 6b 65 79 23 20 40 20 30 3d 20 49 46 key# @ 0= IF
6d70: 20 20 72 65 61 64 2d 6b 65 79 73 20 20 54 48 45 read-keys THE
6d80: 4e 0a 20 20 20 20 6e 69 63 6b 2d 6b 65 79 20 3e N. nick-key >
6d90: 72 61 77 2d 6b 65 79 20 3b 0a 0a 3a 20 69 27 6d raw-key ;..: i'm
6da0: 20 28 20 22 6e 61 6d 65 22 20 2d 2d 20 29 20 70 ( "name" -- ) p
6db0: 61 72 73 65 2d 6e 61 6d 65 20 3e 6b 65 79 20 3b arse-name >key ;
6dc0: 0a 3a 20 70 6b 27 20 28 20 22 6e 61 6d 65 22 20 .: pk' ( "name"
6dd0: 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 -- addr u ).
6de0: 70 61 72 73 65 2d 6e 61 6d 65 20 6e 69 63 6b 3e parse-name nick>
6df0: 70 6b 20 3b 0a 0a 3a 20 64 65 73 74 2d 6b 65 79 pk ;..: dest-key
6e00: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 64 ( addr u -- ) d
6e10: 75 70 20 30 3d 20 49 46 20 20 32 64 72 6f 70 20 up 0= IF 2drop
6e20: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 EXIT THEN.
6e30: 6e 69 63 6b 2d 6b 65 79 20 3e 6f 20 6f 20 30 3d nick-key >o o 0=
6e40: 20 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21 !!unknown-key!!
6e50: 0a 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 6f 3e . ke-pk $@ o>
6e60: 0a 20 20 20 20 70 75 62 6b 65 79 20 24 21 20 3b . pubkey $! ;
6e70: 0a 0a 3a 20 64 65 73 74 2d 70 6b 20 28 20 61 64 ..: dest-pk ( ad
6e80: 64 72 20 75 20 2d 2d 20 29 20 6b 65 79 32 7c 20 dr u -- ) key2|
6e90: 32 64 75 70 20 6b 65 79 7c 20 6b 65 79 23 20 23 2dup key| key# #
6ea0: 40 20 30 3d 20 49 46 0a 09 64 72 6f 70 20 70 75 @ 0= IF..drop pu
6eb0: 62 6b 65 79 20 24 21 20 20 70 65 72 6d 25 75 6e bkey $! perm%un
6ec0: 6b 6e 6f 77 6e 20 70 65 72 6d 2d 6d 61 73 6b 20 known perm-mask
6ed0: 21 0a 20 20 20 20 45 4c 53 45 20 20 63 65 6c 6c !. ELSE cell
6ee0: 2b 20 3e 6f 0a 09 6b 65 2d 6d 61 73 6b 20 40 0a + >o..ke-mask @.
6ef0: 09 6b 65 2d 70 6b 20 24 40 20 6f 3e 0a 09 70 75 .ke-pk $@ o>..pu
6f00: 62 6b 65 79 20 24 21 20 20 70 65 72 6d 2d 6d 61 bkey $! perm-ma
6f10: 73 6b 20 21 20 20 32 64 72 6f 70 20 20 54 48 45 sk ! 2drop THE
6f20: 4e 20 3b 0a 0a 3a 20 72 65 70 6c 61 63 65 2d 6b N ;..: replace-k
6f30: 65 79 20 31 20 2f 73 74 72 69 6e 67 20 7b 20 72 ey 1 /string { r
6f40: 65 76 2d 61 64 64 72 20 75 20 2d 2d 20 6f 20 7d ev-addr u -- o }
6f50: 20 5c 20 72 65 76 6f 63 61 74 69 6f 6e 20 74 69 \ revocation ti
6f60: 63 6b 65 74 0a 20 20 20 20 6b 65 79 28 20 2e 22 cket. key( ."
6f70: 20 52 65 70 6c 61 63 65 3a 22 20 63 72 20 6f 20 Replace:" cr o
6f80: 63 65 6c 6c 2d 20 30 20 2e 6b 65 79 20 29 0a 20 cell- 0 .key ).
6f90: 20 20 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 69 import#self i
6fa0: 6d 70 6f 72 74 2d 74 79 70 65 20 21 0a 20 20 20 mport-type !.
6fb0: 20 73 22 20 23 72 65 76 6f 6b 65 64 22 20 64 75 s" #revoked" du
6fc0: 70 20 3e 72 20 6b 65 2d 6e 69 63 6b 20 24 2b 21 p >r ke-nick $+!
6fd0: 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 24 40 20 . ke-nick $@
6fe0: 72 3e 20 2d 20 6b 65 2d 70 72 6f 66 20 24 40 20 r> - ke-prof $@
6ff0: 6b 65 2d 73 69 67 73 20 6b 65 2d 74 79 70 65 20 ke-sigs ke-type
7000: 40 0a 20 20 20 20 72 65 76 2d 61 64 64 72 20 70 @. rev-addr p
7010: 6b 72 6b 23 20 6b 65 79 3f 6e 65 77 20 3e 6f 0a krk# key?new >o.
7020: 20 20 20 20 6b 65 2d 74 79 70 65 20 21 20 5b 3a ke-type ! [:
7030: 20 6b 65 2d 73 69 67 73 20 24 2b 5b 5d 21 20 3b ke-sigs $+[]! ;
7040: 5d 20 24 5b 5d 6d 61 70 20 6b 65 2d 70 72 6f 66 ] $[]map ke-prof
7050: 20 24 21 20 6b 65 2d 6e 69 63 6b 20 24 21 0a 20 $! ke-nick $!.
7060: 20 20 20 72 65 76 2d 61 64 64 72 20 70 6b 72 6b rev-addr pkrk
7070: 23 20 6b 65 2d 70 6b 20 24 21 0a 20 20 20 20 72 # ke-pk $!. r
7080: 65 76 2d 61 64 64 72 20 75 20 2b 20 31 2d 20 64 ev-addr u + 1- d
7090: 75 70 20 63 40 20 32 2a 20 2d 20 24 31 30 20 2d up c@ 2* - $10 -
70a0: 20 24 31 30 20 6b 65 2d 73 65 6c 66 73 69 67 20 $10 ke-selfsig
70b0: 24 21 0a 20 20 20 20 6b 65 79 28 20 2e 22 20 77 $!. key( ." w
70c0: 69 74 68 3a 22 20 63 72 20 6f 20 63 65 6c 6c 2d ith:" cr o cell-
70d0: 20 30 20 2e 6b 65 79 20 29 20 6f 20 6f 3e 0a 20 0 .key ) o o>.
70e0: 20 20 20 69 6d 70 6f 72 74 23 6e 65 77 20 69 6d import#new im
70f0: 70 6f 72 74 2d 74 79 70 65 20 21 20 3b 0a 0a 3a port-type ! ;..:
7100: 20 72 65 6e 65 77 2d 6b 65 79 20 28 20 72 65 76 renew-key ( rev
7110: 61 64 64 72 20 75 31 20 6b 65 79 61 64 64 72 20 addr u1 keyaddr
7120: 75 32 20 2d 2d 20 6f 20 29 0a 20 20 20 20 63 75 u2 -- o ). cu
7130: 72 72 65 6e 74 2d 6b 65 79 20 3e 6f 20 72 65 70 rrent-key >o rep
7140: 6c 61 63 65 2d 6b 65 79 20 6f 3e 0a 20 20 20 20 lace-key o>.
7150: 3e 6f 20 73 6b 63 20 6b 65 79 73 69 7a 65 20 6b >o skc keysize k
7160: 65 2d 73 6b 20 73 65 63 21 20 6f 20 6f 3e 20 3b e-sk sec! o o> ;
7170: 0a 0a 5c 20 67 65 6e 65 72 61 74 65 20 6e 65 77 ..\ generate new
7180: 20 6b 65 79 0a 0a 3a 20 6f 75 74 2d 6b 65 79 20 key..: out-key
7190: 28 20 6f 20 2d 2d 20 29 0a 20 20 20 20 3e 6f 20 ( o -- ). >o
71a0: 70 61 63 6b 2d 6f 75 74 6b 65 79 20 5b 27 5d 20 pack-outkey [']
71b0: 2e 6e 69 63 6b 2d 62 61 73 65 20 24 74 6d 70 20 .nick-base $tmp
71c0: 66 6e 2d 73 61 6e 69 74 69 7a 65 20 6f 3e 0a 20 fn-sanitize o>.
71d0: 20 20 20 5b 3a 20 2e 22 20 7e 2f 22 20 74 79 70 [: ." ~/" typ
71e0: 65 20 2e 22 20 2e 6e 32 6f 22 20 3b 5d 20 24 74 e ." .n2o" ;] $t
71f0: 6d 70 20 77 2f 6f 20 63 72 65 61 74 65 2d 66 69 mp w/o create-fi
7200: 6c 65 20 74 68 72 6f 77 0a 20 20 20 20 3e 72 20 le throw. >r
7210: 63 6d 64 62 75 66 24 20 72 40 20 77 72 69 74 65 cmdbuf$ r@ write
7220: 2d 66 69 6c 65 20 74 68 72 6f 77 20 72 3e 20 63 -file throw r> c
7230: 6c 6f 73 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 lose-file throw
7240: 3b 0a 3a 20 6f 75 74 2d 6d 65 20 28 20 2d 2d 20 ;.: out-me ( --
7250: 29 0a 20 20 20 20 70 6b 63 20 6b 65 79 73 69 7a ). pkc keysiz
7260: 65 20 6b 65 79 23 20 23 40 20 30 3d 20 21 21 75 e key# #@ 0= !!u
7270: 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21 0a 20 20 20 nknown-key!!.
7280: 20 63 65 6c 6c 2b 20 6f 75 74 2d 6b 65 79 20 3b cell+ out-key ;
7290: 0a 0a 56 61 72 69 61 62 6c 65 20 64 68 74 72 6f ..Variable dhtro
72a0: 6f 74 2e 6e 32 6f 0a 0a 3a 20 2b 64 68 74 72 6f ot.n2o..: +dhtro
72b0: 6f 74 20 28 20 2d 2d 20 29 0a 20 20 20 20 64 65 ot ( -- ). de
72c0: 66 61 75 6c 74 6b 65 79 20 40 20 3e 73 74 6f 72 faultkey @ >stor
72d0: 65 6b 65 79 20 21 0a 20 20 20 20 69 6d 70 6f 72 ekey !. impor
72e0: 74 23 6d 61 6e 75 61 6c 20 69 6d 70 6f 72 74 2d t#manual import-
72f0: 74 79 70 65 20 21 20 20 36 34 23 2d 31 20 6b 65 type ! 64#-1 ke
7300: 79 2d 72 65 61 64 2d 6f 66 66 73 65 74 20 36 34 y-read-offset 64
7310: 21 0a 20 20 20 20 64 68 74 72 6f 6f 74 2e 6e 32 !. dhtroot.n2
7320: 6f 20 24 40 20 64 6f 2d 6b 65 79 20 20 69 6d 70 o $@ do-key imp
7330: 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 ort#new import-t
7340: 79 70 65 20 21 20 3b 0a 0a 3a 20 6e 65 77 2d 6b ype ! ;..: new-k
7350: 65 79 20 28 20 6e 69 63 6b 61 64 64 72 20 75 20 ey ( nickaddr u
7360: 2d 2d 20 29 0a 20 20 20 20 3f 63 68 65 63 6b 2d -- ). ?check-
7370: 72 6e 67 20 5c 20 62 65 66 6f 72 65 20 67 65 6e rng \ before gen
7380: 65 72 61 74 69 6e 67 20 61 20 6b 65 79 2c 20 63 erating a key, c
7390: 68 65 63 6b 20 74 68 65 20 72 6e 67 20 66 6f 72 heck the rng for
73a0: 20 68 65 61 6c 74 68 0a 20 20 20 20 2b 6e 65 77 health. +new
73b0: 70 68 72 61 73 65 20 6b 65 79 3e 64 65 66 61 75 phrase key>defau
73c0: 6c 74 0a 20 20 20 20 6b 65 79 23 75 73 65 72 20 lt. key#user
73d0: 2b 67 65 6e 2d 6b 65 79 73 0a 20 20 20 20 73 65 +gen-keys. se
73e0: 63 72 65 74 2d 6b 65 79 73 23 20 31 2d 20 73 65 cret-keys# 1- se
73f0: 63 72 65 74 2d 6b 65 79 20 3e 72 61 77 2d 6b 65 cret-key >raw-ke
7400: 79 20 20 6c 61 73 74 6b 65 79 40 20 64 72 6f 70 y lastkey@ drop
7410: 20 64 65 66 61 75 6c 74 6b 65 79 20 21 0a 20 20 defaultkey !.
7420: 20 20 6f 75 74 2d 6d 65 20 2b 64 68 74 72 6f 6f out-me +dhtroo
7430: 74 20 73 61 76 65 2d 6b 65 79 73 20 3b 0a 0a 5c t save-keys ;..\
7440: 20 72 65 76 6f 6b 61 74 69 6f 6e 0a 0a 34 20 64 revokation..4 d
7450: 61 74 65 73 69 7a 65 23 20 2b 20 6b 65 79 73 69 atesize# + keysi
7460: 7a 65 20 39 20 2a 20 2b 20 43 6f 6e 73 74 61 6e ze 9 * + Constan
7470: 74 20 72 65 76 73 69 7a 65 23 0a 0a 56 61 72 69 t revsize#..Vari
7480: 61 62 6c 65 20 72 65 76 74 6f 6b 65 6e 0a 0a 3a able revtoken..:
7490: 20 30 6f 6c 64 6b 65 79 20 28 20 2d 2d 20 29 20 0oldkey ( -- )
74a0: 5c 20 70 75 62 6b 65 79 73 20 63 61 6e 20 73 74 \ pubkeys can st
74b0: 61 79 0a 20 20 20 20 6f 6c 64 73 6b 63 20 6b 65 ay. oldskc ke
74c0: 79 73 69 7a 65 20 65 72 61 73 65 20 20 6f 6c 64 ysize erase old
74d0: 73 6b 72 65 76 20 6b 65 79 73 69 7a 65 20 65 72 skrev keysize er
74e0: 61 73 65 20 3b 0a 0a 3a 20 6b 65 79 6d 6f 76 65 ase ;..: keymove
74f0: 20 28 20 61 64 64 72 31 20 61 64 64 72 32 20 2d ( addr1 addr2 -
7500: 2d 20 29 20 20 6b 65 79 73 69 7a 65 20 6d 6f 76 - ) keysize mov
7510: 65 20 3b 0a 0a 3a 20 72 65 76 6f 6b 65 2d 76 65 e ;..: revoke-ve
7520: 72 69 66 79 20 28 20 61 64 64 72 20 75 31 20 70 rify ( addr u1 p
7530: 6b 20 73 74 72 69 6e 67 20 75 32 20 2d 2d 20 61 k string u2 -- a
7540: 64 64 72 20 75 20 66 6c 61 67 20 29 20 72 6f 74 ddr u flag ) rot
7550: 20 3e 72 20 32 3e 72 20 63 3a 30 6b 65 79 0a 20 >r 2>r c:0key.
7560: 20 20 20 73 69 67 6f 6e 6c 79 73 69 7a 65 23 20 sigonlysize#
7570: 2d 20 32 64 75 70 20 32 72 3e 20 3e 6b 65 79 65 - 2dup 2r> >keye
7580: 64 2d 68 61 73 68 0a 20 20 20 20 73 69 67 64 61 d-hash. sigda
7590: 74 65 20 2b 64 61 74 65 0a 20 20 20 20 32 64 75 te +date. 2du
75a0: 70 20 2b 20 72 3e 20 65 64 2d 76 65 72 69 66 79 p + r> ed-verify
75b0: 20 3b 0a 0a 3a 20 3e 72 65 76 6f 6b 65 20 28 20 ;..: >revoke (
75c0: 73 6b 72 65 76 20 2d 2d 20 29 20 20 73 6b 72 65 skrev -- ) skre
75d0: 76 20 6b 65 79 6d 6f 76 65 20 20 70 6b 63 20 63 v keymove pkc c
75e0: 68 65 63 6b 2d 72 65 76 3f 20 30 3d 20 21 21 6e heck-rev? 0= !!n
75f0: 6f 74 2d 6d 79 2d 72 65 76 73 6b 21 21 20 3b 0a ot-my-revsk!! ;.
7600: 0a 3a 20 2b 72 65 76 73 69 67 6e 20 28 20 73 6b .: +revsign ( sk
7610: 20 70 6b 20 2d 2d 20 29 20 20 73 6b 73 69 67 20 pk -- ) sksig
7620: 2d 72 6f 74 20 65 64 2d 73 69 67 6e 20 72 65 76 -rot ed-sign rev
7630: 74 6f 6b 65 6e 20 24 2b 21 20 62 6c 20 72 65 76 token $+! bl rev
7640: 74 6f 6b 65 6e 20 63 24 2b 21 20 3b 0a 0a 3a 20 token c$+! ;..:
7650: 73 69 67 6e 2d 74 6f 6b 65 6e 2c 20 28 20 73 6b sign-token, ( sk
7660: 20 70 6b 20 73 74 72 69 6e 67 20 75 32 20 2d 2d pk string u2 --
7670: 20 29 0a 20 20 20 20 63 3a 30 6b 65 79 20 72 65 ). c:0key re
7680: 76 74 6f 6b 65 6e 20 24 40 20 32 73 77 61 70 20 vtoken $@ 2swap
7690: 3e 6b 65 79 65 64 2d 68 61 73 68 0a 20 20 20 20 >keyed-hash.
76a0: 73 69 67 64 61 74 65 20 2b 64 61 74 65 20 2b 72 sigdate +date +r
76b0: 65 76 73 69 67 6e 20 3b 0a 0a 3a 20 72 65 76 6f evsign ;..: revo
76c0: 6b 65 2d 6b 65 79 20 28 20 2d 2d 20 61 64 64 72 ke-key ( -- addr
76d0: 20 75 20 29 0a 20 20 20 20 73 6b 63 20 6f 6c 64 u ). skc old
76e0: 73 6b 63 20 6b 65 79 6d 6f 76 65 20 20 70 6b 63 skc keymove pkc
76f0: 20 6f 6c 64 70 6b 63 20 6b 65 79 6d 6f 76 65 20 oldpkc keymove
7700: 20 73 6b 72 65 76 20 6f 6c 64 73 6b 72 65 76 20 skrev oldskrev
7710: 6b 65 79 6d 6f 76 65 0a 20 20 20 20 20 20 20 20 keymove.
7720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7740: 20 20 20 5c 20 62 61 63 6b 75 70 20 6b 65 79 73 \ backup keys
7750: 0a 20 20 20 20 6f 6c 64 73 6b 72 65 76 20 6f 6c . oldskrev ol
7760: 64 70 6b 72 65 76 20 73 6b 3e 70 6b 20 20 20 20 dpkrev sk>pk
7770: 20 20 20 20 20 20 20 20 20 20 20 20 5c 20 67 65 \ ge
7780: 6e 65 72 61 74 65 20 72 65 76 6f 6b 61 74 69 6f nerate revokatio
7790: 6e 20 70 75 62 6b 65 79 0a 20 20 20 20 67 65 6e n pubkey. gen
77a0: 2d 6b 65 79 73 20 20 20 20 20 20 20 20 20 20 20 -keys
77b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
77c0: 20 20 20 20 5c 20 67 65 6e 65 72 61 74 65 20 6e \ generate n
77d0: 65 77 20 6b 65 79 73 0a 20 20 20 20 70 6b 63 20 ew keys. pkc
77e0: 6b 65 79 73 69 7a 65 32 20 72 65 76 74 6f 6b 65 keysize2 revtoke
77f0: 6e 20 24 21 20 20 20 20 20 20 20 20 20 20 20 20 n $!
7800: 20 20 20 5c 20 6d 79 20 6e 65 77 20 6b 65 79 0a \ my new key.
7810: 20 20 20 20 6f 6c 64 70 6b 72 65 76 20 6b 65 79 oldpkrev key
7820: 73 69 7a 65 20 72 65 76 74 6f 6b 65 6e 20 24 2b size revtoken $+
7830: 21 20 20 20 20 20 20 20 20 20 20 5c 20 72 65 76 ! \ rev
7840: 6f 6b 65 20 74 6f 6b 65 6e 0a 20 20 20 20 6f 6c oke token. ol
7850: 64 73 6b 72 65 76 20 6f 6c 64 70 6b 72 65 76 20 dskrev oldpkrev
7860: 22 72 65 76 6f 6b 65 22 20 73 69 67 6e 2d 74 6f "revoke" sign-to
7870: 6b 65 6e 2c 20 5c 20 72 65 76 6f 6b 65 20 73 69 ken, \ revoke si
7880: 67 6e 61 74 75 72 65 0a 20 20 20 20 73 6b 63 20 gnature. skc
7890: 70 6b 63 20 22 73 65 6c 66 73 69 67 6e 22 20 73 pkc "selfsign" s
78a0: 69 67 6e 2d 74 6f 6b 65 6e 2c 20 20 20 20 20 20 ign-token,
78b0: 20 20 20 5c 20 73 65 6c 66 20 73 69 67 6e 65 64 \ self signed
78c0: 20 77 69 74 68 20 6e 65 77 20 6b 65 79 0a 20 20 with new key.
78d0: 20 20 22 21 22 20 72 65 76 74 6f 6b 65 6e 20 30 "!" revtoken 0
78e0: 20 24 69 6e 73 20 20 20 20 20 20 20 20 20 20 20 $ins
78f0: 20 20 20 20 20 20 20 20 20 5c 20 22 21 22 20 2b \ "!" +
7900: 20 6f 6c 64 6b 65 79 6c 65 6e 2b 6e 65 77 6b 65 oldkeylen+newke
7910: 79 6c 65 6e 20 74 6f 20 66 6c 61 67 20 72 65 76 ylen to flag rev
7920: 6f 6b 61 74 69 6f 6e 0a 20 20 20 20 72 65 76 74 okation. revt
7930: 6f 6b 65 6e 20 24 40 20 67 65 6e 3e 68 6f 73 74 oken $@ gen>host
7940: 20 32 64 72 6f 70 20 20 20 20 20 20 20 20 20 20 2drop
7950: 20 20 20 5c 20 73 69 67 6e 20 68 6f 73 74 20 69 \ sign host i
7960: 6e 66 6f 72 6d 61 74 69 6f 6e 20 77 69 74 68 20 nformation with
7970: 6f 6c 64 20 6b 65 79 0a 20 20 20 20 73 69 67 64 old key. sigd
7980: 61 74 65 20 2b 64 61 74 65 20 73 69 67 64 61 74 ate +date sigdat
7990: 65 20 64 61 74 65 73 69 7a 65 23 20 72 65 76 74 e datesize# revt
79a0: 6f 6b 65 6e 20 24 2b 21 0a 20 20 20 20 6f 6c 64 oken $+!. old
79b0: 73 6b 63 20 6f 6c 64 70 6b 63 20 2b 72 65 76 73 skc oldpkc +revs
79c0: 69 67 6e 0a 20 20 20 20 30 6f 6c 64 6b 65 79 20 ign. 0oldkey
79d0: 72 65 76 74 6f 6b 65 6e 20 24 40 20 3b 0a 0a 5c revtoken $@ ;..\
79e0: 20 69 6e 76 69 74 61 74 69 6f 6e 0a 0a 56 61 72 invitation..Var
79f0: 69 61 62 6c 65 20 69 6e 76 69 74 61 74 69 6f 6e iable invitation
7a00: 73 0a 0a 65 76 65 6e 74 3a 20 2d 3e 69 6e 76 69 s..event: ->invi
7a10: 74 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 te ( addr u -- )
7a20: 0a 20 20 20 20 2e 22 20 69 6e 76 69 74 65 20 6d . ." invite m
7a30: 65 3a 20 22 20 6f 76 65 72 20 3e 72 20 2e 70 6b e: " over >r .pk
7a40: 32 6b 65 79 24 20 63 72 20 72 3e 20 66 72 65 65 2key$ cr r> free
7a50: 20 74 68 72 6f 77 20 63 74 72 6c 20 4c 20 69 6e throw ctrl L in
7a60: 73 6b 65 79 20 3b 0a 65 76 65 6e 74 3a 20 2d 3e skey ;.event: ->
7a70: 77 61 6b 65 6d 65 20 28 20 6f 20 2d 2d 20 29 20 wakeme ( o -- )
7a80: 3c 65 76 65 6e 74 20 2d 3e 77 61 6b 65 20 65 76 <event ->wake ev
7a90: 65 6e 74 3e 20 3b 0a 0a 3a 20 70 6b 32 6b 65 79 ent> ;..: pk2key
7aa0: 24 2d 61 64 64 20 28 20 61 64 64 72 20 75 20 70 $-add ( addr u p
7ab0: 65 72 6d 20 2d 2d 20 29 20 7b 20 70 65 72 6d 20 erm -- ) { perm
7ac0: 7d 0a 20 20 20 20 73 61 6d 70 6c 65 2d 6b 65 79 }. sample-key
7ad0: 20 3e 6f 20 69 6d 70 6f 72 74 23 69 6e 76 69 74 >o import#invit
7ae0: 65 64 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 ed import-type !
7af0: 20 63 6d 64 3a 6e 65 73 74 73 69 67 0a 20 20 20 cmd:nestsig.
7b00: 20 70 65 72 6d 20 6b 65 2d 6d 61 73 6b 20 21 0a perm ke-mask !.
7b10: 20 20 20 20 69 6d 70 6f 72 74 23 6e 65 77 20 69 import#new i
7b20: 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 20 73 61 mport-type ! sa
7b30: 76 65 2d 70 75 62 6b 65 79 73 20 6f 3e 20 3b 0a ve-pubkeys o> ;.
7b40: 0a 3a 20 78 2d 65 72 61 73 65 20 28 20 6c 65 6e .: x-erase ( len
7b50: 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 78 62 -- ). dup xb
7b60: 61 63 6b 2d 72 65 73 74 6f 72 65 20 20 64 75 70 ack-restore dup
7b70: 20 73 70 61 63 65 73 20 20 78 62 61 63 6b 2d 72 spaces xback-r
7b80: 65 73 74 6f 72 65 20 3b 0a 0a 3a 20 69 6e 76 69 estore ;..: invi
7b90: 74 65 2d 6b 65 79 20 28 20 61 64 64 72 20 75 20 te-key ( addr u
7ba0: 2d 2d 20 6b 65 79 20 29 0a 20 20 20 20 32 64 75 -- key ). 2du
7bb0: 70 20 78 2d 77 69 64 74 68 20 7b 20 61 64 64 72 p x-width { addr
7bc0: 20 75 20 6c 65 6e 20 7d 0a 20 20 20 20 42 45 47 u len }. BEG
7bd0: 49 4e 20 20 61 64 64 72 20 75 20 74 79 70 65 20 IN addr u type
7be0: 6b 65 79 20 20 6c 65 6e 20 78 2d 65 72 61 73 65 key len x-erase
7bf0: 0a 09 64 75 70 20 63 74 72 6c 20 5a 20 3d 0a 20 ..dup ctrl Z =.
7c00: 20 20 20 57 48 49 4c 45 20 20 64 72 6f 70 20 20 WHILE drop
7c10: 42 45 47 49 4e 20 20 6b 65 79 20 63 74 72 6c 20 BEGIN key ctrl
7c20: 4c 20 3d 20 20 55 4e 54 49 4c 20 20 52 45 50 45 L = UNTIL REPE
7c30: 41 54 20 3b 0a 0a 3a 20 70 72 6f 63 65 73 73 2d AT ;..: process-
7c40: 69 6e 76 69 74 61 74 69 6f 6e 20 28 20 61 64 64 invitation ( add
7c50: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 73 22 20 r u -- ). s"
7c60: 69 6e 76 69 74 65 20 28 79 2f 6e 2f 62 29 3f 22 invite (y/n/b)?"
7c70: 20 69 6e 76 69 74 65 2d 6b 65 79 0a 20 20 20 20 invite-key.
7c80: 63 61 73 65 0a 09 27 79 27 20 6f 66 20 20 70 65 case..'y' of pe
7c90: 72 6d 25 64 65 66 61 75 6c 74 20 70 6b 32 6b 65 rm%default pk2ke
7ca0: 79 24 2d 61 64 64 20 20 2e 22 20 61 64 64 65 64 y$-add ." added
7cb0: 22 20 63 72 20 20 20 65 6e 64 6f 66 0a 09 27 62 " cr endof..'b
7cc0: 27 20 6f 66 20 20 70 65 72 6d 25 62 6c 6f 63 6b ' of perm%block
7cd0: 65 64 20 70 6b 32 6b 65 79 24 2d 61 64 64 20 20 ed pk2key$-add
7ce0: 2e 22 20 62 6c 6f 63 6b 65 64 22 20 63 72 20 65 ." blocked" cr e
7cf0: 6e 64 6f 66 0a 09 32 64 72 6f 70 20 2e 22 20 69 ndof..2drop ." i
7d00: 67 6e 6f 72 65 64 22 20 63 72 0a 20 20 20 20 65 gnored" cr. e
7d10: 6e 64 63 61 73 65 20 3b 0a 0a 3a 20 66 69 6c 74 ndcase ;..: filt
7d20: 65 72 2d 69 6e 76 69 74 61 74 69 6f 6e 3f 20 28 er-invitation? (
7d30: 20 61 64 64 72 20 75 20 2d 2d 20 66 6c 61 67 20 addr u -- flag
7d40: 29 0a 20 20 20 20 73 69 67 70 6b 32 73 69 7a 65 ). sigpk2size
7d50: 23 20 2d 20 2b 20 6b 65 79 73 69 7a 65 20 6b 65 # - + keysize ke
7d60: 79 23 20 23 40 20 64 30 3c 3e 20 3b 20 5c 20 61 y# #@ d0<> ; \ a
7d70: 6c 72 65 61 64 79 20 74 68 65 72 65 0a 0a 3a 20 lready there..:
7d80: 2e 69 6e 76 69 74 61 74 69 6f 6e 73 20 28 20 2d .invitations ( -
7d90: 2d 20 29 0a 20 20 20 20 69 6e 76 69 74 61 74 69 - ). invitati
7da0: 6f 6e 73 20 5b 3a 20 32 64 75 70 20 2e 70 6b 32 ons [: 2dup .pk2
7db0: 6b 65 79 24 20 63 72 20 70 72 6f 63 65 73 73 2d key$ cr process-
7dc0: 69 6e 76 69 74 61 74 69 6f 6e 20 3b 5d 20 24 5b invitation ;] $[
7dd0: 5d 6d 61 70 0a 20 20 20 20 69 6e 76 69 74 61 74 ]map. invitat
7de0: 69 6f 6e 73 20 24 5b 5d 6f 66 66 20 3b 0a 0a 3a ions $[]off ;..:
7df0: 20 3e 69 6e 76 69 74 61 74 69 6f 6e 73 20 28 20 >invitations (
7e00: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 addr u -- ).
7e10: 32 64 75 70 20 66 69 6c 74 65 72 2d 69 6e 76 69 2dup filter-invi
7e20: 74 61 74 69 6f 6e 3f 20 49 46 20 20 32 64 72 6f tation? IF 2dro
7e30: 70 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 p EXIT THEN.
7e40: 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 24 5b 5d invitations $[]
7e50: 23 20 3e 72 0a 20 20 20 20 32 64 75 70 20 69 6e # >r. 2dup in
7e60: 76 69 74 61 74 69 6f 6e 73 20 24 69 6e 73 5b 5d vitations $ins[]
7e70: 73 69 67 20 64 72 6f 70 0a 20 20 20 20 69 6e 76 sig drop. inv
7e80: 69 74 61 74 69 6f 6e 73 20 24 5b 5d 23 20 72 3e itations $[]# r>
7e90: 20 3c 3e 20 49 46 0a 09 73 61 76 65 2d 6d 65 6d <> IF..save-mem
7ea0: 20 6d 61 69 6e 2d 75 70 40 20 3c 68 69 64 65 3e main-up@ <hide>
7eb0: 0a 09 3c 65 76 65 6e 74 20 65 24 2c 20 2d 3e 69 ..<event e$, ->i
7ec0: 6e 76 69 74 65 20 75 70 40 20 65 6c 69 74 2c 20 nvite up@ elit,
7ed0: 2d 3e 77 61 6b 65 6d 65 20 6d 61 69 6e 2d 75 70 ->wakeme main-up
7ee0: 40 20 65 76 65 6e 74 3e 20 73 74 6f 70 0a 20 20 @ event> stop.
7ef0: 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 ELSE 2drop T
7f00: 48 45 4e 20 3b 0a 0a 3a 20 73 65 6e 64 2d 69 6e HEN ;..: send-in
7f10: 76 69 74 61 74 69 6f 6e 20 28 20 70 6b 20 75 20 vitation ( pk u
7f20: 2d 2d 20 29 0a 20 20 20 20 73 65 74 75 70 21 20 -- ). setup!
7f30: 6d 79 70 6b 32 6e 69 63 6b 24 20 32 3e 72 0a 20 mypk2nick$ 2>r.
7f40: 20 20 20 67 65 6e 2d 74 6d 70 6b 65 79 73 20 64 gen-tmpkeys d
7f50: 72 6f 70 20 74 73 6b 63 20 73 77 61 70 20 6b 65 rop tskc swap ke
7f60: 79 70 61 64 20 65 64 2d 64 68 20 64 6f 2d 6b 65 ypad ed-dh do-ke
7f70: 79 70 61 64 20 73 65 63 21 0a 20 20 20 20 6e 65 ypad sec!. ne
7f80: 74 32 6f 2d 63 6f 64 65 30 0a 20 20 20 20 74 70 t2o-code0. tp
7f90: 6b 63 20 6b 65 79 73 69 7a 65 20 24 2c 20 6f 6e kc keysize $, on
7fa0: 65 73 68 6f 74 2d 74 6d 70 6b 65 79 0a 20 20 20 eshot-tmpkey.
7fb0: 20 6e 65 73 74 5b 20 32 72 3e 20 24 2c 20 69 6e nest[ 2r> $, in
7fc0: 76 69 74 65 20 5d 74 6d 70 6e 65 73 74 0a 20 20 vite ]tmpnest.
7fd0: 20 20 63 6f 6f 6b 69 65 2b 72 65 71 75 65 73 74 cookie+request
7fe0: 0a 20 20 20 20 65 6e 64 2d 63 6f 64 65 7c 20 3b . end-code| ;
7ff0: 0a 0a 5c 20 6b 65 79 20 61 70 69 20 68 65 6c 70 ..\ key api help
8000: 65 72 73 0a 0a 3a 20 64 65 6c 2d 6c 61 73 74 2d ers..: del-last-
8010: 6b 65 79 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b key ( -- ). k
8020: 65 79 73 20 24 5b 5d 23 20 31 2d 20 6b 65 79 73 eys $[]# 1- keys
8030: 20 24 5b 5d 20 73 65 63 2d 6f 66 66 0a 20 20 20 $[] sec-off.
8040: 20 6b 65 79 73 20 24 40 6c 65 6e 20 63 65 6c 6c keys $@len cell
8050: 2d 20 6b 65 79 73 20 24 21 6c 65 6e 20 3b 0a 0a - keys $!len ;..
8060: 3a 20 73 74 6f 72 65 6b 65 79 21 20 28 20 2d 2d : storekey! ( --
8070: 20 29 0a 20 20 20 20 3e 73 65 63 6b 65 79 20 6b ). >seckey k
8080: 65 79 73 20 24 5b 5d 23 20 30 20 3f 44 4f 20 20 eys $[]# 0 ?DO
8090: 32 64 75 70 20 49 20 6b 65 79 73 20 73 65 63 5b 2dup I keys sec[
80a0: 5d 40 20 73 74 72 3d 20 49 46 0a 09 20 20 20 20 ]@ str= IF..
80b0: 49 20 6b 65 79 73 20 73 65 63 5b 5d 40 20 64 72 I keys sec[]@ dr
80c0: 6f 70 20 3e 73 74 6f 72 65 6b 65 79 20 21 20 20 op >storekey !
80d0: 4c 45 41 56 45 20 20 54 48 45 4e 20 20 4c 4f 4f LEAVE THEN LOO
80e0: 50 20 20 32 64 72 6f 70 20 3b 0a 0a 3a 20 63 68 P 2drop ;..: ch
80f0: 6f 6f 73 65 2d 6b 65 79 20 28 20 2d 2d 20 6f 20 oose-key ( -- o
8100: 29 0a 20 20 20 20 30 20 42 45 47 49 4e 20 20 64 ). 0 BEGIN d
8110: 72 6f 70 0a 09 2e 22 20 43 68 6f 6f 73 65 20 6b rop..." Choose k
8120: 65 79 20 62 79 20 6e 75 6d 62 65 72 3a 22 20 63 ey by number:" c
8130: 72 20 2e 73 65 63 72 65 74 2d 6e 69 63 6b 73 0a r .secret-nicks.
8140: 09 42 45 47 49 4e 20 20 6b 65 79 20 64 75 70 20 .BEGIN key dup
8150: 62 6c 20 3c 20 57 48 49 4c 45 20 20 64 72 6f 70 bl < WHILE drop
8160: 20 20 52 45 50 45 41 54 20 5c 20 73 77 61 6c 6c REPEAT \ swall
8170: 6f 77 20 63 6f 6e 74 72 6f 6c 20 6b 65 79 73 0a ow control keys.
8180: 09 5b 27 5d 20 64 69 67 69 74 3f 20 23 33 36 20 .['] digit? #36
8190: 62 61 73 65 2d 65 78 65 63 75 74 65 20 30 3d 20 base-execute 0=
81a0: 49 46 20 2d 31 20 54 48 45 4e 0a 09 73 65 63 72 IF -1 THEN..secr
81b0: 65 74 2d 6b 65 79 20 64 75 70 20 30 3d 20 57 48 et-key dup 0= WH
81c0: 49 4c 45 0a 09 20 20 20 20 2e 22 20 50 6c 65 61 ILE.. ." Plea
81d0: 73 65 20 65 6e 74 65 72 20 61 20 62 61 73 65 2d se enter a base-
81e0: 33 36 20 6e 75 6d 62 65 72 20 62 65 74 77 65 65 36 number betwee
81f0: 6e 20 30 20 61 6e 64 20 22 0a 09 20 20 20 20 73 n 0 and ".. s
8200: 65 63 72 65 74 2d 6b 65 79 73 23 20 31 2d 20 5b ecret-keys# 1- [
8210: 27 5d 20 2e 20 23 33 36 20 62 61 73 65 2d 65 78 '] . #36 base-ex
8220: 65 63 75 74 65 20 63 72 20 20 72 64 72 6f 70 0a ecute cr rdrop.
8230: 20 20 20 20 52 45 50 45 41 54 0a 20 20 20 20 64 REPEAT. d
8240: 75 70 20 2e 73 74 6f 72 65 6b 65 79 21 20 20 3e up .storekey! >
8250: 73 74 6f 72 65 6b 65 79 20 40 20 64 65 66 61 75 storekey @ defau
8260: 6c 74 6b 65 79 20 21 0a 20 20 20 20 2e 22 20 3d ltkey !. ." =
8270: 3d 3d 3d 20 6b 65 79 20 22 20 64 75 70 20 2e 2e === key " dup ..
8280: 6e 69 63 6b 20 2e 22 20 20 63 68 6f 73 65 6e 20 nick ." chosen
8290: 3d 3d 3d 3d 22 20 63 72 20 3b 0a 0a 5c 20 77 69 ====" cr ;..\ wi
82a0: 6c 6c 20 61 73 6b 20 66 6f 72 20 79 6f 75 72 20 ll ask for your
82b0: 70 61 73 73 77 6f 72 64 20 61 6e 64 20 69 66 20 password and if
82c0: 70 6f 73 73 69 62 6c 65 20 61 75 74 6f 2d 73 65 possible auto-se
82d0: 6c 65 63 74 20 79 6f 75 72 20 69 64 0a 0a 56 61 lect your id..Va
82e0: 72 69 61 62 6c 65 20 74 72 69 65 73 23 0a 23 31 riable tries#.#1
82f0: 30 20 56 61 6c 75 65 20 6d 61 78 74 72 69 65 73 0 Value maxtries
8300: 23 0a 0a 3a 20 67 65 74 2d 73 6b 63 20 28 20 2d #..: get-skc ( -
8310: 2d 20 29 0a 20 20 20 20 73 65 63 72 65 74 2d 6b - ). secret-k
8320: 65 79 73 23 20 3f 45 58 49 54 20 20 74 72 69 65 eys# ?EXIT trie
8330: 73 23 20 6f 66 66 0a 20 20 20 20 64 65 62 75 67 s# off. debug
8340: 2d 76 65 63 74 6f 72 20 40 20 6f 70 2d 76 65 63 -vector @ op-vec
8350: 74 6f 72 20 21 40 20 3e 72 20 3c 64 65 66 61 75 tor !@ >r <defau
8360: 6c 74 3e 0a 20 20 20 20 73 65 63 72 65 74 2d 6b lt>. secret-k
8370: 65 79 73 23 0a 20 20 20 20 42 45 47 49 4e 20 20 eys#. BEGIN
8380: 64 75 70 20 30 3d 20 74 72 69 65 73 23 20 40 20 dup 0= tries# @
8390: 6d 61 78 74 72 69 65 73 23 20 75 3c 20 61 6e 64 maxtries# u< and
83a0: 20 20 57 48 49 4c 45 20 64 72 6f 70 0a 09 20 20 WHILE drop..
83b0: 20 20 73 22 20 50 61 73 73 70 68 72 61 73 65 3a s" Passphrase:
83c0: 20 22 20 2b 70 61 73 73 70 68 72 61 73 65 20 20 " +passphrase
83d0: 20 21 74 69 6d 65 0a 09 20 20 20 20 72 65 61 64 !time.. read
83e0: 2d 6b 65 79 73 20 73 65 63 72 65 74 2d 6b 65 79 -keys secret-key
83f0: 73 23 20 64 75 70 20 30 3d 20 49 46 0a 09 09 5c s# dup 0= IF...\
8400: 20 66 61 69 6c 20 72 69 67 68 74 20 61 66 74 65 fail right afte
8410: 72 20 74 68 65 20 66 69 72 73 74 20 74 72 79 20 r the first try
8420: 69 66 20 50 41 53 53 50 48 52 41 53 45 20 69 73 if PASSPHRASE is
8430: 20 75 73 65 64 0a 09 09 5c 20 61 6e 64 20 67 69 used...\ and gi
8440: 76 65 20 74 68 65 20 6d 61 78 69 6d 75 6d 20 77 ve the maximum w
8450: 61 69 74 69 6e 67 20 70 65 6e 61 6c 74 79 20 69 aiting penalty i
8460: 6e 20 74 68 61 74 20 63 61 73 65 0a 09 09 31 20 n that case...1
8470: 6d 61 78 74 72 69 65 73 23 20 73 22 20 50 41 53 maxtries# s" PAS
8480: 53 50 48 52 41 53 45 22 20 67 65 74 65 6e 76 20 SPHRASE" getenv
8490: 64 30 3d 20 73 65 6c 65 63 74 20 74 72 69 65 73 d0= select tries
84a0: 23 20 2b 21 0a 09 09 3c 65 72 72 3e 20 2e 22 20 # +!...<err> ."
84b0: 54 72 79 23 20 22 20 74 72 69 65 73 23 20 40 20 Try# " tries# @
84c0: 30 20 2e 72 20 27 2f 27 20 65 6d 69 74 20 6d 61 0 .r '/' emit ma
84d0: 78 74 72 69 65 73 23 20 2e 0a 09 09 2e 22 20 66 xtries# ....." f
84e0: 61 69 6c 65 64 2c 20 6e 6f 20 6b 65 79 20 66 6f ailed, no key fo
84f0: 75 6e 64 2c 20 77 61 69 74 69 6e 67 20 22 0a 09 und, waiting "..
8500: 09 23 31 20 74 72 69 65 73 23 20 40 20 32 2a 20 .#1 tries# @ 2*
8510: 6c 73 68 69 66 74 20 64 75 70 20 2e 20 2e 22 20 lshift dup . ."
8520: 6d 73 2e 2e 2e 22 20 6d 73 20 20 3c 64 65 66 61 ms..." ms <defa
8530: 75 6c 74 3e 20 63 72 0a 09 09 64 65 6c 2d 6c 61 ult> cr...del-la
8540: 73 74 2d 6b 65 79 0a 09 20 20 20 20 54 48 45 4e st-key.. THEN
8550: 0a 20 20 20 20 52 45 50 45 41 54 0a 20 20 20 20 . REPEAT.
8560: 64 75 70 20 30 3d 20 49 46 20 20 23 2d 35 36 20 dup 0= IF #-56
8570: 74 68 72 6f 77 20 20 54 48 45 4e 0a 20 20 20 20 throw THEN.
8580: 31 20 3d 20 49 46 20 20 30 20 73 65 63 72 65 74 1 = IF 0 secret
8590: 2d 6b 65 79 0a 09 2e 22 20 3d 3d 3d 3d 20 6f 70 -key..." ==== op
85a0: 65 6e 65 64 3a 20 22 20 64 75 70 20 2e 2e 6e 69 ened: " dup ..ni
85b0: 63 6b 20 2e 22 20 20 69 6e 20 22 20 2e 74 69 6d ck ." in " .tim
85c0: 65 20 2e 22 20 3d 3d 3d 3d 22 20 63 72 0a 20 20 e ." ====" cr.
85d0: 20 20 45 4c 53 45 20 20 2e 22 20 3d 3d 3d 3d 20 ELSE ." ====
85e0: 6f 70 65 6e 65 64 20 69 6e 20 22 20 2e 74 69 6d opened in " .tim
85f0: 65 20 2e 22 20 3d 3d 3d 3d 22 20 63 72 20 63 68 e ." ====" cr ch
8600: 6f 6f 73 65 2d 6b 65 79 20 20 54 48 45 4e 0a 20 oose-key THEN.
8610: 20 20 20 3e 72 61 77 2d 6b 65 79 20 3f 72 73 6b >raw-key ?rsk
8620: 20 20 20 72 3e 20 6f 70 2d 76 65 63 74 6f 72 20 r> op-vector
8630: 21 20 3b 0a 0a 73 63 6f 70 65 3a 20 6e 32 6f 0a ! ;..scope: n2o.
8640: 46 6f 72 77 61 72 64 20 68 65 6c 70 0a 7d 73 63 Forward help.}sc
8650: 6f 70 65 0a 0a 3a 20 67 65 74 2d 6d 79 2d 6b 65 ope..: get-my-ke
8660: 79 20 28 20 2d 2d 20 78 74 20 29 0a 20 20 20 20 y ( -- xt ).
8670: 67 65 6e 2d 6b 65 79 73 2d 64 69 72 20 20 22 73 gen-keys-dir "s
8680: 65 63 6b 65 79 73 2e 6b 32 6f 22 20 2e 6b 65 79 eckeys.k2o" .key
8690: 73 2f 20 32 64 75 70 20 66 69 6c 65 2d 73 74 61 s/ 2dup file-sta
86a0: 74 75 73 20 6e 69 70 0a 20 20 20 20 30 3d 20 49 tus nip. 0= I
86b0: 46 20 20 72 2f 6f 20 6f 70 65 6e 2d 66 69 6c 65 F r/o open-file
86c0: 20 74 68 72 6f 77 20 3e 72 20 72 40 20 66 69 6c throw >r r@ fil
86d0: 65 2d 73 69 7a 65 20 74 68 72 6f 77 20 64 30 3d e-size throw d0=
86e0: 0a 09 72 3e 20 63 6c 6f 73 65 2d 66 69 6c 65 20 ..r> close-file
86f0: 74 68 72 6f 77 20 20 45 4c 53 45 20 20 74 72 75 throw ELSE tru
8700: 65 20 20 54 48 45 4e 0a 20 20 20 20 49 46 20 20 e THEN. IF
8710: 5b 3a 20 2e 22 20 47 65 6e 65 72 61 74 65 20 61 [: ." Generate a
8720: 20 6e 65 77 20 6b 65 79 70 61 69 72 3a 22 20 63 new keypair:" c
8730: 72 0a 09 20 20 67 65 74 2d 6e 69 63 6b 20 64 75 r.. get-nick du
8740: 70 20 30 3d 20 23 2d 35 36 20 61 6e 64 20 74 68 p 0= #-56 and th
8750: 72 6f 77 20 5c 20 65 6d 70 74 79 20 6e 69 63 6b row \ empty nick
8760: 3a 20 70 72 65 74 65 6e 64 20 74 6f 20 71 75 69 : pretend to qui
8770: 74 0a 09 20 20 6e 65 77 2d 6b 65 79 20 2e 6b 65 t.. new-key .ke
8780: 79 73 20 3f 72 73 6b 20 3b 5d 0a 20 20 20 20 45 ys ?rsk ;]. E
8790: 4c 53 45 20 20 5b 27 5d 20 67 65 74 2d 73 6b 63 LSE ['] get-skc
87a0: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 2e 6b 65 79 THEN ;..: .key
87b0: 69 6e 66 6f 20 28 20 2d 2d 20 29 0a 20 20 20 20 info ( -- ).
87c0: 3c 77 61 72 6e 3e 20 2e 22 20 3d 3d 3d 3d 20 4e <warn> ." ==== N
87d0: 6f 20 6b 65 79 20 6f 70 65 6e 65 64 20 3d 3d 3d o key opened ===
87e0: 3d 22 20 63 72 0a 20 20 20 20 3c 69 6e 66 6f 3e =" cr. <info>
87f0: 20 2e 22 20 67 65 6e 65 72 61 74 65 20 61 20 6e ." generate a n
8800: 65 77 20 6f 6e 65 20 77 69 74 68 20 27 6b 65 79 ew one with 'key
8810: 67 65 6e 27 22 20 63 72 20 3c 64 65 66 61 75 6c gen'" cr <defaul
8820: 74 3e 20 3b 0a 0a 3a 20 67 65 74 2d 6d 65 20 28 t> ;..: get-me (
8830: 20 2d 2d 20 29 0a 20 20 20 20 67 65 74 2d 6d 79 -- ). get-my
8840: 2d 6b 65 79 20 63 61 74 63 68 20 64 75 70 20 23 -key catch dup #
8850: 2d 35 36 20 3d 20 49 46 20 64 72 6f 70 20 2e 6b -56 = IF drop .k
8860: 65 79 69 6e 66 6f 20 45 4c 53 45 20 74 68 72 6f eyinfo ELSE thro
8870: 77 20 54 48 45 4e 20 3b 0a 0a 3a 20 3f 67 65 74 w THEN ;..: ?get
8880: 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 5c -me ( -- ). \
8890: 47 20 74 68 69 73 20 76 65 72 73 69 6f 6e 20 6f G this version o
88a0: 66 20 67 65 74 2d 6d 65 20 66 61 69 6c 73 20 68 f get-me fails h
88b0: 61 72 64 20 69 66 20 6e 6f 20 6b 65 79 20 69 73 ard if no key is
88c0: 20 6f 70 65 6e 65 64 0a 20 20 20 20 67 65 74 2d opened. get-
88d0: 6d 79 2d 6b 65 79 20 63 61 74 63 68 20 23 2d 35 my-key catch #-5
88e0: 36 20 3d 20 49 46 0a 09 2e 6b 65 79 69 6e 66 6f 6 = IF...keyinfo
88f0: 20 74 72 75 65 20 21 21 6e 6f 2d 6b 65 79 2d 6f true !!no-key-o
8900: 70 65 6e 21 21 0a 20 20 20 20 54 48 45 4e 20 3b pen!!. THEN ;
8910: 0a 0a 30 20 5b 49 46 5d 0a 4c 6f 63 61 6c 20 56 ..0 [IF].Local V
8920: 61 72 69 61 62 6c 65 73 3a 0a 66 6f 72 74 68 2d ariables:.forth-
8930: 6c 6f 63 61 6c 2d 77 6f 72 64 73 3a 0a 20 20 20 local-words:.
8940: 20 28 0a 20 20 20 20 20 28 28 22 6e 65 74 32 6f (. (("net2o
8950: 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20 64 65 :" "+net2o:") de
8960: 66 69 6e 69 74 69 6f 6e 2d 73 74 61 72 74 65 72 finition-starter
8970: 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 6b 65 79 77 (font-lock-keyw
8980: 6f 72 64 2d 66 61 63 65 20 2e 20 31 29 0a 20 20 ord-face . 1).
8990: 20 20 20 20 22 5b 20 5c 74 5c 6e 5d 22 20 74 20 "[ \t\n]" t
89a0: 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d name (font-lock-
89b0: 66 75 6e 63 74 69 6f 6e 2d 6e 61 6d 65 2d 66 61 function-name-fa
89c0: 63 65 20 2e 20 33 29 29 0a 20 20 20 20 20 28 28 ce . 3)). ((
89d0: 22 64 65 62 75 67 3a 22 20 22 66 69 65 6c 64 3a "debug:" "field:
89e0: 22 20 22 32 66 69 65 6c 64 3a 22 20 22 73 66 66 " "2field:" "sff
89f0: 69 65 6c 64 3a 22 20 22 64 66 66 69 65 6c 64 3a ield:" "dffield:
8a00: 22 20 22 36 34 66 69 65 6c 64 3a 22 20 22 75 76 " "64field:" "uv
8a10: 61 72 22 20 22 75 76 61 6c 75 65 22 29 20 6e 6f ar" "uvalue") no
8a20: 6e 2d 69 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e n-immediate (fon
8a30: 74 2d 6c 6f 63 6b 2d 74 79 70 65 2d 66 61 63 65 t-lock-type-face
8a40: 20 2e 20 32 29 0a 20 20 20 20 20 20 22 5b 20 5c . 2). "[ \
8a50: 74 5c 6e 5d 22 20 74 20 6e 61 6d 65 20 28 66 6f t\n]" t name (fo
8a60: 6e 74 2d 6c 6f 63 6b 2d 76 61 72 69 61 62 6c 65 nt-lock-variable
8a70: 2d 6e 61 6d 65 2d 66 61 63 65 20 2e 20 33 29 29 -name-face . 3))
8a80: 0a 20 20 20 20 20 28 22 5b 61 2d 7a 30 2d 39 5d . ("[a-z0-9]
8a90: 2b 28 22 20 69 6d 6d 65 64 69 61 74 65 20 28 66 +(" immediate (f
8aa0: 6f 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 ont-lock-comment
8ab0: 2d 66 61 63 65 20 2e 20 31 29 0a 20 20 20 20 20 -face . 1).
8ac0: 20 22 29 22 20 6e 69 6c 20 63 6f 6d 6d 65 6e 74 ")" nil comment
8ad0: 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d (font-lock-comm
8ae0: 65 6e 74 2d 66 61 63 65 20 2e 20 31 29 29 0a 20 ent-face . 1)).
8af0: 20 20 20 29 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c ).forth-local
8b00: 2d 69 6e 64 65 6e 74 2d 77 6f 72 64 73 3a 0a 20 -indent-words:.
8b10: 20 20 20 28 0a 20 20 20 20 20 28 28 22 6e 65 74 (. (("net
8b20: 32 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20 2o:" "+net2o:")
8b30: 28 30 20 2e 20 32 29 20 28 30 20 2e 20 32 29 20 (0 . 2) (0 . 2)
8b40: 6e 6f 6e 2d 69 6d 6d 65 64 69 61 74 65 29 0a 20 non-immediate).
8b50: 20 20 20 20 28 28 22 5b 3a 22 20 22 6b 65 79 3a (("[:" "key:
8b60: 63 6f 64 65 22 29 20 28 30 20 2e 20 31 29 20 28 code") (0 . 1) (
8b70: 30 20 2e 20 31 29 20 69 6d 6d 65 64 69 61 74 65 0 . 1) immediate
8b80: 29 0a 20 20 20 20 20 28 28 22 3b 5d 22 20 22 65 ). ((";]" "e
8b90: 6e 64 3a 6b 65 79 22 29 20 28 2d 31 20 2e 20 30 nd:key") (-1 . 0
8ba0: 29 20 28 30 20 2e 20 2d 31 29 20 69 6d 6d 65 64 ) (0 . -1) immed
8bb0: 69 61 74 65 29 0a 20 20 20 20 29 0a 45 6e 64 3a iate). ).End:
8bc0: 0a 5b 54 48 45 4e 5d .[THEN]