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 30 2d 32 30 31 35 20 20 (C) 2010-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 32 20 56 61 word entry..2 Va
0300: 6c 75 65 20 70 77 2d 6c 65 76 65 6c 23 20 5c 20 lue pw-level# \
0310: 70 77 2d 6c 65 76 65 6c 23 20 30 20 69 73 20 6c pw-level# 0 is l
0320: 6f 77 65 73 74 0a 34 20 56 61 6c 75 65 20 70 77 owest.4 Value pw
0330: 2d 6d 61 78 6c 65 76 65 6c 23 20 5c 20 70 77 2d -maxlevel# \ pw-
0340: 6d 61 78 6c 65 76 65 6c 23 20 69 73 20 74 68 65 maxlevel# is the
0350: 20 6d 61 78 69 6d 75 6d 20 63 68 65 63 6b 65 64 maximum checked
0360: 0a 0a 5b 49 46 44 45 46 5d 20 61 6e 64 72 6f 69 ..[IFDEF] androi
0370: 64 78 78 78 20 27 2a 27 20 5b 45 4c 53 45 5d 20 dxxx '*' [ELSE]
0380: 27 e2 80 a2 27 20 5b 54 48 45 4e 5d 20 43 6f 6e '•' [THEN] Con
0390: 73 74 61 6e 74 20 70 77 2a 0a 0a 78 63 2d 76 65 stant pw*..xc-ve
03a0: 63 74 6f 72 20 75 70 40 20 2d 20 63 6c 61 73 73 ctor up@ - class
03b0: 2d 6f 20 21 0a 0a 30 20 63 65 6c 6c 20 75 76 61 -o !..0 cell uva
03c0: 72 20 65 73 63 2d 73 74 61 74 65 20 64 72 6f 70 r esc-state drop
03d0: 0a 0a 44 65 66 65 72 20 6f 6c 64 2d 65 6d 69 74 ..Defer old-emit
03e0: 20 20 77 68 61 74 27 73 20 65 6d 69 74 20 69 73 what's emit is
03f0: 20 6f 6c 64 2d 65 6d 69 74 0a 0a 68 65 72 65 0a old-emit..here.
0400: 78 63 2d 76 65 63 74 6f 72 20 40 20 63 65 6c 6c xc-vector @ cell
0410: 2d 20 64 75 70 20 40 20 74 75 63 6b 20 2d 20 68 - dup @ tuck - h
0420: 65 72 65 20 73 77 61 70 20 64 75 70 20 61 6c 6c ere swap dup all
0430: 6f 74 20 6d 6f 76 65 0a 2c 20 68 65 72 65 20 30 ot move., here 0
0440: 20 2c 20 43 6f 6e 73 74 61 6e 74 20 75 74 66 2d , Constant utf-
0450: 38 2a 0a 0a 78 63 2d 76 65 63 74 6f 72 20 40 20 8*..xc-vector @
0460: 20 75 74 66 2d 38 2a 20 78 63 2d 76 65 63 74 6f utf-8* xc-vecto
0470: 72 20 21 20 27 20 2a 2d 77 69 64 74 68 20 69 73 r ! ' *-width is
0480: 20 78 2d 77 69 64 74 68 20 20 78 63 2d 76 65 63 x-width xc-vec
0490: 74 6f 72 20 21 0a 0a 3a 20 65 6d 69 74 2d 70 77 tor !..: emit-pw
04a0: 2a 20 28 20 6e 20 2d 2d 20 29 0a 20 20 20 20 64 * ( n -- ). d
04b0: 75 70 20 23 65 73 63 20 3d 20 49 46 20 20 65 73 up #esc = IF es
04c0: 63 2d 73 74 61 74 65 20 6f 6e 20 20 54 48 45 4e c-state on THEN
04d0: 0a 20 20 20 20 64 75 70 20 62 6c 20 3c 20 49 46 . dup bl < IF
04e0: 20 20 6f 6c 64 2d 65 6d 69 74 20 20 45 58 49 54 old-emit EXIT
04f0: 20 20 54 48 45 4e 0a 20 20 20 20 65 73 63 2d 73 THEN. esc-s
0500: 74 61 74 65 20 40 20 49 46 20 20 64 75 70 20 6f tate @ IF dup o
0510: 6c 64 2d 65 6d 69 74 0a 20 20 20 20 45 4c 53 45 ld-emit. ELSE
0520: 20 20 64 75 70 20 24 43 30 20 24 38 30 20 77 69 dup $C0 $80 wi
0530: 74 68 69 6e 20 49 46 0a 09 20 20 20 20 5b 20 70 thin IF.. [ p
0540: 77 2a 20 27 20 78 65 6d 69 74 20 24 74 6d 70 0a w* ' xemit $tmp.
0550: 09 20 20 20 20 62 6f 75 6e 64 73 20 5b 3f 44 4f . bounds [?DO
0560: 5d 20 5b 49 5d 20 63 40 20 5d 4c 20 6f 6c 64 2d ] [I] c@ ]L old-
0570: 65 6d 69 74 20 5b 20 5b 4c 4f 4f 50 5d 20 5d 0a emit [ [LOOP] ].
0580: 09 54 48 45 4e 0a 20 20 20 20 54 48 45 4e 0a 20 .THEN. THEN.
0590: 20 20 20 74 6f 75 70 70 65 72 20 27 41 27 20 27 toupper 'A' '
05a0: 5b 27 20 77 69 74 68 69 6e 20 49 46 20 20 65 73 [' within IF es
05b0: 63 2d 73 74 61 74 65 20 6f 66 66 20 20 54 48 45 c-state off THE
05c0: 4e 20 3b 0a 0a 3a 20 74 79 70 65 2d 70 77 2a 20 N ;..: type-pw*
05d0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 20 32 ( addr u -- ) 2
05e0: 64 75 70 20 62 6c 20 73 6b 69 70 20 6e 69 70 20 dup bl skip nip
05f0: 30 3d 0a 20 20 20 20 49 46 20 20 20 20 62 6f 75 0=. IF bou
0600: 6e 64 73 20 55 2b 44 4f 20 20 62 6c 20 6f 6c 64 nds U+DO bl old
0610: 2d 65 6d 69 74 20 20 20 20 4c 4f 4f 50 0a 20 20 -emit LOOP.
0620: 20 20 45 4c 53 45 20 20 62 6f 75 6e 64 73 20 55 ELSE bounds U
0630: 2b 44 4f 20 20 49 20 63 40 20 65 6d 69 74 2d 70 +DO I c@ emit-p
0640: 77 2a 20 20 4c 4f 4f 50 20 20 54 48 45 4e 20 3b w* LOOP THEN ;
0650: 0a 0a 3a 20 61 63 63 65 70 74 2a 20 28 20 61 64 ..: accept* ( ad
0660: 64 72 20 75 20 2d 2d 20 75 27 20 29 0a 20 20 20 dr u -- u' ).
0670: 20 5c 47 20 61 63 63 65 70 74 2d 6c 69 6b 65 20 \G accept-like
0680: 69 6e 70 75 74 2c 20 62 75 74 20 74 79 70 65 73 input, but types
0690: 20 2a 20 69 6e 73 74 65 61 64 20 6f 66 20 74 68 * instead of th
06a0: 65 20 63 68 61 72 61 63 74 65 72 0a 20 20 20 20 e character.
06b0: 5c 47 20 64 6f 6e 27 74 20 73 61 76 65 20 69 6e \G don't save in
06c0: 74 6f 20 68 69 73 74 6f 72 79 0a 20 20 20 20 68 to history. h
06d0: 69 73 74 6f 72 79 20 3e 72 20 20 77 68 61 74 27 istory >r what'
06e0: 73 20 74 79 70 65 20 3e 72 20 20 77 68 61 74 27 s type >r what'
06f0: 73 20 65 6d 69 74 20 69 73 20 6f 6c 64 2d 65 6d s emit is old-em
0700: 69 74 0a 20 20 20 20 75 74 66 2d 38 2a 20 78 63 it. utf-8* xc
0710: 2d 76 65 63 74 6f 72 20 21 40 20 3e 72 20 20 5b -vector !@ >r [
0720: 27 5d 20 74 79 70 65 2d 70 77 2a 20 69 73 20 74 '] type-pw* is t
0730: 79 70 65 20 20 5b 27 5d 20 65 6d 69 74 2d 70 77 ype ['] emit-pw
0740: 2a 20 69 73 20 65 6d 69 74 0a 20 20 20 20 30 20 * is emit. 0
0750: 74 6f 20 68 69 73 74 6f 72 79 0a 20 20 20 20 5b to history. [
0760: 27 5d 20 61 63 63 65 70 74 20 63 61 74 63 68 0a '] accept catch.
0770: 20 20 20 20 72 3e 20 78 63 2d 76 65 63 74 6f 72 r> xc-vector
0780: 20 21 20 20 77 68 61 74 27 73 20 6f 6c 64 2d 65 ! what's old-e
0790: 6d 69 74 20 69 73 20 65 6d 69 74 20 20 72 3e 20 mit is emit r>
07a0: 69 73 20 74 79 70 65 20 20 72 3e 20 74 6f 20 68 is type r> to h
07b0: 69 73 74 6f 72 79 0a 20 20 20 20 74 68 72 6f 77 istory. throw
07c0: 20 2d 31 20 30 20 61 74 2d 64 65 6c 74 61 78 79 -1 0 at-deltaxy
07d0: 20 73 70 61 63 65 20 3b 0a 0a 5c 20 4b 65 79 73 space ;..\ Keys
07e0: 20 61 72 65 20 70 61 73 73 77 6f 72 64 73 20 61 are passwords a
07f0: 6e 64 20 70 72 69 76 61 74 65 20 6b 65 79 73 20 nd private keys
0800: 28 73 65 6c 66 2d 6b 65 79 65 64 2c 20 69 2e 65 (self-keyed, i.e
0810: 2e 20 70 72 69 76 61 74 65 2a 70 75 62 6c 69 63 . private*public
0820: 20 6b 65 79 29 0a 0a 63 6d 64 2d 62 75 66 30 20 key)..cmd-buf0
0830: 75 63 6c 61 73 73 20 63 6d 64 62 75 66 2d 6f 0a uclass cmdbuf-o.
0840: 20 20 20 20 6d 61 78 64 61 74 61 20 2d 0a 20 20 maxdata -.
0850: 20 20 6b 65 79 2d 73 61 6c 74 23 20 75 76 61 72 key-salt# uvar
0860: 20 6b 65 79 70 61 63 6b 0a 20 20 20 20 6b 65 79 keypack. key
0870: 70 61 63 6b 23 20 20 75 76 61 72 20 6b 65 79 70 pack# uvar keyp
0880: 61 63 6b 2d 62 75 66 0a 20 20 20 20 6b 65 79 2d ack-buf. key-
0890: 63 6b 73 75 6d 23 20 75 76 61 72 20 6b 65 79 70 cksum# uvar keyp
08a0: 61 63 6b 2d 63 68 6b 73 75 6d 0a 65 6e 64 2d 63 ack-chksum.end-c
08b0: 6c 61 73 73 20 63 6d 64 2d 6b 65 79 62 75 66 2d lass cmd-keybuf-
08c0: 63 0a 0a 63 6d 64 2d 6b 65 79 62 75 66 2d 63 20 c..cmd-keybuf-c
08d0: 6e 65 77 20 63 6f 64 65 2d 6b 65 79 5e 20 21 0a new code-key^ !.
08e0: 27 20 63 6f 64 65 2d 6b 65 79 5e 20 63 6d 64 62 ' code-key^ cmdb
08f0: 75 66 3a 20 63 6f 64 65 2d 6b 65 79 0a 0a 63 6f uf: code-key..co
0900: 64 65 2d 6b 65 79 0a 63 6d 64 30 6c 6f 63 6b 20 de-key.cmd0lock
0910: 30 20 70 74 68 72 65 61 64 5f 6d 75 74 65 78 5f 0 pthread_mutex_
0920: 69 6e 69 74 20 64 72 6f 70 0a 0a 3a 6e 6f 6e 61 init drop..:nona
0930: 6d 65 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 me ( -- addr u )
0940: 20 6b 65 79 70 61 63 6b 2d 62 75 66 20 63 6d 64 keypack-buf cmd
0950: 62 75 66 23 20 40 20 3b 20 74 6f 20 63 6d 64 62 buf# @ ; to cmdb
0960: 75 66 24 0a 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d uf$.:noname ( --
0970: 20 6e 20 29 20 20 6b 65 79 70 61 63 6b 23 20 63 n ) keypack# c
0980: 6d 64 62 75 66 23 20 40 20 2d 20 3b 20 74 6f 20 mdbuf# @ - ; to
0990: 6d 61 78 73 74 72 69 6e 67 0a 0a 63 6f 64 65 30 maxstring..code0
09a0: 2d 62 75 66 0a 0a 3a 6e 6f 6e 61 6d 65 20 64 65 -buf..:noname de
09b0: 66 65 72 73 20 61 6c 6c 6f 63 2d 63 6f 64 65 2d fers alloc-code-
09c0: 62 75 66 73 0a 20 20 20 20 63 6d 64 2d 6b 65 79 bufs. cmd-key
09d0: 62 75 66 2d 63 20 6e 65 77 20 63 6f 64 65 2d 6b buf-c new code-k
09e0: 65 79 5e 20 21 20 3b 20 69 73 20 61 6c 6c 6f 63 ey^ ! ; is alloc
09f0: 2d 63 6f 64 65 2d 62 75 66 73 0a 3a 6e 6f 6e 61 -code-bufs.:nona
0a00: 6d 65 20 64 65 66 65 72 73 20 66 72 65 65 2d 63 me defers free-c
0a10: 6f 64 65 2d 62 75 66 73 0a 20 20 20 20 63 6f 64 ode-bufs. cod
0a20: 65 2d 6b 65 79 5e 20 40 20 2e 64 69 73 70 6f 73 e-key^ @ .dispos
0a30: 65 20 3b 20 69 73 20 66 72 65 65 2d 63 6f 64 65 e ; is free-code
0a40: 2d 62 75 66 73 0a 0a 5c 20 68 61 73 68 65 64 20 -bufs..\ hashed
0a50: 6b 65 79 20 64 61 74 61 20 62 61 73 65 0a 0a 55 key data base..U
0a60: 73 65 72 20 3e 73 74 6f 72 65 6b 65 79 0a 56 61 ser >storekey.Va
0a70: 72 69 61 62 6c 65 20 64 65 66 61 75 6c 74 6b 65 riable defaultke
0a80: 79 0a 0a 63 6d 64 2d 63 6c 61 73 73 20 63 6c 61 y..cmd-class cla
0a90: 73 73 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 ss. field: ke
0aa0: 2d 73 6b 20 20 20 20 20 20 20 5c 20 73 65 63 72 -sk \ secr
0ab0: 65 74 20 6b 65 79 0a 20 20 20 20 66 69 65 6c 64 et key. field
0ac0: 3a 20 6b 65 2d 70 6b 20 20 20 20 20 20 20 5c 20 : ke-pk \
0ad0: 70 75 62 6c 69 63 20 6b 65 79 0a 20 20 20 20 66 public key. f
0ae0: 69 65 6c 64 3a 20 6b 65 2d 72 73 6b 20 20 20 20 ield: ke-rsk
0af0: 20 20 5c 20 72 65 76 6f 6b 65 20 73 65 63 72 65 \ revoke secre
0b00: 74 20 28 74 65 6d 70 6f 72 61 72 69 6c 79 20 73 t (temporarily s
0b10: 74 6f 72 65 64 29 0a 20 20 20 20 66 69 65 6c 64 tored). field
0b20: 3a 20 6b 65 2d 74 79 70 65 20 20 20 20 20 5c 20 : ke-type \
0b30: 6b 65 79 20 74 79 70 65 0a 20 20 20 20 66 69 65 key type. fie
0b40: 6c 64 3a 20 6b 65 2d 6e 69 63 6b 20 20 20 20 20 ld: ke-nick
0b50: 5c 20 6b 65 79 20 6e 69 63 6b 0a 20 20 20 20 66 \ key nick. f
0b60: 69 65 6c 64 3a 20 6b 65 2d 6e 69 63 6b 23 20 20 ield: ke-nick#
0b70: 20 20 5c 20 74 6f 20 61 76 6f 69 64 20 63 6f 6c \ to avoid col
0b80: 69 73 73 69 6f 6e 73 2c 20 61 64 64 20 61 20 6e issions, add a n
0b90: 75 6d 62 65 72 20 68 65 72 65 0a 20 20 20 20 66 umber here. f
0ba0: 69 65 6c 64 3a 20 6b 65 2d 70 65 74 73 20 20 20 ield: ke-pets
0bb0: 20 20 5c 20 6b 65 79 20 70 65 74 6e 61 6d 65 73 \ key petnames
0bc0: 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 2d 70 . field: ke-p
0bd0: 65 74 73 23 20 20 20 20 5c 20 74 6f 20 61 76 6f ets# \ to avo
0be0: 69 64 20 63 6f 6c 69 73 73 69 6f 6e 73 2c 20 61 id colissions, a
0bf0: 64 64 20 61 20 6e 75 6d 62 65 72 20 68 65 72 65 dd a number here
0c00: 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 2d 70 . field: ke-p
0c10: 72 6f 66 20 20 20 20 20 5c 20 70 72 6f 66 69 6c rof \ profil
0c20: 65 20 6f 62 6a 65 63 74 0a 20 20 20 20 66 69 65 e object. fie
0c30: 6c 64 3a 20 6b 65 2d 73 65 6c 66 73 69 67 0a 20 ld: ke-selfsig.
0c40: 20 20 20 66 69 65 6c 64 3a 20 6b 65 2d 73 69 67 field: ke-sig
0c50: 73 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 2d s. field: ke-
0c60: 69 6d 70 6f 72 74 73 20 20 5c 20 62 69 74 6d 61 imports \ bitma
0c70: 73 6b 20 6f 66 20 6b 65 79 20 69 6d 70 6f 72 74 sk of key import
0c80: 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 2d 73 . field: ke-s
0c90: 74 6f 72 65 6b 65 79 20 5c 20 75 73 65 64 20 74 torekey \ used t
0ca0: 6f 20 65 6e 63 72 79 70 74 20 6f 6e 20 73 74 6f o encrypt on sto
0cb0: 72 61 67 65 0a 20 20 20 20 66 69 65 6c 64 3a 20 rage. field:
0cc0: 6b 65 2d 6d 61 73 6b 20 20 20 20 20 5c 20 70 65 ke-mask \ pe
0cd0: 72 6d 69 73 73 69 6f 6e 20 6d 61 73 6b 0a 20 20 rmission mask.
0ce0: 20 20 36 34 66 69 65 6c 64 3a 20 6b 65 2d 6f 66 64field: ke-of
0cf0: 66 73 65 74 20 5c 20 6f 66 66 73 65 74 20 69 6e fset \ offset in
0d00: 20 6b 65 79 20 66 69 6c 65 0a 20 20 20 20 66 69 key file. fi
0d10: 65 6c 64 3a 20 6b 65 2d 70 77 6c 65 76 65 6c 20 eld: ke-pwlevel
0d20: 20 5c 20 70 61 73 73 77 6f 72 64 20 73 74 72 65 \ password stre
0d30: 6e 67 74 68 20 6c 65 76 65 6c 0a 20 20 20 20 30 ngth level. 0
0d40: 20 2b 66 69 65 6c 64 20 6b 65 2d 65 6e 64 0a 65 +field ke-end.e
0d50: 6e 64 2d 63 6c 61 73 73 20 6b 65 79 2d 65 6e 74 nd-class key-ent
0d60: 72 79 0a 0a 3a 20 66 72 65 65 2d 6b 65 79 20 28 ry..: free-key (
0d70: 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b 65 79 20 o:key -- o:key
0d80: 29 0a 20 20 20 20 5c 67 20 66 72 65 65 20 61 6c ). \g free al
0d90: 6c 20 70 61 72 74 73 20 6f 66 20 74 68 65 20 73 l parts of the s
0da0: 75 62 6b 65 79 0a 20 20 20 20 6b 65 2d 73 6b 20 ubkey. ke-sk
0db0: 73 65 63 2d 6f 66 66 0a 20 20 20 20 6b 65 2d 70 sec-off. ke-p
0dc0: 6b 20 24 6f 66 66 0a 20 20 20 20 6b 65 2d 6e 69 k $off. ke-ni
0dd0: 63 6b 20 24 6f 66 66 0a 20 20 20 20 6b 65 2d 73 ck $off. ke-s
0de0: 65 6c 66 73 69 67 20 24 6f 66 66 0a 20 20 20 20 elfsig $off.
0df0: 6b 65 2d 73 69 67 73 20 24 5b 5d 6f 66 66 0a 20 ke-sigs $[]off.
0e00: 20 20 20 6b 65 2d 70 65 74 73 20 24 5b 5d 6f 66 ke-pets $[]of
0e10: 66 0a 20 20 20 20 6b 65 2d 70 65 74 73 23 20 24 f. ke-pets# $
0e20: 6f 66 66 20 3b 0a 0a 56 61 72 69 61 62 6c 65 20 off ;..Variable
0e30: 6b 65 79 2d 65 6e 74 72 79 2d 74 61 62 6c 65 0a key-entry-table.
0e40: 0a 5c 20 6b 65 79 20 63 6c 61 73 73 0a 0a 30 0a .\ key class..0.
0e50: 65 6e 75 6d 20 6b 65 79 23 61 6e 6f 6e 0a 65 6e enum key#anon.en
0e60: 75 6d 20 6b 65 79 23 75 73 65 72 0a 65 6e 75 6d um key#user.enum
0e70: 20 6b 65 79 23 67 72 6f 75 70 0a 64 72 6f 70 0a key#group.drop.
0e80: 0a 5c 20 6b 65 79 20 69 6d 70 6f 72 74 20 74 79 .\ key import ty
0e90: 70 65 0a 0a 30 0a 65 6e 75 6d 20 69 6d 70 6f 72 pe..0.enum impor
0ea0: 74 23 73 65 6c 66 20 20 20 20 20 20 5c 20 70 72 t#self \ pr
0eb0: 69 76 61 74 65 20 6b 65 79 0a 65 6e 75 6d 20 69 ivate key.enum i
0ec0: 6d 70 6f 72 74 23 6d 61 6e 75 61 6c 20 20 20 20 mport#manual
0ed0: 5c 20 6d 61 6e 75 61 6c 20 69 6d 70 6f 72 74 0a \ manual import.
0ee0: 65 6e 75 6d 20 69 6d 70 6f 72 74 23 73 63 61 6e enum import#scan
0ef0: 20 20 20 20 20 20 5c 20 73 63 61 6e 20 69 6d 70 \ scan imp
0f00: 6f 72 74 0a 65 6e 75 6d 20 69 6d 70 6f 72 74 23 ort.enum import#
0f10: 63 68 61 74 20 20 20 20 20 20 5c 20 73 65 65 6e chat \ seen
0f20: 20 69 6e 20 63 68 61 74 0a 65 6e 75 6d 20 69 6d in chat.enum im
0f30: 70 6f 72 74 23 64 68 74 20 20 20 20 20 20 20 5c port#dht \
0f40: 20 64 68 74 20 69 6d 70 6f 72 74 0a 65 6e 75 6d dht import.enum
0f50: 20 69 6d 70 6f 72 74 23 69 6e 76 69 74 65 64 20 import#invited
0f60: 20 20 5c 20 69 6e 76 69 74 61 74 69 6f 6e 20 69 \ invitation i
0f70: 6d 70 6f 72 74 0a 65 6e 75 6d 20 69 6d 70 6f 72 mport.enum impor
0f80: 74 23 75 6e 74 72 75 73 74 65 64 20 5c 20 6d 75 t#untrusted \ mu
0f90: 73 74 20 62 65 20 6c 61 73 74 0a 64 72 6f 70 0a st be last.drop.
0fa0: 24 31 46 20 65 6e 75 6d 20 69 6d 70 6f 72 74 23 $1F enum import#
0fb0: 6e 65 77 20 20 20 5c 20 6e 65 77 20 66 6f 72 6d new \ new form
0fc0: 61 74 0a 64 72 6f 70 0a 0a 43 72 65 61 74 65 20 at.drop..Create
0fd0: 69 6d 70 6f 72 74 73 24 20 24 32 30 20 61 6c 6c imports$ $20 all
0fe0: 6f 74 20 69 6d 70 6f 72 74 73 24 20 24 32 30 20 ot imports$ $20
0ff0: 62 6c 20 66 69 6c 6c 0a 22 49 6d 73 63 64 69 75 bl fill."Imscdiu
1000: 22 20 69 6d 70 6f 72 74 73 24 20 73 77 61 70 20 " imports$ swap
1010: 6d 6f 76 65 0a 0a 56 61 72 69 61 62 6c 65 20 69 move..Variable i
1020: 6d 70 6f 72 74 2d 74 79 70 65 20 20 69 6d 70 6f mport-type impo
1030: 72 74 23 75 6e 74 72 75 73 74 65 64 20 69 6d 70 rt#untrusted imp
1040: 6f 72 74 2d 74 79 70 65 20 21 0a 0a 43 72 65 61 ort-type !..Crea
1050: 74 65 20 3e 69 6d 2d 63 6f 6c 6f 72 20 20 24 42 te >im-color $B
1060: 36 30 20 2c 20 24 44 36 30 20 2c 20 24 39 36 30 60 , $D60 , $960
1070: 20 2c 20 24 43 36 30 20 2c 20 24 41 36 30 20 2c , $C60 , $A60 ,
1080: 20 24 38 42 31 20 2c 20 24 45 36 30 20 2c 0a 44 $8B1 , $E60 ,.D
1090: 4f 45 53 3e 20 73 77 61 70 20 38 20 63 65 6c 6c OES> swap 8 cell
10a0: 73 20 30 20 44 4f 20 20 64 75 70 20 31 20 61 6e s 0 DO dup 1 an
10b0: 64 20 49 46 20 20 64 72 6f 70 20 49 20 4c 45 41 d IF drop I LEA
10c0: 56 45 20 20 54 48 45 4e 20 20 32 2f 20 20 4c 4f VE THEN 2/ LO
10d0: 4f 50 0a 20 20 63 65 6c 6c 73 20 2b 20 40 20 61 OP. cells + @ a
10e0: 74 74 72 21 20 3b 0a 0a 3a 20 2e 69 6d 70 6f 72 ttr! ;..: .impor
10f0: 74 73 20 28 20 6d 61 73 6b 20 2d 2d 20 29 0a 20 ts ( mask -- ).
1100: 20 20 20 69 6d 70 6f 72 74 73 24 20 24 32 30 20 imports$ $20
1110: 62 6f 75 6e 64 73 20 44 4f 0a 09 64 75 70 20 31 bounds DO..dup 1
1120: 20 61 6e 64 20 49 46 20 20 49 20 63 40 20 65 6d and IF I c@ em
1130: 69 74 20 20 54 48 45 4e 20 20 32 2f 20 4c 4f 4f it THEN 2/ LOO
1140: 50 0a 20 20 20 20 64 72 6f 70 20 3b 0a 0a 5c 20 P. drop ;..\
1150: 73 61 6d 70 6c 65 20 6b 65 79 0a 0a 30 20 56 61 sample key..0 Va
1160: 6c 75 65 20 73 61 6d 70 6c 65 2d 6b 65 79 0a 0a lue sample-key..
1170: 56 61 72 69 61 62 6c 65 20 6b 65 79 2d 74 61 62 Variable key-tab
1180: 6c 65 20 5c 20 6b 65 79 20 68 61 73 68 20 74 61 le \ key hash ta
1190: 62 6c 65 0a 56 61 72 69 61 62 6c 65 20 6e 69 63 ble.Variable nic
11a0: 6b 2d 74 61 62 6c 65 20 5c 20 6e 69 63 6b 20 68 k-table \ nick h
11b0: 61 73 68 20 74 61 62 6c 65 0a 0a 36 34 56 61 72 ash table..64Var
11c0: 69 61 62 6c 65 20 6b 65 79 2d 72 65 61 64 2d 6f iable key-read-o
11d0: 66 66 73 65 74 0a 0a 3a 20 63 75 72 72 65 6e 74 ffset..: current
11e0: 2d 6b 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d -key ( addr u --
11f0: 20 6f 20 29 0a 20 20 20 20 32 64 75 70 20 6b 65 o ). 2dup ke
1200: 79 7c 20 6b 65 79 2d 74 61 62 6c 65 20 23 40 20 y| key-table #@
1210: 64 72 6f 70 0a 20 20 20 20 64 75 70 20 30 3d 20 drop. dup 0=
1220: 49 46 20 20 64 72 6f 70 20 2e 22 20 75 6e 6b 6e IF drop ." unkn
1230: 6f 77 6e 20 6b 65 79 3a 20 22 20 38 35 74 79 70 own key: " 85typ
1240: 65 20 63 72 20 20 30 20 45 58 49 54 20 20 54 48 e cr 0 EXIT TH
1250: 45 4e 0a 20 20 20 20 63 65 6c 6c 2b 20 3e 6f 20 EN. cell+ >o
1260: 6b 65 2d 70 6b 20 24 21 20 6f 20 6f 3e 20 3b 0a ke-pk $! o o> ;.
1270: 0a 56 61 72 69 61 62 6c 65 20 73 69 6d 2d 6e 69 .Variable sim-ni
1280: 63 6b 21 0a 0a 3a 20 6e 69 63 6b 21 20 28 20 2d ck!..: nick! ( -
1290: 2d 20 29 20 73 69 6d 2d 6e 69 63 6b 21 20 40 20 - ) sim-nick! @
12a0: 3f 45 58 49 54 20 20 6f 20 7b 20 77 5e 20 6f 70 ?EXIT o { w^ op
12b0: 74 72 20 7d 0a 20 20 20 20 6b 65 2d 6e 69 63 6b tr }. ke-nick
12c0: 20 24 40 20 6e 69 63 6b 2d 74 61 62 6c 65 20 23 $@ nick-table #
12d0: 40 20 64 30 3d 20 49 46 0a 09 6f 70 74 72 20 63 @ d0= IF..optr c
12e0: 65 6c 6c 20 6b 65 2d 6e 69 63 6b 20 24 40 20 6e ell ke-nick $@ n
12f0: 69 63 6b 2d 74 61 62 6c 65 20 23 21 20 30 0a 20 ick-table #! 0.
1300: 20 20 20 45 4c 53 45 0a 09 6c 61 73 74 23 20 63 ELSE..last# c
1310: 65 6c 6c 2b 20 24 40 6c 65 6e 20 63 65 6c 6c 2f ell+ $@len cell/
1320: 0a 09 6f 70 74 72 20 63 65 6c 6c 20 6c 61 73 74 ..optr cell last
1330: 23 20 63 65 6c 6c 2b 20 24 2b 21 0a 20 20 20 20 # cell+ $+!.
1340: 54 48 45 4e 20 20 6b 65 2d 6e 69 63 6b 23 20 21 THEN ke-nick# !
1350: 20 3b 0a 0a 3a 20 23 2e 6e 69 63 6b 20 28 20 68 ;..: #.nick ( h
1360: 61 73 68 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 ash -- ). dup
1370: 20 24 40 20 74 79 70 65 20 27 23 27 20 65 6d 69 $@ type '#' emi
1380: 74 20 63 65 6c 6c 2b 20 24 40 6c 65 6e 20 63 65 t cell+ $@len ce
1390: 6c 6c 2f 20 2e 20 3b 0a 0a 3a 20 6c 61 73 74 2d ll/ . ;..: last-
13a0: 70 65 74 40 20 28 20 2d 2d 20 61 64 64 72 20 75 pet@ ( -- addr u
13b0: 20 29 0a 20 20 20 20 6b 65 2d 70 65 74 73 20 24 ). ke-pets $
13c0: 5b 5d 23 20 3f 64 75 70 2d 49 46 20 20 31 2d 20 []# ?dup-IF 1-
13d0: 6b 65 2d 70 65 74 73 20 24 5b 5d 40 20 20 45 4c ke-pets $[]@ EL
13e0: 53 45 20 20 30 2e 20 20 54 48 45 4e 20 3b 0a 0a SE 0. THEN ;..
13f0: 3a 20 70 65 74 21 20 28 20 2d 2d 20 29 20 73 69 : pet! ( -- ) si
1400: 6d 2d 6e 69 63 6b 21 20 40 20 3f 45 58 49 54 20 m-nick! @ ?EXIT
1410: 20 6f 20 7b 20 77 5e 20 6f 70 74 72 20 7d 0a 20 o { w^ optr }.
1420: 20 20 20 6c 61 73 74 2d 70 65 74 40 20 6e 69 63 last-pet@ nic
1430: 6b 2d 74 61 62 6c 65 20 23 40 20 64 30 3d 20 49 k-table #@ d0= I
1440: 46 0a 09 6f 70 74 72 20 63 65 6c 6c 20 6c 61 73 F..optr cell las
1450: 74 2d 70 65 74 40 20 6e 69 63 6b 2d 74 61 62 6c t-pet@ nick-tabl
1460: 65 20 23 21 20 30 0a 20 20 20 20 45 4c 53 45 0a e #! 0. ELSE.
1470: 09 6c 61 73 74 23 20 63 65 6c 6c 2b 20 24 40 6c .last# cell+ $@l
1480: 65 6e 20 63 65 6c 6c 2f 0a 09 6f 70 74 72 20 63 en cell/..optr c
1490: 65 6c 6c 20 6c 61 73 74 23 20 63 65 6c 6c 2b 20 ell last# cell+
14a0: 24 2b 21 0a 20 20 20 20 54 48 45 4e 20 20 6b 65 $+!. THEN ke
14b0: 2d 70 65 74 73 20 24 5b 5d 23 20 31 2d 20 6b 65 -pets $[]# 1- ke
14c0: 2d 70 65 74 73 23 20 24 5b 5d 20 21 20 3b 0a 0a -pets# $[] ! ;..
14d0: 3a 20 6b 65 79 3a 6e 65 77 20 28 20 61 64 64 72 : key:new ( addr
14e0: 20 75 20 2d 2d 20 6f 20 29 0a 20 20 20 20 5c 47 u -- o ). \G
14f0: 20 63 72 65 61 74 65 20 6e 65 77 20 6b 65 79 2c create new key,
1500: 20 61 64 64 72 20 75 20 69 73 20 74 68 65 20 70 addr u is the p
1510: 75 62 6c 69 63 20 6b 65 79 0a 20 20 20 20 73 61 ublic key. sa
1520: 6d 70 6c 65 2d 6b 65 79 20 3e 6f 0a 20 20 20 20 mple-key >o.
1530: 6b 65 79 2d 65 6e 74 72 79 2d 74 61 62 6c 65 20 key-entry-table
1540: 40 20 74 6f 6b 65 6e 2d 74 61 62 6c 65 20 21 0a @ token-table !.
1550: 20 20 20 20 6b 65 2d 73 6b 20 6b 65 2d 65 6e 64 ke-sk ke-end
1560: 20 6f 76 65 72 20 2d 20 65 72 61 73 65 20 20 3e over - erase >
1570: 73 74 6f 72 65 6b 65 79 20 40 20 6b 65 2d 73 74 storekey @ ke-st
1580: 6f 72 65 6b 65 79 20 21 0a 20 20 20 20 6b 65 79 orekey !. key
1590: 2d 72 65 61 64 2d 6f 66 66 73 65 74 20 36 34 40 -read-offset 64@
15a0: 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 21 0a 20 ke-offset 64!.
15b0: 20 20 20 31 20 69 6d 70 6f 72 74 2d 74 79 70 65 1 import-type
15c0: 20 40 20 6c 73 68 69 66 74 20 5b 20 31 20 69 6d @ lshift [ 1 im
15d0: 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 port#new lshift
15e0: 5d 4c 20 6f 72 20 6b 65 2d 69 6d 70 6f 72 74 73 ]L or ke-imports
15f0: 20 21 0a 20 20 20 20 6b 65 79 70 61 63 6b 2d 61 !. keypack-a
1600: 6c 6c 23 20 6e 3e 36 34 20 6b 65 79 2d 72 65 61 ll# n>64 key-rea
1610: 64 2d 6f 66 66 73 65 74 20 36 34 2b 21 20 6f 20 d-offset 64+! o
1620: 63 65 6c 6c 2d 20 6b 65 2d 65 6e 64 20 6f 76 65 cell- ke-end ove
1630: 72 20 2d 0a 20 20 20 20 32 6f 76 65 72 20 6b 65 r -. 2over ke
1640: 79 7c 20 6b 65 79 2d 74 61 62 6c 65 20 23 21 20 y| key-table #!
1650: 6f 3e 0a 20 20 20 20 63 75 72 72 65 6e 74 2d 6b o>. current-k
1660: 65 79 20 3b 0a 0a 30 20 56 61 6c 75 65 20 6c 61 ey ;..0 Value la
1670: 73 74 2d 6b 65 79 0a 0a 3a 20 6b 65 79 3f 6e 65 st-key..: key?ne
1680: 77 20 28 20 61 64 64 72 20 75 20 2d 2d 20 6f 20 w ( addr u -- o
1690: 29 0a 20 20 20 20 5c 47 20 43 72 65 61 74 65 20 ). \G Create
16a0: 6f 72 20 6c 6f 6f 6b 75 70 20 6e 65 77 20 6b 65 or lookup new ke
16b0: 79 0a 20 20 20 20 32 64 75 70 20 6b 65 79 7c 20 y. 2dup key|
16c0: 6b 65 79 2d 74 61 62 6c 65 20 23 40 20 64 72 6f key-table #@ dro
16d0: 70 0a 20 20 20 20 64 75 70 20 30 3d 20 49 46 20 p. dup 0= IF
16e0: 20 64 72 6f 70 20 6b 65 79 3a 6e 65 77 20 20 45 drop key:new E
16f0: 4c 53 45 20 20 6e 69 70 20 6e 69 70 20 63 65 6c LSE nip nip cel
1700: 6c 2b 20 20 54 48 45 4e 0a 20 20 20 20 64 75 70 l+ THEN. dup
1710: 20 74 6f 20 6c 61 73 74 2d 6b 65 79 20 3b 0a 0a to last-key ;..
1720: 5c 20 73 65 61 72 63 68 20 66 6f 72 20 6b 65 79 \ search for key
1730: 73 20 2d 20 6e 6f 74 20 6f 70 74 69 6d 69 7a 65 s - not optimize
1740: 64 0a 0a 3a 20 23 73 70 6c 69 74 20 28 20 61 64 d..: #split ( ad
1750: 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 20 6e dr u -- addr u n
1760: 20 29 0a 20 20 20 20 5b 3a 20 32 64 75 70 20 27 ). [: 2dup '
1770: 23 27 20 2d 73 63 61 6e 20 6e 69 70 20 3e 72 0a #' -scan nip >r.
1780: 20 20 20 20 20 20 72 40 20 30 3d 20 49 46 20 20 r@ 0= IF
1790: 72 64 72 6f 70 20 30 20 20 45 58 49 54 20 20 54 rdrop 0 EXIT T
17a0: 48 45 4e 0a 20 20 20 20 20 20 30 2e 20 32 6f 76 HEN. 0. 2ov
17b0: 65 72 20 72 40 20 2f 73 74 72 69 6e 67 20 3e 6e er r@ /string >n
17c0: 75 6d 62 65 72 0a 20 20 20 20 20 20 30 3d 20 49 umber. 0= I
17d0: 46 20 20 6e 69 70 20 64 72 6f 70 20 6e 69 70 20 F nip drop nip
17e0: 72 3e 20 31 2d 20 73 77 61 70 20 20 45 4c 53 45 r> 1- swap ELSE
17f0: 0a 09 20 20 72 64 72 6f 70 20 64 72 6f 70 20 32 .. rdrop drop 2
1800: 64 72 6f 70 20 30 20 20 20 54 48 45 4e 20 3b 5d drop 0 THEN ;]
1810: 20 23 31 30 20 62 61 73 65 2d 65 78 65 63 75 74 #10 base-execut
1820: 65 20 3b 0a 0a 3a 20 6e 69 63 6b 2d 6b 65 79 20 e ;..: nick-key
1830: 28 20 61 64 64 72 20 75 20 2d 2d 20 6f 20 2f 20 ( addr u -- o /
1840: 30 20 29 20 5c 20 73 65 61 72 63 68 20 66 6f 72 0 ) \ search for
1850: 20 6b 65 79 20 6e 69 63 6b 6e 61 6d 65 0a 20 20 key nickname.
1860: 20 20 23 73 70 6c 69 74 20 3e 72 20 6e 69 63 6b #split >r nick
1870: 2d 74 61 62 6c 65 20 23 40 20 32 64 75 70 20 64 -table #@ 2dup d
1880: 30 3d 20 49 46 20 20 72 64 72 6f 70 20 64 72 6f 0= IF rdrop dro
1890: 70 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 p EXIT THEN.
18a0: 20 20 72 3e 20 63 65 6c 6c 73 20 73 61 66 65 2f r> cells safe/
18b0: 73 74 72 69 6e 67 20 30 3d 20 49 46 20 20 64 72 string 0= IF dr
18c0: 6f 70 20 30 20 20 45 58 49 54 20 20 54 48 45 4e op 0 EXIT THEN
18d0: 20 20 40 20 3b 0a 0a 3a 20 73 65 63 72 65 74 2d @ ;..: secret-
18e0: 6b 65 79 73 23 20 28 20 2d 2d 20 6e 20 29 0a 20 keys# ( -- n ).
18f0: 20 20 20 30 20 6b 65 79 2d 74 61 62 6c 65 20 5b 0 key-table [
1900: 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 20 : cell+ $@ drop
1910: 63 65 6c 6c 2b 20 3e 6f 20 6b 65 2d 73 6b 20 40 cell+ >o ke-sk @
1920: 20 30 3c 3e 20 2d 20 6f 3e 20 3b 5d 20 23 6d 61 0<> - o> ;] #ma
1930: 70 20 3b 0a 3a 20 73 65 63 72 65 74 2d 6b 65 79 p ;.: secret-key
1940: 20 28 20 6e 20 2d 2d 20 6f 2f 30 20 29 0a 20 20 ( n -- o/0 ).
1950: 20 20 30 20 74 75 63 6b 20 6b 65 79 2d 74 61 62 0 tuck key-tab
1960: 6c 65 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 le [: cell+ $@ d
1970: 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 20 6b 65 2d rop cell+ >o ke-
1980: 73 6b 20 40 20 49 46 0a 09 20 20 32 64 75 70 20 sk @ IF.. 2dup
1990: 3d 20 49 46 20 20 72 6f 74 20 64 72 6f 70 20 6f = IF rot drop o
19a0: 20 2d 72 6f 74 20 20 54 48 45 4e 20 20 31 2b 0a -rot THEN 1+.
19b0: 20 20 20 20 20 20 54 48 45 4e 20 20 6f 3e 20 3b THEN o> ;
19c0: 5d 20 23 6d 61 70 20 32 64 72 6f 70 20 3b 0a 3a ] #map 2drop ;.:
19d0: 20 2e 23 20 28 20 6e 20 2d 2d 20 29 20 3f 64 75 .# ( n -- ) ?du
19e0: 70 2d 49 46 20 20 27 23 27 20 65 6d 69 74 20 30 p-IF '#' emit 0
19f0: 20 2e 72 20 20 54 48 45 4e 20 3b 0a 3a 20 2e 6e .r THEN ;.: .n
1a00: 69 63 6b 2d 62 61 73 65 20 28 20 6f 3a 6b 65 79 ick-base ( o:key
1a10: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 6e 69 63 -- ). ke-nic
1a20: 6b 20 24 2e 20 20 6b 65 2d 6e 69 63 6b 23 20 40 k $. ke-nick# @
1a30: 20 2e 23 20 3b 0a 3a 20 2e 70 65 74 2d 62 61 73 .# ;.: .pet-bas
1a40: 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 e ( o:key -- ).
1a50: 20 20 20 30 20 6b 65 2d 70 65 74 73 20 5b 3a 20 0 ke-pets [:
1a60: 73 70 61 63 65 20 74 79 70 65 0a 20 20 20 20 20 space type.
1a70: 20 64 75 70 20 6b 65 2d 70 65 74 73 23 20 24 5b dup ke-pets# $[
1a80: 5d 20 40 20 2e 23 20 20 31 2b 20 3b 5d 20 24 5b ] @ .# 1+ ;] $[
1a90: 5d 6d 61 70 20 64 72 6f 70 20 3b 0a 3a 20 2e 70 ]map drop ;.: .p
1aa0: 65 74 30 2d 62 61 73 65 20 28 20 6f 3a 6b 65 79 et0-base ( o:key
1ab0: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 70 65 74 -- ). ke-pet
1ac0: 73 20 24 5b 5d 23 20 49 46 20 20 30 20 6b 65 2d s $[]# IF 0 ke-
1ad0: 70 65 74 73 20 24 5b 5d 40 20 74 79 70 65 20 30 pets $[]@ type 0
1ae0: 20 6b 65 2d 70 65 74 73 23 20 24 5b 5d 20 40 20 ke-pets# $[] @
1af0: 2e 23 0a 20 20 20 20 45 4c 53 45 20 20 2e 6e 69 .#. ELSE .ni
1b00: 63 6b 2d 62 61 73 65 20 20 54 48 45 4e 20 3b 0a ck-base THEN ;.
1b10: 3a 20 2e 72 65 61 6c 2d 6e 69 63 6b 20 28 20 6f : .real-nick ( o
1b20: 3a 6b 65 79 20 2d 2d 20 29 20 20 20 6b 65 2d 69 :key -- ) ke-i
1b30: 6d 70 6f 72 74 73 20 40 20 3e 69 6d 2d 63 6f 6c mports @ >im-col
1b40: 6f 72 20 2e 6e 69 63 6b 2d 62 61 73 65 20 3c 64 or .nick-base <d
1b50: 65 66 61 75 6c 74 3e 20 3b 0a 3a 20 2e 6e 69 63 efault> ;.: .nic
1b60: 6b 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 20 20 k ( o:key -- )
1b70: 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e 69 ke-imports @ >i
1b80: 6d 2d 63 6f 6c 6f 72 20 2e 70 65 74 30 2d 62 61 m-color .pet0-ba
1b90: 73 65 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 3a se <default> ;.:
1ba0: 20 2e 6e 69 63 6b 2b 70 65 74 20 28 20 6f 3a 6b .nick+pet ( o:k
1bb0: 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 69 ey -- ). ke-i
1bc0: 6d 70 6f 72 74 73 20 40 20 3e 69 6d 2d 63 6f 6c mports @ >im-col
1bd0: 6f 72 20 2e 6e 69 63 6b 2d 62 61 73 65 20 2e 70 or .nick-base .p
1be0: 65 74 2d 62 61 73 65 20 3c 64 65 66 61 75 6c 74 et-base <default
1bf0: 3e 20 3b 0a 0a 3a 20 6e 69 63 6b 3e 70 6b 20 28 > ;..: nick>pk (
1c00: 20 6e 69 63 6b 20 75 20 2d 2d 20 70 6b 20 75 20 nick u -- pk u
1c10: 29 0a 20 20 20 20 6e 69 63 6b 2d 6b 65 79 20 3f ). nick-key ?
1c20: 64 75 70 2d 49 46 20 2e 6b 65 2d 70 6b 20 24 40 dup-IF .ke-pk $@
1c30: 20 45 4c 53 45 20 30 20 30 20 54 48 45 4e 20 3b ELSE 0 0 THEN ;
1c40: 0a 3a 20 68 6f 73 74 2e 6e 69 63 6b 3e 70 6b 20 .: host.nick>pk
1c50: 28 20 61 64 64 72 20 75 20 2d 2d 20 70 6b 20 75 ( addr u -- pk u
1c60: 27 20 29 0a 20 20 20 20 27 2e 27 20 24 73 70 6c ' ). '.' $spl
1c70: 69 74 20 64 75 70 20 30 3d 20 49 46 20 20 32 73 it dup 0= IF 2s
1c80: 77 61 70 20 20 54 48 45 4e 20 5b 3a 20 6e 69 63 wap THEN [: nic
1c90: 6b 3e 70 6b 20 74 79 70 65 20 74 79 70 65 20 3b k>pk type type ;
1ca0: 5d 20 24 74 6d 70 20 3b 0a 0a 3a 20 6b 65 79 2d ] $tmp ;..: key-
1cb0: 65 78 69 73 74 3f 20 28 20 61 64 64 72 20 75 20 exist? ( addr u
1cc0: 2d 2d 20 6f 2f 30 20 29 0a 20 20 20 20 6b 65 79 -- o/0 ). key
1cd0: 2d 74 61 62 6c 65 20 23 40 20 49 46 20 20 63 65 -table #@ IF ce
1ce0: 6c 6c 2b 20 20 54 48 45 4e 20 3b 20 0a 0a 5c 20 ll+ THEN ; ..\
1cf0: 70 65 72 6d 69 73 73 69 6f 6e 20 6d 6f 64 69 66 permission modif
1d00: 69 63 61 74 69 6f 6e 0a 0a 32 36 20 62 75 66 66 ication..26 buff
1d10: 65 72 3a 20 70 65 72 6d 2d 63 68 61 72 73 0a 30 er: perm-chars.0
1d20: 20 70 65 72 6d 24 20 63 6f 75 6e 74 20 62 6f 75 perm$ count bou
1d30: 6e 64 73 20 5b 44 4f 5d 20 64 75 70 20 5b 49 5d nds [DO] dup [I]
1d40: 20 63 40 20 27 61 27 20 2d 20 70 65 72 6d 2d 63 c@ 'a' - perm-c
1d50: 68 61 72 73 20 2b 20 63 21 20 31 2b 20 5b 4c 4f hars + c! 1+ [LO
1d60: 4f 50 5d 20 64 72 6f 70 0a 0a 3a 20 2e 70 65 72 OP] drop..: .per
1d70: 6d 20 28 20 70 65 72 6d 69 73 73 69 6f 6e 20 2d m ( permission -
1d80: 2d 20 29 20 20 31 20 70 65 72 6d 24 20 63 6f 75 - ) 1 perm$ cou
1d90: 6e 74 20 62 6f 75 6e 64 73 20 44 4f 0a 09 32 64 nt bounds DO..2d
1da0: 75 70 20 61 6e 64 20 30 3c 3e 20 49 20 63 40 20 up and 0<> I c@
1db0: 27 2d 27 20 72 6f 74 20 73 65 6c 65 63 74 20 65 '-' rot select e
1dc0: 6d 69 74 20 32 2a 0a 20 20 20 20 4c 4f 4f 50 20 mit 2*. LOOP
1dd0: 20 32 64 72 6f 70 20 3b 0a 3a 20 70 65 72 6d 61 2drop ;.: perma
1de0: 6e 64 20 28 20 70 65 72 6d 61 6e 64 20 70 65 72 nd ( permand per
1df0: 6d 6f 72 20 6e 65 77 20 2d 2d 20 70 65 72 6d 61 mor new -- perma
1e00: 6e 64 27 20 70 65 72 6d 6f 72 20 29 0a 20 20 20 nd' permor ).
1e10: 20 69 6e 76 65 72 74 20 74 75 63 6b 20 61 6e 64 invert tuck and
1e20: 20 3e 72 20 61 6e 64 20 72 3e 20 3b 0a 3a 20 3e >r and r> ;.: >
1e30: 70 65 72 6d 2d 6d 6f 64 20 28 20 70 65 72 6d 61 perm-mod ( perma
1e40: 6e 64 20 70 65 72 6d 6f 72 20 2d 2d 20 70 65 72 nd permor -- per
1e50: 6d 61 6e 64 27 20 70 65 72 6d 6f 72 20 29 0a 20 mand' permor ).
1e60: 20 20 20 73 77 61 70 20 64 75 70 20 30 3d 20 49 swap dup 0= I
1e70: 46 20 20 64 72 6f 70 20 64 75 70 20 69 6e 76 65 F drop dup inve
1e80: 72 74 20 20 54 48 45 4e 20 73 77 61 70 20 3b 0a rt THEN swap ;.
1e90: 3a 20 3e 70 65 72 6d 20 28 20 61 64 64 72 20 75 : >perm ( addr u
1ea0: 20 2d 2d 20 70 65 72 6d 61 6e 64 20 70 65 72 6d -- permand perm
1eb0: 6f 72 20 29 0a 20 20 20 20 5c 47 20 70 61 72 73 or ). \G pars
1ec0: 65 20 70 65 72 6d 69 73 73 69 6f 6e 73 3a 20 2b e permissions: +
1ed0: 20 61 64 64 73 2c 20 2d 20 72 65 6d 6f 76 65 73 adds, - removes
1ee0: 20 70 65 72 6d 69 73 73 69 6f 6e 73 2c 0a 20 20 permissions,.
1ef0: 20 20 5c 47 20 6e 6f 20 6d 6f 64 69 66 69 65 72 \G no modifier
1f00: 20 73 65 74 73 20 70 65 72 6d 69 73 73 6f 6e 73 sets permissons
1f10: 2e 0a 20 20 20 20 30 20 30 20 5b 27 5d 20 6f 72 .. 0 0 ['] or
1f20: 20 7b 20 78 74 20 7d 0a 20 20 20 20 32 73 77 61 { xt }. 2swa
1f30: 70 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 20 p bounds ?DO..I
1f40: 63 40 20 63 61 73 65 0a 09 20 20 20 20 27 2b 27 c@ case.. '+'
1f50: 20 6f 66 20 20 3e 70 65 72 6d 2d 6d 6f 64 20 5b of >perm-mod [
1f60: 27 5d 20 6f 72 20 74 6f 20 78 74 20 65 6e 64 6f '] or to xt endo
1f70: 66 0a 09 20 20 20 20 27 2d 27 20 6f 66 20 20 3e f.. '-' of >
1f80: 70 65 72 6d 2d 6d 6f 64 20 5b 27 5d 20 70 65 72 perm-mod ['] per
1f90: 6d 61 6e 64 20 74 6f 20 78 74 20 20 65 6e 64 6f mand to xt endo
1fa0: 66 0a 09 20 20 20 20 27 3d 27 20 6f 66 20 20 32 f.. '=' of 2
1fb0: 64 72 6f 70 20 70 65 72 6d 25 64 65 66 61 75 6c drop perm%defaul
1fc0: 74 20 64 75 70 20 5b 27 5d 20 6f 72 20 74 6f 20 t dup ['] or to
1fd0: 78 74 20 20 65 6e 64 6f 66 0a 09 20 20 20 20 27 xt endof.. '
1fe0: 61 27 20 2d 20 64 75 70 20 27 7a 27 20 75 3c 3d a' - dup 'z' u<=
1ff0: 20 20 49 46 0a 09 09 70 65 72 6d 2d 63 68 61 72 IF...perm-char
2000: 73 20 2b 20 63 40 20 31 20 73 77 61 70 20 6c 73 s + c@ 1 swap ls
2010: 68 69 66 74 20 78 74 20 65 78 65 63 75 74 65 0a hift xt execute.
2020: 09 09 30 20 28 20 64 75 6d 6d 79 20 66 6f 72 20 ..0 ( dummy for
2030: 65 6e 64 63 61 73 65 20 29 0a 09 20 20 20 20 54 endcase ).. T
2040: 48 45 4e 20 20 65 6e 64 63 61 73 65 0a 20 20 20 HEN endcase.
2050: 20 4c 4f 4f 50 20 3b 0a 0a 5c 20 6b 65 79 20 64 LOOP ;..\ key d
2060: 69 73 70 6c 61 79 0a 0a 5b 49 46 55 4e 44 45 46 isplay..[IFUNDEF
2070: 5d 20 6d 61 67 65 6e 74 61 20 20 62 72 6f 77 6e ] magenta brown
2080: 20 63 6f 6e 73 74 61 6e 74 20 6d 61 67 65 6e 74 constant magent
2090: 61 20 5b 54 48 45 4e 5d 0a 5b 49 46 44 45 46 5d a [THEN].[IFDEF]
20a0: 20 67 6c 2d 74 79 70 65 20 3a 20 62 67 7c 20 3e gl-type : bg| >
20b0: 62 67 20 6f 72 20 3b 20 5b 45 4c 53 45 5d 20 3a bg or ; [ELSE] :
20c0: 20 62 67 7c 20 64 72 6f 70 20 3b 20 5b 54 48 45 bg| drop ; [THE
20d0: 4e 5d 0a 0a 43 72 65 61 74 65 20 38 35 63 6f 6c N]..Create 85col
20e0: 6f 72 73 2d 62 77 0a 30 20 2c 20 69 6e 76 65 72 ors-bw.0 , inver
20f0: 73 20 2c 0a 69 6e 76 65 72 73 20 2c 20 30 20 2c s ,.invers , 0 ,
2100: 0a 30 20 2c 20 69 6e 76 65 72 73 20 2c 0a 69 6e .0 , invers ,.in
2110: 76 65 72 73 20 2c 20 30 20 2c 0a 43 72 65 61 74 vers , 0 ,.Creat
2120: 65 20 38 35 63 6f 6c 6f 72 73 2d 63 6c 0a 79 65 e 85colors-cl.ye
2130: 6c 6c 6f 77 20 3e 66 67 20 62 6c 75 65 20 3e 62 llow >fg blue >b
2140: 67 20 6f 72 20 62 6f 6c 64 20 6f 72 20 2c 20 72 g or bold or , r
2150: 65 64 20 3e 66 67 20 77 68 69 74 65 20 62 67 7c ed >fg white bg|
2160: 20 2c 0a 62 6c 61 63 6b 20 3e 66 67 20 63 79 61 ,.black >fg cya
2170: 6e 20 62 67 7c 20 2c 20 67 72 65 65 6e 20 3e 66 n bg| , green >f
2180: 67 20 62 6c 61 63 6b 20 3e 62 67 20 6f 72 20 62 g black >bg or b
2190: 6f 6c 64 20 6f 72 20 2c 0a 77 68 69 74 65 20 3e old or ,.white >
21a0: 66 67 20 62 6c 61 63 6b 20 3e 62 67 20 6f 72 20 fg black >bg or
21b0: 62 6f 6c 64 20 6f 72 20 2c 20 6d 61 67 65 6e 74 bold or , magent
21c0: 61 20 3e 66 67 20 79 65 6c 6c 6f 77 20 62 67 7c a >fg yellow bg|
21d0: 20 2c 0a 62 6c 75 65 20 3e 66 67 20 79 65 6c 6c ,.blue >fg yell
21e0: 6f 77 20 62 67 7c 20 2c 20 63 79 61 6e 20 3e 66 ow bg| , cyan >f
21f0: 67 20 72 65 64 20 3e 62 67 20 6f 72 20 62 6f 6c g red >bg or bol
2200: 64 20 6f 72 20 2c 0a 0a 5b 49 46 44 45 46 5d 20 d or ,..[IFDEF]
2210: 67 6c 2d 74 79 70 65 20 38 35 63 6f 6c 6f 72 73 gl-type 85colors
2220: 2d 63 6c 20 5b 45 4c 53 45 5d 20 38 35 63 6f 6c -cl [ELSE] 85col
2230: 6f 72 73 2d 62 77 20 5b 54 48 45 4e 5d 20 56 61 ors-bw [THEN] Va
2240: 6c 75 65 20 38 35 63 6f 6c 6f 72 73 0a 0a 3a 20 lue 85colors..:
2250: 2e 73 74 72 69 70 65 38 35 20 28 20 61 64 64 72 .stripe85 ( addr
2260: 20 75 20 2d 2d 20 29 20 20 30 20 2d 72 6f 74 20 u -- ) 0 -rot
2270: 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 63 72 20 64 bounds ?DO..cr d
2280: 75 70 20 63 65 6c 6c 73 20 38 35 63 6f 6c 6f 72 up cells 85color
2290: 73 20 2b 20 40 20 61 74 74 72 21 20 31 2b 0a 09 s + @ attr! 1+..
22a0: 49 20 34 20 38 35 74 79 70 65 20 20 64 75 70 20 I 4 85type dup
22b0: 63 65 6c 6c 73 20 38 35 63 6f 6c 6f 72 73 20 2b cells 85colors +
22c0: 20 40 20 61 74 74 72 21 20 31 2b 0a 20 20 20 20 @ attr! 1+.
22d0: 49 20 34 20 2b 20 34 20 38 35 74 79 70 65 20 3c I 4 + 4 85type <
22e0: 64 65 66 61 75 6c 74 3e 20 38 20 2b 4c 4f 4f 50 default> 8 +LOOP
22f0: 20 20 64 72 6f 70 20 3b 0a 3a 20 2e 69 6d 70 6f drop ;.: .impo
2300: 72 74 38 35 20 28 20 61 64 64 72 20 75 20 2d 2d rt85 ( addr u --
2310: 20 29 0a 20 20 20 20 6b 65 2d 69 6d 70 6f 72 74 ). ke-import
2320: 73 20 40 20 3e 69 6d 2d 63 6f 6c 6f 72 20 38 35 s @ >im-color 85
2330: 74 79 70 65 20 3c 64 65 66 61 75 6c 74 3e 20 3b type <default> ;
2340: 0a 3a 20 2e 72 73 6b 20 28 20 6e 69 63 6b 20 75 .: .rsk ( nick u
2350: 20 2d 2d 20 29 0a 20 20 20 20 73 6b 72 65 76 20 -- ). skrev
2360: 24 32 30 20 2e 73 74 72 69 70 65 38 35 20 73 70 $20 .stripe85 sp
2370: 61 63 65 20 74 79 70 65 20 2e 22 20 20 28 6b 65 ace type ." (ke
2380: 65 70 20 6f 66 66 6c 69 6e 65 20 63 6f 70 79 21 ep offline copy!
2390: 29 22 20 63 72 20 3b 0a 3a 20 2e 6b 65 79 20 28 )" cr ;.: .key (
23a0: 20 61 64 64 72 20 75 20 2d 2d 20 29 20 64 72 6f addr u -- ) dro
23b0: 70 20 63 65 6c 6c 2b 20 3e 6f 0a 20 20 20 20 2e p cell+ >o. .
23c0: 22 20 6e 69 63 6b 3a 20 20 20 22 20 2e 6e 69 63 " nick: " .nic
23d0: 6b 20 63 72 0a 20 20 20 20 2e 22 20 70 75 62 6b k cr. ." pubk
23e0: 65 79 3a 20 22 20 6b 65 2d 70 6b 20 24 40 20 38 ey: " ke-pk $@ 8
23f0: 35 74 79 70 65 20 63 72 0a 20 20 20 20 6b 65 2d 5type cr. ke-
2400: 73 6b 20 40 20 49 46 0a 09 2e 22 20 73 65 63 6b sk @ IF..." seck
2410: 65 79 3a 20 22 20 6b 65 2d 73 6b 20 73 65 63 40 ey: " ke-sk sec@
2420: 20 2e 62 6c 61 63 6b 38 35 20 2e 22 20 20 28 6b .black85 ." (k
2430: 65 65 70 20 73 65 63 72 65 74 21 29 22 20 63 72 eep secret!)" cr
2440: 20 20 54 48 45 4e 0a 20 20 20 20 2e 22 20 76 61 THEN. ." va
2450: 6c 69 64 3a 20 20 22 20 6b 65 2d 73 65 6c 66 73 lid: " ke-selfs
2460: 69 67 20 24 40 20 2e 73 69 67 64 61 74 65 73 20 ig $@ .sigdates
2470: 63 72 0a 20 20 20 20 2e 22 20 70 65 72 6d 3a 20 cr. ." perm:
2480: 20 20 22 20 6b 65 2d 6d 61 73 6b 20 40 20 2e 70 " ke-mask @ .p
2490: 65 72 6d 20 63 72 0a 20 20 20 20 6f 3e 20 3b 0a erm cr. o> ;.
24a0: 3a 20 2e 6b 65 79 2d 72 65 73 74 20 28 20 6f 3a : .key-rest ( o:
24b0: 6b 65 79 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 key -- o:key ).
24c0: 20 20 20 6b 65 2d 70 6b 20 24 40 20 6b 65 79 7c ke-pk $@ key|
24d0: 20 2e 69 6d 70 6f 72 74 38 35 0a 20 20 20 20 6b .import85. k
24e0: 65 2d 73 65 6c 66 73 69 67 20 24 40 20 2e 73 69 e-selfsig $@ .si
24f0: 67 64 61 74 65 73 0a 20 20 20 20 73 70 61 63 65 gdates. space
2500: 20 6b 65 2d 6d 61 73 6b 20 40 20 2e 70 65 72 6d ke-mask @ .perm
2510: 0a 20 20 20 20 73 70 61 63 65 20 6b 65 2d 69 6d . space ke-im
2520: 70 6f 72 74 73 20 40 20 2e 69 6d 70 6f 72 74 73 ports @ .imports
2530: 0a 20 20 20 20 73 70 61 63 65 20 2e 6e 69 63 6b . space .nick
2540: 2b 70 65 74 20 3b 0a 3a 20 2e 6b 65 79 2d 6c 69 +pet ;.: .key-li
2550: 73 74 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a st ( o:key -- o:
2560: 6b 65 79 20 29 0a 20 20 20 20 6b 65 2d 6f 66 66 key ). ke-off
2570: 73 65 74 20 36 34 40 20 36 34 3e 64 20 6b 65 79 set 64@ 64>d key
2580: 70 61 63 6b 2d 61 6c 6c 23 20 66 6d 2f 6d 6f 64 pack-all# fm/mod
2590: 20 6e 69 70 20 32 20 2e 72 20 73 70 61 63 65 0a nip 2 .r space.
25a0: 20 20 20 20 2e 6b 65 79 2d 72 65 73 74 20 63 72 .key-rest cr
25b0: 20 3b 0a 3a 20 2e 73 65 63 72 65 74 2d 6e 69 63 ;.: .secret-nic
25c0: 6b 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 30 20 ks ( -- ). 0
25d0: 6b 65 79 2d 74 61 62 6c 65 20 5b 3a 20 63 65 6c key-table [: cel
25e0: 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b l+ $@ drop cell+
25f0: 20 3e 6f 20 6b 65 2d 73 6b 20 40 20 49 46 0a 09 >o ke-sk @ IF..
2600: 20 20 5b 3a 20 64 75 70 20 31 20 2e 72 20 3b 5d [: dup 1 .r ;]
2610: 20 23 33 36 20 62 61 73 65 2d 65 78 65 63 75 74 #36 base-execut
2620: 65 20 73 70 61 63 65 20 2e 6b 65 79 2d 72 65 73 e space .key-res
2630: 74 20 63 72 20 31 2b 0a 20 20 20 20 20 20 54 48 t cr 1+. TH
2640: 45 4e 20 6f 3e 20 3b 5d 20 23 6d 61 70 20 64 72 EN o> ;] #map dr
2650: 6f 70 20 3b 0a 3a 20 2e 6b 65 79 2d 69 6e 76 69 op ;.: .key-invi
2660: 74 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a te ( o:key -- o:
2670: 6b 65 79 20 29 0a 20 20 20 20 6b 65 2d 70 6b 20 key ). ke-pk
2680: 24 40 20 6b 65 79 73 69 7a 65 20 75 6d 69 6e 0a $@ keysize umin.
2690: 20 20 20 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 ke-imports @
26a0: 20 3e 69 6d 2d 63 6f 6c 6f 72 20 38 35 74 79 70 >im-color 85typ
26b0: 65 20 3c 64 65 66 61 75 6c 74 3e 0a 20 20 20 20 e <default>.
26c0: 73 70 61 63 65 20 2e 6e 69 63 6b 20 73 70 61 63 space .nick spac
26d0: 65 20 3b 0a 3a 20 2e 6b 65 79 2d 73 68 6f 72 74 e ;.: .key-short
26e0: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b 65 ( o:key -- o:ke
26f0: 79 20 29 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 y ). ke-nick
2700: 24 2e 20 6b 65 2d 70 72 6f 66 20 24 40 6c 65 6e $. ke-prof $@len
2710: 20 49 46 20 2e 22 20 20 70 72 6f 66 69 6c 65 3a IF ." profile:
2720: 20 22 20 6b 65 2d 70 72 6f 66 20 24 40 20 38 35 " ke-prof $@ 85
2730: 74 79 70 65 20 54 48 45 4e 20 3b 0a 3a 20 6c 69 type THEN ;.: li
2740: 73 74 2d 6b 65 79 73 20 28 20 2d 2d 20 29 0a 20 st-keys ( -- ).
2750: 20 20 20 6b 65 79 2d 74 61 62 6c 65 20 5b 3a 20 key-table [:
2760: 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 cell+ $@ drop ce
2770: 6c 6c 2b 20 2e 2e 6b 65 79 2d 6c 69 73 74 20 3b ll+ ..key-list ;
2780: 5d 20 23 6d 61 70 20 3b 0a 3a 20 6c 69 73 74 2d ] #map ;.: list-
2790: 6e 69 63 6b 73 20 28 20 2d 2d 20 29 0a 20 20 20 nicks ( -- ).
27a0: 20 6e 69 63 6b 2d 74 61 62 6c 65 20 5b 3a 20 64 nick-table [: d
27b0: 75 70 20 24 2e 20 2e 22 20 3a 22 20 63 72 20 63 up $. ." :" cr c
27c0: 65 6c 6c 2b 20 24 40 20 62 6f 75 6e 64 73 20 3f ell+ $@ bounds ?
27d0: 44 4f 0a 09 20 20 49 20 40 20 2e 2e 6b 65 79 2d DO.. I @ ..key-
27e0: 6c 69 73 74 20 20 63 65 6c 6c 20 2b 4c 4f 4f 50 list cell +LOOP
27f0: 20 3b 5d 20 23 6d 61 70 20 3b 0a 0a 3a 20 64 75 ;] #map ;..: du
2800: 6d 70 6b 65 79 20 28 20 61 64 64 72 20 75 20 2d mpkey ( addr u -
2810: 2d 20 29 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3e - ) drop cell+ >
2820: 6f 0a 20 20 20 20 2e 5c 22 20 78 5c 22 20 22 20 o. .\" x\" "
2830: 6b 65 2d 70 6b 20 24 40 20 38 35 74 79 70 65 20 ke-pk $@ 85type
2840: 2e 5c 22 20 5c 22 20 6b 65 79 3f 6e 65 77 22 20 .\" \" key?new"
2850: 63 72 0a 20 20 20 20 6b 65 2d 73 6b 20 40 20 49 cr. ke-sk @ I
2860: 46 20 20 2e 5c 22 20 78 5c 22 20 22 20 6b 65 2d F .\" x\" " ke-
2870: 73 6b 20 40 20 6b 65 79 73 69 7a 65 20 38 35 74 sk @ keysize 85t
2880: 79 70 65 20 2e 5c 22 20 5c 22 20 6b 65 2d 73 6b ype .\" \" ke-sk
2890: 20 73 65 63 21 20 2b 73 65 63 6b 65 79 22 20 63 sec! +seckey" c
28a0: 72 20 20 54 48 45 4e 0a 20 20 20 20 27 22 27 20 r THEN. '"'
28b0: 65 6d 69 74 20 2e 6e 69 63 6b 20 2e 5c 22 20 5c emit .nick .\" \
28c0: 22 20 6b 65 2d 6e 69 63 6b 20 24 21 20 22 0a 20 " ke-nick $! ".
28d0: 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 ke-selfsig $@
28e0: 20 64 72 6f 70 20 36 34 40 20 36 34 3e 64 20 5b drop 64@ 64>d [
28f0: 3a 20 27 24 27 20 65 6d 69 74 20 30 20 75 64 2e : '$' emit 0 ud.
2900: 72 20 3b 5d 20 24 31 30 20 62 61 73 65 2d 65 78 r ;] $10 base-ex
2910: 65 63 75 74 65 0a 20 20 20 20 2e 22 20 2e 20 64 ecute. ." . d
2920: 3e 36 34 20 6b 65 2d 66 69 72 73 74 21 20 22 20 >64 ke-first! "
2930: 6b 65 2d 74 79 70 65 20 40 20 2e 20 2e 22 20 6b ke-type @ . ." k
2940: 65 2d 74 79 70 65 20 21 22 20 20 63 72 20 6f 3e e-type !" cr o>
2950: 20 3b 0a 0a 3a 20 2e 6b 65 79 73 20 28 20 2d 2d ;..: .keys ( --
2960: 20 29 20 6b 65 79 2d 74 61 62 6c 65 20 5b 3a 20 ) key-table [:
2970: 2e 22 20 69 6e 64 65 78 3a 20 22 20 64 75 70 20 ." index: " dup
2980: 24 40 20 38 35 74 79 70 65 20 63 72 20 63 65 6c $@ 85type cr cel
2990: 6c 2b 20 24 40 20 2e 6b 65 79 20 3b 5d 20 23 6d l+ $@ .key ;] #m
29a0: 61 70 20 3b 0a 3a 20 64 75 6d 70 6b 65 79 73 20 ap ;.: dumpkeys
29b0: 28 20 2d 2d 20 29 20 6b 65 79 2d 74 61 62 6c 65 ( -- ) key-table
29c0: 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 75 6d [: cell+ $@ dum
29d0: 70 6b 65 79 20 3b 5d 20 23 6d 61 70 20 3b 0a 0a pkey ;] #map ;..
29e0: 3a 20 6b 65 79 3e 6e 69 63 6b 20 28 20 61 64 64 : key>nick ( add
29f0: 72 6b 65 79 20 75 31 20 2d 2d 20 6e 69 63 6b 20 rkey u1 -- nick
2a00: 75 32 20 29 0a 20 20 20 20 5c 47 20 63 6f 6e 76 u2 ). \G conv
2a10: 65 72 74 20 6b 65 79 20 74 6f 20 6e 69 63 6b 0a ert key to nick.
2a20: 20 20 20 20 6b 65 79 7c 20 6b 65 79 2d 74 61 62 key| key-tab
2a30: 6c 65 20 23 40 20 30 3d 20 49 46 20 20 64 72 6f le #@ 0= IF dro
2a40: 70 20 30 2e 20 20 45 58 49 54 20 20 54 48 45 4e p 0. EXIT THEN
2a50: 0a 20 20 20 20 63 65 6c 6c 2b 20 2e 6b 65 2d 6e . cell+ .ke-n
2a60: 69 63 6b 20 24 40 20 3b 0a 3a 20 6b 65 79 3e 6b ick $@ ;.: key>k
2a70: 65 79 20 28 20 61 64 64 72 6b 65 79 20 75 31 20 ey ( addrkey u1
2a80: 2d 2d 20 6b 65 79 20 75 32 20 29 0a 20 20 20 20 -- key u2 ).
2a90: 5c 47 20 65 78 70 61 6e 64 20 6b 65 79 20 74 6f \G expand key to
2aa0: 20 66 75 6c 6c 20 73 69 7a 65 20 61 6e 64 20 63 full size and c
2ab0: 68 65 63 6b 20 69 66 20 77 65 20 6b 6e 6f 77 20 heck if we know
2ac0: 69 74 0a 20 20 20 20 6b 65 79 7c 20 6b 65 79 2d it. key| key-
2ad0: 74 61 62 6c 65 20 23 40 20 30 3d 20 49 46 20 20 table #@ 0= IF
2ae0: 64 72 6f 70 20 30 2e 20 20 45 58 49 54 20 20 54 drop 0. EXIT T
2af0: 48 45 4e 0a 20 20 20 20 63 65 6c 6c 2b 20 2e 6b HEN. cell+ .k
2b00: 65 2d 70 6b 20 24 40 20 3b 0a 0a 3a 20 2e 6b 65 e-pk $@ ;..: .ke
2b10: 79 23 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 y# ( addr u -- )
2b20: 20 6b 65 79 7c 0a 20 20 20 20 2e 22 20 4b 65 79 key|. ." Key
2b30: 20 27 22 20 6b 65 79 2d 74 61 62 6c 65 20 23 40 '" key-table #@
2b40: 20 30 3d 20 49 46 20 64 72 6f 70 20 45 58 49 54 0= IF drop EXIT
2b50: 20 54 48 45 4e 0a 20 20 20 20 63 65 6c 6c 2b 20 THEN. cell+
2b60: 2e 2e 6e 69 63 6b 20 2e 22 20 27 20 6f 6b 22 20 ..nick ." ' ok"
2b70: 63 72 20 3b 0a 0a 44 65 66 65 72 20 64 68 74 2d cr ;..Defer dht-
2b80: 6e 69 63 6b 3f 0a 65 76 65 6e 74 3a 20 2d 3e 73 nick?.event: ->s
2b90: 65 61 72 63 68 2d 6b 65 79 20 20 6b 65 79 7c 20 earch-key key|
2ba0: 6f 76 65 72 20 3e 72 20 64 68 74 2d 6e 69 63 6b over >r dht-nick
2bb0: 3f 20 72 3e 20 66 72 65 65 20 74 68 72 6f 77 20 ? r> free throw
2bc0: 3b 0a 0a 3a 20 2e 75 6e 6b 65 79 2d 69 64 20 28 ;..: .unkey-id (
2bd0: 20 61 64 64 72 20 75 20 2d 2d 20 29 20 3c 65 72 addr u -- ) <er
2be0: 72 3e 20 38 20 75 6d 69 6e 20 38 35 74 79 70 65 r> 8 umin 85type
2bf0: 20 2e 22 20 28 75 6e 6b 6e 6f 77 6e 29 22 20 3c ." (unknown)" <
2c00: 64 65 66 61 75 6c 74 3e 20 3b 0a 0a 3a 20 2e 6b default> ;..: .k
2c10: 65 79 2d 69 64 20 28 20 61 64 64 72 20 75 20 2d ey-id ( addr u -
2c20: 2d 20 29 20 6b 65 79 7c 20 32 64 75 70 20 6b 65 - ) key| 2dup ke
2c30: 79 2d 74 61 62 6c 65 20 23 40 20 30 3d 0a 20 20 y-table #@ 0=.
2c40: 20 20 49 46 20 20 64 72 6f 70 20 75 70 40 20 72 IF drop up@ r
2c50: 65 63 65 69 76 65 72 2d 74 61 73 6b 20 3d 20 49 eceiver-task = I
2c60: 46 0a 09 20 20 20 20 3c 65 76 65 6e 74 20 32 64 F.. <event 2d
2c70: 75 70 20 73 61 76 65 2d 6d 65 6d 20 65 24 2c 20 up save-mem e$,
2c80: 2d 3e 73 65 61 72 63 68 2d 6b 65 79 20 5b 20 75 ->search-key [ u
2c90: 70 40 20 5d 6c 20 65 76 65 6e 74 3e 0a 09 20 20 p@ ]l event>..
2ca0: 20 20 2e 75 6e 6b 65 79 2d 69 64 20 45 58 49 54 .unkey-id EXIT
2cb0: 20 20 54 48 45 4e 0a 09 63 6f 6e 6e 65 63 74 69 THEN..connecti
2cc0: 6f 6e 20 3e 72 20 32 64 75 70 20 5b 27 5d 20 64 on >r 2dup ['] d
2cd0: 68 74 2d 6e 69 63 6b 3f 20 63 6d 64 2d 6e 65 73 ht-nick? cmd-nes
2ce0: 74 20 72 3e 20 74 6f 20 63 6f 6e 6e 65 63 74 69 t r> to connecti
2cf0: 6f 6e 0a 09 32 64 75 70 20 6b 65 79 2d 74 61 62 on..2dup key-tab
2d00: 6c 65 20 23 40 20 30 3d 20 49 46 20 20 64 72 6f le #@ 0= IF dro
2d10: 70 20 2e 75 6e 6b 65 79 2d 69 64 20 45 58 49 54 p .unkey-id EXIT
2d20: 20 20 54 48 45 4e 20 20 54 48 45 4e 0a 20 20 20 THEN THEN.
2d30: 20 63 65 6c 6c 2b 20 2e 2e 6e 69 63 6b 20 32 64 cell+ ..nick 2d
2d40: 72 6f 70 20 3b 0a 0a 3a 20 2e 63 6f 6e 2d 69 64 rop ;..: .con-id
2d50: 20 28 20 6f 3a 63 6f 6e 6e 65 63 74 69 6f 6e 20 ( o:connection
2d60: 2d 2d 20 29 20 70 75 62 6b 65 79 20 24 40 20 2e -- ) pubkey $@ .
2d70: 6b 65 79 2d 69 64 20 3b 0a 0a 3a 20 2e 73 69 6d key-id ;..: .sim
2d80: 70 6c 65 2d 69 64 20 28 20 61 64 64 72 20 75 20 ple-id ( addr u
2d90: 2d 2d 20 29 20 6b 65 79 3e 6e 69 63 6b 20 74 79 -- ) key>nick ty
2da0: 70 65 20 3b 0a 0a 3a 6e 6f 6e 61 6d 65 20 28 20 pe ;..:noname (
2db0: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 addr u -- ).
2dc0: 6f 20 49 46 20 20 70 75 62 6b 65 79 20 40 20 49 o IF pubkey @ I
2dd0: 46 0a 09 20 20 20 20 32 64 75 70 20 70 75 62 6b F.. 2dup pubk
2de0: 65 79 20 24 40 20 6b 65 79 7c 20 73 74 72 3d 20 ey $@ key| str=
2df0: 30 3d 20 49 46 0a 09 09 5b 3a 20 2e 22 20 77 61 0= IF...[: ." wa
2e00: 6e 74 3a 20 22 20 70 75 62 6b 65 79 20 24 40 20 nt: " pubkey $@
2e10: 6b 65 79 7c 20 38 35 74 79 70 65 20 63 72 0a 09 key| 85type cr..
2e20: 09 20 20 2e 22 20 67 6f 74 20 3a 20 22 20 32 64 . ." got : " 2d
2e30: 75 70 20 38 35 74 79 70 65 20 63 72 20 3b 5d 20 up 85type cr ;]
2e40: 24 65 72 72 0a 09 09 74 72 75 65 20 21 21 77 72 $err...true !!wr
2e50: 6f 6e 67 2d 6b 65 79 21 21 0a 09 20 20 20 20 54 ong-key!!.. T
2e60: 48 45 4e 0a 09 20 20 20 20 63 6f 6e 6e 65 63 74 HEN.. connect
2e70: 28 20 2e 6b 65 79 23 20 29 65 6c 73 65 28 20 32 ( .key# )else( 2
2e80: 64 72 6f 70 20 29 20 20 45 58 49 54 0a 09 54 48 drop ) EXIT..TH
2e90: 45 4e 20 20 54 48 45 4e 0a 20 20 20 20 32 64 75 EN THEN. 2du
2ea0: 70 20 6b 65 79 2d 65 78 69 73 74 3f 0a 20 20 20 p key-exist?.
2eb0: 20 3f 64 75 70 2d 30 3d 2d 49 46 20 20 70 65 72 ?dup-0=-IF per
2ec0: 6d 25 75 6e 6b 6e 6f 77 6e 20 20 45 4c 53 45 20 m%unknown ELSE
2ed0: 20 2e 6b 65 2d 6d 61 73 6b 20 40 20 20 54 48 45 .ke-mask @ THE
2ee0: 4e 20 20 74 6d 70 2d 70 65 72 6d 20 21 0a 20 20 N tmp-perm !.
2ef0: 20 20 63 6f 6e 6e 65 63 74 28 20 32 64 75 70 20 connect( 2dup
2f00: 2e 6b 65 79 23 20 29 0a 20 20 20 20 74 6d 70 2d .key# ). tmp-
2f10: 70 65 72 6d 20 40 20 70 65 72 6d 25 62 6c 6f 63 perm @ perm%bloc
2f20: 6b 65 64 20 61 6e 64 20 49 46 0a 09 5b 3a 20 2e ked and IF..[: .
2f30: 22 20 55 6e 6b 6e 6f 77 6e 20 6b 65 79 2c 20 63 " Unknown key, c
2f40: 6f 6e 6e 65 63 74 69 6f 6e 20 72 65 66 75 73 65 onnection refuse
2f50: 64 3a 20 22 20 38 35 74 79 70 65 20 63 72 20 3b d: " 85type cr ;
2f60: 5d 20 24 65 72 72 0a 09 74 72 75 65 20 21 21 63 ] $err..true !!c
2f70: 6f 6e 6e 65 63 74 2d 70 65 72 6d 21 21 0a 20 20 onnect-perm!!.
2f80: 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 ELSE 2drop T
2f90: 48 45 4e 20 3b 20 49 53 20 63 68 65 63 6b 2d 6b HEN ; IS check-k
2fa0: 65 79 0a 0a 3a 6e 6f 6e 61 6d 65 20 28 20 70 6b ey..:noname ( pk
2fb0: 63 20 2d 2d 20 73 6b 63 20 29 0a 20 20 20 20 6b c -- skc ). k
2fc0: 65 79 73 69 7a 65 20 6b 65 79 2d 74 61 62 6c 65 eysize key-table
2fd0: 20 23 40 20 30 3d 20 21 21 75 6e 6b 6e 6f 77 6e #@ 0= !!unknown
2fe0: 2d 6b 65 79 21 21 0a 20 20 20 20 63 65 6c 6c 2b -key!!. cell+
2ff0: 20 2e 6b 65 2d 73 6b 20 73 65 63 40 20 30 3d 20 .ke-sk sec@ 0=
3000: 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21 20 !!unknown-key!!
3010: 3b 20 69 73 20 73 65 61 72 63 68 2d 6b 65 79 0a ; is search-key.
3020: 0a 5c 20 61 70 70 6c 79 20 70 65 72 6d 69 73 73 .\ apply permiss
3030: 69 6f 6e 73 0a 0a 3a 20 61 70 70 6c 79 2d 70 65 ions..: apply-pe
3040: 72 6d 69 73 73 69 6f 6e 20 28 20 70 65 72 6d 61 rmission ( perma
3050: 6e 64 20 70 65 72 6d 6f 72 20 6f 3a 6b 65 79 20 nd permor o:key
3060: 2d 2d 20 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f -- permand permo
3070: 72 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 6f 76 r o:key ). ov
3080: 65 72 20 6b 65 2d 6d 61 73 6b 20 40 20 61 6e 64 er ke-mask @ and
3090: 20 6f 76 65 72 20 6f 72 20 6b 65 2d 6d 61 73 6b over or ke-mask
30a0: 20 21 20 2e 6b 65 79 2d 6c 69 73 74 20 3b 0a 0a ! .key-list ;..
30b0: 5c 20 67 65 74 20 70 61 73 73 70 68 72 61 73 65 \ get passphrase
30c0: 0a 0a 33 20 56 61 6c 75 65 20 70 61 73 73 70 68 ..3 Value passph
30d0: 72 61 73 65 2d 72 65 74 72 79 23 0a 24 31 30 30 rase-retry#.$100
30e0: 20 43 6f 6e 73 74 61 6e 74 20 6d 61 78 2d 70 61 Constant max-pa
30f0: 73 73 70 68 72 61 73 65 23 20 5c 20 32 35 36 20 ssphrase# \ 256
3100: 63 68 61 72 61 63 74 65 72 73 20 73 68 6f 75 6c characters shoul
3110: 64 20 62 65 20 65 6e 6f 75 67 68 2e 2e 2e 0a 6d d be enough....m
3120: 61 78 2d 70 61 73 73 70 68 72 61 73 65 23 20 62 ax-passphrase# b
3130: 75 66 66 65 72 3a 20 70 61 73 73 70 68 72 61 73 uffer: passphras
3140: 65 0a 0a 3a 20 70 61 73 73 70 68 72 61 73 65 2d e..: passphrase-
3150: 69 6e 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 in ( -- addr u )
3160: 0a 20 20 20 20 22 50 41 53 53 50 48 52 41 53 45 . "PASSPHRASE
3170: 22 20 67 65 74 65 6e 76 20 32 64 75 70 20 64 30 " getenv 2dup d0
3180: 3d 20 49 46 20 20 32 64 72 6f 70 0a 09 70 61 73 = IF 2drop..pas
3190: 73 70 68 72 61 73 65 20 64 75 70 20 6d 61 78 2d sphrase dup max-
31a0: 70 61 73 73 70 68 72 61 73 65 23 20 61 63 63 65 passphrase# acce
31b0: 70 74 2a 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a pt*. THEN ;..
31c0: 3a 20 3e 70 61 73 73 70 68 72 61 73 65 20 28 20 : >passphrase (
31d0: 61 64 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 addr u -- addr u
31e0: 20 29 0a 20 20 20 20 5c 47 20 63 72 65 61 74 65 ). \G create
31f0: 20 61 20 35 31 32 20 62 69 74 20 68 61 73 68 20 a 512 bit hash
3200: 6f 66 20 74 68 65 20 70 61 73 73 70 68 72 61 73 of the passphras
3210: 65 0a 20 20 20 20 6e 6f 2d 6b 65 79 20 3e 63 3a e. no-key >c:
3220: 6b 65 79 20 63 3a 68 61 73 68 0a 20 20 20 20 6b key c:hash. k
3230: 65 63 63 61 6b 2d 70 61 64 64 65 64 20 63 3a 6b eccak-padded c:k
3240: 65 79 3e 20 6b 65 63 63 61 6b 2d 70 61 64 64 65 ey> keccak-padde
3250: 64 20 6b 65 63 63 61 6b 23 6d 61 78 20 32 2f 20 d keccak#max 2/
3260: 3b 0a 0a 3a 20 67 65 74 2d 70 61 73 73 70 68 72 ;..: get-passphr
3270: 61 73 65 20 28 20 2d 2d 20 61 64 64 72 20 75 20 ase ( -- addr u
3280: 29 0a 20 20 20 20 70 61 73 73 70 68 72 61 73 65 ). passphrase
3290: 2d 69 6e 20 3e 70 61 73 73 70 68 72 61 73 65 20 -in >passphrase
32a0: 3b 0a 0a 56 61 72 69 61 62 6c 65 20 6b 65 79 73 ;..Variable keys
32b0: 0a 0a 3a 20 6c 61 73 74 6b 65 79 40 20 28 20 2d ..: lastkey@ ( -
32c0: 2d 20 61 64 64 72 20 75 20 29 20 6b 65 79 73 20 - addr u ) keys
32d0: 24 5b 5d 23 20 31 2d 20 6b 65 79 73 20 73 65 63 $[]# 1- keys sec
32e0: 5b 5d 40 20 3b 0a 3a 20 6b 65 79 3e 64 65 66 61 []@ ;.: key>defa
32f0: 75 6c 74 20 28 20 2d 2d 20 29 20 6c 61 73 74 6b ult ( -- ) lastk
3300: 65 79 40 20 64 72 6f 70 20 3e 73 74 6f 72 65 6b ey@ drop >storek
3310: 65 79 20 21 20 3b 0a 3a 20 2b 6b 65 79 20 28 20 ey ! ;.: +key (
3320: 61 64 64 72 20 75 20 2d 2d 20 29 20 6b 65 79 73 addr u -- ) keys
3330: 20 73 65 63 2b 5b 5d 21 20 3b 0a 3a 20 2b 70 61 sec+[]! ;.: +pa
3340: 73 73 70 68 72 61 73 65 20 28 20 2d 2d 20 29 20 ssphrase ( -- )
3350: 20 67 65 74 2d 70 61 73 73 70 68 72 61 73 65 20 get-passphrase
3360: 2b 6b 65 79 20 3b 0a 3a 20 2b 63 68 65 63 6b 70 +key ;.: +checkp
3370: 68 72 61 73 65 20 28 20 2d 2d 20 66 6c 61 67 20 hrase ( -- flag
3380: 29 20 67 65 74 2d 70 61 73 73 70 68 72 61 73 65 ) get-passphrase
3390: 20 6c 61 73 74 6b 65 79 40 20 73 74 72 3d 20 3b lastkey@ str= ;
33a0: 0a 3a 20 2b 6e 65 77 70 68 72 61 73 65 20 28 20 .: +newphrase (
33b0: 2d 2d 20 29 0a 20 20 20 20 42 45 47 49 4e 0a 09 -- ). BEGIN..
33c0: 2e 22 20 50 61 73 73 70 68 72 61 73 65 3a 20 22 ." Passphrase: "
33d0: 20 2b 70 61 73 73 70 68 72 61 73 65 20 63 72 0a +passphrase cr.
33e0: 09 2e 22 20 52 65 74 79 70 65 20 70 6c 73 3a 20 .." Retype pls:
33f0: 22 20 2b 63 68 65 63 6b 70 68 72 61 73 65 20 30 " +checkphrase 0
3400: 3d 20 57 48 49 4c 45 0a 09 20 20 20 20 2e 22 20 = WHILE.. ."
3410: 20 64 69 64 6e 27 74 20 6d 61 74 63 68 2c 20 74 didn't match, t
3420: 72 79 20 61 67 61 69 6e 20 70 6c 65 61 73 65 22 ry again please"
3430: 20 63 72 0a 20 20 20 20 52 45 50 45 41 54 20 63 cr. REPEAT c
3440: 72 20 3b 0a 0a 3a 20 22 3e 70 61 73 73 70 68 72 r ;..: ">passphr
3450: 61 73 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 ase ( addr u --
3460: 29 20 3e 70 61 73 73 70 68 72 61 73 65 20 2b 6b ) >passphrase +k
3470: 65 79 20 3b 0a 3a 20 3e 73 65 63 6b 65 79 20 28 ey ;.: >seckey (
3480: 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 -- addr u ).
3490: 20 6b 65 2d 73 6b 20 40 20 6b 65 2d 70 6b 20 24 ke-sk @ ke-pk $
34a0: 40 20 64 72 6f 70 20 6b 65 79 70 61 64 20 65 64 @ drop keypad ed
34b0: 2d 64 68 20 3b 0a 3a 20 2b 73 65 63 6b 65 79 20 -dh ;.: +seckey
34c0: 28 20 2d 2d 20 29 20 3e 73 65 63 6b 65 79 20 2b ( -- ) >seckey +
34d0: 6b 65 79 20 3b 0a 0a 5c 20 22 22 20 22 3e 70 61 key ;..\ "" ">pa
34e0: 73 73 70 68 72 61 73 65 20 5c 20 66 6f 6c 6c 6f ssphrase \ follo
34f0: 77 69 6e 67 20 74 68 65 20 65 6e 63 72 79 70 74 wing the encrypt
3500: 2d 65 76 65 72 79 74 68 69 6e 67 20 70 61 72 61 -everything para
3510: 64 69 67 6d 2c 0a 5c 20 6e 6f 20 70 61 73 73 77 digm,.\ no passw
3520: 6f 72 64 20 69 73 20 74 68 65 20 65 6d 70 74 79 ord is the empty
3530: 20 73 74 72 69 6e 67 21 20 20 49 74 27 73 20 73 string! It's s
3540: 74 69 6c 6c 20 65 6e 63 72 79 70 74 65 64 20 3b till encrypted ;
3550: 2d 29 21 0a 0a 5c 20 61 20 73 65 63 72 65 74 20 -)!..\ a secret
3560: 6b 65 79 20 6a 75 73 74 20 6e 65 65 64 73 20 61 key just needs a
3570: 20 6e 69 63 6b 20 61 6e 64 20 61 20 74 79 70 65 nick and a type
3580: 2e 0a 5c 20 53 65 63 72 65 74 20 6b 65 79 73 20 ..\ Secret keys
3590: 63 61 6e 20 62 65 20 70 65 72 73 6f 6e 73 20 61 can be persons a
35a0: 6e 64 20 67 72 6f 75 70 73 2e 0a 0a 5c 20 61 20 nd groups...\ a
35b0: 70 75 62 6c 69 63 20 6b 65 79 20 6e 65 65 64 73 public key needs
35c0: 20 6d 6f 72 65 3a 20 6e 69 63 6b 2c 20 74 79 70 more: nick, typ
35d0: 65 2c 20 70 72 6f 66 69 6c 65 2e 0a 5c 20 54 68 e, profile..\ Th
35e0: 65 20 70 72 6f 66 69 6c 65 20 69 73 20 61 20 73 e profile is a s
35f0: 74 72 75 63 74 75 72 65 64 20 64 6f 63 75 6d 65 tructured docume
3600: 6e 74 2c 20 69 2e 65 2e 20 70 6f 69 6e 74 65 64 nt, i.e. pointed
3610: 20 74 6f 20 62 79 20 61 20 68 61 73 68 2e 0a 0a to by a hash...
3620: 5c 20 61 20 73 69 67 6e 61 74 75 72 65 20 63 6f \ a signature co
3630: 6e 74 61 69 6e 73 20 61 20 70 75 62 6b 65 79 2c ntains a pubkey,
3640: 20 61 20 63 68 65 63 6b 62 6f 78 20 62 69 74 6d a checkbox bitm
3650: 61 73 6b 2c 0a 5c 20 61 20 64 61 74 65 2c 20 61 ask,.\ a date, a
3660: 6e 20 65 78 70 69 72 61 74 69 6f 6e 20 64 61 74 n expiration dat
3670: 65 2c 20 74 68 65 20 73 69 67 6e 65 72 27 73 20 e, the signer's
3680: 70 75 62 6b 65 79 20 61 6e 64 20 74 68 65 20 73 pubkey and the s
3690: 69 67 6e 61 74 75 72 65 20 69 74 73 65 6c 66 0a ignature itself.
36a0: 5c 20 28 72 2b 73 29 2e 20 20 54 68 65 72 65 20 \ (r+s). There
36b0: 69 73 20 61 6e 20 6f 70 74 69 6f 6e 61 6c 20 73 is an optional s
36c0: 69 67 6e 69 6e 67 20 70 72 6f 74 6f 63 6f 6c 20 igning protocol
36d0: 64 6f 63 75 6d 65 6e 74 20 28 68 61 73 68 29 2e document (hash).
36e0: 0a 0a 5c 20 77 65 20 73 74 6f 72 65 20 65 61 63 ..\ we store eac
36f0: 68 20 69 74 65 6d 20 69 6e 20 61 20 32 35 36 20 h item in a 256
3700: 62 79 74 65 73 20 65 6e 63 72 79 70 74 65 64 20 bytes encrypted
3710: 73 74 72 69 6e 67 2c 20 69 2e 65 2e 20 77 69 74 string, i.e. wit
3720: 68 20 61 20 31 36 0a 5c 20 62 79 74 65 20 73 61 h a 16.\ byte sa
3730: 6c 74 20 61 6e 64 20 61 20 31 36 20 62 79 74 65 lt and a 16 byte
3740: 20 63 68 65 63 6b 73 75 6d 2e 0a 0a 3a 20 6b 65 checksum...: ke
3750: 2d 6c 61 73 74 21 20 28 20 36 34 64 61 74 65 20 -last! ( 64date
3760: 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 73 65 6c 66 -- ). ke-self
3770: 73 69 67 20 24 40 6c 65 6e 20 24 31 30 20 75 6d sig $@len $10 um
3780: 61 78 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 21 ax ke-selfsig $!
3790: 6c 65 6e 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73 len. ke-selfs
37a0: 69 67 20 24 40 20 64 72 6f 70 20 36 34 27 2b 20 ig $@ drop 64'+
37b0: 36 34 21 20 3b 0a 3a 20 6b 65 2d 66 69 72 73 74 64! ;.: ke-first
37c0: 21 20 28 20 36 34 64 61 74 65 20 2d 2d 20 29 20 ! ( 64date -- )
37d0: 36 34 23 2d 31 20 6b 65 2d 6c 61 73 74 21 0a 20 64#-1 ke-last!.
37e0: 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 ke-selfsig $@
37f0: 20 64 72 6f 70 20 36 34 21 20 3b 0a 0a 73 63 6f drop 64! ;..sco
3800: 70 65 7b 20 6e 65 74 32 6f 2d 62 61 73 65 0a 0a pe{ net2o-base..
3810: 63 6d 64 2d 74 61 62 6c 65 20 24 40 20 69 6e 68 cmd-table $@ inh
3820: 65 72 69 74 2d 74 61 62 6c 65 20 6b 65 79 2d 65 erit-table key-e
3830: 6e 74 72 79 2d 74 61 62 6c 65 0a 5c 67 20 0a 5c ntry-table.\g .\
3840: 67 20 23 23 23 20 6b 65 79 20 73 74 6f 72 61 67 g ### key storag
3850: 65 20 63 6f 6d 6d 61 6e 64 73 20 23 23 23 0a 5c e commands ###.\
3860: 67 20 0a 24 31 31 20 6e 65 74 32 6f 3a 20 70 72 g .$11 net2o: pr
3870: 69 76 6b 65 79 20 28 20 24 3a 73 74 72 69 6e 67 ivkey ( $:string
3880: 20 2d 2d 20 29 0a 20 20 20 20 5c 67 20 70 72 69 -- ). \g pri
3890: 76 61 74 65 20 6b 65 79 0a 20 20 20 20 5c 20 64 vate key. \ d
38a0: 6f 65 73 20 6e 6f 74 20 6e 65 65 64 20 74 6f 20 oes not need to
38b0: 62 65 20 73 69 67 6e 65 64 2c 20 74 68 65 20 73 be signed, the s
38c0: 65 63 72 65 74 20 6b 65 79 20 76 65 72 69 66 69 ecret key verifi
38d0: 65 73 20 69 74 73 65 6c 66 0a 20 20 20 20 21 21 es itself. !!
38e0: 75 6e 73 69 67 6e 65 64 3f 20 24 34 30 20 21 21 unsigned? $40 !!
38f0: 3e 3d 6f 72 64 65 72 3f 0a 20 20 20 20 6b 65 79 >=order?. key
3900: 70 61 63 6b 20 63 40 20 24 46 20 61 6e 64 20 6b pack c@ $F and k
3910: 65 2d 70 77 6c 65 76 65 6c 20 21 0a 20 20 20 20 e-pwlevel !.
3920: 24 3e 20 6f 76 65 72 20 6b 65 79 70 61 64 20 73 $> over keypad s
3930: 6b 3e 70 6b 20 5c 20 67 65 6e 65 72 61 74 65 20 k>pk \ generate
3940: 70 75 62 6b 65 79 0a 20 20 20 20 6b 65 79 70 61 pubkey. keypa
3950: 64 20 6b 65 2d 70 6b 20 24 40 20 64 72 6f 70 20 d ke-pk $@ drop
3960: 6b 65 79 73 69 7a 65 20 74 75 63 6b 20 73 74 72 keysize tuck str
3970: 3d 20 30 3d 20 21 21 77 72 6f 6e 67 2d 6b 65 79 = 0= !!wrong-key
3980: 21 21 0a 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 !!. ke-sk sec
3990: 21 20 2b 73 65 63 6b 65 79 20 3b 0a 2b 6e 65 74 ! +seckey ;.+net
39a0: 32 6f 3a 20 6b 65 79 74 79 70 65 20 28 20 6e 20 2o: keytype ( n
39b0: 2d 2d 20 29 20 20 20 20 20 20 20 20 20 20 20 21 -- ) !
39c0: 21 73 69 67 6e 65 64 3f 20 20 20 31 20 21 21 3e !signed? 1 !!>
39d0: 6f 72 64 65 72 3f 20 36 34 3e 6e 20 6b 65 2d 74 order? 64>n ke-t
39e0: 79 70 65 20 21 20 3b 0a 20 20 20 20 5c 67 20 6b ype ! ;. \g k
39f0: 65 79 20 74 79 70 65 20 28 30 3a 20 61 6e 6f 6e ey type (0: anon
3a00: 2c 20 31 3a 20 75 73 65 72 2c 20 32 3a 20 67 72 , 1: user, 2: gr
3a10: 6f 75 70 29 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 oup).+net2o: key
3a20: 6e 69 63 6b 20 28 20 24 3a 73 74 72 69 6e 67 20 nick ( $:string
3a30: 2d 2d 20 29 20 20 20 20 21 21 73 69 67 6e 65 64 -- ) !!signed
3a40: 3f 20 20 20 32 20 21 21 3e 6f 72 64 65 72 3f 20 ? 2 !!>order?
3a50: 24 3e 20 6b 65 2d 6e 69 63 6b 20 24 21 0a 20 20 $> ke-nick $!.
3a60: 20 20 6e 69 63 6b 21 20 3b 0a 20 20 20 20 5c 67 nick! ;. \g
3a70: 20 6b 65 79 20 6e 69 63 6b 0a 2b 6e 65 74 32 6f key nick.+net2o
3a80: 3a 20 6b 65 79 70 72 6f 66 69 6c 65 20 28 20 24 : keyprofile ( $
3a90: 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 21 21 73 :string -- ) !!s
3aa0: 69 67 6e 65 64 3f 20 20 20 34 20 21 21 3e 6f 72 igned? 4 !!>or
3ab0: 64 65 72 3f 20 24 3e 20 6b 65 2d 70 72 6f 66 20 der? $> ke-prof
3ac0: 24 21 20 3b 0a 20 20 20 20 5c 67 20 6b 65 79 20 $! ;. \g key
3ad0: 70 72 6f 66 69 6c 65 20 28 68 61 73 68 20 6f 66 profile (hash of
3ae0: 20 61 20 72 65 73 6f 75 72 63 65 29 0a 2b 6e 65 a resource).+ne
3af0: 74 32 6f 3a 20 6b 65 79 6d 61 73 6b 20 28 20 78 t2o: keymask ( x
3b00: 20 2d 2d 20 29 20 20 20 20 20 20 20 20 20 21 21 -- ) !!
3b10: 75 6e 73 69 67 6e 65 64 3f 20 24 32 30 20 21 21 unsigned? $20 !!
3b20: 3e 3d 6f 72 64 65 72 3f 20 36 34 3e 6e 20 6b 65 >=order? 64>n ke
3b30: 2d 6d 61 73 6b 20 21 20 3b 0a 20 20 20 20 5c 67 -mask ! ;. \g
3b40: 20 6b 65 79 20 61 63 63 65 73 73 20 72 69 67 68 key access righ
3b50: 74 20 6d 61 73 6b 0a 2b 6e 65 74 32 6f 3a 20 6b t mask.+net2o: k
3b60: 65 79 67 72 6f 75 70 20 28 20 78 20 2d 2d 20 29 eygroup ( x -- )
3b70: 20 20 20 20 20 20 20 20 21 21 73 69 67 6e 65 64 !!signed
3b80: 3f 20 20 20 24 34 30 20 21 21 3e 6f 72 64 65 72 ? $40 !!>order
3b90: 3f 20 36 34 64 72 6f 70 0a 20 20 20 20 28 20 36 ? 64drop. ( 6
3ba0: 34 3e 6e 20 64 75 70 20 6b 65 79 2d 67 72 6f 75 4>n dup key-grou
3bb0: 70 73 23 20 75 3e 20 21 21 77 72 6f 6e 67 67 72 ps# u> !!wronggr
3bc0: 6f 75 70 21 21 20 63 65 6c 6c 73 20 6b 65 79 2d oup!! cells key-
3bd0: 67 72 6f 75 70 73 20 2b 20 40 20 6b 65 2d 6d 61 groups + @ ke-ma
3be0: 73 6b 20 21 20 29 20 3b 0a 20 20 20 20 5c 67 20 sk ! ) ;. \g
3bf0: 61 63 63 65 73 73 20 67 72 6f 75 70 2c 20 73 74 access group, st
3c00: 75 62 0a 2b 6e 65 74 32 6f 3a 20 2b 6b 65 79 73 ub.+net2o: +keys
3c10: 69 67 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d ig ( $:string --
3c20: 20 29 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 ) !!unsigned?
3c30: 24 31 30 20 21 21 3e 3d 6f 72 64 65 72 3f 20 24 $10 !!>=order? $
3c40: 3e 20 6b 65 2d 73 69 67 73 20 24 2b 5b 5d 21 20 > ke-sigs $+[]!
3c50: 3b 0a 20 20 20 20 5c 67 20 61 64 64 20 61 20 6b ;. \g add a k
3c60: 65 79 20 73 69 67 6e 61 74 75 72 65 0a 2b 6e 65 ey signature.+ne
3c70: 74 32 6f 3a 20 6b 65 79 69 6d 70 6f 72 74 20 28 t2o: keyimport (
3c80: 20 6e 20 2d 2d 20 29 20 20 20 20 20 20 20 21 21 n -- ) !!
3c90: 75 6e 73 69 67 6e 65 64 3f 20 24 31 30 20 21 21 unsigned? $10 !!
3ca0: 3e 3d 6f 72 64 65 72 3f 0a 20 20 20 20 70 77 2d >=order?. pw-
3cb0: 6c 65 76 65 6c 23 20 30 3c 20 49 46 20 20 36 34 level# 0< IF 64
3cc0: 3e 6e 0a 09 64 75 70 20 5b 20 31 20 69 6d 70 6f >n..dup [ 1 impo
3cd0: 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 5d 4c rt#new lshift ]L
3ce0: 20 61 6e 64 20 30 3d 20 49 46 0a 09 20 20 20 20 and 0= IF..
3cf0: 69 6d 70 6f 72 74 23 75 6e 74 72 75 73 74 65 64 import#untrusted
3d00: 20 75 6d 69 6e 20 31 20 73 77 61 70 20 6c 73 68 umin 1 swap lsh
3d10: 69 66 74 0a 09 45 4c 53 45 20 20 5b 20 32 20 69 ift..ELSE [ 2 i
3d20: 6d 70 6f 72 74 23 75 6e 74 72 75 73 74 65 64 20 mport#untrusted
3d30: 6c 73 68 69 66 74 20 31 2d 20 31 20 69 6d 70 6f lshift 1- 1 impo
3d40: 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 rt#new lshift or
3d50: 20 5d 4c 20 61 6e 64 0a 09 54 48 45 4e 0a 09 6b ]L and..THEN..k
3d60: 65 2d 69 6d 70 6f 72 74 73 20 21 0a 20 20 20 20 e-imports !.
3d70: 45 4c 53 45 20 20 36 34 64 72 6f 70 20 20 54 48 ELSE 64drop TH
3d80: 45 4e 20 3b 0a 2b 6e 65 74 32 6f 3a 20 72 73 6b EN ;.+net2o: rsk
3d90: 6b 65 79 20 28 20 24 3a 73 74 72 69 6e 67 20 2d key ( $:string -
3da0: 2d 2d 20 29 0a 20 20 20 20 5c 67 20 72 65 76 6f -- ). \g revo
3db0: 6b 65 20 6b 65 79 2c 20 74 65 6d 70 6f 72 61 72 ke key, temporar
3dc0: 69 6c 79 20 73 74 6f 72 65 64 0a 20 20 20 20 5c ily stored. \
3dd0: 20 64 6f 65 73 20 6e 6f 74 20 6e 65 65 64 20 74 does not need t
3de0: 6f 20 62 65 20 73 69 67 6e 65 64 2c 20 74 68 65 o be signed, the
3df0: 20 72 65 76 6f 6b 65 20 6b 65 79 20 76 65 72 69 revoke key veri
3e00: 66 69 65 73 20 69 74 73 65 6c 66 0a 20 20 20 20 fies itself.
3e10: 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 38 30 20 !!unsigned? $80
3e20: 21 21 3e 3d 6f 72 64 65 72 3f 0a 20 20 20 20 24 !!>=order?. $
3e30: 3e 20 32 64 75 70 20 73 6b 72 65 76 20 73 77 61 > 2dup skrev swa
3e40: 70 20 6b 65 79 7c 20 6d 6f 76 65 20 6b 65 2d 70 p key| move ke-p
3e50: 6b 20 24 40 20 64 72 6f 70 20 63 68 65 63 6b 2d k $@ drop check-
3e60: 72 65 76 3f 20 30 3d 20 21 21 6e 6f 74 2d 6d 79 rev? 0= !!not-my
3e70: 2d 72 65 76 73 6b 21 21 0a 20 20 20 20 70 6b 72 -revsk!!. pkr
3e80: 65 76 20 6b 65 79 73 69 7a 65 32 20 65 72 61 73 ev keysize2 eras
3e90: 65 20 20 6b 65 2d 72 73 6b 20 73 65 63 21 20 3b e ke-rsk sec! ;
3ea0: 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 70 65 74 20 .+net2o: keypet
3eb0: 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 ( $:string -- )
3ec0: 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 20 24 3e !!unsigned? $>
3ed0: 0a 20 20 20 20 70 77 2d 6c 65 76 65 6c 23 20 30 . pw-level# 0
3ee0: 3c 20 49 46 20 20 6b 65 2d 70 65 74 73 20 24 2b < IF ke-pets $+
3ef0: 5b 5d 21 20 70 65 74 21 20 20 45 4c 53 45 20 20 []! pet! ELSE
3f00: 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 7d 73 2drop THEN ;.}s
3f10: 63 6f 70 65 0a 0a 67 65 6e 2d 74 61 62 6c 65 20 cope..gen-table
3f20: 24 66 72 65 65 7a 65 0a 27 20 63 6f 6e 74 65 78 $freeze.' contex
3f30: 74 2d 74 61 62 6c 65 20 69 73 20 67 65 6e 2d 74 t-table is gen-t
3f40: 61 62 6c 65 0a 0a 3a 20 6b 65 79 3a 6e 65 73 74 able..: key:nest
3f50: 2d 73 69 67 20 28 20 61 64 64 72 20 75 20 2d 2d -sig ( addr u --
3f60: 20 61 64 64 72 20 75 27 20 66 6c 61 67 20 29 0a addr u' flag ).
3f70: 20 20 20 20 70 6b 32 2d 73 69 67 3f 20 64 75 70 pk2-sig? dup
3f80: 20 3f 45 58 49 54 20 64 72 6f 70 0a 20 20 20 20 ?EXIT drop.
3f90: 32 64 75 70 20 2b 20 73 69 67 73 69 7a 65 23 20 2dup + sigsize#
3fa0: 2d 20 73 69 67 73 69 7a 65 23 20 3e 24 0a 20 20 - sigsize# >$.
3fb0: 20 20 73 69 67 70 6b 32 73 69 7a 65 23 20 2d 20 sigpk2size# -
3fc0: 32 64 75 70 20 2b 20 6b 65 79 73 69 7a 65 32 20 2dup + keysize2
3fd0: 6b 65 79 3f 6e 65 77 20 6e 3a 3e 6f 20 24 3e 20 key?new n:>o $>
3fe0: 6b 65 2d 73 65 6c 66 73 69 67 20 24 21 0a 20 20 ke-selfsig $!.
3ff0: 20 20 73 69 6d 2d 6e 69 63 6b 21 20 6f 66 66 20 sim-nick! off
4000: 63 2d 73 74 61 74 65 20 6f 66 66 20 73 69 67 2d c-state off sig-
4010: 6f 6b 20 3b 0a 27 20 6b 65 79 3a 6e 65 73 74 2d ok ;.' key:nest-
4020: 73 69 67 20 6b 65 79 2d 65 6e 74 72 79 20 74 6f sig key-entry to
4030: 20 6e 65 73 74 2d 73 69 67 0a 0a 6b 65 79 2d 65 nest-sig..key-e
4040: 6e 74 72 79 20 27 20 6e 65 77 20 73 74 61 74 69 ntry ' new stati
4050: 63 2d 61 20 77 69 74 68 2d 61 6c 6c 6f 63 61 74 c-a with-allocat
4060: 65 72 20 74 6f 20 73 61 6d 70 6c 65 2d 6b 65 79 er to sample-key
4070: 0a 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 6b .sample-key >o k
4080: 65 79 2d 65 6e 74 72 79 2d 74 61 62 6c 65 20 40 ey-entry-table @
4090: 20 74 6f 6b 65 6e 2d 74 61 62 6c 65 20 21 20 6f token-table ! o
40a0: 3e 0a 0a 3a 20 6b 65 79 3a 63 6f 64 65 20 28 20 >..: key:code (
40b0: 2d 2d 20 29 0a 20 20 20 20 63 6f 64 65 2d 6b 65 -- ). code-ke
40c0: 79 20 20 63 6d 64 6c 6f 63 6b 20 6c 6f 63 6b 0a y cmdlock lock.
40d0: 20 20 20 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 keypack keyp
40e0: 61 63 6b 2d 61 6c 6c 23 20 65 72 61 73 65 0a 20 ack-all# erase.
40f0: 20 20 20 63 6d 64 72 65 73 65 74 20 69 6e 69 74 cmdreset init
4100: 2d 72 65 70 6c 79 20 61 6c 73 6f 20 6e 65 74 32 -reply also net2
4110: 6f 2d 62 61 73 65 20 3b 0a 63 6f 6d 70 3a 20 3a o-base ;.comp: :
4120: 2c 20 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73 , also net2o-bas
4130: 65 20 3b 0a 0a 73 63 6f 70 65 7b 20 6e 65 74 32 e ;..scope{ net2
4140: 6f 2d 62 61 73 65 0a 0a 3a 20 65 6e 64 3a 6b 65 o-base..: end:ke
4150: 79 20 28 20 2d 2d 20 29 0a 20 20 20 20 65 6e 64 y ( -- ). end
4160: 2d 77 69 74 68 20 70 72 65 76 69 6f 75 73 20 63 -with previous c
4170: 6d 64 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20 3b 0a mdlock unlock ;.
4180: 63 6f 6d 70 3a 20 3a 2c 20 70 72 65 76 69 6f 75 comp: :, previou
4190: 73 20 3b 0a 0a 7d 73 63 6f 70 65 0a 0a 3a 20 6b s ;..}scope..: k
41a0: 65 79 2d 63 72 79 70 74 20 28 20 2d 2d 20 29 0a ey-crypt ( -- ).
41b0: 20 20 20 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 keypack keyp
41c0: 61 63 6b 2d 61 6c 6c 23 0a 20 20 20 20 3e 73 74 ack-all#. >st
41d0: 6f 72 65 6b 65 79 20 73 65 63 40 20 64 75 70 20 orekey sec@ dup
41e0: 24 32 30 20 75 3c 3d 20 5c 20 69 73 20 61 20 73 $20 u<= \ is a s
41f0: 65 63 72 65 74 2c 20 6e 6f 20 6e 65 65 64 20 74 ecret, no need t
4200: 6f 20 62 65 20 73 6c 6f 77 0a 20 20 20 20 49 46 o be slow. IF
4210: 20 20 65 6e 63 72 79 70 74 24 20 20 45 4c 53 45 encrypt$ ELSE
4220: 20 20 70 77 2d 6c 65 76 65 6c 23 20 65 6e 63 72 pw-level# encr
4230: 79 70 74 2d 70 77 24 20 20 54 48 45 4e 20 3b 0a ypt-pw$ THEN ;.
4240: 0a 30 20 56 61 6c 75 65 20 6b 65 79 2d 73 66 64 .0 Value key-sfd
4250: 20 5c 20 73 65 63 72 65 74 20 6b 65 79 73 0a 30 \ secret keys.0
4260: 20 56 61 6c 75 65 20 6b 65 79 2d 70 66 64 20 5c Value key-pfd \
4270: 20 70 75 62 6b 65 79 73 0a 0a 5c 20 6c 65 67 61 pubkeys..\ lega
4280: 63 79 20 66 6f 72 20 65 61 72 6c 79 20 76 65 72 cy for early ver
4290: 73 69 6f 6e 73 20 6f 66 20 6e 65 74 32 6f 20 70 sions of net2o p
42a0: 72 69 6f 72 20 32 30 31 36 30 36 30 36 0a 0a 3a rior 20160606..:
42b0: 20 6e 65 74 32 6f 3e 6b 65 79 73 20 7b 20 61 64 net2o>keys { ad
42c0: 64 72 20 75 20 2d 2d 20 7d 0a 20 20 20 20 61 64 dr u -- }. ad
42d0: 64 72 20 75 20 2e 6e 65 74 32 6f 2f 20 20 61 64 dr u .net2o/ ad
42e0: 64 72 20 75 20 2e 6b 65 79 73 2f 20 72 65 6e 61 dr u .keys/ rena
42f0: 6d 65 2d 66 69 6c 65 20 64 72 6f 70 20 3b 0a 3a me-file drop ;.:
4300: 20 3f 6c 65 67 61 63 79 2d 6b 65 79 73 20 28 20 ?legacy-keys (
4310: 66 6c 61 67 20 2d 2d 20 29 0a 20 20 20 20 5c 20 flag -- ). \
4320: 21 21 46 49 58 4d 45 21 21 20 6e 65 65 64 73 20 !!FIXME!! needs
4330: 74 6f 20 62 65 20 72 65 6d 6f 76 65 64 20 77 68 to be removed wh
4340: 65 6e 20 61 6c 6c 20 63 75 72 72 65 6e 74 20 75 en all current u
4350: 73 65 72 73 0a 20 20 20 20 5c 20 68 61 76 65 20 sers. \ have
4360: 6d 69 67 72 61 74 65 64 0a 20 20 20 20 49 46 0a migrated. IF.
4370: 09 22 70 75 62 6b 65 79 73 2e 6b 32 6f 22 20 6e ."pubkeys.k2o" n
4380: 65 74 32 6f 3e 6b 65 79 73 0a 09 22 73 65 63 6b et2o>keys.."seck
4390: 65 79 73 2e 6b 32 6f 22 20 6e 65 74 32 6f 3e 6b eys.k2o" net2o>k
43a0: 65 79 73 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a eys. THEN ;..
43b0: 3a 20 67 65 6e 2d 6b 65 79 73 2d 64 69 72 20 28 : gen-keys-dir (
43c0: 20 2d 2d 20 29 0a 20 20 20 20 69 6e 69 74 2d 64 -- ). init-d
43d0: 69 72 73 20 3f 2e 6e 65 74 32 6f 2f 6b 65 79 73 irs ?.net2o/keys
43e0: 20 3f 6c 65 67 61 63 79 2d 6b 65 79 73 20 3b 0a ?legacy-keys ;.
43f0: 0a 3a 20 3f 66 64 2d 6b 65 79 73 20 28 20 66 64 .: ?fd-keys ( fd
4400: 20 61 64 64 72 20 75 20 2d 2d 20 66 64 27 20 29 addr u -- fd' )
4410: 20 7b 20 61 64 64 72 20 75 20 7d 20 64 75 70 20 { addr u } dup
4420: 3f 45 58 49 54 20 64 72 6f 70 0a 20 20 20 20 67 ?EXIT drop. g
4430: 65 6e 2d 6b 65 79 73 2d 64 69 72 0a 20 20 20 20 en-keys-dir.
4440: 61 64 64 72 20 75 20 72 2f 77 20 6f 70 65 6e 2d addr u r/w open-
4450: 66 69 6c 65 20 64 75 70 20 6e 6f 2d 66 69 6c 65 file dup no-file
4460: 23 20 3d 20 49 46 0a 09 32 64 72 6f 70 20 61 64 # = IF..2drop ad
4470: 64 72 20 75 20 72 2f 77 20 63 72 65 61 74 65 2d dr u r/w create-
4480: 66 69 6c 65 0a 20 20 20 20 54 48 45 4e 20 20 74 file. THEN t
4490: 68 72 6f 77 20 3b 0a 0a 3a 20 3f 6b 65 79 2d 73 hrow ;..: ?key-s
44a0: 66 64 20 28 20 2d 2d 20 66 64 20 29 0a 20 20 20 fd ( -- fd ).
44b0: 20 6b 65 79 2d 73 66 64 20 22 73 65 63 6b 65 79 key-sfd "seckey
44c0: 73 2e 6b 32 6f 22 20 2e 6b 65 79 73 2f 20 3f 66 s.k2o" .keys/ ?f
44d0: 64 2d 6b 65 79 73 20 64 75 70 20 74 6f 20 6b 65 d-keys dup to ke
44e0: 79 2d 73 66 64 20 3b 0a 3a 20 3f 6b 65 79 2d 70 y-sfd ;.: ?key-p
44f0: 66 64 20 28 20 2d 2d 20 66 64 20 29 0a 20 20 20 fd ( -- fd ).
4500: 20 6b 65 79 2d 70 66 64 20 22 70 75 62 6b 65 79 key-pfd "pubkey
4510: 73 2e 6b 32 6f 22 20 2e 6b 65 79 73 2f 20 3f 66 s.k2o" .keys/ ?f
4520: 64 2d 6b 65 79 73 20 64 75 70 20 74 6f 20 6b 65 d-keys dup to ke
4530: 79 2d 70 66 64 20 3b 0a 0a 3a 20 6b 65 79 3e 73 y-pfd ;..: key>s
4540: 66 69 6c 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 file ( -- ).
4550: 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d keypack keypack-
4560: 61 6c 6c 23 20 3f 6b 65 79 2d 73 66 64 20 61 70 all# ?key-sfd ap
4570: 70 65 6e 64 2d 66 69 6c 65 20 6b 65 2d 6f 66 66 pend-file ke-off
4580: 73 65 74 20 36 34 21 20 3b 0a 3a 20 6b 65 79 3e set 64! ;.: key>
4590: 70 66 69 6c 65 20 28 20 2d 2d 20 29 0a 20 20 20 pfile ( -- ).
45a0: 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b keypack keypack
45b0: 2d 61 6c 6c 23 20 3f 6b 65 79 2d 70 66 64 20 61 -all# ?key-pfd a
45c0: 70 70 65 6e 64 2d 66 69 6c 65 20 6b 65 2d 6f 66 ppend-file ke-of
45d0: 66 73 65 74 20 36 34 21 20 3b 0a 0a 3a 20 6b 65 fset 64! ;..: ke
45e0: 79 3e 73 66 69 6c 65 40 70 6f 73 20 28 20 36 34 y>sfile@pos ( 64
45f0: 70 6f 73 20 2d 2d 20 29 20 36 34 64 75 70 20 36 pos -- ) 64dup 6
4600: 34 23 2d 31 20 36 34 3d 20 49 46 20 20 36 34 64 4#-1 64= IF 64d
4610: 72 6f 70 20 6b 65 79 3e 73 66 69 6c 65 0a 20 20 rop key>sfile.
4620: 20 20 45 4c 53 45 20 20 36 34 3e 72 20 6b 65 79 ELSE 64>r key
4630: 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c pack keypack-all
4640: 23 20 36 34 72 3e 20 3f 6b 65 79 2d 73 66 64 20 # 64r> ?key-sfd
4650: 77 72 69 74 65 40 70 6f 73 2d 66 69 6c 65 20 20 write@pos-file
4660: 54 48 45 4e 20 3b 0a 3a 20 6b 65 79 3e 70 66 69 THEN ;.: key>pfi
4670: 6c 65 40 70 6f 73 20 28 20 36 34 70 6f 73 20 2d le@pos ( 64pos -
4680: 2d 20 29 20 36 34 64 75 70 20 36 34 23 2d 31 20 - ) 64dup 64#-1
4690: 36 34 3d 20 49 46 20 20 36 34 64 72 6f 70 20 6b 64= IF 64drop k
46a0: 65 79 3e 70 66 69 6c 65 0a 20 20 20 20 45 4c 53 ey>pfile. ELS
46b0: 45 20 20 36 34 3e 72 20 6b 65 79 70 61 63 6b 20 E 64>r keypack
46c0: 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 36 34 72 keypack-all# 64r
46d0: 3e 20 3f 6b 65 79 2d 70 66 64 20 77 72 69 74 65 > ?key-pfd write
46e0: 40 70 6f 73 2d 66 69 6c 65 20 20 54 48 45 4e 20 @pos-file THEN
46f0: 3b 0a 0a 3a 20 72 6e 64 3e 73 66 69 6c 65 20 28 ;..: rnd>sfile (
4700: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 70 61 63 -- ). keypac
4710: 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3e k keypack-all# >
4720: 72 6e 67 24 20 6b 65 79 3e 73 66 69 6c 65 20 3b rng$ key>sfile ;
4730: 0a 3a 20 72 6e 64 3e 70 66 69 6c 65 20 28 20 2d .: rnd>pfile ( -
4740: 2d 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 - ). keypack
4750: 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3e 72 6e keypack-all# >rn
4760: 67 24 20 6b 65 79 3e 70 66 69 6c 65 20 3b 0a 0a g$ key>pfile ;..
4770: 3a 20 3e 6b 65 79 73 20 28 20 2d 2d 20 29 0a 20 : >keys ( -- ).
4780: 20 20 20 5c 47 20 61 64 64 20 73 68 61 72 65 64 \G add shared
4790: 20 73 65 63 72 65 74 20 74 6f 20 6c 69 73 74 20 secret to list
47a0: 6f 66 20 70 6f 73 73 69 62 6c 65 20 6b 65 79 73 of possible keys
47b0: 0a 20 20 20 20 73 6b 63 20 70 6b 63 20 6b 65 79 . skc pkc key
47c0: 70 61 64 20 65 64 2d 64 68 20 2b 6b 65 79 20 3b pad ed-dh +key ;
47d0: 0a 0a 5c 20 6b 65 79 20 67 65 6e 65 72 61 74 69 ..\ key generati
47e0: 6f 6e 0a 5c 20 66 6f 72 20 72 65 70 72 6f 64 75 on.\ for reprodu
47f0: 63 69 62 69 6c 69 74 79 20 6f 66 20 74 68 65 20 cibility of the
4800: 73 65 6c 66 73 69 67 2c 20 61 6c 77 61 79 73 20 selfsig, always
4810: 75 73 65 20 74 68 65 20 73 61 6d 65 20 6f 72 64 use the same ord
4820: 65 72 3a 0a 5c 20 22 70 75 62 6b 65 79 22 20 6e er:.\ "pubkey" n
4830: 65 77 6b 65 79 20 3c 6e 3e 20 6b 65 79 74 79 70 ewkey <n> keytyp
4840: 65 20 22 6e 69 63 6b 22 20 6b 65 79 6e 69 63 6b e "nick" keynick
4850: 20 22 73 69 67 22 20 6b 65 79 73 65 6c 66 73 69 "sig" keyselfsi
4860: 67 0a 0a 55 73 65 72 20 70 6b 2b 73 69 67 24 0a g..User pk+sig$.
4870: 0a 6b 65 79 73 69 7a 65 32 20 43 6f 6e 73 74 61 .keysize2 Consta
4880: 6e 74 20 70 6b 72 6b 23 0a 0a 3a 20 5d 70 6b 2b nt pkrk#..: ]pk+
4890: 73 69 67 6e 20 28 20 61 64 64 72 20 75 20 2d 2d sign ( addr u --
48a0: 20 29 20 2b 63 6d 64 62 75 66 20 5d 73 69 67 6e ) +cmdbuf ]sign
48b0: 20 3b 0a 0a 3a 20 70 61 63 6b 2d 6b 65 79 20 28 ;..: pack-key (
48c0: 20 74 79 70 65 20 6e 69 63 6b 20 75 20 2d 2d 20 type nick u --
48d0: 29 0a 20 20 20 20 6e 6f 77 3e 6e 65 76 65 72 0a ). now>never.
48e0: 20 20 20 20 6b 65 79 3a 63 6f 64 65 0a 20 20 20 key:code.
48f0: 20 20 20 73 69 67 6e 5b 0a 20 20 20 20 20 20 72 sign[. r
4900: 6f 74 20 75 6c 69 74 2c 20 6b 65 79 74 79 70 65 ot ulit, keytype
4910: 20 24 2c 20 6b 65 79 6e 69 63 6b 0a 20 20 20 20 $, keynick.
4920: 20 20 70 6b 63 20 70 6b 72 6b 23 20 5d 70 6b 2b pkc pkrk# ]pk+
4930: 73 69 67 6e 0a 20 20 20 20 20 20 73 6b 63 20 6b sign. skc k
4940: 65 79 73 69 7a 65 20 73 65 63 24 2c 20 70 72 69 eysize sec$, pri
4950: 76 6b 65 79 0a 20 20 20 20 65 6e 64 3a 6b 65 79 vkey. end:key
4960: 20 3b 0a 0a 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 ;..also net2o-b
4970: 61 73 65 0a 3a 20 70 61 63 6b 2d 63 6f 72 65 20 ase.: pack-core
4980: 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 20 5c 20 63 ( o:key -- ) \ c
4990: 6f 72 65 20 77 69 74 68 6f 75 74 20 6b 65 79 0a ore without key.
49a0: 20 20 20 20 6b 65 2d 74 79 70 65 20 40 20 75 6c ke-type @ ul
49b0: 69 74 2c 20 6b 65 79 74 79 70 65 0a 20 20 20 20 it, keytype.
49c0: 6b 65 2d 6e 69 63 6b 20 24 40 20 24 2c 20 6b 65 ke-nick $@ $, ke
49d0: 79 6e 69 63 6b 0a 20 20 20 20 6b 65 2d 70 72 6f ynick. ke-pro
49e0: 66 20 24 40 20 64 75 70 20 49 46 20 20 24 2c 20 f $@ dup IF $,
49f0: 6b 65 79 70 72 6f 66 69 6c 65 20 20 45 4c 53 45 keyprofile ELSE
4a00: 20 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 2drop THEN ;.
4a10: 0a 3a 20 70 61 63 6b 2d 63 6f 72 65 6b 65 79 20 .: pack-corekey
4a20: 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 ( o:key -- ).
4a30: 20 73 69 67 6e 5b 0a 20 20 20 20 70 61 63 6b 2d sign[. pack-
4a40: 63 6f 72 65 0a 20 20 20 20 6b 65 2d 70 6b 20 24 core. ke-pk $
4a50: 40 20 2b 63 6d 64 62 75 66 0a 20 20 20 20 6b 65 @ +cmdbuf. ke
4a60: 2d 73 65 6c 66 73 69 67 20 24 40 20 2b 63 6d 64 -selfsig $@ +cmd
4a70: 62 75 66 20 63 6d 64 2d 72 65 73 6f 6c 76 65 3e buf cmd-resolve>
4a80: 20 32 64 72 6f 70 20 6e 65 73 74 73 69 67 0a 20 2drop nestsig.
4a90: 20 20 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 ke-imports @
4aa0: 75 6c 69 74 2c 20 6b 65 79 69 6d 70 6f 72 74 0a ulit, keyimport.
4ab0: 20 20 20 20 6b 65 2d 6d 61 73 6b 20 40 20 6e 6c ke-mask @ nl
4ac0: 69 74 2c 20 6b 65 79 6d 61 73 6b 0a 20 20 20 20 it, keymask.
4ad0: 6b 65 2d 70 65 74 73 20 5b 3a 20 24 2c 20 6b 65 ke-pets [: $, ke
4ae0: 79 70 65 74 20 3b 5d 20 24 5b 5d 6d 61 70 0a 20 ypet ;] $[]map.
4af0: 20 20 20 6b 65 2d 73 74 6f 72 65 6b 65 79 20 40 ke-storekey @
4b00: 20 3e 73 74 6f 72 65 6b 65 79 20 21 20 3b 0a 70 >storekey ! ;.p
4b10: 72 65 76 69 6f 75 73 0a 0a 3a 20 70 61 63 6b 2d revious..: pack-
4b20: 70 75 62 6b 65 79 20 28 20 6f 3a 6b 65 79 20 2d pubkey ( o:key -
4b30: 2d 20 29 0a 20 20 20 20 6b 65 79 3a 63 6f 64 65 - ). key:code
4b40: 0a 20 20 20 20 20 20 70 61 63 6b 2d 63 6f 72 65 . pack-core
4b50: 6b 65 79 0a 20 20 20 20 65 6e 64 3a 6b 65 79 20 key. end:key
4b60: 3b 0a 3a 20 70 61 63 6b 2d 73 65 63 6b 65 79 20 ;.: pack-seckey
4b70: 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 ( o:key -- ).
4b80: 20 6b 65 79 3a 63 6f 64 65 0a 20 20 20 20 20 20 key:code.
4b90: 70 61 63 6b 2d 63 6f 72 65 6b 65 79 0a 20 20 20 pack-corekey.
4ba0: 20 20 20 6b 65 2d 73 6b 20 73 65 63 40 20 73 65 ke-sk sec@ se
4bb0: 63 24 2c 20 70 72 69 76 6b 65 79 0a 20 20 20 20 c$, privkey.
4bc0: 20 20 6b 65 2d 72 73 6b 20 73 65 63 40 20 64 75 ke-rsk sec@ du
4bd0: 70 20 49 46 20 20 73 65 63 24 2c 20 72 73 6b 6b p IF sec$, rskk
4be0: 65 79 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 ey ELSE 2drop
4bf0: 20 54 48 45 4e 0a 20 20 20 20 65 6e 64 3a 6b 65 THEN. end:ke
4c00: 79 20 3b 0a 3a 20 6b 65 79 6e 69 63 6b 24 20 28 y ;.: keynick$ (
4c10: 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 64 72 20 75 o:key -- addr u
4c20: 20 29 0a 20 20 20 20 5c 47 20 67 65 74 20 74 68 ). \G get th
4c30: 65 20 61 6e 6e 6f 74 61 74 69 6f 6e 73 20 77 69 e annotations wi
4c40: 74 68 20 73 69 67 6e 61 74 75 72 65 0a 20 20 20 th signature.
4c50: 20 5b 27 5d 20 70 61 63 6b 2d 63 6f 72 65 20 67 ['] pack-core g
4c60: 65 6e 2d 63 6d 64 24 20 32 64 72 6f 70 0a 20 20 en-cmd$ 2drop.
4c70: 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 20 ke-selfsig $@
4c80: 74 6d 70 24 20 24 2b 21 20 74 6d 70 24 20 24 40 tmp$ $+! tmp$ $@
4c90: 20 3b 0a 3a 20 6b 65 79 70 6b 32 6e 69 63 6b 24 ;.: keypk2nick$
4ca0: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 64 72 ( o:key -- addr
4cb0: 20 75 20 29 0a 20 20 20 20 5c 47 20 67 65 74 20 u ). \G get
4cc0: 74 68 65 20 61 6e 6e 6f 74 61 74 69 6f 6e 73 20 the annotations
4cd0: 77 69 74 68 20 73 69 67 6e 61 74 75 72 65 0a 20 with signature.
4ce0: 20 20 20 5b 27 5d 20 70 61 63 6b 2d 63 6f 72 65 ['] pack-core
4cf0: 20 67 65 6e 2d 63 6d 64 24 20 32 64 72 6f 70 0a gen-cmd$ 2drop.
4d00: 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 74 6d 70 ke-pk $@ tmp
4d10: 24 20 24 2b 21 20 6b 65 2d 73 65 6c 66 73 69 67 $ $+! ke-selfsig
4d20: 20 24 40 20 74 6d 70 24 20 24 2b 21 20 74 6d 70 $@ tmp$ $+! tmp
4d30: 24 20 24 40 20 3b 0a 3a 20 6d 79 6e 69 63 6b 2d $ $@ ;.: mynick-
4d40: 6b 65 79 20 28 20 2d 2d 20 6f 20 29 0a 20 20 20 key ( -- o ).
4d50: 20 70 6b 63 20 6b 65 79 73 69 7a 65 20 6b 65 79 pkc keysize key
4d60: 2d 74 61 62 6c 65 20 23 40 20 64 72 6f 70 20 63 -table #@ drop c
4d70: 65 6c 6c 2b 20 3b 0a 3a 20 6d 79 6e 69 63 6b 24 ell+ ;.: mynick$
4d80: 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 ( -- addr u ).
4d90: 20 20 20 5c 47 20 67 65 74 20 6d 79 20 6e 69 63 \G get my nic
4da0: 6b 20 77 69 74 68 20 73 69 67 6e 61 74 75 72 65 k with signature
4db0: 0a 20 20 20 20 6d 79 6e 69 63 6b 2d 6b 65 79 20 . mynick-key
4dc0: 2e 6b 65 79 6e 69 63 6b 24 20 3b 0a 3a 20 6d 79 .keynick$ ;.: my
4dd0: 70 6b 32 6e 69 63 6b 24 20 28 20 6f 3a 6b 65 79 pk2nick$ ( o:key
4de0: 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 -- addr u ).
4df0: 20 5c 47 20 67 65 74 20 6d 79 20 6e 69 63 6b 20 \G get my nick
4e00: 77 69 74 68 20 73 69 67 6e 61 74 75 72 65 0a 20 with signature.
4e10: 20 20 20 6d 79 6e 69 63 6b 2d 6b 65 79 20 2e 6b mynick-key .k
4e20: 65 79 70 6b 32 6e 69 63 6b 24 20 3b 0a 3a 20 6b eypk2nick$ ;.: k
4e30: 65 79 2d 73 69 67 6e 20 28 20 6f 3a 6b 65 79 20 ey-sign ( o:key
4e40: 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 5b -- o:key ). [
4e50: 27 5d 20 70 61 63 6b 2d 63 6f 72 65 20 67 65 6e '] pack-core gen
4e60: 2d 63 6d 64 24 0a 20 20 20 20 5b 3a 20 74 79 70 -cmd$. [: typ
4e70: 65 20 6b 65 2d 70 6b 20 24 40 20 74 79 70 65 20 e ke-pk $@ type
4e80: 3b 5d 20 24 74 6d 70 0a 20 20 20 20 6e 6f 77 3e ;] $tmp. now>
4e90: 6e 65 76 65 72 20 63 3a 30 6b 65 79 20 63 3a 68 never c:0key c:h
4ea0: 61 73 68 20 5b 27 5d 20 2e 73 69 67 20 24 74 6d ash ['] .sig $tm
4eb0: 70 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 21 20 p ke-selfsig $!
4ec0: 3b 0a 0a 56 61 72 69 61 62 6c 65 20 63 70 2d 74 ;..Variable cp-t
4ed0: 6d 70 0a 0a 3a 20 73 61 76 65 2d 70 75 62 6b 65 mp..: save-pubke
4ee0: 79 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 ys ( -- ). ke
4ef0: 79 2d 70 66 64 20 3f 64 75 70 2d 49 46 20 20 63 y-pfd ?dup-IF c
4f00: 6c 6f 73 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 lose-file throw
4f10: 20 54 48 45 4e 0a 20 20 20 20 22 70 75 62 6b 65 THEN. "pubke
4f20: 79 73 2e 6b 32 6f 22 20 2e 6b 65 79 73 2f 20 5b ys.k2o" .keys/ [
4f30: 3a 20 74 6f 20 6b 65 79 2d 70 66 64 0a 20 20 20 : to key-pfd.
4f40: 20 20 20 6b 65 79 2d 74 61 62 6c 65 20 5b 3a 20 key-table [:
4f50: 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 cell+ $@ drop ce
4f60: 6c 6c 2b 20 3e 6f 0a 09 6b 65 2d 73 6b 20 73 65 ll+ >o..ke-sk se
4f70: 63 40 20 64 30 3d 20 49 46 20 20 70 61 63 6b 2d c@ d0= IF pack-
4f80: 70 75 62 6b 65 79 0a 09 20 20 20 20 66 6c 75 73 pubkey.. flus
4f90: 68 28 20 2e 22 20 73 61 76 69 6e 67 20 22 20 2e h( ." saving " .
4fa0: 6e 69 63 6b 20 66 6f 72 74 68 3a 63 72 20 29 0a nick forth:cr ).
4fb0: 09 20 20 20 20 6b 65 79 2d 63 72 79 70 74 20 6b . key-crypt k
4fc0: 65 2d 6f 66 66 73 65 74 20 36 34 40 20 6b 65 79 e-offset 64@ key
4fd0: 3e 70 66 69 6c 65 40 70 6f 73 0a 09 54 48 45 4e >pfile@pos..THEN
4fe0: 20 6f 3e 20 3b 5d 20 23 6d 61 70 0a 20 20 20 20 o> ;] #map.
4ff0: 30 20 74 6f 20 6b 65 79 2d 70 66 64 20 3b 5d 20 0 to key-pfd ;]
5000: 73 61 76 65 2d 66 69 6c 65 20 20 3f 6b 65 79 2d save-file ?key-
5010: 70 66 64 20 64 72 6f 70 20 3b 0a 0a 3a 20 73 61 pfd drop ;..: sa
5020: 76 65 2d 73 65 63 6b 65 79 73 20 28 20 2d 2d 20 ve-seckeys ( --
5030: 29 0a 20 20 20 20 6b 65 79 2d 73 66 64 20 3f 64 ). key-sfd ?d
5040: 75 70 2d 49 46 20 20 63 6c 6f 73 65 2d 66 69 6c up-IF close-fil
5050: 65 20 74 68 72 6f 77 20 20 54 48 45 4e 0a 20 20 e throw THEN.
5060: 20 20 22 73 65 63 6b 65 79 73 2e 6b 32 6f 22 20 "seckeys.k2o"
5070: 2e 6b 65 79 73 2f 20 5b 3a 20 74 6f 20 6b 65 79 .keys/ [: to key
5080: 2d 73 66 64 0a 20 20 20 20 20 20 6b 65 79 2d 74 -sfd. key-t
5090: 61 62 6c 65 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 able [: cell+ $@
50a0: 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 0a 09 drop cell+ >o..
50b0: 6b 65 2d 73 6b 20 73 65 63 40 20 64 30 3c 3e 20 ke-sk sec@ d0<>
50c0: 49 46 20 20 70 61 63 6b 2d 73 65 63 6b 65 79 0a IF pack-seckey.
50d0: 09 20 20 20 20 70 77 2d 6c 65 76 65 6c 23 20 3e . pw-level# >
50e0: 72 20 20 6b 65 2d 70 77 6c 65 76 65 6c 20 40 20 r ke-pwlevel @
50f0: 74 6f 20 70 77 2d 6c 65 76 65 6c 23 0a 09 20 20 to pw-level#..
5100: 20 20 6b 65 79 2d 63 72 79 70 74 20 6b 65 2d 6f key-crypt ke-o
5110: 66 66 73 65 74 20 36 34 40 20 6b 65 79 3e 73 66 ffset 64@ key>sf
5120: 69 6c 65 40 70 6f 73 0a 09 20 20 20 20 72 3e 20 ile@pos.. r>
5130: 74 6f 20 70 77 2d 6c 65 76 65 6c 23 0a 09 54 48 to pw-level#..TH
5140: 45 4e 20 6f 3e 20 3b 5d 20 23 6d 61 70 0a 20 20 EN o> ;] #map.
5150: 20 20 30 20 74 6f 20 6b 65 79 2d 73 66 64 20 3b 0 to key-sfd ;
5160: 5d 20 73 61 76 65 2d 66 69 6c 65 20 20 3f 6b 65 ] save-file ?ke
5170: 79 2d 73 66 64 20 64 72 6f 70 20 3b 0a 0a 3a 20 y-sfd drop ;..:
5180: 73 61 76 65 2d 6b 65 79 73 20 28 20 2d 2d 20 29 save-keys ( -- )
5190: 0a 20 20 20 20 73 61 76 65 2d 70 75 62 6b 65 79 . save-pubkey
51a0: 73 20 73 61 76 65 2d 73 65 63 6b 65 79 73 20 3b s save-seckeys ;
51b0: 0a 0a 3a 20 2b 67 65 6e 2d 6b 65 79 73 20 28 20 ..: +gen-keys (
51c0: 6e 69 63 6b 20 75 20 74 79 70 65 20 2d 2d 20 29 nick u type -- )
51d0: 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 20 20 36 . gen-keys 6
51e0: 34 23 2d 31 20 6b 65 79 2d 72 65 61 64 2d 6f 66 4#-1 key-read-of
51f0: 66 73 65 74 20 36 34 21 20 20 70 6b 63 20 6b 65 fset 64! pkc ke
5200: 79 73 69 7a 65 32 20 6b 65 79 3a 6e 65 77 20 3e ysize2 key:new >
5210: 6f 0a 20 20 20 20 5b 20 31 20 69 6d 70 6f 72 74 o. [ 1 import
5220: 23 73 65 6c 66 20 6c 73 68 69 66 74 20 31 20 69 #self lshift 1 i
5230: 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 74 mport#new lshift
5240: 20 6f 72 20 5d 4c 20 6b 65 2d 69 6d 70 6f 72 74 or ]L ke-import
5250: 73 20 21 0a 20 20 20 20 6b 65 2d 74 79 70 65 20 s !. ke-type
5260: 21 20 20 6b 65 2d 6e 69 63 6b 20 24 21 20 20 6e ! ke-nick $! n
5270: 69 63 6b 21 0a 20 20 20 20 70 77 2d 6c 65 76 65 ick!. pw-leve
5280: 6c 23 20 6b 65 2d 70 77 6c 65 76 65 6c 20 21 20 l# ke-pwlevel !
5290: 20 70 65 72 6d 25 6d 79 73 65 6c 66 20 6b 65 2d perm%myself ke-
52a0: 6d 61 73 6b 20 21 0a 20 20 20 20 73 6b 63 20 6b mask !. skc k
52b0: 65 79 73 69 7a 65 20 6b 65 2d 73 6b 20 73 65 63 eysize ke-sk sec
52c0: 21 20 20 2b 73 65 63 6b 65 79 0a 20 20 20 20 73 ! +seckey. s
52d0: 6b 72 65 76 20 6b 65 79 73 69 7a 65 20 6b 65 2d krev keysize ke-
52e0: 72 73 6b 20 73 65 63 21 0a 20 20 20 20 6b 65 79 rsk sec!. key
52f0: 2d 73 69 67 6e 20 6f 3e 20 3b 0a 0a 3a 20 2b 6b -sign o> ;..: +k
5300: 65 79 70 61 69 72 20 28 20 74 79 70 65 20 6e 69 eypair ( type ni
5310: 63 6b 20 75 20 2d 2d 20 29 20 2b 70 61 73 73 70 ck u -- ) +passp
5320: 68 72 61 73 65 20 2b 67 65 6e 2d 6b 65 79 73 20 hrase +gen-keys
5330: 3b 0a 0a 24 34 30 20 62 75 66 66 65 72 3a 20 6e ;..$40 buffer: n
5340: 69 63 6b 2d 62 75 66 0a 0a 3a 20 67 65 74 2d 6e ick-buf..: get-n
5350: 69 63 6b 20 28 20 2d 2d 20 61 64 64 72 20 75 20 ick ( -- addr u
5360: 29 0a 20 20 20 20 2e 22 20 6e 69 63 6b 3a 20 22 ). ." nick: "
5370: 20 6e 69 63 6b 2d 62 75 66 20 24 34 30 20 61 63 nick-buf $40 ac
5380: 63 65 70 74 20 6e 69 63 6b 2d 62 75 66 20 73 77 cept nick-buf sw
5390: 61 70 20 63 72 20 3b 0a 0a 3a 20 79 65 73 3f 20 ap cr ;..: yes?
53a0: 28 20 2d 2d 20 66 6c 61 67 20 29 20 20 2e 22 20 ( -- flag ) ."
53b0: 20 28 79 2f 4e 29 22 20 6b 65 79 20 63 72 20 27 (y/N)" key cr '
53c0: 79 27 20 3d 20 3b 0a 0a 3a 20 3f 72 73 6b 20 28 y' = ;..: ?rsk (
53d0: 20 2d 2d 20 29 0a 20 20 20 20 70 6b 63 20 6b 65 -- ). pkc ke
53e0: 79 73 69 7a 65 20 6b 65 79 2d 65 78 69 73 74 3f ysize key-exist?
53f0: 20 64 75 70 20 30 3d 20 49 46 20 20 64 72 6f 70 dup 0= IF drop
5400: 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 EXIT THEN.
5410: 20 3e 6f 20 6b 65 2d 72 73 6b 20 73 65 63 40 20 >o ke-rsk sec@
5420: 64 75 70 20 30 3d 20 49 46 20 20 32 64 72 6f 70 dup 0= IF 2drop
5430: 20 6f 3e 20 20 45 58 49 54 20 20 54 48 45 4e 0a o> EXIT THEN.
5440: 20 20 20 20 2e 22 20 59 6f 75 20 73 74 69 6c 6c ." You still
5450: 20 68 61 76 65 6e 27 74 20 73 74 6f 72 65 64 20 haven't stored
5460: 79 6f 75 72 20 72 65 76 6f 6b 65 20 6b 65 79 20 your revoke key
5470: 73 65 63 75 72 65 6c 79 20 6f 66 66 2d 6c 69 6e securely off-lin
5480: 65 2e 22 20 63 72 0a 20 20 20 20 2e 22 20 50 61 e." cr. ." Pa
5490: 70 65 72 20 61 6e 64 20 70 65 6e 63 69 6c 20 72 per and pencil r
54a0: 65 61 64 79 3f 22 20 79 65 73 3f 20 49 46 0a 09 eady?" yes? IF..
54b0: 2e 73 74 72 69 70 65 38 35 20 63 72 0a 09 2e 22 .stripe85 cr..."
54c0: 20 57 72 69 74 74 65 6e 20 64 6f 77 6e 3f 22 20 Written down?"
54d0: 79 65 73 3f 20 49 46 0a 09 20 20 20 20 2e 22 20 yes? IF.. ."
54e0: 59 6f 75 20 77 6f 6e 27 74 20 73 65 65 20 74 68 You won't see th
54f0: 69 73 20 61 67 61 69 6e 21 20 44 65 6c 65 74 65 is again! Delete
5500: 3f 22 20 79 65 73 3f 0a 09 20 20 20 20 49 46 20 ?" yes?.. IF
5510: 6b 65 2d 72 73 6b 20 73 65 63 2d 6f 66 66 20 20 ke-rsk sec-off
5520: 73 61 76 65 2d 6b 65 79 73 0a 09 09 2e 22 20 72 save-keys...." r
5530: 65 76 6f 6b 65 20 6b 65 79 20 64 65 6c 65 74 65 evoke key delete
5540: 64 2e 22 20 63 72 20 6f 3e 20 20 45 58 49 54 20 d." cr o> EXIT
5550: 20 54 48 45 4e 20 20 54 48 45 4e 0a 20 20 20 20 THEN THEN.
5560: 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 45 ELSE 2drop THE
5570: 4e 0a 20 20 20 20 2e 22 20 49 27 6d 20 6b 65 65 N. ." I'm kee
5580: 70 69 6e 67 20 79 6f 75 72 20 72 65 76 6f 6b 65 ping your revoke
5590: 20 6b 65 79 2e 20 20 54 68 69 73 20 77 69 6c 6c key. This will
55a0: 20 73 68 6f 77 20 75 70 20 61 67 61 69 6e 2e 22 show up again."
55b0: 20 63 72 20 6f 3e 20 3b 0a 0a 5c 20 72 65 61 64 cr o> ;..\ read
55c0: 20 6b 65 79 20 66 69 6c 65 0a 0a 3a 20 74 72 79 key file..: try
55d0: 2d 64 65 63 72 79 70 74 2d 6b 65 79 20 28 20 6b -decrypt-key ( k
55e0: 65 79 20 75 31 20 2d 2d 20 61 64 64 72 20 75 32 ey u1 -- addr u2
55f0: 20 66 6c 61 67 20 29 0a 20 20 20 20 6b 65 79 70 flag ). keyp
5600: 61 63 6b 20 6b 65 79 70 61 63 6b 2d 64 20 6b 65 ack keypack-d ke
5610: 79 70 61 63 6b 2d 61 6c 6c 23 20 6d 6f 76 65 0a ypack-all# move.
5620: 20 20 20 20 6b 65 79 70 61 63 6b 2d 64 20 6b 65 keypack-d ke
5630: 79 70 61 63 6b 2d 61 6c 6c 23 20 32 73 77 61 70 ypack-all# 2swap
5640: 0a 20 20 20 20 64 75 70 20 24 32 30 20 3d 20 49 . dup $20 = I
5650: 46 20 20 64 65 63 72 79 70 74 24 20 20 45 4c 53 F decrypt$ ELS
5660: 45 0a 09 6b 65 79 70 61 63 6b 20 63 40 20 24 46 E..keypack c@ $F
5670: 20 61 6e 64 20 70 77 2d 6d 61 78 6c 65 76 65 6c and pw-maxlevel
5680: 23 20 3c 3d 20 49 46 20 20 64 65 63 72 79 70 74 # <= IF decrypt
5690: 2d 70 77 24 0a 09 45 4c 53 45 20 20 32 64 72 6f -pw$..ELSE 2dro
56a0: 70 20 66 61 6c 73 65 20 20 54 48 45 4e 0a 20 20 p false THEN.
56b0: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 74 72 79 2d THEN ;..: try-
56c0: 64 65 63 72 79 70 74 20 28 20 66 6c 61 67 20 2d decrypt ( flag -
56d0: 2d 20 61 64 64 72 20 75 20 2f 20 30 20 30 20 29 - addr u / 0 0 )
56e0: 20 7b 20 66 6c 61 67 20 7d 0a 20 20 20 20 6b 65 { flag }. ke
56f0: 79 73 20 24 5b 5d 23 20 30 20 3f 44 4f 0a 09 49 ys $[]# 0 ?DO..I
5700: 20 6b 65 79 73 20 73 65 63 5b 5d 40 20 64 75 70 keys sec[]@ dup
5710: 20 6b 65 79 73 69 7a 65 20 3d 20 66 6c 61 67 20 keysize = flag
5720: 78 6f 72 20 49 46 0a 09 20 20 20 20 74 72 79 2d xor IF.. try-
5730: 64 65 63 72 79 70 74 2d 6b 65 79 20 49 46 0a 09 decrypt-key IF..
5740: 09 49 20 6b 65 79 73 20 24 5b 5d 20 40 20 64 75 .I keys $[] @ du
5750: 70 20 3e 73 74 6f 72 65 6b 65 79 20 21 20 64 65 p >storekey ! de
5760: 66 61 75 6c 74 6b 65 79 20 21 0a 09 09 75 6e 6c faultkey !...unl
5770: 6f 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e 20 oop EXIT THEN
5780: 20 54 48 45 4e 0a 09 32 64 72 6f 70 0a 20 20 20 THEN..2drop.
5790: 20 4c 4f 4f 50 20 20 30 20 30 20 3b 0a 0a 3a 20 LOOP 0 0 ;..:
57a0: 3f 70 65 72 6d 20 28 20 2d 2d 20 29 0a 20 20 20 ?perm ( -- ).
57b0: 20 6c 61 73 74 2d 6b 65 79 20 3e 6f 20 6b 65 2d last-key >o ke-
57c0: 6d 61 73 6b 20 40 20 30 3d 20 49 46 0a 09 6b 65 mask @ 0= IF..ke
57d0: 2d 73 6b 20 73 65 63 40 20 6e 69 70 20 49 46 20 -sk sec@ nip IF
57e0: 20 70 65 72 6d 25 6d 79 73 65 6c 66 20 20 45 4c perm%myself EL
57f0: 53 45 20 20 70 65 72 6d 25 64 65 66 61 75 6c 74 SE perm%default
5800: 20 20 54 48 45 4e 20 20 6b 65 2d 6d 61 73 6b 20 THEN ke-mask
5810: 21 0a 20 20 20 20 54 48 45 4e 20 6f 3e 20 3b 0a !. THEN o> ;.
5820: 0a 3a 20 64 6f 2d 6b 65 79 20 28 20 61 64 64 72 .: do-key ( addr
5830: 20 75 20 2f 20 30 20 30 20 20 2d 2d 20 29 0a 20 u / 0 0 -- ).
5840: 20 20 20 64 75 70 20 30 3d 20 49 46 20 20 32 64 dup 0= IF 2d
5850: 72 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e 0a rop EXIT THEN.
5860: 20 20 20 20 73 61 6d 70 6c 65 2d 6b 65 79 20 2e sample-key .
5870: 64 6f 2d 63 6d 64 2d 6c 6f 6f 70 20 3f 70 65 72 do-cmd-loop ?per
5880: 6d 20 3b 0a 0a 3a 20 2e 6b 65 79 24 20 28 20 61 m ;..: .key$ ( a
5890: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 73 ddr u -- ). s
58a0: 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 20 6b 65 ample-key >o ke
58b0: 2d 73 6b 20 6b 65 2d 65 6e 64 20 6f 76 65 72 20 -sk ke-end over
58c0: 2d 20 65 72 61 73 65 0a 20 20 20 20 73 69 67 6e - erase. sign
58d0: 65 64 2d 76 61 6c 20 76 61 6c 69 64 61 74 65 64 ed-val validated
58e0: 20 6f 72 21 20 20 63 2d 73 74 61 74 65 20 6f 66 or! c-state of
58f0: 66 20 20 6e 65 73 74 2d 63 6d 64 2d 6c 6f 6f 70 f nest-cmd-loop
5900: 0a 20 20 20 20 73 69 67 6e 65 64 2d 76 61 6c 20 . signed-val
5910: 69 6e 76 65 72 74 20 76 61 6c 69 64 61 74 65 64 invert validated
5920: 20 61 6e 64 21 0a 20 20 20 20 2e 6b 65 79 2d 73 and!. .key-s
5930: 68 6f 72 74 20 66 72 65 65 2d 6b 65 79 20 6f 3e hort free-key o>
5940: 20 3b 0a 0a 3a 20 72 65 61 64 2d 6b 65 79 73 2d ;..: read-keys-
5950: 6c 6f 6f 70 20 28 20 66 64 20 2d 2d 20 29 20 20 loop ( fd -- )
5960: 63 6f 64 65 2d 6b 65 79 0a 20 20 20 20 3e 72 20 code-key. >r
5970: 30 2e 20 72 40 20 72 65 70 6f 73 69 74 69 6f 6e 0. r@ reposition
5980: 2d 66 69 6c 65 20 74 68 72 6f 77 0a 20 20 20 20 -file throw.
5990: 42 45 47 49 4e 0a 09 72 40 20 66 69 6c 65 2d 70 BEGIN..r@ file-p
59a0: 6f 73 69 74 69 6f 6e 20 74 68 72 6f 77 20 64 3e osition throw d>
59b0: 36 34 20 6b 65 79 2d 72 65 61 64 2d 6f 66 66 73 64 key-read-offs
59c0: 65 74 20 36 34 21 0a 09 6b 65 79 70 61 63 6b 20 et 64!..keypack
59d0: 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 72 40 20 keypack-all# r@
59e0: 72 65 61 64 2d 66 69 6c 65 20 74 68 72 6f 77 0a read-file throw.
59f0: 09 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3d 20 .keypack-all# =
5a00: 57 48 49 4c 45 0a 09 20 20 20 20 69 6d 70 6f 72 WHILE.. impor
5a10: 74 2d 74 79 70 65 20 40 20 69 6d 70 6f 72 74 23 t-type @ import#
5a20: 73 65 6c 66 20 3d 20 74 72 79 2d 64 65 63 72 79 self = try-decry
5a30: 70 74 20 64 6f 2d 6b 65 79 0a 20 20 20 20 52 45 pt do-key. RE
5a40: 50 45 41 54 20 20 72 64 72 6f 70 20 20 63 6f 64 PEAT rdrop cod
5a50: 65 30 2d 62 75 66 20 3b 0a 3a 20 72 65 61 64 2d e0-buf ;.: read-
5a60: 6b 65 79 2d 6c 6f 6f 70 20 28 20 2d 2d 20 29 0a key-loop ( -- ).
5a70: 20 20 20 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 import#self
5a80: 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 0a 20 20 import-type !.
5a90: 20 20 3f 6b 65 79 2d 73 66 64 20 72 65 61 64 2d ?key-sfd read-
5aa0: 6b 65 79 73 2d 6c 6f 6f 70 20 3b 0a 3a 20 72 65 keys-loop ;.: re
5ab0: 61 64 2d 70 6b 65 79 2d 6c 6f 6f 70 20 28 20 2d ad-pkey-loop ( -
5ac0: 2d 20 29 0a 20 20 20 20 6c 61 73 74 6b 65 79 40 - ). lastkey@
5ad0: 20 64 72 6f 70 20 64 65 66 61 75 6c 74 6b 65 79 drop defaultkey
5ae0: 20 21 20 5c 20 61 74 20 6c 65 61 73 74 20 6f 6e ! \ at least on
5af0: 65 20 64 65 66 61 75 6c 74 20 6b 65 79 20 61 76 e default key av
5b00: 61 69 6c 61 62 6c 65 0a 20 20 20 20 70 77 2d 6c ailable. pw-l
5b10: 65 76 65 6c 23 20 3e 72 20 2d 31 20 74 6f 20 70 evel# >r -1 to p
5b20: 77 2d 6c 65 76 65 6c 23 20 20 69 6d 70 6f 72 74 w-level# import
5b30: 23 6d 61 6e 75 61 6c 20 69 6d 70 6f 72 74 2d 74 #manual import-t
5b40: 79 70 65 20 21 0a 20 20 20 20 3f 6b 65 79 2d 70 ype !. ?key-p
5b50: 66 64 20 72 65 61 64 2d 6b 65 79 73 2d 6c 6f 6f fd read-keys-loo
5b60: 70 0a 20 20 20 20 72 3e 20 74 6f 20 70 77 2d 6c p. r> to pw-l
5b70: 65 76 65 6c 23 20 20 3b 0a 0a 3a 20 72 65 61 64 evel# ;..: read
5b80: 2d 6b 65 79 73 20 28 20 2d 2d 20 29 0a 20 20 20 -keys ( -- ).
5b90: 20 72 65 61 64 2d 6b 65 79 2d 6c 6f 6f 70 20 72 read-key-loop r
5ba0: 65 61 64 2d 70 6b 65 79 2d 6c 6f 6f 70 20 69 6d ead-pkey-loop im
5bb0: 70 6f 72 74 23 75 6e 74 72 75 73 74 65 64 20 69 port#untrusted i
5bc0: 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 3b 0a 0a mport-type ! ;..
5bd0: 3a 20 72 65 61 64 2d 70 6b 32 6b 65 79 24 20 28 : read-pk2key$ (
5be0: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 addr u -- ).
5bf0: 20 5c 67 20 72 65 61 64 20 61 20 6e 65 73 74 65 \g read a neste
5c00: 64 20 6b 65 79 20 69 6e 74 6f 20 73 61 6d 70 6c d key into sampl
5c10: 65 2d 6b 65 79 0a 20 20 20 20 73 61 6d 70 6c 65 e-key. sample
5c20: 2d 6b 65 79 20 3e 6f 20 63 2d 73 74 61 74 65 20 -key >o c-state
5c30: 6f 66 66 20 20 73 69 6d 2d 6e 69 63 6b 21 20 6f off sim-nick! o
5c40: 6e 0a 20 20 20 20 70 6b 32 2d 73 69 67 3f 20 21 n. pk2-sig? !
5c50: 21 73 69 67 21 21 20 73 69 67 70 6b 32 73 69 7a !sig!! sigpk2siz
5c60: 65 23 20 2d 20 32 64 75 70 20 2b 20 3e 72 20 64 e# - 2dup + >r d
5c70: 6f 2d 6e 65 73 74 73 69 67 0a 20 20 20 20 72 40 o-nestsig. r@
5c80: 20 6b 65 79 73 69 7a 65 32 20 6b 65 2d 70 6b 20 keysize2 ke-pk
5c90: 24 21 0a 20 20 20 20 72 3e 20 6b 65 79 73 69 7a $!. r> keysiz
5ca0: 65 32 20 2b 20 73 69 67 73 69 7a 65 23 20 6b 65 e2 + sigsize# ke
5cb0: 2d 73 65 6c 66 73 69 67 20 24 21 0a 20 20 20 20 -selfsig $!.
5cc0: 6f 3e 20 20 73 69 6d 2d 6e 69 63 6b 21 20 6f 66 o> sim-nick! of
5cd0: 66 20 3b 0a 0a 3a 20 2e 70 6b 32 6b 65 79 24 20 f ;..: .pk2key$
5ce0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 ( addr u -- ).
5cf0: 20 20 72 65 61 64 2d 70 6b 32 6b 65 79 24 20 73 read-pk2key$ s
5d00: 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 0a 20 20 20 ample-key >o.
5d10: 20 5b 20 31 20 69 6d 70 6f 72 74 23 69 6e 76 69 [ 1 import#invi
5d20: 74 65 64 20 6c 73 68 69 66 74 20 31 20 69 6d 70 ted lshift 1 imp
5d30: 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 6f ort#new lshift o
5d40: 72 20 5d 4c 20 6b 65 2d 69 6d 70 6f 72 74 73 20 r ]L ke-imports
5d50: 21 0a 20 20 20 20 2e 6b 65 79 2d 69 6e 76 69 74 !. .key-invit
5d60: 65 20 66 72 65 65 2d 6b 65 79 20 6f 3e 20 3b 0a e free-key o> ;.
5d70: 0a 5c 20 73 65 6c 65 63 74 20 6b 65 79 20 62 79 .\ select key by
5d80: 20 6e 69 63 6b 0a 0a 3a 20 3e 72 61 77 2d 6b 65 nick..: >raw-ke
5d90: 79 20 28 20 6f 20 2d 2d 20 29 0a 20 20 20 20 64 y ( o -- ). d
5da0: 75 70 20 30 3d 20 21 21 6e 6f 2d 6e 69 63 6b 21 up 0= !!no-nick!
5db0: 21 20 3e 6f 0a 20 20 20 20 6b 65 2d 70 6b 20 24 ! >o. ke-pk $
5dc0: 40 20 70 6b 63 20 70 6b 72 6b 23 20 73 6d 6f 76 @ pkc pkrk# smov
5dd0: 65 0a 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 40 e. ke-sk sec@
5de0: 20 73 6b 63 20 73 77 61 70 20 6b 65 79 7c 20 6d skc swap key| m
5df0: 6f 76 65 0a 20 20 20 20 3e 73 6b 73 69 67 20 6f ove. >sksig o
5e00: 3e 20 3b 0a 0a 3a 20 3e 6b 65 79 20 28 20 61 64 > ;..: >key ( ad
5e10: 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 6b 65 dr u -- ). ke
5e20: 79 2d 74 61 62 6c 65 20 40 20 30 3d 20 49 46 20 y-table @ 0= IF
5e30: 20 72 65 61 64 2d 6b 65 79 73 20 20 54 48 45 4e read-keys THEN
5e40: 0a 20 20 20 20 6e 69 63 6b 2d 6b 65 79 20 3e 72 . nick-key >r
5e50: 61 77 2d 6b 65 79 20 3b 0a 0a 3a 20 69 27 6d 20 aw-key ;..: i'm
5e60: 28 20 22 6e 61 6d 65 22 20 2d 2d 20 29 20 70 61 ( "name" -- ) pa
5e70: 72 73 65 2d 6e 61 6d 65 20 3e 6b 65 79 20 3b 0a rse-name >key ;.
5e80: 3a 20 70 6b 27 20 28 20 22 6e 61 6d 65 22 20 2d : pk' ( "name" -
5e90: 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 70 - addr u ). p
5ea0: 61 72 73 65 2d 6e 61 6d 65 20 6e 69 63 6b 3e 70 arse-name nick>p
5eb0: 6b 20 3b 0a 0a 3a 20 64 65 73 74 2d 6b 65 79 20 k ;..: dest-key
5ec0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 64 75 ( addr u -- ) du
5ed0: 70 20 30 3d 20 49 46 20 20 32 64 72 6f 70 20 20 p 0= IF 2drop
5ee0: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 6e EXIT THEN. n
5ef0: 69 63 6b 2d 6b 65 79 20 3e 6f 20 6f 20 30 3d 20 ick-key >o o 0=
5f00: 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21 0a !!unknown-key!!.
5f10: 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 6f 3e 0a ke-pk $@ o>.
5f20: 20 20 20 20 70 75 62 6b 65 79 20 24 21 20 3b 0a pubkey $! ;.
5f30: 0a 3a 20 64 65 73 74 2d 70 6b 20 28 20 61 64 64 .: dest-pk ( add
5f40: 72 20 75 20 2d 2d 20 29 20 6b 65 79 32 7c 20 32 r u -- ) key2| 2
5f50: 64 75 70 20 6b 65 79 7c 20 6b 65 79 2d 74 61 62 dup key| key-tab
5f60: 6c 65 20 23 40 20 30 3d 20 49 46 0a 09 64 72 6f le #@ 0= IF..dro
5f70: 70 20 70 75 62 6b 65 79 20 24 21 20 20 70 65 72 p pubkey $! per
5f80: 6d 25 75 6e 6b 6e 6f 77 6e 20 70 65 72 6d 2d 6d m%unknown perm-m
5f90: 61 73 6b 20 21 0a 20 20 20 20 45 4c 53 45 20 20 ask !. ELSE
5fa0: 63 65 6c 6c 2b 20 3e 6f 0a 09 6b 65 2d 6d 61 73 cell+ >o..ke-mas
5fb0: 6b 20 40 0a 09 6b 65 2d 70 6b 20 24 40 20 6f 3e k @..ke-pk $@ o>
5fc0: 0a 09 70 75 62 6b 65 79 20 24 21 20 20 70 65 72 ..pubkey $! per
5fd0: 6d 2d 6d 61 73 6b 20 21 20 20 32 64 72 6f 70 20 m-mask ! 2drop
5fe0: 20 54 48 45 4e 20 3b 0a 0a 3a 20 72 65 70 6c 61 THEN ;..: repla
5ff0: 63 65 2d 6b 65 79 20 31 20 2f 73 74 72 69 6e 67 ce-key 1 /string
6000: 20 7b 20 72 65 76 2d 61 64 64 72 20 75 20 2d 2d { rev-addr u --
6010: 20 6f 20 7d 20 5c 20 72 65 76 6f 63 61 74 69 6f o } \ revocatio
6020: 6e 20 74 69 63 6b 65 74 0a 20 20 20 20 6b 65 79 n ticket. key
6030: 28 20 2e 22 20 52 65 70 6c 61 63 65 3a 22 20 63 ( ." Replace:" c
6040: 72 20 6f 20 63 65 6c 6c 2d 20 30 20 2e 6b 65 79 r o cell- 0 .key
6050: 20 29 0a 20 20 20 20 69 6d 70 6f 72 74 23 73 65 ). import#se
6060: 6c 66 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 lf import-type !
6070: 0a 20 20 20 20 73 22 20 23 72 65 76 6f 6b 65 64 . s" #revoked
6080: 22 20 64 75 70 20 3e 72 20 6b 65 2d 6e 69 63 6b " dup >r ke-nick
6090: 20 24 2b 21 0a 20 20 20 20 6b 65 2d 6e 69 63 6b $+!. ke-nick
60a0: 20 24 40 20 72 3e 20 2d 20 6b 65 2d 70 72 6f 66 $@ r> - ke-prof
60b0: 20 24 40 20 6b 65 2d 73 69 67 73 20 6b 65 2d 74 $@ ke-sigs ke-t
60c0: 79 70 65 20 40 0a 20 20 20 20 72 65 76 2d 61 64 ype @. rev-ad
60d0: 64 72 20 70 6b 72 6b 23 20 6b 65 79 3f 6e 65 77 dr pkrk# key?new
60e0: 20 3e 6f 0a 20 20 20 20 6b 65 2d 74 79 70 65 20 >o. ke-type
60f0: 21 20 5b 3a 20 6b 65 2d 73 69 67 73 20 24 2b 5b ! [: ke-sigs $+[
6100: 5d 21 20 3b 5d 20 24 5b 5d 6d 61 70 20 6b 65 2d ]! ;] $[]map ke-
6110: 70 72 6f 66 20 24 21 20 6b 65 2d 6e 69 63 6b 20 prof $! ke-nick
6120: 24 21 0a 20 20 20 20 72 65 76 2d 61 64 64 72 20 $!. rev-addr
6130: 70 6b 72 6b 23 20 6b 65 2d 70 6b 20 24 21 0a 20 pkrk# ke-pk $!.
6140: 20 20 20 72 65 76 2d 61 64 64 72 20 75 20 2b 20 rev-addr u +
6150: 31 2d 20 64 75 70 20 63 40 20 32 2a 20 2d 20 24 1- dup c@ 2* - $
6160: 31 30 20 2d 20 24 31 30 20 6b 65 2d 73 65 6c 66 10 - $10 ke-self
6170: 73 69 67 20 24 21 0a 20 20 20 20 6b 65 79 28 20 sig $!. key(
6180: 2e 22 20 77 69 74 68 3a 22 20 63 72 20 6f 20 63 ." with:" cr o c
6190: 65 6c 6c 2d 20 30 20 2e 6b 65 79 20 29 20 6f 20 ell- 0 .key ) o
61a0: 6f 3e 0a 20 20 20 20 69 6d 70 6f 72 74 23 75 6e o>. import#un
61b0: 74 72 75 73 74 65 64 20 69 6d 70 6f 72 74 2d 74 trusted import-t
61c0: 79 70 65 20 21 20 3b 0a 0a 3a 20 72 65 6e 65 77 ype ! ;..: renew
61d0: 2d 6b 65 79 20 28 20 72 65 76 61 64 64 72 20 75 -key ( revaddr u
61e0: 31 20 6b 65 79 61 64 64 72 20 75 32 20 2d 2d 20 1 keyaddr u2 --
61f0: 6f 20 29 0a 20 20 20 20 63 75 72 72 65 6e 74 2d o ). current-
6200: 6b 65 79 20 3e 6f 20 72 65 70 6c 61 63 65 2d 6b key >o replace-k
6210: 65 79 20 6f 3e 0a 20 20 20 20 3e 6f 20 73 6b 63 ey o>. >o skc
6220: 20 6b 65 79 73 69 7a 65 20 6b 65 2d 73 6b 20 73 keysize ke-sk s
6230: 65 63 21 20 6f 20 6f 3e 20 3b 0a 0a 5c 20 67 65 ec! o o> ;..\ ge
6240: 6e 65 72 61 74 65 20 6e 65 77 20 6b 65 79 0a 0a nerate new key..
6250: 3a 20 6f 75 74 2d 6b 65 79 20 28 20 6f 20 2d 2d : out-key ( o --
6260: 20 29 0a 20 20 20 20 3e 6f 20 70 61 63 6b 2d 70 ). >o pack-p
6270: 75 62 6b 65 79 20 6f 20 6f 3e 0a 20 20 20 20 5b ubkey o o>. [
6280: 3a 20 2e 2e 6e 69 63 6b 2d 62 61 73 65 20 2e 22 : ..nick-base ."
6290: 20 2e 6e 32 6f 22 20 3b 5d 20 24 74 6d 70 20 66 .n2o" ;] $tmp f
62a0: 6e 2d 73 61 6e 69 74 69 7a 65 20 77 2f 6f 20 63 n-sanitize w/o c
62b0: 72 65 61 74 65 2d 66 69 6c 65 20 74 68 72 6f 77 reate-file throw
62c0: 0a 20 20 20 20 3e 72 20 63 6d 64 62 75 66 24 20 . >r cmdbuf$
62d0: 72 40 20 77 72 69 74 65 2d 66 69 6c 65 20 74 68 r@ write-file th
62e0: 72 6f 77 20 72 3e 20 63 6c 6f 73 65 2d 66 69 6c row r> close-fil
62f0: 65 20 74 68 72 6f 77 20 3b 0a 3a 20 6f 75 74 2d e throw ;.: out-
6300: 6d 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 70 6b me ( -- ). pk
6310: 63 20 6b 65 79 73 69 7a 65 20 6b 65 79 2d 74 61 c keysize key-ta
6320: 62 6c 65 20 23 40 20 30 3d 20 21 21 75 6e 6b 6e ble #@ 0= !!unkn
6330: 6f 77 6e 2d 6b 65 79 21 21 0a 20 20 20 20 63 65 own-key!!. ce
6340: 6c 6c 2b 20 6f 75 74 2d 6b 65 79 20 3b 0a 0a 56 ll+ out-key ;..V
6350: 61 72 69 61 62 6c 65 20 64 68 74 72 6f 6f 74 2e ariable dhtroot.
6360: 6e 32 6f 0a 0a 3a 20 2b 64 68 74 72 6f 6f 74 20 n2o..: +dhtroot
6370: 28 20 2d 2d 20 29 0a 20 20 20 20 64 65 66 61 75 ( -- ). defau
6380: 6c 74 6b 65 79 20 40 20 3e 73 74 6f 72 65 6b 65 ltkey @ >storeke
6390: 79 20 21 0a 20 20 20 20 69 6d 70 6f 72 74 23 6d y !. import#m
63a0: 61 6e 75 61 6c 20 69 6d 70 6f 72 74 2d 74 79 70 anual import-typ
63b0: 65 20 21 20 20 36 34 23 2d 31 20 6b 65 79 2d 72 e ! 64#-1 key-r
63c0: 65 61 64 2d 6f 66 66 73 65 74 20 36 34 21 0a 20 ead-offset 64!.
63d0: 20 20 20 64 68 74 72 6f 6f 74 2e 6e 32 6f 20 24 dhtroot.n2o $
63e0: 40 20 64 6f 2d 6b 65 79 20 3b 0a 0a 3a 20 6e 65 @ do-key ;..: ne
63f0: 77 2d 6b 65 79 20 28 20 6e 69 63 6b 61 64 64 72 w-key ( nickaddr
6400: 20 75 20 2d 2d 20 29 0a 20 20 20 20 2b 6e 65 77 u -- ). +new
6410: 70 68 72 61 73 65 20 6b 65 79 3e 64 65 66 61 75 phrase key>defau
6420: 6c 74 0a 20 20 20 20 6b 65 79 23 75 73 65 72 20 lt. key#user
6430: 2b 67 65 6e 2d 6b 65 79 73 0a 20 20 20 20 73 65 +gen-keys. se
6440: 63 72 65 74 2d 6b 65 79 73 23 20 31 2d 20 73 65 cret-keys# 1- se
6450: 63 72 65 74 2d 6b 65 79 20 3e 72 61 77 2d 6b 65 cret-key >raw-ke
6460: 79 20 20 6c 61 73 74 6b 65 79 40 20 64 72 6f 70 y lastkey@ drop
6470: 20 64 65 66 61 75 6c 74 6b 65 79 20 21 0a 20 20 defaultkey !.
6480: 20 20 6f 75 74 2d 6d 65 20 2b 64 68 74 72 6f 6f out-me +dhtroo
6490: 74 20 73 61 76 65 2d 6b 65 79 73 20 3b 0a 0a 5c t save-keys ;..\
64a0: 20 72 65 76 6f 6b 61 74 69 6f 6e 0a 0a 34 20 64 revokation..4 d
64b0: 61 74 65 73 69 7a 65 23 20 2b 20 6b 65 79 73 69 atesize# + keysi
64c0: 7a 65 20 39 20 2a 20 2b 20 43 6f 6e 73 74 61 6e ze 9 * + Constan
64d0: 74 20 72 65 76 73 69 7a 65 23 0a 0a 56 61 72 69 t revsize#..Vari
64e0: 61 62 6c 65 20 72 65 76 74 6f 6b 65 6e 0a 0a 3a able revtoken..:
64f0: 20 30 6f 6c 64 6b 65 79 20 28 20 2d 2d 20 29 20 0oldkey ( -- )
6500: 5c 20 70 75 62 6b 65 79 73 20 63 61 6e 20 73 74 \ pubkeys can st
6510: 61 79 0a 20 20 20 20 6f 6c 64 73 6b 63 20 6b 65 ay. oldskc ke
6520: 79 73 69 7a 65 20 65 72 61 73 65 20 20 6f 6c 64 ysize erase old
6530: 73 6b 72 65 76 20 6b 65 79 73 69 7a 65 20 65 72 skrev keysize er
6540: 61 73 65 20 3b 0a 0a 3a 20 6b 65 79 6d 6f 76 65 ase ;..: keymove
6550: 20 28 20 61 64 64 72 31 20 61 64 64 72 32 20 2d ( addr1 addr2 -
6560: 2d 20 29 20 20 6b 65 79 73 69 7a 65 20 6d 6f 76 - ) keysize mov
6570: 65 20 3b 0a 0a 3a 20 72 65 76 6f 6b 65 2d 76 65 e ;..: revoke-ve
6580: 72 69 66 79 20 28 20 61 64 64 72 20 75 31 20 70 rify ( addr u1 p
6590: 6b 20 73 74 72 69 6e 67 20 75 32 20 2d 2d 20 61 k string u2 -- a
65a0: 64 64 72 20 75 20 66 6c 61 67 20 29 20 72 6f 74 ddr u flag ) rot
65b0: 20 3e 72 20 32 3e 72 20 63 3a 30 6b 65 79 0a 20 >r 2>r c:0key.
65c0: 20 20 20 73 69 67 6f 6e 6c 79 73 69 7a 65 23 20 sigonlysize#
65d0: 2d 20 32 64 75 70 20 32 72 3e 20 3e 6b 65 79 65 - 2dup 2r> >keye
65e0: 64 2d 68 61 73 68 0a 20 20 20 20 73 69 67 64 61 d-hash. sigda
65f0: 74 65 20 2b 64 61 74 65 0a 20 20 20 20 32 64 75 te +date. 2du
6600: 70 20 2b 20 72 3e 20 65 64 2d 76 65 72 69 66 79 p + r> ed-verify
6610: 20 3b 0a 0a 3a 20 3e 72 65 76 6f 6b 65 20 28 20 ;..: >revoke (
6620: 73 6b 72 65 76 20 2d 2d 20 29 20 20 73 6b 72 65 skrev -- ) skre
6630: 76 20 6b 65 79 6d 6f 76 65 20 20 70 6b 63 20 63 v keymove pkc c
6640: 68 65 63 6b 2d 72 65 76 3f 20 30 3d 20 21 21 6e heck-rev? 0= !!n
6650: 6f 74 2d 6d 79 2d 72 65 76 73 6b 21 21 20 3b 0a ot-my-revsk!! ;.
6660: 0a 3a 20 2b 72 65 76 73 69 67 6e 20 28 20 73 6b .: +revsign ( sk
6670: 20 70 6b 20 2d 2d 20 29 20 20 73 6b 73 69 67 20 pk -- ) sksig
6680: 2d 72 6f 74 20 65 64 2d 73 69 67 6e 20 72 65 76 -rot ed-sign rev
6690: 74 6f 6b 65 6e 20 24 2b 21 20 62 6c 20 72 65 76 token $+! bl rev
66a0: 74 6f 6b 65 6e 20 63 24 2b 21 20 3b 0a 0a 3a 20 token c$+! ;..:
66b0: 73 69 67 6e 2d 74 6f 6b 65 6e 2c 20 28 20 73 6b sign-token, ( sk
66c0: 20 70 6b 20 73 74 72 69 6e 67 20 75 32 20 2d 2d pk string u2 --
66d0: 20 29 0a 20 20 20 20 63 3a 30 6b 65 79 20 72 65 ). c:0key re
66e0: 76 74 6f 6b 65 6e 20 24 40 20 32 73 77 61 70 20 vtoken $@ 2swap
66f0: 3e 6b 65 79 65 64 2d 68 61 73 68 0a 20 20 20 20 >keyed-hash.
6700: 73 69 67 64 61 74 65 20 2b 64 61 74 65 20 2b 72 sigdate +date +r
6710: 65 76 73 69 67 6e 20 3b 0a 0a 3a 20 72 65 76 6f evsign ;..: revo
6720: 6b 65 2d 6b 65 79 20 28 20 2d 2d 20 61 64 64 72 ke-key ( -- addr
6730: 20 75 20 29 0a 20 20 20 20 73 6b 63 20 6f 6c 64 u ). skc old
6740: 73 6b 63 20 6b 65 79 6d 6f 76 65 20 20 70 6b 63 skc keymove pkc
6750: 20 6f 6c 64 70 6b 63 20 6b 65 79 6d 6f 76 65 20 oldpkc keymove
6760: 20 73 6b 72 65 76 20 6f 6c 64 73 6b 72 65 76 20 skrev oldskrev
6770: 6b 65 79 6d 6f 76 65 0a 20 20 20 20 20 20 20 20 keymove.
6780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
67a0: 20 20 20 5c 20 62 61 63 6b 75 70 20 6b 65 79 73 \ backup keys
67b0: 0a 20 20 20 20 6f 6c 64 73 6b 72 65 76 20 6f 6c . oldskrev ol
67c0: 64 70 6b 72 65 76 20 73 6b 3e 70 6b 20 20 20 20 dpkrev sk>pk
67d0: 20 20 20 20 20 20 20 20 20 20 20 20 5c 20 67 65 \ ge
67e0: 6e 65 72 61 74 65 20 72 65 76 6f 6b 61 74 69 6f nerate revokatio
67f0: 6e 20 70 75 62 6b 65 79 0a 20 20 20 20 67 65 6e n pubkey. gen
6800: 2d 6b 65 79 73 20 20 20 20 20 20 20 20 20 20 20 -keys
6810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6820: 20 20 20 20 5c 20 67 65 6e 65 72 61 74 65 20 6e \ generate n
6830: 65 77 20 6b 65 79 73 0a 20 20 20 20 70 6b 63 20 ew keys. pkc
6840: 6b 65 79 73 69 7a 65 32 20 72 65 76 74 6f 6b 65 keysize2 revtoke
6850: 6e 20 24 21 20 20 20 20 20 20 20 20 20 20 20 20 n $!
6860: 20 20 20 5c 20 6d 79 20 6e 65 77 20 6b 65 79 0a \ my new key.
6870: 20 20 20 20 6f 6c 64 70 6b 72 65 76 20 6b 65 79 oldpkrev key
6880: 73 69 7a 65 20 72 65 76 74 6f 6b 65 6e 20 24 2b size revtoken $+
6890: 21 20 20 20 20 20 20 20 20 20 20 5c 20 72 65 76 ! \ rev
68a0: 6f 6b 65 20 74 6f 6b 65 6e 0a 20 20 20 20 6f 6c oke token. ol
68b0: 64 73 6b 72 65 76 20 6f 6c 64 70 6b 72 65 76 20 dskrev oldpkrev
68c0: 22 72 65 76 6f 6b 65 22 20 73 69 67 6e 2d 74 6f "revoke" sign-to
68d0: 6b 65 6e 2c 20 5c 20 72 65 76 6f 6b 65 20 73 69 ken, \ revoke si
68e0: 67 6e 61 74 75 72 65 0a 20 20 20 20 73 6b 63 20 gnature. skc
68f0: 70 6b 63 20 22 73 65 6c 66 73 69 67 6e 22 20 73 pkc "selfsign" s
6900: 69 67 6e 2d 74 6f 6b 65 6e 2c 20 20 20 20 20 20 ign-token,
6910: 20 20 20 5c 20 73 65 6c 66 20 73 69 67 6e 65 64 \ self signed
6920: 20 77 69 74 68 20 6e 65 77 20 6b 65 79 0a 20 20 with new key.
6930: 20 20 22 21 22 20 72 65 76 74 6f 6b 65 6e 20 30 "!" revtoken 0
6940: 20 24 69 6e 73 20 20 20 20 20 20 20 20 20 20 20 $ins
6950: 20 20 20 20 20 20 20 20 20 5c 20 22 21 22 20 2b \ "!" +
6960: 20 6f 6c 64 6b 65 79 6c 65 6e 2b 6e 65 77 6b 65 oldkeylen+newke
6970: 79 6c 65 6e 20 74 6f 20 66 6c 61 67 20 72 65 76 ylen to flag rev
6980: 6f 6b 61 74 69 6f 6e 0a 20 20 20 20 72 65 76 74 okation. revt
6990: 6f 6b 65 6e 20 24 40 20 67 65 6e 3e 68 6f 73 74 oken $@ gen>host
69a0: 20 32 64 72 6f 70 20 20 20 20 20 20 20 20 20 20 2drop
69b0: 20 20 20 5c 20 73 69 67 6e 20 68 6f 73 74 20 69 \ sign host i
69c0: 6e 66 6f 72 6d 61 74 69 6f 6e 20 77 69 74 68 20 nformation with
69d0: 6f 6c 64 20 6b 65 79 0a 20 20 20 20 73 69 67 64 old key. sigd
69e0: 61 74 65 20 2b 64 61 74 65 20 73 69 67 64 61 74 ate +date sigdat
69f0: 65 20 64 61 74 65 73 69 7a 65 23 20 72 65 76 74 e datesize# revt
6a00: 6f 6b 65 6e 20 24 2b 21 0a 20 20 20 20 6f 6c 64 oken $+!. old
6a10: 73 6b 63 20 6f 6c 64 70 6b 63 20 2b 72 65 76 73 skc oldpkc +revs
6a20: 69 67 6e 0a 20 20 20 20 30 6f 6c 64 6b 65 79 20 ign. 0oldkey
6a30: 72 65 76 74 6f 6b 65 6e 20 24 40 20 3b 0a 0a 5c revtoken $@ ;..\
6a40: 20 69 6e 76 69 74 61 74 69 6f 6e 0a 0a 56 61 72 invitation..Var
6a50: 69 61 62 6c 65 20 69 6e 76 69 74 61 74 69 6f 6e iable invitation
6a60: 73 0a 0a 65 76 65 6e 74 3a 20 2d 3e 69 6e 76 69 s..event: ->invi
6a70: 74 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 te ( addr u -- )
6a80: 0a 20 20 20 20 2e 22 20 69 6e 76 69 74 65 20 6d . ." invite m
6a90: 65 3a 20 22 20 6f 76 65 72 20 3e 72 20 2e 70 6b e: " over >r .pk
6aa0: 32 6b 65 79 24 20 63 72 20 72 3e 20 66 72 65 65 2key$ cr r> free
6ab0: 20 74 68 72 6f 77 20 63 74 72 6c 20 4c 20 69 6e throw ctrl L in
6ac0: 73 6b 65 79 20 3b 0a 65 76 65 6e 74 3a 20 2d 3e skey ;.event: ->
6ad0: 77 61 6b 65 6d 65 20 28 20 6f 20 2d 2d 20 29 20 wakeme ( o -- )
6ae0: 3c 65 76 65 6e 74 20 2d 3e 77 61 6b 65 20 65 76 <event ->wake ev
6af0: 65 6e 74 3e 20 3b 0a 0a 3a 20 70 6b 32 6b 65 79 ent> ;..: pk2key
6b00: 24 2d 61 64 64 20 28 20 61 64 64 72 20 75 20 70 $-add ( addr u p
6b10: 65 72 6d 20 2d 2d 20 29 20 7b 20 70 65 72 6d 20 erm -- ) { perm
6b20: 7d 0a 20 20 20 20 73 61 6d 70 6c 65 2d 6b 65 79 }. sample-key
6b30: 20 3e 6f 20 69 6d 70 6f 72 74 23 69 6e 76 69 74 >o import#invit
6b40: 65 64 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 ed import-type !
6b50: 20 63 6d 64 3a 6e 65 73 74 73 69 67 0a 20 20 20 cmd:nestsig.
6b60: 20 70 65 72 6d 20 6b 65 2d 6d 61 73 6b 20 21 0a perm ke-mask !.
6b70: 20 20 20 20 69 6d 70 6f 72 74 23 75 6e 74 72 75 import#untru
6b80: 73 74 65 64 20 69 6d 70 6f 72 74 2d 74 79 70 65 sted import-type
6b90: 20 21 20 20 73 61 76 65 2d 70 75 62 6b 65 79 73 ! save-pubkeys
6ba0: 20 6f 3e 20 3b 0a 0a 3a 20 70 72 6f 63 65 73 73 o> ;..: process
6bb0: 2d 69 6e 76 69 74 61 74 69 6f 6e 20 28 20 61 64 -invitation ( ad
6bc0: 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 6b 65 dr u -- ). ke
6bd0: 79 20 63 61 73 65 0a 09 27 79 27 20 6f 66 20 20 y case..'y' of
6be0: 70 65 72 6d 25 64 65 66 61 75 6c 74 20 70 6b 32 perm%default pk2
6bf0: 6b 65 79 24 2d 61 64 64 20 20 2e 22 20 61 64 64 key$-add ." add
6c00: 65 64 22 20 63 72 20 20 20 65 6e 64 6f 66 0a 09 ed" cr endof..
6c10: 27 62 27 20 6f 66 20 20 70 65 72 6d 25 62 6c 6f 'b' of perm%blo
6c20: 63 6b 65 64 20 70 6b 32 6b 65 79 24 2d 61 64 64 cked pk2key$-add
6c30: 20 20 2e 22 20 62 6c 6f 63 6b 65 64 22 20 63 72 ." blocked" cr
6c40: 20 65 6e 64 6f 66 0a 09 32 64 72 6f 70 20 2e 22 endof..2drop ."
6c50: 20 69 67 6e 6f 72 65 64 22 20 63 72 0a 20 20 20 ignored" cr.
6c60: 20 65 6e 64 63 61 73 65 20 3b 0a 0a 3a 20 66 69 endcase ;..: fi
6c70: 6c 74 65 72 2d 69 6e 76 69 74 61 74 69 6f 6e 3f lter-invitation?
6c80: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 66 6c 61 ( addr u -- fla
6c90: 67 20 29 0a 20 20 20 20 73 69 67 70 6b 32 73 69 g ). sigpk2si
6ca0: 7a 65 23 20 2d 20 2b 20 6b 65 79 73 69 7a 65 20 ze# - + keysize
6cb0: 6b 65 79 2d 74 61 62 6c 65 20 23 40 20 64 30 3c key-table #@ d0<
6cc0: 3e 20 3b 20 5c 20 61 6c 72 65 61 64 79 20 74 68 > ; \ already th
6cd0: 65 72 65 0a 0a 3a 20 2e 69 6e 76 69 74 61 74 69 ere..: .invitati
6ce0: 6f 6e 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 69 ons ( -- ). i
6cf0: 6e 76 69 74 61 74 69 6f 6e 73 20 5b 3a 20 2e 22 nvitations [: ."
6d00: 20 69 6e 76 69 74 65 20 28 79 2f 6e 2f 62 29 3f invite (y/n/b)?
6d10: 20 22 20 32 64 75 70 20 2e 70 6b 32 6b 65 79 24 " 2dup .pk2key$
6d20: 20 70 72 6f 63 65 73 73 2d 69 6e 76 69 74 61 74 process-invitat
6d30: 69 6f 6e 0a 20 20 20 20 3b 5d 20 24 5b 5d 6d 61 ion. ;] $[]ma
6d40: 70 20 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 24 p invitations $
6d50: 5b 5d 6f 66 66 20 3b 0a 0a 3a 6e 6f 6e 61 6d 65 []off ;..:noname
6d60: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 ( addr u -- ).
6d70: 20 20 20 32 64 75 70 20 66 69 6c 74 65 72 2d 69 2dup filter-i
6d80: 6e 76 69 74 61 74 69 6f 6e 3f 20 49 46 20 20 32 nvitation? IF 2
6d90: 64 72 6f 70 20 45 58 49 54 20 20 54 48 45 4e 0a drop EXIT THEN.
6da0: 20 20 20 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 invitations
6db0: 24 5b 5d 23 20 3e 72 0a 20 20 20 20 32 64 75 70 $[]# >r. 2dup
6dc0: 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 24 69 6e invitations $in
6dd0: 73 5b 5d 73 69 67 0a 20 20 20 20 69 6e 76 69 74 s[]sig. invit
6de0: 61 74 69 6f 6e 73 20 24 5b 5d 23 20 72 3e 20 3c ations $[]# r> <
6df0: 3e 20 49 46 0a 09 73 61 76 65 2d 6d 65 6d 20 5b > IF..save-mem [
6e00: 20 75 70 40 20 5d 6c 20 3c 68 69 64 65 3e 0a 09 up@ ]l <hide>..
6e10: 3c 65 76 65 6e 74 20 65 24 2c 20 2d 3e 69 6e 76 <event e$, ->inv
6e20: 69 74 65 20 75 70 40 20 65 6c 69 74 2c 20 2d 3e ite up@ elit, ->
6e30: 77 61 6b 65 6d 65 20 5b 20 75 70 40 20 5d 6c 20 wakeme [ up@ ]l
6e40: 65 76 65 6e 74 3e 20 73 74 6f 70 0a 20 20 20 20 event> stop.
6e50: 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 45 ELSE 2drop THE
6e60: 4e 0a 3b 20 69 73 20 3e 69 6e 76 69 74 61 74 69 N.; is >invitati
6e70: 6f 6e 73 0a 3a 20 73 65 6e 64 2d 69 6e 76 69 74 ons.: send-invit
6e80: 61 74 69 6f 6e 20 28 20 70 6b 20 75 20 2d 2d 20 ation ( pk u --
6e90: 29 0a 20 20 20 20 73 65 74 75 70 21 20 6d 79 70 ). setup! myp
6ea0: 6b 32 6e 69 63 6b 24 20 32 3e 72 0a 20 20 20 20 k2nick$ 2>r.
6eb0: 67 65 6e 2d 74 6d 70 6b 65 79 73 20 64 72 6f 70 gen-tmpkeys drop
6ec0: 20 74 73 6b 63 20 73 77 61 70 20 6b 65 79 70 61 tskc swap keypa
6ed0: 64 20 65 64 2d 64 68 20 64 6f 2d 6b 65 79 70 61 d ed-dh do-keypa
6ee0: 64 20 73 65 63 21 0a 20 20 20 20 6e 65 74 32 6f d sec!. net2o
6ef0: 2d 63 6f 64 65 30 0a 20 20 20 20 74 70 6b 63 20 -code0. tpkc
6f00: 6b 65 79 73 69 7a 65 20 24 2c 20 6f 6e 65 73 68 keysize $, onesh
6f10: 6f 74 2d 74 6d 70 6b 65 79 0a 20 20 20 20 6e 65 ot-tmpkey. ne
6f20: 73 74 5b 20 32 72 3e 20 24 2c 20 69 6e 76 69 74 st[ 2r> $, invit
6f30: 65 20 5d 74 6d 70 6e 65 73 74 0a 20 20 20 20 63 e ]tmpnest. c
6f40: 6f 6f 6b 69 65 2b 72 65 71 75 65 73 74 0a 20 20 ookie+request.
6f50: 20 20 65 6e 64 2d 63 6f 64 65 7c 20 3b 0a 0a 5c end-code| ;..\
6f60: 20 6b 65 79 20 61 70 69 20 68 65 6c 70 65 72 73 key api helpers
6f70: 0a 0a 3a 20 64 65 6c 2d 6c 61 73 74 2d 6b 65 79 ..: del-last-key
6f80: 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 73 ( -- ). keys
6f90: 20 24 5b 5d 23 20 31 2d 20 6b 65 79 73 20 24 5b $[]# 1- keys $[
6fa0: 5d 20 73 65 63 2d 6f 66 66 0a 20 20 20 20 6b 65 ] sec-off. ke
6fb0: 79 73 20 24 40 6c 65 6e 20 63 65 6c 6c 2d 20 6b ys $@len cell- k
6fc0: 65 79 73 20 24 21 6c 65 6e 20 3b 0a 0a 3a 20 73 eys $!len ;..: s
6fd0: 74 6f 72 65 6b 65 79 21 20 28 20 2d 2d 20 29 0a torekey! ( -- ).
6fe0: 20 20 20 20 3e 73 65 63 6b 65 79 20 6b 65 79 73 >seckey keys
6ff0: 20 24 5b 5d 23 20 30 20 3f 44 4f 20 20 32 64 75 $[]# 0 ?DO 2du
7000: 70 20 49 20 6b 65 79 73 20 73 65 63 5b 5d 40 20 p I keys sec[]@
7010: 73 74 72 3d 20 49 46 0a 09 20 20 20 20 49 20 6b str= IF.. I k
7020: 65 79 73 20 73 65 63 5b 5d 40 20 64 72 6f 70 20 eys sec[]@ drop
7030: 3e 73 74 6f 72 65 6b 65 79 20 21 20 20 4c 45 41 >storekey ! LEA
7040: 56 45 20 20 54 48 45 4e 20 20 4c 4f 4f 50 20 20 VE THEN LOOP
7050: 32 64 72 6f 70 20 3b 0a 0a 3a 20 63 68 6f 6f 73 2drop ;..: choos
7060: 65 2d 6b 65 79 20 28 20 2d 2d 20 6f 20 29 0a 20 e-key ( -- o ).
7070: 20 20 20 30 20 42 45 47 49 4e 20 20 64 72 6f 70 0 BEGIN drop
7080: 0a 09 2e 22 20 43 68 6f 6f 73 65 20 6b 65 79 20 ..." Choose key
7090: 62 79 20 6e 75 6d 62 65 72 3a 22 20 63 72 20 2e by number:" cr .
70a0: 73 65 63 72 65 74 2d 6e 69 63 6b 73 0a 09 42 45 secret-nicks..BE
70b0: 47 49 4e 20 20 6b 65 79 20 64 75 70 20 62 6c 20 GIN key dup bl
70c0: 3c 20 57 48 49 4c 45 20 20 64 72 6f 70 20 20 52 < WHILE drop R
70d0: 45 50 45 41 54 20 5c 20 73 77 61 6c 6c 6f 77 20 EPEAT \ swallow
70e0: 63 6f 6e 74 72 6f 6c 20 6b 65 79 73 0a 09 5b 27 control keys..['
70f0: 5d 20 64 69 67 69 74 3f 20 23 33 36 20 62 61 73 ] digit? #36 bas
7100: 65 2d 65 78 65 63 75 74 65 20 30 3d 20 49 46 20 e-execute 0= IF
7110: 2d 31 20 54 48 45 4e 0a 09 73 65 63 72 65 74 2d -1 THEN..secret-
7120: 6b 65 79 20 64 75 70 20 30 3d 20 57 48 49 4c 45 key dup 0= WHILE
7130: 0a 09 20 20 20 20 2e 22 20 50 6c 65 61 73 65 20 .. ." Please
7140: 65 6e 74 65 72 20 61 20 62 61 73 65 2d 33 36 20 enter a base-36
7150: 6e 75 6d 62 65 72 20 62 65 74 77 65 65 6e 20 30 number between 0
7160: 20 61 6e 64 20 22 0a 09 20 20 20 20 73 65 63 72 and ".. secr
7170: 65 74 2d 6b 65 79 73 23 20 31 2d 20 5b 27 5d 20 et-keys# 1- [']
7180: 2e 20 23 33 36 20 62 61 73 65 2d 65 78 65 63 75 . #36 base-execu
7190: 74 65 20 63 72 20 20 72 64 72 6f 70 0a 20 20 20 te cr rdrop.
71a0: 20 52 45 50 45 41 54 0a 20 20 20 20 64 75 70 20 REPEAT. dup
71b0: 2e 73 74 6f 72 65 6b 65 79 21 20 20 3e 73 74 6f .storekey! >sto
71c0: 72 65 6b 65 79 20 40 20 64 65 66 61 75 6c 74 6b rekey @ defaultk
71d0: 65 79 20 21 0a 20 20 20 20 2e 22 20 3d 3d 3d 3d ey !. ." ====
71e0: 20 6b 65 79 20 22 20 64 75 70 20 2e 2e 6e 69 63 key " dup ..nic
71f0: 6b 20 2e 22 20 20 63 68 6f 73 65 6e 20 3d 3d 3d k ." chosen ===
7200: 3d 22 20 63 72 20 3b 0a 0a 5c 20 77 69 6c 6c 20 =" cr ;..\ will
7210: 61 73 6b 20 66 6f 72 20 79 6f 75 72 20 70 61 73 ask for your pas
7220: 73 77 6f 72 64 20 61 6e 64 20 69 66 20 70 6f 73 sword and if pos
7230: 73 69 62 6c 65 20 61 75 74 6f 2d 73 65 6c 65 63 sible auto-selec
7240: 74 20 79 6f 75 72 20 69 64 0a 0a 3a 20 67 65 74 t your id..: get
7250: 2d 73 6b 63 20 28 20 2d 2d 20 29 0a 20 20 20 20 -skc ( -- ).
7260: 73 65 63 72 65 74 2d 6b 65 79 73 23 20 3f 45 58 secret-keys# ?EX
7270: 49 54 0a 20 20 20 20 64 65 62 75 67 2d 76 65 63 IT. debug-vec
7280: 74 6f 72 20 40 20 6f 70 2d 76 65 63 74 6f 72 20 tor @ op-vector
7290: 21 40 20 3e 72 20 3c 64 65 66 61 75 6c 74 3e 0a !@ >r <default>.
72a0: 20 20 20 20 73 65 63 72 65 74 2d 6b 65 79 73 23 secret-keys#
72b0: 0a 20 20 20 20 42 45 47 49 4e 20 20 64 75 70 20 . BEGIN dup
72c0: 30 3d 20 57 48 49 4c 45 20 64 72 6f 70 0a 09 20 0= WHILE drop..
72d0: 20 20 20 2e 22 20 50 61 73 73 70 68 72 61 73 65 ." Passphrase
72e0: 3a 20 22 20 2b 70 61 73 73 70 68 72 61 73 65 20 : " +passphrase
72f0: 20 20 21 74 69 6d 65 0a 09 20 20 20 20 72 65 61 !time.. rea
7300: 64 2d 6b 65 79 73 20 73 65 63 72 65 74 2d 6b 65 d-keys secret-ke
7310: 79 73 23 20 64 75 70 20 30 3d 20 49 46 0a 09 09 ys# dup 0= IF...
7320: 2e 22 20 20 77 72 6f 6e 67 20 70 61 73 73 70 68 ." wrong passph
7330: 72 61 73 65 2c 20 6e 6f 20 6b 65 79 20 66 6f 75 rase, no key fou
7340: 6e 64 22 20 64 65 6c 2d 6c 61 73 74 2d 6b 65 79 nd" del-last-key
7350: 0a 09 20 20 20 20 54 48 45 4e 20 20 63 72 0a 20 .. THEN cr.
7360: 20 20 20 52 45 50 45 41 54 0a 20 20 20 20 31 20 REPEAT. 1
7370: 3d 20 49 46 20 20 30 20 73 65 63 72 65 74 2d 6b = IF 0 secret-k
7380: 65 79 0a 09 2e 22 20 3d 3d 3d 3d 20 6f 70 65 6e ey..." ==== open
7390: 65 64 3a 20 22 20 64 75 70 20 2e 2e 6e 69 63 6b ed: " dup ..nick
73a0: 20 2e 22 20 20 69 6e 20 22 20 2e 74 69 6d 65 20 ." in " .time
73b0: 2e 22 20 3d 3d 3d 3d 22 20 63 72 0a 20 20 20 20 ." ====" cr.
73c0: 45 4c 53 45 20 20 2e 22 20 3d 3d 3d 3d 20 6f 70 ELSE ." ==== op
73d0: 65 6e 65 64 20 69 6e 20 22 20 2e 74 69 6d 65 20 ened in " .time
73e0: 2e 22 20 3d 3d 3d 3d 22 20 63 72 20 63 68 6f 6f ." ====" cr choo
73f0: 73 65 2d 6b 65 79 20 20 54 48 45 4e 0a 20 20 20 se-key THEN.
7400: 20 3e 72 61 77 2d 6b 65 79 20 3f 72 73 6b 20 20 >raw-key ?rsk
7410: 20 72 3e 20 6f 70 2d 76 65 63 74 6f 72 20 21 20 r> op-vector !
7420: 3b 0a 0a 3a 20 67 65 74 2d 6d 65 20 28 20 2d 2d ;..: get-me ( --
7430: 20 29 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 2d ). gen-keys-
7440: 64 69 72 20 20 22 73 65 63 6b 65 79 73 2e 6b 32 dir "seckeys.k2
7450: 6f 22 20 2e 6b 65 79 73 2f 20 32 64 75 70 20 66 o" .keys/ 2dup f
7460: 69 6c 65 2d 73 74 61 74 75 73 20 6e 69 70 0a 20 ile-status nip.
7470: 20 20 20 30 3d 20 49 46 20 20 72 2f 6f 20 6f 70 0= IF r/o op
7480: 65 6e 2d 66 69 6c 65 20 74 68 72 6f 77 20 3e 72 en-file throw >r
7490: 20 72 40 20 66 69 6c 65 2d 73 69 7a 65 20 74 68 r@ file-size th
74a0: 72 6f 77 20 64 30 3d 0a 09 72 3e 20 63 6c 6f 73 row d0=..r> clos
74b0: 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 20 45 4c e-file throw EL
74c0: 53 45 20 20 74 72 75 65 20 20 54 48 45 4e 0a 20 SE true THEN.
74d0: 20 20 20 49 46 20 20 5b 3a 20 2e 22 20 47 65 6e IF [: ." Gen
74e0: 65 72 61 74 65 20 61 20 6e 65 77 20 6b 65 79 70 erate a new keyp
74f0: 61 69 72 3a 22 20 63 72 0a 09 20 20 67 65 74 2d air:" cr.. get-
7500: 6e 69 63 6b 20 6e 65 77 2d 6b 65 79 20 2e 6b 65 nick new-key .ke
7510: 79 73 20 3f 72 73 6b 20 3b 5d 0a 20 20 20 20 45 ys ?rsk ;]. E
7520: 4c 53 45 20 20 5b 27 5d 20 67 65 74 2d 73 6b 63 LSE ['] get-skc
7530: 20 20 54 48 45 4e 0a 20 20 20 20 63 61 74 63 68 THEN. catch
7540: 20 3f 64 75 70 2d 49 46 20 20 44 6f 45 72 72 6f ?dup-IF DoErro
7550: 72 20 20 54 48 45 4e 20 3b 0a 0a 30 20 5b 49 46 r THEN ;..0 [IF
7560: 5d 0a 4c 6f 63 61 6c 20 56 61 72 69 61 62 6c 65 ].Local Variable
7570: 73 3a 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 77 s:.forth-local-w
7580: 6f 72 64 73 3a 0a 20 20 20 20 28 0a 20 20 20 20 ords:. (.
7590: 20 28 28 22 6e 65 74 32 6f 3a 22 20 22 2b 6e 65 (("net2o:" "+ne
75a0: 74 32 6f 3a 22 29 20 64 65 66 69 6e 69 74 69 6f t2o:") definitio
75b0: 6e 2d 73 74 61 72 74 65 72 20 28 66 6f 6e 74 2d n-starter (font-
75c0: 6c 6f 63 6b 2d 6b 65 79 77 6f 72 64 2d 66 61 63 lock-keyword-fac
75d0: 65 20 2e 20 31 29 0a 20 20 20 20 20 20 22 5b 20 e . 1). "[
75e0: 5c 74 5c 6e 5d 22 20 74 20 6e 61 6d 65 20 28 66 \t\n]" t name (f
75f0: 6f 6e 74 2d 6c 6f 63 6b 2d 66 75 6e 63 74 69 6f ont-lock-functio
7600: 6e 2d 6e 61 6d 65 2d 66 61 63 65 20 2e 20 33 29 n-name-face . 3)
7610: 29 0a 20 20 20 20 20 28 28 22 64 65 62 75 67 3a ). (("debug:
7620: 22 20 22 66 69 65 6c 64 3a 22 20 22 32 66 69 65 " "field:" "2fie
7630: 6c 64 3a 22 20 22 73 66 66 69 65 6c 64 3a 22 20 ld:" "sffield:"
7640: 22 64 66 66 69 65 6c 64 3a 22 20 22 36 34 66 69 "dffield:" "64fi
7650: 65 6c 64 3a 22 20 22 75 76 61 72 22 20 22 75 76 eld:" "uvar" "uv
7660: 61 6c 75 65 22 29 20 6e 6f 6e 2d 69 6d 6d 65 64 alue") non-immed
7670: 69 61 74 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d iate (font-lock-
7680: 74 79 70 65 2d 66 61 63 65 20 2e 20 32 29 0a 20 type-face . 2).
7690: 20 20 20 20 20 22 5b 20 5c 74 5c 6e 5d 22 20 74 "[ \t\n]" t
76a0: 20 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b name (font-lock
76b0: 2d 76 61 72 69 61 62 6c 65 2d 6e 61 6d 65 2d 66 -variable-name-f
76c0: 61 63 65 20 2e 20 33 29 29 0a 20 20 20 20 20 28 ace . 3)). (
76d0: 22 5b 61 2d 7a 30 2d 39 5d 2b 28 22 20 69 6d 6d "[a-z0-9]+(" imm
76e0: 65 64 69 61 74 65 20 28 66 6f 6e 74 2d 6c 6f 63 ediate (font-loc
76f0: 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 65 20 2e k-comment-face .
7700: 20 31 29 0a 20 20 20 20 20 20 22 29 22 20 6e 69 1). ")" ni
7710: 6c 20 63 6f 6d 6d 65 6e 74 20 28 66 6f 6e 74 2d l comment (font-
7720: 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 lock-comment-fac
7730: 65 20 2e 20 31 29 29 0a 20 20 20 20 29 0a 66 6f e . 1)). ).fo
7740: 72 74 68 2d 6c 6f 63 61 6c 2d 69 6e 64 65 6e 74 rth-local-indent
7750: 2d 77 6f 72 64 73 3a 0a 20 20 20 20 28 0a 20 20 -words:. (.
7760: 20 20 20 28 28 22 6e 65 74 32 6f 3a 22 20 22 2b (("net2o:" "+
7770: 6e 65 74 32 6f 3a 22 29 20 28 30 20 2e 20 32 29 net2o:") (0 . 2)
7780: 20 28 30 20 2e 20 32 29 20 6e 6f 6e 2d 69 6d 6d (0 . 2) non-imm
7790: 65 64 69 61 74 65 29 0a 20 20 20 20 20 28 28 22 ediate). (("
77a0: 5b 3a 22 20 22 6b 65 79 3a 63 6f 64 65 22 29 20 [:" "key:code")
77b0: 28 30 20 2e 20 31 29 20 28 30 20 2e 20 31 29 20 (0 . 1) (0 . 1)
77c0: 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 20 immediate).
77d0: 28 28 22 3b 5d 22 20 22 65 6e 64 3a 6b 65 79 22 ((";]" "end:key"
77e0: 29 20 28 2d 31 20 2e 20 30 29 20 28 30 20 2e 20 ) (-1 . 0) (0 .
77f0: 2d 31 29 20 69 6d 6d 65 64 69 61 74 65 29 0a 20 -1) immediate).
7800: 20 20 20 29 0a 45 6e 64 3a 0a 5b 54 48 45 4e 5d ).End:.[THEN]