0000: 5c 20 6e 65 74 32 6f 20 6b 65 79 20 73 74 6f 72 \ net2o key stor
0010: 61 67 65 0a 0a 5c 20 43 6f 70 79 72 69 67 68 74 age..\ Copyright
0020: 20 28 43 29 20 32 30 31 33 2d 32 30 31 35 20 20 (C) 2013-2015
0030: 20 42 65 72 6e 64 20 50 61 79 73 61 6e 0a 0a 5c Bernd Paysan..\
0040: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0050: 20 66 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 free software:
0060: 79 6f 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 you can redistri
0070: 62 75 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d bute it and/or m
0080: 6f 64 69 66 79 0a 5c 20 69 74 20 75 6e 64 65 72 odify.\ it under
0090: 20 74 68 65 20 74 65 72 6d 73 20 6f 66 20 74 68 the terms of th
00a0: 65 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e e GNU Affero Gen
00b0: 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 eral Public Lice
00c0: 6e 73 65 20 61 73 20 70 75 62 6c 69 73 68 65 64 nse as published
00d0: 20 62 79 0a 5c 20 74 68 65 20 46 72 65 65 20 53 by.\ the Free S
00e0: 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 69 oftware Foundati
00f0: 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 69 on, either versi
0100: 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 65 on 3 of the Lice
0110: 6e 73 65 2c 20 6f 72 0a 5c 20 28 61 74 20 79 6f nse, or.\ (at yo
0120: 75 72 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c ur option) any l
0130: 61 74 65 72 20 76 65 72 73 69 6f 6e 2e 0a 0a 5c ater version...\
0140: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0150: 20 64 69 73 74 72 69 62 75 74 65 64 20 69 6e 20 distributed in
0160: 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 69 74 the hope that it
0170: 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 6c 2c will be useful,
0180: 0a 5c 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 .\ but WITHOUT A
0190: 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 NY WARRANTY; wit
01a0: 68 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d hout even the im
01b0: 70 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f plied warranty o
01c0: 66 0a 5c 20 4d 45 52 43 48 41 4e 54 41 42 49 4c f.\ MERCHANTABIL
01d0: 49 54 59 20 6f 72 20 46 49 54 4e 45 53 53 20 46 ITY or FITNESS F
01e0: 4f 52 20 41 20 50 41 52 54 49 43 55 4c 41 52 20 OR A PARTICULAR
01f0: 50 55 52 50 4f 53 45 2e 20 20 53 65 65 20 74 68 PURPOSE. See th
0200: 65 0a 5c 20 47 4e 55 20 41 66 66 65 72 6f 20 47 e.\ GNU Affero G
0210: 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 eneral Public Li
0220: 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 20 64 cense for more d
0230: 65 74 61 69 6c 73 2e 0a 0a 5c 20 59 6f 75 20 73 etails...\ You s
0240: 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 65 69 hould have recei
0250: 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 74 68 ved a copy of th
0260: 65 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e e GNU Affero Gen
0270: 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 eral Public Lice
0280: 6e 73 65 0a 5c 20 61 6c 6f 6e 67 20 77 69 74 68 nse.\ along with
0290: 20 74 68 69 73 20 70 72 6f 67 72 61 6d 2e 20 20 this program.
02a0: 49 66 20 6e 6f 74 2c 20 73 65 65 20 3c 68 74 74 If not, see <htt
02b0: 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 2f p://www.gnu.org/
02c0: 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a 0a 72 65 71 licenses/>...req
02d0: 75 69 72 65 20 6d 6b 64 69 72 2e 66 73 0a 0a 5c uire mkdir.fs..\
02e0: 20 61 63 63 65 70 74 20 66 6f 72 20 70 61 73 73 accept for pass
02f0: 77 6f 72 64 20 65 6e 74 72 79 0a 0a 73 63 6f 70 word entry..scop
0300: 65 7b 20 63 6f 6e 66 69 67 0a 56 61 72 69 61 62 e{ config.Variab
0310: 6c 65 20 70 77 2d 6c 65 76 65 6c 23 20 32 20 70 le pw-level# 2 p
0320: 77 2d 6c 65 76 65 6c 23 20 21 20 5c 20 70 77 2d w-level# ! \ pw-
0330: 6c 65 76 65 6c 23 20 30 20 69 73 20 6c 6f 77 65 level# 0 is lowe
0340: 73 74 0a 56 61 72 69 61 62 6c 65 20 70 77 2d 6d st.Variable pw-m
0350: 61 78 6c 65 76 65 6c 23 20 34 20 70 77 2d 6d 61 axlevel# 4 pw-ma
0360: 78 6c 65 76 65 6c 23 20 21 20 5c 20 70 77 2d 6d xlevel# ! \ pw-m
0370: 61 78 6c 65 76 65 6c 23 20 69 73 20 74 68 65 20 axlevel# is the
0380: 6d 61 78 69 6d 75 6d 20 63 68 65 63 6b 65 64 0a maximum checked.
0390: 7d 73 63 6f 70 65 0a 0a 5c 20 4b 65 79 73 20 61 }scope..\ Keys a
03a0: 72 65 20 70 61 73 73 77 6f 72 64 73 20 61 6e 64 re passwords and
03b0: 20 70 72 69 76 61 74 65 20 6b 65 79 73 20 28 73 private keys (s
03c0: 65 6c 66 2d 6b 65 79 65 64 2c 20 69 2e 65 2e 20 elf-keyed, i.e.
03d0: 70 72 69 76 61 74 65 2a 70 75 62 6c 69 63 20 6b private*public k
03e0: 65 79 29 0a 0a 63 6d 64 2d 62 75 66 30 20 75 63 ey)..cmd-buf0 uc
03f0: 6c 61 73 73 20 63 6d 64 62 75 66 2d 6f 0a 20 20 lass cmdbuf-o.
0400: 20 20 6d 61 78 64 61 74 61 20 2d 0a 20 20 20 20 maxdata -.
0410: 6b 65 79 2d 73 61 6c 74 23 20 75 76 61 72 20 6b key-salt# uvar k
0420: 65 79 70 61 63 6b 0a 20 20 20 20 6b 65 79 70 61 eypack. keypa
0430: 63 6b 23 20 20 75 76 61 72 20 6b 65 79 70 61 63 ck# uvar keypac
0440: 6b 2d 62 75 66 0a 20 20 20 20 6b 65 79 2d 63 6b k-buf. key-ck
0450: 73 75 6d 23 20 75 76 61 72 20 6b 65 79 70 61 63 sum# uvar keypac
0460: 6b 2d 63 68 6b 73 75 6d 0a 65 6e 64 2d 63 6c 61 k-chksum.end-cla
0470: 73 73 20 63 6d 64 2d 6b 65 79 62 75 66 2d 63 0a ss cmd-keybuf-c.
0480: 0a 63 6d 64 2d 6b 65 79 62 75 66 2d 63 20 27 20 .cmd-keybuf-c '
0490: 6e 65 77 20 73 74 61 74 69 63 2d 61 20 77 69 74 new static-a wit
04a0: 68 2d 61 6c 6c 6f 63 61 74 65 72 20 63 6f 64 65 h-allocater code
04b0: 2d 6b 65 79 5e 20 21 0a 27 20 63 6f 64 65 2d 6b -key^ !.' code-k
04c0: 65 79 5e 20 63 6d 64 62 75 66 3a 20 63 6f 64 65 ey^ cmdbuf: code
04d0: 2d 6b 65 79 0a 0a 63 6f 64 65 2d 6b 65 79 0a 63 -key..code-key.c
04e0: 6d 64 30 6c 6f 63 6b 20 30 20 70 74 68 72 65 61 md0lock 0 pthrea
04f0: 64 5f 6d 75 74 65 78 5f 69 6e 69 74 20 64 72 6f d_mutex_init dro
0500: 70 0a 0a 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d 20 p..:noname ( --
0510: 61 64 64 72 20 75 20 29 20 6b 65 79 70 61 63 6b addr u ) keypack
0520: 2d 62 75 66 20 63 6d 64 62 75 66 23 20 40 20 3b -buf cmdbuf# @ ;
0530: 20 74 6f 20 63 6d 64 62 75 66 24 0a 3a 6e 6f 6e to cmdbuf$.:non
0540: 61 6d 65 20 28 20 2d 2d 20 6e 20 29 20 20 6b 65 ame ( -- n ) ke
0550: 79 70 61 63 6b 23 20 63 6d 64 62 75 66 23 20 40 ypack# cmdbuf# @
0560: 20 2d 20 3b 20 74 6f 20 6d 61 78 73 74 72 69 6e - ; to maxstrin
0570: 67 0a 0a 63 6f 64 65 30 2d 62 75 66 0a 0a 3a 6e g..code0-buf..:n
0580: 6f 6e 61 6d 65 20 64 65 66 65 72 73 20 61 6c 6c oname defers all
0590: 6f 63 2d 63 6f 64 65 2d 62 75 66 73 0a 20 20 20 oc-code-bufs.
05a0: 20 63 6d 64 2d 6b 65 79 62 75 66 2d 63 20 6e 65 cmd-keybuf-c ne
05b0: 77 20 63 6f 64 65 2d 6b 65 79 5e 20 21 20 3b 20 w code-key^ ! ;
05c0: 69 73 20 61 6c 6c 6f 63 2d 63 6f 64 65 2d 62 75 is alloc-code-bu
05d0: 66 73 0a 3a 6e 6f 6e 61 6d 65 20 64 65 66 65 72 fs.:noname defer
05e0: 73 20 66 72 65 65 2d 63 6f 64 65 2d 62 75 66 73 s free-code-bufs
05f0: 0a 20 20 20 20 63 6f 64 65 2d 6b 65 79 5e 20 40 . code-key^ @
0600: 20 2e 64 69 73 70 6f 73 65 20 3b 20 69 73 20 66 .dispose ; is f
0610: 72 65 65 2d 63 6f 64 65 2d 62 75 66 73 0a 0a 5c ree-code-bufs..\
0620: 20 68 61 73 68 65 64 20 6b 65 79 20 64 61 74 61 hashed key data
0630: 20 62 61 73 65 0a 0a 56 61 72 69 61 62 6c 65 20 base..Variable
0640: 67 72 6f 75 70 73 5b 5d 20 5c 20 6e 61 6d 65 73 groups[] \ names
0650: 20 6f 66 20 67 72 6f 75 70 73 2c 20 73 6f 72 74 of groups, sort
0660: 65 64 20 62 79 20 6f 72 64 65 72 20 69 6e 20 67 ed by order in g
0670: 72 6f 75 70 73 20 66 69 6c 65 0a 0a 55 73 65 72 roups file..User
0680: 20 3e 73 74 6f 72 65 6b 65 79 0a 56 61 72 69 61 >storekey.Varia
0690: 62 6c 65 20 64 65 66 61 75 6c 74 6b 65 79 0a 0a ble defaultkey..
06a0: 3a 20 66 72 65 65 2d 6b 65 79 20 28 20 6f 3a 6b : free-key ( o:k
06b0: 65 79 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 20 ey -- o:key ).
06c0: 20 20 5c 67 20 66 72 65 65 20 61 6c 6c 20 70 61 \g free all pa
06d0: 72 74 73 20 6f 66 20 74 68 65 20 73 75 62 6b 65 rts of the subke
06e0: 79 0a 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 2d y. ke-sk sec-
06f0: 66 72 65 65 0a 20 20 20 20 6b 65 2d 73 6b 73 69 free. ke-sksi
0700: 67 20 73 65 63 2d 66 72 65 65 0a 20 20 20 20 6b g sec-free. k
0710: 65 2d 70 6b 20 24 66 72 65 65 0a 20 20 20 20 6b e-pk $free. k
0720: 65 2d 6e 69 63 6b 20 24 66 72 65 65 0a 20 20 20 e-nick $free.
0730: 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 66 72 65 ke-selfsig $fre
0740: 65 0a 20 20 20 20 6b 65 2d 63 68 61 74 20 24 66 e. ke-chat $f
0750: 72 65 65 0a 20 20 20 20 6b 65 2d 73 69 67 73 5b ree. ke-sigs[
0760: 5d 20 24 5b 5d 66 72 65 65 0a 20 20 20 20 6b 65 ] $[]free. ke
0770: 2d 70 65 74 73 5b 5d 20 24 5b 5d 66 72 65 65 0a -pets[] $[]free.
0780: 20 20 20 20 6b 65 2d 70 65 74 73 23 20 24 66 72 ke-pets# $fr
0790: 65 65 0a 20 20 20 20 6b 65 2d 61 76 61 74 61 72 ee. ke-avatar
07a0: 20 24 66 72 65 65 20 3b 0a 0a 5c 20 6b 65 79 20 $free ;..\ key
07b0: 63 6c 61 73 73 0a 0a 30 0a 65 6e 75 6d 20 6b 65 class..0.enum ke
07c0: 79 23 61 6e 6f 6e 0a 65 6e 75 6d 20 6b 65 79 23 y#anon.enum key#
07d0: 75 73 65 72 0a 65 6e 75 6d 20 6b 65 79 23 67 72 user.enum key#gr
07e0: 6f 75 70 0a 64 72 6f 70 0a 0a 5c 20 6b 65 79 20 oup.drop..\ key
07f0: 69 6d 70 6f 72 74 20 74 79 70 65 0a 0a 30 0a 65 import type..0.e
0800: 6e 75 6d 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 num import#self
0810: 20 20 20 20 20 20 20 5c 20 70 72 69 76 61 74 65 \ private
0820: 20 6b 65 79 0a 65 6e 75 6d 20 69 6d 70 6f 72 74 key.enum import
0830: 23 6d 61 6e 75 61 6c 20 20 20 20 20 20 5c 20 6d #manual \ m
0840: 61 6e 75 61 6c 20 69 6d 70 6f 72 74 0a 65 6e 75 anual import.enu
0850: 6d 20 69 6d 70 6f 72 74 23 73 63 61 6e 20 20 20 m import#scan
0860: 20 20 20 20 20 5c 20 73 63 61 6e 20 69 6d 70 6f \ scan impo
0870: 72 74 0a 65 6e 75 6d 20 69 6d 70 6f 72 74 23 63 rt.enum import#c
0880: 68 61 74 20 20 20 20 20 20 20 20 5c 20 73 65 65 hat \ see
0890: 6e 20 69 6e 20 63 68 61 74 0a 65 6e 75 6d 20 69 n in chat.enum i
08a0: 6d 70 6f 72 74 23 64 68 74 20 20 20 20 20 20 20 mport#dht
08b0: 20 20 5c 20 64 68 74 20 69 6d 70 6f 72 74 0a 65 \ dht import.e
08c0: 6e 75 6d 20 69 6d 70 6f 72 74 23 69 6e 76 69 74 num import#invit
08d0: 65 64 20 20 20 20 20 5c 20 69 6e 76 69 74 61 74 ed \ invitat
08e0: 69 6f 6e 20 69 6d 70 6f 72 74 0a 65 6e 75 6d 20 ion import.enum
08f0: 69 6d 70 6f 72 74 23 70 72 6f 76 69 73 69 6f 6e import#provision
0900: 61 6c 20 5c 20 70 72 6f 76 69 73 69 6f 6e 61 6c al \ provisional
0910: 20 6b 65 79 0a 65 6e 75 6d 20 69 6d 70 6f 72 74 key.enum import
0920: 23 75 6e 74 72 75 73 74 65 64 20 20 20 5c 20 6d #untrusted \ m
0930: 75 73 74 20 62 65 20 6c 61 73 74 0a 64 72 6f 70 ust be last.drop
0940: 0a 24 31 46 20 65 6e 75 6d 20 69 6d 70 6f 72 74 .$1F enum import
0950: 23 6e 65 77 20 20 20 5c 20 6e 65 77 20 66 6f 72 #new \ new for
0960: 6d 61 74 0a 64 72 6f 70 0a 0a 43 72 65 61 74 65 mat.drop..Create
0970: 20 69 6d 70 6f 72 74 73 24 20 24 32 30 20 61 6c imports$ $20 al
0980: 6c 6f 74 20 69 6d 70 6f 72 74 73 24 20 24 32 30 lot imports$ $20
0990: 20 62 6c 20 66 69 6c 6c 0a 22 49 6d 73 63 64 69 bl fill."Imscdi
09a0: 70 75 22 20 69 6d 70 6f 72 74 73 24 20 73 77 61 pu" imports$ swa
09b0: 70 20 6d 6f 76 65 0a 0a 56 61 72 69 61 62 6c 65 p move..Variable
09c0: 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 20 69 6d import-type im
09d0: 70 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d port#new import-
09e0: 74 79 70 65 20 21 0a 0a 3a 20 3e 69 6d 2d 63 6f type !..: >im-co
09f0: 6c 6f 72 23 20 28 20 6d 61 73 6b 20 2d 2d 20 63 lor# ( mask -- c
0a00: 6f 6c 6f 72 23 20 29 0a 20 20 20 20 38 20 63 65 olor# ). 8 ce
0a10: 6c 6c 73 20 30 20 44 4f 20 20 64 75 70 20 31 20 lls 0 DO dup 1
0a20: 61 6e 64 20 49 46 20 20 64 72 6f 70 20 49 20 4c and IF drop I L
0a30: 45 41 56 45 20 20 54 48 45 4e 20 20 32 2f 20 20 EAVE THEN 2/
0a40: 4c 4f 4f 50 20 3b 0a 0a 43 72 65 61 74 65 20 3e LOOP ;..Create >
0a50: 69 6d 2d 63 6f 6c 6f 72 20 20 24 42 36 30 30 20 im-color $B600
0a60: 2c 20 24 44 36 30 30 20 2c 20 24 39 36 30 30 20 , $D600 , $9600
0a70: 2c 20 24 43 36 30 30 20 2c 20 24 41 36 30 30 20 , $C600 , $A600
0a80: 2c 20 24 38 42 30 31 20 2c 20 24 38 43 30 31 20 , $8B01 , $8C01
0a90: 2c 20 24 45 36 30 30 20 2c 0a 44 4f 45 53 3e 20 , $E600 ,.DOES>
0aa0: 73 77 61 70 20 3e 69 6d 2d 63 6f 6c 6f 72 23 20 swap >im-color#
0ab0: 37 20 75 6d 69 6e 20 63 65 6c 6c 73 20 2b 20 40 7 umin cells + @
0ac0: 20 61 74 74 72 21 20 3b 0a 0a 3a 20 2e 69 6d 70 attr! ;..: .imp
0ad0: 6f 72 74 73 20 28 20 6d 61 73 6b 20 2d 2d 20 29 orts ( mask -- )
0ae0: 0a 20 20 20 20 69 6d 70 6f 72 74 73 24 20 69 6d . imports$ im
0af0: 70 6f 72 74 23 6e 65 77 20 62 6f 75 6e 64 73 20 port#new bounds
0b00: 44 4f 0a 09 31 20 49 20 69 6d 70 6f 72 74 73 24 DO..1 I imports$
0b10: 20 2d 20 6c 73 68 69 66 74 20 3e 69 6d 2d 63 6f - lshift >im-co
0b20: 6c 6f 72 0a 09 64 75 70 20 31 20 61 6e 64 20 49 lor..dup 1 and I
0b30: 46 20 20 49 20 63 40 20 65 6d 69 74 20 20 54 48 F I c@ emit TH
0b40: 45 4e 20 20 32 2f 20 4c 4f 4f 50 0a 20 20 20 20 EN 2/ LOOP.
0b50: 64 72 6f 70 20 3c 64 65 66 61 75 6c 74 3e 20 3b drop <default> ;
0b60: 0a 0a 43 72 65 61 74 65 20 69 6d 70 6f 72 74 2d ..Create import-
0b70: 6e 61 6d 65 24 0a 22 49 20 6d 79 73 65 6c 66 22 name$."I myself"
0b80: 20 73 2c 20 22 6d 61 6e 75 61 6c 22 20 73 2c 20 s, "manual" s,
0b90: 22 73 63 61 6e 22 20 73 2c 20 22 63 68 61 74 22 "scan" s, "chat"
0ba0: 20 73 2c 20 22 64 68 74 22 20 73 2c 20 22 69 6e s, "dht" s, "in
0bb0: 76 69 74 65 64 22 20 73 2c 20 22 70 72 6f 76 69 vited" s, "provi
0bc0: 73 69 6f 6e 61 6c 22 20 73 2c 20 22 75 6e 74 72 sional" s, "untr
0bd0: 75 73 74 65 64 22 20 73 2c 0a 0a 3a 20 2e 69 6d usted" s,..: .im
0be0: 70 6f 72 74 2d 63 6f 6c 6f 72 73 20 28 20 2d 2d port-colors ( --
0bf0: 20 29 0a 20 20 20 20 69 6d 70 6f 72 74 2d 6e 61 ). import-na
0c00: 6d 65 24 0a 20 20 20 20 69 6d 70 6f 72 74 23 75 me$. import#u
0c10: 6e 74 72 75 73 74 65 64 20 31 2b 20 30 20 3f 44 ntrusted 1+ 0 ?D
0c20: 4f 0a 09 31 20 49 20 6c 73 68 69 66 74 20 3e 69 O..1 I lshift >i
0c30: 6d 2d 63 6f 6c 6f 72 20 63 6f 75 6e 74 20 32 64 m-color count 2d
0c40: 75 70 20 74 79 70 65 20 3c 64 65 66 61 75 6c 74 up type <default
0c50: 3e 20 73 70 61 63 65 20 2b 20 61 6c 69 67 6e 65 > space + aligne
0c60: 64 0a 20 20 20 20 4c 4f 4f 50 20 64 72 6f 70 20 d. LOOP drop
0c70: 3b 0a 0a 5c 20 73 61 6d 70 6c 65 20 6b 65 79 0a ;..\ sample key.
0c80: 0a 6b 65 79 2d 65 6e 74 72 79 20 27 20 6e 65 77 .key-entry ' new
0c90: 20 73 74 61 74 69 63 2d 61 20 77 69 74 68 2d 61 static-a with-a
0ca0: 6c 6c 6f 63 61 74 65 72 20 43 6f 6e 73 74 61 6e llocater Constan
0cb0: 74 20 73 61 6d 70 6c 65 2d 6b 65 79 0a 0a 56 61 t sample-key..Va
0cc0: 72 69 61 62 6c 65 20 6b 65 79 23 20 5c 20 6b 65 riable key# \ ke
0cd0: 79 20 68 61 73 68 20 74 61 62 6c 65 0a 56 61 72 y hash table.Var
0ce0: 69 61 62 6c 65 20 6e 69 63 6b 23 20 5c 20 6e 69 iable nick# \ ni
0cf0: 63 6b 20 68 61 73 68 20 74 61 62 6c 65 0a 0a 36 ck hash table..6
0d00: 34 56 61 72 69 61 62 6c 65 20 6b 65 79 2d 72 65 4Variable key-re
0d10: 61 64 2d 6f 66 66 73 65 74 0a 0a 3a 20 63 75 72 ad-offset..: cur
0d20: 72 65 6e 74 2d 6b 65 79 20 28 20 61 64 64 72 20 rent-key ( addr
0d30: 75 20 2d 2d 20 6f 20 29 0a 20 20 20 20 32 64 75 u -- o ). 2du
0d40: 70 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 64 p key| key# #@ d
0d50: 72 6f 70 0a 20 20 20 20 64 75 70 20 30 3d 20 49 rop. dup 0= I
0d60: 46 20 20 64 72 6f 70 20 2e 22 20 75 6e 6b 6e 6f F drop ." unkno
0d70: 77 6e 20 6b 65 79 3a 20 22 20 38 35 74 79 70 65 wn key: " 85type
0d80: 20 63 72 20 20 30 20 45 58 49 54 20 20 54 48 45 cr 0 EXIT THE
0d90: 4e 0a 20 20 20 20 63 65 6c 6c 2b 20 3e 6f 20 6b N. cell+ >o k
0da0: 65 2d 70 6b 20 24 21 20 6f 20 6f 3e 20 3b 0a 0a e-pk $! o o> ;..
0db0: 56 61 72 69 61 62 6c 65 20 73 69 6d 2d 6e 69 63 Variable sim-nic
0dc0: 6b 21 0a 0a 3a 20 6e 69 63 6b 21 20 28 20 2d 2d k!..: nick! ( --
0dd0: 20 29 20 73 69 6d 2d 6e 69 63 6b 21 20 40 20 3f ) sim-nick! @ ?
0de0: 45 58 49 54 20 20 6f 20 7b 20 77 5e 20 6f 70 74 EXIT o { w^ opt
0df0: 72 20 7d 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 r }. ke-nick
0e00: 24 40 20 6e 69 63 6b 23 20 23 40 20 64 30 3d 20 $@ nick# #@ d0=
0e10: 49 46 0a 09 6f 70 74 72 20 63 65 6c 6c 20 6b 65 IF..optr cell ke
0e20: 2d 6e 69 63 6b 20 24 40 20 6e 69 63 6b 23 20 23 -nick $@ nick# #
0e30: 21 20 30 0a 20 20 20 20 45 4c 53 45 0a 09 6c 61 ! 0. ELSE..la
0e40: 73 74 23 20 63 65 6c 6c 2b 20 24 40 6c 65 6e 20 st# cell+ $@len
0e50: 63 65 6c 6c 2f 0a 09 6f 70 74 72 20 63 65 6c 6c cell/..optr cell
0e60: 20 6c 61 73 74 23 20 63 65 6c 6c 2b 20 24 2b 21 last# cell+ $+!
0e70: 0a 20 20 20 20 54 48 45 4e 20 20 6b 65 2d 6e 69 . THEN ke-ni
0e80: 63 6b 23 20 21 20 3b 0a 0a 3a 20 23 2e 6e 69 63 ck# ! ;..: #.nic
0e90: 6b 20 28 20 68 61 73 68 20 2d 2d 20 29 0a 20 20 k ( hash -- ).
0ea0: 20 20 64 75 70 20 24 40 20 74 79 70 65 20 27 23 dup $@ type '#
0eb0: 27 20 65 6d 69 74 20 63 65 6c 6c 2b 20 24 40 6c ' emit cell+ $@l
0ec0: 65 6e 20 63 65 6c 6c 2f 20 2e 20 3b 0a 0a 3a 20 en cell/ . ;..:
0ed0: 6c 61 73 74 2d 70 65 74 40 20 28 20 2d 2d 20 61 last-pet@ ( -- a
0ee0: 64 64 72 20 75 20 29 0a 20 20 20 20 6b 65 2d 70 ddr u ). ke-p
0ef0: 65 74 73 5b 5d 20 24 5b 5d 23 20 3f 64 75 70 2d ets[] $[]# ?dup-
0f00: 49 46 20 20 31 2d 20 6b 65 2d 70 65 74 73 5b 5d IF 1- ke-pets[]
0f10: 20 24 5b 5d 40 20 20 45 4c 53 45 20 20 23 30 2e $[]@ ELSE #0.
0f20: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 70 65 74 21 THEN ;..: pet!
0f30: 20 28 20 2d 2d 20 29 20 73 69 6d 2d 6e 69 63 6b ( -- ) sim-nick
0f40: 21 20 40 20 3f 45 58 49 54 20 20 6f 20 7b 20 77 ! @ ?EXIT o { w
0f50: 5e 20 6f 70 74 72 20 7d 0a 20 20 20 20 6c 61 73 ^ optr }. las
0f60: 74 2d 70 65 74 40 20 6e 69 63 6b 23 20 23 40 20 t-pet@ nick# #@
0f70: 64 30 3d 20 49 46 0a 09 6f 70 74 72 20 63 65 6c d0= IF..optr cel
0f80: 6c 20 6c 61 73 74 2d 70 65 74 40 20 6e 69 63 6b l last-pet@ nick
0f90: 23 20 23 21 20 30 0a 20 20 20 20 45 4c 53 45 0a # #! 0. ELSE.
0fa0: 09 6c 61 73 74 23 20 63 65 6c 6c 2b 20 24 40 6c .last# cell+ $@l
0fb0: 65 6e 20 63 65 6c 6c 2f 0a 09 6f 70 74 72 20 63 en cell/..optr c
0fc0: 65 6c 6c 20 6c 61 73 74 23 20 63 65 6c 6c 2b 20 ell last# cell+
0fd0: 24 2b 21 0a 20 20 20 20 54 48 45 4e 20 20 6b 65 $+!. THEN ke
0fe0: 2d 70 65 74 73 5b 5d 20 24 5b 5d 23 20 31 2d 20 -pets[] $[]# 1-
0ff0: 6b 65 2d 70 65 74 73 23 20 24 5b 5d 20 21 20 3b ke-pets# $[] ! ;
1000: 0a 0a 3a 20 6b 65 79 3a 6e 65 77 20 28 20 61 64 ..: key:new ( ad
1010: 64 72 20 75 20 2d 2d 20 6f 20 29 0a 20 20 20 20 dr u -- o ).
1020: 5c 47 20 63 72 65 61 74 65 20 6e 65 77 20 6b 65 \G create new ke
1030: 79 2c 20 61 64 64 72 20 75 20 69 73 20 74 68 65 y, addr u is the
1040: 20 70 75 62 6c 69 63 20 6b 65 79 0a 20 20 20 20 public key.
1050: 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 20 6b sample-key >o k
1060: 65 2d 73 6b 20 6b 65 2d 65 6e 64 20 6f 76 65 72 e-sk ke-end over
1070: 20 2d 20 65 72 61 73 65 0a 20 20 20 20 6b 65 79 - erase. key
1080: 2d 65 6e 74 72 79 2d 74 61 62 6c 65 20 40 20 74 -entry-table @ t
1090: 6f 6b 65 6e 2d 74 61 62 6c 65 20 21 0a 20 20 20 oken-table !.
10a0: 20 3e 73 74 6f 72 65 6b 65 79 20 40 20 6b 65 2d >storekey @ ke-
10b0: 73 74 6f 72 65 6b 65 79 20 21 0a 20 20 20 20 6b storekey !. k
10c0: 65 79 2d 72 65 61 64 2d 6f 66 66 73 65 74 20 36 ey-read-offset 6
10d0: 34 40 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 21 4@ ke-offset 64!
10e0: 0a 20 20 20 20 31 20 69 6d 70 6f 72 74 2d 74 79 . 1 import-ty
10f0: 70 65 20 40 20 6c 73 68 69 66 74 20 5b 20 31 20 pe @ lshift [ 1
1100: 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 import#new lshif
1110: 74 20 5d 4c 20 6f 72 20 6b 65 2d 69 6d 70 6f 72 t ]L or ke-impor
1120: 74 73 20 21 0a 20 20 20 20 6b 65 79 70 61 63 6b ts !. keypack
1130: 2d 61 6c 6c 23 20 6e 3e 36 34 20 6b 65 79 2d 72 -all# n>64 key-r
1140: 65 61 64 2d 6f 66 66 73 65 74 20 36 34 2b 21 0a ead-offset 64+!.
1150: 20 20 20 20 6f 20 63 65 6c 6c 2d 20 6b 65 2d 65 o cell- ke-e
1160: 6e 64 20 6f 76 65 72 20 2d 20 32 6f 76 65 72 20 nd over - 2over
1170: 6b 65 79 7c 20 6b 65 79 23 20 23 21 0a 20 20 20 key| key# #!.
1180: 20 6f 3e 0a 20 20 20 20 63 75 72 72 65 6e 74 2d o>. current-
1190: 6b 65 79 20 3b 0a 0a 30 20 56 61 6c 75 65 20 6c key ;..0 Value l
11a0: 61 73 74 2d 6b 65 79 0a 0a 3a 20 6b 65 79 3f 6e ast-key..: key?n
11b0: 65 77 20 28 20 61 64 64 72 20 75 20 2d 2d 20 6f ew ( addr u -- o
11c0: 20 29 0a 20 20 20 20 5c 47 20 43 72 65 61 74 65 ). \G Create
11d0: 20 6f 72 20 6c 6f 6f 6b 75 70 20 6e 65 77 20 6b or lookup new k
11e0: 65 79 0a 20 20 20 20 32 64 75 70 20 6b 65 79 7c ey. 2dup key|
11f0: 20 6b 65 79 23 20 23 40 20 64 72 6f 70 0a 20 20 key# #@ drop.
1200: 20 20 64 75 70 20 30 3d 20 49 46 20 20 64 72 6f dup 0= IF dro
1210: 70 20 6b 65 79 3a 6e 65 77 0a 20 20 20 20 45 4c p key:new. EL
1220: 53 45 20 20 6e 69 70 20 6e 69 70 20 63 65 6c 6c SE nip nip cell
1230: 2b 20 20 31 20 69 6d 70 6f 72 74 2d 74 79 70 65 + 1 import-type
1240: 20 40 20 6c 73 68 69 66 74 20 6f 76 65 72 20 2e @ lshift over .
1250: 6b 65 2d 69 6d 70 6f 72 74 73 20 6f 72 21 20 20 ke-imports or!
1260: 54 48 45 4e 0a 20 20 20 20 64 75 70 20 74 6f 20 THEN. dup to
1270: 6c 61 73 74 2d 6b 65 79 20 3b 0a 0a 5c 20 73 65 last-key ;..\ se
1280: 61 72 63 68 20 66 6f 72 20 6b 65 79 73 20 2d 20 arch for keys -
1290: 6e 6f 74 20 6f 70 74 69 6d 69 7a 65 64 0a 0a 3a not optimized..:
12a0: 20 23 73 70 6c 69 74 20 28 20 61 64 64 72 20 75 #split ( addr u
12b0: 20 2d 2d 20 61 64 64 72 20 75 20 6e 20 29 0a 20 -- addr u n ).
12c0: 20 20 20 5b 3a 20 32 64 75 70 20 27 23 27 20 2d [: 2dup '#' -
12d0: 73 63 61 6e 20 6e 69 70 20 3e 72 0a 20 20 20 20 scan nip >r.
12e0: 20 20 72 40 20 30 3d 20 49 46 20 20 72 64 72 6f r@ 0= IF rdro
12f0: 70 20 30 20 20 45 58 49 54 20 20 54 48 45 4e 0a p 0 EXIT THEN.
1300: 20 20 20 20 20 20 23 30 2e 20 32 6f 76 65 72 20 #0. 2over
1310: 72 40 20 31 2b 20 2f 73 74 72 69 6e 67 20 3e 6e r@ 1+ /string >n
1320: 75 6d 62 65 72 0a 20 20 20 20 20 20 30 3d 20 49 umber. 0= I
1330: 46 20 20 6e 69 70 20 64 72 6f 70 20 6e 69 70 20 F nip drop nip
1340: 72 3e 20 73 77 61 70 20 20 45 4c 53 45 0a 09 20 r> swap ELSE..
1350: 20 72 64 72 6f 70 20 64 72 6f 70 20 32 64 72 6f rdrop drop 2dro
1360: 70 20 30 20 20 20 54 48 45 4e 20 3b 5d 20 23 31 p 0 THEN ;] #1
1370: 30 20 62 61 73 65 2d 65 78 65 63 75 74 65 20 3b 0 base-execute ;
1380: 0a 0a 3a 20 6e 69 63 6b 2d 6b 65 79 20 28 20 61 ..: nick-key ( a
1390: 64 64 72 20 75 20 2d 2d 20 6f 20 2f 20 30 20 29 ddr u -- o / 0 )
13a0: 20 5c 20 73 65 61 72 63 68 20 66 6f 72 20 6b 65 \ search for ke
13b0: 79 20 6e 69 63 6b 6e 61 6d 65 0a 20 20 20 20 23 y nickname. #
13c0: 73 70 6c 69 74 20 3e 72 20 6e 69 63 6b 23 20 23 split >r nick# #
13d0: 40 20 32 64 75 70 20 64 30 3d 20 49 46 20 20 72 @ 2dup d0= IF r
13e0: 64 72 6f 70 20 64 72 6f 70 20 20 45 58 49 54 20 drop drop EXIT
13f0: 20 54 48 45 4e 0a 20 20 20 20 72 3e 20 63 65 6c THEN. r> cel
1400: 6c 73 20 73 61 66 65 2f 73 74 72 69 6e 67 20 30 ls safe/string 0
1410: 3d 20 49 46 20 20 64 72 6f 70 20 30 20 20 45 58 = IF drop 0 EX
1420: 49 54 20 20 54 48 45 4e 20 20 40 20 3b 0a 0a 3a IT THEN @ ;..:
1430: 20 73 65 63 72 65 74 2d 6b 65 79 73 23 20 28 20 secret-keys# (
1440: 2d 2d 20 6e 20 29 0a 20 20 20 20 30 20 6b 65 79 -- n ). 0 key
1450: 23 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 # [: cell+ $@ dr
1460: 6f 70 20 63 65 6c 6c 2b 20 3e 6f 20 6b 65 2d 73 op cell+ >o ke-s
1470: 6b 20 40 20 30 3c 3e 20 2d 20 6f 3e 20 3b 5d 20 k @ 0<> - o> ;]
1480: 23 6d 61 70 20 3b 0a 3a 20 73 65 63 72 65 74 2d #map ;.: secret-
1490: 6b 65 79 20 28 20 6e 20 2d 2d 20 6f 2f 30 20 29 key ( n -- o/0 )
14a0: 0a 20 20 20 20 30 20 74 75 63 6b 20 6b 65 79 23 . 0 tuck key#
14b0: 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f [: cell+ $@ dro
14c0: 70 20 63 65 6c 6c 2b 20 3e 6f 20 6b 65 2d 73 6b p cell+ >o ke-sk
14d0: 20 40 20 49 46 0a 09 20 20 32 64 75 70 20 3d 20 @ IF.. 2dup =
14e0: 49 46 20 20 72 6f 74 20 64 72 6f 70 20 6f 20 2d IF rot drop o -
14f0: 72 6f 74 20 20 54 48 45 4e 20 20 31 2b 0a 20 20 rot THEN 1+.
1500: 20 20 20 20 54 48 45 4e 20 20 6f 3e 20 3b 5d 20 THEN o> ;]
1510: 23 6d 61 70 20 32 64 72 6f 70 20 3b 0a 3a 20 2e #map 2drop ;.: .
1520: 23 20 28 20 6e 20 2d 2d 20 29 20 3f 64 75 70 2d # ( n -- ) ?dup-
1530: 49 46 20 20 27 23 27 20 65 6d 69 74 20 30 20 2e IF '#' emit 0 .
1540: 72 20 20 54 48 45 4e 20 3b 0a 3a 20 2e 6e 69 63 r THEN ;.: .nic
1550: 6b 2d 62 61 73 65 20 28 20 6f 3a 6b 65 79 20 2d k-base ( o:key -
1560: 2d 20 29 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 - ). ke-nick
1570: 24 2e 20 20 6b 65 2d 6e 69 63 6b 23 20 40 20 2e $. ke-nick# @ .
1580: 23 20 3b 0a 3a 20 2e 70 65 74 2d 62 61 73 65 20 # ;.: .pet-base
1590: 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 ( o:key -- ).
15a0: 20 30 20 6b 65 2d 70 65 74 73 5b 5d 20 5b 3a 20 0 ke-pets[] [:
15b0: 73 70 61 63 65 20 74 79 70 65 20 64 75 70 20 6b space type dup k
15c0: 65 2d 70 65 74 73 23 20 24 5b 5d 20 40 20 2e 23 e-pets# $[] @ .#
15d0: 20 20 31 2b 20 3b 5d 20 24 5b 5d 6d 61 70 20 64 1+ ;] $[]map d
15e0: 72 6f 70 20 3b 0a 3a 20 2e 70 65 74 30 2d 62 61 rop ;.: .pet0-ba
15f0: 73 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a se ( o:key -- ).
1600: 20 20 20 20 6b 65 2d 70 65 74 73 5b 5d 20 24 5b ke-pets[] $[
1610: 5d 23 20 49 46 20 20 30 20 6b 65 2d 70 65 74 73 ]# IF 0 ke-pets
1620: 5b 5d 20 24 5b 5d 40 20 74 79 70 65 20 30 20 6b [] $[]@ type 0 k
1630: 65 2d 70 65 74 73 23 20 24 5b 5d 20 40 20 2e 23 e-pets# $[] @ .#
1640: 0a 20 20 20 20 45 4c 53 45 20 20 2e 6e 69 63 6b . ELSE .nick
1650: 2d 62 61 73 65 20 20 54 48 45 4e 20 3b 0a 3a 20 -base THEN ;.:
1660: 2e 72 65 61 6c 2d 6e 69 63 6b 20 28 20 6f 3a 6b .real-nick ( o:k
1670: 65 79 20 2d 2d 20 29 20 20 20 6b 65 2d 69 6d 70 ey -- ) ke-imp
1680: 6f 72 74 73 20 40 20 3e 69 6d 2d 63 6f 6c 6f 72 orts @ >im-color
1690: 20 2e 6e 69 63 6b 2d 62 61 73 65 20 3c 64 65 66 .nick-base <def
16a0: 61 75 6c 74 3e 20 3b 0a 0a 30 20 56 61 6c 75 65 ault> ;..0 Value
16b0: 20 6c 61 73 74 2d 6b 69 0a 0a 3a 20 2e 6e 69 63 last-ki..: .nic
16c0: 6b 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 20 20 k ( o:key -- )
16d0: 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 64 75 ke-imports @ du
16e0: 70 20 74 6f 20 6c 61 73 74 2d 6b 69 20 3e 69 6d p to last-ki >im
16f0: 2d 63 6f 6c 6f 72 20 2e 70 65 74 30 2d 62 61 73 -color .pet0-bas
1700: 65 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 3a 20 e <default> ;.:
1710: 2e 6e 69 63 6b 2b 70 65 74 20 28 20 6f 3a 6b 65 .nick+pet ( o:ke
1720: 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 69 6d y -- ). ke-im
1730: 70 6f 72 74 73 20 40 20 3e 69 6d 2d 63 6f 6c 6f ports @ >im-colo
1740: 72 20 2e 6e 69 63 6b 2d 62 61 73 65 20 2e 70 65 r .nick-base .pe
1750: 74 2d 62 61 73 65 20 3c 64 65 66 61 75 6c 74 3e t-base <default>
1760: 20 3b 0a 0a 3a 20 6e 69 63 6b 3e 70 6b 20 28 20 ;..: nick>pk (
1770: 6e 69 63 6b 20 75 20 2d 2d 20 70 6b 20 75 20 29 nick u -- pk u )
1780: 0a 20 20 20 20 6e 69 63 6b 2d 6b 65 79 20 3f 64 . nick-key ?d
1790: 75 70 2d 49 46 20 2e 6b 65 2d 70 6b 20 24 40 20 up-IF .ke-pk $@
17a0: 45 4c 53 45 20 30 20 30 20 54 48 45 4e 20 3b 0a ELSE 0 0 THEN ;.
17b0: 3a 20 68 6f 73 74 2e 6e 69 63 6b 3e 70 6b 20 28 : host.nick>pk (
17c0: 20 61 64 64 72 20 75 20 2d 2d 20 70 6b 20 75 27 addr u -- pk u'
17d0: 20 29 0a 20 20 20 20 27 2e 27 20 24 73 70 6c 69 ). '.' $spli
17e0: 74 20 64 75 70 20 30 3d 20 49 46 20 20 32 73 77 t dup 0= IF 2sw
17f0: 61 70 20 20 54 48 45 4e 20 5b 3a 20 6e 69 63 6b ap THEN [: nick
1800: 3e 70 6b 20 74 79 70 65 20 74 79 70 65 20 3b 5d >pk type type ;]
1810: 20 24 74 6d 70 20 3b 0a 0a 3a 20 6b 65 79 2d 65 $tmp ;..: key-e
1820: 78 69 73 74 3f 20 28 20 61 64 64 72 20 75 20 2d xist? ( addr u -
1830: 2d 20 6f 2f 30 20 29 0a 20 20 20 20 6b 65 79 23 - o/0 ). key#
1840: 20 23 40 20 49 46 20 20 63 65 6c 6c 2b 20 20 54 #@ IF cell+ T
1850: 48 45 4e 20 3b 20 0a 0a 5c 20 70 65 72 6d 69 73 HEN ; ..\ permis
1860: 73 69 6f 6e 20 6d 6f 64 69 66 69 63 61 74 69 6f sion modificatio
1870: 6e 0a 0a 32 36 20 62 75 66 66 65 72 3a 20 70 65 n..26 buffer: pe
1880: 72 6d 2d 63 68 61 72 73 0a 30 20 70 65 72 6d 24 rm-chars.0 perm$
1890: 20 63 6f 75 6e 74 20 62 6f 75 6e 64 73 20 5b 44 count bounds [D
18a0: 4f 5d 20 64 75 70 20 5b 49 5d 20 63 40 20 27 61 O] dup [I] c@ 'a
18b0: 27 20 2d 20 70 65 72 6d 2d 63 68 61 72 73 20 2b ' - perm-chars +
18c0: 20 63 21 20 31 2b 20 5b 4c 4f 4f 50 5d 20 64 72 c! 1+ [LOOP] dr
18d0: 6f 70 0a 0a 3a 20 2e 70 65 72 6d 20 28 20 70 65 op..: .perm ( pe
18e0: 72 6d 69 73 73 69 6f 6e 20 2d 2d 20 29 20 20 31 rmission -- ) 1
18f0: 20 70 65 72 6d 24 20 63 6f 75 6e 74 20 62 6f 75 perm$ count bou
1900: 6e 64 73 20 44 4f 0a 09 32 64 75 70 20 61 6e 64 nds DO..2dup and
1910: 20 30 3c 3e 20 49 20 63 40 20 27 2d 27 20 72 6f 0<> I c@ '-' ro
1920: 74 20 73 65 6c 65 63 74 20 65 6d 69 74 20 32 2a t select emit 2*
1930: 0a 20 20 20 20 4c 4f 4f 50 20 20 32 64 72 6f 70 . LOOP 2drop
1940: 20 3b 0a 3a 20 70 65 72 6d 61 6e 64 20 28 20 70 ;.: permand ( p
1950: 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72 20 6e 65 ermand permor ne
1960: 77 20 2d 2d 20 70 65 72 6d 61 6e 64 27 20 70 65 w -- permand' pe
1970: 72 6d 6f 72 20 29 0a 20 20 20 20 69 6e 76 65 72 rmor ). inver
1980: 74 20 74 75 63 6b 20 61 6e 64 20 3e 72 20 61 6e t tuck and >r an
1990: 64 20 72 3e 20 3b 0a 3a 20 3e 70 65 72 6d 2d 6d d r> ;.: >perm-m
19a0: 6f 64 20 28 20 70 65 72 6d 61 6e 64 20 70 65 72 od ( permand per
19b0: 6d 6f 72 20 2d 2d 20 70 65 72 6d 61 6e 64 27 20 mor -- permand'
19c0: 70 65 72 6d 6f 72 20 29 0a 20 20 20 20 73 77 61 permor ). swa
19d0: 70 20 64 75 70 20 30 3d 20 49 46 20 20 64 72 6f p dup 0= IF dro
19e0: 70 20 64 75 70 20 69 6e 76 65 72 74 20 20 54 48 p dup invert TH
19f0: 45 4e 20 73 77 61 70 20 3b 0a 3a 20 3e 70 65 72 EN swap ;.: >per
1a00: 6d 20 28 20 61 64 64 72 20 75 20 2d 2d 20 70 65 m ( addr u -- pe
1a10: 72 6d 61 6e 64 20 70 65 72 6d 6f 72 20 29 0a 20 rmand permor ).
1a20: 20 20 20 5c 47 20 70 61 72 73 65 20 70 65 72 6d \G parse perm
1a30: 69 73 73 69 6f 6e 73 3a 20 2b 20 61 64 64 73 2c issions: + adds,
1a40: 20 2d 20 72 65 6d 6f 76 65 73 20 70 65 72 6d 69 - removes permi
1a50: 73 73 69 6f 6e 73 2c 0a 20 20 20 20 5c 47 20 6e ssions,. \G n
1a60: 6f 20 6d 6f 64 69 66 69 65 72 20 73 65 74 73 20 o modifier sets
1a70: 70 65 72 6d 69 73 73 6f 6e 73 2e 0a 20 20 20 20 permissons..
1a80: 30 20 30 20 5b 27 5d 20 6f 72 20 7b 20 78 74 20 0 0 ['] or { xt
1a90: 7d 0a 20 20 20 20 32 73 77 61 70 20 62 6f 75 6e }. 2swap boun
1aa0: 64 73 20 3f 44 4f 0a 09 49 20 63 40 20 63 61 73 ds ?DO..I c@ cas
1ab0: 65 0a 09 20 20 20 20 27 2b 27 20 6f 66 20 20 3e e.. '+' of >
1ac0: 70 65 72 6d 2d 6d 6f 64 20 5b 27 5d 20 6f 72 20 perm-mod ['] or
1ad0: 74 6f 20 78 74 20 65 6e 64 6f 66 0a 09 20 20 20 to xt endof..
1ae0: 20 27 2d 27 20 6f 66 20 20 3e 70 65 72 6d 2d 6d '-' of >perm-m
1af0: 6f 64 20 5b 27 5d 20 70 65 72 6d 61 6e 64 20 74 od ['] permand t
1b00: 6f 20 78 74 20 20 65 6e 64 6f 66 0a 09 20 20 20 o xt endof..
1b10: 20 27 3d 27 20 6f 66 20 20 32 64 72 6f 70 20 70 '=' of 2drop p
1b20: 65 72 6d 25 64 65 66 61 75 6c 74 20 64 75 70 20 erm%default dup
1b30: 5b 27 5d 20 6f 72 20 74 6f 20 78 74 20 20 65 6e ['] or to xt en
1b40: 64 6f 66 0a 09 20 20 20 20 27 61 27 20 2d 20 64 dof.. 'a' - d
1b50: 75 70 20 27 7a 27 20 75 3c 3d 20 20 49 46 0a 09 up 'z' u<= IF..
1b60: 09 70 65 72 6d 2d 63 68 61 72 73 20 2b 20 63 40 .perm-chars + c@
1b70: 20 31 20 73 77 61 70 20 6c 73 68 69 66 74 20 78 1 swap lshift x
1b80: 74 20 65 78 65 63 75 74 65 0a 09 09 30 20 28 20 t execute...0 (
1b90: 64 75 6d 6d 79 20 66 6f 72 20 65 6e 64 63 61 73 dummy for endcas
1ba0: 65 20 29 0a 09 20 20 20 20 54 48 45 4e 20 20 65 e ).. THEN e
1bb0: 6e 64 63 61 73 65 0a 20 20 20 20 4c 4f 4f 50 20 ndcase. LOOP
1bc0: 3b 0a 3a 20 2e 70 65 72 6d 61 6e 64 6f 72 20 28 ;.: .permandor (
1bd0: 20 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72 20 permand permor
1be0: 2d 2d 20 29 0a 20 20 20 20 30 20 7b 20 2b 2d 20 -- ). 0 { +-
1bf0: 7d 0a 20 20 20 20 31 20 70 65 72 6d 24 20 63 6f }. 1 perm$ co
1c00: 75 6e 74 20 62 6f 75 6e 64 73 20 44 4f 20 20 3e unt bounds DO >
1c10: 72 0a 09 6f 76 65 72 20 72 40 20 61 6e 64 20 30 r..over r@ and 0
1c20: 3d 20 49 46 20 20 27 2d 27 20 64 75 70 20 2b 2d = IF '-' dup +-
1c30: 20 3c 3e 20 49 46 20 20 64 75 70 20 74 6f 20 2b <> IF dup to +
1c40: 2d 20 65 6d 69 74 0a 09 20 20 20 20 45 4c 53 45 - emit.. ELSE
1c50: 20 20 64 72 6f 70 20 20 54 48 45 4e 20 72 3e 20 drop THEN r>
1c60: 20 49 20 63 40 20 65 6d 69 74 20 20 3e 72 20 54 I c@ emit >r T
1c70: 48 45 4e 0a 09 64 75 70 20 20 72 40 20 61 6e 64 HEN..dup r@ and
1c80: 20 20 20 20 49 46 20 20 27 2b 27 20 64 75 70 20 IF '+' dup
1c90: 2b 2d 20 3c 3e 20 49 46 20 20 64 75 70 20 74 6f +- <> IF dup to
1ca0: 20 2b 2d 20 65 6d 69 74 0a 09 20 20 20 20 45 4c +- emit.. EL
1cb0: 53 45 20 20 64 72 6f 70 20 20 54 48 45 4e 20 72 SE drop THEN r
1cc0: 3e 20 20 49 20 63 40 20 65 6d 69 74 20 20 3e 72 > I c@ emit >r
1cd0: 20 54 48 45 4e 0a 09 72 3e 20 32 2a 0a 20 20 20 THEN..r> 2*.
1ce0: 20 4c 4f 4f 50 20 20 64 72 6f 70 20 32 64 72 6f LOOP drop 2dro
1cf0: 70 20 3b 0a 0a 5c 20 72 65 61 64 20 69 6e 20 70 p ;..\ read in p
1d00: 65 72 6d 69 73 73 69 6f 6e 20 67 72 6f 75 70 73 ermission groups
1d10: 2c 20 67 72 6f 75 70 73 20 69 73 20 69 6e 20 74 , groups is in t
1d20: 68 65 20 2e 6e 65 74 32 6f 20 64 69 72 65 63 74 he .net2o direct
1d30: 6f 72 79 0a 0a 3a 20 3e 67 72 6f 75 70 2d 69 64 ory..: >group-id
1d40: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 69 64 2f ( addr u -- id/
1d50: 2d 31 20 29 0a 20 20 20 20 2d 31 20 30 20 67 72 -1 ). -1 0 gr
1d60: 6f 75 70 73 5b 5d 20 5b 3a 20 32 73 77 61 70 20 oups[] [: 2swap
1d70: 32 3e 72 20 32 20 63 65 6c 6c 73 20 2f 73 74 72 2>r 2 cells /str
1d80: 69 6e 67 0a 20 20 20 20 20 20 32 6f 76 65 72 20 ing. 2over
1d90: 73 74 72 69 6e 67 2d 70 72 65 66 69 78 3f 20 49 string-prefix? I
1da0: 46 20 20 32 72 3e 20 6e 69 70 20 64 75 70 0a 20 F 2r> nip dup.
1db0: 20 20 20 20 20 45 4c 53 45 20 20 32 72 3e 20 20 ELSE 2r>
1dc0: 54 48 45 4e 20 20 31 2b 20 3b 5d 20 24 5b 5d 6d THEN 1+ ;] $[]m
1dd0: 61 70 0a 20 20 20 20 32 6e 69 70 20 64 72 6f 70 ap. 2nip drop
1de0: 20 3b 0a 0a 3a 20 3e 67 72 6f 75 70 73 20 28 20 ;..: >groups (
1df0: 61 64 64 72 20 75 20 70 61 6e 64 20 70 6f 72 20 addr u pand por
1e00: 2d 2d 20 29 0a 20 20 20 20 73 22 20 22 20 67 72 -- ). s" " gr
1e10: 6f 75 70 73 5b 5d 20 24 2b 5b 5d 21 0a 20 20 20 oups[] $+[]!.
1e20: 20 5b 3a 20 7b 20 64 5e 20 70 61 6e 64 6f 72 20 [: { d^ pandor
1e30: 7d 20 70 61 6e 64 6f 72 20 32 20 63 65 6c 6c 73 } pandor 2 cells
1e40: 20 74 79 70 65 20 20 74 79 70 65 20 3b 5d 0a 20 type type ;].
1e50: 20 20 20 67 72 6f 75 70 73 5b 5d 20 64 75 70 20 groups[] dup
1e60: 24 5b 5d 23 20 31 2d 20 73 77 61 70 20 24 5b 5d $[]# 1- swap $[]
1e70: 20 24 65 78 65 63 20 3b 0a 0a 3a 20 69 6e 69 74 $exec ;..: init
1e80: 2d 67 72 6f 75 70 73 20 28 20 2d 2d 20 29 0a 20 -groups ( -- ).
1e90: 20 20 20 22 6d 79 73 65 6c 66 22 20 20 70 65 72 "myself" per
1ea0: 6d 25 6d 79 73 65 6c 66 20 20 64 75 70 20 3e 67 m%myself dup >g
1eb0: 72 6f 75 70 73 0a 20 20 20 20 22 70 65 65 72 22 roups. "peer"
1ec0: 20 20 20 20 70 65 72 6d 25 64 65 66 61 75 6c 74 perm%default
1ed0: 20 64 75 70 20 3e 67 72 6f 75 70 73 0a 20 20 20 dup >groups.
1ee0: 20 22 64 68 74 22 20 20 20 20 20 70 65 72 6d 25 "dht" perm%
1ef0: 64 68 74 72 6f 6f 74 20 64 75 70 20 3e 67 72 6f dhtroot dup >gro
1f00: 75 70 73 0a 20 20 20 20 22 75 6e 6b 6e 6f 77 6e ups. "unknown
1f10: 22 20 70 65 72 6d 25 75 6e 6b 6e 6f 77 6e 20 64 " perm%unknown d
1f20: 75 70 20 3e 67 72 6f 75 70 73 0a 20 20 20 20 22 up >groups. "
1f30: 62 6c 6f 63 6b 65 64 22 20 70 65 72 6d 25 62 6c blocked" perm%bl
1f40: 6f 63 6b 65 64 20 70 65 72 6d 25 69 6e 64 69 72 ocked perm%indir
1f50: 65 63 74 20 6f 72 20 64 75 70 20 3e 67 72 6f 75 ect or dup >grou
1f60: 70 73 20 3b 0a 0a 3a 20 2e 67 72 6f 75 70 73 20 ps ;..: .groups
1f70: 28 20 2d 2d 20 29 0a 20 20 20 20 67 72 6f 75 70 ( -- ). group
1f80: 73 5b 5d 20 5b 3a 20 32 64 75 70 20 32 20 63 65 s[] [: 2dup 2 ce
1f90: 6c 6c 73 20 2f 73 74 72 69 6e 67 20 74 79 70 65 lls /string type
1fa0: 20 73 70 61 63 65 0a 20 20 20 20 20 20 64 72 6f space. dro
1fb0: 70 20 32 40 20 2e 70 65 72 6d 61 6e 64 6f 72 20 p 2@ .permandor
1fc0: 63 72 20 3b 5d 20 24 5b 5d 6d 61 70 20 3b 0a 0a cr ;] $[]map ;..
1fd0: 3a 20 2e 69 6e 2d 67 72 6f 75 70 73 20 28 20 61 : .in-groups ( a
1fe0: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 62 ddr u -- ). b
1ff0: 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 20 70 40 2b ounds ?DO..I p@+
2000: 20 49 20 2d 20 3e 72 20 36 34 3e 6e 20 67 72 6f I - >r 64>n gro
2010: 75 70 73 5b 5d 20 24 5b 5d 40 20 32 20 63 65 6c ups[] $[]@ 2 cel
2020: 6c 73 20 2f 73 74 72 69 6e 67 20 73 70 61 63 65 ls /string space
2030: 20 74 79 70 65 0a 20 20 20 20 72 3e 20 2b 4c 4f type. r> +LO
2040: 4f 50 20 3b 0a 0a 3a 20 77 72 69 74 65 2d 67 72 OP ;..: write-gr
2050: 6f 75 70 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 oups ( -- ).
2060: 5b 3a 20 2e 22 20 67 72 6f 75 70 73 2b 22 20 67 [: ." groups+" g
2070: 65 74 70 69 64 20 30 20 2e 72 20 3b 5d 20 24 74 etpid 0 .r ;] $t
2080: 6d 70 20 2e 6e 65 74 32 6f 2f 20 32 64 75 70 20 mp .net2o/ 2dup
2090: 77 2f 6f 20 63 72 65 61 74 65 2d 66 69 6c 65 20 w/o create-file
20a0: 74 68 72 6f 77 20 3e 72 0a 20 20 20 20 5b 27 5d throw >r. [']
20b0: 20 2e 67 72 6f 75 70 73 20 72 40 20 6f 75 74 66 .groups r@ outf
20c0: 69 6c 65 2d 65 78 65 63 75 74 65 0a 20 20 20 20 ile-execute.
20d0: 72 3e 20 63 6c 6f 73 65 2d 66 69 6c 65 20 74 68 r> close-file th
20e0: 72 6f 77 20 27 2b 27 20 2d 73 63 61 6e 20 31 2d row '+' -scan 1-
20f0: 20 3e 62 61 63 6b 75 70 20 3b 0a 0a 3a 20 67 72 >backup ;..: gr
2100: 6f 75 70 2d 6c 69 6e 65 20 28 20 2d 2d 20 29 0a oup-line ( -- ).
2110: 20 20 20 20 70 61 72 73 65 2d 6e 61 6d 65 20 70 parse-name p
2120: 61 72 73 65 2d 6e 61 6d 65 20 3e 70 65 72 6d 20 arse-name >perm
2130: 3e 67 72 6f 75 70 73 20 3b 0a 0a 3a 20 72 65 61 >groups ;..: rea
2140: 64 2d 67 72 6f 75 70 73 2d 6c 6f 6f 70 20 28 20 d-groups-loop (
2150: 2d 2d 20 29 0a 20 20 20 20 42 45 47 49 4e 20 20 -- ). BEGIN
2160: 72 65 66 69 6c 6c 20 20 57 48 49 4c 45 20 20 67 refill WHILE g
2170: 72 6f 75 70 2d 6c 69 6e 65 20 20 52 45 50 45 41 roup-line REPEA
2180: 54 20 3b 0a 0a 3a 20 72 65 61 64 2d 67 72 6f 75 T ;..: read-grou
2190: 70 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 22 67 ps ( -- ). "g
21a0: 72 6f 75 70 73 22 20 2e 6e 65 74 32 6f 2d 63 6f roups" .net2o-co
21b0: 6e 66 69 67 2f 20 32 64 75 70 20 66 69 6c 65 2d nfig/ 2dup file-
21c0: 73 74 61 74 75 73 20 6e 69 70 20 6e 6f 2d 66 69 status nip no-fi
21d0: 6c 65 23 20 3d 20 49 46 0a 09 69 6e 69 74 2d 67 le# = IF..init-g
21e0: 72 6f 75 70 73 20 77 72 69 74 65 2d 67 72 6f 75 roups write-grou
21f0: 70 73 20 32 64 72 6f 70 20 20 45 58 49 54 0a 20 ps 2drop EXIT.
2200: 20 20 20 54 48 45 4e 20 20 3e 69 6e 63 6c 75 64 THEN >includ
2210: 65 64 20 74 68 72 6f 77 0a 20 20 20 20 5b 27 5d ed throw. [']
2220: 20 72 65 61 64 2d 67 72 6f 75 70 73 2d 6c 6f 6f read-groups-loo
2230: 70 20 65 78 65 63 75 74 65 2d 70 61 72 73 69 6e p execute-parsin
2240: 67 2d 6e 61 6d 65 64 2d 66 69 6c 65 20 3b 0a 0a g-named-file ;..
2250: 3a 20 67 72 6f 75 70 73 3e 6d 61 73 6b 20 28 20 : groups>mask (
2260: 61 64 64 72 20 75 20 2d 2d 20 6d 61 73 6b 20 29 addr u -- mask )
2270: 0a 20 20 20 20 30 20 2d 72 6f 74 20 62 6f 75 6e . 0 -rot boun
2280: 64 73 20 3f 44 4f 0a 09 49 20 70 40 2b 20 49 20 ds ?DO..I p@+ I
2290: 2d 20 3e 72 0a 09 36 34 3e 6e 20 64 75 70 20 67 - >r..64>n dup g
22a0: 72 6f 75 70 73 5b 5d 20 24 5b 5d 23 20 75 3e 3d roups[] $[]# u>=
22b0: 20 21 21 6e 6f 2d 67 72 6f 75 70 21 21 0a 09 67 !!no-group!!..g
22c0: 72 6f 75 70 73 5b 5d 20 24 5b 5d 40 20 64 72 6f roups[] $[]@ dro
22d0: 70 20 32 40 20 3e 72 20 61 6e 64 20 72 3e 20 6f p 2@ >r and r> o
22e0: 72 0a 20 20 20 20 72 3e 20 2b 4c 4f 4f 50 20 3b r. r> +LOOP ;
22f0: 0a 0a 3a 20 3f 3e 67 72 6f 75 70 73 20 28 20 6d ..: ?>groups ( m
2300: 61 73 6b 20 2d 2d 20 6d 61 73 6b 27 20 29 0a 20 ask -- mask' ).
2310: 20 20 20 6b 65 2d 67 72 6f 75 70 73 20 24 40 6c ke-groups $@l
2320: 65 6e 20 30 3d 20 49 46 0a 09 67 72 6f 75 70 73 en 0= IF..groups
2330: 5b 5d 20 24 5b 5d 23 20 30 20 44 4f 0a 09 20 20 [] $[]# 0 DO..
2340: 20 20 64 75 70 20 49 20 67 72 6f 75 70 73 5b 5d dup I groups[]
2350: 20 24 5b 5d 40 20 64 72 6f 70 20 40 0a 09 20 20 $[]@ drop @..
2360: 20 20 6f 72 20 6f 76 65 72 20 3d 20 49 46 0a 09 or over = IF..
2370: 09 49 20 6b 65 2d 67 72 6f 75 70 73 20 63 24 2b .I ke-groups c$+
2380: 21 0a 09 09 49 20 67 72 6f 75 70 73 5b 5d 20 24 !...I groups[] $
2390: 5b 5d 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 40 []@ drop cell+ @
23a0: 20 69 6e 76 65 72 74 20 61 6e 64 0a 09 20 20 20 invert and..
23b0: 20 54 48 45 4e 0a 09 4c 4f 4f 50 0a 20 20 20 20 THEN..LOOP.
23c0: 54 48 45 4e 20 20 64 72 6f 70 20 3b 0a 0a 3a 6e THEN drop ;..:n
23d0: 6f 6e 61 6d 65 20 64 65 66 65 72 73 20 27 63 6f oname defers 'co
23e0: 6c 64 20 20 67 72 6f 75 70 73 5b 5d 20 6f 66 66 ld groups[] off
23f0: 20 72 65 61 64 2d 67 72 6f 75 70 73 20 3b 20 69 read-groups ; i
2400: 73 20 27 63 6f 6c 64 0a 0a 5c 20 6b 65 79 20 64 s 'cold..\ key d
2410: 69 73 70 6c 61 79 0a 0a 5b 49 46 55 4e 44 45 46 isplay..[IFUNDEF
2420: 5d 20 6d 61 67 65 6e 74 61 20 20 62 72 6f 77 6e ] magenta brown
2430: 20 63 6f 6e 73 74 61 6e 74 20 6d 61 67 65 6e 74 constant magent
2440: 61 20 5b 54 48 45 4e 5d 0a 5b 49 46 44 45 46 5d a [THEN].[IFDEF]
2450: 20 67 6c 2d 74 79 70 65 20 3a 20 62 67 7c 20 3e gl-type : bg| >
2460: 62 67 20 6f 72 20 3b 20 5b 45 4c 53 45 5d 20 3a bg or ; [ELSE] :
2470: 20 62 67 7c 20 64 72 6f 70 20 3b 20 5b 54 48 45 bg| drop ; [THE
2480: 4e 5d 0a 0a 43 72 65 61 74 65 20 38 35 63 6f 6c N]..Create 85col
2490: 6f 72 73 2d 62 77 0a 30 20 2c 20 69 6e 76 65 72 ors-bw.0 , inver
24a0: 73 20 2c 0a 69 6e 76 65 72 73 20 2c 20 30 20 2c s ,.invers , 0 ,
24b0: 0a 30 20 2c 20 69 6e 76 65 72 73 20 2c 0a 69 6e .0 , invers ,.in
24c0: 76 65 72 73 20 2c 20 30 20 2c 0a 43 72 65 61 74 vers , 0 ,.Creat
24d0: 65 20 38 35 63 6f 6c 6f 72 73 2d 63 6c 0a 79 65 e 85colors-cl.ye
24e0: 6c 6c 6f 77 20 3e 66 67 20 62 6c 75 65 20 3e 62 llow >fg blue >b
24f0: 67 20 6f 72 20 62 6f 6c 64 20 6f 72 20 2c 20 72 g or bold or , r
2500: 65 64 20 3e 66 67 20 77 68 69 74 65 20 62 67 7c ed >fg white bg|
2510: 20 2c 0a 62 6c 61 63 6b 20 3e 66 67 20 63 79 61 ,.black >fg cya
2520: 6e 20 62 67 7c 20 2c 20 67 72 65 65 6e 20 3e 66 n bg| , green >f
2530: 67 20 62 6c 61 63 6b 20 3e 62 67 20 6f 72 20 62 g black >bg or b
2540: 6f 6c 64 20 6f 72 20 2c 0a 77 68 69 74 65 20 3e old or ,.white >
2550: 66 67 20 62 6c 61 63 6b 20 3e 62 67 20 6f 72 20 fg black >bg or
2560: 62 6f 6c 64 20 6f 72 20 2c 20 6d 61 67 65 6e 74 bold or , magent
2570: 61 20 3e 66 67 20 79 65 6c 6c 6f 77 20 62 67 7c a >fg yellow bg|
2580: 20 2c 0a 62 6c 75 65 20 3e 66 67 20 79 65 6c 6c ,.blue >fg yell
2590: 6f 77 20 62 67 7c 20 2c 20 63 79 61 6e 20 3e 66 ow bg| , cyan >f
25a0: 67 20 72 65 64 20 3e 62 67 20 6f 72 20 62 6f 6c g red >bg or bol
25b0: 64 20 6f 72 20 2c 0a 0a 5b 49 46 44 45 46 5d 20 d or ,..[IFDEF]
25c0: 67 6c 2d 74 79 70 65 20 38 35 63 6f 6c 6f 72 73 gl-type 85colors
25d0: 2d 63 6c 20 5b 45 4c 53 45 5d 20 38 35 63 6f 6c -cl [ELSE] 85col
25e0: 6f 72 73 2d 62 77 20 5b 54 48 45 4e 5d 20 56 61 ors-bw [THEN] Va
25f0: 6c 75 65 20 38 35 63 6f 6c 6f 72 73 0a 0a 3a 20 lue 85colors..:
2600: 2e 73 74 72 69 70 65 38 35 20 28 20 61 64 64 72 .stripe85 ( addr
2610: 20 75 20 2d 2d 20 29 20 20 30 20 2d 72 6f 74 20 u -- ) 0 -rot
2620: 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 64 75 70 20 bounds ?DO..dup
2630: 63 65 6c 6c 73 20 38 35 63 6f 6c 6f 72 73 20 2b cells 85colors +
2640: 20 40 20 61 74 74 72 21 20 31 2b 0a 09 49 20 34 @ attr! 1+..I 4
2650: 20 38 35 74 79 70 65 20 20 64 75 70 20 63 65 6c 85type dup cel
2660: 6c 73 20 38 35 63 6f 6c 6f 72 73 20 2b 20 40 20 ls 85colors + @
2670: 61 74 74 72 21 20 31 2b 0a 20 20 20 20 49 20 34 attr! 1+. I 4
2680: 20 2b 20 34 20 38 35 74 79 70 65 20 3c 64 65 66 + 4 85type <def
2690: 61 75 6c 74 3e 20 63 72 20 38 20 2b 4c 4f 4f 50 ault> cr 8 +LOOP
26a0: 20 20 64 72 6f 70 20 3b 0a 3a 20 2e 69 6d 70 6f drop ;.: .impo
26b0: 72 74 38 35 20 28 20 61 64 64 72 20 75 20 2d 2d rt85 ( addr u --
26c0: 20 29 0a 20 20 20 20 6b 65 2d 69 6d 70 6f 72 74 ). ke-import
26d0: 73 20 40 20 3e 69 6d 2d 63 6f 6c 6f 72 20 38 35 s @ >im-color 85
26e0: 74 79 70 65 20 3c 64 65 66 61 75 6c 74 3e 20 3b type <default> ;
26f0: 0a 3a 20 2e 72 73 6b 20 28 20 6e 69 63 6b 20 75 .: .rsk ( nick u
2700: 20 2d 2d 20 29 0a 20 20 20 20 73 6b 72 65 76 20 -- ). skrev
2710: 24 32 30 20 2e 73 74 72 69 70 65 38 35 20 73 70 $20 .stripe85 sp
2720: 61 63 65 20 74 79 70 65 20 2e 22 20 20 28 6b 65 ace type ." (ke
2730: 65 70 20 6f 66 66 6c 69 6e 65 20 63 6f 70 79 21 ep offline copy!
2740: 29 22 20 63 72 20 3b 0a 3a 20 2e 6b 65 79 20 28 )" cr ;.: .key (
2750: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 addr u -- ).
2760: 20 2e 22 20 6e 69 63 6b 3a 20 20 20 22 20 2e 6e ." nick: " .n
2770: 69 63 6b 20 63 72 0a 20 20 20 20 2e 22 20 70 75 ick cr. ." pu
2780: 62 6b 65 79 3a 20 22 20 6b 65 2d 70 6b 20 24 40 bkey: " ke-pk $@
2790: 20 38 35 74 79 70 65 20 63 72 0a 20 20 20 20 6b 85type cr. k
27a0: 65 2d 73 6b 20 40 20 49 46 0a 09 2e 22 20 73 65 e-sk @ IF..." se
27b0: 63 6b 65 79 3a 20 22 20 6b 65 2d 73 6b 20 73 65 ckey: " ke-sk se
27c0: 63 40 20 2e 62 6c 61 63 6b 38 35 20 2e 22 20 20 c@ .black85 ."
27d0: 28 6b 65 65 70 20 73 65 63 72 65 74 21 29 22 20 (keep secret!)"
27e0: 63 72 20 20 54 48 45 4e 0a 20 20 20 20 6b 65 2d cr THEN. ke-
27f0: 77 61 6c 6c 65 74 20 40 20 49 46 0a 09 2e 22 20 wallet @ IF..."
2800: 77 61 6c 6c 65 74 3a 20 22 20 6b 65 2d 77 61 6c wallet: " ke-wal
2810: 6c 65 74 20 73 65 63 40 20 2e 62 6c 61 63 6b 38 let sec@ .black8
2820: 35 20 2e 22 20 20 28 6b 65 65 70 20 73 65 63 72 5 ." (keep secr
2830: 65 74 21 29 22 20 63 72 20 20 54 48 45 4e 0a 20 et!)" cr THEN.
2840: 20 20 20 2e 22 20 76 61 6c 69 64 3a 20 20 22 20 ." valid: "
2850: 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 20 2e 73 ke-selfsig $@ .s
2860: 69 67 64 61 74 65 73 20 63 72 0a 20 20 20 20 2e igdates cr. .
2870: 22 20 67 72 6f 75 70 73 3a 20 22 20 6b 65 2d 67 " groups: " ke-g
2880: 72 6f 75 70 73 20 24 40 20 2e 69 6e 2d 67 72 6f roups $@ .in-gro
2890: 75 70 73 20 63 72 0a 20 20 20 20 2e 22 20 70 65 ups cr. ." pe
28a0: 72 6d 3a 20 20 20 22 20 6b 65 2d 6d 61 73 6b 20 rm: " ke-mask
28b0: 40 20 2e 70 65 72 6d 20 63 72 20 3b 0a 3a 20 2e @ .perm cr ;.: .
28c0: 6b 65 79 2d 72 65 73 74 20 28 20 6f 3a 6b 65 79 key-rest ( o:key
28d0: 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 -- o:key ).
28e0: 6b 65 2d 70 6b 20 24 40 20 6b 65 79 7c 20 2e 69 ke-pk $@ key| .i
28f0: 6d 70 6f 72 74 38 35 0a 20 20 20 20 6b 65 2d 77 mport85. ke-w
2900: 61 6c 6c 65 74 20 73 65 63 40 20 6e 69 70 20 49 allet sec@ nip I
2910: 46 0a 09 77 61 6c 6c 65 74 28 20 73 70 61 63 65 F..wallet( space
2920: 20 6b 65 2d 77 61 6c 6c 65 74 20 73 65 63 40 20 ke-wallet sec@
2930: 2e 62 6c 61 63 6b 38 35 20 29 65 6c 73 65 28 20 .black85 )else(
2940: 2e 22 20 20 57 22 20 29 0a 20 20 20 20 45 4c 53 ." W" ). ELS
2950: 45 20 20 77 61 6c 6c 65 74 28 20 24 31 35 20 29 E wallet( $15 )
2960: 65 6c 73 65 28 20 32 20 29 20 73 70 61 63 65 73 else( 2 ) spaces
2970: 20 54 48 45 4e 0a 20 20 20 20 6b 65 2d 73 65 6c THEN. ke-sel
2980: 66 73 69 67 20 24 40 20 73 70 61 63 65 20 2e 73 fsig $@ space .s
2990: 69 67 64 61 74 65 73 0a 20 20 20 20 6b 65 2d 61 igdates. ke-a
29a0: 76 61 74 61 72 20 24 40 20 64 75 70 20 49 46 20 vatar $@ dup IF
29b0: 73 70 61 63 65 20 38 35 74 79 70 65 20 20 45 4c space 85type EL
29c0: 53 45 20 20 32 64 72 6f 70 20 20 54 48 45 4e 0a SE 2drop THEN.
29d0: 20 20 20 20 6b 65 2d 67 72 6f 75 70 73 20 24 40 ke-groups $@
29e0: 20 32 64 75 70 20 2e 69 6e 2d 67 72 6f 75 70 73 2dup .in-groups
29f0: 20 67 72 6f 75 70 73 3e 6d 61 73 6b 20 69 6e 76 groups>mask inv
2a00: 65 72 74 0a 20 20 20 20 73 70 61 63 65 20 6b 65 ert. space ke
2a10: 2d 6d 61 73 6b 20 40 20 61 6e 64 20 2d 31 20 73 -mask @ and -1 s
2a20: 77 61 70 20 2e 70 65 72 6d 61 6e 64 6f 72 0a 20 wap .permandor.
2a30: 20 20 20 23 74 61 62 20 65 6d 69 74 20 6b 65 2d #tab emit ke-
2a40: 69 6d 70 6f 72 74 73 20 40 20 2e 69 6d 70 6f 72 imports @ .impor
2a50: 74 73 0a 20 20 20 20 73 70 61 63 65 20 2e 6e 69 ts. space .ni
2a60: 63 6b 2b 70 65 74 20 3b 0a 3a 20 2e 6b 65 79 2d ck+pet ;.: .key-
2a70: 6c 69 73 74 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 list ( o:key --
2a80: 6f 3a 6b 65 79 20 29 0a 20 20 20 20 6b 65 2d 69 o:key ). ke-i
2a90: 6d 70 6f 72 74 73 20 40 20 5b 20 31 20 69 6d 70 mports @ [ 1 imp
2aa0: 6f 72 74 23 70 72 6f 76 69 73 69 6f 6e 61 6c 20 ort#provisional
2ab0: 6c 73 68 69 66 74 20 5d 4c 20 61 6e 64 20 3f 45 lshift ]L and ?E
2ac0: 58 49 54 0a 20 20 20 20 6b 65 2d 6f 66 66 73 65 XIT. ke-offse
2ad0: 74 20 36 34 40 20 36 34 3e 64 20 6b 65 79 70 61 t 64@ 64>d keypa
2ae0: 63 6b 2d 61 6c 6c 23 20 66 6d 2f 6d 6f 64 20 6e ck-all# fm/mod n
2af0: 69 70 20 33 20 2e 72 20 73 70 61 63 65 0a 20 20 ip 3 .r space.
2b00: 20 20 2e 6b 65 79 2d 72 65 73 74 20 63 72 20 3b .key-rest cr ;
2b10: 0a 0a 5c 20 70 72 69 6e 74 20 69 6e 76 69 74 61 ..\ print invita
2b20: 74 69 6f 6e 73 0a 0a 3a 20 2e 6b 65 79 2d 69 6e tions..: .key-in
2b30: 76 69 74 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 vite ( o:key --
2b40: 6f 3a 6b 65 79 20 29 0a 20 20 20 20 6b 65 2d 70 o:key ). ke-p
2b50: 6b 20 24 40 20 6b 65 79 73 69 7a 65 20 75 6d 69 k $@ keysize umi
2b60: 6e 0a 20 20 20 20 6b 65 2d 69 6d 70 6f 72 74 73 n. ke-imports
2b70: 20 40 20 3e 69 6d 2d 63 6f 6c 6f 72 20 38 35 74 @ >im-color 85t
2b80: 79 70 65 20 3c 64 65 66 61 75 6c 74 3e 0a 20 20 ype <default>.
2b90: 20 20 73 70 61 63 65 20 2e 6e 69 63 6b 20 73 70 space .nick sp
2ba0: 61 63 65 20 3b 0a 3a 20 2e 6b 65 79 2d 73 68 6f ace ;.: .key-sho
2bb0: 72 74 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a rt ( o:key -- o:
2bc0: 6b 65 79 20 29 0a 20 20 20 20 6b 65 2d 6e 69 63 key ). ke-nic
2bd0: 6b 20 24 2e 20 6b 65 2d 70 72 6f 66 20 24 40 6c k $. ke-prof $@l
2be0: 65 6e 20 49 46 20 2e 22 20 20 70 72 6f 66 69 6c en IF ." profil
2bf0: 65 3a 20 22 20 6b 65 2d 70 72 6f 66 20 24 40 20 e: " ke-prof $@
2c00: 38 35 74 79 70 65 20 54 48 45 4e 20 3b 0a 0a 5c 85type THEN ;..\
2c10: 20 70 72 69 6e 74 20 73 6f 72 74 65 64 20 6c 69 print sorted li
2c20: 73 74 20 6f 66 20 6b 65 79 73 20 62 79 20 6e 69 st of keys by ni
2c30: 63 6b 0a 0a 56 61 72 69 61 62 6c 65 20 6b 65 79 ck..Variable key
2c40: 2d 6c 69 73 74 5b 5d 0a 3a 20 24 69 6e 73 5b 5d -list[].: $ins[]
2c50: 6b 65 79 20 28 20 6f 3a 6b 65 79 20 24 61 72 72 key ( o:key $arr
2c60: 61 79 20 2d 2d 20 70 6f 73 20 29 0a 20 20 20 20 ay -- pos ).
2c70: 5c 47 20 69 6e 73 65 72 74 20 4f 28 6c 6f 67 28 \G insert O(log(
2c80: 6e 29 29 20 69 6e 74 6f 20 70 72 65 2d 73 6f 72 n)) into pre-sor
2c90: 74 65 64 20 61 72 72 61 79 0a 20 20 20 20 5c 47 ted array. \G
2ca0: 20 40 76 61 72 7b 70 6f 73 7d 20 69 73 20 74 68 @var{pos} is th
2cb0: 65 20 69 6e 73 65 72 74 69 6f 6e 20 6f 66 66 73 e insertion offs
2cc0: 65 74 20 6f 72 20 2d 31 20 69 66 20 6e 6f 74 20 et or -1 if not
2cd0: 69 6e 73 65 72 74 65 64 0a 20 20 20 20 7b 20 61 inserted. { a
2ce0: 5b 5d 20 7d 20 30 20 61 5b 5d 20 24 5b 5d 23 0a [] } 0 a[] $[]#.
2cf0: 20 20 20 20 42 45 47 49 4e 20 20 32 64 75 70 20 BEGIN 2dup
2d00: 75 3c 20 20 57 48 49 4c 45 20 20 32 64 75 70 20 u< WHILE 2dup
2d10: 2b 20 32 2f 20 7b 20 6c 65 66 74 20 72 69 67 68 + 2/ { left righ
2d20: 74 20 24 23 20 7d 0a 09 20 20 20 20 6b 65 2d 6e t $# }.. ke-n
2d30: 69 63 6b 20 24 40 20 24 23 20 61 5b 5d 20 24 5b ick $@ $# a[] $[
2d40: 5d 20 40 20 2e 6b 65 2d 6e 69 63 6b 20 24 40 20 ] @ .ke-nick $@
2d50: 63 6f 6d 70 61 72 65 20 64 75 70 20 30 3d 20 49 compare dup 0= I
2d60: 46 0a 09 09 64 72 6f 70 20 6b 65 2d 6e 69 63 6b F...drop ke-nick
2d70: 23 20 40 20 24 23 20 61 5b 5d 20 24 5b 5d 20 40 # @ $# a[] $[] @
2d80: 20 2e 6b 65 2d 6e 69 63 6b 23 20 40 20 2d 20 20 .ke-nick# @ -
2d90: 54 48 45 4e 0a 09 20 20 20 20 30 3c 20 49 46 20 THEN.. 0< IF
2da0: 20 6c 65 66 74 20 24 23 20 20 45 4c 53 45 20 20 left $# ELSE
2db0: 24 23 20 31 2b 20 72 69 67 68 74 20 20 54 48 45 $# 1+ right THE
2dc0: 4e 0a 20 20 20 20 52 45 50 45 41 54 20 20 64 72 N. REPEAT dr
2dd0: 6f 70 20 3e 72 0a 20 20 20 20 6f 20 7b 20 77 5e op >r. o { w^
2de0: 20 69 6e 73 24 30 20 7d 20 69 6e 73 24 30 20 63 ins$0 } ins$0 c
2df0: 65 6c 6c 20 61 5b 5d 20 72 40 20 63 65 6c 6c 73 ell a[] r@ cells
2e00: 20 24 69 6e 73 20 72 3e 20 3b 0a 3a 20 6b 65 79 $ins r> ;.: key
2e10: 73 3e 73 6f 72 74 5b 5d 20 28 20 2d 2d 20 29 20 s>sort[] ( -- )
2e20: 20 6b 65 79 2d 6c 69 73 74 5b 5d 20 24 66 72 65 key-list[] $fre
2e30: 65 0a 20 20 20 20 6b 65 79 23 20 5b 3a 20 63 65 e. key# [: ce
2e40: 6c 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 6c 6c ll+ $@ drop cell
2e50: 2b 20 3e 6f 20 6b 65 79 2d 6c 69 73 74 5b 5d 20 + >o key-list[]
2e60: 24 69 6e 73 5b 5d 6b 65 79 20 64 72 6f 70 20 6f $ins[]key drop o
2e70: 3e 20 3b 5d 20 23 6d 61 70 20 3b 0a 3a 20 6c 69 > ;] #map ;.: li
2e80: 73 74 2d 6b 65 79 73 20 28 20 2d 2d 20 29 0a 20 st-keys ( -- ).
2e90: 20 20 20 6b 65 79 73 3e 73 6f 72 74 5b 5d 0a 20 keys>sort[].
2ea0: 20 20 20 2e 22 20 63 6f 6c 6f 72 73 3a 20 22 20 ." colors: "
2eb0: 2e 69 6d 70 6f 72 74 2d 63 6f 6c 6f 72 73 20 63 .import-colors c
2ec0: 72 0a 20 20 20 20 2e 22 20 6e 75 6d 20 70 75 62 r. ." num pub
2ed0: 6b 65 79 20 20 20 20 20 20 20 20 20 20 20 20 20 key
2ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ef0: 20 20 20 20 20 20 22 0a 20 20 20 20 77 61 6c 6c ". wall
2f00: 65 74 28 20 2e 22 20 77 61 6c 6c 65 74 20 20 20 et( ." wallet
2f10: 20 20 20 20 20 20 20 20 20 20 22 20 29 0a 20 20 " ).
2f20: 20 20 2e 22 20 20 20 64 61 74 65 20 20 20 20 20 ." date
2f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f40: 67 72 70 2b 70 72 6d 20 68 20 6e 69 63 6b 22 20 grp+prm h nick"
2f50: 63 72 0a 20 20 20 20 6b 65 79 2d 6c 69 73 74 5b cr. key-list[
2f60: 5d 20 24 40 20 62 6f 75 6e 64 73 20 3f 44 4f 20 ] $@ bounds ?DO
2f70: 20 49 20 40 20 2e 2e 6b 65 79 2d 6c 69 73 74 20 I @ ..key-list
2f80: 20 63 65 6c 6c 20 2b 4c 4f 4f 50 20 3b 0a 3a 20 cell +LOOP ;.:
2f90: 6c 69 73 74 2d 6e 69 63 6b 73 20 28 20 2d 2d 20 list-nicks ( --
2fa0: 29 0a 20 20 20 20 6e 69 63 6b 23 20 5b 3a 20 64 ). nick# [: d
2fb0: 75 70 20 24 2e 20 2e 22 20 3a 22 20 63 72 20 63 up $. ." :" cr c
2fc0: 65 6c 6c 2b 20 24 40 20 62 6f 75 6e 64 73 20 3f ell+ $@ bounds ?
2fd0: 44 4f 0a 20 20 20 20 20 20 49 20 40 20 2e 2e 6b DO. I @ ..k
2fe0: 65 79 2d 6c 69 73 74 20 20 63 65 6c 6c 20 2b 4c ey-list cell +L
2ff0: 4f 4f 50 20 3b 5d 20 23 6d 61 70 20 3b 0a 0a 5c OOP ;] #map ;..\
3000: 20 6c 69 73 74 20 6f 66 20 73 65 63 72 65 74 20 list of secret
3010: 6b 65 79 73 20 74 6f 20 73 65 6c 65 63 74 20 66 keys to select f
3020: 72 6f 6d 0a 0a 56 61 72 69 61 62 6c 65 20 73 65 rom..Variable se
3030: 63 72 65 74 2d 6e 69 63 6b 73 5b 5d 0a 56 61 72 cret-nicks[].Var
3040: 69 61 62 6c 65 20 73 65 63 72 65 74 2d 6e 69 63 iable secret-nic
3050: 6b 73 23 0a 3a 20 2e 73 65 63 72 65 74 2d 6e 69 ks#.: .secret-ni
3060: 63 6b 73 2d 69 6e 73 65 72 74 20 28 20 2d 2d 20 cks-insert ( --
3070: 29 0a 20 20 20 20 73 65 63 72 65 74 2d 6e 69 63 ). secret-nic
3080: 6b 73 5b 5d 20 24 66 72 65 65 20 20 73 65 63 72 ks[] $free secr
3090: 65 74 2d 6e 69 63 6b 73 23 20 24 66 72 65 65 0a et-nicks# $free.
30a0: 20 20 20 20 30 20 6b 65 79 23 20 5b 3a 20 63 65 0 key# [: ce
30b0: 6c 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 6c 6c ll+ $@ drop cell
30c0: 2b 20 3e 6f 20 6b 65 2d 73 6b 20 40 20 49 46 0a + >o ke-sk @ IF.
30d0: 09 20 20 73 65 63 72 65 74 2d 6e 69 63 6b 73 5b . secret-nicks[
30e0: 5d 20 24 69 6e 73 5b 5d 6b 65 79 20 3e 72 0a 09 ] $ins[]key >r..
30f0: 20 20 64 75 70 20 7b 20 63 5e 20 78 20 7d 20 78 dup { c^ x } x
3100: 20 31 20 73 65 63 72 65 74 2d 6e 69 63 6b 73 23 1 secret-nicks#
3110: 20 72 3e 20 24 69 6e 73 20 20 31 2b 0a 20 20 20 r> $ins 1+.
3120: 20 20 20 54 48 45 4e 20 6f 3e 20 3b 5d 20 23 6d THEN o> ;] #m
3130: 61 70 20 64 72 6f 70 20 3b 0a 3a 20 6e 69 63 6b ap drop ;.: nick
3140: 23 3e 6b 65 79 23 20 28 20 6e 31 20 2d 2d 20 6e #>key# ( n1 -- n
3150: 32 20 29 0a 20 20 20 20 73 65 63 72 65 74 2d 6e 2 ). secret-n
3160: 69 63 6b 73 23 20 24 40 20 72 6f 74 20 73 61 66 icks# $@ rot saf
3170: 65 2f 73 74 72 69 6e 67 20 49 46 20 20 63 40 20 e/string IF c@
3180: 20 45 4c 53 45 20 20 64 72 6f 70 20 2d 31 20 20 ELSE drop -1
3190: 54 48 45 4e 20 3b 0a 3a 20 2e 73 65 63 72 65 74 THEN ;.: .secret
31a0: 2d 6e 69 63 6b 73 20 28 20 2d 2d 20 29 0a 20 20 -nicks ( -- ).
31b0: 20 20 2e 73 65 63 72 65 74 2d 6e 69 63 6b 73 2d .secret-nicks-
31c0: 69 6e 73 65 72 74 0a 20 20 20 20 73 65 63 72 65 insert. secre
31d0: 74 2d 6e 69 63 6b 73 5b 5d 20 24 5b 5d 23 20 30 t-nicks[] $[]# 0
31e0: 20 3f 44 4f 0a 09 49 20 31 20 5b 27 5d 20 2e 72 ?DO..I 1 ['] .r
31f0: 20 23 33 36 20 62 61 73 65 2d 65 78 65 63 75 74 #36 base-execut
3200: 65 20 73 70 61 63 65 0a 09 49 20 73 65 63 72 65 e space..I secre
3210: 74 2d 6e 69 63 6b 73 5b 5d 20 24 5b 5d 20 40 20 t-nicks[] $[] @
3220: 2e 2e 6b 65 79 2d 72 65 73 74 20 63 72 0a 20 20 ..key-rest cr.
3230: 20 20 4c 4f 4f 50 20 3b 0a 0a 5c 20 64 75 6d 70 LOOP ;..\ dump
3240: 20 6b 65 79 73 0a 0a 3a 20 64 75 6d 70 6b 65 79 keys..: dumpkey
3250: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 64 ( addr u -- ) d
3260: 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 0a 20 20 20 rop cell+ >o.
3270: 20 2e 5c 22 20 78 5c 22 20 22 20 6b 65 2d 70 6b .\" x\" " ke-pk
3280: 20 24 40 20 38 35 74 79 70 65 20 2e 5c 22 20 5c $@ 85type .\" \
3290: 22 20 6b 65 79 3f 6e 65 77 22 20 63 72 0a 20 20 " key?new" cr.
32a0: 20 20 6b 65 2d 73 6b 20 40 20 49 46 20 20 2e 5c ke-sk @ IF .\
32b0: 22 20 78 5c 22 20 22 20 6b 65 2d 73 6b 20 40 20 " x\" " ke-sk @
32c0: 6b 65 79 73 69 7a 65 20 38 35 74 79 70 65 20 2e keysize 85type .
32d0: 5c 22 20 5c 22 20 6b 65 2d 73 6b 20 73 65 63 21 \" \" ke-sk sec!
32e0: 20 2b 73 65 63 6b 65 79 22 20 63 72 20 20 54 48 +seckey" cr TH
32f0: 45 4e 0a 20 20 20 20 27 22 27 20 65 6d 69 74 20 EN. '"' emit
3300: 2e 6e 69 63 6b 20 2e 5c 22 20 5c 22 20 6b 65 2d .nick .\" \" ke-
3310: 6e 69 63 6b 20 24 21 20 22 0a 20 20 20 20 6b 65 nick $! ". ke
3320: 2d 73 65 6c 66 73 69 67 20 24 40 20 64 72 6f 70 -selfsig $@ drop
3330: 20 36 34 40 20 36 34 3e 64 20 5b 3a 20 27 24 27 64@ 64>d [: '$'
3340: 20 65 6d 69 74 20 30 20 75 64 2e 72 20 3b 5d 20 emit 0 ud.r ;]
3350: 24 31 30 20 62 61 73 65 2d 65 78 65 63 75 74 65 $10 base-execute
3360: 0a 20 20 20 20 2e 22 20 2e 20 64 3e 36 34 20 6b . ." . d>64 k
3370: 65 2d 66 69 72 73 74 21 20 22 20 6b 65 2d 74 79 e-first! " ke-ty
3380: 70 65 20 40 20 2e 20 2e 22 20 6b 65 2d 74 79 70 pe @ . ." ke-typ
3390: 65 20 21 22 20 20 63 72 20 6f 3e 20 3b 0a 0a 3a e !" cr o> ;..:
33a0: 20 2e 6b 65 79 73 20 28 20 2d 2d 20 29 20 6b 65 .keys ( -- ) ke
33b0: 79 23 20 5b 3a 20 2e 22 20 69 6e 64 65 78 3a 20 y# [: ." index:
33c0: 22 20 64 75 70 20 24 40 20 38 35 74 79 70 65 20 " dup $@ 85type
33d0: 63 72 20 63 65 6c 6c 2b 20 24 40 0a 09 20 64 72 cr cell+ $@.. dr
33e0: 6f 70 20 63 65 6c 6c 2b 20 2e 2e 6b 65 79 20 3b op cell+ ..key ;
33f0: 5d 20 23 6d 61 70 20 3b 0a 3a 20 64 75 6d 70 6b ] #map ;.: dumpk
3400: 65 79 73 20 28 20 2d 2d 20 29 20 6b 65 79 23 20 eys ( -- ) key#
3410: 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 75 6d 70 [: cell+ $@ dump
3420: 6b 65 79 20 3b 5d 20 23 6d 61 70 20 3b 0a 0a 3a key ;] #map ;..:
3430: 20 6b 65 79 3e 6f 20 28 20 61 64 64 72 6b 65 79 key>o ( addrkey
3440: 20 75 31 20 2d 2d 20 6f 20 2f 20 30 20 29 0a 20 u1 -- o / 0 ).
3450: 20 20 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 key| key# #@
3460: 30 3d 20 49 46 20 20 64 72 6f 70 20 30 20 20 45 0= IF drop 0 E
3470: 58 49 54 20 20 54 48 45 4e 20 20 63 65 6c 6c 2b XIT THEN cell+
3480: 20 3b 0a 3a 20 6b 65 79 3e 6e 69 63 6b 20 28 20 ;.: key>nick (
3490: 61 64 64 72 6b 65 79 20 75 31 20 2d 2d 20 6e 69 addrkey u1 -- ni
34a0: 63 6b 20 75 32 20 29 0a 20 20 20 20 5c 47 20 63 ck u2 ). \G c
34b0: 6f 6e 76 65 72 74 20 6b 65 79 20 74 6f 20 6e 69 onvert key to ni
34c0: 63 6b 0a 20 20 20 20 6b 65 79 3e 6f 20 64 75 70 ck. key>o dup
34d0: 20 49 46 20 20 2e 6b 65 2d 6e 69 63 6b 20 24 40 IF .ke-nick $@
34e0: 20 20 45 4c 53 45 20 20 30 20 20 54 48 45 4e 20 ELSE 0 THEN
34f0: 3b 0a 3a 20 6b 65 79 3e 6b 65 79 20 28 20 61 64 ;.: key>key ( ad
3500: 64 72 6b 65 79 20 75 31 20 2d 2d 20 6b 65 79 20 drkey u1 -- key
3510: 75 32 20 29 0a 20 20 20 20 5c 47 20 65 78 70 61 u2 ). \G expa
3520: 6e 64 20 6b 65 79 20 74 6f 20 66 75 6c 6c 20 73 nd key to full s
3530: 69 7a 65 20 61 6e 64 20 63 68 65 63 6b 20 69 66 ize and check if
3540: 20 77 65 20 6b 6e 6f 77 20 69 74 0a 20 20 20 20 we know it.
3550: 6b 65 79 3e 6f 20 64 75 70 20 49 46 20 20 2e 6b key>o dup IF .k
3560: 65 2d 70 6b 20 24 40 20 20 45 4c 53 45 20 20 30 e-pk $@ ELSE 0
3570: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 2e 6b 65 79 THEN ;..: .key
3580: 23 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 # ( addr u -- )
3590: 6b 65 79 7c 0a 20 20 20 20 2e 22 20 4b 65 79 20 key|. ." Key
35a0: 27 22 20 6b 65 79 23 20 23 40 20 30 3d 20 49 46 '" key# #@ 0= IF
35b0: 20 64 72 6f 70 20 45 58 49 54 20 54 48 45 4e 0a drop EXIT THEN.
35c0: 20 20 20 20 63 65 6c 6c 2b 20 2e 2e 6e 69 63 6b cell+ ..nick
35d0: 20 2e 22 20 27 20 6f 6b 22 20 63 72 20 3b 0a 0a ." ' ok" cr ;..
35e0: 46 6f 72 77 61 72 64 20 64 68 74 2d 6e 69 63 6b Forward dht-nick
35f0: 3f 0a 56 61 72 69 61 62 6c 65 20 6b 65 79 73 65 ?.Variable keyse
3600: 61 72 63 68 73 23 0a 68 61 73 68 3a 20 75 6e 6b archs#.hash: unk
3610: 6e 6f 77 6e 2d 6b 65 79 73 23 0a 0a 65 76 65 6e nown-keys#..even
3620: 74 3a 20 3a 3e 73 65 61 72 63 68 2d 6b 65 79 20 t: :>search-key
3630: 28 20 24 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 ( $addr -- ).
3640: 20 7b 20 77 5e 20 6b 65 79 20 7d 20 6b 65 79 20 { w^ key } key
3650: 24 40 20 64 68 74 2d 6e 69 63 6b 3f 20 6b 65 79 $@ dht-nick? key
3660: 20 24 66 72 65 65 0a 20 20 20 20 31 20 6b 65 79 $free. 1 key
3670: 73 65 61 72 63 68 73 23 20 2b 21 40 20 64 72 6f searchs# +!@ dro
3680: 70 20 3b 0a 0a 3a 20 2e 75 6e 6b 65 79 2d 69 64 p ;..: .unkey-id
3690: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 3c ( addr u -- ) <
36a0: 65 72 72 3e 20 38 20 75 6d 69 6e 20 38 35 74 79 err> 8 umin 85ty
36b0: 70 65 20 2e 22 20 28 75 6e 6b 6e 6f 77 6e 29 22 pe ." (unknown)"
36c0: 20 3c 64 65 66 61 75 6c 74 3e 0a 20 20 20 20 5b <default>. [
36d0: 20 31 20 69 6d 70 6f 72 74 23 75 6e 74 72 75 73 1 import#untrus
36e0: 74 65 64 20 6c 73 68 69 66 74 20 5d 4c 20 74 6f ted lshift ]L to
36f0: 20 6c 61 73 74 2d 6b 69 20 3b 0a 0a 3a 20 2e 6b last-ki ;..: .k
3700: 65 79 2d 69 64 20 28 20 61 64 64 72 20 75 20 2d ey-id ( addr u -
3710: 2d 20 29 20 20 6c 61 73 74 23 20 3e 72 20 20 6b - ) last# >r k
3720: 65 79 7c 20 32 64 75 70 20 6b 65 79 23 20 23 40 ey| 2dup key# #@
3730: 20 30 3d 0a 20 20 20 20 49 46 20 20 64 72 6f 70 0=. IF drop
3740: 20 6b 65 79 73 65 61 72 63 68 73 23 20 40 20 31 keysearchs# @ 1
3750: 2b 20 3e 72 0a 09 32 64 75 70 20 75 6e 6b 6e 6f + >r..2dup unkno
3760: 77 6e 2d 6b 65 79 73 23 20 23 40 20 6e 69 70 20 wn-keys# #@ nip
3770: 30 3d 20 64 68 74 2d 63 6f 6e 6e 65 63 74 69 6f 0= dht-connectio
3780: 6e 20 61 6e 64 20 49 46 0a 09 20 20 20 20 3c 65 n and IF.. <e
3790: 76 65 6e 74 20 32 64 75 70 20 24 6d 61 6b 65 20 vent 2dup $make
37a0: 65 6c 69 74 2c 20 3a 3e 73 65 61 72 63 68 2d 6b elit, :>search-k
37b0: 65 79 20 3f 71 75 65 72 79 2d 74 61 73 6b 20 65 ey ?query-task e
37c0: 76 65 6e 74 7c 0a 09 20 20 20 20 42 45 47 49 4e vent|.. BEGIN
37d0: 20 20 6b 65 79 73 65 61 72 63 68 73 23 20 40 20 keysearchs# @
37e0: 72 40 20 2d 20 30 3c 20 20 57 48 49 4c 45 20 20 r@ - 0< WHILE
37f0: 3c 65 76 65 6e 74 20 20 71 75 65 72 79 2d 74 61 <event query-ta
3800: 73 6b 20 65 76 65 6e 74 7c 20 20 52 45 50 45 41 sk event| REPEA
3810: 54 0a 09 20 20 20 20 72 64 72 6f 70 20 20 32 64 T.. rdrop 2d
3820: 75 70 20 6b 65 79 23 20 23 40 20 30 3d 20 49 46 up key# #@ 0= IF
3830: 20 20 64 72 6f 70 0a 09 09 22 3c 75 6e 6b 6e 6f drop..."<unkno
3840: 77 6e 3e 22 20 32 6f 76 65 72 20 75 6e 6b 6e 6f wn>" 2over unkno
3850: 77 6e 2d 6b 65 79 73 23 20 23 21 0a 09 09 2e 75 wn-keys# #!....u
3860: 6e 6b 65 79 2d 69 64 20 20 72 3e 20 74 6f 20 6c nkey-id r> to l
3870: 61 73 74 23 20 45 58 49 54 20 20 54 48 45 4e 0a ast# EXIT THEN.
3880: 09 45 4c 53 45 20 20 72 64 72 6f 70 20 2e 75 6e .ELSE rdrop .un
3890: 6b 65 79 2d 69 64 20 20 72 3e 20 74 6f 20 6c 61 key-id r> to la
38a0: 73 74 23 20 20 45 58 49 54 20 20 54 48 45 4e 0a st# EXIT THEN.
38b0: 20 20 20 20 54 48 45 4e 0a 20 20 20 20 63 65 6c THEN. cel
38c0: 6c 2b 20 2e 2e 6e 69 63 6b 20 32 64 72 6f 70 20 l+ ..nick 2drop
38d0: 72 3e 20 74 6f 20 6c 61 73 74 23 20 3b 0a 0a 3a r> to last# ;..:
38e0: 20 2e 6b 65 79 2d 69 64 3f 20 28 20 61 64 64 72 .key-id? ( addr
38f0: 20 75 20 2d 2d 20 29 20 20 6c 61 73 74 23 20 3e u -- ) last# >
3900: 72 20 20 6b 65 79 7c 20 32 64 75 70 20 6b 65 79 r key| 2dup key
3910: 23 20 23 40 20 30 3d 0a 20 20 20 20 49 46 20 20 # #@ 0=. IF
3920: 64 72 6f 70 20 2e 75 6e 6b 65 79 2d 69 64 20 20 drop .unkey-id
3930: 72 3e 20 74 6f 20 6c 61 73 74 23 20 45 58 49 54 r> to last# EXIT
3940: 20 20 54 48 45 4e 0a 20 20 20 20 63 65 6c 6c 2b THEN. cell+
3950: 20 2e 2e 6e 69 63 6b 20 32 64 72 6f 70 20 72 3e ..nick 2drop r>
3960: 20 74 6f 20 6c 61 73 74 23 20 3b 0a 0a 3a 20 2e to last# ;..: .
3970: 63 6f 6e 2d 69 64 20 28 20 6f 3a 63 6f 6e 6e 65 con-id ( o:conne
3980: 63 74 69 6f 6e 20 2d 2d 20 29 20 70 75 62 6b 65 ction -- ) pubke
3990: 79 20 24 40 20 2e 6b 65 79 2d 69 64 20 3b 0a 0a y $@ .key-id ;..
39a0: 3a 20 2e 73 69 6d 70 6c 65 2d 69 64 20 28 20 61 : .simple-id ( a
39b0: 64 64 72 20 75 20 2d 2d 20 29 20 6c 61 73 74 23 ddr u -- ) last#
39c0: 20 3e 72 0a 20 20 20 20 6b 65 79 3e 6f 20 64 75 >r. key>o du
39d0: 70 20 49 46 20 20 2e 2e 6e 69 63 6b 2d 62 61 73 p IF ..nick-bas
39e0: 65 20 20 45 4c 53 45 20 20 64 72 6f 70 20 2e 22 e ELSE drop ."
39f0: 20 75 6e 6b 6e 6f 77 6e 22 20 20 54 48 45 4e 0a unknown" THEN.
3a00: 20 20 20 20 72 3e 20 74 6f 20 6c 61 73 74 23 20 r> to last#
3a10: 3b 0a 0a 3a 20 63 68 65 63 6b 2d 6b 65 79 20 28 ;..: check-key (
3a20: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 addr u -- ).
3a30: 20 6f 20 49 46 20 20 70 75 62 6b 65 79 20 40 20 o IF pubkey @
3a40: 49 46 0a 09 20 20 20 20 32 64 75 70 20 70 75 62 IF.. 2dup pub
3a50: 6b 65 79 20 24 40 20 6b 65 79 7c 20 73 74 72 3d key $@ key| str=
3a60: 20 30 3d 20 49 46 0a 09 09 5b 3a 20 2e 22 20 77 0= IF...[: ." w
3a70: 61 6e 74 3a 20 22 20 70 75 62 6b 65 79 20 24 40 ant: " pubkey $@
3a80: 20 6b 65 79 7c 20 38 35 74 79 70 65 20 63 72 0a key| 85type cr.
3a90: 09 09 20 20 2e 22 20 67 6f 74 20 3a 20 22 20 32 .. ." got : " 2
3aa0: 64 75 70 20 38 35 74 79 70 65 20 63 72 20 3b 5d dup 85type cr ;]
3ab0: 20 24 65 72 72 0a 09 09 74 72 75 65 20 21 21 77 $err...true !!w
3ac0: 72 6f 6e 67 2d 6b 65 79 21 21 0a 09 20 20 20 20 rong-key!!..
3ad0: 54 48 45 4e 0a 09 20 20 20 20 63 6f 6e 6e 65 63 THEN.. connec
3ae0: 74 28 20 2e 6b 65 79 23 20 29 65 6c 73 65 28 20 t( .key# )else(
3af0: 32 64 72 6f 70 20 29 20 20 45 58 49 54 0a 09 54 2drop ) EXIT..T
3b00: 48 45 4e 20 20 54 48 45 4e 0a 20 20 20 20 32 64 HEN THEN. 2d
3b10: 75 70 20 6b 65 79 2d 65 78 69 73 74 3f 0a 20 20 up key-exist?.
3b20: 20 20 3f 64 75 70 2d 30 3d 2d 49 46 20 20 70 65 ?dup-0=-IF pe
3b30: 72 6d 25 75 6e 6b 6e 6f 77 6e 20 20 45 4c 53 45 rm%unknown ELSE
3b40: 20 20 2e 6b 65 2d 6d 61 73 6b 20 40 20 20 54 48 .ke-mask @ TH
3b50: 45 4e 20 20 74 6d 70 2d 70 65 72 6d 20 21 0a 20 EN tmp-perm !.
3b60: 20 20 20 63 6f 6e 6e 65 63 74 28 20 32 64 75 70 connect( 2dup
3b70: 20 2e 6b 65 79 23 20 29 0a 20 20 20 20 74 6d 70 .key# ). tmp
3b80: 2d 70 65 72 6d 20 40 20 70 65 72 6d 25 62 6c 6f -perm @ perm%blo
3b90: 63 6b 65 64 20 61 6e 64 20 49 46 0a 09 5b 3a 20 cked and IF..[:
3ba0: 2e 22 20 55 6e 6b 6e 6f 77 6e 20 6b 65 79 2c 20 ." Unknown key,
3bb0: 63 6f 6e 6e 65 63 74 69 6f 6e 20 72 65 66 75 73 connection refus
3bc0: 65 64 3a 20 22 20 38 35 74 79 70 65 20 63 72 20 ed: " 85type cr
3bd0: 3b 5d 20 24 65 72 72 0a 09 74 72 75 65 20 21 21 ;] $err..true !!
3be0: 63 6f 6e 6e 65 63 74 2d 70 65 72 6d 21 21 0a 20 connect-perm!!.
3bf0: 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 ELSE 2drop
3c00: 54 48 45 4e 20 3b 0a 0a 3a 20 73 65 61 72 63 68 THEN ;..: search
3c10: 2d 6b 65 79 20 28 20 70 6b 63 20 2d 2d 20 6f 20 -key ( pkc -- o
3c20: 73 6b 63 20 29 0a 20 20 20 20 6b 65 79 73 69 7a skc ). keysiz
3c30: 65 20 6b 65 79 23 20 23 40 20 30 3d 20 21 21 75 e key# #@ 0= !!u
3c40: 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21 0a 20 20 20 nknown-key!!.
3c50: 20 63 65 6c 6c 2b 20 64 75 70 20 2e 6b 65 2d 73 cell+ dup .ke-s
3c60: 6b 20 73 65 63 40 20 30 3d 20 21 21 75 6e 6b 6e k sec@ 0= !!unkn
3c70: 6f 77 6e 2d 6b 65 79 21 21 20 3b 0a 3a 20 73 65 own-key!! ;.: se
3c80: 61 72 63 68 2d 6b 65 79 3f 20 28 20 70 6b 63 20 arch-key? ( pkc
3c90: 2d 2d 20 66 61 6c 73 65 20 2f 20 6f 20 73 6b 63 -- false / o skc
3ca0: 20 29 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 6b ). keysize k
3cb0: 65 79 23 20 23 40 20 30 3d 20 49 46 20 20 64 72 ey# #@ 0= IF dr
3cc0: 6f 70 20 30 20 20 45 58 49 54 20 20 54 48 45 4e op 0 EXIT THEN
3cd0: 0a 20 20 20 20 63 65 6c 6c 2b 20 64 75 70 20 2e . cell+ dup .
3ce0: 6b 65 2d 73 6b 20 73 65 63 40 20 30 3d 20 49 46 ke-sk sec@ 0= IF
3cf0: 20 20 32 64 72 6f 70 20 30 20 20 45 58 49 54 20 2drop 0 EXIT
3d00: 20 54 48 45 4e 20 3b 0a 0a 5c 20 61 70 70 6c 79 THEN ;..\ apply
3d10: 20 70 65 72 6d 69 73 73 69 6f 6e 73 26 67 72 6f permissions&gro
3d20: 75 70 73 0a 0a 3a 20 61 70 70 6c 79 2d 70 65 72 ups..: apply-per
3d30: 6d 69 73 73 69 6f 6e 20 28 20 70 65 72 6d 61 6e mission ( perman
3d40: 64 20 70 65 72 6d 6f 72 20 6f 3a 6b 65 79 20 2d d permor o:key -
3d50: 2d 20 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72 - permand permor
3d60: 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 6f 76 65 o:key ). ove
3d70: 72 20 6b 65 2d 6d 61 73 6b 20 40 20 61 6e 64 20 r ke-mask @ and
3d80: 6f 76 65 72 20 6f 72 20 6b 65 2d 6d 61 73 6b 20 over or ke-mask
3d90: 21 20 2e 6b 65 79 2d 6c 69 73 74 20 3b 0a 0a 3a ! .key-list ;..:
3da0: 20 2d 67 72 6f 75 70 2d 70 65 72 6d 20 28 20 6f -group-perm ( o
3db0: 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 :key -- ). ke
3dc0: 2d 67 72 6f 75 70 73 20 24 40 20 67 72 6f 75 70 -groups $@ group
3dd0: 73 3e 6d 61 73 6b 20 69 6e 76 65 72 74 20 6b 65 s>mask invert ke
3de0: 2d 6d 61 73 6b 20 61 6e 64 21 20 3b 0a 3a 20 2b -mask and! ;.: +
3df0: 67 72 6f 75 70 2d 70 65 72 6d 20 28 20 6f 3a 6b group-perm ( o:k
3e00: 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 67 ey -- ). ke-g
3e10: 72 6f 75 70 73 20 24 40 20 67 72 6f 75 70 73 3e roups $@ groups>
3e20: 6d 61 73 6b 20 20 20 20 20 20 20 20 6b 65 2d 6d mask ke-m
3e30: 61 73 6b 20 6f 72 21 20 3b 0a 0a 3a 20 61 64 64 ask or! ;..: add
3e40: 2d 67 72 6f 75 70 20 28 20 69 64 20 6f 3a 6b 65 -group ( id o:ke
3e50: 79 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 2d y -- ). dup -
3e60: 31 20 3d 20 21 21 6e 6f 2d 67 72 6f 75 70 21 21 1 = !!no-group!!
3e70: 20 2d 67 72 6f 75 70 2d 70 65 72 6d 20 75 3e 36 -group-perm u>6
3e80: 34 20 63 6d 64 74 6d 70 24 20 6b 65 2d 67 72 6f 4 cmdtmp$ ke-gro
3e90: 75 70 73 20 24 2b 21 20 2b 67 72 6f 75 70 2d 70 ups $+! +group-p
3ea0: 65 72 6d 20 3b 0a 3a 20 73 65 74 2d 67 72 6f 75 erm ;.: set-grou
3eb0: 70 20 28 20 69 64 20 6f 3a 6b 65 79 20 2d 2d 20 p ( id o:key --
3ec0: 29 0a 20 20 20 20 64 75 70 20 2d 31 20 3d 20 21 ). dup -1 = !
3ed0: 21 6e 6f 2d 67 72 6f 75 70 21 21 20 2d 67 72 6f !no-group!! -gro
3ee0: 75 70 2d 70 65 72 6d 20 75 3e 36 34 20 63 6d 64 up-perm u>64 cmd
3ef0: 74 6d 70 24 20 6b 65 2d 67 72 6f 75 70 73 20 24 tmp$ ke-groups $
3f00: 21 20 2b 67 72 6f 75 70 2d 70 65 72 6d 20 3b 0a ! +group-perm ;.
3f10: 3a 20 73 75 62 2d 67 72 6f 75 70 20 28 20 69 64 : sub-group ( id
3f20: 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 o:key -- ).
3f30: 64 75 70 20 2d 31 20 3d 20 21 21 6e 6f 2d 67 72 dup -1 = !!no-gr
3f40: 6f 75 70 21 21 20 2d 67 72 6f 75 70 2d 70 65 72 oup!! -group-per
3f50: 6d 20 75 3e 36 34 20 63 6d 64 74 6d 70 24 20 6b m u>64 cmdtmp$ k
3f60: 65 2d 67 72 6f 75 70 73 20 24 40 20 32 6f 76 65 e-groups $@ 2ove
3f70: 72 20 73 65 61 72 63 68 0a 20 20 20 20 49 46 20 r search. IF
3f80: 20 20 6e 69 70 20 3e 72 20 6e 69 70 20 6b 65 2d nip >r nip ke-
3f90: 67 72 6f 75 70 73 20 64 75 70 20 24 40 6c 65 6e groups dup $@len
3fa0: 20 72 3e 20 2d 20 72 6f 74 20 24 64 65 6c 0a 20 r> - rot $del.
3fb0: 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 32 ELSE 2drop 2
3fc0: 64 72 6f 70 20 20 54 48 45 4e 20 2b 67 72 6f 75 drop THEN +grou
3fd0: 70 2d 70 65 72 6d 20 3b 0a 0a 3a 20 61 70 70 6c p-perm ;..: appl
3fe0: 79 2d 67 72 6f 75 70 20 28 20 61 64 64 72 20 75 y-group ( addr u
3ff0: 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 o:key -- ).
4000: 6f 76 65 72 20 63 40 20 27 2b 27 20 3d 20 49 46 over c@ '+' = IF
4010: 20 20 31 20 2f 73 74 72 69 6e 67 20 3e 67 72 6f 1 /string >gro
4020: 75 70 2d 69 64 20 61 64 64 2d 67 72 6f 75 70 20 up-id add-group
4030: 2e 6b 65 79 2d 6c 69 73 74 20 20 45 58 49 54 20 .key-list EXIT
4040: 20 54 48 45 4e 0a 20 20 20 20 6f 76 65 72 20 63 THEN. over c
4050: 40 20 27 2d 27 20 3d 20 49 46 20 20 31 20 2f 73 @ '-' = IF 1 /s
4060: 74 72 69 6e 67 20 3e 67 72 6f 75 70 2d 69 64 20 tring >group-id
4070: 73 75 62 2d 67 72 6f 75 70 20 2e 6b 65 79 2d 6c sub-group .key-l
4080: 69 73 74 20 20 45 58 49 54 20 20 54 48 45 4e 0a ist EXIT THEN.
4090: 20 20 20 20 3e 67 72 6f 75 70 2d 69 64 20 73 65 >group-id se
40a0: 74 2d 67 72 6f 75 70 20 2e 6b 65 79 2d 6c 69 73 t-group .key-lis
40b0: 74 20 3b 0a 0a 5c 20 63 61 6c 63 75 6c 61 74 65 t ;..\ calculate
40c0: 20 70 61 73 73 70 68 72 61 73 65 20 65 6e 74 72 passphrase entr
40d0: 6f 70 79 0a 0a 24 31 30 30 20 63 65 6c 6c 73 20 opy..$100 cells
40e0: 62 75 66 66 65 72 3a 20 70 68 2d 68 69 73 74 6f buffer: ph-histo
40f0: 67 72 61 6d 0a 0a 3a 20 3e 70 68 2d 68 69 73 74 gram..: >ph-hist
4100: 6f 67 72 61 6d 20 28 20 61 64 64 72 20 75 20 2d ogram ( addr u -
4110: 2d 20 29 0a 20 20 20 20 5c 47 20 67 65 6e 65 72 - ). \G gener
4120: 61 74 65 20 61 20 68 69 73 74 6f 67 72 61 6d 20 ate a histogram
4130: 6f 66 20 62 79 74 65 73 20 69 6e 20 61 20 73 74 of bytes in a st
4140: 72 69 6e 67 0a 20 20 20 20 70 68 2d 68 69 73 74 ring. ph-hist
4150: 6f 67 72 61 6d 20 24 31 30 30 20 63 65 6c 6c 73 ogram $100 cells
4160: 20 65 72 61 73 65 0a 20 20 20 20 62 6f 75 6e 64 erase. bound
4170: 73 20 3f 44 4f 20 20 31 20 49 20 63 40 20 63 65 s ?DO 1 I c@ ce
4180: 6c 6c 73 20 70 68 2d 68 69 73 74 6f 67 72 61 6d lls ph-histogram
4190: 20 2b 20 2b 21 20 20 4c 4f 4f 50 20 3b 0a 0a 3a + +! LOOP ;..:
41a0: 20 70 68 2d 73 71 73 75 6d 20 28 20 61 64 64 72 ph-sqsum ( addr
41b0: 20 75 20 2d 2d 20 66 73 71 73 75 6d 20 29 0a 20 u -- fsqsum ).
41c0: 20 20 20 5c 47 20 63 6f 6d 70 75 74 65 20 74 68 \G compute th
41d0: 65 20 64 69 73 74 61 6e 63 65 20 6f 66 20 6e 65 e distance of ne
41e0: 69 67 68 62 6f 72 69 6e 67 20 6c 65 74 74 65 72 ighboring letter
41f0: 73 20 72 65 6c 61 74 69 76 65 20 74 6f 20 74 68 s relative to th
4200: 65 20 75 73 65 64 20 73 65 74 0a 20 20 20 20 5c e used set. \
4210: 47 20 28 69 2e 65 2e 20 6f 6e 6c 79 20 74 68 65 G (i.e. only the
4220: 20 70 6f 70 75 6c 61 74 65 64 20 73 6c 6f 74 73 populated slots
4230: 20 63 6f 75 6e 74 29 0a 20 20 20 20 30 65 20 31 count). 0e 1
4240: 2d 20 30 20 6d 61 78 20 62 6f 75 6e 64 73 20 3f - 0 max bounds ?
4250: 44 4f 0a 09 30 20 49 20 63 40 20 49 20 31 2b 20 DO..0 I c@ I 1+
4260: 63 40 20 32 64 75 70 20 6d 69 6e 20 3e 72 20 6d c@ 2dup min >r m
4270: 61 78 20 72 3e 20 3f 44 4f 0a 09 20 20 20 20 49 ax r> ?DO.. I
4280: 20 63 65 6c 6c 73 20 70 68 2d 68 69 73 74 6f 67 cells ph-histog
4290: 72 61 6d 20 2b 20 40 20 30 3c 3e 20 2d 20 4c 4f ram + @ 0<> - LO
42a0: 4f 50 0a 09 64 75 70 20 2a 20 5b 20 31 65 20 24 OP..dup * [ 1e $
42b0: 31 30 30 30 30 20 66 6d 2f 20 5d 20 46 4c 69 74 10000 fm/ ] FLit
42c0: 65 72 61 6c 20 66 6d 2a 20 66 2b 0a 20 20 20 20 eral fm* f+.
42d0: 4c 4f 4f 50 20 3b 0a 0a 3a 20 67 2d 74 65 73 74 LOOP ;..: g-test
42e0: 20 28 20 6e 20 2d 2d 20 65 6e 74 72 6f 70 79 20 ( n -- entropy
42f0: 29 0a 20 20 20 20 5b 20 31 65 20 24 31 30 30 20 ). [ 1e $100
4300: 66 6d 2f 20 5d 20 46 6c 69 74 65 72 61 6c 20 66 fm/ ] Fliteral f
4310: 6d 2a 20 66 6c 6e 20 7b 20 66 3a 20 6e 30 20 7d m* fln { f: n0 }
4320: 0a 20 20 20 20 30 65 20 20 70 68 2d 68 69 73 74 . 0e ph-hist
4330: 6f 67 72 61 6d 20 24 31 30 30 20 63 65 6c 6c 73 ogram $100 cells
4340: 20 62 6f 75 6e 64 73 20 44 4f 0a 09 49 20 40 20 bounds DO..I @
4350: 3f 64 75 70 2d 49 46 20 20 73 3e 66 20 66 64 75 ?dup-IF s>f fdu
4360: 70 20 66 6c 6e 20 6e 30 20 66 2d 20 66 2a 20 66 p fln n0 f- f* f
4370: 2b 20 20 54 48 45 4e 0a 20 20 20 20 63 65 6c 6c + THEN. cell
4380: 20 2b 4c 4f 4f 50 20 3b 0a 0a 3a 20 70 61 73 73 +LOOP ;..: pass
4390: 70 68 72 61 73 65 2d 65 6e 74 72 6f 70 79 20 28 phrase-entropy (
43a0: 20 61 64 64 72 20 75 20 2d 2d 20 66 65 6e 74 72 addr u -- fentr
43b0: 6f 70 79 20 29 0a 20 20 20 20 5c 47 20 65 73 74 opy ). \G est
43c0: 69 6d 61 74 65 20 70 61 73 73 70 68 72 61 73 65 imate passphrase
43d0: 20 65 6e 74 72 6f 70 79 0a 20 20 20 20 64 75 70 entropy. dup
43e0: 20 30 3d 20 49 46 20 20 32 64 72 6f 70 20 30 65 0= IF 2drop 0e
43f0: 20 20 45 58 49 54 20 20 54 48 45 4e 20 20 32 64 EXIT THEN 2d
4400: 75 70 0a 20 20 20 20 64 75 70 20 3e 72 20 3e 70 up. dup >r >p
4410: 68 2d 68 69 73 74 6f 67 72 61 6d 0a 20 20 20 20 h-histogram.
4420: 72 40 20 67 2d 74 65 73 74 20 20 31 65 2d 32 30 r@ g-test 1e-20
4430: 20 66 6d 61 78 20 31 2f 66 20 72 3e 20 66 6d 2a fmax 1/f r> fm*
4440: 0a 20 20 20 20 70 68 2d 73 71 73 75 6d 20 66 2a . ph-sqsum f*
4450: 20 24 31 30 30 20 66 6d 2a 20 66 73 71 72 74 20 $100 fm* fsqrt
4460: 3b 0a 0a 5c 20 67 65 74 20 70 61 73 73 70 68 72 ;..\ get passphr
4470: 61 73 65 0a 0a 33 20 56 61 6c 75 65 20 70 61 73 ase..3 Value pas
4480: 73 70 68 72 61 73 65 2d 72 65 74 72 79 23 0a 24 sphrase-retry#.$
4490: 31 30 30 20 43 6f 6e 73 74 61 6e 74 20 6d 61 78 100 Constant max
44a0: 2d 70 61 73 73 70 68 72 61 73 65 23 20 5c 20 32 -passphrase# \ 2
44b0: 35 36 20 63 68 61 72 61 63 74 65 72 73 20 73 68 56 characters sh
44c0: 6f 75 6c 64 20 62 65 20 65 6e 6f 75 67 68 2e 2e ould be enough..
44d0: 2e 0a 6d 61 78 2d 70 61 73 73 70 68 72 61 73 65 ..max-passphrase
44e0: 23 20 62 75 66 66 65 72 3a 20 70 61 73 73 70 68 # buffer: passph
44f0: 72 61 73 65 0a 0a 3a 20 70 61 73 73 70 68 72 61 rase..: passphra
4500: 73 65 2d 69 6e 20 28 20 61 64 64 72 20 75 20 2d se-in ( addr u -
4510: 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 22 - addr u ). "
4520: 50 41 53 53 50 48 52 41 53 45 22 20 67 65 74 65 PASSPHRASE" gete
4530: 6e 76 20 32 64 75 70 20 64 30 3d 20 49 46 20 20 nv 2dup d0= IF
4540: 32 64 72 6f 70 20 74 79 70 65 0a 09 70 61 73 73 2drop type..pass
4550: 70 68 72 61 73 65 20 64 75 70 20 6d 61 78 2d 70 phrase dup max-p
4560: 61 73 73 70 68 72 61 73 65 23 20 61 63 63 65 70 assphrase# accep
4570: 74 2a 20 63 72 0a 20 20 20 20 45 4c 53 45 20 20 t* cr. ELSE
4580: 32 6e 69 70 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 2nip THEN ;..:
4590: 3e 70 61 73 73 70 68 72 61 73 65 20 28 20 61 64 >passphrase ( ad
45a0: 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 20 29 dr u -- addr u )
45b0: 0a 20 20 20 20 5c 47 20 63 72 65 61 74 65 20 61 . \G create a
45c0: 20 35 31 32 20 62 69 74 20 68 61 73 68 20 6f 66 512 bit hash of
45d0: 20 74 68 65 20 70 61 73 73 70 68 72 61 73 65 0a the passphrase.
45e0: 20 20 20 20 6e 6f 2d 6b 65 79 20 3e 63 3a 6b 65 no-key >c:ke
45f0: 79 20 63 3a 68 61 73 68 0a 20 20 20 20 6b 65 63 y c:hash. kec
4600: 63 61 6b 2d 70 61 64 64 65 64 20 63 3a 6b 65 79 cak-padded c:key
4610: 3e 20 6b 65 63 63 61 6b 2d 70 61 64 64 65 64 20 > keccak-padded
4620: 6b 65 63 63 61 6b 23 6d 61 78 20 32 2f 20 3b 0a keccak#max 2/ ;.
4630: 0a 3a 20 67 65 74 2d 70 61 73 73 70 68 72 61 73 .: get-passphras
4640: 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 e ( addr u -- ad
4650: 64 72 20 75 20 29 0a 20 20 20 20 70 61 73 73 70 dr u ). passp
4660: 68 72 61 73 65 2d 69 6e 20 3e 70 61 73 73 70 68 hrase-in >passph
4670: 72 61 73 65 20 3b 0a 0a 56 61 72 69 61 62 6c 65 rase ;..Variable
4680: 20 6b 65 79 73 0a 0a 3a 20 6c 61 73 74 6b 65 79 keys..: lastkey
4690: 40 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 20 @ ( -- addr u )
46a0: 6b 65 79 73 20 24 5b 5d 23 20 31 2d 20 6b 65 79 keys $[]# 1- key
46b0: 73 20 73 65 63 5b 5d 40 20 3b 0a 3a 20 6b 65 79 s sec[]@ ;.: key
46c0: 3e 64 65 66 61 75 6c 74 20 28 20 2d 2d 20 29 20 >default ( -- )
46d0: 6c 61 73 74 6b 65 79 40 20 64 72 6f 70 20 3e 73 lastkey@ drop >s
46e0: 74 6f 72 65 6b 65 79 20 21 20 3b 0a 3a 20 2b 6b torekey ! ;.: +k
46f0: 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 ey ( addr u -- )
4700: 20 6b 65 79 73 20 73 65 63 2b 5b 5d 21 20 3b 0a keys sec+[]! ;.
4710: 3a 20 2b 70 61 73 73 70 68 72 61 73 65 20 28 20 : +passphrase (
4720: 61 64 64 72 20 75 20 2d 2d 20 29 20 20 67 65 74 addr u -- ) get
4730: 2d 70 61 73 73 70 68 72 61 73 65 20 2b 6b 65 79 -passphrase +key
4740: 20 3b 0a 3a 20 2b 63 68 65 63 6b 70 68 72 61 73 ;.: +checkphras
4750: 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 66 6c e ( addr u -- fl
4760: 61 67 20 29 20 67 65 74 2d 70 61 73 73 70 68 72 ag ) get-passphr
4770: 61 73 65 20 6c 61 73 74 6b 65 79 40 20 73 74 72 ase lastkey@ str
4780: 3d 20 3b 0a 3a 20 2b 6e 65 77 70 68 72 61 73 65 = ;.: +newphrase
4790: 20 28 20 2d 2d 20 29 0a 20 20 20 20 42 45 47 49 ( -- ). BEGI
47a0: 4e 0a 09 73 22 20 50 61 73 73 70 68 72 61 73 65 N..s" Passphrase
47b0: 3a 20 22 20 2b 70 61 73 73 70 68 72 61 73 65 0a : " +passphrase.
47c0: 09 73 22 20 52 65 74 79 70 65 20 70 6c 73 3a 20 .s" Retype pls:
47d0: 22 20 2b 63 68 65 63 6b 70 68 72 61 73 65 20 30 " +checkphrase 0
47e0: 3d 20 57 48 49 4c 45 0a 09 20 20 20 20 63 72 20 = WHILE.. cr
47f0: 2e 22 20 20 64 69 64 6e 27 74 20 6d 61 74 63 68 ." didn't match
4800: 2c 20 74 72 79 20 61 67 61 69 6e 20 70 6c 65 61 , try again plea
4810: 73 65 22 20 63 72 0a 20 20 20 20 52 45 50 45 41 se" cr. REPEA
4820: 54 20 63 72 20 3b 0a 0a 3a 20 22 3e 70 61 73 73 T cr ;..: ">pass
4830: 70 68 72 61 73 65 20 28 20 61 64 64 72 20 75 20 phrase ( addr u
4840: 2d 2d 20 29 20 3e 70 61 73 73 70 68 72 61 73 65 -- ) >passphrase
4850: 20 2b 6b 65 79 20 3b 0a 3a 20 3e 73 65 63 6b 65 +key ;.: >secke
4860: 79 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 0a y ( -- addr u ).
4870: 20 20 20 20 6b 65 2d 73 6b 20 40 20 6b 65 2d 70 ke-sk @ ke-p
4880: 6b 20 24 40 20 64 72 6f 70 20 6b 65 79 70 61 64 k $@ drop keypad
4890: 20 65 64 2d 64 68 20 3b 0a 3a 20 2b 73 65 63 6b ed-dh ;.: +seck
48a0: 65 79 20 28 20 2d 2d 20 29 20 3e 73 65 63 6b 65 ey ( -- ) >secke
48b0: 79 20 2b 6b 65 79 20 3b 0a 0a 5c 20 22 22 20 22 y +key ;..\ "" "
48c0: 3e 70 61 73 73 70 68 72 61 73 65 20 5c 20 66 6f >passphrase \ fo
48d0: 6c 6c 6f 77 69 6e 67 20 74 68 65 20 65 6e 63 72 llowing the encr
48e0: 79 70 74 2d 65 76 65 72 79 74 68 69 6e 67 20 70 ypt-everything p
48f0: 61 72 61 64 69 67 6d 2c 0a 5c 20 6e 6f 20 70 61 aradigm,.\ no pa
4900: 73 73 77 6f 72 64 20 69 73 20 74 68 65 20 65 6d ssword is the em
4910: 70 74 79 20 73 74 72 69 6e 67 21 20 20 49 74 27 pty string! It'
4920: 73 20 73 74 69 6c 6c 20 65 6e 63 72 79 70 74 65 s still encrypte
4930: 64 20 3b 2d 29 21 0a 0a 5c 20 61 20 73 65 63 72 d ;-)!..\ a secr
4940: 65 74 20 6b 65 79 20 6a 75 73 74 20 6e 65 65 64 et key just need
4950: 73 20 61 20 6e 69 63 6b 20 61 6e 64 20 61 20 74 s a nick and a t
4960: 79 70 65 2e 0a 5c 20 53 65 63 72 65 74 20 6b 65 ype..\ Secret ke
4970: 79 73 20 63 61 6e 20 62 65 20 70 65 72 73 6f 6e ys can be person
4980: 73 20 61 6e 64 20 67 72 6f 75 70 73 2e 0a 0a 5c s and groups...\
4990: 20 61 20 70 75 62 6c 69 63 20 6b 65 79 20 6e 65 a public key ne
49a0: 65 64 73 20 6d 6f 72 65 3a 20 6e 69 63 6b 2c 20 eds more: nick,
49b0: 74 79 70 65 2c 20 70 72 6f 66 69 6c 65 2e 0a 5c type, profile..\
49c0: 20 54 68 65 20 70 72 6f 66 69 6c 65 20 69 73 20 The profile is
49d0: 61 20 73 74 72 75 63 74 75 72 65 64 20 64 6f 63 a structured doc
49e0: 75 6d 65 6e 74 2c 20 69 2e 65 2e 20 70 6f 69 6e ument, i.e. poin
49f0: 74 65 64 20 74 6f 20 62 79 20 61 20 68 61 73 68 ted to by a hash
4a00: 2e 0a 0a 5c 20 61 20 73 69 67 6e 61 74 75 72 65 ...\ a signature
4a10: 20 63 6f 6e 74 61 69 6e 73 20 61 20 70 75 62 6b contains a pubk
4a20: 65 79 2c 20 61 20 63 68 65 63 6b 62 6f 78 20 62 ey, a checkbox b
4a30: 69 74 6d 61 73 6b 2c 0a 5c 20 61 20 64 61 74 65 itmask,.\ a date
4a40: 2c 20 61 6e 20 65 78 70 69 72 61 74 69 6f 6e 20 , an expiration
4a50: 64 61 74 65 2c 20 74 68 65 20 73 69 67 6e 65 72 date, the signer
4a60: 27 73 20 70 75 62 6b 65 79 20 61 6e 64 20 74 68 's pubkey and th
4a70: 65 20 73 69 67 6e 61 74 75 72 65 20 69 74 73 65 e signature itse
4a80: 6c 66 0a 5c 20 28 72 2b 73 29 2e 20 20 54 68 65 lf.\ (r+s). The
4a90: 72 65 20 69 73 20 61 6e 20 6f 70 74 69 6f 6e 61 re is an optiona
4aa0: 6c 20 73 69 67 6e 69 6e 67 20 70 72 6f 74 6f 63 l signing protoc
4ab0: 6f 6c 20 64 6f 63 75 6d 65 6e 74 20 28 68 61 73 ol document (has
4ac0: 68 29 2e 0a 0a 5c 20 77 65 20 73 74 6f 72 65 20 h)...\ we store
4ad0: 65 61 63 68 20 69 74 65 6d 20 69 6e 20 61 20 32 each item in a 2
4ae0: 35 36 20 62 79 74 65 73 20 65 6e 63 72 79 70 74 56 bytes encrypt
4af0: 65 64 20 73 74 72 69 6e 67 2c 20 69 2e 65 2e 20 ed string, i.e.
4b00: 77 69 74 68 20 61 20 31 36 0a 5c 20 62 79 74 65 with a 16.\ byte
4b10: 20 73 61 6c 74 20 61 6e 64 20 61 20 31 36 20 62 salt and a 16 b
4b20: 79 74 65 20 63 68 65 63 6b 73 75 6d 2e 0a 0a 3a yte checksum...:
4b30: 20 6b 65 2d 6c 61 73 74 21 20 28 20 36 34 64 61 ke-last! ( 64da
4b40: 74 65 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 73 te -- ). ke-s
4b50: 65 6c 66 73 69 67 20 24 40 6c 65 6e 20 24 31 30 elfsig $@len $10
4b60: 20 75 6d 61 78 20 6b 65 2d 73 65 6c 66 73 69 67 umax ke-selfsig
4b70: 20 24 21 6c 65 6e 0a 20 20 20 20 6b 65 2d 73 65 $!len. ke-se
4b80: 6c 66 73 69 67 20 24 40 20 64 72 6f 70 20 36 34 lfsig $@ drop 64
4b90: 27 2b 20 36 34 21 20 3b 0a 3a 20 6b 65 2d 66 69 '+ 64! ;.: ke-fi
4ba0: 72 73 74 21 20 28 20 36 34 64 61 74 65 20 2d 2d rst! ( 64date --
4bb0: 20 29 20 36 34 23 2d 31 20 6b 65 2d 6c 61 73 74 ) 64#-1 ke-last
4bc0: 21 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 !. ke-selfsig
4bd0: 20 24 40 20 64 72 6f 70 20 36 34 21 20 3b 0a 0a $@ drop 64! ;..
4be0: 56 61 72 69 61 62 6c 65 20 73 61 76 65 2d 6b 65 Variable save-ke
4bf0: 79 73 2d 61 67 61 69 6e 0a 56 61 72 69 61 62 6c ys-again.Variabl
4c00: 65 20 6b 65 79 2d 76 65 72 73 69 6f 6e 0a 3a 20 e key-version.:
4c10: 6b 65 79 2d 76 65 72 73 69 6f 6e 24 20 22 31 22 key-version$ "1"
4c20: 20 3b 0a 6b 65 79 2d 76 65 72 73 69 6f 6e 24 20 ;.key-version$
4c30: 65 76 61 6c 75 61 74 65 20 43 6f 6e 73 74 61 6e evaluate Constan
4c40: 74 20 6b 65 79 2d 76 65 72 73 69 6f 6e 23 0a 0a t key-version#..
4c50: 3a 20 6e 65 77 2d 70 65 74 3f 20 28 20 61 64 64 : new-pet? ( add
4c60: 72 20 75 20 2d 2d 20 61 64 64 72 20 75 20 66 6c r u -- addr u fl
4c70: 61 67 20 29 0a 20 20 20 20 30 20 6b 65 2d 70 65 ag ). 0 ke-pe
4c80: 74 73 5b 5d 20 5b 3a 20 72 6f 74 20 3e 72 20 32 ts[] [: rot >r 2
4c90: 6f 76 65 72 20 73 74 72 3d 20 72 3e 20 6f 72 20 over str= r> or
4ca0: 3b 5d 20 24 5b 5d 6d 61 70 20 30 3d 20 3b 0a 0a ;] $[]map 0= ;..
4cb0: 3a 20 3f 73 6b 20 28 20 61 64 64 72 20 75 20 2d : ?sk ( addr u -
4cc0: 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 6f - addr u ). o
4cd0: 76 65 72 20 6b 65 79 70 61 64 20 73 6b 3e 70 6b ver keypad sk>pk
4ce0: 20 5c 20 67 65 6e 65 72 61 74 65 20 70 75 62 6b \ generate pubk
4cf0: 65 79 0a 20 20 20 20 6b 65 79 70 61 64 20 6b 65 ey. keypad ke
4d00: 2d 70 6b 20 24 40 20 64 72 6f 70 20 6b 65 79 73 -pk $@ drop keys
4d10: 69 7a 65 20 74 75 63 6b 20 73 74 72 3d 20 30 3d ize tuck str= 0=
4d20: 20 21 21 77 72 6f 6e 67 2d 6b 65 79 21 21 20 3b !!wrong-key!! ;
4d30: 0a 0a 73 63 6f 70 65 7b 20 6e 65 74 32 6f 2d 62 ..scope{ net2o-b
4d40: 61 73 65 0a 0a 63 6d 64 2d 74 61 62 6c 65 20 24 ase..cmd-table $
4d50: 40 20 69 6e 68 65 72 69 74 2d 74 61 62 6c 65 20 @ inherit-table
4d60: 6b 65 79 2d 65 6e 74 72 79 2d 74 61 62 6c 65 0a key-entry-table.
4d70: 5c 67 20 0a 5c 67 20 23 23 23 20 6b 65 79 20 73 \g .\g ### key s
4d80: 74 6f 72 61 67 65 20 63 6f 6d 6d 61 6e 64 73 20 torage commands
4d90: 23 23 23 0a 5c 67 0a 24 32 20 6e 65 74 32 6f 3a ###.\g.$2 net2o:
4da0: 20 73 6c 69 74 20 28 20 23 6c 69 74 20 2d 2d 20 slit ( #lit --
4db0: 29 20 5c 67 20 64 65 70 72 65 63 61 74 65 64 20 ) \g deprecated
4dc0: 73 6c 69 74 20 76 65 72 73 69 6f 6e 0a 20 20 20 slit version.
4dd0: 20 70 40 20 6b 65 79 2d 76 65 72 73 69 6f 6e 20 p@ key-version
4de0: 40 20 30 3d 20 49 46 20 20 7a 7a 3e 6e 20 73 61 @ 0= IF zz>n sa
4df0: 76 65 2d 6b 65 79 73 2d 61 67 61 69 6e 20 6f 6e ve-keys-again on
4e00: 20 20 45 4c 53 45 20 20 36 34 69 6e 76 65 72 74 ELSE 64invert
4e10: 20 20 54 48 45 4e 20 3b 0a 24 46 20 6e 65 74 32 THEN ;.$F net2
4e20: 6f 3a 20 6b 76 65 72 73 69 6f 6e 20 28 20 24 3a o: kversion ( $:
4e30: 73 74 72 69 6e 67 20 2d 2d 20 29 20 5c 67 20 6b string -- ) \g k
4e40: 65 79 20 76 65 72 73 69 6f 6e 0a 20 20 20 20 24 ey version. $
4e50: 3e 20 73 3e 75 6e 75 6d 62 65 72 3f 20 49 46 20 > s>unumber? IF
4e60: 20 64 72 6f 70 20 20 45 4c 53 45 20 20 32 64 72 drop ELSE 2dr
4e70: 6f 70 20 30 20 20 54 48 45 4e 20 20 64 75 70 20 op 0 THEN dup
4e80: 6b 65 79 2d 76 65 72 73 69 6f 6e 20 21 0a 20 20 key-version !.
4e90: 20 20 6b 65 79 2d 76 65 72 73 69 6f 6e 23 20 75 key-version# u
4ea0: 3c 20 73 61 76 65 2d 6b 65 79 73 2d 61 67 61 69 < save-keys-agai
4eb0: 6e 20 6f 72 21 20 3b 0a 24 31 31 20 6e 65 74 32 n or! ;.$11 net2
4ec0: 6f 3a 20 70 72 69 76 6b 65 79 20 28 20 24 3a 73 o: privkey ( $:s
4ed0: 74 72 69 6e 67 20 2d 2d 20 29 0a 20 20 20 20 5c tring -- ). \
4ee0: 67 20 70 72 69 76 61 74 65 20 6b 65 79 0a 20 20 g private key.
4ef0: 20 20 5c 20 64 6f 65 73 20 6e 6f 74 20 6e 65 65 \ does not nee
4f00: 64 20 74 6f 20 62 65 20 73 69 67 6e 65 64 2c 20 d to be signed,
4f10: 74 68 65 20 73 65 63 72 65 74 20 6b 65 79 20 76 the secret key v
4f20: 65 72 69 66 69 65 73 20 69 74 73 65 6c 66 0a 20 erifies itself.
4f30: 20 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 !!unsigned? $
4f40: 34 30 20 21 21 3e 3d 6f 72 64 65 72 3f 0a 20 20 40 !!>=order?.
4f50: 20 20 6b 65 79 70 61 63 6b 20 63 40 20 24 46 20 keypack c@ $F
4f60: 61 6e 64 20 6b 65 2d 70 77 6c 65 76 65 6c 20 21 and ke-pwlevel !
4f70: 0a 20 20 20 20 24 3e 20 3f 73 6b 20 6b 65 2d 73 . $> ?sk ke-s
4f80: 6b 20 73 65 63 21 20 2b 73 65 63 6b 65 79 0a 20 k sec! +seckey.
4f90: 20 20 20 22 5c 30 22 20 6b 65 2d 67 72 6f 75 70 "\0" ke-group
4fa0: 73 20 24 21 20 30 20 67 72 6f 75 70 73 5b 5d 20 s $! 0 groups[]
4fb0: 24 5b 5d 40 20 64 72 6f 70 20 40 20 6b 65 2d 6d $[]@ drop @ ke-m
4fc0: 61 73 6b 20 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 ask ! ;.+net2o:
4fd0: 6b 65 79 74 79 70 65 20 28 20 6e 20 2d 2d 20 29 keytype ( n -- )
4fe0: 20 20 20 20 20 20 20 20 20 20 20 21 21 73 69 67 !!sig
4ff0: 6e 65 64 3f 20 20 20 31 20 21 21 3e 6f 72 64 65 ned? 1 !!>orde
5000: 72 3f 20 36 34 3e 6e 20 6b 65 2d 74 79 70 65 20 r? 64>n ke-type
5010: 21 20 3b 0a 20 20 20 20 5c 67 20 6b 65 79 20 74 ! ;. \g key t
5020: 79 70 65 20 28 30 3a 20 61 6e 6f 6e 2c 20 31 3a ype (0: anon, 1:
5030: 20 75 73 65 72 2c 20 32 3a 20 67 72 6f 75 70 29 user, 2: group)
5040: 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 6e 69 63 6b .+net2o: keynick
5050: 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 ( $:string -- )
5060: 20 20 20 20 21 21 73 69 67 6e 65 64 3f 20 20 20 !!signed?
5070: 32 20 21 21 3e 6f 72 64 65 72 3f 20 24 3e 20 6b 2 !!>order? $> k
5080: 65 2d 6e 69 63 6b 20 24 21 0a 20 20 20 20 5c 67 e-nick $!. \g
5090: 20 6b 65 79 20 6e 69 63 6b 0a 20 20 20 20 6e 69 key nick. ni
50a0: 63 6b 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 ck! ;.+net2o: ke
50b0: 79 70 72 6f 66 69 6c 65 20 28 20 24 3a 73 74 72 yprofile ( $:str
50c0: 69 6e 67 20 2d 2d 20 29 20 21 21 73 69 67 6e 65 ing -- ) !!signe
50d0: 64 3f 20 20 20 34 20 21 21 3e 6f 72 64 65 72 3f d? 4 !!>order?
50e0: 20 24 3e 20 6b 65 2d 70 72 6f 66 20 24 21 20 3b $> ke-prof $! ;
50f0: 0a 20 20 20 20 5c 67 20 6b 65 79 20 70 72 6f 66 . \g key prof
5100: 69 6c 65 20 28 68 61 73 68 20 6f 66 20 61 20 72 ile (hash of a r
5110: 65 73 6f 75 72 63 65 29 0a 2b 6e 65 74 32 6f 3a esource).+net2o:
5120: 20 6b 65 79 6d 61 73 6b 20 28 20 78 20 2d 2d 20 keymask ( x --
5130: 29 20 20 20 20 20 20 20 20 20 21 21 75 6e 73 69 ) !!unsi
5140: 67 6e 65 64 3f 20 24 34 30 20 21 21 3e 3d 6f 72 gned? $40 !!>=or
5150: 64 65 72 3f 20 36 34 3e 6e 0a 20 20 20 20 5c 67 der? 64>n. \g
5160: 20 6b 65 79 20 61 63 63 65 73 73 20 72 69 67 68 key access righ
5170: 74 20 6d 61 73 6b 0a 20 20 20 20 31 20 69 6d 70 t mask. 1 imp
5180: 6f 72 74 2d 74 79 70 65 20 40 20 6c 73 68 69 66 ort-type @ lshif
5190: 74 0a 20 20 20 20 5b 20 31 20 69 6d 70 6f 72 74 t. [ 1 import
51a0: 23 73 65 6c 66 20 6c 73 68 69 66 74 20 31 20 69 #self lshift 1 i
51b0: 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 74 mport#new lshift
51c0: 20 6f 72 20 5d 4c 0a 20 20 20 20 61 6e 64 20 30 or ]L. and 0
51d0: 3d 20 49 46 20 20 64 72 6f 70 20 70 65 72 6d 25 = IF drop perm%
51e0: 64 65 66 61 75 6c 74 20 20 54 48 45 4e 20 20 64 default THEN d
51f0: 75 70 20 6b 65 2d 6d 61 73 6b 20 6f 72 21 20 3f up ke-mask or! ?
5200: 3e 67 72 6f 75 70 73 20 3b 0a 2b 6e 65 74 32 6f >groups ;.+net2o
5210: 3a 20 6b 65 79 67 72 6f 75 70 73 20 28 20 24 3a : keygroups ( $:
5220: 67 72 6f 75 70 73 20 2d 2d 20 29 20 21 21 75 6e groups -- ) !!un
5230: 73 69 67 6e 65 64 3f 20 24 32 30 20 21 21 3e 6f signed? $20 !!>o
5240: 72 64 65 72 3f 20 24 3e 0a 20 20 20 20 5c 67 20 rder? $>. \g
5250: 61 63 63 65 73 73 20 67 72 6f 75 70 73 0a 20 20 access groups.
5260: 20 20 31 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 1 import-type
5270: 40 20 6c 73 68 69 66 74 0a 20 20 20 20 5b 20 31 @ lshift. [ 1
5280: 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 6c 73 68 import#self lsh
5290: 69 66 74 20 31 20 69 6d 70 6f 72 74 23 6e 65 77 ift 1 import#new
52a0: 20 6c 73 68 69 66 74 20 6f 72 20 5d 4c 0a 20 20 lshift or ]L.
52b0: 20 20 61 6e 64 20 30 3d 20 49 46 20 20 32 64 72 and 0= IF 2dr
52c0: 6f 70 20 22 5c 78 30 31 22 20 20 54 48 45 4e 0a op "\x01" THEN.
52d0: 20 20 20 20 32 64 75 70 20 6b 65 2d 67 72 6f 75 2dup ke-grou
52e0: 70 73 20 24 21 20 67 72 6f 75 70 73 3e 6d 61 73 ps $! groups>mas
52f0: 6b 20 6b 65 2d 6d 61 73 6b 20 21 20 3b 0a 2b 6e k ke-mask ! ;.+n
5300: 65 74 32 6f 3a 20 2b 6b 65 79 73 69 67 20 28 20 et2o: +keysig (
5310: 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 20 21 $:string -- ) !
5320: 21 75 6e 73 69 67 6e 65 64 3f 20 24 31 30 20 21 !unsigned? $10 !
5330: 21 3e 3d 6f 72 64 65 72 3f 20 24 3e 20 6b 65 2d !>=order? $> ke-
5340: 73 69 67 73 5b 5d 20 24 2b 5b 5d 21 20 3b 0a 20 sigs[] $+[]! ;.
5350: 20 20 20 5c 67 20 61 64 64 20 61 20 6b 65 79 20 \g add a key
5360: 73 69 67 6e 61 74 75 72 65 0a 2b 6e 65 74 32 6f signature.+net2o
5370: 3a 20 6b 65 79 69 6d 70 6f 72 74 20 28 20 6e 20 : keyimport ( n
5380: 2d 2d 20 29 20 20 20 20 20 20 20 21 21 75 6e 73 -- ) !!uns
5390: 69 67 6e 65 64 3f 20 24 31 30 20 21 21 3e 3d 6f igned? $10 !!>=o
53a0: 72 64 65 72 3f 0a 20 20 20 20 63 6f 6e 66 69 67 rder?. config
53b0: 3a 70 77 2d 6c 65 76 65 6c 23 20 40 20 30 3c 20 :pw-level# @ 0<
53c0: 49 46 20 20 36 34 3e 6e 0a 09 64 75 70 20 5b 20 IF 64>n..dup [
53d0: 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 1 import#new lsh
53e0: 69 66 74 20 5d 4c 20 61 6e 64 20 30 3d 20 49 46 ift ]L and 0= IF
53f0: 0a 09 20 20 20 20 69 6d 70 6f 72 74 23 75 6e 74 .. import#unt
5400: 72 75 73 74 65 64 20 75 6d 69 6e 20 31 20 73 77 rusted umin 1 sw
5410: 61 70 20 6c 73 68 69 66 74 20 5b 20 31 20 69 6d ap lshift [ 1 im
5420: 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 port#new lshift
5430: 5d 4c 20 6f 72 0a 09 45 4c 53 45 0a 09 20 20 20 ]L or..ELSE..
5440: 20 5b 20 32 20 69 6d 70 6f 72 74 23 75 6e 74 72 [ 2 import#untr
5450: 75 73 74 65 64 20 6c 73 68 69 66 74 20 31 2d 20 usted lshift 1-
5460: 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 1 import#new lsh
5470: 69 66 74 20 6f 72 20 5d 4c 20 61 6e 64 0a 09 54 ift or ]L and..T
5480: 48 45 4e 0a 09 6b 65 2d 69 6d 70 6f 72 74 73 20 HEN..ke-imports
5490: 6f 72 21 0a 20 20 20 20 45 4c 53 45 20 20 36 34 or!. ELSE 64
54a0: 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 2b 6e 65 drop THEN ;.+ne
54b0: 74 32 6f 3a 20 72 73 6b 6b 65 79 20 28 20 24 3a t2o: rskkey ( $:
54c0: 73 74 72 69 6e 67 20 2d 2d 2d 20 29 0a 20 20 20 string --- ).
54d0: 20 5c 67 20 72 65 76 6f 6b 65 20 6b 65 79 2c 20 \g revoke key,
54e0: 74 65 6d 70 6f 72 61 72 69 6c 79 20 73 74 6f 72 temporarily stor
54f0: 65 64 0a 20 20 20 20 5c 20 64 6f 65 73 20 6e 6f ed. \ does no
5500: 74 20 6e 65 65 64 20 74 6f 20 62 65 20 73 69 67 t need to be sig
5510: 6e 65 64 2c 20 74 68 65 20 72 65 76 6f 6b 65 20 ned, the revoke
5520: 6b 65 79 20 76 65 72 69 66 69 65 73 20 69 74 73 key verifies its
5530: 65 6c 66 0a 20 20 20 20 21 21 75 6e 73 69 67 6e elf. !!unsign
5540: 65 64 3f 20 24 38 30 20 21 21 3e 3d 6f 72 64 65 ed? $80 !!>=orde
5550: 72 3f 0a 20 20 20 20 24 3e 20 32 64 75 70 20 73 r?. $> 2dup s
5560: 6b 72 65 76 20 73 77 61 70 20 6b 65 79 7c 20 6d krev swap key| m
5570: 6f 76 65 20 6b 65 2d 70 6b 20 24 40 20 64 72 6f ove ke-pk $@ dro
5580: 70 20 63 68 65 63 6b 2d 72 65 76 3f 20 30 3d 20 p check-rev? 0=
5590: 21 21 6e 6f 74 2d 6d 79 2d 72 65 76 73 6b 21 21 !!not-my-revsk!!
55a0: 0a 20 20 20 20 70 6b 72 65 76 20 6b 65 79 73 69 . pkrev keysi
55b0: 7a 65 32 20 65 72 61 73 65 20 20 6b 65 2d 72 73 ze2 erase ke-rs
55c0: 6b 20 73 65 63 21 20 3b 0a 2b 6e 65 74 32 6f 3a k sec! ;.+net2o:
55d0: 20 6b 65 79 70 65 74 20 28 20 24 3a 73 74 72 69 keypet ( $:stri
55e0: 6e 67 20 2d 2d 20 29 20 20 21 21 75 6e 73 69 67 ng -- ) !!unsig
55f0: 6e 65 64 3f 20 20 24 3e 0a 20 20 20 20 6e 65 77 ned? $>. new
5600: 2d 70 65 74 3f 20 49 46 0a 09 6b 65 2d 70 65 74 -pet? IF..ke-pet
5610: 73 5b 5d 20 24 2b 5b 5d 21 20 70 65 74 21 20 20 s[] $+[]! pet!
5620: 45 58 49 54 0a 20 20 20 20 54 48 45 4e 20 20 32 EXIT. THEN 2
5630: 64 72 6f 70 20 3b 0a 2b 6e 65 74 32 6f 3a 20 77 drop ;.+net2o: w
5640: 61 6c 6c 65 74 6b 65 79 20 28 20 24 3a 73 65 65 alletkey ( $:see
5650: 64 20 2d 2d 20 29 20 21 21 75 6e 73 69 67 6e 65 d -- ) !!unsigne
5660: 64 3f 20 20 24 3e 0a 20 20 20 20 6b 65 2d 77 61 d? $>. ke-wa
5670: 6c 6c 65 74 20 73 65 63 21 20 3b 0a 2b 6e 65 74 llet sec! ;.+net
5680: 32 6f 3a 20 61 76 61 74 61 72 20 28 20 24 3a 73 2o: avatar ( $:s
5690: 74 72 69 6e 67 20 2d 2d 20 29 0a 20 20 20 20 5c tring -- ). \
56a0: 67 20 6b 65 79 20 61 76 61 74 61 72 20 70 72 6f g key avatar pro
56b0: 66 69 6c 65 20 28 68 61 73 68 20 6f 66 20 61 20 file (hash of a
56c0: 72 65 73 6f 75 72 63 65 29 0a 20 20 20 20 21 21 resource). !!
56d0: 73 69 67 6e 65 64 3f 20 20 20 38 20 21 21 3e 6f signed? 8 !!>o
56e0: 72 64 65 72 3f 20 24 3e 20 6b 65 2d 61 76 61 74 rder? $> ke-avat
56f0: 61 72 20 24 21 20 3b 0a 5c 20 64 75 6d 6d 69 65 ar $! ;.\ dummie
5700: 73 20 74 68 61 74 20 61 72 65 20 72 65 74 61 69 s that are retai
5710: 6e 65 64 20 65 76 65 6e 20 74 68 6f 75 67 68 20 ned even though
5720: 77 65 20 64 6f 6e 27 74 20 6b 6e 6f 77 20 77 68 we don't know wh
5730: 61 74 20 74 68 65 79 20 61 72 65 0a 2b 6e 65 74 at they are.+net
5740: 32 6f 3a 20 6b 65 79 2d 73 74 72 69 6e 67 31 20 2o: key-string1
5750: 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 ( $:string -- )
5760: 24 3e 20 6b 65 2d 5b 5d 31 20 24 2b 5b 5d 21 20 $> ke-[]1 $+[]!
5770: 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 2d 73 74 ;.+net2o: key-st
5780: 72 69 6e 67 32 20 28 20 24 3a 73 74 72 69 6e 67 ring2 ( $:string
5790: 20 2d 2d 20 29 20 24 3e 20 6b 65 2d 5b 5d 32 20 -- ) $> ke-[]2
57a0: 24 2b 5b 5d 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 $+[]! ;.+net2o:
57b0: 6b 65 79 2d 73 74 72 69 6e 67 33 20 28 20 24 3a key-string3 ( $:
57c0: 73 74 72 69 6e 67 20 2d 2d 20 29 20 24 3e 20 6b string -- ) $> k
57d0: 65 2d 5b 5d 33 20 24 2b 5b 5d 21 20 3b 0a 2b 6e e-[]3 $+[]! ;.+n
57e0: 65 74 32 6f 3a 20 6b 65 79 2d 73 74 72 69 6e 67 et2o: key-string
57f0: 34 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 4 ( $:string --
5800: 29 20 24 3e 20 6b 65 2d 5b 5d 34 20 24 2b 5b 5d ) $> ke-[]4 $+[]
5810: 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 2d ! ;.+net2o: key-
5820: 73 65 63 31 20 28 20 24 3a 73 74 72 69 6e 67 20 sec1 ( $:string
5830: 2d 2d 20 29 20 24 3e 20 6b 65 2d 73 65 63 31 20 -- ) $> ke-sec1
5840: 73 65 63 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b sec! ;.+net2o: k
5850: 65 79 2d 73 65 63 32 20 28 20 24 3a 73 74 72 69 ey-sec2 ( $:stri
5860: 6e 67 20 2d 2d 20 29 20 24 3e 20 6b 65 2d 73 65 ng -- ) $> ke-se
5870: 63 32 20 73 65 63 21 20 3b 0a 2b 6e 65 74 32 6f c2 sec! ;.+net2o
5880: 3a 20 6b 65 79 2d 6e 75 6d 31 20 28 20 36 34 6e : key-num1 ( 64n
5890: 20 2d 2d 20 29 20 20 6b 65 2d 23 31 20 36 34 21 -- ) ke-#1 64!
58a0: 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 2d 6e ;.+net2o: key-n
58b0: 75 6d 32 20 28 20 36 34 6e 20 2d 2d 20 29 20 20 um2 ( 64n -- )
58c0: 6b 65 2d 23 32 20 36 34 21 20 3b 0a 2b 6e 65 74 ke-#2 64! ;.+net
58d0: 32 6f 3a 20 6b 65 79 2d 6e 75 6d 33 20 28 20 36 2o: key-num3 ( 6
58e0: 34 6e 20 2d 2d 20 29 20 20 6b 65 2d 23 33 20 36 4n -- ) ke-#3 6
58f0: 34 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 4! ;.+net2o: key
5900: 2d 6e 75 6d 34 20 28 20 36 34 6e 20 2d 2d 20 29 -num4 ( 64n -- )
5910: 20 20 6b 65 2d 23 34 20 36 34 21 20 3b 0a 7d 73 ke-#4 64! ;.}s
5920: 63 6f 70 65 0a 0a 6b 65 79 2d 65 6e 74 72 79 2d cope..key-entry-
5930: 74 61 62 6c 65 20 24 73 61 76 65 0a 0a 27 20 63 table $save..' c
5940: 6f 6e 74 65 78 74 2d 74 61 62 6c 65 20 69 73 20 ontext-table is
5950: 67 65 6e 2d 74 61 62 6c 65 0a 0a 3a 20 6b 65 79 gen-table..: key
5960: 3a 6e 65 73 74 2d 73 69 67 20 28 20 61 64 64 72 :nest-sig ( addr
5970: 20 75 20 2d 2d 20 61 64 64 72 20 75 27 20 66 6c u -- addr u' fl
5980: 61 67 20 29 0a 20 20 20 20 70 6b 32 2d 73 69 67 ag ). pk2-sig
5990: 3f 20 64 75 70 20 3f 45 58 49 54 20 64 72 6f 70 ? dup ?EXIT drop
59a0: 0a 20 20 20 20 32 64 75 70 20 2b 20 73 69 67 73 . 2dup + sigs
59b0: 69 7a 65 23 20 2d 20 73 69 67 73 69 7a 65 23 20 ize# - sigsize#
59c0: 3e 24 0a 20 20 20 20 73 69 67 70 6b 32 73 69 7a >$. sigpk2siz
59d0: 65 23 20 2d 20 32 64 75 70 20 2b 20 6b 65 79 73 e# - 2dup + keys
59e0: 69 7a 65 32 20 6b 65 79 3f 6e 65 77 20 6e 3a 3e ize2 key?new n:>
59f0: 6f 20 24 3e 20 6b 65 2d 73 65 6c 66 73 69 67 20 o $> ke-selfsig
5a00: 24 21 0a 20 20 20 20 73 69 6d 2d 6e 69 63 6b 21 $!. sim-nick!
5a10: 20 6f 66 66 20 63 2d 73 74 61 74 65 20 6f 66 66 off c-state off
5a20: 20 73 69 67 2d 6f 6b 20 3b 0a 27 20 6b 65 79 3a sig-ok ;.' key:
5a30: 6e 65 73 74 2d 73 69 67 20 6b 65 79 2d 65 6e 74 nest-sig key-ent
5a40: 72 79 20 74 6f 20 6e 65 73 74 2d 73 69 67 0a 0a ry to nest-sig..
5a50: 6b 65 79 2d 65 6e 74 72 79 2d 74 61 62 6c 65 20 key-entry-table
5a60: 40 20 73 61 6d 70 6c 65 2d 6b 65 79 20 2e 74 6f @ sample-key .to
5a70: 6b 65 6e 2d 74 61 62 6c 65 20 21 0a 0a 3a 20 6b ken-table !..: k
5a80: 65 79 3a 63 6f 64 65 20 28 20 2d 2d 20 29 0a 20 ey:code ( -- ).
5a90: 20 20 20 63 6f 64 65 2d 6b 65 79 20 20 63 6d 64 code-key cmd
5aa0: 6c 6f 63 6b 20 6c 6f 63 6b 0a 20 20 20 20 6b 65 lock lock. ke
5ab0: 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 6c ypack keypack-al
5ac0: 6c 23 20 65 72 61 73 65 0a 20 20 20 20 63 6d 64 l# erase. cmd
5ad0: 72 65 73 65 74 20 69 6e 69 74 2d 72 65 70 6c 79 reset init-reply
5ae0: 20 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73 65 also net2o-base
5af0: 20 3b 0a 63 6f 6d 70 73 65 6d 3a 20 5b 27 5d 20 ;.compsem: [']
5b00: 6b 65 79 3a 63 6f 64 65 20 63 6f 6d 70 69 6c 65 key:code compile
5b10: 2c 20 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73 , also net2o-bas
5b20: 65 20 3b 0a 0a 73 63 6f 70 65 7b 20 6e 65 74 32 e ;..scope{ net2
5b30: 6f 2d 62 61 73 65 0a 0a 3a 20 65 6e 64 3a 6b 65 o-base..: end:ke
5b40: 79 20 28 20 2d 2d 20 29 0a 20 20 20 20 65 6e 64 y ( -- ). end
5b50: 2d 77 69 74 68 20 70 72 65 76 69 6f 75 73 20 63 -with previous c
5b60: 6d 64 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20 3b 0a mdlock unlock ;.
5b70: 63 6f 6d 70 73 65 6d 3a 20 5b 27 5d 20 65 6e 64 compsem: ['] end
5b80: 3a 6b 65 79 20 63 6f 6d 70 69 6c 65 2c 20 70 72 :key compile, pr
5b90: 65 76 69 6f 75 73 20 3b 0a 0a 7d 73 63 6f 70 65 evious ;..}scope
5ba0: 0a 0a 3a 20 6b 65 79 2d 63 72 79 70 74 20 28 20 ..: key-crypt (
5bb0: 2d 2d 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b -- ). keypack
5bc0: 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 0a 20 20 keypack-all#.
5bd0: 20 20 3e 73 74 6f 72 65 6b 65 79 20 73 65 63 40 >storekey sec@
5be0: 20 64 75 70 20 24 32 30 20 75 3c 3d 20 5c 20 69 dup $20 u<= \ i
5bf0: 73 20 61 20 73 65 63 72 65 74 2c 20 6e 6f 20 6e s a secret, no n
5c00: 65 65 64 20 74 6f 20 62 65 20 73 6c 6f 77 0a 20 eed to be slow.
5c10: 20 20 20 49 46 20 20 65 6e 63 72 79 70 74 24 20 IF encrypt$
5c20: 20 45 4c 53 45 20 20 63 6f 6e 66 69 67 3a 70 77 ELSE config:pw
5c30: 2d 6c 65 76 65 6c 23 20 40 20 65 6e 63 72 79 70 -level# @ encryp
5c40: 74 2d 70 77 24 20 20 54 48 45 4e 20 3b 0a 0a 30 t-pw$ THEN ;..0
5c50: 20 56 61 6c 75 65 20 6b 65 79 2d 73 66 64 20 5c Value key-sfd \
5c60: 20 73 65 63 72 65 74 20 6b 65 79 73 0a 30 20 56 secret keys.0 V
5c70: 61 6c 75 65 20 6b 65 79 2d 70 66 64 20 5c 20 70 alue key-pfd \ p
5c80: 75 62 6b 65 79 73 0a 0a 5c 20 6c 65 67 61 63 79 ubkeys..\ legacy
5c90: 20 66 6f 72 20 65 61 72 6c 79 20 76 65 72 73 69 for early versi
5ca0: 6f 6e 73 20 6f 66 20 6e 65 74 32 6f 20 70 72 69 ons of net2o pri
5cb0: 6f 72 20 32 30 31 36 30 36 30 36 0a 0a 3a 20 6e or 20160606..: n
5cc0: 65 74 32 6f 3e 6b 65 79 73 20 7b 20 61 64 64 72 et2o>keys { addr
5cd0: 20 75 20 2d 2d 20 7d 0a 20 20 20 20 61 64 64 72 u -- }. addr
5ce0: 20 75 20 2e 6e 65 74 32 6f 2f 20 20 61 64 64 72 u .net2o/ addr
5cf0: 20 75 20 2e 6b 65 79 73 2f 20 72 65 6e 61 6d 65 u .keys/ rename
5d00: 2d 66 69 6c 65 20 64 72 6f 70 20 3b 0a 3a 20 3f -file drop ;.: ?
5d10: 6c 65 67 61 63 79 2d 6b 65 79 73 20 28 20 66 6c legacy-keys ( fl
5d20: 61 67 20 2d 2d 20 29 0a 20 20 20 20 5c 20 21 21 ag -- ). \ !!
5d30: 46 49 58 4d 45 21 21 20 6e 65 65 64 73 20 74 6f FIXME!! needs to
5d40: 20 62 65 20 72 65 6d 6f 76 65 64 20 77 68 65 6e be removed when
5d50: 20 61 6c 6c 20 63 75 72 72 65 6e 74 20 75 73 65 all current use
5d60: 72 73 0a 20 20 20 20 5c 20 68 61 76 65 20 6d 69 rs. \ have mi
5d70: 67 72 61 74 65 64 0a 20 20 20 20 49 46 0a 09 22 grated. IF.."
5d80: 70 75 62 6b 65 79 73 2e 6b 32 6f 22 20 6e 65 74 pubkeys.k2o" net
5d90: 32 6f 3e 6b 65 79 73 0a 09 22 73 65 63 6b 65 79 2o>keys.."seckey
5da0: 73 2e 6b 32 6f 22 20 6e 65 74 32 6f 3e 6b 65 79 s.k2o" net2o>key
5db0: 73 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 s. THEN ;..:
5dc0: 67 65 6e 2d 6b 65 79 73 2d 64 69 72 20 28 20 2d gen-keys-dir ( -
5dd0: 2d 20 29 0a 20 20 20 20 69 6e 69 74 2d 64 69 72 - ). init-dir
5de0: 73 20 3f 2e 6e 65 74 32 6f 2f 6b 65 79 73 20 3f s ?.net2o/keys ?
5df0: 6c 65 67 61 63 79 2d 6b 65 79 73 0a 20 20 20 20 legacy-keys.
5e00: 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 23 20 30 3d groups[] $[]# 0=
5e10: 20 49 46 20 20 72 65 61 64 2d 67 72 6f 75 70 73 IF read-groups
5e20: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 3f 66 64 2d THEN ;..: ?fd-
5e30: 6b 65 79 73 20 28 20 66 64 20 61 64 64 72 20 75 keys ( fd addr u
5e40: 20 2d 2d 20 66 64 27 20 29 20 7b 20 61 64 64 72 -- fd' ) { addr
5e50: 20 75 20 7d 20 64 75 70 20 3f 45 58 49 54 20 64 u } dup ?EXIT d
5e60: 72 6f 70 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 rop. gen-keys
5e70: 2d 64 69 72 0a 20 20 20 20 61 64 64 72 20 75 20 -dir. addr u
5e80: 72 2f 77 20 6f 70 65 6e 2d 66 69 6c 65 20 64 75 r/w open-file du
5e90: 70 20 6e 6f 2d 66 69 6c 65 23 20 3d 20 49 46 0a p no-file# = IF.
5ea0: 09 32 64 72 6f 70 20 61 64 64 72 20 75 20 72 2f .2drop addr u r/
5eb0: 77 20 63 72 65 61 74 65 2d 66 69 6c 65 0a 20 20 w create-file.
5ec0: 20 20 54 48 45 4e 20 20 74 68 72 6f 77 20 3b 0a THEN throw ;.
5ed0: 0a 3a 20 3f 6b 65 79 2d 73 66 64 20 28 20 2d 2d .: ?key-sfd ( --
5ee0: 20 66 64 20 29 0a 20 20 20 20 6b 65 79 2d 73 66 fd ). key-sf
5ef0: 64 20 22 73 65 63 6b 65 79 73 2e 6b 32 6f 22 20 d "seckeys.k2o"
5f00: 2e 6b 65 79 73 2f 20 3f 66 64 2d 6b 65 79 73 20 .keys/ ?fd-keys
5f10: 64 75 70 20 74 6f 20 6b 65 79 2d 73 66 64 20 3b dup to key-sfd ;
5f20: 0a 3a 20 3f 6b 65 79 2d 70 66 64 20 28 20 2d 2d .: ?key-pfd ( --
5f30: 20 66 64 20 29 0a 20 20 20 20 6b 65 79 2d 70 66 fd ). key-pf
5f40: 64 20 22 70 75 62 6b 65 79 73 2e 6b 32 6f 22 20 d "pubkeys.k2o"
5f50: 2e 6b 65 79 73 2f 20 3f 66 64 2d 6b 65 79 73 20 .keys/ ?fd-keys
5f60: 64 75 70 20 74 6f 20 6b 65 79 2d 70 66 64 20 3b dup to key-pfd ;
5f70: 0a 0a 3a 20 6b 65 79 3e 73 66 69 6c 65 20 28 20 ..: key>sfile (
5f80: 2d 2d 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b -- ). keypack
5f90: 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3f 6b keypack-all# ?k
5fa0: 65 79 2d 73 66 64 20 61 70 70 65 6e 64 2d 66 69 ey-sfd append-fi
5fb0: 6c 65 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 21 le ke-offset 64!
5fc0: 20 3b 0a 3a 20 6b 65 79 3e 70 66 69 6c 65 20 28 ;.: key>pfile (
5fd0: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 70 61 63 -- ). keypac
5fe0: 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3f k keypack-all# ?
5ff0: 6b 65 79 2d 70 66 64 20 61 70 70 65 6e 64 2d 66 key-pfd append-f
6000: 69 6c 65 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 ile ke-offset 64
6010: 21 20 3b 0a 0a 3a 20 6b 65 79 3e 73 66 69 6c 65 ! ;..: key>sfile
6020: 40 70 6f 73 20 28 20 36 34 70 6f 73 20 2d 2d 20 @pos ( 64pos --
6030: 29 20 36 34 64 75 70 20 36 34 23 2d 31 20 36 34 ) 64dup 64#-1 64
6040: 3d 20 49 46 20 20 36 34 64 72 6f 70 20 6b 65 79 = IF 64drop key
6050: 3e 73 66 69 6c 65 0a 20 20 20 20 45 4c 53 45 20 >sfile. ELSE
6060: 20 36 34 3e 72 20 6b 65 79 70 61 63 6b 20 6b 65 64>r keypack ke
6070: 79 70 61 63 6b 2d 61 6c 6c 23 20 36 34 72 3e 20 ypack-all# 64r>
6080: 3f 6b 65 79 2d 73 66 64 20 77 72 69 74 65 40 70 ?key-sfd write@p
6090: 6f 73 2d 66 69 6c 65 20 20 54 48 45 4e 20 3b 0a os-file THEN ;.
60a0: 3a 20 6b 65 79 3e 70 66 69 6c 65 40 70 6f 73 20 : key>pfile@pos
60b0: 28 20 36 34 70 6f 73 20 2d 2d 20 29 20 36 34 64 ( 64pos -- ) 64d
60c0: 75 70 20 36 34 23 2d 31 20 36 34 3d 20 49 46 20 up 64#-1 64= IF
60d0: 20 36 34 64 72 6f 70 20 6b 65 79 3e 70 66 69 6c 64drop key>pfil
60e0: 65 0a 20 20 20 20 45 4c 53 45 20 20 36 34 3e 72 e. ELSE 64>r
60f0: 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b keypack keypack
6100: 2d 61 6c 6c 23 20 36 34 72 3e 20 3f 6b 65 79 2d -all# 64r> ?key-
6110: 70 66 64 20 77 72 69 74 65 40 70 6f 73 2d 66 69 pfd write@pos-fi
6120: 6c 65 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 72 6e le THEN ;..: rn
6130: 64 3e 73 66 69 6c 65 20 28 20 2d 2d 20 29 0a 20 d>sfile ( -- ).
6140: 20 20 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 keypack keypa
6150: 63 6b 2d 61 6c 6c 23 20 3e 72 6e 67 24 20 6b 65 ck-all# >rng$ ke
6160: 79 3e 73 66 69 6c 65 20 3b 0a 3a 20 72 6e 64 3e y>sfile ;.: rnd>
6170: 70 66 69 6c 65 20 28 20 2d 2d 20 29 0a 20 20 20 pfile ( -- ).
6180: 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b keypack keypack
6190: 2d 61 6c 6c 23 20 3e 72 6e 67 24 20 6b 65 79 3e -all# >rng$ key>
61a0: 70 66 69 6c 65 20 3b 0a 0a 5c 20 6b 65 79 20 67 pfile ;..\ key g
61b0: 65 6e 65 72 61 74 69 6f 6e 0a 5c 20 66 6f 72 20 eneration.\ for
61c0: 72 65 70 72 6f 64 75 63 69 62 69 6c 69 74 79 20 reproducibility
61d0: 6f 66 20 74 68 65 20 73 65 6c 66 73 69 67 2c 20 of the selfsig,
61e0: 61 6c 77 61 79 73 20 75 73 65 20 74 68 65 20 73 always use the s
61f0: 61 6d 65 20 6f 72 64 65 72 3a 0a 5c 20 22 70 75 ame order:.\ "pu
6200: 62 6b 65 79 22 20 6e 65 77 6b 65 79 20 3c 6e 3e bkey" newkey <n>
6210: 20 6b 65 79 74 79 70 65 20 22 6e 69 63 6b 22 20 keytype "nick"
6220: 6b 65 79 6e 69 63 6b 20 22 73 69 67 22 20 6b 65 keynick "sig" ke
6230: 79 73 65 6c 66 73 69 67 0a 0a 55 73 65 72 20 70 yselfsig..User p
6240: 6b 2b 73 69 67 24 0a 0a 6b 65 79 73 69 7a 65 32 k+sig$..keysize2
6250: 20 43 6f 6e 73 74 61 6e 74 20 70 6b 72 6b 23 0a Constant pkrk#.
6260: 0a 3a 20 5d 70 6b 2b 73 69 67 6e 20 28 20 61 64 .: ]pk+sign ( ad
6270: 64 72 20 75 20 2d 2d 20 29 20 2b 63 6d 64 62 75 dr u -- ) +cmdbu
6280: 66 20 5d 73 69 67 6e 20 3b 0a 0a 61 6c 73 6f 20 f ]sign ;..also
6290: 6e 65 74 32 6f 2d 62 61 73 65 0a 3a 20 70 61 63 net2o-base.: pac
62a0: 6b 2d 63 6f 72 65 20 28 20 6f 3a 6b 65 79 20 2d k-core ( o:key -
62b0: 2d 20 29 20 5c 20 63 6f 72 65 20 77 69 74 68 6f - ) \ core witho
62c0: 75 74 20 6b 65 79 0a 20 20 20 20 6b 65 2d 74 79 ut key. ke-ty
62d0: 70 65 20 40 20 75 6c 69 74 2c 20 6b 65 79 74 79 pe @ ulit, keyty
62e0: 70 65 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 24 pe. ke-nick $
62f0: 40 20 24 2c 20 6b 65 79 6e 69 63 6b 0a 20 20 20 @ $, keynick.
6300: 20 6b 65 2d 70 72 6f 66 20 24 40 20 64 75 70 20 ke-prof $@ dup
6310: 49 46 20 20 24 2c 20 6b 65 79 70 72 6f 66 69 6c IF $, keyprofil
6320: 65 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 e ELSE 2drop
6330: 54 48 45 4e 0a 20 20 20 20 6b 65 2d 61 76 61 74 THEN. ke-avat
6340: 61 72 20 24 40 20 64 75 70 20 49 46 20 20 24 2c ar $@ dup IF $,
6350: 20 61 76 61 74 61 72 20 20 45 4c 53 45 20 20 32 avatar ELSE 2
6360: 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 drop THEN ;..:
6370: 70 61 63 6b 2d 73 69 67 6e 6b 65 79 20 28 20 6f pack-signkey ( o
6380: 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 73 69 :key -- ). si
6390: 67 6e 5b 0a 20 20 20 20 70 61 63 6b 2d 63 6f 72 gn[. pack-cor
63a0: 65 0a 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 2b e. ke-pk $@ +
63b0: 63 6d 64 62 75 66 0a 20 20 20 20 6b 65 2d 73 65 cmdbuf. ke-se
63c0: 6c 66 73 69 67 20 24 40 20 2b 63 6d 64 62 75 66 lfsig $@ +cmdbuf
63d0: 20 63 6d 64 2d 72 65 73 6f 6c 76 65 3e 20 32 64 cmd-resolve> 2d
63e0: 72 6f 70 20 6e 65 73 74 73 69 67 20 3b 0a 0a 3a rop nestsig ;..:
63f0: 20 70 61 63 6b 2d 63 6f 72 65 6b 65 79 20 28 20 pack-corekey (
6400: 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 70 o:key -- ). p
6410: 61 63 6b 2d 73 69 67 6e 6b 65 79 0a 20 20 20 20 ack-signkey.
6420: 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 75 6c 69 ke-imports @ uli
6430: 74 2c 20 6b 65 79 69 6d 70 6f 72 74 0a 20 20 20 t, keyimport.
6440: 20 6b 65 2d 6d 61 73 6b 20 40 20 20 6b 65 2d 67 ke-mask @ ke-g
6450: 72 6f 75 70 73 20 24 40 6c 65 6e 20 49 46 0a 09 roups $@len IF..
6460: 6b 65 2d 67 72 6f 75 70 73 20 24 40 20 32 64 75 ke-groups $@ 2du
6470: 70 20 24 2c 20 6b 65 79 67 72 6f 75 70 73 0a 09 p $, keygroups..
6480: 67 72 6f 75 70 73 3e 6d 61 73 6b 20 69 6e 76 65 groups>mask inve
6490: 72 74 20 61 6e 64 20 20 54 48 45 4e 0a 20 20 20 rt and THEN.
64a0: 20 3f 64 75 70 2d 49 46 20 20 75 6c 69 74 2c 20 ?dup-IF ulit,
64b0: 6b 65 79 6d 61 73 6b 20 20 54 48 45 4e 0a 20 20 keymask THEN.
64c0: 20 20 6b 65 2d 70 65 74 73 5b 5d 20 5b 3a 20 24 ke-pets[] [: $
64d0: 2c 20 6b 65 79 70 65 74 20 3b 5d 20 24 5b 5d 6d , keypet ;] $[]m
64e0: 61 70 0a 20 20 20 20 6b 65 2d 73 74 6f 72 65 6b ap. ke-storek
64f0: 65 79 20 40 20 3e 73 74 6f 72 65 6b 65 79 20 21 ey @ >storekey !
6500: 20 3b 0a 0a 3a 20 70 61 63 6b 2d 63 6f 72 65 73 ;..: pack-cores
6510: 65 63 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a ec ( o:key -- ).
6520: 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 40 20 73 ke-sk sec@ s
6530: 65 63 24 2c 20 70 72 69 76 6b 65 79 0a 20 20 20 ec$, privkey.
6540: 20 6b 65 2d 72 73 6b 20 73 65 63 40 20 64 75 70 ke-rsk sec@ dup
6550: 20 49 46 20 20 73 65 63 24 2c 20 72 73 6b 6b 65 IF sec$, rskke
6560: 79 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 y ELSE 2drop
6570: 54 48 45 4e 0a 20 20 20 20 6b 65 2d 77 61 6c 6c THEN. ke-wall
6580: 65 74 20 73 65 63 40 20 64 75 70 20 49 46 20 20 et sec@ dup IF
6590: 73 65 63 24 2c 20 77 61 6c 6c 65 74 6b 65 79 20 sec$, walletkey
65a0: 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 ELSE 2drop TH
65b0: 45 4e 20 3b 0a 3a 20 70 61 63 6b 2d 63 6f 72 65 EN ;.: pack-core
65c0: 65 78 74 72 61 20 28 20 6f 3a 6b 65 79 20 2d 2d extra ( o:key --
65d0: 20 29 0a 20 20 20 20 6b 65 2d 5b 5d 31 20 5b 3a ). ke-[]1 [:
65e0: 20 24 2c 20 6b 65 79 2d 73 74 72 69 6e 67 31 20 $, key-string1
65f0: 3b 5d 20 24 5b 5d 6d 61 70 0a 20 20 20 20 6b 65 ;] $[]map. ke
6600: 2d 5b 5d 32 20 5b 3a 20 24 2c 20 6b 65 79 2d 73 -[]2 [: $, key-s
6610: 74 72 69 6e 67 32 20 3b 5d 20 24 5b 5d 6d 61 70 tring2 ;] $[]map
6620: 0a 20 20 20 20 6b 65 2d 5b 5d 33 20 5b 3a 20 24 . ke-[]3 [: $
6630: 2c 20 6b 65 79 2d 73 74 72 69 6e 67 33 20 3b 5d , key-string3 ;]
6640: 20 24 5b 5d 6d 61 70 0a 20 20 20 20 6b 65 2d 5b $[]map. ke-[
6650: 5d 34 20 5b 3a 20 24 2c 20 6b 65 79 2d 73 74 72 ]4 [: $, key-str
6660: 69 6e 67 34 20 3b 5d 20 24 5b 5d 6d 61 70 0a 20 ing4 ;] $[]map.
6670: 20 20 20 6b 65 2d 23 31 20 36 34 40 20 36 34 64 ke-#1 64@ 64d
6680: 75 70 20 36 34 2d 30 3c 3e 20 49 46 20 20 6c 69 up 64-0<> IF li
6690: 74 2c 20 6b 65 79 2d 6e 75 6d 31 20 20 45 4c 53 t, key-num1 ELS
66a0: 45 20 20 36 34 64 72 6f 70 20 20 54 48 45 4e 0a E 64drop THEN.
66b0: 20 20 20 20 6b 65 2d 23 32 20 36 34 40 20 36 34 ke-#2 64@ 64
66c0: 64 75 70 20 36 34 2d 30 3c 3e 20 49 46 20 20 6c dup 64-0<> IF l
66d0: 69 74 2c 20 6b 65 79 2d 6e 75 6d 32 20 20 45 4c it, key-num2 EL
66e0: 53 45 20 20 36 34 64 72 6f 70 20 20 54 48 45 4e SE 64drop THEN
66f0: 0a 20 20 20 20 6b 65 2d 23 33 20 36 34 40 20 36 . ke-#3 64@ 6
6700: 34 64 75 70 20 36 34 2d 30 3c 3e 20 49 46 20 20 4dup 64-0<> IF
6710: 6c 69 74 2c 20 6b 65 79 2d 6e 75 6d 33 20 20 45 lit, key-num3 E
6720: 4c 53 45 20 20 36 34 64 72 6f 70 20 20 54 48 45 LSE 64drop THE
6730: 4e 0a 20 20 20 20 6b 65 2d 23 34 20 36 34 40 20 N. ke-#4 64@
6740: 36 34 64 75 70 20 36 34 2d 30 3c 3e 20 49 46 20 64dup 64-0<> IF
6750: 20 6c 69 74 2c 20 6b 65 79 2d 6e 75 6d 34 20 20 lit, key-num4
6760: 45 4c 53 45 20 20 36 34 64 72 6f 70 20 20 54 48 ELSE 64drop TH
6770: 45 4e 20 3b 0a 3a 20 70 61 63 6b 2d 73 65 63 65 EN ;.: pack-sece
6780: 78 74 72 61 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 xtra ( o:key --
6790: 29 0a 20 20 20 20 6b 65 2d 73 65 63 31 20 73 65 ). ke-sec1 se
67a0: 63 40 20 64 75 70 20 49 46 20 20 73 65 63 24 2c c@ dup IF sec$,
67b0: 20 6b 65 79 2d 73 65 63 31 20 20 45 4c 53 45 20 key-sec1 ELSE
67c0: 20 32 64 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 2drop THEN.
67d0: 20 6b 65 2d 73 65 63 32 20 73 65 63 40 20 64 75 ke-sec2 sec@ du
67e0: 70 20 49 46 20 20 73 65 63 24 2c 20 6b 65 79 2d p IF sec$, key-
67f0: 73 65 63 32 20 20 45 4c 53 45 20 20 32 64 72 6f sec2 ELSE 2dro
6800: 70 20 20 54 48 45 4e 20 3b 0a 70 72 65 76 69 6f p THEN ;.previo
6810: 75 73 0a 0a 3a 20 70 61 63 6b 2d 70 75 62 6b 65 us..: pack-pubke
6820: 79 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 y ( o:key -- ).
6830: 20 20 20 6b 65 79 3a 63 6f 64 65 0a 20 20 20 20 key:code.
6840: 20 20 6b 65 79 2d 76 65 72 73 69 6f 6e 24 20 24 key-version$ $
6850: 2c 20 76 65 72 73 69 6f 6e 0a 20 20 20 20 20 20 , version.
6860: 70 61 63 6b 2d 63 6f 72 65 6b 65 79 0a 20 20 20 pack-corekey.
6870: 20 20 20 70 61 63 6b 2d 63 6f 72 65 65 78 74 72 pack-coreextr
6880: 61 0a 20 20 20 20 65 6e 64 3a 6b 65 79 20 3b 0a a. end:key ;.
6890: 3a 20 70 61 63 6b 2d 6f 75 74 6b 65 79 20 28 20 : pack-outkey (
68a0: 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b o:key -- ). k
68b0: 65 79 3a 63 6f 64 65 0a 20 20 20 20 20 20 22 6e ey:code. "n
68c0: 32 6f 22 20 6e 65 74 32 6f 2d 62 61 73 65 3a 34 2o" net2o-base:4
68d0: 63 63 2c 0a 20 20 20 20 20 20 6b 65 79 2d 76 65 cc,. key-ve
68e0: 72 73 69 6f 6e 24 20 24 2c 20 76 65 72 73 69 6f rsion$ $, versio
68f0: 6e 0a 20 20 20 20 20 20 70 61 63 6b 2d 73 69 67 n. pack-sig
6900: 6e 6b 65 79 0a 20 20 20 20 65 6e 64 3a 6b 65 79 nkey. end:key
6910: 20 3b 0a 3a 20 70 61 63 6b 2d 73 65 63 6b 65 79 ;.: pack-seckey
6920: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 ( o:key -- ).
6930: 20 20 6b 65 79 3a 63 6f 64 65 0a 20 20 20 20 20 key:code.
6940: 20 6b 65 79 2d 76 65 72 73 69 6f 6e 24 20 24 2c key-version$ $,
6950: 20 76 65 72 73 69 6f 6e 0a 20 20 20 20 20 20 70 version. p
6960: 61 63 6b 2d 63 6f 72 65 6b 65 79 0a 20 20 20 20 ack-corekey.
6970: 20 20 70 61 63 6b 2d 63 6f 72 65 73 65 63 0a 20 pack-coresec.
6980: 20 20 20 20 20 70 61 63 6b 2d 63 6f 72 65 65 78 pack-coreex
6990: 74 72 61 0a 20 20 20 20 20 20 70 61 63 6b 2d 73 tra. pack-s
69a0: 65 63 65 78 74 72 61 0a 20 20 20 20 65 6e 64 3a ecextra. end:
69b0: 6b 65 79 20 3b 0a 3a 20 6b 65 79 6e 69 63 6b 24 key ;.: keynick$
69c0: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 64 72 ( o:key -- addr
69d0: 20 75 20 29 0a 20 20 20 20 5c 47 20 67 65 74 20 u ). \G get
69e0: 74 68 65 20 61 6e 6e 6f 74 61 74 69 6f 6e 73 20 the annotations
69f0: 77 69 74 68 20 73 69 67 6e 61 74 75 72 65 0a 20 with signature.
6a00: 20 20 20 5b 27 5d 20 70 61 63 6b 2d 63 6f 72 65 ['] pack-core
6a10: 20 67 65 6e 2d 63 6d 64 24 20 32 64 72 6f 70 0a gen-cmd$ 2drop.
6a20: 20 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 ke-selfsig $
6a30: 40 20 74 6d 70 24 20 24 2b 21 20 74 6d 70 24 20 @ tmp$ $+! tmp$
6a40: 24 40 20 3b 0a 3a 20 6b 65 79 70 6b 32 6e 69 63 $@ ;.: keypk2nic
6a50: 6b 24 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 k$ ( o:key -- ad
6a60: 64 72 20 75 20 29 0a 20 20 20 20 5c 47 20 67 65 dr u ). \G ge
6a70: 74 20 74 68 65 20 61 6e 6e 6f 74 61 74 69 6f 6e t the annotation
6a80: 73 20 77 69 74 68 20 73 69 67 6e 61 74 75 72 65 s with signature
6a90: 0a 20 20 20 20 5b 27 5d 20 70 61 63 6b 2d 63 6f . ['] pack-co
6aa0: 72 65 20 67 65 6e 2d 63 6d 64 24 20 32 64 72 6f re gen-cmd$ 2dro
6ab0: 70 0a 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 74 p. ke-pk $@ t
6ac0: 6d 70 24 20 24 2b 21 20 6b 65 2d 73 65 6c 66 73 mp$ $+! ke-selfs
6ad0: 69 67 20 24 40 20 74 6d 70 24 20 24 2b 21 20 74 ig $@ tmp$ $+! t
6ae0: 6d 70 24 20 24 40 20 3b 0a 3a 20 6d 79 6e 69 63 mp$ $@ ;.: mynic
6af0: 6b 2d 6b 65 79 20 28 20 2d 2d 20 6f 20 29 0a 20 k-key ( -- o ).
6b00: 20 20 20 70 6b 40 20 6b 65 79 7c 20 6b 65 79 23 pk@ key| key#
6b10: 20 23 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3b #@ drop cell+ ;
6b20: 0a 3a 20 6d 79 6e 69 63 6b 24 20 28 20 2d 2d 20 .: mynick$ ( --
6b30: 61 64 64 72 20 75 20 29 0a 20 20 20 20 5c 47 20 addr u ). \G
6b40: 67 65 74 20 6d 79 20 6e 69 63 6b 20 77 69 74 68 get my nick with
6b50: 20 73 69 67 6e 61 74 75 72 65 0a 20 20 20 20 6d signature. m
6b60: 79 6e 69 63 6b 2d 6b 65 79 20 2e 6b 65 79 6e 69 ynick-key .keyni
6b70: 63 6b 24 20 3b 0a 3a 20 6d 79 70 6b 32 6e 69 63 ck$ ;.: mypk2nic
6b80: 6b 24 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 k$ ( o:key -- ad
6b90: 64 72 20 75 20 29 0a 20 20 20 20 5c 47 20 67 65 dr u ). \G ge
6ba0: 74 20 6d 79 20 6e 69 63 6b 20 77 69 74 68 20 73 t my nick with s
6bb0: 69 67 6e 61 74 75 72 65 0a 20 20 20 20 6d 79 6e ignature. myn
6bc0: 69 63 6b 2d 6b 65 79 20 2e 6b 65 79 70 6b 32 6e ick-key .keypk2n
6bd0: 69 63 6b 24 20 3b 0a 3a 20 6b 65 79 2d 73 69 67 ick$ ;.: key-sig
6be0: 6e 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b n ( o:key -- o:k
6bf0: 65 79 20 29 0a 20 20 20 20 5b 27 5d 20 70 61 63 ey ). ['] pac
6c00: 6b 2d 63 6f 72 65 20 67 65 6e 2d 63 6d 64 24 0a k-core gen-cmd$.
6c10: 20 20 20 20 5b 3a 20 74 79 70 65 20 6b 65 2d 70 [: type ke-p
6c20: 6b 20 24 40 20 74 79 70 65 20 3b 5d 20 24 74 6d k $@ type ;] $tm
6c30: 70 0a 20 20 20 20 6e 6f 77 3e 6e 65 76 65 72 20 p. now>never
6c40: 63 3a 30 6b 65 79 20 63 3a 68 61 73 68 20 5b 3a c:0key c:hash [:
6c50: 20 30 20 2e 2e 73 69 67 20 3b 5d 20 24 74 6d 70 0 ..sig ;] $tmp
6c60: 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 21 20 3b ke-selfsig $! ;
6c70: 0a 0a 56 61 72 69 61 62 6c 65 20 63 70 2d 74 6d ..Variable cp-tm
6c80: 70 0a 0a 3a 20 73 65 63 2d 6b 65 79 3f 20 28 20 p..: sec-key? (
6c90: 6f 3a 6b 65 79 20 2d 2d 20 66 6c 61 67 20 29 0a o:key -- flag ).
6ca0: 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 40 20 64 ke-sk sec@ d
6cb0: 30 3c 3e 0a 20 20 20 20 6b 65 2d 67 72 6f 75 70 0<>. ke-group
6cc0: 73 20 24 40 20 24 30 31 20 73 63 61 6e 20 6e 69 s $@ $01 scan ni
6cd0: 70 20 30 3d 20 61 6e 64 20 3b 0a 0a 3a 20 73 61 p 0= and ;..: sa
6ce0: 76 65 2d 70 75 62 6b 65 79 73 20 28 20 2d 2d 20 ve-pubkeys ( --
6cf0: 29 0a 20 20 20 20 6b 65 79 2d 70 66 64 20 3f 64 ). key-pfd ?d
6d00: 75 70 2d 49 46 20 20 63 6c 6f 73 65 2d 66 69 6c up-IF close-fil
6d10: 65 20 74 68 72 6f 77 20 20 54 48 45 4e 0a 20 20 e throw THEN.
6d20: 20 20 22 70 75 62 6b 65 79 73 2e 6b 32 6f 22 20 "pubkeys.k2o"
6d30: 2e 6b 65 79 73 2f 20 5b 3a 20 74 6f 20 6b 65 79 .keys/ [: to key
6d40: 2d 70 66 64 0a 20 20 20 20 20 20 6b 65 79 23 20 -pfd. key#
6d50: 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 [: cell+ $@ drop
6d60: 20 63 65 6c 6c 2b 20 3e 6f 0a 09 73 65 63 2d 6b cell+ >o..sec-k
6d70: 65 79 3f 20 30 3d 20 49 46 20 20 70 61 63 6b 2d ey? 0= IF pack-
6d80: 70 75 62 6b 65 79 0a 09 20 20 20 20 66 6c 75 73 pubkey.. flus
6d90: 68 28 20 2e 22 20 73 61 76 69 6e 67 20 22 20 2e h( ." saving " .
6da0: 6e 69 63 6b 20 66 6f 72 74 68 3a 63 72 20 29 0a nick forth:cr ).
6db0: 09 20 20 20 20 6b 65 79 2d 63 72 79 70 74 20 6b . key-crypt k
6dc0: 65 2d 6f 66 66 73 65 74 20 36 34 40 20 6b 65 79 e-offset 64@ key
6dd0: 3e 70 66 69 6c 65 40 70 6f 73 0a 09 54 48 45 4e >pfile@pos..THEN
6de0: 20 6f 3e 20 3b 5d 20 23 6d 61 70 0a 20 20 20 20 o> ;] #map.
6df0: 30 20 74 6f 20 6b 65 79 2d 70 66 64 20 3b 5d 20 0 to key-pfd ;]
6e00: 73 61 76 65 2d 66 69 6c 65 20 20 3f 6b 65 79 2d save-file ?key-
6e10: 70 66 64 20 64 72 6f 70 20 3b 0a 0a 3a 20 73 61 pfd drop ;..: sa
6e20: 76 65 2d 73 65 63 6b 65 79 73 20 28 20 2d 2d 20 ve-seckeys ( --
6e30: 29 0a 20 20 20 20 6b 65 79 2d 73 66 64 20 3f 64 ). key-sfd ?d
6e40: 75 70 2d 49 46 20 20 63 6c 6f 73 65 2d 66 69 6c up-IF close-fil
6e50: 65 20 74 68 72 6f 77 20 20 54 48 45 4e 0a 20 20 e throw THEN.
6e60: 20 20 22 73 65 63 6b 65 79 73 2e 6b 32 6f 22 20 "seckeys.k2o"
6e70: 2e 6b 65 79 73 2f 20 5b 3a 20 74 6f 20 6b 65 79 .keys/ [: to key
6e80: 2d 73 66 64 0a 20 20 20 20 20 20 6b 65 79 23 20 -sfd. key#
6e90: 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 [: cell+ $@ drop
6ea0: 20 63 65 6c 6c 2b 20 3e 6f 0a 09 73 65 63 2d 6b cell+ >o..sec-k
6eb0: 65 79 3f 20 49 46 20 20 70 61 63 6b 2d 73 65 63 ey? IF pack-sec
6ec0: 6b 65 79 0a 09 20 20 20 20 63 6f 6e 66 69 67 3a key.. config:
6ed0: 70 77 2d 6c 65 76 65 6c 23 20 40 20 3e 72 20 20 pw-level# @ >r
6ee0: 6b 65 2d 70 77 6c 65 76 65 6c 20 40 20 63 6f 6e ke-pwlevel @ con
6ef0: 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23 20 21 0a fig:pw-level# !.
6f00: 09 20 20 20 20 6b 65 79 2d 63 72 79 70 74 20 6b . key-crypt k
6f10: 65 2d 6f 66 66 73 65 74 20 36 34 40 20 6b 65 79 e-offset 64@ key
6f20: 3e 73 66 69 6c 65 40 70 6f 73 0a 09 20 20 20 20 >sfile@pos..
6f30: 72 3e 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76 r> config:pw-lev
6f40: 65 6c 23 20 21 0a 09 54 48 45 4e 20 6f 3e 20 3b el# !..THEN o> ;
6f50: 5d 20 23 6d 61 70 0a 20 20 20 20 30 20 74 6f 20 ] #map. 0 to
6f60: 6b 65 79 2d 73 66 64 20 3b 5d 20 73 61 76 65 2d key-sfd ;] save-
6f70: 66 69 6c 65 20 20 3f 6b 65 79 2d 73 66 64 20 64 file ?key-sfd d
6f80: 72 6f 70 20 3b 0a 0a 3a 20 73 61 76 65 2d 6b 65 rop ;..: save-ke
6f90: 79 73 20 28 20 2d 2d 20 29 20 20 3f 2e 6e 65 74 ys ( -- ) ?.net
6fa0: 32 6f 2f 6b 65 79 73 20 64 72 6f 70 0a 20 20 20 2o/keys drop.
6fb0: 20 73 61 76 65 2d 70 75 62 6b 65 79 73 20 73 61 save-pubkeys sa
6fc0: 76 65 2d 73 65 63 6b 65 79 73 20 3b 0a 0a 5c 20 ve-seckeys ;..\
6fd0: 72 65 73 70 6f 6e 64 20 74 6f 20 73 63 61 6e 6e respond to scann
6fe0: 69 6e 67 20 6b 65 79 73 0a 0a 69 6e 20 6e 65 74 ing keys..in net
6ff0: 32 6f 20 66 6f 72 77 61 72 64 20 70 6b 6c 6f 6f 2o forward pkloo
7000: 6b 75 70 0a 0a 74 72 75 65 20 56 61 6c 75 65 20 kup..true Value
7010: 73 63 61 6e 2d 6f 6e 63 65 3f 0a 0a 3a 20 73 63 scan-once?..: sc
7020: 61 6e 6e 65 64 2d 6b 65 79 2d 69 6e 20 28 20 61 anned-key-in ( a
7030: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 2e ddr u -- ). .
7040: 22 20 73 63 61 6e 6e 65 64 20 22 20 20 32 64 75 " scanned " 2du
7050: 70 20 2e 6b 65 79 2d 69 64 20 63 72 0a 20 20 20 p .key-id cr.
7060: 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 49 46 key| key# #@ IF
7070: 0a 09 63 65 6c 6c 2b 20 3e 6f 20 5b 20 31 20 69 ..cell+ >o [ 1 i
7080: 6d 70 6f 72 74 23 73 63 61 6e 20 6c 73 68 69 66 mport#scan lshif
7090: 74 20 5d 4c 20 6b 65 2d 69 6d 70 6f 72 74 73 20 t ]L ke-imports
70a0: 6f 72 21 0a 09 2e 6b 65 79 2d 6c 69 73 74 20 63 or!...key-list c
70b0: 72 20 6f 3e 0a 09 73 61 76 65 2d 6b 65 79 73 0a r o>..save-keys.
70c0: 20 20 20 20 45 4c 53 45 20 20 64 72 6f 70 20 20 ELSE drop
70d0: 54 48 45 4e 20 3b 0a 3a 20 3f 73 63 61 6e 2d 6c THEN ;.: ?scan-l
70e0: 65 76 65 6c 20 28 20 2d 2d 20 29 0a 20 20 20 20 evel ( -- ).
70f0: 5b 49 46 44 45 46 5d 20 61 6e 64 72 6f 69 64 20 [IFDEF] android
7100: 5b 20 61 6c 73 6f 20 61 6e 64 72 6f 69 64 20 5d [ also android ]
7110: 0a 09 6c 65 76 65 6c 23 20 40 20 30 3e 20 73 63 ..level# @ 0> sc
7120: 61 6e 2d 6f 6e 63 65 3f 20 61 6e 64 20 6c 65 76 an-once? and lev
7130: 65 6c 23 20 2b 21 20 20 5b 20 70 72 65 76 69 6f el# +! [ previo
7140: 75 73 20 5d 0a 20 20 20 20 5b 54 48 45 4e 5d 20 us ]. [THEN]
7150: 3b 0a 0a 3a 20 73 63 61 6e 6e 65 64 2d 6b 65 79 ;..: scanned-key
7160: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 ( addr u -- ).
7170: 20 20 20 73 63 61 6e 6e 65 64 2d 6b 65 79 2d 69 scanned-key-i
7180: 6e 20 3f 73 63 61 6e 2d 6c 65 76 65 6c 20 3b 0a n ?scan-level ;.
7190: 3a 20 73 63 61 6e 6e 65 64 2d 68 61 73 68 20 28 : scanned-hash (
71a0: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 addr u -- ).
71b0: 20 2e 22 20 68 61 73 68 3a 20 22 20 38 35 74 79 ." hash: " 85ty
71c0: 70 65 20 63 72 20 3b 0a 3a 20 73 63 61 6e 6e 65 pe cr ;.: scanne
71d0: 64 2d 6b 65 79 73 69 67 20 28 20 61 64 64 72 20 d-keysig ( addr
71e0: 75 20 2d 2d 20 29 0a 20 20 20 20 2e 22 20 73 69 u -- ). ." si
71f0: 67 3a 20 22 20 38 35 74 79 70 65 20 63 72 0a 20 g: " 85type cr.
7200: 20 20 20 3f 73 63 61 6e 2d 6c 65 76 65 6c 20 3b ?scan-level ;
7210: 0a 3a 20 73 63 61 6e 6e 65 64 2d 73 65 63 72 65 .: scanned-secre
7220: 74 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a t ( addr u -- ).
7230: 20 20 20 20 2e 22 20 73 65 63 72 65 74 3a 20 22 ." secret: "
7240: 20 38 35 74 79 70 65 20 63 72 0a 20 20 20 20 3f 85type cr. ?
7250: 73 63 61 6e 2d 6c 65 76 65 6c 20 3b 0a 3a 20 73 scan-level ;.: s
7260: 63 61 6e 6e 65 64 2d 70 61 79 6d 65 6e 74 20 28 canned-payment (
7270: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 addr u -- ).
7280: 20 2e 22 20 70 61 79 6d 65 6e 74 3a 20 22 20 38 ." payment: " 8
7290: 35 74 79 70 65 20 63 72 0a 20 20 20 20 3f 73 63 5type cr. ?sc
72a0: 61 6e 2d 6c 65 76 65 6c 20 3b 0a 0a 43 72 65 61 an-level ;..Crea
72b0: 74 65 20 73 63 61 6e 6e 65 64 2d 78 0a 27 20 6e te scanned-x.' n
72c0: 6f 6f 70 20 2c 20 5c 20 73 74 75 62 20 66 6f 72 oop , \ stub for
72d0: 20 6f 77 6e 6b 65 79 0a 27 20 73 63 61 6e 6e 65 ownkey.' scanne
72e0: 64 2d 6b 65 79 20 2c 0a 27 20 73 63 61 6e 6e 65 d-key ,.' scanne
72f0: 64 2d 6b 65 79 73 69 67 20 2c 0a 27 20 73 63 61 d-keysig ,.' sca
7300: 6e 6e 65 64 2d 68 61 73 68 20 2c 0a 27 20 73 63 nned-hash ,.' sc
7310: 61 6e 6e 65 64 2d 73 65 63 72 65 74 20 2c 0a 27 anned-secret ,.'
7320: 20 73 63 61 6e 6e 65 64 2d 70 61 79 6d 65 6e 74 scanned-payment
7330: 20 2c 0a 0a 68 65 72 65 20 73 63 61 6e 6e 65 64 ,..here scanned
7340: 2d 78 20 2d 20 63 65 6c 6c 2f 20 63 6f 6e 73 74 -x - cell/ const
7350: 61 6e 74 20 73 63 61 6e 6e 65 64 2d 6d 61 78 23 ant scanned-max#
7360: 0a 0a 56 61 72 69 61 62 6c 65 20 6c 61 73 74 73 ..Variable lasts
7370: 63 61 6e 24 0a 0a 3a 20 6c 61 73 74 73 63 61 6e can$..: lastscan
7380: 3f 20 28 20 61 64 64 72 20 75 20 74 61 67 20 2d ? ( addr u tag -
7390: 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 3e 72 20 - flag ). >r
73a0: 24 6d 61 6b 65 20 7b 20 77 5e 20 6a 75 73 74 24 $make { w^ just$
73b0: 20 7d 20 72 3e 20 6a 75 73 74 24 20 63 24 2b 21 } r> just$ c$+!
73c0: 0a 20 20 20 20 6a 75 73 74 24 20 24 40 20 6c 61 . just$ $@ la
73d0: 73 74 73 63 61 6e 24 20 24 40 20 73 74 72 3d 0a stscan$ $@ str=.
73e0: 20 20 20 20 6a 75 73 74 24 20 40 20 6c 61 73 74 just$ @ last
73f0: 73 63 61 6e 24 20 24 21 62 75 66 20 3b 0a 3a 20 scan$ $!buf ;.:
7400: 73 63 61 6e 2d 72 65 73 75 6c 74 20 28 20 61 64 scan-result ( ad
7410: 64 72 20 75 20 74 61 67 20 2d 2d 20 29 0a 20 20 dr u tag -- ).
7420: 20 20 64 75 70 20 32 6f 76 65 72 20 72 6f 74 20 dup 2over rot
7430: 6c 61 73 74 73 63 61 6e 3f 20 49 46 20 64 72 6f lastscan? IF dro
7440: 70 20 32 64 72 6f 70 20 45 58 49 54 20 54 48 45 p 2drop EXIT THE
7450: 4e 0a 20 20 20 20 64 75 70 20 73 63 61 6e 6e 65 N. dup scanne
7460: 64 2d 6d 61 78 23 20 75 3c 20 49 46 20 20 63 65 d-max# u< IF ce
7470: 6c 6c 73 20 73 63 61 6e 6e 65 64 2d 78 20 2b 20 lls scanned-x +
7480: 70 65 72 66 6f 72 6d 0a 20 20 20 20 45 4c 53 45 perform. ELSE
7490: 20 20 2e 22 20 75 6e 6b 6e 6f 77 6e 20 74 61 67 ." unknown tag
74a0: 20 22 20 68 65 78 2e 20 2e 22 20 73 63 61 6e 6e " hex. ." scann
74b0: 65 64 20 22 20 38 35 74 79 70 65 20 63 72 20 3f ed " 85type cr ?
74c0: 73 63 61 6e 2d 6c 65 76 65 6c 20 20 54 48 45 4e scan-level THEN
74d0: 20 3b 0a 0a 5c 20 67 65 6e 65 72 61 74 65 20 6b ;..\ generate k
74e0: 65 79 73 0a 0a 3a 20 73 6b 73 69 67 21 20 28 20 eys..: sksig! (
74f0: 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 70 6b 20 24 -- ). ke-pk $
7500: 40 20 6b 65 2d 73 6b 20 73 65 63 40 20 63 3a 30 @ ke-sk sec@ c:0
7510: 6b 65 79 20 3e 6b 65 79 65 64 2d 68 61 73 68 20 key >keyed-hash
7520: 6b 65 79 70 61 64 20 6b 65 79 73 69 7a 65 20 6b keypad keysize k
7530: 65 63 63 61 6b 3e 0a 20 20 20 20 6b 65 79 70 61 eccak>. keypa
7540: 64 20 6b 65 79 73 69 7a 65 20 6b 65 2d 73 6b 73 d keysize ke-sks
7550: 69 67 20 73 65 63 21 20 3b 0a 0a 3a 20 2b 67 65 ig sec! ;..: +ge
7560: 6e 2d 6b 65 79 73 20 28 20 6e 69 63 6b 20 75 20 n-keys ( nick u
7570: 74 79 70 65 20 2d 2d 20 29 0a 20 20 20 20 67 65 type -- ). ge
7580: 6e 2d 6b 65 79 73 20 20 36 34 23 2d 31 20 6b 65 n-keys 64#-1 ke
7590: 79 2d 72 65 61 64 2d 6f 66 66 73 65 74 20 36 34 y-read-offset 64
75a0: 21 0a 20 20 20 20 70 6b 63 20 6b 65 79 73 69 7a !. pkc keysiz
75b0: 65 32 20 6b 65 79 3a 6e 65 77 20 3e 6f 20 6f 20 e2 key:new >o o
75c0: 74 6f 20 6d 79 2d 6b 65 79 2d 64 65 66 61 75 6c to my-key-defaul
75d0: 74 20 20 6f 20 74 6f 20 6d 79 2d 6b 65 79 0a 20 t o to my-key.
75e0: 20 20 20 5b 20 31 20 69 6d 70 6f 72 74 23 73 65 [ 1 import#se
75f0: 6c 66 20 6c 73 68 69 66 74 20 31 20 69 6d 70 6f lf lshift 1 impo
7600: 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 rt#new lshift or
7610: 20 5d 4c 20 6b 65 2d 69 6d 70 6f 72 74 73 20 21 ]L ke-imports !
7620: 0a 20 20 20 20 6b 65 2d 74 79 70 65 20 21 20 20 . ke-type !
7630: 6b 65 2d 6e 69 63 6b 20 24 21 20 20 6e 69 63 6b ke-nick $! nick
7640: 21 0a 20 20 20 20 63 6f 6e 66 69 67 3a 70 77 2d !. config:pw-
7650: 6c 65 76 65 6c 23 20 40 20 6b 65 2d 70 77 6c 65 level# @ ke-pwle
7660: 76 65 6c 20 21 20 20 70 65 72 6d 25 6d 79 73 65 vel ! perm%myse
7670: 6c 66 20 6b 65 2d 6d 61 73 6b 20 21 0a 20 20 20 lf ke-mask !.
7680: 20 73 6b 63 20 6b 65 79 73 69 7a 65 20 6b 65 2d skc keysize ke-
7690: 73 6b 20 73 65 63 21 20 20 2b 73 65 63 6b 65 79 sk sec! +seckey
76a0: 0a 20 20 20 20 73 6b 72 65 76 20 6b 65 79 73 69 . skrev keysi
76b0: 7a 65 20 6b 65 2d 72 73 6b 20 73 65 63 21 0a 20 ze ke-rsk sec!.
76c0: 20 20 20 73 6b 73 69 67 21 0a 5c 20 20 20 20 24 sksig!.\ $
76d0: 31 30 20 72 6e 67 24 20 6b 65 2d 77 61 6c 6c 65 10 rng$ ke-walle
76e0: 74 20 73 65 63 21 20 5c 20 77 61 6c 6c 65 74 20 t sec! \ wallet
76f0: 6b 65 79 20 69 73 20 6a 75 73 74 20 24 31 30 0a key is just $10.
7700: 20 20 20 20 6b 65 79 2d 73 69 67 6e 20 6f 3e 20 key-sign o>
7710: 3b 0a 0a 3a 20 74 68 69 73 2d 6b 65 79 2d 73 69 ;..: this-key-si
7720: 67 6e 20 28 20 2d 2d 20 29 0a 20 20 20 20 6d 79 gn ( -- ). my
7730: 2d 6b 65 79 20 3e 72 20 6f 20 74 6f 20 6d 79 2d -key >r o to my-
7740: 6b 65 79 20 20 6b 65 79 2d 73 69 67 6e 20 20 72 key key-sign r
7750: 3e 20 74 6f 20 6d 79 2d 6b 65 79 20 3b 0a 0a 3a > to my-key ;..:
7760: 20 64 75 6d 6d 79 2d 6b 65 79 20 28 20 72 61 64 dummy-key ( rad
7770: 64 72 20 75 20 6e 69 63 6b 20 75 20 2d 2d 20 6f dr u nick u -- o
7780: 20 29 0a 20 20 20 20 5c 47 20 47 65 6e 65 72 61 ). \G Genera
7790: 74 65 20 61 20 64 65 74 65 72 6d 69 6e 69 73 74 te a determinist
77a0: 69 63 20 6b 65 79 20 62 61 73 65 64 20 6f 6e 20 ic key based on
77b0: 74 68 65 20 61 64 64 72 65 73 73 20 61 6e 64 20 the address and
77c0: 6f 75 72 20 73 6b 73 69 67 0a 20 20 20 20 32 3e our sksig. 2>
77d0: 72 0a 20 20 20 20 32 64 75 70 20 73 6b 73 69 67 r. 2dup sksig
77e0: 40 20 6b 65 79 65 64 2d 68 61 73 68 23 31 32 38 @ keyed-hash#128
77f0: 20 73 6b 31 20 73 77 61 70 20 6d 6f 76 65 20 73 sk1 swap move s
7800: 6b 31 20 70 6b 31 20 73 6b 3e 70 6b 0a 20 20 20 k1 pk1 sk>pk.
7810: 20 73 6b 73 69 67 40 20 32 6f 76 65 72 20 6b 65 sksig@ 2over ke
7820: 79 65 64 2d 68 61 73 68 23 31 32 38 20 73 6b 72 yed-hash#128 skr
7830: 65 76 20 73 77 61 70 20 6d 6f 76 65 20 73 6b 72 ev swap move skr
7840: 65 76 20 70 6b 72 65 76 20 73 6b 3e 70 6b 0a 20 ev pkrev sk>pk.
7850: 20 20 20 73 6b 31 20 70 6b 72 65 76 20 73 6b 63 sk1 pkrev skc
7860: 20 70 6b 63 20 65 64 2d 6b 65 79 70 61 69 72 78 pkc ed-keypairx
7870: 20 32 72 3e 0a 20 20 20 20 69 6d 70 6f 72 74 23 2r>. import#
7880: 70 72 6f 76 69 73 69 6f 6e 61 6c 20 69 6d 70 6f provisional impo
7890: 72 74 2d 74 79 70 65 20 21 0a 20 20 20 20 70 6b rt-type !. pk
78a0: 63 20 6b 65 79 73 69 7a 65 32 20 6b 65 79 3a 6e c keysize2 key:n
78b0: 65 77 20 3e 6f 20 6b 65 2d 70 65 74 73 5b 5d 20 ew >o ke-pets[]
78c0: 24 2b 5b 5d 21 20 6b 65 2d 6e 69 63 6b 20 24 21 $+[]! ke-nick $!
78d0: 20 6e 69 63 6b 21 0a 20 20 20 20 73 6b 63 20 6b nick!. skc k
78e0: 65 79 73 69 7a 65 20 6b 65 2d 73 6b 20 73 65 63 eysize ke-sk sec
78f0: 21 20 20 73 6b 72 65 76 20 6b 65 79 73 69 7a 65 ! skrev keysize
7900: 20 6b 65 2d 72 73 6b 20 73 65 63 21 20 20 73 6b ke-rsk sec! sk
7910: 73 69 67 21 0a 20 20 20 20 70 65 72 6d 25 64 65 sig!. perm%de
7920: 66 61 75 6c 74 20 6b 65 2d 6d 61 73 6b 20 21 20 fault ke-mask !
7930: 22 5c 78 30 31 22 20 6b 65 2d 67 72 6f 75 70 73 "\x01" ke-groups
7940: 20 24 21 0a 20 20 20 20 74 68 69 73 2d 6b 65 79 $!. this-key
7950: 2d 73 69 67 6e 20 6f 20 6f 3e 20 3b 0a 0a 24 34 -sign o o> ;..$4
7960: 30 20 62 75 66 66 65 72 3a 20 6e 69 63 6b 2d 62 0 buffer: nick-b
7970: 75 66 0a 0a 3a 20 67 65 74 2d 6e 69 63 6b 20 28 uf..: get-nick (
7980: 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 -- addr u ).
7990: 20 2e 22 20 6e 69 63 6b 3a 20 22 20 6e 69 63 6b ." nick: " nick
79a0: 2d 62 75 66 20 24 34 30 20 61 63 63 65 70 74 20 -buf $40 accept
79b0: 6e 69 63 6b 2d 62 75 66 20 73 77 61 70 20 2d 74 nick-buf swap -t
79c0: 72 61 69 6c 69 6e 67 20 63 72 20 3b 0a 0a 66 61 railing cr ;..fa
79d0: 6c 73 65 20 76 61 6c 75 65 20 3f 79 65 73 0a 3a lse value ?yes.:
79e0: 20 79 65 73 3f 20 28 20 61 64 64 72 20 75 20 2d yes? ( addr u -
79f0: 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 3f 79 65 - flag ). ?ye
7a00: 73 20 49 46 20 20 32 64 72 6f 70 20 74 72 75 65 s IF 2drop true
7a10: 20 20 45 4c 53 45 20 20 74 79 70 65 20 2e 22 20 ELSE type ."
7a20: 20 28 79 2f 4e 29 22 20 6b 65 79 20 63 72 20 27 (y/N)" key cr '
7a30: 79 27 20 3d 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 y' = THEN ;..:
7a40: 3f 72 73 6b 20 28 20 2d 2d 20 29 0a 20 20 20 20 ?rsk ( -- ).
7a50: 70 6b 40 20 6b 65 79 7c 20 6b 65 79 2d 65 78 69 pk@ key| key-exi
7a60: 73 74 3f 20 64 75 70 20 30 3d 20 49 46 20 20 64 st? dup 0= IF d
7a70: 72 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e 0a rop EXIT THEN.
7a80: 20 20 20 20 3e 6f 20 6b 65 2d 72 73 6b 20 73 65 >o ke-rsk se
7a90: 63 40 20 64 75 70 20 30 3d 20 49 46 20 20 32 64 c@ dup 0= IF 2d
7aa0: 72 6f 70 20 6f 3e 20 20 45 58 49 54 20 20 54 48 rop o> EXIT TH
7ab0: 45 4e 0a 20 20 20 20 2e 22 20 59 6f 75 20 73 74 EN. ." You st
7ac0: 69 6c 6c 20 68 61 76 65 6e 27 74 20 73 74 6f 72 ill haven't stor
7ad0: 65 64 20 79 6f 75 72 20 72 65 76 6f 6b 65 20 6b ed your revoke k
7ae0: 65 79 20 73 65 63 75 72 65 6c 79 20 6f 66 66 2d ey securely off-
7af0: 6c 69 6e 65 2e 22 20 63 72 0a 20 20 20 20 73 22 line." cr. s"
7b00: 20 50 61 70 65 72 20 61 6e 64 20 70 65 6e 63 69 Paper and penci
7b10: 6c 20 72 65 61 64 79 3f 22 20 79 65 73 3f 20 49 l ready?" yes? I
7b20: 46 0a 09 2e 73 74 72 69 70 65 38 35 0a 09 73 22 F...stripe85..s"
7b30: 20 57 72 69 74 74 65 6e 20 64 6f 77 6e 3f 22 20 Written down?"
7b40: 79 65 73 3f 20 49 46 0a 09 20 20 20 20 73 22 20 yes? IF.. s"
7b50: 59 6f 75 20 77 6f 6e 27 74 20 73 65 65 20 74 68 You won't see th
7b60: 69 73 20 61 67 61 69 6e 21 20 44 65 6c 65 74 65 is again! Delete
7b70: 3f 22 20 79 65 73 3f 0a 09 20 20 20 20 49 46 20 ?" yes?.. IF
7b80: 6b 65 2d 72 73 6b 20 73 65 63 2d 66 72 65 65 20 ke-rsk sec-free
7b90: 20 73 61 76 65 2d 6b 65 79 73 0a 09 09 2e 22 20 save-keys...."
7ba0: 72 65 76 6f 6b 65 20 6b 65 79 20 64 65 6c 65 74 revoke key delet
7bb0: 65 64 2e 22 20 63 72 20 6f 3e 20 20 45 58 49 54 ed." cr o> EXIT
7bc0: 20 20 54 48 45 4e 20 20 54 48 45 4e 0a 20 20 20 THEN THEN.
7bd0: 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 ELSE 2drop TH
7be0: 45 4e 0a 20 20 20 20 2e 22 20 49 27 6d 20 6b 65 EN. ." I'm ke
7bf0: 65 70 69 6e 67 20 79 6f 75 72 20 72 65 76 6f 6b eping your revok
7c00: 65 20 6b 65 79 2e 20 20 54 68 69 73 20 77 69 6c e key. This wil
7c10: 6c 20 73 68 6f 77 20 75 70 20 61 67 61 69 6e 2e l show up again.
7c20: 22 20 63 72 20 6f 3e 20 3b 0a 0a 5c 20 72 65 61 " cr o> ;..\ rea
7c30: 64 20 6b 65 79 20 66 69 6c 65 0a 0a 3a 20 74 72 d key file..: tr
7c40: 79 2d 64 65 63 72 79 70 74 2d 6b 65 79 20 28 20 y-decrypt-key (
7c50: 6b 65 79 20 75 31 20 2d 2d 20 61 64 64 72 20 75 key u1 -- addr u
7c60: 32 20 66 6c 61 67 20 29 0a 20 20 20 20 6b 65 79 2 flag ). key
7c70: 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 64 20 6b pack keypack-d k
7c80: 65 79 70 61 63 6b 2d 61 6c 6c 23 20 6d 6f 76 65 eypack-all# move
7c90: 0a 20 20 20 20 6b 65 79 70 61 63 6b 2d 64 20 6b . keypack-d k
7ca0: 65 79 70 61 63 6b 2d 61 6c 6c 23 20 32 73 77 61 eypack-all# 2swa
7cb0: 70 0a 20 20 20 20 64 75 70 20 24 32 30 20 3d 20 p. dup $20 =
7cc0: 49 46 20 20 64 65 63 72 79 70 74 24 20 20 45 4c IF decrypt$ EL
7cd0: 53 45 0a 09 6b 65 79 70 61 63 6b 20 63 40 20 24 SE..keypack c@ $
7ce0: 46 20 61 6e 64 20 63 6f 6e 66 69 67 3a 70 77 2d F and config:pw-
7cf0: 6d 61 78 6c 65 76 65 6c 23 20 40 20 3c 3d 0a 09 maxlevel# @ <=..
7d00: 49 46 20 20 2b 63 6d 64 20 64 65 63 72 79 70 74 IF +cmd decrypt
7d10: 2d 70 77 24 20 2b 63 72 79 70 74 73 75 20 20 45 -pw$ +cryptsu E
7d20: 4c 53 45 20 20 32 64 72 6f 70 20 66 61 6c 73 65 LSE 2drop false
7d30: 20 20 54 48 45 4e 0a 20 20 20 20 54 48 45 4e 20 THEN. THEN
7d40: 3b 0a 0a 3a 20 74 72 79 2d 64 65 63 72 79 70 74 ;..: try-decrypt
7d50: 20 28 20 66 6c 61 67 20 2d 2d 20 61 64 64 72 20 ( flag -- addr
7d60: 75 20 2f 20 30 20 30 20 29 20 7b 20 66 6c 61 67 u / 0 0 ) { flag
7d70: 20 7d 0a 20 20 20 20 6b 65 79 73 20 24 5b 5d 23 }. keys $[]#
7d80: 20 30 20 3f 44 4f 0a 09 49 20 6b 65 79 73 20 73 0 ?DO..I keys s
7d90: 65 63 5b 5d 40 20 64 75 70 20 6b 65 79 73 69 7a ec[]@ dup keysiz
7da0: 65 20 3d 20 66 6c 61 67 20 78 6f 72 20 49 46 0a e = flag xor IF.
7db0: 09 20 20 20 20 74 72 79 2d 64 65 63 72 79 70 74 . try-decrypt
7dc0: 2d 6b 65 79 20 49 46 0a 09 09 49 20 6b 65 79 73 -key IF...I keys
7dd0: 20 24 5b 5d 20 40 20 64 75 70 20 3e 73 74 6f 72 $[] @ dup >stor
7de0: 65 6b 65 79 20 21 20 64 65 66 61 75 6c 74 6b 65 ekey ! defaultke
7df0: 79 20 21 0a 09 09 75 6e 6c 6f 6f 70 20 20 45 58 y !...unloop EX
7e00: 49 54 20 20 54 48 45 4e 20 20 54 48 45 4e 0a 09 IT THEN THEN..
7e10: 32 64 72 6f 70 0a 20 20 20 20 4c 4f 4f 50 20 20 2drop. LOOP
7e20: 30 20 30 20 3b 0a 0a 3a 20 3f 70 65 72 6d 20 28 0 0 ;..: ?perm (
7e30: 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 o:key -- ).
7e40: 6b 65 2d 73 6b 20 73 65 63 40 20 6e 69 70 20 64 ke-sk sec@ nip d
7e50: 75 70 20 49 46 20 20 70 65 72 6d 25 6d 79 73 65 up IF perm%myse
7e60: 6c 66 20 20 45 4c 53 45 20 20 70 65 72 6d 25 64 lf ELSE perm%d
7e70: 65 66 61 75 6c 74 20 20 54 48 45 4e 20 20 6b 65 efault THEN ke
7e80: 2d 6d 61 73 6b 20 21 0a 20 20 20 20 49 46 20 20 -mask !. IF
7e90: 22 5c 78 30 30 22 20 20 45 4c 53 45 20 20 22 5c "\x00" ELSE "\
7ea0: 78 30 31 22 20 20 54 48 45 4e 20 20 6b 65 2d 67 x01" THEN ke-g
7eb0: 72 6f 75 70 73 20 24 21 20 3b 0a 0a 3a 20 3f 77 roups $! ;..: ?w
7ec0: 61 6c 6c 65 74 20 28 20 6f 3a 6b 65 79 20 2d 2d allet ( o:key --
7ed0: 20 29 0a 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 ). ke-sk sec
7ee0: 40 20 6e 69 70 20 49 46 0a 09 6b 65 2d 77 61 6c @ nip IF..ke-wal
7ef0: 6c 65 74 20 73 65 63 40 20 6e 69 70 20 30 3d 20 let sec@ nip 0=
7f00: 49 46 0a 09 20 20 20 20 24 31 30 20 72 6e 67 24 IF.. $10 rng$
7f10: 20 6b 65 2d 77 61 6c 6c 65 74 20 73 65 63 21 20 ke-wallet sec!
7f20: 20 73 61 76 65 2d 6b 65 79 73 2d 61 67 61 69 6e save-keys-again
7f30: 20 6f 6e 0a 09 54 48 45 4e 0a 20 20 20 20 54 48 on..THEN. TH
7f40: 45 4e 20 3b 0a 0a 3a 20 64 6f 2d 6b 65 79 20 28 EN ;..: do-key (
7f50: 20 61 64 64 72 20 75 20 2f 20 30 20 30 20 20 2d addr u / 0 0 -
7f60: 2d 20 29 20 20 6b 65 79 2d 76 65 72 73 69 6f 6e - ) key-version
7f70: 20 6f 66 66 0a 20 20 20 20 64 75 70 20 30 3d 20 off. dup 0=
7f80: 49 46 20 20 32 64 72 6f 70 20 20 45 58 49 54 20 IF 2drop EXIT
7f90: 20 54 48 45 4e 0a 20 20 20 20 73 61 6d 70 6c 65 THEN. sample
7fa0: 2d 6b 65 79 20 3e 6f 20 6b 65 2d 73 6b 20 6b 65 -key >o ke-sk ke
7fb0: 2d 65 6e 64 20 6f 76 65 72 20 2d 20 65 72 61 73 -end over - eras
7fc0: 65 20 20 64 6f 2d 63 6d 64 2d 6c 6f 6f 70 0a 20 e do-cmd-loop.
7fd0: 20 20 20 6b 65 79 2d 76 65 72 73 69 6f 6e 20 40 key-version @
7fe0: 20 6b 65 79 2d 76 65 72 73 69 6f 6e 23 20 75 3c key-version# u<
7ff0: 20 73 61 76 65 2d 6b 65 79 73 2d 61 67 61 69 6e save-keys-again
8000: 20 6f 72 21 0a 20 20 20 20 28 20 6c 61 73 74 2d or!. ( last-
8010: 6b 65 79 20 2e 3f 77 61 6c 6c 65 74 20 29 20 6f key .?wallet ) o
8020: 3e 20 3b 0a 0a 3a 20 2e 6b 65 79 24 20 28 20 61 > ;..: .key$ ( a
8030: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 73 ddr u -- ). s
8040: 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 20 6b 65 ample-key >o ke
8050: 2d 73 6b 20 6b 65 2d 65 6e 64 20 6f 76 65 72 20 -sk ke-end over
8060: 2d 20 65 72 61 73 65 0a 20 20 20 20 73 69 67 6e - erase. sign
8070: 65 64 2d 76 61 6c 20 76 61 6c 69 64 61 74 65 64 ed-val validated
8080: 20 6f 72 21 20 20 63 2d 73 74 61 74 65 20 6f 66 or! c-state of
8090: 66 20 20 6e 65 73 74 2d 63 6d 64 2d 6c 6f 6f 70 f nest-cmd-loop
80a0: 0a 20 20 20 20 73 69 67 6e 65 64 2d 76 61 6c 20 . signed-val
80b0: 69 6e 76 65 72 74 20 76 61 6c 69 64 61 74 65 64 invert validated
80c0: 20 61 6e 64 21 0a 20 20 20 20 2e 6b 65 79 2d 73 and!. .key-s
80d0: 68 6f 72 74 20 66 72 65 65 2d 6b 65 79 20 6f 3e hort free-key o>
80e0: 20 3b 0a 0a 3a 20 72 65 61 64 2d 6b 65 79 73 2d ;..: read-keys-
80f0: 6c 6f 6f 70 20 28 20 66 64 20 2d 2d 20 29 20 20 loop ( fd -- )
8100: 73 61 76 65 2d 6b 65 79 73 2d 61 67 61 69 6e 20 save-keys-again
8110: 6f 66 66 0a 20 20 20 20 63 6f 64 65 2d 6b 65 79 off. code-key
8120: 0a 20 20 20 20 3e 72 20 23 30 2e 20 72 40 20 72 . >r #0. r@ r
8130: 65 70 6f 73 69 74 69 6f 6e 2d 66 69 6c 65 20 74 eposition-file t
8140: 68 72 6f 77 0a 20 20 20 20 42 45 47 49 4e 0a 09 hrow. BEGIN..
8150: 72 40 20 66 69 6c 65 2d 70 6f 73 69 74 69 6f 6e r@ file-position
8160: 20 74 68 72 6f 77 20 64 3e 36 34 20 6b 65 79 2d throw d>64 key-
8170: 72 65 61 64 2d 6f 66 66 73 65 74 20 36 34 21 0a read-offset 64!.
8180: 09 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b .keypack keypack
8190: 2d 61 6c 6c 23 20 72 40 20 72 65 61 64 2d 66 69 -all# r@ read-fi
81a0: 6c 65 20 74 68 72 6f 77 0a 09 6b 65 79 70 61 63 le throw..keypac
81b0: 6b 2d 61 6c 6c 23 20 3d 20 57 48 49 4c 45 0a 09 k-all# = WHILE..
81c0: 20 20 20 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 import-type
81d0: 40 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 3d 20 @ import#self =
81e0: 74 72 79 2d 64 65 63 72 79 70 74 20 64 6f 2d 6b try-decrypt do-k
81f0: 65 79 0a 09 52 45 50 45 41 54 20 20 72 64 72 6f ey..REPEAT rdro
8200: 70 20 20 63 6f 64 65 30 2d 62 75 66 20 3b 0a 3a p code0-buf ;.:
8210: 20 6d 69 67 72 61 74 65 2d 6b 65 79 2d 6c 6f 6f migrate-key-loo
8220: 70 20 28 20 2d 2d 20 29 20 20 73 65 63 72 65 74 p ( -- ) secret
8230: 2d 6b 65 79 73 23 20 3e 72 0a 20 20 20 20 6f 6c -keys# >r. ol
8240: 64 2d 70 77 2d 64 69 66 66 75 73 65 20 20 3f 6b d-pw-diffuse ?k
8250: 65 79 2d 73 66 64 20 72 65 61 64 2d 6b 65 79 73 ey-sfd read-keys
8260: 2d 6c 6f 6f 70 20 20 6e 65 77 2d 70 77 2d 64 69 -loop new-pw-di
8270: 66 66 75 73 65 0a 20 20 20 20 73 65 63 72 65 74 ffuse. secret
8280: 2d 6b 65 79 73 23 20 72 3e 20 75 3e 20 49 46 0a -keys# r> u> IF.
8290: 09 5b 3a 20 2e 22 20 4d 69 67 72 61 74 69 6e 67 .[: ." Migrating
82a0: 20 70 61 73 73 77 6f 72 64 20 68 61 73 68 20 74 password hash t
82b0: 6f 20 45 43 43 2b 6b 65 63 63 61 6b 22 20 63 72 o ECC+keccak" cr
82c0: 20 3b 5d 0a 09 69 6e 66 6f 2d 63 6f 6c 6f 72 20 ;]..info-color
82d0: 5b 27 5d 20 63 6f 6c 6f 72 2d 65 78 65 63 75 74 ['] color-execut
82e0: 65 20 64 6f 2d 64 65 62 75 67 0a 09 73 61 76 65 e do-debug..save
82f0: 2d 6b 65 79 73 2d 61 67 61 69 6e 20 6f 6e 0a 20 -keys-again on.
8300: 20 20 20 54 48 45 4e 20 3b 0a 3a 20 72 65 61 64 THEN ;.: read
8310: 2d 6b 65 79 2d 6c 6f 6f 70 20 28 20 2d 2d 20 29 -key-loop ( -- )
8320: 0a 20 20 20 20 69 6d 70 6f 72 74 23 73 65 6c 66 . import#self
8330: 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 20 import-type !
8340: 73 65 63 72 65 74 2d 6b 65 79 73 23 20 3e 72 0a secret-keys# >r.
8350: 20 20 20 20 3f 6b 65 79 2d 73 66 64 20 72 65 61 ?key-sfd rea
8360: 64 2d 6b 65 79 73 2d 6c 6f 6f 70 0a 20 20 20 20 d-keys-loop.
8370: 73 65 63 72 65 74 2d 6b 65 79 73 23 20 72 3e 20 secret-keys# r>
8380: 3d 20 49 46 20 20 6d 69 67 72 61 74 65 2d 6b 65 = IF migrate-ke
8390: 79 2d 6c 6f 6f 70 20 20 54 48 45 4e 0a 20 20 20 y-loop THEN.
83a0: 20 73 61 76 65 2d 6b 65 79 73 2d 61 67 61 69 6e save-keys-again
83b0: 20 40 20 49 46 20 20 73 61 76 65 2d 73 65 63 6b @ IF save-seck
83c0: 65 79 73 20 20 20 20 20 20 54 48 45 4e 20 3b 0a eys THEN ;.
83d0: 3a 20 72 65 61 64 2d 70 6b 65 79 2d 6c 6f 6f 70 : read-pkey-loop
83e0: 20 28 20 2d 2d 20 29 0a 20 20 20 20 6c 61 73 74 ( -- ). last
83f0: 6b 65 79 40 20 64 72 6f 70 20 64 65 66 61 75 6c key@ drop defaul
8400: 74 6b 65 79 20 21 20 5c 20 61 74 20 6c 65 61 73 tkey ! \ at leas
8410: 74 20 6f 6e 65 20 64 65 66 61 75 6c 74 20 6b 65 t one default ke
8420: 79 20 61 76 61 69 6c 61 62 6c 65 0a 20 20 20 20 y available.
8430: 74 72 75 65 20 75 73 65 72 27 20 6e 6f 2d 65 64 true user' no-ed
8440: 2d 63 68 65 63 6b 3f 20 75 70 40 20 2b 0a 20 20 -check? up@ +.
8450: 20 20 5b 3a 20 2d 31 20 63 6f 6e 66 69 67 3a 70 [: -1 config:p
8460: 77 2d 6c 65 76 65 6c 23 0a 09 5b 3a 20 69 6d 70 w-level#..[: imp
8470: 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 ort#new import-t
8480: 79 70 65 20 21 20 20 3f 6b 65 79 2d 70 66 64 20 ype ! ?key-pfd
8490: 72 65 61 64 2d 6b 65 79 73 2d 6c 6f 6f 70 0a 09 read-keys-loop..
84a0: 20 20 20 20 73 61 76 65 2d 6b 65 79 73 2d 61 67 save-keys-ag
84b0: 61 69 6e 20 40 20 49 46 20 20 73 61 76 65 2d 6b ain @ IF save-k
84c0: 65 79 73 20 20 54 48 45 4e 20 3b 5d 20 21 77 72 eys THEN ;] !wr
84d0: 61 70 70 65 72 20 3b 5d 20 21 77 72 61 70 70 65 apper ;] !wrappe
84e0: 72 20 3b 0a 0a 3a 20 72 65 61 64 2d 6b 65 79 73 r ;..: read-keys
84f0: 20 28 20 2d 2d 20 29 0a 20 20 20 20 72 65 61 64 ( -- ). read
8500: 2d 6b 65 79 2d 6c 6f 6f 70 20 72 65 61 64 2d 70 -key-loop read-p
8510: 6b 65 79 2d 6c 6f 6f 70 20 69 6d 70 6f 72 74 23 key-loop import#
8520: 6e 65 77 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 new import-type
8530: 21 20 3b 0a 0a 3a 20 72 65 61 64 2d 70 6b 32 6b ! ;..: read-pk2k
8540: 65 79 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20 ey$ ( addr u --
8550: 29 0a 20 20 20 20 5c 67 20 72 65 61 64 20 61 20 ). \g read a
8560: 6e 65 73 74 65 64 20 6b 65 79 20 69 6e 74 6f 20 nested key into
8570: 73 61 6d 70 6c 65 2d 6b 65 79 0a 20 20 20 20 73 sample-key. s
8580: 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 63 2d 73 ample-key >o c-s
8590: 74 61 74 65 20 6f 66 66 20 20 73 69 6d 2d 6e 69 tate off sim-ni
85a0: 63 6b 21 20 6f 6e 0a 20 20 20 20 70 6b 32 2d 73 ck! on. pk2-s
85b0: 69 67 3f 20 21 21 73 69 67 21 21 20 73 69 67 70 ig? !!sig!! sigp
85c0: 6b 32 73 69 7a 65 23 20 2d 20 32 64 75 70 20 2b k2size# - 2dup +
85d0: 20 3e 72 20 64 6f 2d 6e 65 73 74 73 69 67 0a 20 >r do-nestsig.
85e0: 20 20 20 72 40 20 6b 65 79 73 69 7a 65 32 20 6b r@ keysize2 k
85f0: 65 2d 70 6b 20 24 21 0a 20 20 20 20 72 3e 20 6b e-pk $!. r> k
8600: 65 79 73 69 7a 65 32 20 2b 20 73 69 67 73 69 7a eysize2 + sigsiz
8610: 65 23 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 21 e# ke-selfsig $!
8620: 0a 20 20 20 20 6f 3e 20 20 73 69 6d 2d 6e 69 63 . o> sim-nic
8630: 6b 21 20 6f 66 66 20 3b 0a 0a 3a 20 2e 70 6b 32 k! off ;..: .pk2
8640: 6b 65 79 24 20 28 20 61 64 64 72 20 75 20 2d 2d key$ ( addr u --
8650: 20 29 0a 20 20 20 20 72 65 61 64 2d 70 6b 32 6b ). read-pk2k
8660: 65 79 24 20 73 61 6d 70 6c 65 2d 6b 65 79 20 3e ey$ sample-key >
8670: 6f 0a 20 20 20 20 5b 20 31 20 69 6d 70 6f 72 74 o. [ 1 import
8680: 23 69 6e 76 69 74 65 64 20 6c 73 68 69 66 74 20 #invited lshift
8690: 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 1 import#new lsh
86a0: 69 66 74 20 6f 72 20 5d 4c 20 6b 65 2d 69 6d 70 ift or ]L ke-imp
86b0: 6f 72 74 73 20 21 0a 20 20 20 20 2e 6b 65 79 2d orts !. .key-
86c0: 69 6e 76 69 74 65 20 66 72 65 65 2d 6b 65 79 20 invite free-key
86d0: 6f 3e 20 3b 0a 0a 5c 20 73 65 6c 65 63 74 20 6b o> ;..\ select k
86e0: 65 79 20 62 79 20 6e 69 63 6b 0a 0a 46 6f 72 77 ey by nick..Forw
86f0: 61 72 64 20 21 6d 79 2d 61 64 64 72 24 0a 0a 3a ard !my-addr$..:
8700: 20 72 61 77 2d 6b 65 79 21 20 28 20 6f 3a 6b 65 raw-key! ( o:ke
8710: 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 73 6b y -- ). ke-sk
8720: 73 69 67 20 40 20 30 3d 20 49 46 20 20 73 6b 73 sig @ 0= IF sks
8730: 69 67 21 20 20 54 48 45 4e 0a 20 20 20 20 6b 65 ig! THEN. ke
8740: 2d 70 6b 20 24 40 20 70 6b 63 20 70 6b 72 6b 23 -pk $@ pkc pkrk#
8750: 20 73 6d 6f 76 65 0a 20 20 20 20 6b 65 2d 73 6b smove. ke-sk
8760: 20 73 65 63 40 20 73 6b 63 20 73 77 61 70 20 6b sec@ skc swap k
8770: 65 79 7c 20 6d 6f 76 65 0a 20 20 20 20 6b 65 2d ey| move. ke-
8780: 73 6b 73 69 67 20 73 65 63 40 20 73 6b 73 69 67 sksig sec@ sksig
8790: 20 6b 65 79 73 69 7a 65 20 73 6d 6f 76 65 20 3b keysize smove ;
87a0: 0a 0a 3a 20 3e 72 61 77 2d 6b 65 79 20 28 20 6f ..: >raw-key ( o
87b0: 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 30 3d -- ). dup 0=
87c0: 20 21 21 6e 6f 2d 6e 69 63 6b 21 21 20 64 75 70 !!no-nick!! dup
87d0: 20 74 6f 20 6d 79 2d 6b 65 79 2d 64 65 66 61 75 to my-key-defau
87e0: 6c 74 20 2e 72 61 77 2d 6b 65 79 21 20 20 21 6d lt .raw-key! !m
87f0: 79 2d 61 64 64 72 24 20 3b 0a 0a 3a 20 3e 6b 65 y-addr$ ;..: >ke
8800: 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a y ( addr u -- ).
8810: 20 20 20 20 6b 65 79 23 20 40 20 30 3d 20 49 46 key# @ 0= IF
8820: 20 20 72 65 61 64 2d 6b 65 79 73 20 20 54 48 45 read-keys THE
8830: 4e 0a 20 20 20 20 6e 69 63 6b 2d 6b 65 79 20 3e N. nick-key >
8840: 72 61 77 2d 6b 65 79 20 3b 0a 0a 3a 20 69 27 6d raw-key ;..: i'm
8850: 20 28 20 22 6e 61 6d 65 22 20 2d 2d 20 29 20 70 ( "name" -- ) p
8860: 61 72 73 65 2d 6e 61 6d 65 20 3e 6b 65 79 20 3b arse-name >key ;
8870: 0a 3a 20 70 6b 27 20 28 20 22 6e 61 6d 65 22 20 .: pk' ( "name"
8880: 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 -- addr u ).
8890: 70 61 72 73 65 2d 6e 61 6d 65 20 6e 69 63 6b 3e parse-name nick>
88a0: 70 6b 20 3b 0a 0a 3a 20 64 65 73 74 2d 6b 65 79 pk ;..: dest-key
88b0: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 64 ( addr u -- ) d
88c0: 75 70 20 30 3d 20 49 46 20 20 32 64 72 6f 70 20 up 0= IF 2drop
88d0: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 EXIT THEN.
88e0: 6e 69 63 6b 2d 6b 65 79 20 3e 6f 20 6f 20 30 3d nick-key >o o 0=
88f0: 20 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21 !!unknown-key!!
8900: 0a 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 6f 3e . ke-pk $@ o>
8910: 0a 20 20 20 20 70 75 62 6b 65 79 20 24 21 20 3b . pubkey $! ;
8920: 0a 0a 3a 20 64 65 73 74 2d 70 6b 20 28 20 61 64 ..: dest-pk ( ad
8930: 64 72 20 75 20 2d 2d 20 29 20 6b 65 79 32 7c 20 dr u -- ) key2|
8940: 32 64 75 70 20 6b 65 79 7c 20 6b 65 79 23 20 23 2dup key| key# #
8950: 40 20 30 3d 20 49 46 0a 09 64 72 6f 70 20 20 70 @ 0= IF..drop p
8960: 65 72 6d 25 75 6e 6b 6e 6f 77 6e 0a 20 20 20 20 erm%unknown.
8970: 45 4c 53 45 20 20 63 65 6c 6c 2b 20 3e 6f 20 32 ELSE cell+ >o 2
8980: 64 72 6f 70 0a 09 6b 65 2d 70 6b 20 24 40 20 6b drop..ke-pk $@ k
8990: 65 2d 6d 61 73 6b 20 40 20 6f 3e 20 20 54 48 45 e-mask @ o> THE
89a0: 4e 0a 20 20 20 20 70 65 72 6d 2d 6d 61 73 6b 20 N. perm-mask
89b0: 21 20 70 75 62 6b 65 79 20 24 21 20 3b 0a 0a 3a ! pubkey $! ;..:
89c0: 20 72 65 70 6c 61 63 65 2d 6b 65 79 20 31 20 2f replace-key 1 /
89d0: 73 74 72 69 6e 67 20 7b 20 72 65 76 2d 61 64 64 string { rev-add
89e0: 72 20 75 20 2d 2d 20 6f 20 7d 20 5c 20 72 65 76 r u -- o } \ rev
89f0: 6f 63 61 74 69 6f 6e 20 74 69 63 6b 65 74 0a 20 ocation ticket.
8a00: 20 20 20 6b 65 79 28 20 2e 22 20 52 65 70 6c 61 key( ." Repla
8a10: 63 65 3a 22 20 63 72 20 2e 6b 65 79 20 29 0a 20 ce:" cr .key ).
8a20: 20 20 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 69 import#self i
8a30: 6d 70 6f 72 74 2d 74 79 70 65 20 21 0a 20 20 20 mport-type !.
8a40: 20 73 22 20 23 72 65 76 6f 6b 65 64 22 20 64 75 s" #revoked" du
8a50: 70 20 3e 72 20 6b 65 2d 6e 69 63 6b 20 24 2b 21 p >r ke-nick $+!
8a60: 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 24 40 20 . ke-nick $@
8a70: 72 3e 20 2d 20 6b 65 2d 70 72 6f 66 20 24 40 20 r> - ke-prof $@
8a80: 6b 65 2d 73 69 67 73 5b 5d 20 6b 65 2d 74 79 70 ke-sigs[] ke-typ
8a90: 65 20 40 0a 20 20 20 20 72 65 76 2d 61 64 64 72 e @. rev-addr
8aa0: 20 70 6b 72 6b 23 20 6b 65 79 3f 6e 65 77 20 3e pkrk# key?new >
8ab0: 6f 0a 20 20 20 20 6b 65 2d 74 79 70 65 20 21 20 o. ke-type !
8ac0: 5b 3a 20 6b 65 2d 73 69 67 73 5b 5d 20 24 2b 5b [: ke-sigs[] $+[
8ad0: 5d 21 20 3b 5d 20 24 5b 5d 6d 61 70 20 6b 65 2d ]! ;] $[]map ke-
8ae0: 70 72 6f 66 20 24 21 20 6b 65 2d 6e 69 63 6b 20 prof $! ke-nick
8af0: 24 21 0a 20 20 20 20 72 65 76 2d 61 64 64 72 20 $!. rev-addr
8b00: 70 6b 72 6b 23 20 6b 65 2d 70 6b 20 24 21 0a 20 pkrk# ke-pk $!.
8b10: 20 20 20 72 65 76 2d 61 64 64 72 20 75 20 2b 20 rev-addr u +
8b20: 31 2d 20 64 75 70 20 63 40 20 32 2a 20 2d 20 24 1- dup c@ 2* - $
8b30: 31 30 20 2d 20 24 31 30 20 6b 65 2d 73 65 6c 66 10 - $10 ke-self
8b40: 73 69 67 20 24 21 0a 20 20 20 20 6b 65 79 28 20 sig $!. key(
8b50: 2e 22 20 77 69 74 68 3a 22 20 63 72 20 2e 6b 65 ." with:" cr .ke
8b60: 79 20 29 20 6f 20 6f 3e 0a 20 20 20 20 69 6d 70 y ) o o>. imp
8b70: 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 ort#new import-t
8b80: 79 70 65 20 21 20 3b 0a 0a 3a 20 72 65 6e 65 77 ype ! ;..: renew
8b90: 2d 6b 65 79 20 28 20 72 65 76 61 64 64 72 20 75 -key ( revaddr u
8ba0: 31 20 6b 65 79 61 64 64 72 20 75 32 20 2d 2d 20 1 keyaddr u2 --
8bb0: 6f 20 29 0a 20 20 20 20 63 75 72 72 65 6e 74 2d o ). current-
8bc0: 6b 65 79 20 3e 6f 20 72 65 70 6c 61 63 65 2d 6b key >o replace-k
8bd0: 65 79 20 6f 3e 0a 20 20 20 20 3e 6f 20 73 6b 63 ey o>. >o skc
8be0: 20 6b 65 79 73 69 7a 65 20 6b 65 2d 73 6b 20 73 keysize ke-sk s
8bf0: 65 63 21 20 6f 20 6f 3e 20 3b 0a 0a 5c 20 67 65 ec! o o> ;..\ ge
8c00: 6e 65 72 61 74 65 20 6e 65 77 20 6b 65 79 0a 0a nerate new key..
8c10: 3a 20 6f 75 74 2d 6b 65 79 20 28 20 6f 20 2d 2d : out-key ( o --
8c20: 20 29 0a 20 20 20 20 3e 6f 20 70 61 63 6b 2d 6f ). >o pack-o
8c30: 75 74 6b 65 79 20 5b 27 5d 20 2e 6e 69 63 6b 2d utkey ['] .nick-
8c40: 62 61 73 65 20 24 74 6d 70 20 66 6e 2d 73 61 6e base $tmp fn-san
8c50: 69 74 69 7a 65 20 6f 3e 0a 20 20 20 20 5b 3a 20 itize o>. [:
8c60: 2e 22 20 7e 2f 22 20 74 79 70 65 20 2e 22 20 2e ." ~/" type ." .
8c70: 6e 32 6f 22 20 3b 5d 20 24 74 6d 70 20 77 2f 6f n2o" ;] $tmp w/o
8c80: 20 63 72 65 61 74 65 2d 66 69 6c 65 20 74 68 72 create-file thr
8c90: 6f 77 0a 20 20 20 20 3e 72 20 63 6d 64 62 75 66 ow. >r cmdbuf
8ca0: 24 20 72 40 20 77 72 69 74 65 2d 66 69 6c 65 20 $ r@ write-file
8cb0: 74 68 72 6f 77 20 72 3e 20 63 6c 6f 73 65 2d 66 throw r> close-f
8cc0: 69 6c 65 20 74 68 72 6f 77 20 3b 0a 3a 20 6f 75 ile throw ;.: ou
8cd0: 74 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 t-me ( -- ).
8ce0: 70 6b 40 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 pk@ key| key# #@
8cf0: 20 30 3d 20 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 0= !!unknown-ke
8d00: 79 21 21 20 5c 20 77 65 6c 6c 2c 20 79 6f 75 20 y!! \ well, you
8d10: 73 68 6f 75 6c 64 20 6b 6e 6f 77 20 79 6f 75 72 should know your
8d20: 73 65 6c 66 0a 20 20 20 20 63 65 6c 6c 2b 20 6f self. cell+ o
8d30: 75 74 2d 6b 65 79 20 3b 0a 0a 24 56 61 72 69 61 ut-key ;..$Varia
8d40: 62 6c 65 20 64 68 74 72 6f 6f 74 2e 6e 32 6f 0a ble dhtroot.n2o.
8d50: 0a 3a 20 2b 64 68 74 72 6f 6f 74 20 28 20 2d 2d .: +dhtroot ( --
8d60: 20 29 0a 20 20 20 20 64 65 66 61 75 6c 74 6b 65 ). defaultke
8d70: 79 20 40 20 3e 73 74 6f 72 65 6b 65 79 20 21 0a y @ >storekey !.
8d80: 20 20 20 20 69 6d 70 6f 72 74 23 6d 61 6e 75 61 import#manua
8d90: 6c 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 l import-type !
8da0: 20 36 34 23 2d 31 20 6b 65 79 2d 72 65 61 64 2d 64#-1 key-read-
8db0: 6f 66 66 73 65 74 20 36 34 21 0a 20 20 20 20 64 offset 64!. d
8dc0: 68 74 72 6f 6f 74 2e 6e 32 6f 20 24 40 20 64 6f htroot.n2o $@ do
8dd0: 2d 6b 65 79 0a 20 20 20 20 6c 61 73 74 2d 6b 65 -key. last-ke
8de0: 79 20 3e 6f 20 22 5c 78 30 32 22 20 6b 65 2d 67 y >o "\x02" ke-g
8df0: 72 6f 75 70 73 20 24 21 20 70 65 72 6d 25 64 68 roups $! perm%dh
8e00: 74 72 6f 6f 74 20 6b 65 2d 6d 61 73 6b 20 21 20 troot ke-mask !
8e10: 6f 3e 0a 20 20 20 20 69 6d 70 6f 72 74 23 6e 65 o>. import#ne
8e20: 77 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 w import-type !
8e30: 3b 0a 0a 3a 20 6e 65 77 2d 6b 65 79 2c 20 28 20 ;..: new-key, (
8e40: 6e 69 63 6b 61 64 64 72 20 75 20 2d 2d 20 29 0a nickaddr u -- ).
8e50: 20 20 20 20 3f 63 68 65 63 6b 2d 72 6e 67 20 5c ?check-rng \
8e60: 20 62 65 66 6f 72 65 20 67 65 6e 65 72 61 74 69 before generati
8e70: 6e 67 20 61 20 6b 65 79 2c 20 63 68 65 63 6b 20 ng a key, check
8e80: 74 68 65 20 72 6e 67 20 66 6f 72 20 68 65 61 6c the rng for heal
8e90: 74 68 0a 20 20 20 20 6b 65 79 3e 64 65 66 61 75 th. key>defau
8ea0: 6c 74 0a 20 20 20 20 6b 65 79 23 75 73 65 72 20 lt. key#user
8eb0: 2b 67 65 6e 2d 6b 65 79 73 0a 20 20 20 20 73 65 +gen-keys. se
8ec0: 63 72 65 74 2d 6b 65 79 73 23 20 31 2d 20 73 65 cret-keys# 1- se
8ed0: 63 72 65 74 2d 6b 65 79 20 3e 72 61 77 2d 6b 65 cret-key >raw-ke
8ee0: 79 20 20 6c 61 73 74 6b 65 79 40 20 64 72 6f 70 y lastkey@ drop
8ef0: 20 64 65 66 61 75 6c 74 6b 65 79 20 21 0a 20 20 defaultkey !.
8f00: 20 20 6f 75 74 2d 6d 65 20 2b 64 68 74 72 6f 6f out-me +dhtroo
8f10: 74 20 73 61 76 65 2d 6b 65 79 73 20 3b 0a 0a 3a t save-keys ;..:
8f20: 20 6e 65 77 2d 6b 65 79 20 28 20 6e 69 63 6b 61 new-key ( nicka
8f30: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 2b ddr u -- ). +
8f40: 6e 65 77 70 68 72 61 73 65 20 6e 65 77 2d 6b 65 newphrase new-ke
8f50: 79 2c 20 3b 0a 0a 5c 20 72 65 76 6f 6b 61 74 69 y, ;..\ revokati
8f60: 6f 6e 0a 0a 34 20 64 61 74 65 73 69 7a 65 23 20 on..4 datesize#
8f70: 2b 20 6b 65 79 73 69 7a 65 20 39 20 2a 20 2b 20 + keysize 9 * +
8f80: 43 6f 6e 73 74 61 6e 74 20 72 65 76 73 69 7a 65 Constant revsize
8f90: 23 0a 0a 56 61 72 69 61 62 6c 65 20 72 65 76 74 #..Variable revt
8fa0: 6f 6b 65 6e 0a 0a 3a 20 30 6f 6c 64 6b 65 79 20 oken..: 0oldkey
8fb0: 28 20 2d 2d 20 29 20 5c 20 70 75 62 6b 65 79 73 ( -- ) \ pubkeys
8fc0: 20 63 61 6e 20 73 74 61 79 0a 20 20 20 20 6f 6c can stay. ol
8fd0: 64 73 6b 63 20 6b 65 79 73 69 7a 65 20 65 72 61 dskc keysize era
8fe0: 73 65 20 20 6f 6c 64 73 6b 72 65 76 20 6b 65 79 se oldskrev key
8ff0: 73 69 7a 65 20 65 72 61 73 65 20 3b 0a 0a 3a 20 size erase ;..:
9000: 6b 65 79 6d 6f 76 65 20 28 20 61 64 64 72 31 20 keymove ( addr1
9010: 61 64 64 72 32 20 2d 2d 20 29 20 20 6b 65 79 73 addr2 -- ) keys
9020: 69 7a 65 20 6d 6f 76 65 20 3b 0a 0a 3a 20 72 65 ize move ;..: re
9030: 76 6f 6b 65 2d 76 65 72 69 66 79 20 28 20 61 64 voke-verify ( ad
9040: 64 72 20 75 31 20 70 6b 20 73 74 72 69 6e 67 20 dr u1 pk string
9050: 75 32 20 2d 2d 20 61 64 64 72 20 75 20 66 6c 61 u2 -- addr u fla
9060: 67 20 29 20 72 6f 74 20 3e 72 20 32 3e 72 20 63 g ) rot >r 2>r c
9070: 3a 30 6b 65 79 0a 20 20 20 20 73 69 67 6f 6e 6c :0key. sigonl
9080: 79 73 69 7a 65 23 20 2d 20 32 64 75 70 20 32 72 ysize# - 2dup 2r
9090: 3e 20 3e 6b 65 79 65 64 2d 68 61 73 68 0a 20 20 > >keyed-hash.
90a0: 20 20 73 69 67 64 61 74 65 20 2b 64 61 74 65 0a sigdate +date.
90b0: 20 20 20 20 32 64 75 70 20 2b 20 72 3e 20 65 64 2dup + r> ed
90c0: 2d 76 65 72 69 66 79 20 3b 0a 0a 3a 20 3e 72 65 -verify ;..: >re
90d0: 76 6f 6b 65 20 28 20 73 6b 72 65 76 20 2d 2d 20 voke ( skrev --
90e0: 29 20 20 73 6b 72 65 76 20 6b 65 79 6d 6f 76 65 ) skrev keymove
90f0: 20 20 70 6b 63 20 63 68 65 63 6b 2d 72 65 76 3f pkc check-rev?
9100: 20 30 3d 20 21 21 6e 6f 74 2d 6d 79 2d 72 65 76 0= !!not-my-rev
9110: 73 6b 21 21 20 3b 0a 0a 3a 20 2b 72 65 76 73 69 sk!! ;..: +revsi
9120: 67 6e 20 28 20 73 6b 20 70 6b 20 2d 2d 20 29 20 gn ( sk pk -- )
9130: 20 73 6b 73 69 67 20 2d 72 6f 74 20 65 64 2d 73 sksig -rot ed-s
9140: 69 67 6e 20 72 65 76 74 6f 6b 65 6e 20 24 2b 21 ign revtoken $+!
9150: 20 62 6c 20 72 65 76 74 6f 6b 65 6e 20 63 24 2b bl revtoken c$+
9160: 21 20 3b 0a 0a 3a 20 73 69 67 6e 2d 74 6f 6b 65 ! ;..: sign-toke
9170: 6e 2c 20 28 20 73 6b 20 70 6b 20 73 74 72 69 6e n, ( sk pk strin
9180: 67 20 75 32 20 2d 2d 20 29 0a 20 20 20 20 63 3a g u2 -- ). c:
9190: 30 6b 65 79 20 72 65 76 74 6f 6b 65 6e 20 24 40 0key revtoken $@
91a0: 20 32 73 77 61 70 20 3e 6b 65 79 65 64 2d 68 61 2swap >keyed-ha
91b0: 73 68 0a 20 20 20 20 73 69 67 64 61 74 65 20 2b sh. sigdate +
91c0: 64 61 74 65 20 2b 72 65 76 73 69 67 6e 20 3b 0a date +revsign ;.
91d0: 0a 3a 20 72 65 76 6f 6b 65 2d 6b 65 79 20 28 20 .: revoke-key (
91e0: 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 -- addr u ).
91f0: 73 6b 63 20 6f 6c 64 73 6b 63 20 6b 65 79 6d 6f skc oldskc keymo
9200: 76 65 20 20 70 6b 63 20 6f 6c 64 70 6b 63 20 6b ve pkc oldpkc k
9210: 65 79 6d 6f 76 65 20 20 73 6b 72 65 76 20 6f 6c eymove skrev ol
9220: 64 73 6b 72 65 76 20 6b 65 79 6d 6f 76 65 0a 20 dskrev keymove.
9230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9250: 20 20 20 20 20 20 20 20 20 20 5c 20 62 61 63 6b \ back
9260: 75 70 20 6b 65 79 73 0a 20 20 20 20 6f 6c 64 73 up keys. olds
9270: 6b 72 65 76 20 6f 6c 64 70 6b 72 65 76 20 73 6b krev oldpkrev sk
9280: 3e 70 6b 20 20 20 20 20 20 20 20 20 20 20 20 20 >pk
9290: 20 20 20 5c 20 67 65 6e 65 72 61 74 65 20 72 65 \ generate re
92a0: 76 6f 6b 61 74 69 6f 6e 20 70 75 62 6b 65 79 0a vokation pubkey.
92b0: 20 20 20 20 67 65 6e 2d 6b 65 79 73 20 20 20 20 gen-keys
92c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92d0: 20 20 20 20 20 20 20 20 20 20 20 5c 20 67 65 6e \ gen
92e0: 65 72 61 74 65 20 6e 65 77 20 6b 65 79 73 0a 20 erate new keys.
92f0: 20 20 20 70 6b 63 20 6b 65 79 73 69 7a 65 32 20 pkc keysize2
9300: 72 65 76 74 6f 6b 65 6e 20 24 21 20 20 20 20 20 revtoken $!
9310: 20 20 20 20 20 20 20 20 20 20 5c 20 6d 79 20 6e \ my n
9320: 65 77 20 6b 65 79 0a 20 20 20 20 6f 6c 64 70 6b ew key. oldpk
9330: 72 65 76 20 6b 65 79 73 69 7a 65 20 72 65 76 74 rev keysize revt
9340: 6f 6b 65 6e 20 24 2b 21 20 20 20 20 20 20 20 20 oken $+!
9350: 20 20 5c 20 72 65 76 6f 6b 65 20 74 6f 6b 65 6e \ revoke token
9360: 0a 20 20 20 20 6f 6c 64 73 6b 72 65 76 20 6f 6c . oldskrev ol
9370: 64 70 6b 72 65 76 20 22 72 65 76 6f 6b 65 22 20 dpkrev "revoke"
9380: 73 69 67 6e 2d 74 6f 6b 65 6e 2c 20 5c 20 72 65 sign-token, \ re
9390: 76 6f 6b 65 20 73 69 67 6e 61 74 75 72 65 0a 20 voke signature.
93a0: 20 20 20 73 6b 63 20 70 6b 63 20 22 73 65 6c 66 skc pkc "self
93b0: 73 69 67 6e 22 20 73 69 67 6e 2d 74 6f 6b 65 6e sign" sign-token
93c0: 2c 20 20 20 20 20 20 20 20 20 5c 20 73 65 6c 66 , \ self
93d0: 20 73 69 67 6e 65 64 20 77 69 74 68 20 6e 65 77 signed with new
93e0: 20 6b 65 79 0a 20 20 20 20 22 21 22 20 72 65 76 key. "!" rev
93f0: 74 6f 6b 65 6e 20 30 20 24 69 6e 73 20 20 20 20 token 0 $ins
9400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9410: 5c 20 22 21 22 20 2b 20 6f 6c 64 6b 65 79 6c 65 \ "!" + oldkeyle
9420: 6e 2b 6e 65 77 6b 65 79 6c 65 6e 20 74 6f 20 66 n+newkeylen to f
9430: 6c 61 67 20 72 65 76 6f 6b 61 74 69 6f 6e 0a 20 lag revokation.
9440: 20 20 20 72 65 76 74 6f 6b 65 6e 20 24 40 20 67 revtoken $@ g
9450: 65 6e 3e 68 6f 73 74 20 32 64 72 6f 70 20 20 20 en>host 2drop
9460: 20 20 20 20 20 20 20 20 20 20 5c 20 73 69 67 6e \ sign
9470: 20 68 6f 73 74 20 69 6e 66 6f 72 6d 61 74 69 6f host informatio
9480: 6e 20 77 69 74 68 20 6f 6c 64 20 6b 65 79 0a 20 n with old key.
9490: 20 20 20 73 69 67 64 61 74 65 20 2b 64 61 74 65 sigdate +date
94a0: 20 73 69 67 64 61 74 65 20 64 61 74 65 73 69 7a sigdate datesiz
94b0: 65 23 20 72 65 76 74 6f 6b 65 6e 20 24 2b 21 0a e# revtoken $+!.
94c0: 20 20 20 20 6f 6c 64 73 6b 63 20 6f 6c 64 70 6b oldskc oldpk
94d0: 63 20 2b 72 65 76 73 69 67 6e 0a 20 20 20 20 30 c +revsign. 0
94e0: 6f 6c 64 6b 65 79 20 72 65 76 74 6f 6b 65 6e 20 oldkey revtoken
94f0: 24 40 20 3b 0a 0a 5c 20 69 6e 76 69 74 61 74 69 $@ ;..\ invitati
9500: 6f 6e 0a 0a 56 61 72 69 61 62 6c 65 20 69 6e 76 on..Variable inv
9510: 69 74 61 74 69 6f 6e 73 0a 0a 44 65 66 65 72 20 itations..Defer
9520: 64 6f 2d 69 6e 76 69 74 65 0a 3a 6e 6f 6e 61 6d do-invite.:nonam
9530: 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a e ( addr u -- ).
9540: 20 20 20 20 2e 22 20 69 6e 76 69 74 65 20 6d 65 ." invite me
9550: 3a 20 22 20 6f 76 65 72 20 3e 72 20 2e 70 6b 32 : " over >r .pk2
9560: 6b 65 79 24 20 63 72 20 72 3e 20 66 72 65 65 20 key$ cr r> free
9570: 74 68 72 6f 77 20 63 74 72 6c 20 4c 20 69 6e 73 throw ctrl L ins
9580: 6b 65 79 20 3b 0a 69 73 20 64 6f 2d 69 6e 76 69 key ;.is do-invi
9590: 74 65 0a 0a 65 76 65 6e 74 3a 20 3a 3e 69 6e 76 te..event: :>inv
95a0: 69 74 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 ite ( addr u --
95b0: 29 20 64 6f 2d 69 6e 76 69 74 65 20 3b 0a 0a 3a ) do-invite ;..:
95c0: 20 70 6b 32 6b 65 79 24 2d 61 64 64 20 28 20 61 pk2key$-add ( a
95d0: 64 64 72 20 75 20 70 65 72 6d 20 2d 2d 20 29 20 ddr u perm -- )
95e0: 7b 20 70 65 72 6d 20 7d 0a 20 20 20 20 73 61 6d { perm }. sam
95f0: 70 6c 65 2d 6b 65 79 20 3e 6f 20 69 6d 70 6f 72 ple-key >o impor
9600: 74 23 69 6e 76 69 74 65 64 20 69 6d 70 6f 72 74 t#invited import
9610: 2d 74 79 70 65 20 21 20 63 6d 64 3a 6e 65 73 74 -type ! cmd:nest
9620: 73 69 67 0a 20 20 20 20 70 65 72 6d 20 6b 65 2d sig. perm ke-
9630: 6d 61 73 6b 20 21 0a 20 20 20 20 69 6d 70 6f 72 mask !. impor
9640: 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 79 70 t#new import-typ
9650: 65 20 21 20 20 73 61 76 65 2d 70 75 62 6b 65 79 e ! save-pubkey
9660: 73 20 6f 3e 20 3b 0a 0a 3a 20 78 2d 65 72 61 73 s o> ;..: x-eras
9670: 65 20 28 20 6c 65 6e 20 2d 2d 20 29 20 20 65 64 e ( len -- ) ed
9680: 69 74 2d 63 75 72 70 6f 73 20 21 0a 20 20 20 20 it-curpos !.
9690: 78 65 64 69 74 2d 73 74 61 72 74 70 6f 73 20 20 xedit-startpos
96a0: 65 64 69 74 2d 63 75 72 70 6f 73 20 40 20 73 70 edit-curpos @ sp
96b0: 61 63 65 73 20 20 78 65 64 69 74 2d 73 74 61 72 aces xedit-star
96c0: 74 70 6f 73 20 3b 0a 0a 3a 20 69 6e 76 69 74 65 tpos ;..: invite
96d0: 2d 6b 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d -key ( addr u --
96e0: 20 6b 65 79 20 29 0a 20 20 20 20 32 64 75 70 20 key ). 2dup
96f0: 78 2d 77 69 64 74 68 20 7b 20 61 64 64 72 20 75 x-width { addr u
9700: 20 6c 65 6e 20 7d 0a 20 20 20 20 42 45 47 49 4e len }. BEGIN
9710: 20 20 61 64 64 72 20 75 20 74 79 70 65 20 6b 65 addr u type ke
9720: 79 20 20 6c 65 6e 20 78 2d 65 72 61 73 65 0a 09 y len x-erase..
9730: 64 75 70 20 63 74 72 6c 20 5a 20 3d 0a 20 20 20 dup ctrl Z =.
9740: 20 57 48 49 4c 45 20 20 64 72 6f 70 20 20 42 45 WHILE drop BE
9750: 47 49 4e 20 20 6b 65 79 20 63 74 72 6c 20 4c 20 GIN key ctrl L
9760: 3d 20 20 55 4e 54 49 4c 20 20 52 45 50 45 41 54 = UNTIL REPEAT
9770: 20 3b 0a 0a 3a 20 70 72 6f 63 65 73 73 2d 69 6e ;..: process-in
9780: 76 69 74 61 74 69 6f 6e 20 28 20 61 64 64 72 20 vitation ( addr
9790: 75 20 2d 2d 20 29 0a 20 20 20 20 73 22 20 69 6e u -- ). s" in
97a0: 76 69 74 65 20 28 79 2f 6e 2f 62 29 3f 22 20 69 vite (y/n/b)?" i
97b0: 6e 76 69 74 65 2d 6b 65 79 0a 20 20 20 20 63 61 nvite-key. ca
97c0: 73 65 0a 09 27 79 27 20 6f 66 20 20 70 65 72 6d se..'y' of perm
97d0: 25 64 65 66 61 75 6c 74 20 70 6b 32 6b 65 79 24 %default pk2key$
97e0: 2d 61 64 64 20 20 2e 22 20 61 64 64 65 64 22 20 -add ." added"
97f0: 63 72 20 20 20 65 6e 64 6f 66 0a 09 27 62 27 20 cr endof..'b'
9800: 6f 66 20 20 70 65 72 6d 25 62 6c 6f 63 6b 65 64 of perm%blocked
9810: 20 70 6b 32 6b 65 79 24 2d 61 64 64 20 20 2e 22 pk2key$-add ."
9820: 20 62 6c 6f 63 6b 65 64 22 20 63 72 20 65 6e 64 blocked" cr end
9830: 6f 66 0a 09 32 64 72 6f 70 20 2e 22 20 69 67 6e of..2drop ." ign
9840: 6f 72 65 64 22 20 63 72 0a 20 20 20 20 65 6e 64 ored" cr. end
9850: 63 61 73 65 20 3b 0a 0a 3a 20 61 64 64 2d 69 6e case ;..: add-in
9860: 76 69 74 61 74 69 6f 6e 20 28 20 61 64 64 72 20 vitation ( addr
9870: 75 20 2d 2d 20 29 20 5c 20 61 64 64 20 69 6e 76 u -- ) \ add inv
9880: 69 74 61 74 69 6f 6e 20 77 69 74 68 6f 75 74 20 itation without
9890: 61 73 6b 69 6e 67 0a 20 20 20 20 70 65 72 6d 25 asking. perm%
98a0: 64 65 66 61 75 6c 74 20 70 6b 32 6b 65 79 24 2d default pk2key$-
98b0: 61 64 64 20 3b 0a 0a 3a 20 66 69 6c 74 65 72 2d add ;..: filter-
98c0: 69 6e 76 69 74 61 74 69 6f 6e 3f 20 28 20 61 64 invitation? ( ad
98d0: 64 72 20 75 20 2d 2d 20 66 6c 61 67 20 29 0a 20 dr u -- flag ).
98e0: 20 20 20 73 69 67 70 6b 32 73 69 7a 65 23 20 2d sigpk2size# -
98f0: 20 2b 20 6b 65 79 73 69 7a 65 20 6b 65 79 23 20 + keysize key#
9900: 23 40 20 64 30 3c 3e 20 3b 20 5c 20 61 6c 72 65 #@ d0<> ; \ alre
9910: 61 64 79 20 74 68 65 72 65 0a 0a 3a 20 2e 69 6e ady there..: .in
9920: 76 69 74 61 74 69 6f 6e 73 20 28 20 2d 2d 20 29 vitations ( -- )
9930: 0a 20 20 20 20 69 6e 76 69 74 61 74 69 6f 6e 73 . invitations
9940: 20 5b 3a 20 32 64 75 70 20 2e 70 6b 32 6b 65 79 [: 2dup .pk2key
9950: 24 20 63 72 20 70 72 6f 63 65 73 73 2d 69 6e 76 $ cr process-inv
9960: 69 74 61 74 69 6f 6e 20 3b 5d 20 24 5b 5d 6d 61 itation ;] $[]ma
9970: 70 0a 20 20 20 20 69 6e 76 69 74 61 74 69 6f 6e p. invitation
9980: 73 20 24 5b 5d 66 72 65 65 20 3b 0a 0a 3a 20 71 s $[]free ;..: q
9990: 75 65 75 65 2d 69 6e 76 69 74 61 74 69 6f 6e 20 ueue-invitation
99a0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 ( addr u -- ).
99b0: 20 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 24 5b invitations $[
99c0: 5d 23 20 3e 72 0a 20 20 20 20 32 64 75 70 20 69 ]# >r. 2dup i
99d0: 6e 76 69 74 61 74 69 6f 6e 73 20 24 69 6e 73 5b nvitations $ins[
99e0: 5d 73 69 67 20 64 72 6f 70 0a 20 20 20 20 69 6e ]sig drop. in
99f0: 76 69 74 61 74 69 6f 6e 73 20 24 5b 5d 23 20 72 vitations $[]# r
9a00: 3e 20 3c 3e 20 49 46 0a 09 73 61 76 65 2d 6d 65 > <> IF..save-me
9a10: 6d 20 6d 61 69 6e 2d 75 70 40 20 3c 68 69 64 65 m main-up@ <hide
9a20: 3e 0a 09 3c 65 76 65 6e 74 20 65 24 2c 20 3a 3e >..<event e$, :>
9a30: 69 6e 76 69 74 65 20 6d 61 69 6e 2d 75 70 40 20 invite main-up@
9a40: 65 76 65 6e 74 7c 0a 20 20 20 20 45 4c 53 45 20 event|. ELSE
9a50: 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 2drop THEN ;..
9a60: 66 6f 72 77 61 72 64 20 2e 73 69 67 71 72 0a 65 forward .sigqr.e
9a70: 76 65 6e 74 3a 20 3a 3e 73 68 6f 77 2d 6b 65 79 vent: :>show-key
9a80: 73 69 67 20 28 20 24 61 64 64 72 20 2d 2d 20 29 sig ( $addr -- )
9a90: 0a 20 20 20 20 7b 20 77 5e 20 70 6b 20 7d 20 6d . { w^ pk } m
9aa0: 73 67 28 20 2e 22 20 53 69 67 6e 20 69 6e 76 69 sg( ." Sign invi
9ab0: 74 61 74 69 6f 6e 20 51 52 22 20 66 6f 72 74 68 tation QR" forth
9ac0: 3a 63 72 20 29 0a 20 20 20 20 70 6b 20 24 40 20 :cr ). pk $@
9ad0: 32 64 75 70 20 66 69 6c 74 65 72 2d 69 6e 76 69 2dup filter-invi
9ae0: 74 61 74 69 6f 6e 3f 20 30 3d 20 49 46 0a 09 6d tation? 0= IF..m
9af0: 73 67 28 20 2e 22 20 41 64 64 20 69 6e 76 69 74 sg( ." Add invit
9b00: 61 74 69 6f 6e 20 22 20 32 64 75 70 20 38 35 74 ation " 2dup 85t
9b10: 79 70 65 20 66 6f 72 74 68 3a 63 72 20 29 0a 09 ype forth:cr )..
9b20: 32 64 75 70 20 61 64 64 2d 69 6e 76 69 74 61 74 2dup add-invitat
9b30: 69 6f 6e 20 20 54 48 45 4e 0a 20 20 20 20 2e 73 ion THEN. .s
9b40: 69 67 71 72 20 70 6b 20 24 66 72 65 65 20 3b 0a igqr pk $free ;.
9b50: 0a 3a 20 3e 69 6e 76 69 74 61 74 69 6f 6e 73 20 .: >invitations
9b60: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 ( addr u -- ).
9b70: 20 20 71 72 2d 63 72 79 70 74 3f 20 49 46 0a 09 qr-crypt? IF..
9b80: 6d 73 67 28 20 2e 22 20 51 52 20 69 6e 76 69 74 msg( ." QR invit
9b90: 61 74 69 6f 6e 20 77 69 74 68 20 73 69 67 6e 61 ation with signa
9ba0: 74 75 72 65 22 20 66 6f 72 74 68 3a 63 72 20 29 ture" forth:cr )
9bb0: 0a 09 3c 65 76 65 6e 74 20 24 6d 61 6b 65 20 65 ..<event $make e
9bc0: 6c 69 74 2c 20 3a 3e 73 68 6f 77 2d 6b 65 79 73 lit, :>show-keys
9bd0: 69 67 20 6d 61 69 6e 2d 75 70 40 20 65 76 65 6e ig main-up@ even
9be0: 74 3e 0a 20 20 20 20 45 4c 53 45 0a 09 32 64 75 t>. ELSE..2du
9bf0: 70 20 66 69 6c 74 65 72 2d 69 6e 76 69 74 61 74 p filter-invitat
9c00: 69 6f 6e 3f 20 49 46 20 20 32 64 72 6f 70 20 45 ion? IF 2drop E
9c10: 58 49 54 20 20 54 48 45 4e 0a 09 6d 73 67 28 20 XIT THEN..msg(
9c20: 2e 22 20 71 75 65 75 65 20 69 6e 76 69 74 61 74 ." queue invitat
9c30: 69 6f 6e 22 20 66 6f 72 74 68 3a 63 72 20 29 0a ion" forth:cr ).
9c40: 09 71 75 65 75 65 2d 69 6e 76 69 74 61 74 69 6f .queue-invitatio
9c50: 6e 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a 61 6c n. THEN ;..al
9c60: 73 6f 20 6e 65 74 32 6f 2d 62 61 73 65 0a 0a 3a so net2o-base..:
9c70: 20 69 6e 76 69 74 65 2d 6d 65 20 28 20 2d 2d 20 invite-me ( --
9c80: 29 0a 20 20 20 20 5b 3a 20 30 6b 65 79 2c 20 6e ). [: 0key, n
9c90: 65 73 74 5b 20 6d 79 70 6b 32 6e 69 63 6b 24 20 est[ mypk2nick$
9ca0: 24 2c 20 70 75 62 6b 65 79 20 24 40 20 6b 65 79 $, pubkey $@ key
9cb0: 7c 20 24 2c 20 69 6e 76 69 74 65 20 63 6f 6f 6b | $, invite cook
9cc0: 69 65 2b 72 65 71 75 65 73 74 0a 20 20 20 20 20 ie+request.
9cd0: 20 5d 74 6d 70 6e 65 73 74 20 65 6e 64 2d 63 6d ]tmpnest end-cm
9ce0: 64 20 3b 5d 20 69 73 20 65 78 70 65 63 74 2d 72 d ;] is expect-r
9cf0: 65 70 6c 79 3f 20 3b 0a 3a 20 71 72 2d 63 68 61 eply? ;.: qr-cha
9d00: 6c 6c 65 6e 67 65 2c 20 28 20 2d 2d 20 29 0a 20 llenge, ( -- ).
9d10: 20 20 20 24 31 30 20 72 6e 67 24 20 32 64 75 70 $10 rng$ 2dup
9d20: 20 24 2c 20 71 72 2d 6b 65 79 20 24 38 0a 20 20 $, qr-key $8.
9d30: 20 20 6d 73 67 28 20 2e 22 20 63 68 61 6c 6c 65 msg( ." challe
9d40: 6e 67 65 3a 20 22 20 32 6f 76 65 72 20 38 35 74 nge: " 2over 85t
9d50: 79 70 65 20 73 70 61 63 65 20 32 64 75 70 20 78 ype space 2dup x
9d60: 74 79 70 65 20 66 6f 72 74 68 3a 63 72 20 29 0a type forth:cr ).
9d70: 20 20 20 20 63 3a 30 6b 65 79 20 3e 6b 65 79 65 c:0key >keye
9d80: 64 2d 68 61 73 68 0a 20 20 20 20 71 72 2d 68 61 d-hash. qr-ha
9d90: 73 68 20 24 34 30 20 63 3a 68 61 73 68 40 20 71 sh $40 c:hash@ q
9da0: 72 2d 68 61 73 68 20 24 31 30 20 24 2c 20 71 72 r-hash $10 $, qr
9db0: 2d 63 68 61 6c 6c 65 6e 67 65 20 3b 0a 3a 20 71 -challenge ;.: q
9dc0: 72 2d 69 6e 76 69 74 65 2d 6d 65 20 28 20 2d 2d r-invite-me ( --
9dd0: 20 29 0a 20 20 20 20 5b 3a 20 30 6b 65 79 2c 20 ). [: 0key,
9de0: 6e 65 73 74 5b 20 71 72 2d 63 68 61 6c 6c 65 6e nest[ qr-challen
9df0: 67 65 2c 0a 20 20 20 20 20 20 6d 79 70 6b 32 6e ge,. mypk2n
9e00: 69 63 6b 24 20 24 2c 20 70 75 62 6b 65 79 20 24 ick$ $, pubkey $
9e10: 40 20 6b 65 79 7c 20 24 2c 20 69 6e 76 69 74 65 @ key| $, invite
9e20: 20 63 6f 6f 6b 69 65 2b 72 65 71 75 65 73 74 0a cookie+request.
9e30: 20 20 20 20 20 20 5d 74 6d 70 6e 65 73 74 20 65 ]tmpnest e
9e40: 6e 64 2d 63 6d 64 20 3b 5d 20 69 73 20 65 78 70 nd-cmd ;] is exp
9e50: 65 63 74 2d 72 65 70 6c 79 3f 20 3b 0a 3a 20 73 ect-reply? ;.: s
9e60: 65 6e 64 2d 69 6e 76 69 74 61 74 69 6f 6e 20 28 end-invitation (
9e70: 20 2d 2d 20 29 20 0a 20 20 20 20 73 65 74 75 70 -- ) . setup
9e80: 21 20 20 2b 72 65 73 65 6e 64 2d 63 6d 64 20 20 ! +resend-cmd
9e90: 67 65 6e 2d 74 6d 70 6b 65 79 73 0a 20 20 20 20 gen-tmpkeys.
9ea0: 5b 27 5d 20 63 6f 6e 6e 65 63 74 2d 72 65 73 74 ['] connect-rest
9eb0: 20 72 71 64 3f 0a 20 20 20 20 63 6d 64 28 20 69 rqd?. cmd( i
9ec0: 6e 64 2d 61 64 64 72 20 40 20 49 46 20 20 2e 22 nd-addr @ IF ."
9ed0: 20 69 6e 22 20 54 48 45 4e 20 2e 22 20 64 69 72 in" THEN ." dir
9ee0: 65 63 74 20 63 6f 6e 6e 65 63 74 22 20 66 6f 72 ect connect" for
9ef0: 74 68 3a 63 72 20 29 0a 20 20 20 20 69 76 73 28 th:cr ). ivs(
9f00: 20 2e 22 20 67 65 6e 20 72 65 71 75 65 73 74 22 ." gen request"
9f10: 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 20 forth:cr ).
9f20: 6e 65 74 32 6f 2d 63 6f 64 65 30 0a 20 20 20 20 net2o-code0.
9f30: 6e 65 74 32 6f 2d 76 65 72 73 69 6f 6e 20 24 2c net2o-version $,
9f40: 20 76 65 72 73 69 6f 6e 3f 20 20 30 6b 65 79 2c version? 0key,
9f50: 0a 20 20 20 20 6e 65 73 74 5b 20 63 6f 6f 6b 69 . nest[ cooki
9f60: 65 2c 20 5d 6e 65 73 74 0a 20 20 20 20 74 70 6b e, ]nest. tpk
9f70: 63 20 6b 65 79 73 69 7a 65 20 24 2c 20 72 65 63 c keysize $, rec
9f80: 65 69 76 65 2d 74 6d 70 6b 65 79 0a 20 20 20 20 eive-tmpkey.
9f90: 74 6d 70 6b 65 79 2d 72 65 71 75 65 73 74 20 74 tmpkey-request t
9fa0: 6d 70 2d 73 65 63 72 65 74 2c 0a 20 20 20 20 6e mp-secret,. n
9fb0: 65 73 74 5b 20 72 65 71 75 65 73 74 2d 69 6e 76 est[ request-inv
9fc0: 69 74 61 74 69 6f 6e 20 72 65 71 75 65 73 74 2c itation request,
9fd0: 20 5d 6e 65 73 74 0a 20 20 20 20 63 6c 6f 73 65 ]nest. close
9fe0: 2d 74 6d 70 6e 65 73 74 0a 20 20 20 20 5b 27 5d -tmpnest. [']
9ff0: 20 70 75 73 68 2d 63 6d 64 20 49 53 20 65 78 70 push-cmd IS exp
a000: 65 63 74 2d 72 65 70 6c 79 3f 0a 20 20 20 20 65 ect-reply?. e
a010: 6e 64 2d 63 6f 64 65 7c 0a 20 20 20 20 6e 65 74 nd-code|. net
a020: 32 6f 3a 64 69 73 70 6f 73 65 2d 63 6f 6e 74 65 2o:dispose-conte
a030: 78 74 20 3b 0a 3a 20 73 65 6e 64 2d 71 72 2d 69 xt ;.: send-qr-i
a040: 6e 76 69 74 61 74 69 6f 6e 20 28 20 2d 2d 20 73 nvitation ( -- s
a050: 75 63 63 65 73 73 2d 62 69 74 20 29 0a 20 20 20 uccess-bit ).
a060: 20 73 65 74 75 70 21 20 20 2b 72 65 73 65 6e 64 setup! +resend
a070: 2d 63 6d 64 20 20 67 65 6e 2d 74 6d 70 6b 65 79 -cmd gen-tmpkey
a080: 73 0a 20 20 20 20 5b 27 5d 20 63 6f 6e 6e 65 63 s. ['] connec
a090: 74 2d 72 65 73 74 20 72 71 64 3f 0a 20 20 20 20 t-rest rqd?.
a0a0: 63 6d 64 28 20 69 6e 64 2d 61 64 64 72 20 40 20 cmd( ind-addr @
a0b0: 49 46 20 20 2e 22 20 69 6e 22 20 54 48 45 4e 20 IF ." in" THEN
a0c0: 2e 22 20 64 69 72 65 63 74 20 63 6f 6e 6e 65 63 ." direct connec
a0d0: 74 22 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 20 t" forth:cr ).
a0e0: 20 20 69 76 73 28 20 2e 22 20 67 65 6e 20 72 65 ivs( ." gen re
a0f0: 71 75 65 73 74 22 20 66 6f 72 74 68 3a 63 72 20 quest" forth:cr
a100: 29 0a 20 20 20 20 6e 65 74 32 6f 2d 63 6f 64 65 ). net2o-code
a110: 30 0a 20 20 20 20 6e 65 74 32 6f 2d 76 65 72 73 0. net2o-vers
a120: 69 6f 6e 20 24 2c 20 76 65 72 73 69 6f 6e 3f 20 ion $, version?
a130: 20 30 6b 65 79 2c 0a 20 20 20 20 6e 65 73 74 5b 0key,. nest[
a140: 20 63 6f 6f 6b 69 65 2c 20 72 65 71 75 65 73 74 cookie, request
a150: 2c 20 5d 6e 65 73 74 0a 20 20 20 20 74 70 6b 63 , ]nest. tpkc
a160: 20 6b 65 79 73 69 7a 65 20 24 2c 20 72 65 63 65 keysize $, rece
a170: 69 76 65 2d 74 6d 70 6b 65 79 0a 20 20 20 20 74 ive-tmpkey. t
a180: 6d 70 6b 65 79 2d 72 65 71 75 65 73 74 20 74 6d mpkey-request tm
a190: 70 2d 73 65 63 72 65 74 2c 0a 20 20 20 20 6e 65 p-secret,. ne
a1a0: 73 74 5b 20 72 65 71 75 65 73 74 2d 71 72 2d 69 st[ request-qr-i
a1b0: 6e 76 69 74 61 74 69 6f 6e 20 72 65 71 75 65 73 nvitation reques
a1c0: 74 2c 20 5d 6e 65 73 74 0a 20 20 20 20 63 6c 6f t, ]nest. clo
a1d0: 73 65 2d 74 6d 70 6e 65 73 74 0a 20 20 20 20 5b se-tmpnest. [
a1e0: 27 5d 20 70 75 73 68 2d 63 6d 64 20 49 53 20 65 '] push-cmd IS e
a1f0: 78 70 65 63 74 2d 72 65 70 6c 79 3f 0a 20 20 20 xpect-reply?.
a200: 20 65 6e 64 2d 63 6f 64 65 7c 20 69 6e 76 69 74 end-code| invit
a210: 65 2d 72 65 73 75 6c 74 23 0a 20 20 20 20 6e 65 e-result#. ne
a220: 74 32 6f 3a 64 69 73 70 6f 73 65 2d 63 6f 6e 74 t2o:dispose-cont
a230: 65 78 74 20 3b 0a 70 72 65 76 69 6f 75 73 0a 0a ext ;.previous..
a240: 66 6f 72 77 61 72 64 20 3e 71 72 2d 6b 65 79 0a forward >qr-key.
a250: 65 76 65 6e 74 3a 20 3a 3e 3f 73 63 61 6e 2d 6c event: :>?scan-l
a260: 65 76 65 6c 20 28 20 2d 2d 20 29 20 3f 73 63 61 evel ( -- ) ?sca
a270: 6e 2d 6c 65 76 65 6c 20 3b 0a 65 76 65 6e 74 3a n-level ;.event:
a280: 20 3a 3e 71 72 2d 69 6e 76 69 74 61 74 69 6f 6e :>qr-invitation
a290: 20 7b 20 74 61 73 6b 20 77 5e 20 70 6b 20 2d 2d { task w^ pk --
a2a0: 20 7d 0a 20 20 20 20 70 6b 20 24 40 20 6b 65 79 }. pk $@ key
a2b0: 73 69 7a 65 32 20 2f 73 74 72 69 6e 67 20 3e 71 size2 /string >q
a2c0: 72 2d 6b 65 79 0a 20 20 20 20 70 6b 20 24 40 20 r-key. pk $@
a2d0: 6b 65 79 73 69 7a 65 32 20 75 6d 69 6e 20 5b 3a keysize2 umin [:
a2e0: 20 6e 65 74 32 6f 3a 70 6b 6c 6f 6f 6b 75 70 20 net2o:pklookup
a2f0: 73 65 6e 64 2d 71 72 2d 69 6e 76 69 74 61 74 69 send-qr-invitati
a300: 6f 6e 20 3b 5d 20 63 61 74 63 68 0a 20 20 20 20 on ;] catch.
a310: 49 46 20 20 20 20 32 64 72 6f 70 20 2e 22 20 73 IF 2drop ." s
a320: 65 6e 64 20 71 72 20 69 6e 76 69 74 61 74 69 6f end qr invitatio
a330: 6e 2c 20 61 62 6f 72 74 65 64 22 20 30 0a 20 20 n, aborted" 0.
a340: 20 20 45 4c 53 45 20 20 2e 22 20 73 65 6e 74 20 ELSE ." sent
a350: 71 72 20 69 6e 76 69 74 61 74 69 6f 6e 2c 20 67 qr invitation, g
a360: 6f 74 20 22 20 64 75 70 20 68 65 78 2e 20 54 48 ot " dup hex. TH
a370: 45 4e 0a 20 20 20 20 66 6f 72 74 68 3a 63 72 0a EN. forth:cr.
a380: 20 20 20 20 30 3d 20 49 46 20 20 3c 65 76 65 6e 0= IF <even
a390: 74 20 3a 3e 3f 73 63 61 6e 2d 6c 65 76 65 6c 20 t :>?scan-level
a3a0: 74 61 73 6b 20 65 76 65 6e 74 3e 20 20 54 48 45 task event> THE
a3b0: 4e 20 20 70 6b 20 24 66 72 65 65 20 3b 0a 0a 3a N pk $free ;..:
a3c0: 20 73 63 61 6e 6e 65 64 2d 6f 77 6e 6b 65 79 20 scanned-ownkey
a3d0: 7b 20 64 3a 20 70 6b 20 2d 2d 20 7d 0a 20 20 20 { d: pk -- }.
a3e0: 20 70 6b 20 73 63 61 6e 6e 65 64 2d 6b 65 79 2d pk scanned-key-
a3f0: 69 6e 0a 20 20 20 20 3c 65 76 65 6e 74 20 75 70 in. <event up
a400: 40 20 65 6c 69 74 2c 20 70 6b 20 24 31 30 20 2b @ elit, pk $10 +
a410: 20 24 6d 61 6b 65 20 65 6c 69 74 2c 20 3a 3e 71 $make elit, :>q
a420: 72 2d 69 6e 76 69 74 61 74 69 6f 6e 20 3f 71 75 r-invitation ?qu
a430: 65 72 79 2d 74 61 73 6b 20 65 76 65 6e 74 3e 20 ery-task event>
a440: 3b 0a 5c 20 74 68 65 20 69 64 65 61 20 6f 66 20 ;.\ the idea of
a450: 73 63 61 6e 20 61 6e 20 6f 77 6e 20 6b 65 79 20 scan an own key
a460: 69 73 20 74 6f 20 73 65 6e 64 20 61 20 69 6e 76 is to send a inv
a470: 69 74 61 74 69 6f 6e 2c 0a 5c 20 61 6e 64 20 72 itation,.\ and r
a480: 65 63 65 69 76 65 20 61 20 73 69 67 6e 61 74 75 eceive a signatu
a490: 72 65 20 74 68 61 74 20 70 72 6f 6f 66 73 20 74 re that proofs t
a4a0: 68 65 20 73 63 61 6e 6e 65 64 20 64 65 76 69 63 he scanned devic
a4b0: 65 0a 5c 20 68 61 73 20 61 63 63 65 73 73 20 74 e.\ has access t
a4c0: 6f 20 74 68 65 20 73 65 63 72 65 74 20 6b 65 79 o the secret key
a4d0: 0a 27 20 73 63 61 6e 6e 65 64 2d 6f 77 6e 6b 65 .' scanned-ownke
a4e0: 79 20 73 63 61 6e 6e 65 64 2d 78 20 71 72 3a 6f y scanned-x qr:o
a4f0: 77 6e 6b 65 79 23 20 63 65 6c 6c 73 20 2b 20 21 wnkey# cells + !
a500: 0a 0a 5c 20 6b 65 79 20 61 70 69 20 68 65 6c 70 ..\ key api help
a510: 65 72 73 0a 0a 3a 20 64 65 6c 2d 6c 61 73 74 2d ers..: del-last-
a520: 6b 65 79 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b key ( -- ). k
a530: 65 79 73 20 24 5b 5d 23 20 31 2d 20 6b 65 79 73 eys $[]# 1- keys
a540: 20 24 5b 5d 20 73 65 63 2d 66 72 65 65 0a 20 20 $[] sec-free.
a550: 20 20 6b 65 79 73 20 24 40 6c 65 6e 20 63 65 6c keys $@len cel
a560: 6c 2d 20 6b 65 79 73 20 24 21 6c 65 6e 20 3b 0a l- keys $!len ;.
a570: 0a 3a 20 73 74 6f 72 65 6b 65 79 21 20 28 20 2d .: storekey! ( -
a580: 2d 20 29 0a 20 20 20 20 3e 73 65 63 6b 65 79 20 - ). >seckey
a590: 6b 65 79 73 20 24 5b 5d 23 20 30 20 3f 44 4f 20 keys $[]# 0 ?DO
a5a0: 20 32 64 75 70 20 49 20 6b 65 79 73 20 73 65 63 2dup I keys sec
a5b0: 5b 5d 40 20 73 74 72 3d 20 49 46 0a 09 20 20 20 []@ str= IF..
a5c0: 20 49 20 6b 65 79 73 20 73 65 63 5b 5d 40 20 64 I keys sec[]@ d
a5d0: 72 6f 70 20 3e 73 74 6f 72 65 6b 65 79 20 21 20 rop >storekey !
a5e0: 20 4c 45 41 56 45 20 20 54 48 45 4e 20 20 4c 4f LEAVE THEN LO
a5f0: 4f 50 20 20 32 64 72 6f 70 20 3b 0a 0a 3a 20 63 OP 2drop ;..: c
a600: 68 6f 6f 73 65 2d 6b 65 79 20 28 20 2d 2d 20 6f hoose-key ( -- o
a610: 20 29 0a 20 20 20 20 30 20 42 45 47 49 4e 20 20 ). 0 BEGIN
a620: 64 72 6f 70 0a 09 2e 22 20 43 68 6f 6f 73 65 20 drop..." Choose
a630: 6b 65 79 20 62 79 20 6e 75 6d 62 65 72 3a 22 20 key by number:"
a640: 63 72 20 2e 73 65 63 72 65 74 2d 6e 69 63 6b 73 cr .secret-nicks
a650: 0a 09 42 45 47 49 4e 20 20 6b 65 79 20 64 75 70 ..BEGIN key dup
a660: 20 62 6c 20 3c 20 57 48 49 4c 45 20 20 64 72 6f bl < WHILE dro
a670: 70 20 20 52 45 50 45 41 54 20 5c 20 73 77 61 6c p REPEAT \ swal
a680: 6c 6f 77 20 63 6f 6e 74 72 6f 6c 20 6b 65 79 73 low control keys
a690: 0a 09 5b 27 5d 20 64 69 67 69 74 3f 20 23 33 36 ..['] digit? #36
a6a0: 20 62 61 73 65 2d 65 78 65 63 75 74 65 20 30 3d base-execute 0=
a6b0: 20 49 46 20 20 64 72 6f 70 20 30 0a 09 45 4c 53 IF drop 0..ELS
a6c0: 45 20 20 6e 69 63 6b 23 3e 6b 65 79 23 20 73 65 E nick#>key# se
a6d0: 63 72 65 74 2d 6b 65 79 20 20 54 48 45 4e 0a 09 cret-key THEN..
a6e0: 64 75 70 20 30 3d 20 57 48 49 4c 45 0a 09 20 20 dup 0= WHILE..
a6f0: 20 20 2e 22 20 50 6c 65 61 73 65 20 65 6e 74 65 ." Please ente
a700: 72 20 61 20 62 61 73 65 2d 33 36 20 6e 75 6d 62 r a base-36 numb
a710: 65 72 20 62 65 74 77 65 65 6e 20 30 20 61 6e 64 er between 0 and
a720: 20 22 0a 09 20 20 20 20 73 65 63 72 65 74 2d 6b ".. secret-k
a730: 65 79 73 23 20 31 2d 20 5b 27 5d 20 2e 20 23 33 eys# 1- ['] . #3
a740: 36 20 62 61 73 65 2d 65 78 65 63 75 74 65 20 63 6 base-execute c
a750: 72 20 20 72 64 72 6f 70 0a 20 20 20 20 52 45 50 r rdrop. REP
a760: 45 41 54 0a 20 20 20 20 64 75 70 20 2e 73 74 6f EAT. dup .sto
a770: 72 65 6b 65 79 21 20 20 3e 73 74 6f 72 65 6b 65 rekey! >storeke
a780: 79 20 40 20 64 65 66 61 75 6c 74 6b 65 79 20 21 y @ defaultkey !
a790: 0a 20 20 20 20 2e 22 20 3d 3d 3d 3d 20 6b 65 79 . ." ==== key
a7a0: 20 22 20 64 75 70 20 2e 2e 6e 69 63 6b 20 2e 22 " dup ..nick ."
a7b0: 20 20 63 68 6f 73 65 6e 20 3d 3d 3d 3d 22 20 63 chosen ====" c
a7c0: 72 20 3b 0a 0a 5c 20 77 69 6c 6c 20 61 73 6b 20 r ;..\ will ask
a7d0: 66 6f 72 20 79 6f 75 72 20 70 61 73 73 77 6f 72 for your passwor
a7e0: 64 20 61 6e 64 20 69 66 20 70 6f 73 73 69 62 6c d and if possibl
a7f0: 65 20 61 75 74 6f 2d 73 65 6c 65 63 74 20 79 6f e auto-select yo
a800: 75 72 20 69 64 0a 0a 56 61 72 69 61 62 6c 65 20 ur id..Variable
a810: 74 72 69 65 73 23 0a 23 31 30 20 56 61 6c 75 65 tries#.#10 Value
a820: 20 6d 61 78 74 72 69 65 73 23 0a 0a 66 6f 72 77 maxtries#..forw
a830: 61 72 64 20 72 65 61 64 2d 63 68 61 74 67 72 6f ard read-chatgro
a840: 75 70 73 0a 0a 3a 20 67 65 74 2d 73 6b 63 20 28 ups..: get-skc (
a850: 20 2d 2d 20 29 0a 20 20 20 20 73 65 63 72 65 74 -- ). secret
a860: 2d 6b 65 79 73 23 20 49 46 20 20 72 65 61 64 2d -keys# IF read-
a870: 63 68 61 74 67 72 6f 75 70 73 20 20 45 58 49 54 chatgroups EXIT
a880: 20 20 54 48 45 4e 20 20 74 72 69 65 73 23 20 6f THEN tries# o
a890: 66 66 0a 20 20 20 20 64 65 62 75 67 2d 76 65 63 ff. debug-vec
a8a0: 74 6f 72 20 40 20 6f 70 2d 76 65 63 74 6f 72 20 tor @ op-vector
a8b0: 21 40 20 3e 72 20 3c 64 65 66 61 75 6c 74 3e 0a !@ >r <default>.
a8c0: 20 20 20 20 73 65 63 72 65 74 2d 6b 65 79 73 23 secret-keys#
a8d0: 0a 20 20 20 20 42 45 47 49 4e 20 20 64 75 70 20 . BEGIN dup
a8e0: 30 3d 20 74 72 69 65 73 23 20 40 20 6d 61 78 74 0= tries# @ maxt
a8f0: 72 69 65 73 23 20 75 3c 20 61 6e 64 20 20 57 48 ries# u< and WH
a900: 49 4c 45 20 64 72 6f 70 0a 09 20 20 20 20 73 22 ILE drop.. s"
a910: 20 50 61 73 73 70 68 72 61 73 65 3a 20 22 20 2b Passphrase: " +
a920: 70 61 73 73 70 68 72 61 73 65 20 20 20 21 74 69 passphrase !ti
a930: 6d 65 0a 09 20 20 20 20 72 65 61 64 2d 6b 65 79 me.. read-key
a940: 73 20 73 65 63 72 65 74 2d 6b 65 79 73 23 20 64 s secret-keys# d
a950: 75 70 20 30 3d 20 49 46 0a 09 09 5c 20 66 61 69 up 0= IF...\ fai
a960: 6c 20 72 69 67 68 74 20 61 66 74 65 72 20 74 68 l right after th
a970: 65 20 66 69 72 73 74 20 74 72 79 20 69 66 20 50 e first try if P
a980: 41 53 53 50 48 52 41 53 45 20 69 73 20 75 73 65 ASSPHRASE is use
a990: 64 0a 09 09 5c 20 61 6e 64 20 67 69 76 65 20 74 d...\ and give t
a9a0: 68 65 20 6d 61 78 69 6d 75 6d 20 77 61 69 74 69 he maximum waiti
a9b0: 6e 67 20 70 65 6e 61 6c 74 79 20 69 6e 20 74 68 ng penalty in th
a9c0: 61 74 20 63 61 73 65 0a 09 09 31 20 6d 61 78 74 at case...1 maxt
a9d0: 72 69 65 73 23 20 73 22 20 50 41 53 53 50 48 52 ries# s" PASSPHR
a9e0: 41 53 45 22 20 67 65 74 65 6e 76 20 64 30 3d 20 ASE" getenv d0=
a9f0: 73 65 6c 65 63 74 20 74 72 69 65 73 23 20 2b 21 select tries# +!
aa00: 0a 09 09 3c 65 72 72 3e 20 2e 22 20 54 72 79 23 ...<err> ." Try#
aa10: 20 22 20 74 72 69 65 73 23 20 40 20 30 20 2e 72 " tries# @ 0 .r
aa20: 20 27 2f 27 20 65 6d 69 74 20 6d 61 78 74 72 69 '/' emit maxtri
aa30: 65 73 23 20 2e 0a 09 09 2e 22 20 66 61 69 6c 65 es# ....." faile
aa40: 64 2c 20 6e 6f 20 6b 65 79 20 66 6f 75 6e 64 2c d, no key found,
aa50: 20 77 61 69 74 69 6e 67 20 22 0a 09 09 23 31 30 waiting "...#10
aa60: 30 30 20 74 72 69 65 73 23 20 40 20 6c 73 68 69 00 tries# @ lshi
aa70: 66 74 20 64 75 70 20 2e 20 2e 22 20 6d 73 2e 2e ft dup . ." ms..
aa80: 2e 22 20 6d 73 20 20 3c 64 65 66 61 75 6c 74 3e ." ms <default>
aa90: 20 63 72 0a 09 09 64 65 6c 2d 6c 61 73 74 2d 6b cr...del-last-k
aaa0: 65 79 0a 09 20 20 20 20 54 48 45 4e 0a 20 20 20 ey.. THEN.
aab0: 20 52 45 50 45 41 54 0a 20 20 20 20 64 75 70 20 REPEAT. dup
aac0: 30 3d 20 49 46 20 20 23 2d 35 36 20 74 68 72 6f 0= IF #-56 thro
aad0: 77 20 20 54 48 45 4e 0a 20 20 20 20 31 20 3d 20 w THEN. 1 =
aae0: 49 46 20 20 30 20 73 65 63 72 65 74 2d 6b 65 79 IF 0 secret-key
aaf0: 0a 09 2e 22 20 3d 3d 3d 3d 20 6f 70 65 6e 65 64 ..." ==== opened
ab00: 3a 20 22 20 64 75 70 20 2e 2e 6e 69 63 6b 20 2e : " dup ..nick .
ab10: 22 20 20 69 6e 20 22 20 2e 74 69 6d 65 20 2e 22 " in " .time ."
ab20: 20 3d 3d 3d 3d 22 20 63 72 0a 20 20 20 20 45 4c ====" cr. EL
ab30: 53 45 20 20 2e 22 20 3d 3d 3d 3d 20 6f 70 65 6e SE ." ==== open
ab40: 65 64 20 69 6e 20 22 20 2e 74 69 6d 65 20 2e 22 ed in " .time ."
ab50: 20 3d 3d 3d 3d 22 20 63 72 20 63 68 6f 6f 73 65 ====" cr choose
ab60: 2d 6b 65 79 20 20 54 48 45 4e 0a 20 20 20 20 3e -key THEN. >
ab70: 72 61 77 2d 6b 65 79 20 3f 72 73 6b 20 72 65 61 raw-key ?rsk rea
ab80: 64 2d 63 68 61 74 67 72 6f 75 70 73 20 20 72 3e d-chatgroups r>
ab90: 20 6f 70 2d 76 65 63 74 6f 72 20 21 20 3b 0a 0a op-vector ! ;..
aba0: 73 63 6f 70 65 3a 20 6e 32 6f 0a 7d 73 63 6f 70 scope: n2o.}scop
abb0: 65 0a 0a 3a 20 6c 61 63 6b 73 2d 6b 65 79 3f 20 e..: lacks-key?
abc0: 28 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 ( -- flag ).
abd0: 67 65 6e 2d 6b 65 79 73 2d 64 69 72 20 20 22 73 gen-keys-dir "s
abe0: 65 63 6b 65 79 73 2e 6b 32 6f 22 20 2e 6b 65 79 eckeys.k2o" .key
abf0: 73 2f 20 32 64 75 70 20 66 69 6c 65 2d 73 74 61 s/ 2dup file-sta
ac00: 74 75 73 20 6e 69 70 0a 20 20 20 20 30 3d 20 49 tus nip. 0= I
ac10: 46 20 20 72 2f 6f 20 6f 70 65 6e 2d 66 69 6c 65 F r/o open-file
ac20: 20 74 68 72 6f 77 20 3e 72 20 72 40 20 66 69 6c throw >r r@ fil
ac30: 65 2d 73 69 7a 65 20 74 68 72 6f 77 20 64 30 3d e-size throw d0=
ac40: 0a 09 72 3e 20 63 6c 6f 73 65 2d 66 69 6c 65 20 ..r> close-file
ac50: 74 68 72 6f 77 20 20 45 4c 53 45 20 20 74 72 75 throw ELSE tru
ac60: 65 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 67 65 74 e THEN ;..: get
ac70: 2d 6d 79 2d 6b 65 79 20 28 20 2d 2d 20 78 74 20 -my-key ( -- xt
ac80: 29 0a 20 20 20 20 6c 61 63 6b 73 2d 6b 65 79 3f ). lacks-key?
ac90: 0a 20 20 20 20 49 46 20 20 5b 3a 20 2e 22 20 47 . IF [: ." G
aca0: 65 6e 65 72 61 74 65 20 61 20 6e 65 77 20 6b 65 enerate a new ke
acb0: 79 70 61 69 72 3a 22 20 63 72 0a 09 20 20 67 65 ypair:" cr.. ge
acc0: 74 2d 6e 69 63 6b 20 64 75 70 20 30 3d 20 23 2d t-nick dup 0= #-
acd0: 35 36 20 61 6e 64 20 74 68 72 6f 77 20 5c 20 65 56 and throw \ e
ace0: 6d 70 74 79 20 6e 69 63 6b 3a 20 70 72 65 74 65 mpty nick: prete
acf0: 6e 64 20 74 6f 20 71 75 69 74 0a 09 20 20 6e 65 nd to quit.. ne
ad00: 77 2d 6b 65 79 20 2e 6b 65 79 73 20 3f 72 73 6b w-key .keys ?rsk
ad10: 20 72 65 61 64 2d 63 68 61 74 67 72 6f 75 70 73 read-chatgroups
ad20: 20 3b 5d 0a 20 20 20 20 45 4c 53 45 20 20 5b 27 ;]. ELSE ['
ad30: 5d 20 67 65 74 2d 73 6b 63 20 20 54 48 45 4e 20 ] get-skc THEN
ad40: 3b 0a 0a 3a 20 2e 6b 65 79 69 6e 66 6f 20 28 20 ;..: .keyinfo (
ad50: 2d 2d 20 29 0a 20 20 20 20 3c 77 61 72 6e 3e 20 -- ). <warn>
ad60: 2e 22 20 3d 3d 3d 3d 20 4e 6f 20 6b 65 79 20 6f ." ==== No key o
ad70: 70 65 6e 65 64 20 3d 3d 3d 3d 22 20 63 72 0a 20 pened ====" cr.
ad80: 20 20 20 3c 69 6e 66 6f 3e 20 2e 22 20 67 65 6e <info> ." gen
ad90: 65 72 61 74 65 20 61 20 6e 65 77 20 6f 6e 65 20 erate a new one
ada0: 77 69 74 68 20 27 6b 65 79 67 65 6e 27 22 20 63 with 'keygen'" c
adb0: 72 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 0a 3a r <default> ;..:
adc0: 20 67 65 74 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 get-me ( -- ).
add0: 20 20 20 67 65 74 2d 6d 79 2d 6b 65 79 20 63 61 get-my-key ca
ade0: 74 63 68 20 64 75 70 20 23 2d 35 36 20 3d 20 49 tch dup #-56 = I
adf0: 46 20 64 72 6f 70 20 2e 6b 65 79 69 6e 66 6f 20 F drop .keyinfo
ae00: 45 4c 53 45 20 74 68 72 6f 77 20 54 48 45 4e 20 ELSE throw THEN
ae10: 3b 0a 0a 3a 20 3f 67 65 74 2d 6d 65 20 28 20 2d ;..: ?get-me ( -
ae20: 2d 20 29 0a 20 20 20 20 5c 47 20 74 68 69 73 20 - ). \G this
ae30: 76 65 72 73 69 6f 6e 20 6f 66 20 67 65 74 2d 6d version of get-m
ae40: 65 20 66 61 69 6c 73 20 68 61 72 64 20 69 66 20 e fails hard if
ae50: 6e 6f 20 6b 65 79 20 69 73 20 6f 70 65 6e 65 64 no key is opened
ae60: 0a 20 20 20 20 67 65 74 2d 6d 79 2d 6b 65 79 20 . get-my-key
ae70: 63 61 74 63 68 0a 20 20 20 20 63 61 73 65 0a 09 catch. case..
ae80: 23 2d 35 36 20 6f 66 20 2e 6b 65 79 69 6e 66 6f #-56 of .keyinfo
ae90: 20 74 72 75 65 20 21 21 6e 6f 2d 6b 65 79 2d 6f true !!no-key-o
aea0: 70 65 6e 21 21 20 65 6e 64 6f 66 0a 09 23 2d 32 pen!! endof..#-2
aeb0: 38 20 6f 66 20 2e 6b 65 79 69 6e 66 6f 20 74 72 8 of .keyinfo tr
aec0: 75 65 20 21 21 6e 6f 2d 6b 65 79 2d 6f 70 65 6e ue !!no-key-open
aed0: 21 21 20 65 6e 64 6f 66 0a 09 74 68 72 6f 77 20 !! endof..throw
aee0: 20 30 0a 20 20 20 20 65 6e 64 63 61 73 65 20 3b 0. endcase ;
aef0: 0a 0a 5c 5c 5c 0a 4c 6f 63 61 6c 20 56 61 72 69 ..\\\.Local Vari
af00: 61 62 6c 65 73 3a 0a 66 6f 72 74 68 2d 6c 6f 63 ables:.forth-loc
af10: 61 6c 2d 77 6f 72 64 73 3a 0a 20 20 20 20 28 0a al-words:. (.
af20: 20 20 20 20 20 28 28 22 6e 65 74 32 6f 3a 22 20 (("net2o:"
af30: 22 2b 6e 65 74 32 6f 3a 22 29 20 64 65 66 69 6e "+net2o:") defin
af40: 69 74 69 6f 6e 2d 73 74 61 72 74 65 72 20 28 66 ition-starter (f
af50: 6f 6e 74 2d 6c 6f 63 6b 2d 6b 65 79 77 6f 72 64 ont-lock-keyword
af60: 2d 66 61 63 65 20 2e 20 31 29 0a 20 20 20 20 20 -face . 1).
af70: 20 22 5b 20 5c 74 5c 6e 5d 22 20 74 20 6e 61 6d "[ \t\n]" t nam
af80: 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 66 75 6e e (font-lock-fun
af90: 63 74 69 6f 6e 2d 6e 61 6d 65 2d 66 61 63 65 20 ction-name-face
afa0: 2e 20 33 29 29 0a 20 20 20 20 20 28 28 22 64 65 . 3)). (("de
afb0: 62 75 67 3a 22 20 22 66 69 65 6c 64 3a 22 20 22 bug:" "field:" "
afc0: 32 66 69 65 6c 64 3a 22 20 22 73 66 66 69 65 6c 2field:" "sffiel
afd0: 64 3a 22 20 22 64 66 66 69 65 6c 64 3a 22 20 22 d:" "dffield:" "
afe0: 36 34 66 69 65 6c 64 3a 22 20 22 75 76 61 72 22 64field:" "uvar"
aff0: 20 22 75 76 61 6c 75 65 22 29 20 6e 6f 6e 2d 69 "uvalue") non-i
b000: 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e 74 2d 6c mmediate (font-l
b010: 6f 63 6b 2d 74 79 70 65 2d 66 61 63 65 20 2e 20 ock-type-face .
b020: 32 29 0a 20 20 20 20 20 20 22 5b 20 5c 74 5c 6e 2). "[ \t\n
b030: 5d 22 20 74 20 6e 61 6d 65 20 28 66 6f 6e 74 2d ]" t name (font-
b040: 6c 6f 63 6b 2d 76 61 72 69 61 62 6c 65 2d 6e 61 lock-variable-na
b050: 6d 65 2d 66 61 63 65 20 2e 20 33 29 29 0a 20 20 me-face . 3)).
b060: 20 20 20 28 22 5b 61 2d 7a 30 2d 39 5d 2b 28 22 ("[a-z0-9]+("
b070: 20 69 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e 74 immediate (font
b080: 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 -lock-comment-fa
b090: 63 65 20 2e 20 31 29 0a 20 20 20 20 20 20 22 29 ce . 1). ")
b0a0: 22 20 6e 69 6c 20 63 6f 6d 6d 65 6e 74 20 28 66 " nil comment (f
b0b0: 6f 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 ont-lock-comment
b0c0: 2d 66 61 63 65 20 2e 20 31 29 29 0a 20 20 20 20 -face . 1)).
b0d0: 29 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 69 6e ).forth-local-in
b0e0: 64 65 6e 74 2d 77 6f 72 64 73 3a 0a 20 20 20 20 dent-words:.
b0f0: 28 0a 20 20 20 20 20 28 28 22 6e 65 74 32 6f 3a (. (("net2o:
b100: 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20 28 30 20 " "+net2o:") (0
b110: 2e 20 32 29 20 28 30 20 2e 20 32 29 20 6e 6f 6e . 2) (0 . 2) non
b120: 2d 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 -immediate).
b130: 29 0a 45 6e 64 3a 0a 5b 54 48 45 4e 5d 0a ).End:.[THEN].