Hex Artifact Content
Not logged in

Artifact 778f766a8285c0676cf66df0c2ae69b071ae02cc:


0000: 5c 20 6e 65 74 32 6f 20 6b 65 79 20 73 74 6f 72  \ net2o key stor
0010: 61 67 65 0a 0a 5c 20 43 6f 70 79 72 69 67 68 74  age..\ Copyright
0020: 20 28 43 29 20 32 30 31 33 2d 32 30 31 35 20 20   (C) 2013-2015  
0030: 20 42 65 72 6e 64 20 50 61 79 73 61 6e 0a 0a 5c   Bernd Paysan..\
0040: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73   This program is
0050: 20 66 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20   free software: 
0060: 79 6f 75 20 63 61 6e 20 72 65 64 69 73 74 72 69  you can redistri
0070: 62 75 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d  bute it and/or m
0080: 6f 64 69 66 79 0a 5c 20 69 74 20 75 6e 64 65 72  odify.\ it under
0090: 20 74 68 65 20 74 65 72 6d 73 20 6f 66 20 74 68   the terms of th
00a0: 65 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e  e GNU Affero Gen
00b0: 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65  eral Public Lice
00c0: 6e 73 65 20 61 73 20 70 75 62 6c 69 73 68 65 64  nse as published
00d0: 20 62 79 0a 5c 20 74 68 65 20 46 72 65 65 20 53   by.\ the Free S
00e0: 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 69  oftware Foundati
00f0: 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 69  on, either versi
0100: 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 65  on 3 of the Lice
0110: 6e 73 65 2c 20 6f 72 0a 5c 20 28 61 74 20 79 6f  nse, or.\ (at yo
0120: 75 72 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c  ur option) any l
0130: 61 74 65 72 20 76 65 72 73 69 6f 6e 2e 0a 0a 5c  ater version...\
0140: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73   This program is
0150: 20 64 69 73 74 72 69 62 75 74 65 64 20 69 6e 20   distributed in 
0160: 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 69 74  the hope that it
0170: 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 6c 2c   will be useful,
0180: 0a 5c 20 62 75 74 20 57 49 54 48 4f 55 54 20 41  .\ but WITHOUT A
0190: 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74  NY WARRANTY; wit
01a0: 68 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d  hout even the im
01b0: 70 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f  plied warranty o
01c0: 66 0a 5c 20 4d 45 52 43 48 41 4e 54 41 42 49 4c  f.\ MERCHANTABIL
01d0: 49 54 59 20 6f 72 20 46 49 54 4e 45 53 53 20 46  ITY or FITNESS F
01e0: 4f 52 20 41 20 50 41 52 54 49 43 55 4c 41 52 20  OR A PARTICULAR 
01f0: 50 55 52 50 4f 53 45 2e 20 20 53 65 65 20 74 68  PURPOSE.  See th
0200: 65 0a 5c 20 47 4e 55 20 41 66 66 65 72 6f 20 47  e.\ GNU Affero G
0210: 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69  eneral Public Li
0220: 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 20 64  cense for more d
0230: 65 74 61 69 6c 73 2e 0a 0a 5c 20 59 6f 75 20 73  etails...\ You s
0240: 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 65 69  hould have recei
0250: 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 74 68  ved a copy of th
0260: 65 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e  e GNU Affero Gen
0270: 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65  eral Public Lice
0280: 6e 73 65 0a 5c 20 61 6c 6f 6e 67 20 77 69 74 68  nse.\ along with
0290: 20 74 68 69 73 20 70 72 6f 67 72 61 6d 2e 20 20   this program.  
02a0: 49 66 20 6e 6f 74 2c 20 73 65 65 20 3c 68 74 74  If not, see <htt
02b0: 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 2f  p://www.gnu.org/
02c0: 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a 0a 72 65 71  licenses/>...req
02d0: 75 69 72 65 20 6d 6b 64 69 72 2e 66 73 0a 0a 5c  uire mkdir.fs..\
02e0: 20 61 63 63 65 70 74 20 66 6f 72 20 70 61 73 73   accept for pass
02f0: 77 6f 72 64 20 65 6e 74 72 79 0a 0a 73 63 6f 70  word entry..scop
0300: 65 7b 20 63 6f 6e 66 69 67 0a 56 61 72 69 61 62  e{ config.Variab
0310: 6c 65 20 70 77 2d 6c 65 76 65 6c 23 20 32 20 70  le pw-level# 2 p
0320: 77 2d 6c 65 76 65 6c 23 20 21 20 5c 20 70 77 2d  w-level# ! \ pw-
0330: 6c 65 76 65 6c 23 20 30 20 69 73 20 6c 6f 77 65  level# 0 is lowe
0340: 73 74 0a 56 61 72 69 61 62 6c 65 20 70 77 2d 6d  st.Variable pw-m
0350: 61 78 6c 65 76 65 6c 23 20 34 20 70 77 2d 6d 61  axlevel# 4 pw-ma
0360: 78 6c 65 76 65 6c 23 20 21 20 5c 20 70 77 2d 6d  xlevel# ! \ pw-m
0370: 61 78 6c 65 76 65 6c 23 20 69 73 20 74 68 65 20  axlevel# is the 
0380: 6d 61 78 69 6d 75 6d 20 63 68 65 63 6b 65 64 0a  maximum checked.
0390: 7d 73 63 6f 70 65 0a 0a 5b 49 46 44 45 46 5d 20  }scope..[IFDEF] 
03a0: 6d 73 6c 69 6e 75 78 20 27 2a 27 20 5b 45 4c 53  mslinux '*' [ELS
03b0: 45 5d 20 27 e2 80 a2 27 20 5b 54 48 45 4e 5d 20  E] '•' [THEN] 
03c0: 43 6f 6e 73 74 61 6e 74 20 70 77 2a 0a 0a 78 63  Constant pw*..xc
03d0: 2d 76 65 63 74 6f 72 20 75 70 40 20 2d 20 63 6c  -vector up@ - cl
03e0: 61 73 73 2d 6f 20 21 0a 0a 30 20 63 65 6c 6c 20  ass-o !..0 cell 
03f0: 75 76 61 72 20 65 73 63 2d 73 74 61 74 65 20 64  uvar esc-state d
0400: 72 6f 70 0a 0a 44 65 66 65 72 20 6f 6c 64 2d 65  rop..Defer old-e
0410: 6d 69 74 20 20 77 68 61 74 27 73 20 65 6d 69 74  mit  what's emit
0420: 20 69 73 20 6f 6c 64 2d 65 6d 69 74 0a 0a 68 65   is old-emit..he
0430: 72 65 0a 78 63 2d 76 65 63 74 6f 72 20 40 20 63  re.xc-vector @ c
0440: 65 6c 6c 2d 20 64 75 70 20 40 20 74 75 63 6b 20  ell- dup @ tuck 
0450: 2d 20 68 65 72 65 20 73 77 61 70 20 64 75 70 20  - here swap dup 
0460: 61 6c 6c 6f 74 20 6d 6f 76 65 0a 2c 20 68 65 72  allot move., her
0470: 65 20 30 20 2c 20 43 6f 6e 73 74 61 6e 74 20 75  e 0 , Constant u
0480: 74 66 2d 38 2a 0a 0a 78 63 2d 76 65 63 74 6f 72  tf-8*..xc-vector
0490: 20 40 20 20 75 74 66 2d 38 2a 20 78 63 2d 76 65   @  utf-8* xc-ve
04a0: 63 74 6f 72 20 21 20 27 20 2a 2d 77 69 64 74 68  ctor ! ' *-width
04b0: 20 69 73 20 78 2d 77 69 64 74 68 20 20 78 63 2d   is x-width  xc-
04c0: 76 65 63 74 6f 72 20 21 0a 0a 3a 20 65 6d 69 74  vector !..: emit
04d0: 2d 70 77 2a 20 28 20 6e 20 2d 2d 20 29 0a 20 20  -pw* ( n -- ).  
04e0: 20 20 64 75 70 20 23 65 73 63 20 3d 20 49 46 20    dup #esc = IF 
04f0: 20 65 73 63 2d 73 74 61 74 65 20 6f 6e 20 20 54   esc-state on  T
0500: 48 45 4e 0a 20 20 20 20 64 75 70 20 62 6c 20 3c  HEN.    dup bl <
0510: 20 49 46 20 20 6f 6c 64 2d 65 6d 69 74 20 20 45   IF  old-emit  E
0520: 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 65 73  XIT  THEN.    es
0530: 63 2d 73 74 61 74 65 20 40 20 49 46 20 20 64 75  c-state @ IF  du
0540: 70 20 6f 6c 64 2d 65 6d 69 74 0a 09 74 6f 75 70  p old-emit..toup
0550: 70 65 72 20 27 41 27 20 27 5b 27 20 77 69 74 68  per 'A' '[' with
0560: 69 6e 20 49 46 20 20 65 73 63 2d 73 74 61 74 65  in IF  esc-state
0570: 20 6f 66 66 20 20 54 48 45 4e 0a 20 20 20 20 45   off  THEN.    E
0580: 4c 53 45 20 20 24 43 30 20 24 38 30 20 77 69 74  LSE  $C0 $80 wit
0590: 68 69 6e 20 49 46 0a 09 20 20 20 20 5b 20 70 77  hin IF..    [ pw
05a0: 2a 20 27 20 78 65 6d 69 74 20 24 74 6d 70 0a 09  * ' xemit $tmp..
05b0: 20 20 20 20 62 6f 75 6e 64 73 20 5b 3f 44 4f 5d      bounds [?DO]
05c0: 20 5b 49 5d 20 63 40 20 5d 4c 20 6f 6c 64 2d 65   [I] c@ ]L old-e
05d0: 6d 69 74 20 5b 20 5b 4c 4f 4f 50 5d 20 5d 0a 09  mit [ [LOOP] ]..
05e0: 54 48 45 4e 0a 20 20 20 20 54 48 45 4e 20 3b 0a  THEN.    THEN ;.
05f0: 0a 3a 20 74 79 70 65 2d 70 77 2a 20 28 20 61 64  .: type-pw* ( ad
0600: 64 72 20 75 20 2d 2d 20 29 20 20 32 64 75 70 20  dr u -- )  2dup 
0610: 62 6c 20 73 6b 69 70 20 6e 69 70 20 30 3d 0a 20  bl skip nip 0=. 
0620: 20 20 20 49 46 20 20 20 20 62 6f 75 6e 64 73 20     IF    bounds 
0630: 55 2b 44 4f 20 20 62 6c 20 6f 6c 64 2d 65 6d 69  U+DO  bl old-emi
0640: 74 20 20 20 20 4c 4f 4f 50 0a 20 20 20 20 45 4c  t    LOOP.    EL
0650: 53 45 20 20 62 6f 75 6e 64 73 20 55 2b 44 4f 20  SE  bounds U+DO 
0660: 20 49 20 63 40 20 65 6d 69 74 2d 70 77 2a 20 20   I c@ emit-pw*  
0670: 4c 4f 4f 50 20 20 54 48 45 4e 20 3b 0a 0a 3a 20  LOOP  THEN ;..: 
0680: 61 63 63 65 70 74 2a 20 28 20 61 64 64 72 20 75  accept* ( addr u
0690: 20 2d 2d 20 75 27 20 29 0a 20 20 20 20 5c 47 20   -- u' ).    \G 
06a0: 61 63 63 65 70 74 2d 6c 69 6b 65 20 69 6e 70 75  accept-like inpu
06b0: 74 2c 20 62 75 74 20 74 79 70 65 73 20 2a 20 69  t, but types * i
06c0: 6e 73 74 65 61 64 20 6f 66 20 74 68 65 20 63 68  nstead of the ch
06d0: 61 72 61 63 74 65 72 0a 20 20 20 20 5c 47 20 64  aracter.    \G d
06e0: 6f 6e 27 74 20 73 61 76 65 20 69 6e 74 6f 20 68  on't save into h
06f0: 69 73 74 6f 72 79 0a 20 20 20 20 68 69 73 74 6f  istory.    histo
0700: 72 79 20 3e 72 20 20 77 68 61 74 27 73 20 74 79  ry >r  what's ty
0710: 70 65 20 3e 72 20 20 77 68 61 74 27 73 20 65 6d  pe >r  what's em
0720: 69 74 20 69 73 20 6f 6c 64 2d 65 6d 69 74 0a 20  it is old-emit. 
0730: 20 20 20 75 74 66 2d 38 2a 20 78 63 2d 76 65 63     utf-8* xc-vec
0740: 74 6f 72 20 21 40 20 3e 72 20 20 5b 27 5d 20 74  tor !@ >r  ['] t
0750: 79 70 65 2d 70 77 2a 20 69 73 20 74 79 70 65 20  ype-pw* is type 
0760: 20 5b 27 5d 20 65 6d 69 74 2d 70 77 2a 20 69 73   ['] emit-pw* is
0770: 20 65 6d 69 74 0a 20 20 20 20 30 20 74 6f 20 68   emit.    0 to h
0780: 69 73 74 6f 72 79 0a 20 20 20 20 5b 27 5d 20 61  istory.    ['] a
0790: 63 63 65 70 74 20 63 61 74 63 68 0a 20 20 20 20  ccept catch.    
07a0: 72 3e 20 78 63 2d 76 65 63 74 6f 72 20 21 20 20  r> xc-vector !  
07b0: 77 68 61 74 27 73 20 6f 6c 64 2d 65 6d 69 74 20  what's old-emit 
07c0: 69 73 20 65 6d 69 74 20 20 72 3e 20 69 73 20 74  is emit  r> is t
07d0: 79 70 65 20 20 72 3e 20 74 6f 20 68 69 73 74 6f  ype  r> to histo
07e0: 72 79 0a 20 20 20 20 74 68 72 6f 77 20 2d 31 20  ry.    throw -1 
07f0: 30 20 61 74 2d 64 65 6c 74 61 78 79 20 73 70 61  0 at-deltaxy spa
0800: 63 65 20 3b 0a 0a 5c 20 4b 65 79 73 20 61 72 65  ce ;..\ Keys are
0810: 20 70 61 73 73 77 6f 72 64 73 20 61 6e 64 20 70   passwords and p
0820: 72 69 76 61 74 65 20 6b 65 79 73 20 28 73 65 6c  rivate keys (sel
0830: 66 2d 6b 65 79 65 64 2c 20 69 2e 65 2e 20 70 72  f-keyed, i.e. pr
0840: 69 76 61 74 65 2a 70 75 62 6c 69 63 20 6b 65 79  ivate*public key
0850: 29 0a 0a 63 6d 64 2d 62 75 66 30 20 75 63 6c 61  )..cmd-buf0 ucla
0860: 73 73 20 63 6d 64 62 75 66 2d 6f 0a 20 20 20 20  ss cmdbuf-o.    
0870: 6d 61 78 64 61 74 61 20 2d 0a 20 20 20 20 6b 65  maxdata -.    ke
0880: 79 2d 73 61 6c 74 23 20 75 76 61 72 20 6b 65 79  y-salt# uvar key
0890: 70 61 63 6b 0a 20 20 20 20 6b 65 79 70 61 63 6b  pack.    keypack
08a0: 23 20 20 75 76 61 72 20 6b 65 79 70 61 63 6b 2d  #  uvar keypack-
08b0: 62 75 66 0a 20 20 20 20 6b 65 79 2d 63 6b 73 75  buf.    key-cksu
08c0: 6d 23 20 75 76 61 72 20 6b 65 79 70 61 63 6b 2d  m# uvar keypack-
08d0: 63 68 6b 73 75 6d 0a 65 6e 64 2d 63 6c 61 73 73  chksum.end-class
08e0: 20 63 6d 64 2d 6b 65 79 62 75 66 2d 63 0a 0a 63   cmd-keybuf-c..c
08f0: 6d 64 2d 6b 65 79 62 75 66 2d 63 20 27 20 6e 65  md-keybuf-c ' ne
0900: 77 20 73 74 61 74 69 63 2d 61 20 77 69 74 68 2d  w static-a with-
0910: 61 6c 6c 6f 63 61 74 65 72 20 63 6f 64 65 2d 6b  allocater code-k
0920: 65 79 5e 20 21 0a 27 20 63 6f 64 65 2d 6b 65 79  ey^ !.' code-key
0930: 5e 20 63 6d 64 62 75 66 3a 20 63 6f 64 65 2d 6b  ^ cmdbuf: code-k
0940: 65 79 0a 0a 63 6f 64 65 2d 6b 65 79 0a 63 6d 64  ey..code-key.cmd
0950: 30 6c 6f 63 6b 20 30 20 70 74 68 72 65 61 64 5f  0lock 0 pthread_
0960: 6d 75 74 65 78 5f 69 6e 69 74 20 64 72 6f 70 0a  mutex_init drop.
0970: 0a 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d 20 61 64  .:noname ( -- ad
0980: 64 72 20 75 20 29 20 6b 65 79 70 61 63 6b 2d 62  dr u ) keypack-b
0990: 75 66 20 63 6d 64 62 75 66 23 20 40 20 3b 20 74  uf cmdbuf# @ ; t
09a0: 6f 20 63 6d 64 62 75 66 24 0a 3a 6e 6f 6e 61 6d  o cmdbuf$.:nonam
09b0: 65 20 28 20 2d 2d 20 6e 20 29 20 20 6b 65 79 70  e ( -- n )  keyp
09c0: 61 63 6b 23 20 63 6d 64 62 75 66 23 20 40 20 2d  ack# cmdbuf# @ -
09d0: 20 3b 20 74 6f 20 6d 61 78 73 74 72 69 6e 67 0a   ; to maxstring.
09e0: 0a 63 6f 64 65 30 2d 62 75 66 0a 0a 3a 6e 6f 6e  .code0-buf..:non
09f0: 61 6d 65 20 64 65 66 65 72 73 20 61 6c 6c 6f 63  ame defers alloc
0a00: 2d 63 6f 64 65 2d 62 75 66 73 0a 20 20 20 20 63  -code-bufs.    c
0a10: 6d 64 2d 6b 65 79 62 75 66 2d 63 20 6e 65 77 20  md-keybuf-c new 
0a20: 63 6f 64 65 2d 6b 65 79 5e 20 21 20 3b 20 69 73  code-key^ ! ; is
0a30: 20 61 6c 6c 6f 63 2d 63 6f 64 65 2d 62 75 66 73   alloc-code-bufs
0a40: 0a 3a 6e 6f 6e 61 6d 65 20 64 65 66 65 72 73 20  .:noname defers 
0a50: 66 72 65 65 2d 63 6f 64 65 2d 62 75 66 73 0a 20  free-code-bufs. 
0a60: 20 20 20 63 6f 64 65 2d 6b 65 79 5e 20 40 20 2e     code-key^ @ .
0a70: 64 69 73 70 6f 73 65 20 3b 20 69 73 20 66 72 65  dispose ; is fre
0a80: 65 2d 63 6f 64 65 2d 62 75 66 73 0a 0a 5c 20 68  e-code-bufs..\ h
0a90: 61 73 68 65 64 20 6b 65 79 20 64 61 74 61 20 62  ashed key data b
0aa0: 61 73 65 0a 0a 56 61 72 69 61 62 6c 65 20 67 72  ase..Variable gr
0ab0: 6f 75 70 73 5b 5d 20 5c 20 6e 61 6d 65 73 20 6f  oups[] \ names o
0ac0: 66 20 67 72 6f 75 70 73 2c 20 73 6f 72 74 65 64  f groups, sorted
0ad0: 20 62 79 20 6f 72 64 65 72 20 69 6e 20 67 72 6f   by order in gro
0ae0: 75 70 73 20 66 69 6c 65 0a 0a 55 73 65 72 20 3e  ups file..User >
0af0: 73 74 6f 72 65 6b 65 79 0a 56 61 72 69 61 62 6c  storekey.Variabl
0b00: 65 20 64 65 66 61 75 6c 74 6b 65 79 0a 0a 3a 20  e defaultkey..: 
0b10: 66 72 65 65 2d 6b 65 79 20 28 20 6f 3a 6b 65 79  free-key ( o:key
0b20: 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20   -- o:key ).    
0b30: 5c 67 20 66 72 65 65 20 61 6c 6c 20 70 61 72 74  \g free all part
0b40: 73 20 6f 66 20 74 68 65 20 73 75 62 6b 65 79 0a  s of the subkey.
0b50: 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 2d 6f 66      ke-sk sec-of
0b60: 66 0a 20 20 20 20 6b 65 2d 73 6b 73 69 67 20 73  f.    ke-sksig s
0b70: 65 63 2d 6f 66 66 0a 20 20 20 20 6b 65 2d 70 6b  ec-off.    ke-pk
0b80: 20 24 6f 66 66 0a 20 20 20 20 6b 65 2d 6e 69 63   $off.    ke-nic
0b90: 6b 20 24 6f 66 66 0a 20 20 20 20 6b 65 2d 73 65  k $off.    ke-se
0ba0: 6c 66 73 69 67 20 24 6f 66 66 0a 20 20 20 20 6b  lfsig $off.    k
0bb0: 65 2d 73 69 67 73 5b 5d 20 24 5b 5d 6f 66 66 0a  e-sigs[] $[]off.
0bc0: 20 20 20 20 6b 65 2d 70 65 74 73 5b 5d 20 24 5b      ke-pets[] $[
0bd0: 5d 6f 66 66 0a 20 20 20 20 6b 65 2d 70 65 74 73  ]off.    ke-pets
0be0: 23 20 24 6f 66 66 20 3b 0a 0a 5c 20 6b 65 79 20  # $off ;..\ key 
0bf0: 63 6c 61 73 73 0a 0a 30 0a 65 6e 75 6d 20 6b 65  class..0.enum ke
0c00: 79 23 61 6e 6f 6e 0a 65 6e 75 6d 20 6b 65 79 23  y#anon.enum key#
0c10: 75 73 65 72 0a 65 6e 75 6d 20 6b 65 79 23 67 72  user.enum key#gr
0c20: 6f 75 70 0a 64 72 6f 70 0a 0a 5c 20 6b 65 79 20  oup.drop..\ key 
0c30: 69 6d 70 6f 72 74 20 74 79 70 65 0a 0a 30 0a 65  import type..0.e
0c40: 6e 75 6d 20 69 6d 70 6f 72 74 23 73 65 6c 66 20  num import#self 
0c50: 20 20 20 20 20 5c 20 70 72 69 76 61 74 65 20 6b       \ private k
0c60: 65 79 0a 65 6e 75 6d 20 69 6d 70 6f 72 74 23 6d  ey.enum import#m
0c70: 61 6e 75 61 6c 20 20 20 20 5c 20 6d 61 6e 75 61  anual    \ manua
0c80: 6c 20 69 6d 70 6f 72 74 0a 65 6e 75 6d 20 69 6d  l import.enum im
0c90: 70 6f 72 74 23 73 63 61 6e 20 20 20 20 20 20 5c  port#scan      \
0ca0: 20 73 63 61 6e 20 69 6d 70 6f 72 74 0a 65 6e 75   scan import.enu
0cb0: 6d 20 69 6d 70 6f 72 74 23 63 68 61 74 20 20 20  m import#chat   
0cc0: 20 20 20 5c 20 73 65 65 6e 20 69 6e 20 63 68 61     \ seen in cha
0cd0: 74 0a 65 6e 75 6d 20 69 6d 70 6f 72 74 23 64 68  t.enum import#dh
0ce0: 74 20 20 20 20 20 20 20 5c 20 64 68 74 20 69 6d  t       \ dht im
0cf0: 70 6f 72 74 0a 65 6e 75 6d 20 69 6d 70 6f 72 74  port.enum import
0d00: 23 69 6e 76 69 74 65 64 20 20 20 5c 20 69 6e 76  #invited   \ inv
0d10: 69 74 61 74 69 6f 6e 20 69 6d 70 6f 72 74 0a 65  itation import.e
0d20: 6e 75 6d 20 69 6d 70 6f 72 74 23 75 6e 74 72 75  num import#untru
0d30: 73 74 65 64 20 5c 20 6d 75 73 74 20 62 65 20 6c  sted \ must be l
0d40: 61 73 74 0a 64 72 6f 70 0a 24 31 46 20 65 6e 75  ast.drop.$1F enu
0d50: 6d 20 69 6d 70 6f 72 74 23 6e 65 77 20 20 20 5c  m import#new   \
0d60: 20 6e 65 77 20 66 6f 72 6d 61 74 0a 64 72 6f 70   new format.drop
0d70: 0a 0a 43 72 65 61 74 65 20 69 6d 70 6f 72 74 73  ..Create imports
0d80: 24 20 24 32 30 20 61 6c 6c 6f 74 20 69 6d 70 6f  $ $20 allot impo
0d90: 72 74 73 24 20 24 32 30 20 62 6c 20 66 69 6c 6c  rts$ $20 bl fill
0da0: 0a 22 49 6d 73 63 64 69 75 22 20 69 6d 70 6f 72  ."Imscdiu" impor
0db0: 74 73 24 20 73 77 61 70 20 6d 6f 76 65 0a 0a 56  ts$ swap move..V
0dc0: 61 72 69 61 62 6c 65 20 69 6d 70 6f 72 74 2d 74  ariable import-t
0dd0: 79 70 65 20 20 69 6d 70 6f 72 74 23 6e 65 77 20  ype  import#new 
0de0: 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 0a 0a 43  import-type !..C
0df0: 72 65 61 74 65 20 3e 69 6d 2d 63 6f 6c 6f 72 20  reate >im-color 
0e00: 20 24 42 36 30 20 2c 20 24 44 36 30 20 2c 20 24   $B60 , $D60 , $
0e10: 39 36 30 20 2c 20 24 43 36 30 20 2c 20 24 41 36  960 , $C60 , $A6
0e20: 30 20 2c 20 24 38 42 31 20 2c 20 24 45 36 30 20  0 , $8B1 , $E60 
0e30: 2c 0a 44 4f 45 53 3e 20 73 77 61 70 20 38 20 63  ,.DOES> swap 8 c
0e40: 65 6c 6c 73 20 30 20 44 4f 20 20 64 75 70 20 31  ells 0 DO  dup 1
0e50: 20 61 6e 64 20 49 46 20 20 64 72 6f 70 20 49 20   and IF  drop I 
0e60: 4c 45 41 56 45 20 20 54 48 45 4e 20 20 32 2f 20  LEAVE  THEN  2/ 
0e70: 20 4c 4f 4f 50 0a 20 20 63 65 6c 6c 73 20 2b 20   LOOP.  cells + 
0e80: 40 20 61 74 74 72 21 20 3b 0a 0a 3a 20 2e 69 6d  @ attr! ;..: .im
0e90: 70 6f 72 74 73 20 28 20 6d 61 73 6b 20 2d 2d 20  ports ( mask -- 
0ea0: 29 0a 20 20 20 20 69 6d 70 6f 72 74 73 24 20 69  ).    imports$ i
0eb0: 6d 70 6f 72 74 23 6e 65 77 20 62 6f 75 6e 64 73  mport#new bounds
0ec0: 20 44 4f 0a 09 31 20 49 20 69 6d 70 6f 72 74 73   DO..1 I imports
0ed0: 24 20 2d 20 6c 73 68 69 66 74 20 3e 69 6d 2d 63  $ - lshift >im-c
0ee0: 6f 6c 6f 72 0a 09 64 75 70 20 31 20 61 6e 64 20  olor..dup 1 and 
0ef0: 49 46 20 20 49 20 63 40 20 65 6d 69 74 20 20 54  IF  I c@ emit  T
0f00: 48 45 4e 20 20 32 2f 20 4c 4f 4f 50 0a 20 20 20  HEN  2/ LOOP.   
0f10: 20 64 72 6f 70 20 3c 64 65 66 61 75 6c 74 3e 20   drop <default> 
0f20: 3b 0a 0a 43 72 65 61 74 65 20 69 6d 70 6f 72 74  ;..Create import
0f30: 2d 6e 61 6d 65 24 0a 22 49 20 6d 79 73 65 6c 66  -name$."I myself
0f40: 22 20 73 2c 20 22 6d 61 6e 75 61 6c 22 20 73 2c  " s, "manual" s,
0f50: 20 22 73 63 61 6e 22 20 73 2c 20 22 63 68 61 74   "scan" s, "chat
0f60: 22 20 73 2c 20 22 64 68 74 22 20 73 2c 20 22 69  " s, "dht" s, "i
0f70: 6e 76 69 74 65 64 22 20 73 2c 20 22 75 6e 74 72  nvited" s, "untr
0f80: 75 73 74 65 64 22 20 73 2c 0a 0a 3a 20 2e 69 6d  usted" s,..: .im
0f90: 70 6f 72 74 2d 63 6f 6c 6f 72 73 20 28 20 2d 2d  port-colors ( --
0fa0: 20 29 0a 20 20 20 20 69 6d 70 6f 72 74 2d 6e 61   ).    import-na
0fb0: 6d 65 24 0a 20 20 20 20 69 6d 70 6f 72 74 23 75  me$.    import#u
0fc0: 6e 74 72 75 73 74 65 64 20 31 2b 20 30 20 3f 44  ntrusted 1+ 0 ?D
0fd0: 4f 0a 09 31 20 49 20 6c 73 68 69 66 74 20 3e 69  O..1 I lshift >i
0fe0: 6d 2d 63 6f 6c 6f 72 20 63 6f 75 6e 74 20 32 64  m-color count 2d
0ff0: 75 70 20 74 79 70 65 20 3c 64 65 66 61 75 6c 74  up type <default
1000: 3e 20 73 70 61 63 65 20 2b 20 61 6c 69 67 6e 65  > space + aligne
1010: 64 0a 20 20 20 20 4c 4f 4f 50 20 64 72 6f 70 20  d.    LOOP drop 
1020: 3b 0a 0a 5c 20 73 61 6d 70 6c 65 20 6b 65 79 0a  ;..\ sample key.
1030: 0a 6b 65 79 2d 65 6e 74 72 79 20 27 20 6e 65 77  .key-entry ' new
1040: 20 73 74 61 74 69 63 2d 61 20 77 69 74 68 2d 61   static-a with-a
1050: 6c 6c 6f 63 61 74 65 72 20 43 6f 6e 73 74 61 6e  llocater Constan
1060: 74 20 73 61 6d 70 6c 65 2d 6b 65 79 0a 0a 56 61  t sample-key..Va
1070: 72 69 61 62 6c 65 20 6b 65 79 23 20 5c 20 6b 65  riable key# \ ke
1080: 79 20 68 61 73 68 20 74 61 62 6c 65 0a 56 61 72  y hash table.Var
1090: 69 61 62 6c 65 20 6e 69 63 6b 23 20 5c 20 6e 69  iable nick# \ ni
10a0: 63 6b 20 68 61 73 68 20 74 61 62 6c 65 0a 0a 36  ck hash table..6
10b0: 34 56 61 72 69 61 62 6c 65 20 6b 65 79 2d 72 65  4Variable key-re
10c0: 61 64 2d 6f 66 66 73 65 74 0a 0a 3a 20 63 75 72  ad-offset..: cur
10d0: 72 65 6e 74 2d 6b 65 79 20 28 20 61 64 64 72 20  rent-key ( addr 
10e0: 75 20 2d 2d 20 6f 20 29 0a 20 20 20 20 32 64 75  u -- o ).    2du
10f0: 70 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 64  p key| key# #@ d
1100: 72 6f 70 0a 20 20 20 20 64 75 70 20 30 3d 20 49  rop.    dup 0= I
1110: 46 20 20 64 72 6f 70 20 2e 22 20 75 6e 6b 6e 6f  F  drop ." unkno
1120: 77 6e 20 6b 65 79 3a 20 22 20 38 35 74 79 70 65  wn key: " 85type
1130: 20 63 72 20 20 30 20 45 58 49 54 20 20 54 48 45   cr  0 EXIT  THE
1140: 4e 0a 20 20 20 20 63 65 6c 6c 2b 20 3e 6f 20 6b  N.    cell+ >o k
1150: 65 2d 70 6b 20 24 21 20 6f 20 6f 3e 20 3b 0a 0a  e-pk $! o o> ;..
1160: 56 61 72 69 61 62 6c 65 20 73 69 6d 2d 6e 69 63  Variable sim-nic
1170: 6b 21 0a 0a 3a 20 6e 69 63 6b 21 20 28 20 2d 2d  k!..: nick! ( --
1180: 20 29 20 73 69 6d 2d 6e 69 63 6b 21 20 40 20 3f   ) sim-nick! @ ?
1190: 45 58 49 54 20 20 6f 20 7b 20 77 5e 20 6f 70 74  EXIT  o { w^ opt
11a0: 72 20 7d 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20  r }.    ke-nick 
11b0: 24 40 20 6e 69 63 6b 23 20 23 40 20 64 30 3d 20  $@ nick# #@ d0= 
11c0: 49 46 0a 09 6f 70 74 72 20 63 65 6c 6c 20 6b 65  IF..optr cell ke
11d0: 2d 6e 69 63 6b 20 24 40 20 6e 69 63 6b 23 20 23  -nick $@ nick# #
11e0: 21 20 30 0a 20 20 20 20 45 4c 53 45 0a 09 6c 61  ! 0.    ELSE..la
11f0: 73 74 23 20 63 65 6c 6c 2b 20 24 40 6c 65 6e 20  st# cell+ $@len 
1200: 63 65 6c 6c 2f 0a 09 6f 70 74 72 20 63 65 6c 6c  cell/..optr cell
1210: 20 6c 61 73 74 23 20 63 65 6c 6c 2b 20 24 2b 21   last# cell+ $+!
1220: 0a 20 20 20 20 54 48 45 4e 20 20 6b 65 2d 6e 69  .    THEN  ke-ni
1230: 63 6b 23 20 21 20 3b 0a 0a 3a 20 23 2e 6e 69 63  ck# ! ;..: #.nic
1240: 6b 20 28 20 68 61 73 68 20 2d 2d 20 29 0a 20 20  k ( hash -- ).  
1250: 20 20 64 75 70 20 24 40 20 74 79 70 65 20 27 23    dup $@ type '#
1260: 27 20 65 6d 69 74 20 63 65 6c 6c 2b 20 24 40 6c  ' emit cell+ $@l
1270: 65 6e 20 63 65 6c 6c 2f 20 2e 20 3b 0a 0a 3a 20  en cell/ . ;..: 
1280: 6c 61 73 74 2d 70 65 74 40 20 28 20 2d 2d 20 61  last-pet@ ( -- a
1290: 64 64 72 20 75 20 29 0a 20 20 20 20 6b 65 2d 70  ddr u ).    ke-p
12a0: 65 74 73 5b 5d 20 24 5b 5d 23 20 3f 64 75 70 2d  ets[] $[]# ?dup-
12b0: 49 46 20 20 31 2d 20 6b 65 2d 70 65 74 73 5b 5d  IF  1- ke-pets[]
12c0: 20 24 5b 5d 40 20 20 45 4c 53 45 20 20 23 30 2e   $[]@  ELSE  #0.
12d0: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 70 65 74 21    THEN ;..: pet!
12e0: 20 28 20 2d 2d 20 29 20 73 69 6d 2d 6e 69 63 6b   ( -- ) sim-nick
12f0: 21 20 40 20 3f 45 58 49 54 20 20 6f 20 7b 20 77  ! @ ?EXIT  o { w
1300: 5e 20 6f 70 74 72 20 7d 0a 20 20 20 20 6c 61 73  ^ optr }.    las
1310: 74 2d 70 65 74 40 20 6e 69 63 6b 23 20 23 40 20  t-pet@ nick# #@ 
1320: 64 30 3d 20 49 46 0a 09 6f 70 74 72 20 63 65 6c  d0= IF..optr cel
1330: 6c 20 6c 61 73 74 2d 70 65 74 40 20 6e 69 63 6b  l last-pet@ nick
1340: 23 20 23 21 20 30 0a 20 20 20 20 45 4c 53 45 0a  # #! 0.    ELSE.
1350: 09 6c 61 73 74 23 20 63 65 6c 6c 2b 20 24 40 6c  .last# cell+ $@l
1360: 65 6e 20 63 65 6c 6c 2f 0a 09 6f 70 74 72 20 63  en cell/..optr c
1370: 65 6c 6c 20 6c 61 73 74 23 20 63 65 6c 6c 2b 20  ell last# cell+ 
1380: 24 2b 21 0a 20 20 20 20 54 48 45 4e 20 20 6b 65  $+!.    THEN  ke
1390: 2d 70 65 74 73 5b 5d 20 24 5b 5d 23 20 31 2d 20  -pets[] $[]# 1- 
13a0: 6b 65 2d 70 65 74 73 23 20 24 5b 5d 20 21 20 3b  ke-pets# $[] ! ;
13b0: 0a 0a 3a 20 6b 65 79 3a 6e 65 77 20 28 20 61 64  ..: key:new ( ad
13c0: 64 72 20 75 20 2d 2d 20 6f 20 29 0a 20 20 20 20  dr u -- o ).    
13d0: 5c 47 20 63 72 65 61 74 65 20 6e 65 77 20 6b 65  \G create new ke
13e0: 79 2c 20 61 64 64 72 20 75 20 69 73 20 74 68 65  y, addr u is the
13f0: 20 70 75 62 6c 69 63 20 6b 65 79 0a 20 20 20 20   public key.    
1400: 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 20 6b  sample-key >o  k
1410: 65 2d 73 6b 20 6b 65 2d 65 6e 64 20 6f 76 65 72  e-sk ke-end over
1420: 20 2d 20 65 72 61 73 65 0a 20 20 20 20 6b 65 79   - erase.    key
1430: 2d 65 6e 74 72 79 2d 74 61 62 6c 65 20 40 20 74  -entry-table @ t
1440: 6f 6b 65 6e 2d 74 61 62 6c 65 20 21 0a 20 20 20  oken-table !.   
1450: 20 3e 73 74 6f 72 65 6b 65 79 20 40 20 6b 65 2d   >storekey @ ke-
1460: 73 74 6f 72 65 6b 65 79 20 21 0a 20 20 20 20 6b  storekey !.    k
1470: 65 79 2d 72 65 61 64 2d 6f 66 66 73 65 74 20 36  ey-read-offset 6
1480: 34 40 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 21  4@ ke-offset 64!
1490: 0a 20 20 20 20 31 20 69 6d 70 6f 72 74 2d 74 79  .    1 import-ty
14a0: 70 65 20 40 20 6c 73 68 69 66 74 20 5b 20 31 20  pe @ lshift [ 1 
14b0: 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66  import#new lshif
14c0: 74 20 5d 4c 20 6f 72 20 6b 65 2d 69 6d 70 6f 72  t ]L or ke-impor
14d0: 74 73 20 21 0a 20 20 20 20 6b 65 79 70 61 63 6b  ts !.    keypack
14e0: 2d 61 6c 6c 23 20 6e 3e 36 34 20 6b 65 79 2d 72  -all# n>64 key-r
14f0: 65 61 64 2d 6f 66 66 73 65 74 20 36 34 2b 21 20  ead-offset 64+! 
1500: 6f 20 63 65 6c 6c 2d 20 6b 65 2d 65 6e 64 20 6f  o cell- ke-end o
1510: 76 65 72 20 2d 0a 20 20 20 20 32 6f 76 65 72 20  ver -.    2over 
1520: 6b 65 79 7c 20 6b 65 79 23 20 23 21 20 6f 3e 0a  key| key# #! o>.
1530: 20 20 20 20 63 75 72 72 65 6e 74 2d 6b 65 79 20      current-key 
1540: 3b 0a 0a 30 20 56 61 6c 75 65 20 6c 61 73 74 2d  ;..0 Value last-
1550: 6b 65 79 0a 0a 3a 20 6b 65 79 3f 6e 65 77 20 28  key..: key?new (
1560: 20 61 64 64 72 20 75 20 2d 2d 20 6f 20 29 0a 20   addr u -- o ). 
1570: 20 20 20 5c 47 20 43 72 65 61 74 65 20 6f 72 20     \G Create or 
1580: 6c 6f 6f 6b 75 70 20 6e 65 77 20 6b 65 79 0a 20  lookup new key. 
1590: 20 20 20 32 64 75 70 20 6b 65 79 7c 20 6b 65 79     2dup key| key
15a0: 23 20 23 40 20 64 72 6f 70 0a 20 20 20 20 64 75  # #@ drop.    du
15b0: 70 20 30 3d 20 49 46 20 20 64 72 6f 70 20 6b 65  p 0= IF  drop ke
15c0: 79 3a 6e 65 77 0a 20 20 20 20 45 4c 53 45 20 20  y:new.    ELSE  
15d0: 6e 69 70 20 6e 69 70 20 63 65 6c 6c 2b 20 20 31  nip nip cell+  1
15e0: 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 40 20 6c   import-type @ l
15f0: 73 68 69 66 74 20 6f 76 65 72 20 2e 6b 65 2d 69  shift over .ke-i
1600: 6d 70 6f 72 74 73 20 6f 72 21 20 20 54 48 45 4e  mports or!  THEN
1610: 0a 20 20 20 20 64 75 70 20 74 6f 20 6c 61 73 74  .    dup to last
1620: 2d 6b 65 79 20 3b 0a 0a 5c 20 73 65 61 72 63 68  -key ;..\ search
1630: 20 66 6f 72 20 6b 65 79 73 20 2d 20 6e 6f 74 20   for keys - not 
1640: 6f 70 74 69 6d 69 7a 65 64 0a 0a 3a 20 23 73 70  optimized..: #sp
1650: 6c 69 74 20 28 20 61 64 64 72 20 75 20 2d 2d 20  lit ( addr u -- 
1660: 61 64 64 72 20 75 20 6e 20 29 0a 20 20 20 20 5b  addr u n ).    [
1670: 3a 20 32 64 75 70 20 27 23 27 20 2d 73 63 61 6e  : 2dup '#' -scan
1680: 20 6e 69 70 20 3e 72 0a 20 20 20 20 20 20 72 40   nip >r.      r@
1690: 20 30 3d 20 49 46 20 20 72 64 72 6f 70 20 30 20   0= IF  rdrop 0 
16a0: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20   EXIT  THEN.    
16b0: 20 20 23 30 2e 20 32 6f 76 65 72 20 72 40 20 2f    #0. 2over r@ /
16c0: 73 74 72 69 6e 67 20 3e 6e 75 6d 62 65 72 0a 20  string >number. 
16d0: 20 20 20 20 20 30 3d 20 49 46 20 20 6e 69 70 20       0= IF  nip 
16e0: 64 72 6f 70 20 6e 69 70 20 72 3e 20 31 2d 20 73  drop nip r> 1- s
16f0: 77 61 70 20 20 45 4c 53 45 0a 09 20 20 72 64 72  wap  ELSE..  rdr
1700: 6f 70 20 64 72 6f 70 20 32 64 72 6f 70 20 30 20  op drop 2drop 0 
1710: 20 20 54 48 45 4e 20 3b 5d 20 23 31 30 20 62 61    THEN ;] #10 ba
1720: 73 65 2d 65 78 65 63 75 74 65 20 3b 0a 0a 3a 20  se-execute ;..: 
1730: 6e 69 63 6b 2d 6b 65 79 20 28 20 61 64 64 72 20  nick-key ( addr 
1740: 75 20 2d 2d 20 6f 20 2f 20 30 20 29 20 5c 20 73  u -- o / 0 ) \ s
1750: 65 61 72 63 68 20 66 6f 72 20 6b 65 79 20 6e 69  earch for key ni
1760: 63 6b 6e 61 6d 65 0a 20 20 20 20 23 73 70 6c 69  ckname.    #spli
1770: 74 20 3e 72 20 6e 69 63 6b 23 20 23 40 20 32 64  t >r nick# #@ 2d
1780: 75 70 20 64 30 3d 20 49 46 20 20 72 64 72 6f 70  up d0= IF  rdrop
1790: 20 64 72 6f 70 20 20 45 58 49 54 20 20 54 48 45   drop  EXIT  THE
17a0: 4e 0a 20 20 20 20 72 3e 20 63 65 6c 6c 73 20 73  N.    r> cells s
17b0: 61 66 65 2f 73 74 72 69 6e 67 20 30 3d 20 49 46  afe/string 0= IF
17c0: 20 20 64 72 6f 70 20 30 20 20 45 58 49 54 20 20    drop 0  EXIT  
17d0: 54 48 45 4e 20 20 40 20 3b 0a 0a 3a 20 73 65 63  THEN  @ ;..: sec
17e0: 72 65 74 2d 6b 65 79 73 23 20 28 20 2d 2d 20 6e  ret-keys# ( -- n
17f0: 20 29 0a 20 20 20 20 30 20 6b 65 79 23 20 5b 3a   ).    0 key# [:
1800: 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 20 63   cell+ $@ drop c
1810: 65 6c 6c 2b 20 3e 6f 20 6b 65 2d 73 6b 20 40 20  ell+ >o ke-sk @ 
1820: 30 3c 3e 20 2d 20 6f 3e 20 3b 5d 20 23 6d 61 70  0<> - o> ;] #map
1830: 20 3b 0a 3a 20 73 65 63 72 65 74 2d 6b 65 79 20   ;.: secret-key 
1840: 28 20 6e 20 2d 2d 20 6f 2f 30 20 29 0a 20 20 20  ( n -- o/0 ).   
1850: 20 30 20 74 75 63 6b 20 6b 65 79 23 20 5b 3a 20   0 tuck key# [: 
1860: 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 20 63 65  cell+ $@ drop ce
1870: 6c 6c 2b 20 3e 6f 20 6b 65 2d 73 6b 20 40 20 49  ll+ >o ke-sk @ I
1880: 46 0a 09 20 20 32 64 75 70 20 3d 20 49 46 20 20  F..  2dup = IF  
1890: 72 6f 74 20 64 72 6f 70 20 6f 20 2d 72 6f 74 20  rot drop o -rot 
18a0: 20 54 48 45 4e 20 20 31 2b 0a 20 20 20 20 20 20   THEN  1+.      
18b0: 54 48 45 4e 20 20 6f 3e 20 3b 5d 20 23 6d 61 70  THEN  o> ;] #map
18c0: 20 32 64 72 6f 70 20 3b 0a 3a 20 2e 23 20 28 20   2drop ;.: .# ( 
18d0: 6e 20 2d 2d 20 29 20 3f 64 75 70 2d 49 46 20 20  n -- ) ?dup-IF  
18e0: 27 23 27 20 65 6d 69 74 20 30 20 2e 72 20 20 54  '#' emit 0 .r  T
18f0: 48 45 4e 20 3b 0a 3a 20 2e 6e 69 63 6b 2d 62 61  HEN ;.: .nick-ba
1900: 73 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a  se ( o:key -- ).
1910: 20 20 20 20 6b 65 2d 6e 69 63 6b 20 24 2e 20 20      ke-nick $.  
1920: 6b 65 2d 6e 69 63 6b 23 20 40 20 2e 23 20 3b 0a  ke-nick# @ .# ;.
1930: 3a 20 2e 70 65 74 2d 62 61 73 65 20 28 20 6f 3a  : .pet-base ( o:
1940: 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 30 20 6b  key -- ).    0 k
1950: 65 2d 70 65 74 73 5b 5d 20 5b 3a 20 73 70 61 63  e-pets[] [: spac
1960: 65 20 74 79 70 65 0a 20 20 20 20 20 20 64 75 70  e type.      dup
1970: 20 6b 65 2d 70 65 74 73 23 20 24 5b 5d 20 40 20   ke-pets# $[] @ 
1980: 2e 23 20 20 31 2b 20 3b 5d 20 24 5b 5d 6d 61 70  .#  1+ ;] $[]map
1990: 20 64 72 6f 70 20 3b 0a 3a 20 2e 70 65 74 30 2d   drop ;.: .pet0-
19a0: 62 61 73 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20  base ( o:key -- 
19b0: 29 0a 20 20 20 20 6b 65 2d 70 65 74 73 5b 5d 20  ).    ke-pets[] 
19c0: 24 5b 5d 23 20 49 46 20 20 30 20 6b 65 2d 70 65  $[]# IF  0 ke-pe
19d0: 74 73 5b 5d 20 24 5b 5d 40 20 74 79 70 65 20 30  ts[] $[]@ type 0
19e0: 20 6b 65 2d 70 65 74 73 23 20 24 5b 5d 20 40 20   ke-pets# $[] @ 
19f0: 2e 23 0a 20 20 20 20 45 4c 53 45 20 20 2e 6e 69  .#.    ELSE  .ni
1a00: 63 6b 2d 62 61 73 65 20 20 54 48 45 4e 20 3b 0a  ck-base  THEN ;.
1a10: 3a 20 2e 72 65 61 6c 2d 6e 69 63 6b 20 28 20 6f  : .real-nick ( o
1a20: 3a 6b 65 79 20 2d 2d 20 29 20 20 20 6b 65 2d 69  :key -- )   ke-i
1a30: 6d 70 6f 72 74 73 20 40 20 3e 69 6d 2d 63 6f 6c  mports @ >im-col
1a40: 6f 72 20 2e 6e 69 63 6b 2d 62 61 73 65 20 3c 64  or .nick-base <d
1a50: 65 66 61 75 6c 74 3e 20 3b 0a 3a 20 2e 6e 69 63  efault> ;.: .nic
1a60: 6b 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 20 20  k ( o:key -- )  
1a70: 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e 69   ke-imports @ >i
1a80: 6d 2d 63 6f 6c 6f 72 20 2e 70 65 74 30 2d 62 61  m-color .pet0-ba
1a90: 73 65 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 3a  se <default> ;.:
1aa0: 20 2e 6e 69 63 6b 2b 70 65 74 20 28 20 6f 3a 6b   .nick+pet ( o:k
1ab0: 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 69  ey -- ).    ke-i
1ac0: 6d 70 6f 72 74 73 20 40 20 3e 69 6d 2d 63 6f 6c  mports @ >im-col
1ad0: 6f 72 20 2e 6e 69 63 6b 2d 62 61 73 65 20 2e 70  or .nick-base .p
1ae0: 65 74 2d 62 61 73 65 20 3c 64 65 66 61 75 6c 74  et-base <default
1af0: 3e 20 3b 0a 0a 3a 20 6e 69 63 6b 3e 70 6b 20 28  > ;..: nick>pk (
1b00: 20 6e 69 63 6b 20 75 20 2d 2d 20 70 6b 20 75 20   nick u -- pk u 
1b10: 29 0a 20 20 20 20 6e 69 63 6b 2d 6b 65 79 20 3f  ).    nick-key ?
1b20: 64 75 70 2d 49 46 20 2e 6b 65 2d 70 6b 20 24 40  dup-IF .ke-pk $@
1b30: 20 45 4c 53 45 20 30 20 30 20 54 48 45 4e 20 3b   ELSE 0 0 THEN ;
1b40: 0a 3a 20 68 6f 73 74 2e 6e 69 63 6b 3e 70 6b 20  .: host.nick>pk 
1b50: 28 20 61 64 64 72 20 75 20 2d 2d 20 70 6b 20 75  ( addr u -- pk u
1b60: 27 20 29 0a 20 20 20 20 27 2e 27 20 24 73 70 6c  ' ).    '.' $spl
1b70: 69 74 20 64 75 70 20 30 3d 20 49 46 20 20 32 73  it dup 0= IF  2s
1b80: 77 61 70 20 20 54 48 45 4e 20 5b 3a 20 6e 69 63  wap  THEN [: nic
1b90: 6b 3e 70 6b 20 74 79 70 65 20 74 79 70 65 20 3b  k>pk type type ;
1ba0: 5d 20 24 74 6d 70 20 3b 0a 0a 3a 20 6b 65 79 2d  ] $tmp ;..: key-
1bb0: 65 78 69 73 74 3f 20 28 20 61 64 64 72 20 75 20  exist? ( addr u 
1bc0: 2d 2d 20 6f 2f 30 20 29 0a 20 20 20 20 6b 65 79  -- o/0 ).    key
1bd0: 23 20 23 40 20 49 46 20 20 63 65 6c 6c 2b 20 20  # #@ IF  cell+  
1be0: 54 48 45 4e 20 3b 20 0a 0a 5c 20 70 65 72 6d 69  THEN ; ..\ permi
1bf0: 73 73 69 6f 6e 20 6d 6f 64 69 66 69 63 61 74 69  ssion modificati
1c00: 6f 6e 0a 0a 32 36 20 62 75 66 66 65 72 3a 20 70  on..26 buffer: p
1c10: 65 72 6d 2d 63 68 61 72 73 0a 30 20 70 65 72 6d  erm-chars.0 perm
1c20: 24 20 63 6f 75 6e 74 20 62 6f 75 6e 64 73 20 5b  $ count bounds [
1c30: 44 4f 5d 20 64 75 70 20 5b 49 5d 20 63 40 20 27  DO] dup [I] c@ '
1c40: 61 27 20 2d 20 70 65 72 6d 2d 63 68 61 72 73 20  a' - perm-chars 
1c50: 2b 20 63 21 20 31 2b 20 5b 4c 4f 4f 50 5d 20 64  + c! 1+ [LOOP] d
1c60: 72 6f 70 0a 0a 3a 20 2e 70 65 72 6d 20 28 20 70  rop..: .perm ( p
1c70: 65 72 6d 69 73 73 69 6f 6e 20 2d 2d 20 29 20 20  ermission -- )  
1c80: 31 20 70 65 72 6d 24 20 63 6f 75 6e 74 20 62 6f  1 perm$ count bo
1c90: 75 6e 64 73 20 44 4f 0a 09 32 64 75 70 20 61 6e  unds DO..2dup an
1ca0: 64 20 30 3c 3e 20 49 20 63 40 20 27 2d 27 20 72  d 0<> I c@ '-' r
1cb0: 6f 74 20 73 65 6c 65 63 74 20 65 6d 69 74 20 32  ot select emit 2
1cc0: 2a 0a 20 20 20 20 4c 4f 4f 50 20 20 32 64 72 6f  *.    LOOP  2dro
1cd0: 70 20 3b 0a 3a 20 70 65 72 6d 61 6e 64 20 28 20  p ;.: permand ( 
1ce0: 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72 20 6e  permand permor n
1cf0: 65 77 20 2d 2d 20 70 65 72 6d 61 6e 64 27 20 70  ew -- permand' p
1d00: 65 72 6d 6f 72 20 29 0a 20 20 20 20 69 6e 76 65  ermor ).    inve
1d10: 72 74 20 74 75 63 6b 20 61 6e 64 20 3e 72 20 61  rt tuck and >r a
1d20: 6e 64 20 72 3e 20 3b 0a 3a 20 3e 70 65 72 6d 2d  nd r> ;.: >perm-
1d30: 6d 6f 64 20 28 20 70 65 72 6d 61 6e 64 20 70 65  mod ( permand pe
1d40: 72 6d 6f 72 20 2d 2d 20 70 65 72 6d 61 6e 64 27  rmor -- permand'
1d50: 20 70 65 72 6d 6f 72 20 29 0a 20 20 20 20 73 77   permor ).    sw
1d60: 61 70 20 64 75 70 20 30 3d 20 49 46 20 20 64 72  ap dup 0= IF  dr
1d70: 6f 70 20 64 75 70 20 69 6e 76 65 72 74 20 20 54  op dup invert  T
1d80: 48 45 4e 20 73 77 61 70 20 3b 0a 3a 20 3e 70 65  HEN swap ;.: >pe
1d90: 72 6d 20 28 20 61 64 64 72 20 75 20 2d 2d 20 70  rm ( addr u -- p
1da0: 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72 20 29 0a  ermand permor ).
1db0: 20 20 20 20 5c 47 20 70 61 72 73 65 20 70 65 72      \G parse per
1dc0: 6d 69 73 73 69 6f 6e 73 3a 20 2b 20 61 64 64 73  missions: + adds
1dd0: 2c 20 2d 20 72 65 6d 6f 76 65 73 20 70 65 72 6d  , - removes perm
1de0: 69 73 73 69 6f 6e 73 2c 0a 20 20 20 20 5c 47 20  issions,.    \G 
1df0: 6e 6f 20 6d 6f 64 69 66 69 65 72 20 73 65 74 73  no modifier sets
1e00: 20 70 65 72 6d 69 73 73 6f 6e 73 2e 0a 20 20 20   permissons..   
1e10: 20 30 20 30 20 5b 27 5d 20 6f 72 20 7b 20 78 74   0 0 ['] or { xt
1e20: 20 7d 0a 20 20 20 20 32 73 77 61 70 20 62 6f 75   }.    2swap bou
1e30: 6e 64 73 20 3f 44 4f 0a 09 49 20 63 40 20 63 61  nds ?DO..I c@ ca
1e40: 73 65 0a 09 20 20 20 20 27 2b 27 20 6f 66 20 20  se..    '+' of  
1e50: 3e 70 65 72 6d 2d 6d 6f 64 20 5b 27 5d 20 6f 72  >perm-mod ['] or
1e60: 20 74 6f 20 78 74 20 65 6e 64 6f 66 0a 09 20 20   to xt endof..  
1e70: 20 20 27 2d 27 20 6f 66 20 20 3e 70 65 72 6d 2d    '-' of  >perm-
1e80: 6d 6f 64 20 5b 27 5d 20 70 65 72 6d 61 6e 64 20  mod ['] permand 
1e90: 74 6f 20 78 74 20 20 65 6e 64 6f 66 0a 09 20 20  to xt  endof..  
1ea0: 20 20 27 3d 27 20 6f 66 20 20 32 64 72 6f 70 20    '=' of  2drop 
1eb0: 70 65 72 6d 25 64 65 66 61 75 6c 74 20 64 75 70  perm%default dup
1ec0: 20 5b 27 5d 20 6f 72 20 74 6f 20 78 74 20 20 65   ['] or to xt  e
1ed0: 6e 64 6f 66 0a 09 20 20 20 20 27 61 27 20 2d 20  ndof..    'a' - 
1ee0: 64 75 70 20 27 7a 27 20 75 3c 3d 20 20 49 46 0a  dup 'z' u<=  IF.
1ef0: 09 09 70 65 72 6d 2d 63 68 61 72 73 20 2b 20 63  ..perm-chars + c
1f00: 40 20 31 20 73 77 61 70 20 6c 73 68 69 66 74 20  @ 1 swap lshift 
1f10: 78 74 20 65 78 65 63 75 74 65 0a 09 09 30 20 28  xt execute...0 (
1f20: 20 64 75 6d 6d 79 20 66 6f 72 20 65 6e 64 63 61   dummy for endca
1f30: 73 65 20 29 0a 09 20 20 20 20 54 48 45 4e 20 20  se )..    THEN  
1f40: 65 6e 64 63 61 73 65 0a 20 20 20 20 4c 4f 4f 50  endcase.    LOOP
1f50: 20 3b 0a 3a 20 2e 70 65 72 6d 61 6e 64 6f 72 20   ;.: .permandor 
1f60: 28 20 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72  ( permand permor
1f70: 20 2d 2d 20 29 0a 20 20 20 20 30 20 7b 20 2b 2d   -- ).    0 { +-
1f80: 20 7d 0a 20 20 20 20 31 20 70 65 72 6d 24 20 63   }.    1 perm$ c
1f90: 6f 75 6e 74 20 62 6f 75 6e 64 73 20 44 4f 20 20  ount bounds DO  
1fa0: 3e 72 0a 09 6f 76 65 72 20 72 40 20 61 6e 64 20  >r..over r@ and 
1fb0: 30 3d 20 49 46 20 20 27 2d 27 20 64 75 70 20 2b  0= IF  '-' dup +
1fc0: 2d 20 3c 3e 20 49 46 20 20 64 75 70 20 74 6f 20  - <> IF  dup to 
1fd0: 2b 2d 20 65 6d 69 74 0a 09 20 20 20 20 45 4c 53  +- emit..    ELS
1fe0: 45 20 20 64 72 6f 70 20 20 54 48 45 4e 20 72 3e  E  drop  THEN r>
1ff0: 20 20 49 20 63 40 20 65 6d 69 74 20 20 3e 72 20    I c@ emit  >r 
2000: 54 48 45 4e 0a 09 64 75 70 20 20 72 40 20 61 6e  THEN..dup  r@ an
2010: 64 20 20 20 20 49 46 20 20 27 2b 27 20 64 75 70  d    IF  '+' dup
2020: 20 2b 2d 20 3c 3e 20 49 46 20 20 64 75 70 20 74   +- <> IF  dup t
2030: 6f 20 2b 2d 20 65 6d 69 74 0a 09 20 20 20 20 45  o +- emit..    E
2040: 4c 53 45 20 20 64 72 6f 70 20 20 54 48 45 4e 20  LSE  drop  THEN 
2050: 72 3e 20 20 49 20 63 40 20 65 6d 69 74 20 20 3e  r>  I c@ emit  >
2060: 72 20 54 48 45 4e 0a 09 72 3e 20 32 2a 0a 20 20  r THEN..r> 2*.  
2070: 20 20 4c 4f 4f 50 20 20 64 72 6f 70 20 32 64 72    LOOP  drop 2dr
2080: 6f 70 20 3b 0a 0a 5c 20 72 65 61 64 20 69 6e 20  op ;..\ read in 
2090: 70 65 72 6d 69 73 73 69 6f 6e 20 67 72 6f 75 70  permission group
20a0: 73 2c 20 67 72 6f 75 70 73 20 69 73 20 69 6e 20  s, groups is in 
20b0: 74 68 65 20 2e 6e 65 74 32 6f 20 64 69 72 65 63  the .net2o direc
20c0: 74 6f 72 79 0a 0a 3a 20 3e 67 72 6f 75 70 2d 69  tory..: >group-i
20d0: 64 20 28 20 61 64 64 72 20 75 20 2d 2d 20 69 64  d ( addr u -- id
20e0: 2f 2d 31 20 29 0a 20 20 20 20 2d 31 20 30 20 67  /-1 ).    -1 0 g
20f0: 72 6f 75 70 73 5b 5d 20 5b 3a 20 32 73 77 61 70  roups[] [: 2swap
2100: 20 32 3e 72 20 32 20 63 65 6c 6c 73 20 2f 73 74   2>r 2 cells /st
2110: 72 69 6e 67 0a 20 20 20 20 20 20 32 6f 76 65 72  ring.      2over
2120: 20 73 74 72 69 6e 67 2d 70 72 65 66 69 78 3f 20   string-prefix? 
2130: 49 46 20 20 32 72 3e 20 6e 69 70 20 64 75 70 0a  IF  2r> nip dup.
2140: 20 20 20 20 20 20 45 4c 53 45 20 20 32 72 3e 20        ELSE  2r> 
2150: 20 54 48 45 4e 20 20 31 2b 20 3b 5d 20 24 5b 5d   THEN  1+ ;] $[]
2160: 6d 61 70 0a 20 20 20 20 32 6e 69 70 20 64 72 6f  map.    2nip dro
2170: 70 20 3b 0a 0a 3a 20 3e 67 72 6f 75 70 73 20 28  p ;..: >groups (
2180: 20 61 64 64 72 20 75 20 70 61 6e 64 20 70 6f 72   addr u pand por
2190: 20 2d 2d 20 29 0a 20 20 20 20 73 22 20 22 20 67   -- ).    s" " g
21a0: 72 6f 75 70 73 5b 5d 20 24 2b 5b 5d 21 0a 20 20  roups[] $+[]!.  
21b0: 20 20 5b 3a 20 7b 20 64 5e 20 70 61 6e 64 6f 72    [: { d^ pandor
21c0: 20 7d 20 70 61 6e 64 6f 72 20 32 20 63 65 6c 6c   } pandor 2 cell
21d0: 73 20 74 79 70 65 20 20 74 79 70 65 20 3b 5d 0a  s type  type ;].
21e0: 20 20 20 20 67 72 6f 75 70 73 5b 5d 20 64 75 70      groups[] dup
21f0: 20 24 5b 5d 23 20 31 2d 20 73 77 61 70 20 24 5b   $[]# 1- swap $[
2200: 5d 20 24 65 78 65 63 20 3b 0a 0a 3a 20 69 6e 69  ] $exec ;..: ini
2210: 74 2d 67 72 6f 75 70 73 20 28 20 2d 2d 20 29 0a  t-groups ( -- ).
2220: 20 20 20 20 22 6d 79 73 65 6c 66 22 20 20 70 65      "myself"  pe
2230: 72 6d 25 6d 79 73 65 6c 66 20 20 64 75 70 20 3e  rm%myself  dup >
2240: 67 72 6f 75 70 73 0a 20 20 20 20 22 70 65 65 72  groups.    "peer
2250: 22 20 20 20 20 70 65 72 6d 25 64 65 66 61 75 6c  "    perm%defaul
2260: 74 20 64 75 70 20 3e 67 72 6f 75 70 73 0a 20 20  t dup >groups.  
2270: 20 20 22 64 68 74 22 20 20 20 20 20 70 65 72 6d    "dht"     perm
2280: 25 64 68 74 72 6f 6f 74 20 64 75 70 20 3e 67 72  %dhtroot dup >gr
2290: 6f 75 70 73 0a 20 20 20 20 22 75 6e 6b 6e 6f 77  oups.    "unknow
22a0: 6e 22 20 70 65 72 6d 25 75 6e 6b 6e 6f 77 6e 20  n" perm%unknown 
22b0: 64 75 70 20 3e 67 72 6f 75 70 73 0a 20 20 20 20  dup >groups.    
22c0: 22 62 6c 6f 63 6b 65 64 22 20 70 65 72 6d 25 62  "blocked" perm%b
22d0: 6c 6f 63 6b 65 64 20 70 65 72 6d 25 69 6e 64 69  locked perm%indi
22e0: 72 65 63 74 20 6f 72 20 64 75 70 20 3e 67 72 6f  rect or dup >gro
22f0: 75 70 73 20 3b 0a 0a 3a 20 2e 67 72 6f 75 70 73  ups ;..: .groups
2300: 20 28 20 2d 2d 20 29 0a 20 20 20 20 67 72 6f 75   ( -- ).    grou
2310: 70 73 5b 5d 20 5b 3a 20 32 64 75 70 20 32 20 63  ps[] [: 2dup 2 c
2320: 65 6c 6c 73 20 2f 73 74 72 69 6e 67 20 74 79 70  ells /string typ
2330: 65 20 73 70 61 63 65 0a 20 20 20 20 20 20 64 72  e space.      dr
2340: 6f 70 20 32 40 20 2e 70 65 72 6d 61 6e 64 6f 72  op 2@ .permandor
2350: 20 63 72 20 3b 5d 20 24 5b 5d 6d 61 70 20 3b 0a   cr ;] $[]map ;.
2360: 0a 3a 20 2e 69 6e 2d 67 72 6f 75 70 73 20 28 20  .: .in-groups ( 
2370: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20  addr u -- ).    
2380: 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 20 70 40  bounds ?DO..I p@
2390: 2b 20 49 20 2d 20 3e 72 20 36 34 3e 6e 20 67 72  + I - >r 64>n gr
23a0: 6f 75 70 73 5b 5d 20 24 5b 5d 40 20 32 20 63 65  oups[] $[]@ 2 ce
23b0: 6c 6c 73 20 2f 73 74 72 69 6e 67 20 73 70 61 63  lls /string spac
23c0: 65 20 74 79 70 65 0a 20 20 20 20 72 3e 20 2b 4c  e type.    r> +L
23d0: 4f 4f 50 20 3b 0a 0a 3a 20 77 72 69 74 65 2d 67  OOP ;..: write-g
23e0: 72 6f 75 70 73 20 28 20 2d 2d 20 29 0a 20 20 20  roups ( -- ).   
23f0: 20 5b 3a 20 2e 22 20 67 72 6f 75 70 73 2b 22 20   [: ." groups+" 
2400: 67 65 74 70 69 64 20 30 20 2e 72 20 3b 5d 20 24  getpid 0 .r ;] $
2410: 74 6d 70 20 2e 6e 65 74 32 6f 2f 20 32 64 75 70  tmp .net2o/ 2dup
2420: 20 77 2f 6f 20 63 72 65 61 74 65 2d 66 69 6c 65   w/o create-file
2430: 20 74 68 72 6f 77 20 3e 72 0a 20 20 20 20 5b 27   throw >r.    ['
2440: 5d 20 2e 67 72 6f 75 70 73 20 72 40 20 6f 75 74  ] .groups r@ out
2450: 66 69 6c 65 2d 65 78 65 63 75 74 65 0a 20 20 20  file-execute.   
2460: 20 72 3e 20 63 6c 6f 73 65 2d 66 69 6c 65 20 74   r> close-file t
2470: 68 72 6f 77 20 27 2b 27 20 2d 73 63 61 6e 20 31  hrow '+' -scan 1
2480: 2d 20 3e 62 61 63 6b 75 70 20 3b 0a 0a 3a 20 67  - >backup ;..: g
2490: 72 6f 75 70 2d 6c 69 6e 65 20 28 20 2d 2d 20 29  roup-line ( -- )
24a0: 0a 20 20 20 20 70 61 72 73 65 2d 6e 61 6d 65 20  .    parse-name 
24b0: 70 61 72 73 65 2d 6e 61 6d 65 20 3e 70 65 72 6d  parse-name >perm
24c0: 20 3e 67 72 6f 75 70 73 20 3b 0a 0a 3a 20 72 65   >groups ;..: re
24d0: 61 64 2d 67 72 6f 75 70 73 2d 6c 6f 6f 70 20 28  ad-groups-loop (
24e0: 20 2d 2d 20 29 0a 20 20 20 20 42 45 47 49 4e 20   -- ).    BEGIN 
24f0: 20 72 65 66 69 6c 6c 20 20 57 48 49 4c 45 20 20   refill  WHILE  
2500: 67 72 6f 75 70 2d 6c 69 6e 65 20 20 52 45 50 45  group-line  REPE
2510: 41 54 20 3b 0a 0a 3a 20 72 65 61 64 2d 67 72 6f  AT ;..: read-gro
2520: 75 70 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 22  ups ( -- ).    "
2530: 67 72 6f 75 70 73 22 20 2e 6e 65 74 32 6f 2f 20  groups" .net2o/ 
2540: 32 64 75 70 20 66 69 6c 65 2d 73 74 61 74 75 73  2dup file-status
2550: 20 6e 69 70 20 6e 6f 2d 66 69 6c 65 23 20 3d 20   nip no-file# = 
2560: 49 46 0a 09 69 6e 69 74 2d 67 72 6f 75 70 73 20  IF..init-groups 
2570: 77 72 69 74 65 2d 67 72 6f 75 70 73 20 32 64 72  write-groups 2dr
2580: 6f 70 20 20 45 58 49 54 0a 20 20 20 20 54 48 45  op  EXIT.    THE
2590: 4e 20 20 3e 69 6e 63 6c 75 64 65 64 20 74 68 72  N  >included thr
25a0: 6f 77 0a 20 20 20 20 5b 27 5d 20 72 65 61 64 2d  ow.    ['] read-
25b0: 67 72 6f 75 70 73 2d 6c 6f 6f 70 20 65 78 65 63  groups-loop exec
25c0: 75 74 65 2d 70 61 72 73 69 6e 67 2d 6e 61 6d 65  ute-parsing-name
25d0: 64 2d 66 69 6c 65 20 3b 0a 0a 3a 20 67 72 6f 75  d-file ;..: grou
25e0: 70 73 3e 6d 61 73 6b 20 28 20 61 64 64 72 20 75  ps>mask ( addr u
25f0: 20 2d 2d 20 6d 61 73 6b 20 29 0a 20 20 20 20 30   -- mask ).    0
2600: 20 2d 72 6f 74 20 62 6f 75 6e 64 73 20 3f 44 4f   -rot bounds ?DO
2610: 0a 09 49 20 70 40 2b 20 49 20 2d 20 3e 72 0a 09  ..I p@+ I - >r..
2620: 36 34 3e 6e 20 64 75 70 20 67 72 6f 75 70 73 5b  64>n dup groups[
2630: 5d 20 24 5b 5d 23 20 75 3e 3d 20 21 21 6e 6f 2d  ] $[]# u>= !!no-
2640: 67 72 6f 75 70 21 21 0a 09 67 72 6f 75 70 73 5b  group!!..groups[
2650: 5d 20 24 5b 5d 40 20 64 72 6f 70 20 32 40 20 3e  ] $[]@ drop 2@ >
2660: 72 20 61 6e 64 20 72 3e 20 6f 72 0a 20 20 20 20  r and r> or.    
2670: 72 3e 20 2b 4c 4f 4f 50 20 3b 0a 0a 3a 20 3f 3e  r> +LOOP ;..: ?>
2680: 67 72 6f 75 70 73 20 28 20 6d 61 73 6b 20 2d 2d  groups ( mask --
2690: 20 6d 61 73 6b 27 20 29 0a 20 20 20 20 6b 65 2d   mask' ).    ke-
26a0: 67 72 6f 75 70 73 20 24 40 6c 65 6e 20 30 3d 20  groups $@len 0= 
26b0: 49 46 0a 09 67 72 6f 75 70 73 5b 5d 20 24 5b 5d  IF..groups[] $[]
26c0: 23 20 30 20 44 4f 0a 09 20 20 20 20 64 75 70 20  # 0 DO..    dup 
26d0: 49 20 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 40 20  I groups[] $[]@ 
26e0: 64 72 6f 70 20 40 0a 09 20 20 20 20 6f 72 20 6f  drop @..    or o
26f0: 76 65 72 20 3d 20 49 46 0a 09 09 49 20 6b 65 2d  ver = IF...I ke-
2700: 67 72 6f 75 70 73 20 63 24 2b 21 0a 09 09 49 20  groups c$+!...I 
2710: 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 40 20 64 72  groups[] $[]@ dr
2720: 6f 70 20 63 65 6c 6c 2b 20 40 20 69 6e 76 65 72  op cell+ @ inver
2730: 74 20 61 6e 64 0a 09 20 20 20 20 54 48 45 4e 0a  t and..    THEN.
2740: 09 4c 4f 4f 50 0a 20 20 20 20 54 48 45 4e 20 20  .LOOP.    THEN  
2750: 64 72 6f 70 20 3b 0a 0a 3a 6e 6f 6e 61 6d 65 20  drop ;..:noname 
2760: 64 65 66 65 72 73 20 27 63 6f 6c 64 20 20 67 72  defers 'cold  gr
2770: 6f 75 70 73 5b 5d 20 6f 66 66 20 72 65 61 64 2d  oups[] off read-
2780: 67 72 6f 75 70 73 20 3b 20 69 73 20 27 63 6f 6c  groups ; is 'col
2790: 64 0a 0a 5c 20 6b 65 79 20 64 69 73 70 6c 61 79  d..\ key display
27a0: 0a 0a 5b 49 46 55 4e 44 45 46 5d 20 6d 61 67 65  ..[IFUNDEF] mage
27b0: 6e 74 61 20 20 62 72 6f 77 6e 20 63 6f 6e 73 74  nta  brown const
27c0: 61 6e 74 20 6d 61 67 65 6e 74 61 20 5b 54 48 45  ant magenta [THE
27d0: 4e 5d 0a 5b 49 46 44 45 46 5d 20 67 6c 2d 74 79  N].[IFDEF] gl-ty
27e0: 70 65 20 3a 20 62 67 7c 20 3e 62 67 20 6f 72 20  pe : bg| >bg or 
27f0: 3b 20 5b 45 4c 53 45 5d 20 3a 20 62 67 7c 20 64  ; [ELSE] : bg| d
2800: 72 6f 70 20 3b 20 5b 54 48 45 4e 5d 0a 0a 43 72  rop ; [THEN]..Cr
2810: 65 61 74 65 20 38 35 63 6f 6c 6f 72 73 2d 62 77  eate 85colors-bw
2820: 0a 30 20 2c 20 69 6e 76 65 72 73 20 2c 0a 69 6e  .0 , invers ,.in
2830: 76 65 72 73 20 2c 20 30 20 2c 0a 30 20 2c 20 69  vers , 0 ,.0 , i
2840: 6e 76 65 72 73 20 2c 0a 69 6e 76 65 72 73 20 2c  nvers ,.invers ,
2850: 20 30 20 2c 0a 43 72 65 61 74 65 20 38 35 63 6f   0 ,.Create 85co
2860: 6c 6f 72 73 2d 63 6c 0a 79 65 6c 6c 6f 77 20 3e  lors-cl.yellow >
2870: 66 67 20 62 6c 75 65 20 3e 62 67 20 6f 72 20 62  fg blue >bg or b
2880: 6f 6c 64 20 6f 72 20 2c 20 72 65 64 20 3e 66 67  old or , red >fg
2890: 20 77 68 69 74 65 20 62 67 7c 20 2c 0a 62 6c 61   white bg| ,.bla
28a0: 63 6b 20 3e 66 67 20 63 79 61 6e 20 62 67 7c 20  ck >fg cyan bg| 
28b0: 2c 20 67 72 65 65 6e 20 3e 66 67 20 62 6c 61 63  , green >fg blac
28c0: 6b 20 3e 62 67 20 6f 72 20 62 6f 6c 64 20 6f 72  k >bg or bold or
28d0: 20 2c 0a 77 68 69 74 65 20 3e 66 67 20 62 6c 61   ,.white >fg bla
28e0: 63 6b 20 3e 62 67 20 6f 72 20 62 6f 6c 64 20 6f  ck >bg or bold o
28f0: 72 20 2c 20 6d 61 67 65 6e 74 61 20 3e 66 67 20  r , magenta >fg 
2900: 79 65 6c 6c 6f 77 20 62 67 7c 20 2c 0a 62 6c 75  yellow bg| ,.blu
2910: 65 20 3e 66 67 20 79 65 6c 6c 6f 77 20 62 67 7c  e >fg yellow bg|
2920: 20 2c 20 63 79 61 6e 20 3e 66 67 20 72 65 64 20   , cyan >fg red 
2930: 3e 62 67 20 6f 72 20 62 6f 6c 64 20 6f 72 20 2c  >bg or bold or ,
2940: 0a 0a 5b 49 46 44 45 46 5d 20 67 6c 2d 74 79 70  ..[IFDEF] gl-typ
2950: 65 20 38 35 63 6f 6c 6f 72 73 2d 63 6c 20 5b 45  e 85colors-cl [E
2960: 4c 53 45 5d 20 38 35 63 6f 6c 6f 72 73 2d 62 77  LSE] 85colors-bw
2970: 20 5b 54 48 45 4e 5d 20 56 61 6c 75 65 20 38 35   [THEN] Value 85
2980: 63 6f 6c 6f 72 73 0a 0a 3a 20 2e 73 74 72 69 70  colors..: .strip
2990: 65 38 35 20 28 20 61 64 64 72 20 75 20 2d 2d 20  e85 ( addr u -- 
29a0: 29 20 20 30 20 2d 72 6f 74 20 62 6f 75 6e 64 73  )  0 -rot bounds
29b0: 20 3f 44 4f 0a 09 64 75 70 20 63 65 6c 6c 73 20   ?DO..dup cells 
29c0: 38 35 63 6f 6c 6f 72 73 20 2b 20 40 20 61 74 74  85colors + @ att
29d0: 72 21 20 31 2b 0a 09 49 20 34 20 38 35 74 79 70  r! 1+..I 4 85typ
29e0: 65 20 20 64 75 70 20 63 65 6c 6c 73 20 38 35 63  e  dup cells 85c
29f0: 6f 6c 6f 72 73 20 2b 20 40 20 61 74 74 72 21 20  olors + @ attr! 
2a00: 31 2b 0a 20 20 20 20 49 20 34 20 2b 20 34 20 38  1+.    I 4 + 4 8
2a10: 35 74 79 70 65 20 3c 64 65 66 61 75 6c 74 3e 20  5type <default> 
2a20: 63 72 20 38 20 2b 4c 4f 4f 50 20 20 64 72 6f 70  cr 8 +LOOP  drop
2a30: 20 3b 0a 3a 20 2e 69 6d 70 6f 72 74 38 35 20 28   ;.: .import85 (
2a40: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20   addr u -- ).   
2a50: 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e 69   ke-imports @ >i
2a60: 6d 2d 63 6f 6c 6f 72 20 38 35 74 79 70 65 20 3c  m-color 85type <
2a70: 64 65 66 61 75 6c 74 3e 20 3b 0a 3a 20 2e 72 73  default> ;.: .rs
2a80: 6b 20 28 20 6e 69 63 6b 20 75 20 2d 2d 20 29 0a  k ( nick u -- ).
2a90: 20 20 20 20 73 6b 72 65 76 20 24 32 30 20 2e 73      skrev $20 .s
2aa0: 74 72 69 70 65 38 35 20 73 70 61 63 65 20 74 79  tripe85 space ty
2ab0: 70 65 20 2e 22 20 20 28 6b 65 65 70 20 6f 66 66  pe ."  (keep off
2ac0: 6c 69 6e 65 20 63 6f 70 79 21 29 22 20 63 72 20  line copy!)" cr 
2ad0: 3b 0a 3a 20 2e 6b 65 79 20 28 20 61 64 64 72 20  ;.: .key ( addr 
2ae0: 75 20 2d 2d 20 29 20 64 72 6f 70 20 63 65 6c 6c  u -- ) drop cell
2af0: 2b 20 3e 6f 0a 20 20 20 20 2e 22 20 6e 69 63 6b  + >o.    ." nick
2b00: 3a 20 20 20 22 20 2e 6e 69 63 6b 20 63 72 0a 20  :   " .nick cr. 
2b10: 20 20 20 2e 22 20 70 75 62 6b 65 79 3a 20 22 20     ." pubkey: " 
2b20: 6b 65 2d 70 6b 20 24 40 20 38 35 74 79 70 65 20  ke-pk $@ 85type 
2b30: 63 72 0a 20 20 20 20 6b 65 2d 73 6b 20 40 20 49  cr.    ke-sk @ I
2b40: 46 0a 09 2e 22 20 73 65 63 6b 65 79 3a 20 22 20  F..." seckey: " 
2b50: 6b 65 2d 73 6b 20 73 65 63 40 20 2e 62 6c 61 63  ke-sk sec@ .blac
2b60: 6b 38 35 20 2e 22 20 20 28 6b 65 65 70 20 73 65  k85 ."  (keep se
2b70: 63 72 65 74 21 29 22 20 63 72 20 20 54 48 45 4e  cret!)" cr  THEN
2b80: 0a 20 20 20 20 2e 22 20 76 61 6c 69 64 3a 20 20  .    ." valid:  
2b90: 22 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 20  " ke-selfsig $@ 
2ba0: 2e 73 69 67 64 61 74 65 73 20 63 72 0a 20 20 20  .sigdates cr.   
2bb0: 20 2e 22 20 67 72 6f 75 70 73 3a 20 22 20 6b 65   ." groups: " ke
2bc0: 2d 67 72 6f 75 70 73 20 24 40 20 2e 69 6e 2d 67  -groups $@ .in-g
2bd0: 72 6f 75 70 73 20 63 72 0a 20 20 20 20 2e 22 20  roups cr.    ." 
2be0: 70 65 72 6d 3a 20 20 20 22 20 6b 65 2d 6d 61 73  perm:   " ke-mas
2bf0: 6b 20 40 20 2e 70 65 72 6d 20 63 72 0a 20 20 20  k @ .perm cr.   
2c00: 20 6f 3e 20 3b 0a 3a 20 2e 6b 65 79 2d 72 65 73   o> ;.: .key-res
2c10: 74 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b  t ( o:key -- o:k
2c20: 65 79 20 29 0a 20 20 20 20 6b 65 2d 70 6b 20 24  ey ).    ke-pk $
2c30: 40 20 6b 65 79 7c 20 2e 69 6d 70 6f 72 74 38 35  @ key| .import85
2c40: 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 20  .    ke-selfsig 
2c50: 24 40 20 73 70 61 63 65 20 2e 73 69 67 64 61 74  $@ space .sigdat
2c60: 65 73 0a 20 20 20 20 6b 65 2d 67 72 6f 75 70 73  es.    ke-groups
2c70: 20 24 40 20 32 64 75 70 20 2e 69 6e 2d 67 72 6f   $@ 2dup .in-gro
2c80: 75 70 73 20 67 72 6f 75 70 73 3e 6d 61 73 6b 20  ups groups>mask 
2c90: 69 6e 76 65 72 74 0a 20 20 20 20 73 70 61 63 65  invert.    space
2ca0: 20 6b 65 2d 6d 61 73 6b 20 40 20 61 6e 64 20 2d   ke-mask @ and -
2cb0: 31 20 73 77 61 70 20 2e 70 65 72 6d 61 6e 64 6f  1 swap .permando
2cc0: 72 0a 20 20 20 20 23 74 61 62 20 65 6d 69 74 20  r.    #tab emit 
2cd0: 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20 2e 69 6d  ke-imports @ .im
2ce0: 70 6f 72 74 73 0a 20 20 20 20 73 70 61 63 65 20  ports.    space 
2cf0: 2e 6e 69 63 6b 2b 70 65 74 20 3b 0a 3a 20 2e 6b  .nick+pet ;.: .k
2d00: 65 79 2d 6c 69 73 74 20 28 20 6f 3a 6b 65 79 20  ey-list ( o:key 
2d10: 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 6b  -- o:key ).    k
2d20: 65 2d 6f 66 66 73 65 74 20 36 34 40 20 36 34 3e  e-offset 64@ 64>
2d30: 64 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 66  d keypack-all# f
2d40: 6d 2f 6d 6f 64 20 6e 69 70 20 33 20 2e 72 20 73  m/mod nip 3 .r s
2d50: 70 61 63 65 0a 20 20 20 20 2e 6b 65 79 2d 72 65  pace.    .key-re
2d60: 73 74 20 63 72 20 3b 0a 3a 20 2e 73 65 63 72 65  st cr ;.: .secre
2d70: 74 2d 6e 69 63 6b 73 20 28 20 2d 2d 20 29 0a 20  t-nicks ( -- ). 
2d80: 20 20 20 30 20 6b 65 79 23 20 5b 3a 20 63 65 6c     0 key# [: cel
2d90: 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b  l+ $@ drop cell+
2da0: 20 3e 6f 20 6b 65 2d 73 6b 20 40 20 49 46 0a 09   >o ke-sk @ IF..
2db0: 20 20 5b 3a 20 64 75 70 20 31 20 2e 72 20 3b 5d    [: dup 1 .r ;]
2dc0: 20 23 33 36 20 62 61 73 65 2d 65 78 65 63 75 74   #36 base-execut
2dd0: 65 20 73 70 61 63 65 20 2e 6b 65 79 2d 72 65 73  e space .key-res
2de0: 74 20 63 72 20 31 2b 0a 20 20 20 20 20 20 54 48  t cr 1+.      TH
2df0: 45 4e 20 6f 3e 20 3b 5d 20 23 6d 61 70 20 64 72  EN o> ;] #map dr
2e00: 6f 70 20 3b 0a 3a 20 2e 6b 65 79 2d 69 6e 76 69  op ;.: .key-invi
2e10: 74 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a  te ( o:key -- o:
2e20: 6b 65 79 20 29 0a 20 20 20 20 6b 65 2d 70 6b 20  key ).    ke-pk 
2e30: 24 40 20 6b 65 79 73 69 7a 65 20 75 6d 69 6e 0a  $@ keysize umin.
2e40: 20 20 20 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40      ke-imports @
2e50: 20 3e 69 6d 2d 63 6f 6c 6f 72 20 38 35 74 79 70   >im-color 85typ
2e60: 65 20 3c 64 65 66 61 75 6c 74 3e 0a 20 20 20 20  e <default>.    
2e70: 73 70 61 63 65 20 2e 6e 69 63 6b 20 73 70 61 63  space .nick spac
2e80: 65 20 3b 0a 3a 20 2e 6b 65 79 2d 73 68 6f 72 74  e ;.: .key-short
2e90: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b 65   ( o:key -- o:ke
2ea0: 79 20 29 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20  y ).    ke-nick 
2eb0: 24 2e 20 6b 65 2d 70 72 6f 66 20 24 40 6c 65 6e  $. ke-prof $@len
2ec0: 20 49 46 20 2e 22 20 20 70 72 6f 66 69 6c 65 3a   IF ."  profile:
2ed0: 20 22 20 6b 65 2d 70 72 6f 66 20 24 40 20 38 35   " ke-prof $@ 85
2ee0: 74 79 70 65 20 54 48 45 4e 20 3b 0a 0a 5c 20 70  type THEN ;..\ p
2ef0: 72 69 6e 74 20 73 6f 72 74 65 64 20 6c 69 73 74  rint sorted list
2f00: 20 6f 66 20 6b 65 79 73 20 62 79 20 6e 69 63 6b   of keys by nick
2f10: 0a 0a 56 61 72 69 61 62 6c 65 20 73 6f 72 74 2d  ..Variable sort-
2f20: 6c 69 73 74 5b 5d 0a 3a 20 24 69 6e 73 5b 5d 6b  list[].: $ins[]k
2f30: 65 79 20 28 20 6f 3a 6b 65 79 20 24 61 72 72 61  ey ( o:key $arra
2f40: 79 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 69 6e  y -- ).    \G in
2f50: 73 65 72 74 20 4f 28 6c 6f 67 28 6e 29 29 20 69  sert O(log(n)) i
2f60: 6e 74 6f 20 70 72 65 2d 73 6f 72 74 65 64 20 61  nto pre-sorted a
2f70: 72 72 61 79 0a 20 20 20 20 5c 47 20 40 76 61 72  rray.    \G @var
2f80: 7b 70 6f 73 7d 20 69 73 20 74 68 65 20 69 6e 73  {pos} is the ins
2f90: 65 72 74 69 6f 6e 20 6f 66 66 73 65 74 20 6f 72  ertion offset or
2fa0: 20 2d 31 20 69 66 20 6e 6f 74 20 69 6e 73 65 72   -1 if not inser
2fb0: 74 65 64 0a 20 20 20 20 7b 20 61 5b 5d 20 7d 20  ted.    { a[] } 
2fc0: 30 20 61 5b 5d 20 24 5b 5d 23 0a 20 20 20 20 42  0 a[] $[]#.    B
2fd0: 45 47 49 4e 20 20 32 64 75 70 20 75 3c 20 20 57  EGIN  2dup u<  W
2fe0: 48 49 4c 45 20 20 32 64 75 70 20 2b 20 32 2f 20  HILE  2dup + 2/ 
2ff0: 7b 20 6c 65 66 74 20 72 69 67 68 74 20 24 23 20  { left right $# 
3000: 7d 0a 09 20 20 20 20 6b 65 2d 6e 69 63 6b 20 24  }..    ke-nick $
3010: 40 20 24 23 20 61 5b 5d 20 24 5b 5d 20 40 20 2e  @ $# a[] $[] @ .
3020: 6b 65 2d 6e 69 63 6b 20 24 40 20 63 6f 6d 70 61  ke-nick $@ compa
3030: 72 65 20 64 75 70 20 30 3d 20 49 46 0a 09 09 64  re dup 0= IF...d
3040: 72 6f 70 20 6b 65 2d 6e 69 63 6b 23 20 40 20 24  rop ke-nick# @ $
3050: 23 20 61 5b 5d 20 24 5b 5d 20 40 20 2e 6b 65 2d  # a[] $[] @ .ke-
3060: 6e 69 63 6b 23 20 40 20 2d 20 20 54 48 45 4e 0a  nick# @ -  THEN.
3070: 09 20 20 20 20 30 3c 20 49 46 20 20 6c 65 66 74  .    0< IF  left
3080: 20 24 23 20 20 45 4c 53 45 20 20 24 23 20 31 2b   $#  ELSE  $# 1+
3090: 20 72 69 67 68 74 20 20 54 48 45 4e 0a 20 20 20   right  THEN.   
30a0: 20 52 45 50 45 41 54 20 20 64 72 6f 70 20 3e 72   REPEAT  drop >r
30b0: 0a 20 20 20 20 6f 20 7b 20 77 5e 20 69 6e 73 24  .    o { w^ ins$
30c0: 30 20 7d 20 69 6e 73 24 30 20 63 65 6c 6c 20 61  0 } ins$0 cell a
30d0: 5b 5d 20 72 3e 20 63 65 6c 6c 73 20 24 69 6e 73  [] r> cells $ins
30e0: 20 3b 0a 3a 20 6c 69 73 74 2d 6b 65 79 73 20 28   ;.: list-keys (
30f0: 20 2d 2d 20 29 0a 20 20 20 20 2e 22 20 63 6f 6c   -- ).    ." col
3100: 6f 72 73 3a 20 22 20 2e 69 6d 70 6f 72 74 2d 63  ors: " .import-c
3110: 6f 6c 6f 72 73 20 63 72 0a 20 20 20 20 2e 22 20  olors cr.    ." 
3120: 6e 75 6d 20 70 75 62 6b 65 79 20 20 20 20 20 20  num pubkey      
3130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3140: 20 20 20 20 20 20 20 20 20 20 20 20 20 64 61 74               dat
3150: 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  e               
3160: 20 20 20 20 20 20 67 72 70 2b 70 65 72 6d 09 68        grp+perm.h
3170: 20 6e 69 63 6b 22 20 63 72 0a 20 20 20 20 6b 65   nick" cr.    ke
3180: 79 23 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64  y# [: cell+ $@ d
3190: 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 20 73 6f 72  rop cell+ >o sor
31a0: 74 2d 6c 69 73 74 5b 5d 20 24 69 6e 73 5b 5d 6b  t-list[] $ins[]k
31b0: 65 79 20 6f 3e 20 3b 5d 20 23 6d 61 70 0a 20 20  ey o> ;] #map.  
31c0: 20 20 73 6f 72 74 2d 6c 69 73 74 5b 5d 20 24 5b    sort-list[] $[
31d0: 5d 23 20 30 20 3f 44 4f 20 20 49 20 73 6f 72 74  ]# 0 ?DO  I sort
31e0: 2d 6c 69 73 74 5b 5d 20 24 5b 5d 20 40 20 2e 2e  -list[] $[] @ ..
31f0: 6b 65 79 2d 6c 69 73 74 20 20 4c 4f 4f 50 0a 20  key-list  LOOP. 
3200: 20 20 20 73 6f 72 74 2d 6c 69 73 74 5b 5d 20 24     sort-list[] $
3210: 6f 66 66 20 3b 0a 3a 20 6c 69 73 74 2d 6e 69 63  off ;.: list-nic
3220: 6b 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 6e 69  ks ( -- ).    ni
3230: 63 6b 23 20 5b 3a 20 64 75 70 20 24 2e 20 2e 22  ck# [: dup $. ."
3240: 20 3a 22 20 63 72 20 63 65 6c 6c 2b 20 24 40 20   :" cr cell+ $@ 
3250: 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 20 20 49 20  bounds ?DO..  I 
3260: 40 20 2e 2e 6b 65 79 2d 6c 69 73 74 20 20 63 65  @ ..key-list  ce
3270: 6c 6c 20 2b 4c 4f 4f 50 20 3b 5d 20 23 6d 61 70  ll +LOOP ;] #map
3280: 20 3b 0a 0a 3a 20 64 75 6d 70 6b 65 79 20 28 20   ;..: dumpkey ( 
3290: 61 64 64 72 20 75 20 2d 2d 20 29 20 64 72 6f 70  addr u -- ) drop
32a0: 20 63 65 6c 6c 2b 20 3e 6f 0a 20 20 20 20 2e 5c   cell+ >o.    .\
32b0: 22 20 78 5c 22 20 22 20 6b 65 2d 70 6b 20 24 40  " x\" " ke-pk $@
32c0: 20 38 35 74 79 70 65 20 2e 5c 22 20 5c 22 20 6b   85type .\" \" k
32d0: 65 79 3f 6e 65 77 22 20 63 72 0a 20 20 20 20 6b  ey?new" cr.    k
32e0: 65 2d 73 6b 20 40 20 49 46 20 20 2e 5c 22 20 78  e-sk @ IF  .\" x
32f0: 5c 22 20 22 20 6b 65 2d 73 6b 20 40 20 6b 65 79  \" " ke-sk @ key
3300: 73 69 7a 65 20 38 35 74 79 70 65 20 2e 5c 22 20  size 85type .\" 
3310: 5c 22 20 6b 65 2d 73 6b 20 73 65 63 21 20 2b 73  \" ke-sk sec! +s
3320: 65 63 6b 65 79 22 20 63 72 20 20 54 48 45 4e 0a  eckey" cr  THEN.
3330: 20 20 20 20 27 22 27 20 65 6d 69 74 20 2e 6e 69      '"' emit .ni
3340: 63 6b 20 2e 5c 22 20 5c 22 20 6b 65 2d 6e 69 63  ck .\" \" ke-nic
3350: 6b 20 24 21 20 22 0a 20 20 20 20 6b 65 2d 73 65  k $! ".    ke-se
3360: 6c 66 73 69 67 20 24 40 20 64 72 6f 70 20 36 34  lfsig $@ drop 64
3370: 40 20 36 34 3e 64 20 5b 3a 20 27 24 27 20 65 6d  @ 64>d [: '$' em
3380: 69 74 20 30 20 75 64 2e 72 20 3b 5d 20 24 31 30  it 0 ud.r ;] $10
3390: 20 62 61 73 65 2d 65 78 65 63 75 74 65 0a 20 20   base-execute.  
33a0: 20 20 2e 22 20 2e 20 64 3e 36 34 20 6b 65 2d 66    ." . d>64 ke-f
33b0: 69 72 73 74 21 20 22 20 6b 65 2d 74 79 70 65 20  irst! " ke-type 
33c0: 40 20 2e 20 2e 22 20 6b 65 2d 74 79 70 65 20 21  @ . ." ke-type !
33d0: 22 20 20 63 72 20 6f 3e 20 3b 0a 0a 3a 20 2e 6b  "  cr o> ;..: .k
33e0: 65 79 73 20 28 20 2d 2d 20 29 20 6b 65 79 23 20  eys ( -- ) key# 
33f0: 5b 3a 20 2e 22 20 69 6e 64 65 78 3a 20 22 20 64  [: ." index: " d
3400: 75 70 20 24 40 20 38 35 74 79 70 65 20 63 72 20  up $@ 85type cr 
3410: 63 65 6c 6c 2b 20 24 40 20 2e 6b 65 79 20 3b 5d  cell+ $@ .key ;]
3420: 20 23 6d 61 70 20 3b 0a 3a 20 64 75 6d 70 6b 65   #map ;.: dumpke
3430: 79 73 20 28 20 2d 2d 20 29 20 6b 65 79 23 20 5b  ys ( -- ) key# [
3440: 3a 20 63 65 6c 6c 2b 20 24 40 20 64 75 6d 70 6b  : cell+ $@ dumpk
3450: 65 79 20 3b 5d 20 23 6d 61 70 20 3b 0a 0a 3a 20  ey ;] #map ;..: 
3460: 6b 65 79 3e 6e 69 63 6b 20 28 20 61 64 64 72 6b  key>nick ( addrk
3470: 65 79 20 75 31 20 2d 2d 20 6e 69 63 6b 20 75 32  ey u1 -- nick u2
3480: 20 29 0a 20 20 20 20 5c 47 20 63 6f 6e 76 65 72   ).    \G conver
3490: 74 20 6b 65 79 20 74 6f 20 6e 69 63 6b 0a 20 20  t key to nick.  
34a0: 20 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 30    key| key# #@ 0
34b0: 3d 20 49 46 20 20 64 72 6f 70 20 23 30 2e 20 20  = IF  drop #0.  
34c0: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 63  EXIT  THEN.    c
34d0: 65 6c 6c 2b 20 2e 6b 65 2d 6e 69 63 6b 20 24 40  ell+ .ke-nick $@
34e0: 20 3b 0a 3a 20 6b 65 79 3e 6b 65 79 20 28 20 61   ;.: key>key ( a
34f0: 64 64 72 6b 65 79 20 75 31 20 2d 2d 20 6b 65 79  ddrkey u1 -- key
3500: 20 75 32 20 29 0a 20 20 20 20 5c 47 20 65 78 70   u2 ).    \G exp
3510: 61 6e 64 20 6b 65 79 20 74 6f 20 66 75 6c 6c 20  and key to full 
3520: 73 69 7a 65 20 61 6e 64 20 63 68 65 63 6b 20 69  size and check i
3530: 66 20 77 65 20 6b 6e 6f 77 20 69 74 0a 20 20 20  f we know it.   
3540: 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 30 3d   key| key# #@ 0=
3550: 20 49 46 20 20 64 72 6f 70 20 23 30 2e 20 20 45   IF  drop #0.  E
3560: 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 63 65  XIT  THEN.    ce
3570: 6c 6c 2b 20 2e 6b 65 2d 70 6b 20 24 40 20 3b 0a  ll+ .ke-pk $@ ;.
3580: 0a 3a 20 2e 6b 65 79 23 20 28 20 61 64 64 72 20  .: .key# ( addr 
3590: 75 20 2d 2d 20 29 20 6b 65 79 7c 0a 20 20 20 20  u -- ) key|.    
35a0: 2e 22 20 4b 65 79 20 27 22 20 6b 65 79 23 20 23  ." Key '" key# #
35b0: 40 20 30 3d 20 49 46 20 64 72 6f 70 20 45 58 49  @ 0= IF drop EXI
35c0: 54 20 54 48 45 4e 0a 20 20 20 20 63 65 6c 6c 2b  T THEN.    cell+
35d0: 20 2e 2e 6e 69 63 6b 20 2e 22 20 27 20 6f 6b 22   ..nick ." ' ok"
35e0: 20 63 72 20 3b 0a 0a 44 65 66 65 72 20 64 68 74   cr ;..Defer dht
35f0: 2d 6e 69 63 6b 3f 0a 65 76 65 6e 74 3a 20 3a 3e  -nick?.event: :>
3600: 73 65 61 72 63 68 2d 6b 65 79 20 20 6b 65 79 7c  search-key  key|
3610: 20 6f 76 65 72 20 3e 72 20 64 68 74 2d 6e 69 63   over >r dht-nic
3620: 6b 3f 20 72 3e 20 66 72 65 65 20 74 68 72 6f 77  k? r> free throw
3630: 20 3b 0a 0a 3a 20 2e 75 6e 6b 65 79 2d 69 64 20   ;..: .unkey-id 
3640: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 3c 65  ( addr u -- ) <e
3650: 72 72 3e 20 38 20 75 6d 69 6e 20 38 35 74 79 70  rr> 8 umin 85typ
3660: 65 20 2e 22 20 28 75 6e 6b 6e 6f 77 6e 29 22 20  e ." (unknown)" 
3670: 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 0a 56 61 72  <default> ;..Var
3680: 69 61 62 6c 65 20 75 6e 6b 65 79 2d 69 64 23 0a  iable unkey-id#.
3690: 23 36 30 2e 30 30 30 2e 30 30 30 2e 30 30 30 20  #60.000.000.000 
36a0: 64 3e 36 34 20 36 34 43 6f 6e 73 74 61 6e 74 20  d>64 64Constant 
36b0: 75 6e 6b 65 79 2d 74 6f 23 0a 3a 20 3f 75 6e 6b  unkey-to#.: ?unk
36c0: 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 66  ey ( addr u -- f
36d0: 6c 61 67 20 29 0a 20 20 20 20 75 6e 6b 65 79 2d  lag ).    unkey-
36e0: 69 64 23 20 23 40 0a 20 20 20 20 49 46 20 20 36  id# #@.    IF  6
36f0: 34 40 20 75 6e 6b 65 79 2d 74 6f 23 20 36 34 2b  4@ unkey-to# 64+
3700: 20 74 69 63 6b 73 20 36 34 2d 20 36 34 2d 30 3e   ticks 64- 64-0>
3710: 3d 20 20 54 48 45 4e 20 20 30 3d 20 3b 0a 20 20  =  THEN  0= ;.  
3720: 20 20 0a 3a 20 28 2e 6b 65 79 2d 69 64 29 20 28    .: (.key-id) (
3730: 20 61 64 64 72 20 75 20 2d 2d 20 29 20 6b 65 79   addr u -- ) key
3740: 7c 20 32 64 75 70 20 6b 65 79 23 20 23 40 20 30  | 2dup key# #@ 0
3750: 3d 0a 20 20 20 20 49 46 20 20 64 72 6f 70 20 75  =.    IF  drop u
3760: 70 40 20 72 65 63 65 69 76 65 72 2d 74 61 73 6b  p@ receiver-task
3770: 20 3d 20 49 46 0a 09 20 20 20 20 3c 65 76 65 6e   = IF..    <even
3780: 74 20 32 64 75 70 20 73 61 76 65 2d 6d 65 6d 20  t 2dup save-mem 
3790: 65 24 2c 20 3a 3e 73 65 61 72 63 68 2d 6b 65 79  e$, :>search-key
37a0: 20 6d 61 69 6e 2d 75 70 40 20 65 76 65 6e 74 3e   main-up@ event>
37b0: 0a 09 20 20 20 20 2e 75 6e 6b 65 79 2d 69 64 20  ..    .unkey-id 
37c0: 45 58 49 54 20 20 54 48 45 4e 0a 09 32 64 75 70  EXIT  THEN..2dup
37d0: 20 3f 75 6e 6b 65 79 20 20 49 46 0a 09 20 20 20   ?unkey  IF..   
37e0: 20 74 69 63 6b 73 20 7b 20 36 34 5e 20 74 78 20   ticks { 64^ tx 
37f0: 7d 20 74 78 20 31 20 36 34 73 20 32 6f 76 65 72  } tx 1 64s 2over
3800: 20 75 6e 6b 65 79 2d 69 64 23 20 23 21 0a 09 20   unkey-id# #!.. 
3810: 20 20 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 3e 72     connection >r
3820: 20 32 64 75 70 20 5b 27 5d 20 64 68 74 2d 6e 69   2dup ['] dht-ni
3830: 63 6b 3f 20 63 6d 64 2d 6e 65 73 74 20 72 3e 20  ck? cmd-nest r> 
3840: 74 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e 0a 09 20  to connection.. 
3850: 20 20 20 32 64 75 70 20 6b 65 79 23 20 23 40 20     2dup key# #@ 
3860: 30 3d 20 49 46 20 20 64 72 6f 70 20 2e 75 6e 6b  0= IF  drop .unk
3870: 65 79 2d 69 64 20 45 58 49 54 0a 09 20 20 20 20  ey-id EXIT..    
3880: 45 4c 53 45 20 20 3e 72 20 32 64 75 70 20 75 6e  ELSE  >r 2dup un
3890: 6b 65 79 2d 69 64 23 20 23 6f 66 66 20 72 3e 20  key-id# #off r> 
38a0: 20 54 48 45 4e 0a 09 45 4c 53 45 20 20 2e 75 6e   THEN..ELSE  .un
38b0: 6b 65 79 2d 69 64 20 20 45 58 49 54 20 20 54 48  key-id  EXIT  TH
38c0: 45 4e 0a 20 20 20 20 54 48 45 4e 0a 20 20 20 20  EN.    THEN.    
38d0: 63 65 6c 6c 2b 20 2e 2e 6e 69 63 6b 20 32 64 72  cell+ ..nick 2dr
38e0: 6f 70 20 3b 0a 0a 3a 20 2e 6b 65 79 2d 69 64 20  op ;..: .key-id 
38f0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20  ( addr u -- ).  
3900: 20 20 6c 61 73 74 23 20 3e 72 20 20 28 2e 6b 65    last# >r  (.ke
3910: 79 2d 69 64 29 20 20 72 3e 20 74 6f 20 6c 61 73  y-id)  r> to las
3920: 74 23 20 3b 0a 0a 3a 20 2e 63 6f 6e 2d 69 64 20  t# ;..: .con-id 
3930: 28 20 6f 3a 63 6f 6e 6e 65 63 74 69 6f 6e 20 2d  ( o:connection -
3940: 2d 20 29 20 70 75 62 6b 65 79 20 24 40 20 2e 6b  - ) pubkey $@ .k
3950: 65 79 2d 69 64 20 3b 0a 0a 3a 20 2e 73 69 6d 70  ey-id ;..: .simp
3960: 6c 65 2d 69 64 20 28 20 61 64 64 72 20 75 20 2d  le-id ( addr u -
3970: 2d 20 29 20 6c 61 73 74 23 20 3e 72 20 20 6b 65  - ) last# >r  ke
3980: 79 3e 6e 69 63 6b 20 74 79 70 65 20 20 72 3e 20  y>nick type  r> 
3990: 74 6f 20 6c 61 73 74 23 20 3b 0a 0a 3a 20 63 68  to last# ;..: ch
39a0: 65 63 6b 2d 6b 65 79 20 28 20 61 64 64 72 20 75  eck-key ( addr u
39b0: 20 2d 2d 20 29 0a 20 20 20 20 6f 20 49 46 20 20   -- ).    o IF  
39c0: 70 75 62 6b 65 79 20 40 20 49 46 0a 09 20 20 20  pubkey @ IF..   
39d0: 20 32 64 75 70 20 70 75 62 6b 65 79 20 24 40 20   2dup pubkey $@ 
39e0: 6b 65 79 7c 20 73 74 72 3d 20 30 3d 20 49 46 0a  key| str= 0= IF.
39f0: 09 09 5b 3a 20 2e 22 20 77 61 6e 74 3a 20 22 20  ..[: ." want: " 
3a00: 70 75 62 6b 65 79 20 24 40 20 6b 65 79 7c 20 38  pubkey $@ key| 8
3a10: 35 74 79 70 65 20 63 72 0a 09 09 20 20 2e 22 20  5type cr...  ." 
3a20: 67 6f 74 20 3a 20 22 20 32 64 75 70 20 38 35 74  got : " 2dup 85t
3a30: 79 70 65 20 63 72 20 3b 5d 20 24 65 72 72 0a 09  ype cr ;] $err..
3a40: 09 74 72 75 65 20 21 21 77 72 6f 6e 67 2d 6b 65  .true !!wrong-ke
3a50: 79 21 21 0a 09 20 20 20 20 54 48 45 4e 0a 09 20  y!!..    THEN.. 
3a60: 20 20 20 63 6f 6e 6e 65 63 74 28 20 2e 6b 65 79     connect( .key
3a70: 23 20 29 65 6c 73 65 28 20 32 64 72 6f 70 20 29  # )else( 2drop )
3a80: 20 20 45 58 49 54 0a 09 54 48 45 4e 20 20 54 48    EXIT..THEN  TH
3a90: 45 4e 0a 20 20 20 20 32 64 75 70 20 6b 65 79 2d  EN.    2dup key-
3aa0: 65 78 69 73 74 3f 0a 20 20 20 20 3f 64 75 70 2d  exist?.    ?dup-
3ab0: 30 3d 2d 49 46 20 20 70 65 72 6d 25 75 6e 6b 6e  0=-IF  perm%unkn
3ac0: 6f 77 6e 20 20 45 4c 53 45 20 20 2e 6b 65 2d 6d  own  ELSE  .ke-m
3ad0: 61 73 6b 20 40 20 20 54 48 45 4e 20 20 74 6d 70  ask @  THEN  tmp
3ae0: 2d 70 65 72 6d 20 21 0a 20 20 20 20 63 6f 6e 6e  -perm !.    conn
3af0: 65 63 74 28 20 32 64 75 70 20 2e 6b 65 79 23 20  ect( 2dup .key# 
3b00: 29 0a 20 20 20 20 74 6d 70 2d 70 65 72 6d 20 40  ).    tmp-perm @
3b10: 20 70 65 72 6d 25 62 6c 6f 63 6b 65 64 20 61 6e   perm%blocked an
3b20: 64 20 49 46 0a 09 5b 3a 20 2e 22 20 55 6e 6b 6e  d IF..[: ." Unkn
3b30: 6f 77 6e 20 6b 65 79 2c 20 63 6f 6e 6e 65 63 74  own key, connect
3b40: 69 6f 6e 20 72 65 66 75 73 65 64 3a 20 22 20 38  ion refused: " 8
3b50: 35 74 79 70 65 20 63 72 20 3b 5d 20 24 65 72 72  5type cr ;] $err
3b60: 0a 09 74 72 75 65 20 21 21 63 6f 6e 6e 65 63 74  ..true !!connect
3b70: 2d 70 65 72 6d 21 21 0a 20 20 20 20 45 4c 53 45  -perm!!.    ELSE
3b80: 20 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a    2drop  THEN ;.
3b90: 0a 3a 20 73 65 61 72 63 68 2d 6b 65 79 20 28 20  .: search-key ( 
3ba0: 70 6b 63 20 2d 2d 20 6f 20 73 6b 63 20 29 0a 20  pkc -- o skc ). 
3bb0: 20 20 20 6b 65 79 73 69 7a 65 20 6b 65 79 23 20     keysize key# 
3bc0: 23 40 20 30 3d 20 21 21 75 6e 6b 6e 6f 77 6e 2d  #@ 0= !!unknown-
3bd0: 6b 65 79 21 21 0a 20 20 20 20 63 65 6c 6c 2b 20  key!!.    cell+ 
3be0: 64 75 70 20 2e 6b 65 2d 73 6b 20 73 65 63 40 20  dup .ke-sk sec@ 
3bf0: 30 3d 20 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 79  0= !!unknown-key
3c00: 21 21 20 3b 0a 3a 20 73 65 61 72 63 68 2d 6b 65  !! ;.: search-ke
3c10: 79 3f 20 28 20 70 6b 63 20 2d 2d 20 66 61 6c 73  y? ( pkc -- fals
3c20: 65 20 2f 20 6f 20 73 6b 63 20 29 0a 20 20 20 20  e / o skc ).    
3c30: 6b 65 79 73 69 7a 65 20 6b 65 79 23 20 23 40 20  keysize key# #@ 
3c40: 30 3d 20 49 46 20 20 64 72 6f 70 20 30 20 20 45  0= IF  drop 0  E
3c50: 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 63 65  XIT  THEN.    ce
3c60: 6c 6c 2b 20 64 75 70 20 2e 6b 65 2d 73 6b 20 73  ll+ dup .ke-sk s
3c70: 65 63 40 20 30 3d 20 49 46 20 20 32 64 72 6f 70  ec@ 0= IF  2drop
3c80: 20 30 20 20 45 58 49 54 20 20 54 48 45 4e 20 3b   0  EXIT  THEN ;
3c90: 0a 0a 5c 20 61 70 70 6c 79 20 70 65 72 6d 69 73  ..\ apply permis
3ca0: 73 69 6f 6e 73 26 67 72 6f 75 70 73 0a 0a 3a 20  sions&groups..: 
3cb0: 61 70 70 6c 79 2d 70 65 72 6d 69 73 73 69 6f 6e  apply-permission
3cc0: 20 28 20 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f   ( permand permo
3cd0: 72 20 6f 3a 6b 65 79 20 2d 2d 20 70 65 72 6d 61  r o:key -- perma
3ce0: 6e 64 20 70 65 72 6d 6f 72 20 6f 3a 6b 65 79 20  nd permor o:key 
3cf0: 29 0a 20 20 20 20 6f 76 65 72 20 6b 65 2d 6d 61  ).    over ke-ma
3d00: 73 6b 20 40 20 61 6e 64 20 6f 76 65 72 20 6f 72  sk @ and over or
3d10: 20 6b 65 2d 6d 61 73 6b 20 21 20 2e 6b 65 79 2d   ke-mask ! .key-
3d20: 6c 69 73 74 20 3b 0a 0a 3a 20 2d 67 72 6f 75 70  list ;..: -group
3d30: 2d 70 65 72 6d 20 28 20 6f 3a 6b 65 79 20 2d 2d  -perm ( o:key --
3d40: 20 29 0a 20 20 20 20 6b 65 2d 67 72 6f 75 70 73   ).    ke-groups
3d50: 20 24 40 20 67 72 6f 75 70 73 3e 6d 61 73 6b 20   $@ groups>mask 
3d60: 69 6e 76 65 72 74 20 6b 65 2d 6d 61 73 6b 20 61  invert ke-mask a
3d70: 6e 64 21 20 3b 0a 3a 20 2b 67 72 6f 75 70 2d 70  nd! ;.: +group-p
3d80: 65 72 6d 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29  erm ( o:key -- )
3d90: 0a 20 20 20 20 6b 65 2d 67 72 6f 75 70 73 20 24  .    ke-groups $
3da0: 40 20 67 72 6f 75 70 73 3e 6d 61 73 6b 20 20 20  @ groups>mask   
3db0: 20 20 20 20 20 6b 65 2d 6d 61 73 6b 20 6f 72 21       ke-mask or!
3dc0: 20 3b 0a 0a 3a 20 61 64 64 2d 67 72 6f 75 70 20   ;..: add-group 
3dd0: 28 20 69 64 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a  ( id o:key -- ).
3de0: 20 20 20 20 64 75 70 20 2d 31 20 3d 20 21 21 6e      dup -1 = !!n
3df0: 6f 2d 67 72 6f 75 70 21 21 20 2d 67 72 6f 75 70  o-group!! -group
3e00: 2d 70 65 72 6d 20 75 3e 36 34 20 63 6d 64 74 6d  -perm u>64 cmdtm
3e10: 70 24 20 6b 65 2d 67 72 6f 75 70 73 20 24 2b 21  p$ ke-groups $+!
3e20: 20 2b 67 72 6f 75 70 2d 70 65 72 6d 20 3b 0a 3a   +group-perm ;.:
3e30: 20 73 65 74 2d 67 72 6f 75 70 20 28 20 69 64 20   set-group ( id 
3e40: 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 64  o:key -- ).    d
3e50: 75 70 20 2d 31 20 3d 20 21 21 6e 6f 2d 67 72 6f  up -1 = !!no-gro
3e60: 75 70 21 21 20 2d 67 72 6f 75 70 2d 70 65 72 6d  up!! -group-perm
3e70: 20 75 3e 36 34 20 63 6d 64 74 6d 70 24 20 6b 65   u>64 cmdtmp$ ke
3e80: 2d 67 72 6f 75 70 73 20 24 21 20 2b 67 72 6f 75  -groups $! +grou
3e90: 70 2d 70 65 72 6d 20 3b 0a 3a 20 73 75 62 2d 67  p-perm ;.: sub-g
3ea0: 72 6f 75 70 20 28 20 69 64 20 6f 3a 6b 65 79 20  roup ( id o:key 
3eb0: 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 2d 31 20  -- ).    dup -1 
3ec0: 3d 20 21 21 6e 6f 2d 67 72 6f 75 70 21 21 20 2d  = !!no-group!! -
3ed0: 67 72 6f 75 70 2d 70 65 72 6d 20 75 3e 36 34 20  group-perm u>64 
3ee0: 63 6d 64 74 6d 70 24 20 6b 65 2d 67 72 6f 75 70  cmdtmp$ ke-group
3ef0: 73 20 24 40 20 32 6f 76 65 72 20 73 65 61 72 63  s $@ 2over searc
3f00: 68 0a 20 20 20 20 49 46 20 20 20 6e 69 70 20 3e  h.    IF   nip >
3f10: 72 20 6e 69 70 20 6b 65 2d 67 72 6f 75 70 73 20  r nip ke-groups 
3f20: 64 75 70 20 24 40 6c 65 6e 20 72 3e 20 2d 20 72  dup $@len r> - r
3f30: 6f 74 20 24 64 65 6c 0a 20 20 20 20 45 4c 53 45  ot $del.    ELSE
3f40: 20 20 32 64 72 6f 70 20 32 64 72 6f 70 20 20 54    2drop 2drop  T
3f50: 48 45 4e 20 2b 67 72 6f 75 70 2d 70 65 72 6d 20  HEN +group-perm 
3f60: 3b 0a 0a 3a 20 61 70 70 6c 79 2d 67 72 6f 75 70  ;..: apply-group
3f70: 20 28 20 61 64 64 72 20 75 20 6f 3a 6b 65 79 20   ( addr u o:key 
3f80: 2d 2d 20 29 0a 20 20 20 20 6f 76 65 72 20 63 40  -- ).    over c@
3f90: 20 27 2b 27 20 3d 20 49 46 20 20 31 20 2f 73 74   '+' = IF  1 /st
3fa0: 72 69 6e 67 20 3e 67 72 6f 75 70 2d 69 64 20 61  ring >group-id a
3fb0: 64 64 2d 67 72 6f 75 70 20 2e 6b 65 79 2d 6c 69  dd-group .key-li
3fc0: 73 74 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20  st  EXIT  THEN. 
3fd0: 20 20 20 6f 76 65 72 20 63 40 20 27 2d 27 20 3d     over c@ '-' =
3fe0: 20 49 46 20 20 31 20 2f 73 74 72 69 6e 67 20 3e   IF  1 /string >
3ff0: 67 72 6f 75 70 2d 69 64 20 73 75 62 2d 67 72 6f  group-id sub-gro
4000: 75 70 20 2e 6b 65 79 2d 6c 69 73 74 20 20 45 58  up .key-list  EX
4010: 49 54 20 20 54 48 45 4e 0a 20 20 20 20 3e 67 72  IT  THEN.    >gr
4020: 6f 75 70 2d 69 64 20 73 65 74 2d 67 72 6f 75 70  oup-id set-group
4030: 20 2e 6b 65 79 2d 6c 69 73 74 20 3b 0a 0a 5c 20   .key-list ;..\ 
4040: 67 65 74 20 70 61 73 73 70 68 72 61 73 65 0a 0a  get passphrase..
4050: 33 20 56 61 6c 75 65 20 70 61 73 73 70 68 72 61  3 Value passphra
4060: 73 65 2d 72 65 74 72 79 23 0a 24 31 30 30 20 43  se-retry#.$100 C
4070: 6f 6e 73 74 61 6e 74 20 6d 61 78 2d 70 61 73 73  onstant max-pass
4080: 70 68 72 61 73 65 23 20 5c 20 32 35 36 20 63 68  phrase# \ 256 ch
4090: 61 72 61 63 74 65 72 73 20 73 68 6f 75 6c 64 20  aracters should 
40a0: 62 65 20 65 6e 6f 75 67 68 2e 2e 2e 0a 6d 61 78  be enough....max
40b0: 2d 70 61 73 73 70 68 72 61 73 65 23 20 62 75 66  -passphrase# buf
40c0: 66 65 72 3a 20 70 61 73 73 70 68 72 61 73 65 0a  fer: passphrase.
40d0: 0a 3a 20 70 61 73 73 70 68 72 61 73 65 2d 69 6e  .: passphrase-in
40e0: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 64   ( addr u -- add
40f0: 72 20 75 20 29 0a 20 20 20 20 22 50 41 53 53 50  r u ).    "PASSP
4100: 48 52 41 53 45 22 20 67 65 74 65 6e 76 20 32 64  HRASE" getenv 2d
4110: 75 70 20 64 30 3d 20 49 46 20 20 32 64 72 6f 70  up d0= IF  2drop
4120: 20 74 79 70 65 0a 09 70 61 73 73 70 68 72 61 73   type..passphras
4130: 65 20 64 75 70 20 6d 61 78 2d 70 61 73 73 70 68  e dup max-passph
4140: 72 61 73 65 23 20 61 63 63 65 70 74 2a 20 63 72  rase# accept* cr
4150: 0a 20 20 20 20 45 4c 53 45 20 20 32 6e 69 70 20  .    ELSE  2nip 
4160: 20 54 48 45 4e 20 3b 0a 0a 3a 20 3e 70 61 73 73   THEN ;..: >pass
4170: 70 68 72 61 73 65 20 28 20 61 64 64 72 20 75 20  phrase ( addr u 
4180: 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20  -- addr u ).    
4190: 5c 47 20 63 72 65 61 74 65 20 61 20 35 31 32 20  \G create a 512 
41a0: 62 69 74 20 68 61 73 68 20 6f 66 20 74 68 65 20  bit hash of the 
41b0: 70 61 73 73 70 68 72 61 73 65 0a 20 20 20 20 6e  passphrase.    n
41c0: 6f 2d 6b 65 79 20 3e 63 3a 6b 65 79 20 63 3a 68  o-key >c:key c:h
41d0: 61 73 68 0a 20 20 20 20 6b 65 63 63 61 6b 2d 70  ash.    keccak-p
41e0: 61 64 64 65 64 20 63 3a 6b 65 79 3e 20 6b 65 63  added c:key> kec
41f0: 63 61 6b 2d 70 61 64 64 65 64 20 6b 65 63 63 61  cak-padded kecca
4200: 6b 23 6d 61 78 20 32 2f 20 3b 0a 0a 3a 20 67 65  k#max 2/ ;..: ge
4210: 74 2d 70 61 73 73 70 68 72 61 73 65 20 28 20 61  t-passphrase ( a
4220: 64 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 20  ddr u -- addr u 
4230: 29 0a 20 20 20 20 70 61 73 73 70 68 72 61 73 65  ).    passphrase
4240: 2d 69 6e 20 3e 70 61 73 73 70 68 72 61 73 65 20  -in >passphrase 
4250: 3b 0a 0a 56 61 72 69 61 62 6c 65 20 6b 65 79 73  ;..Variable keys
4260: 0a 0a 3a 20 6c 61 73 74 6b 65 79 40 20 28 20 2d  ..: lastkey@ ( -
4270: 2d 20 61 64 64 72 20 75 20 29 20 6b 65 79 73 20  - addr u ) keys 
4280: 24 5b 5d 23 20 31 2d 20 6b 65 79 73 20 73 65 63  $[]# 1- keys sec
4290: 5b 5d 40 20 3b 0a 3a 20 6b 65 79 3e 64 65 66 61  []@ ;.: key>defa
42a0: 75 6c 74 20 28 20 2d 2d 20 29 20 6c 61 73 74 6b  ult ( -- ) lastk
42b0: 65 79 40 20 64 72 6f 70 20 3e 73 74 6f 72 65 6b  ey@ drop >storek
42c0: 65 79 20 21 20 3b 0a 3a 20 2b 6b 65 79 20 28 20  ey ! ;.: +key ( 
42d0: 61 64 64 72 20 75 20 2d 2d 20 29 20 6b 65 79 73  addr u -- ) keys
42e0: 20 73 65 63 2b 5b 5d 21 20 3b 0a 3a 20 2b 70 61   sec+[]! ;.: +pa
42f0: 73 73 70 68 72 61 73 65 20 28 20 61 64 64 72 20  ssphrase ( addr 
4300: 75 20 2d 2d 20 29 20 20 67 65 74 2d 70 61 73 73  u -- )  get-pass
4310: 70 68 72 61 73 65 20 2b 6b 65 79 20 3b 0a 3a 20  phrase +key ;.: 
4320: 2b 63 68 65 63 6b 70 68 72 61 73 65 20 28 20 61  +checkphrase ( a
4330: 64 64 72 20 75 20 2d 2d 20 66 6c 61 67 20 29 20  ddr u -- flag ) 
4340: 67 65 74 2d 70 61 73 73 70 68 72 61 73 65 20 6c  get-passphrase l
4350: 61 73 74 6b 65 79 40 20 73 74 72 3d 20 3b 0a 3a  astkey@ str= ;.:
4360: 20 2b 6e 65 77 70 68 72 61 73 65 20 28 20 2d 2d   +newphrase ( --
4370: 20 29 0a 20 20 20 20 42 45 47 49 4e 0a 09 73 22   ).    BEGIN..s"
4380: 20 50 61 73 73 70 68 72 61 73 65 3a 20 22 20 2b   Passphrase: " +
4390: 70 61 73 73 70 68 72 61 73 65 0a 09 73 22 20 52  passphrase..s" R
43a0: 65 74 79 70 65 20 70 6c 73 3a 20 22 20 2b 63 68  etype pls: " +ch
43b0: 65 63 6b 70 68 72 61 73 65 20 30 3d 20 57 48 49  eckphrase 0= WHI
43c0: 4c 45 0a 09 20 20 20 20 63 72 20 2e 22 20 20 64  LE..    cr ."  d
43d0: 69 64 6e 27 74 20 6d 61 74 63 68 2c 20 74 72 79  idn't match, try
43e0: 20 61 67 61 69 6e 20 70 6c 65 61 73 65 22 20 63   again please" c
43f0: 72 0a 20 20 20 20 52 45 50 45 41 54 20 63 72 20  r.    REPEAT cr 
4400: 3b 0a 0a 3a 20 22 3e 70 61 73 73 70 68 72 61 73  ;..: ">passphras
4410: 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20  e ( addr u -- ) 
4420: 3e 70 61 73 73 70 68 72 61 73 65 20 2b 6b 65 79  >passphrase +key
4430: 20 3b 0a 3a 20 3e 73 65 63 6b 65 79 20 28 20 2d   ;.: >seckey ( -
4440: 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 6b  - addr u ).    k
4450: 65 2d 73 6b 20 40 20 6b 65 2d 70 6b 20 24 40 20  e-sk @ ke-pk $@ 
4460: 64 72 6f 70 20 6b 65 79 70 61 64 20 65 64 2d 64  drop keypad ed-d
4470: 68 20 3b 0a 3a 20 2b 73 65 63 6b 65 79 20 28 20  h ;.: +seckey ( 
4480: 2d 2d 20 29 20 3e 73 65 63 6b 65 79 20 2b 6b 65  -- ) >seckey +ke
4490: 79 20 3b 0a 0a 5c 20 22 22 20 22 3e 70 61 73 73  y ;..\ "" ">pass
44a0: 70 68 72 61 73 65 20 5c 20 66 6f 6c 6c 6f 77 69  phrase \ followi
44b0: 6e 67 20 74 68 65 20 65 6e 63 72 79 70 74 2d 65  ng the encrypt-e
44c0: 76 65 72 79 74 68 69 6e 67 20 70 61 72 61 64 69  verything paradi
44d0: 67 6d 2c 0a 5c 20 6e 6f 20 70 61 73 73 77 6f 72  gm,.\ no passwor
44e0: 64 20 69 73 20 74 68 65 20 65 6d 70 74 79 20 73  d is the empty s
44f0: 74 72 69 6e 67 21 20 20 49 74 27 73 20 73 74 69  tring!  It's sti
4500: 6c 6c 20 65 6e 63 72 79 70 74 65 64 20 3b 2d 29  ll encrypted ;-)
4510: 21 0a 0a 5c 20 61 20 73 65 63 72 65 74 20 6b 65  !..\ a secret ke
4520: 79 20 6a 75 73 74 20 6e 65 65 64 73 20 61 20 6e  y just needs a n
4530: 69 63 6b 20 61 6e 64 20 61 20 74 79 70 65 2e 0a  ick and a type..
4540: 5c 20 53 65 63 72 65 74 20 6b 65 79 73 20 63 61  \ Secret keys ca
4550: 6e 20 62 65 20 70 65 72 73 6f 6e 73 20 61 6e 64  n be persons and
4560: 20 67 72 6f 75 70 73 2e 0a 0a 5c 20 61 20 70 75   groups...\ a pu
4570: 62 6c 69 63 20 6b 65 79 20 6e 65 65 64 73 20 6d  blic key needs m
4580: 6f 72 65 3a 20 6e 69 63 6b 2c 20 74 79 70 65 2c  ore: nick, type,
4590: 20 70 72 6f 66 69 6c 65 2e 0a 5c 20 54 68 65 20   profile..\ The 
45a0: 70 72 6f 66 69 6c 65 20 69 73 20 61 20 73 74 72  profile is a str
45b0: 75 63 74 75 72 65 64 20 64 6f 63 75 6d 65 6e 74  uctured document
45c0: 2c 20 69 2e 65 2e 20 70 6f 69 6e 74 65 64 20 74  , i.e. pointed t
45d0: 6f 20 62 79 20 61 20 68 61 73 68 2e 0a 0a 5c 20  o by a hash...\ 
45e0: 61 20 73 69 67 6e 61 74 75 72 65 20 63 6f 6e 74  a signature cont
45f0: 61 69 6e 73 20 61 20 70 75 62 6b 65 79 2c 20 61  ains a pubkey, a
4600: 20 63 68 65 63 6b 62 6f 78 20 62 69 74 6d 61 73   checkbox bitmas
4610: 6b 2c 0a 5c 20 61 20 64 61 74 65 2c 20 61 6e 20  k,.\ a date, an 
4620: 65 78 70 69 72 61 74 69 6f 6e 20 64 61 74 65 2c  expiration date,
4630: 20 74 68 65 20 73 69 67 6e 65 72 27 73 20 70 75   the signer's pu
4640: 62 6b 65 79 20 61 6e 64 20 74 68 65 20 73 69 67  bkey and the sig
4650: 6e 61 74 75 72 65 20 69 74 73 65 6c 66 0a 5c 20  nature itself.\ 
4660: 28 72 2b 73 29 2e 20 20 54 68 65 72 65 20 69 73  (r+s).  There is
4670: 20 61 6e 20 6f 70 74 69 6f 6e 61 6c 20 73 69 67   an optional sig
4680: 6e 69 6e 67 20 70 72 6f 74 6f 63 6f 6c 20 64 6f  ning protocol do
4690: 63 75 6d 65 6e 74 20 28 68 61 73 68 29 2e 0a 0a  cument (hash)...
46a0: 5c 20 77 65 20 73 74 6f 72 65 20 65 61 63 68 20  \ we store each 
46b0: 69 74 65 6d 20 69 6e 20 61 20 32 35 36 20 62 79  item in a 256 by
46c0: 74 65 73 20 65 6e 63 72 79 70 74 65 64 20 73 74  tes encrypted st
46d0: 72 69 6e 67 2c 20 69 2e 65 2e 20 77 69 74 68 20  ring, i.e. with 
46e0: 61 20 31 36 0a 5c 20 62 79 74 65 20 73 61 6c 74  a 16.\ byte salt
46f0: 20 61 6e 64 20 61 20 31 36 20 62 79 74 65 20 63   and a 16 byte c
4700: 68 65 63 6b 73 75 6d 2e 0a 0a 3a 20 6b 65 2d 6c  hecksum...: ke-l
4710: 61 73 74 21 20 28 20 36 34 64 61 74 65 20 2d 2d  ast! ( 64date --
4720: 20 29 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73 69   ).    ke-selfsi
4730: 67 20 24 40 6c 65 6e 20 24 31 30 20 75 6d 61 78  g $@len $10 umax
4740: 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 21 6c 65   ke-selfsig $!le
4750: 6e 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73 69 67  n.    ke-selfsig
4760: 20 24 40 20 64 72 6f 70 20 36 34 27 2b 20 36 34   $@ drop 64'+ 64
4770: 21 20 3b 0a 3a 20 6b 65 2d 66 69 72 73 74 21 20  ! ;.: ke-first! 
4780: 28 20 36 34 64 61 74 65 20 2d 2d 20 29 20 36 34  ( 64date -- ) 64
4790: 23 2d 31 20 6b 65 2d 6c 61 73 74 21 0a 20 20 20  #-1 ke-last!.   
47a0: 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 20 64   ke-selfsig $@ d
47b0: 72 6f 70 20 36 34 21 20 3b 0a 0a 73 63 6f 70 65  rop 64! ;..scope
47c0: 7b 20 6e 65 74 32 6f 2d 62 61 73 65 0a 0a 63 6d  { net2o-base..cm
47d0: 64 2d 74 61 62 6c 65 20 24 40 20 69 6e 68 65 72  d-table $@ inher
47e0: 69 74 2d 74 61 62 6c 65 20 6b 65 79 2d 65 6e 74  it-table key-ent
47f0: 72 79 2d 74 61 62 6c 65 0a 5c 67 20 0a 5c 67 20  ry-table.\g .\g 
4800: 23 23 23 20 6b 65 79 20 73 74 6f 72 61 67 65 20  ### key storage 
4810: 63 6f 6d 6d 61 6e 64 73 20 23 23 23 0a 5c 67 20  commands ###.\g 
4820: 0a 24 31 31 20 6e 65 74 32 6f 3a 20 70 72 69 76  .$11 net2o: priv
4830: 6b 65 79 20 28 20 24 3a 73 74 72 69 6e 67 20 2d  key ( $:string -
4840: 2d 20 29 0a 20 20 20 20 5c 67 20 70 72 69 76 61  - ).    \g priva
4850: 74 65 20 6b 65 79 0a 20 20 20 20 5c 20 64 6f 65  te key.    \ doe
4860: 73 20 6e 6f 74 20 6e 65 65 64 20 74 6f 20 62 65  s not need to be
4870: 20 73 69 67 6e 65 64 2c 20 74 68 65 20 73 65 63   signed, the sec
4880: 72 65 74 20 6b 65 79 20 76 65 72 69 66 69 65 73  ret key verifies
4890: 20 69 74 73 65 6c 66 0a 20 20 20 20 21 21 75 6e   itself.    !!un
48a0: 73 69 67 6e 65 64 3f 20 24 34 30 20 21 21 3e 3d  signed? $40 !!>=
48b0: 6f 72 64 65 72 3f 0a 20 20 20 20 6b 65 79 70 61  order?.    keypa
48c0: 63 6b 20 63 40 20 24 46 20 61 6e 64 20 6b 65 2d  ck c@ $F and ke-
48d0: 70 77 6c 65 76 65 6c 20 21 0a 20 20 20 20 24 3e  pwlevel !.    $>
48e0: 20 6f 76 65 72 20 6b 65 79 70 61 64 20 73 6b 3e   over keypad sk>
48f0: 70 6b 20 5c 20 67 65 6e 65 72 61 74 65 20 70 75  pk \ generate pu
4900: 62 6b 65 79 0a 20 20 20 20 6b 65 79 70 61 64 20  bkey.    keypad 
4910: 6b 65 2d 70 6b 20 24 40 20 64 72 6f 70 20 6b 65  ke-pk $@ drop ke
4920: 79 73 69 7a 65 20 74 75 63 6b 20 73 74 72 3d 20  ysize tuck str= 
4930: 30 3d 20 21 21 77 72 6f 6e 67 2d 6b 65 79 21 21  0= !!wrong-key!!
4940: 0a 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 21 20  .    ke-sk sec! 
4950: 2b 73 65 63 6b 65 79 20 22 5c 30 22 20 6b 65 2d  +seckey "\0" ke-
4960: 67 72 6f 75 70 73 20 24 21 20 30 20 67 72 6f 75  groups $! 0 grou
4970: 70 73 5b 5d 20 24 5b 5d 40 20 64 72 6f 70 20 40  ps[] $[]@ drop @
4980: 20 6b 65 2d 6d 61 73 6b 20 21 20 3b 0a 2b 6e 65   ke-mask ! ;.+ne
4990: 74 32 6f 3a 20 6b 65 79 74 79 70 65 20 28 20 6e  t2o: keytype ( n
49a0: 20 2d 2d 20 29 20 20 20 20 20 20 20 20 20 20 20   -- )           
49b0: 21 21 73 69 67 6e 65 64 3f 20 20 20 31 20 21 21  !!signed?   1 !!
49c0: 3e 6f 72 64 65 72 3f 20 36 34 3e 6e 20 6b 65 2d  >order? 64>n ke-
49d0: 74 79 70 65 20 21 20 3b 0a 20 20 20 20 5c 67 20  type ! ;.    \g 
49e0: 6b 65 79 20 74 79 70 65 20 28 30 3a 20 61 6e 6f  key type (0: ano
49f0: 6e 2c 20 31 3a 20 75 73 65 72 2c 20 32 3a 20 67  n, 1: user, 2: g
4a00: 72 6f 75 70 29 0a 2b 6e 65 74 32 6f 3a 20 6b 65  roup).+net2o: ke
4a10: 79 6e 69 63 6b 20 28 20 24 3a 73 74 72 69 6e 67  ynick ( $:string
4a20: 20 2d 2d 20 29 20 20 20 20 21 21 73 69 67 6e 65   -- )    !!signe
4a30: 64 3f 20 20 20 32 20 21 21 3e 6f 72 64 65 72 3f  d?   2 !!>order?
4a40: 20 24 3e 20 6b 65 2d 6e 69 63 6b 20 24 21 0a 20   $> ke-nick $!. 
4a50: 20 20 20 5c 67 20 6b 65 79 20 6e 69 63 6b 0a 20     \g key nick. 
4a60: 20 20 20 6e 69 63 6b 21 20 3b 0a 2b 6e 65 74 32     nick! ;.+net2
4a70: 6f 3a 20 6b 65 79 70 72 6f 66 69 6c 65 20 28 20  o: keyprofile ( 
4a80: 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 21 21  $:string -- ) !!
4a90: 73 69 67 6e 65 64 3f 20 20 20 34 20 21 21 3e 6f  signed?   4 !!>o
4aa0: 72 64 65 72 3f 20 24 3e 20 6b 65 2d 70 72 6f 66  rder? $> ke-prof
4ab0: 20 24 21 20 3b 0a 20 20 20 20 5c 67 20 6b 65 79   $! ;.    \g key
4ac0: 20 70 72 6f 66 69 6c 65 20 28 68 61 73 68 20 6f   profile (hash o
4ad0: 66 20 61 20 72 65 73 6f 75 72 63 65 29 0a 2b 6e  f a resource).+n
4ae0: 65 74 32 6f 3a 20 6b 65 79 6d 61 73 6b 20 28 20  et2o: keymask ( 
4af0: 78 20 2d 2d 20 29 20 20 20 20 20 20 20 20 20 21  x -- )         !
4b00: 21 75 6e 73 69 67 6e 65 64 3f 20 24 34 30 20 21  !unsigned? $40 !
4b10: 21 3e 3d 6f 72 64 65 72 3f 20 36 34 3e 6e 0a 20  !>=order? 64>n. 
4b20: 20 20 20 5c 67 20 6b 65 79 20 61 63 63 65 73 73     \g key access
4b30: 20 72 69 67 68 74 20 6d 61 73 6b 0a 20 20 20 20   right mask.    
4b40: 31 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 40 20  1 import-type @ 
4b50: 6c 73 68 69 66 74 0a 20 20 20 20 5b 20 31 20 69  lshift.    [ 1 i
4b60: 6d 70 6f 72 74 23 73 65 6c 66 20 6c 73 68 69 66  mport#self lshif
4b70: 74 20 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c  t 1 import#new l
4b80: 73 68 69 66 74 20 6f 72 20 5d 4c 0a 20 20 20 20  shift or ]L.    
4b90: 61 6e 64 20 30 3d 20 49 46 20 20 64 72 6f 70 20  and 0= IF  drop 
4ba0: 70 65 72 6d 25 64 65 66 61 75 6c 74 20 20 54 48  perm%default  TH
4bb0: 45 4e 20 20 64 75 70 20 6b 65 2d 6d 61 73 6b 20  EN  dup ke-mask 
4bc0: 6f 72 21 20 3f 3e 67 72 6f 75 70 73 20 3b 0a 2b  or! ?>groups ;.+
4bd0: 6e 65 74 32 6f 3a 20 6b 65 79 67 72 6f 75 70 73  net2o: keygroups
4be0: 20 28 20 24 3a 67 72 6f 75 70 73 20 2d 2d 20 29   ( $:groups -- )
4bf0: 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 32 30   !!unsigned? $20
4c00: 20 21 21 3e 6f 72 64 65 72 3f 20 24 3e 0a 20 20   !!>order? $>.  
4c10: 20 20 5c 67 20 61 63 63 65 73 73 20 67 72 6f 75    \g access grou
4c20: 70 73 0a 20 20 20 20 31 20 69 6d 70 6f 72 74 2d  ps.    1 import-
4c30: 74 79 70 65 20 40 20 6c 73 68 69 66 74 0a 20 20  type @ lshift.  
4c40: 20 20 5b 20 31 20 69 6d 70 6f 72 74 23 73 65 6c    [ 1 import#sel
4c50: 66 20 6c 73 68 69 66 74 20 31 20 69 6d 70 6f 72  f lshift 1 impor
4c60: 74 23 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 20  t#new lshift or 
4c70: 5d 4c 0a 20 20 20 20 61 6e 64 20 30 3d 20 49 46  ]L.    and 0= IF
4c80: 20 20 32 64 72 6f 70 20 22 5c 78 30 31 22 20 20    2drop "\x01"  
4c90: 54 48 45 4e 0a 20 20 20 20 32 64 75 70 20 6b 65  THEN.    2dup ke
4ca0: 2d 67 72 6f 75 70 73 20 24 21 20 67 72 6f 75 70  -groups $! group
4cb0: 73 3e 6d 61 73 6b 20 6b 65 2d 6d 61 73 6b 20 21  s>mask ke-mask !
4cc0: 20 3b 0a 2b 6e 65 74 32 6f 3a 20 2b 6b 65 79 73   ;.+net2o: +keys
4cd0: 69 67 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d  ig ( $:string --
4ce0: 20 29 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20   )  !!unsigned? 
4cf0: 24 31 30 20 21 21 3e 3d 6f 72 64 65 72 3f 20 24  $10 !!>=order? $
4d00: 3e 20 6b 65 2d 73 69 67 73 5b 5d 20 24 2b 5b 5d  > ke-sigs[] $+[]
4d10: 21 20 3b 0a 20 20 20 20 5c 67 20 61 64 64 20 61  ! ;.    \g add a
4d20: 20 6b 65 79 20 73 69 67 6e 61 74 75 72 65 0a 2b   key signature.+
4d30: 6e 65 74 32 6f 3a 20 6b 65 79 69 6d 70 6f 72 74  net2o: keyimport
4d40: 20 28 20 6e 20 2d 2d 20 29 20 20 20 20 20 20 20   ( n -- )       
4d50: 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 31 30 20  !!unsigned? $10 
4d60: 21 21 3e 3d 6f 72 64 65 72 3f 0a 20 20 20 20 63  !!>=order?.    c
4d70: 6f 6e 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23 20  onfig:pw-level# 
4d80: 40 20 30 3c 20 49 46 20 20 36 34 3e 6e 0a 09 64  @ 0< IF  64>n..d
4d90: 75 70 20 5b 20 31 20 69 6d 70 6f 72 74 23 6e 65  up [ 1 import#ne
4da0: 77 20 6c 73 68 69 66 74 20 5d 4c 20 61 6e 64 20  w lshift ]L and 
4db0: 30 3d 20 49 46 0a 09 20 20 20 20 69 6d 70 6f 72  0= IF..    impor
4dc0: 74 23 75 6e 74 72 75 73 74 65 64 20 75 6d 69 6e  t#untrusted umin
4dd0: 20 31 20 73 77 61 70 20 6c 73 68 69 66 74 20 5b   1 swap lshift [
4de0: 20 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73   1 import#new ls
4df0: 68 69 66 74 20 5d 4c 20 6f 72 0a 09 45 4c 53 45  hift ]L or..ELSE
4e00: 0a 09 20 20 20 20 5b 20 32 20 69 6d 70 6f 72 74  ..    [ 2 import
4e10: 23 75 6e 74 72 75 73 74 65 64 20 6c 73 68 69 66  #untrusted lshif
4e20: 74 20 31 2d 20 31 20 69 6d 70 6f 72 74 23 6e 65  t 1- 1 import#ne
4e30: 77 20 6c 73 68 69 66 74 20 6f 72 20 5d 4c 20 61  w lshift or ]L a
4e40: 6e 64 0a 09 54 48 45 4e 0a 09 6b 65 2d 69 6d 70  nd..THEN..ke-imp
4e50: 6f 72 74 73 20 6f 72 21 0a 20 20 20 20 45 4c 53  orts or!.    ELS
4e60: 45 20 20 36 34 64 72 6f 70 20 20 54 48 45 4e 20  E  64drop  THEN 
4e70: 3b 0a 2b 6e 65 74 32 6f 3a 20 72 73 6b 6b 65 79  ;.+net2o: rskkey
4e80: 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 2d 20   ( $:string --- 
4e90: 29 0a 20 20 20 20 5c 67 20 72 65 76 6f 6b 65 20  ).    \g revoke 
4ea0: 6b 65 79 2c 20 74 65 6d 70 6f 72 61 72 69 6c 79  key, temporarily
4eb0: 20 73 74 6f 72 65 64 0a 20 20 20 20 5c 20 64 6f   stored.    \ do
4ec0: 65 73 20 6e 6f 74 20 6e 65 65 64 20 74 6f 20 62  es not need to b
4ed0: 65 20 73 69 67 6e 65 64 2c 20 74 68 65 20 72 65  e signed, the re
4ee0: 76 6f 6b 65 20 6b 65 79 20 76 65 72 69 66 69 65  voke key verifie
4ef0: 73 20 69 74 73 65 6c 66 0a 20 20 20 20 21 21 75  s itself.    !!u
4f00: 6e 73 69 67 6e 65 64 3f 20 24 38 30 20 21 21 3e  nsigned? $80 !!>
4f10: 3d 6f 72 64 65 72 3f 0a 20 20 20 20 24 3e 20 32  =order?.    $> 2
4f20: 64 75 70 20 73 6b 72 65 76 20 73 77 61 70 20 6b  dup skrev swap k
4f30: 65 79 7c 20 6d 6f 76 65 20 6b 65 2d 70 6b 20 24  ey| move ke-pk $
4f40: 40 20 64 72 6f 70 20 63 68 65 63 6b 2d 72 65 76  @ drop check-rev
4f50: 3f 20 30 3d 20 21 21 6e 6f 74 2d 6d 79 2d 72 65  ? 0= !!not-my-re
4f60: 76 73 6b 21 21 0a 20 20 20 20 70 6b 72 65 76 20  vsk!!.    pkrev 
4f70: 6b 65 79 73 69 7a 65 32 20 65 72 61 73 65 20 20  keysize2 erase  
4f80: 6b 65 2d 72 73 6b 20 73 65 63 21 20 3b 0a 2b 6e  ke-rsk sec! ;.+n
4f90: 65 74 32 6f 3a 20 6b 65 79 70 65 74 20 28 20 24  et2o: keypet ( $
4fa0: 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 20 21 21  :string -- )  !!
4fb0: 75 6e 73 69 67 6e 65 64 3f 20 20 24 3e 0a 20 20  unsigned?  $>.  
4fc0: 20 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76 65    config:pw-leve
4fd0: 6c 23 20 40 20 30 3c 20 49 46 20 20 6b 65 2d 70  l# @ 0< IF  ke-p
4fe0: 65 74 73 5b 5d 20 24 2b 5b 5d 21 20 70 65 74 21  ets[] $+[]! pet!
4ff0: 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54    ELSE  2drop  T
5000: 48 45 4e 20 3b 0a 7d 73 63 6f 70 65 0a 0a 67 65  HEN ;.}scope..ge
5010: 6e 2d 74 61 62 6c 65 20 24 66 72 65 65 7a 65 0a  n-table $freeze.
5020: 27 20 63 6f 6e 74 65 78 74 2d 74 61 62 6c 65 20  ' context-table 
5030: 69 73 20 67 65 6e 2d 74 61 62 6c 65 0a 0a 3a 20  is gen-table..: 
5040: 6b 65 79 3a 6e 65 73 74 2d 73 69 67 20 28 20 61  key:nest-sig ( a
5050: 64 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 27  ddr u -- addr u'
5060: 20 66 6c 61 67 20 29 0a 20 20 20 20 70 6b 32 2d   flag ).    pk2-
5070: 73 69 67 3f 20 64 75 70 20 3f 45 58 49 54 20 64  sig? dup ?EXIT d
5080: 72 6f 70 0a 20 20 20 20 32 64 75 70 20 2b 20 73  rop.    2dup + s
5090: 69 67 73 69 7a 65 23 20 2d 20 73 69 67 73 69 7a  igsize# - sigsiz
50a0: 65 23 20 3e 24 0a 20 20 20 20 73 69 67 70 6b 32  e# >$.    sigpk2
50b0: 73 69 7a 65 23 20 2d 20 32 64 75 70 20 2b 20 6b  size# - 2dup + k
50c0: 65 79 73 69 7a 65 32 20 6b 65 79 3f 6e 65 77 20  eysize2 key?new 
50d0: 6e 3a 3e 6f 20 24 3e 20 6b 65 2d 73 65 6c 66 73  n:>o $> ke-selfs
50e0: 69 67 20 24 21 0a 20 20 20 20 73 69 6d 2d 6e 69  ig $!.    sim-ni
50f0: 63 6b 21 20 6f 66 66 20 63 2d 73 74 61 74 65 20  ck! off c-state 
5100: 6f 66 66 20 73 69 67 2d 6f 6b 20 3b 0a 27 20 6b  off sig-ok ;.' k
5110: 65 79 3a 6e 65 73 74 2d 73 69 67 20 6b 65 79 2d  ey:nest-sig key-
5120: 65 6e 74 72 79 20 74 6f 20 6e 65 73 74 2d 73 69  entry to nest-si
5130: 67 0a 0a 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f  g..sample-key >o
5140: 20 6b 65 79 2d 65 6e 74 72 79 2d 74 61 62 6c 65   key-entry-table
5150: 20 40 20 74 6f 6b 65 6e 2d 74 61 62 6c 65 20 21   @ token-table !
5160: 20 6f 3e 0a 0a 3a 20 6b 65 79 3a 63 6f 64 65 20   o>..: key:code 
5170: 28 20 2d 2d 20 29 0a 20 20 20 20 63 6f 64 65 2d  ( -- ).    code-
5180: 6b 65 79 20 20 63 6d 64 6c 6f 63 6b 20 6c 6f 63  key  cmdlock loc
5190: 6b 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 6b 65  k.    keypack ke
51a0: 79 70 61 63 6b 2d 61 6c 6c 23 20 65 72 61 73 65  ypack-all# erase
51b0: 0a 20 20 20 20 63 6d 64 72 65 73 65 74 20 69 6e  .    cmdreset in
51c0: 69 74 2d 72 65 70 6c 79 20 61 6c 73 6f 20 6e 65  it-reply also ne
51d0: 74 32 6f 2d 62 61 73 65 20 3b 0a 63 6f 6d 70 3a  t2o-base ;.comp:
51e0: 20 3a 2c 20 61 6c 73 6f 20 6e 65 74 32 6f 2d 62   :, also net2o-b
51f0: 61 73 65 20 3b 0a 0a 73 63 6f 70 65 7b 20 6e 65  ase ;..scope{ ne
5200: 74 32 6f 2d 62 61 73 65 0a 0a 3a 20 65 6e 64 3a  t2o-base..: end:
5210: 6b 65 79 20 28 20 2d 2d 20 29 0a 20 20 20 20 65  key ( -- ).    e
5220: 6e 64 2d 77 69 74 68 20 70 72 65 76 69 6f 75 73  nd-with previous
5230: 20 63 6d 64 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20   cmdlock unlock 
5240: 3b 0a 63 6f 6d 70 3a 20 3a 2c 20 70 72 65 76 69  ;.comp: :, previ
5250: 6f 75 73 20 3b 0a 0a 7d 73 63 6f 70 65 0a 0a 3a  ous ;..}scope..:
5260: 20 6b 65 79 2d 63 72 79 70 74 20 28 20 2d 2d 20   key-crypt ( -- 
5270: 29 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 6b 65  ).    keypack ke
5280: 79 70 61 63 6b 2d 61 6c 6c 23 0a 20 20 20 20 3e  ypack-all#.    >
5290: 73 74 6f 72 65 6b 65 79 20 73 65 63 40 20 64 75  storekey sec@ du
52a0: 70 20 24 32 30 20 75 3c 3d 20 5c 20 69 73 20 61  p $20 u<= \ is a
52b0: 20 73 65 63 72 65 74 2c 20 6e 6f 20 6e 65 65 64   secret, no need
52c0: 20 74 6f 20 62 65 20 73 6c 6f 77 0a 20 20 20 20   to be slow.    
52d0: 49 46 20 20 65 6e 63 72 79 70 74 24 20 20 45 4c  IF  encrypt$  EL
52e0: 53 45 20 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65  SE  config:pw-le
52f0: 76 65 6c 23 20 40 20 65 6e 63 72 79 70 74 2d 70  vel# @ encrypt-p
5300: 77 24 20 20 54 48 45 4e 20 3b 0a 0a 30 20 56 61  w$  THEN ;..0 Va
5310: 6c 75 65 20 6b 65 79 2d 73 66 64 20 5c 20 73 65  lue key-sfd \ se
5320: 63 72 65 74 20 6b 65 79 73 0a 30 20 56 61 6c 75  cret keys.0 Valu
5330: 65 20 6b 65 79 2d 70 66 64 20 5c 20 70 75 62 6b  e key-pfd \ pubk
5340: 65 79 73 0a 0a 5c 20 6c 65 67 61 63 79 20 66 6f  eys..\ legacy fo
5350: 72 20 65 61 72 6c 79 20 76 65 72 73 69 6f 6e 73  r early versions
5360: 20 6f 66 20 6e 65 74 32 6f 20 70 72 69 6f 72 20   of net2o prior 
5370: 32 30 31 36 30 36 30 36 0a 0a 3a 20 6e 65 74 32  20160606..: net2
5380: 6f 3e 6b 65 79 73 20 7b 20 61 64 64 72 20 75 20  o>keys { addr u 
5390: 2d 2d 20 7d 0a 20 20 20 20 61 64 64 72 20 75 20  -- }.    addr u 
53a0: 2e 6e 65 74 32 6f 2f 20 20 61 64 64 72 20 75 20  .net2o/  addr u 
53b0: 2e 6b 65 79 73 2f 20 72 65 6e 61 6d 65 2d 66 69  .keys/ rename-fi
53c0: 6c 65 20 64 72 6f 70 20 3b 0a 3a 20 3f 6c 65 67  le drop ;.: ?leg
53d0: 61 63 79 2d 6b 65 79 73 20 28 20 66 6c 61 67 20  acy-keys ( flag 
53e0: 2d 2d 20 29 0a 20 20 20 20 5c 20 21 21 46 49 58  -- ).    \ !!FIX
53f0: 4d 45 21 21 20 6e 65 65 64 73 20 74 6f 20 62 65  ME!! needs to be
5400: 20 72 65 6d 6f 76 65 64 20 77 68 65 6e 20 61 6c   removed when al
5410: 6c 20 63 75 72 72 65 6e 74 20 75 73 65 72 73 0a  l current users.
5420: 20 20 20 20 5c 20 68 61 76 65 20 6d 69 67 72 61      \ have migra
5430: 74 65 64 0a 20 20 20 20 49 46 0a 09 22 70 75 62  ted.    IF.."pub
5440: 6b 65 79 73 2e 6b 32 6f 22 20 6e 65 74 32 6f 3e  keys.k2o" net2o>
5450: 6b 65 79 73 0a 09 22 73 65 63 6b 65 79 73 2e 6b  keys.."seckeys.k
5460: 32 6f 22 20 6e 65 74 32 6f 3e 6b 65 79 73 0a 20  2o" net2o>keys. 
5470: 20 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 67 65 6e     THEN ;..: gen
5480: 2d 6b 65 79 73 2d 64 69 72 20 28 20 2d 2d 20 29  -keys-dir ( -- )
5490: 0a 20 20 20 20 69 6e 69 74 2d 64 69 72 73 20 3f  .    init-dirs ?
54a0: 2e 6e 65 74 32 6f 2f 6b 65 79 73 20 3f 6c 65 67  .net2o/keys ?leg
54b0: 61 63 79 2d 6b 65 79 73 0a 20 20 20 20 67 72 6f  acy-keys.    gro
54c0: 75 70 73 5b 5d 20 24 5b 5d 23 20 30 3d 20 49 46  ups[] $[]# 0= IF
54d0: 20 20 72 65 61 64 2d 67 72 6f 75 70 73 20 20 54    read-groups  T
54e0: 48 45 4e 20 3b 0a 0a 3a 20 3f 66 64 2d 6b 65 79  HEN ;..: ?fd-key
54f0: 73 20 28 20 66 64 20 61 64 64 72 20 75 20 2d 2d  s ( fd addr u --
5500: 20 66 64 27 20 29 20 7b 20 61 64 64 72 20 75 20   fd' ) { addr u 
5510: 7d 20 64 75 70 20 3f 45 58 49 54 20 64 72 6f 70  } dup ?EXIT drop
5520: 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 2d 64 69  .    gen-keys-di
5530: 72 0a 20 20 20 20 61 64 64 72 20 75 20 72 2f 77  r.    addr u r/w
5540: 20 6f 70 65 6e 2d 66 69 6c 65 20 64 75 70 20 6e   open-file dup n
5550: 6f 2d 66 69 6c 65 23 20 3d 20 49 46 0a 09 32 64  o-file# = IF..2d
5560: 72 6f 70 20 61 64 64 72 20 75 20 72 2f 77 20 63  rop addr u r/w c
5570: 72 65 61 74 65 2d 66 69 6c 65 0a 20 20 20 20 54  reate-file.    T
5580: 48 45 4e 20 20 74 68 72 6f 77 20 3b 0a 0a 3a 20  HEN  throw ;..: 
5590: 3f 6b 65 79 2d 73 66 64 20 28 20 2d 2d 20 66 64  ?key-sfd ( -- fd
55a0: 20 29 0a 20 20 20 20 6b 65 79 2d 73 66 64 20 22   ).    key-sfd "
55b0: 73 65 63 6b 65 79 73 2e 6b 32 6f 22 20 2e 6b 65  seckeys.k2o" .ke
55c0: 79 73 2f 20 3f 66 64 2d 6b 65 79 73 20 64 75 70  ys/ ?fd-keys dup
55d0: 20 74 6f 20 6b 65 79 2d 73 66 64 20 3b 0a 3a 20   to key-sfd ;.: 
55e0: 3f 6b 65 79 2d 70 66 64 20 28 20 2d 2d 20 66 64  ?key-pfd ( -- fd
55f0: 20 29 0a 20 20 20 20 6b 65 79 2d 70 66 64 20 22   ).    key-pfd "
5600: 70 75 62 6b 65 79 73 2e 6b 32 6f 22 20 2e 6b 65  pubkeys.k2o" .ke
5610: 79 73 2f 20 3f 66 64 2d 6b 65 79 73 20 64 75 70  ys/ ?fd-keys dup
5620: 20 74 6f 20 6b 65 79 2d 70 66 64 20 3b 0a 0a 3a   to key-pfd ;..:
5630: 20 6b 65 79 3e 73 66 69 6c 65 20 28 20 2d 2d 20   key>sfile ( -- 
5640: 29 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 6b 65  ).    keypack ke
5650: 79 70 61 63 6b 2d 61 6c 6c 23 20 3f 6b 65 79 2d  ypack-all# ?key-
5660: 73 66 64 20 61 70 70 65 6e 64 2d 66 69 6c 65 20  sfd append-file 
5670: 6b 65 2d 6f 66 66 73 65 74 20 36 34 21 20 3b 0a  ke-offset 64! ;.
5680: 3a 20 6b 65 79 3e 70 66 69 6c 65 20 28 20 2d 2d  : key>pfile ( --
5690: 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b 20 6b   ).    keypack k
56a0: 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3f 6b 65 79  eypack-all# ?key
56b0: 2d 70 66 64 20 61 70 70 65 6e 64 2d 66 69 6c 65  -pfd append-file
56c0: 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 21 20 3b   ke-offset 64! ;
56d0: 0a 0a 3a 20 6b 65 79 3e 73 66 69 6c 65 40 70 6f  ..: key>sfile@po
56e0: 73 20 28 20 36 34 70 6f 73 20 2d 2d 20 29 20 36  s ( 64pos -- ) 6
56f0: 34 64 75 70 20 36 34 23 2d 31 20 36 34 3d 20 49  4dup 64#-1 64= I
5700: 46 20 20 36 34 64 72 6f 70 20 6b 65 79 3e 73 66  F  64drop key>sf
5710: 69 6c 65 0a 20 20 20 20 45 4c 53 45 20 20 36 34  ile.    ELSE  64
5720: 3e 72 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61  >r keypack keypa
5730: 63 6b 2d 61 6c 6c 23 20 36 34 72 3e 20 3f 6b 65  ck-all# 64r> ?ke
5740: 79 2d 73 66 64 20 77 72 69 74 65 40 70 6f 73 2d  y-sfd write@pos-
5750: 66 69 6c 65 20 20 54 48 45 4e 20 3b 0a 3a 20 6b  file  THEN ;.: k
5760: 65 79 3e 70 66 69 6c 65 40 70 6f 73 20 28 20 36  ey>pfile@pos ( 6
5770: 34 70 6f 73 20 2d 2d 20 29 20 36 34 64 75 70 20  4pos -- ) 64dup 
5780: 36 34 23 2d 31 20 36 34 3d 20 49 46 20 20 36 34  64#-1 64= IF  64
5790: 64 72 6f 70 20 6b 65 79 3e 70 66 69 6c 65 0a 20  drop key>pfile. 
57a0: 20 20 20 45 4c 53 45 20 20 36 34 3e 72 20 6b 65     ELSE  64>r ke
57b0: 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 6c  ypack keypack-al
57c0: 6c 23 20 36 34 72 3e 20 3f 6b 65 79 2d 70 66 64  l# 64r> ?key-pfd
57d0: 20 77 72 69 74 65 40 70 6f 73 2d 66 69 6c 65 20   write@pos-file 
57e0: 20 54 48 45 4e 20 3b 0a 0a 3a 20 72 6e 64 3e 73   THEN ;..: rnd>s
57f0: 66 69 6c 65 20 28 20 2d 2d 20 29 0a 20 20 20 20  file ( -- ).    
5800: 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d  keypack keypack-
5810: 61 6c 6c 23 20 3e 72 6e 67 24 20 6b 65 79 3e 73  all# >rng$ key>s
5820: 66 69 6c 65 20 3b 0a 3a 20 72 6e 64 3e 70 66 69  file ;.: rnd>pfi
5830: 6c 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65  le ( -- ).    ke
5840: 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 61 6c  ypack keypack-al
5850: 6c 23 20 3e 72 6e 67 24 20 6b 65 79 3e 70 66 69  l# >rng$ key>pfi
5860: 6c 65 20 3b 0a 0a 5c 20 6b 65 79 20 67 65 6e 65  le ;..\ key gene
5870: 72 61 74 69 6f 6e 0a 5c 20 66 6f 72 20 72 65 70  ration.\ for rep
5880: 72 6f 64 75 63 69 62 69 6c 69 74 79 20 6f 66 20  roducibility of 
5890: 74 68 65 20 73 65 6c 66 73 69 67 2c 20 61 6c 77  the selfsig, alw
58a0: 61 79 73 20 75 73 65 20 74 68 65 20 73 61 6d 65  ays use the same
58b0: 20 6f 72 64 65 72 3a 0a 5c 20 22 70 75 62 6b 65   order:.\ "pubke
58c0: 79 22 20 6e 65 77 6b 65 79 20 3c 6e 3e 20 6b 65  y" newkey <n> ke
58d0: 79 74 79 70 65 20 22 6e 69 63 6b 22 20 6b 65 79  ytype "nick" key
58e0: 6e 69 63 6b 20 22 73 69 67 22 20 6b 65 79 73 65  nick "sig" keyse
58f0: 6c 66 73 69 67 0a 0a 55 73 65 72 20 70 6b 2b 73  lfsig..User pk+s
5900: 69 67 24 0a 0a 6b 65 79 73 69 7a 65 32 20 43 6f  ig$..keysize2 Co
5910: 6e 73 74 61 6e 74 20 70 6b 72 6b 23 0a 0a 3a 20  nstant pkrk#..: 
5920: 5d 70 6b 2b 73 69 67 6e 20 28 20 61 64 64 72 20  ]pk+sign ( addr 
5930: 75 20 2d 2d 20 29 20 2b 63 6d 64 62 75 66 20 5d  u -- ) +cmdbuf ]
5940: 73 69 67 6e 20 3b 0a 0a 61 6c 73 6f 20 6e 65 74  sign ;..also net
5950: 32 6f 2d 62 61 73 65 0a 3a 20 70 61 63 6b 2d 63  2o-base.: pack-c
5960: 6f 72 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29  ore ( o:key -- )
5970: 20 5c 20 63 6f 72 65 20 77 69 74 68 6f 75 74 20   \ core without 
5980: 6b 65 79 0a 20 20 20 20 6b 65 2d 74 79 70 65 20  key.    ke-type 
5990: 40 20 75 6c 69 74 2c 20 6b 65 79 74 79 70 65 0a  @ ulit, keytype.
59a0: 20 20 20 20 6b 65 2d 6e 69 63 6b 20 24 40 20 24      ke-nick $@ $
59b0: 2c 20 6b 65 79 6e 69 63 6b 0a 20 20 20 20 6b 65  , keynick.    ke
59c0: 2d 70 72 6f 66 20 24 40 20 64 75 70 20 49 46 20  -prof $@ dup IF 
59d0: 20 24 2c 20 6b 65 79 70 72 6f 66 69 6c 65 20 20   $, keyprofile  
59e0: 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 45  ELSE  2drop  THE
59f0: 4e 20 3b 0a 0a 3a 20 70 61 63 6b 2d 73 69 67 6e  N ;..: pack-sign
5a00: 6b 65 79 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29  key ( o:key -- )
5a10: 0a 20 20 20 20 73 69 67 6e 5b 0a 20 20 20 20 70  .    sign[.    p
5a20: 61 63 6b 2d 63 6f 72 65 0a 20 20 20 20 6b 65 2d  ack-core.    ke-
5a30: 70 6b 20 24 40 20 2b 63 6d 64 62 75 66 0a 20 20  pk $@ +cmdbuf.  
5a40: 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 20    ke-selfsig $@ 
5a50: 2b 63 6d 64 62 75 66 20 63 6d 64 2d 72 65 73 6f  +cmdbuf cmd-reso
5a60: 6c 76 65 3e 20 32 64 72 6f 70 20 6e 65 73 74 73  lve> 2drop nests
5a70: 69 67 20 3b 0a 0a 3a 20 70 61 63 6b 2d 63 6f 72  ig ;..: pack-cor
5a80: 65 6b 65 79 20 28 20 6f 3a 6b 65 79 20 2d 2d 20  ekey ( o:key -- 
5a90: 29 0a 20 20 20 20 70 61 63 6b 2d 73 69 67 6e 6b  ).    pack-signk
5aa0: 65 79 0a 20 20 20 20 6b 65 2d 69 6d 70 6f 72 74  ey.    ke-import
5ab0: 73 20 40 20 75 6c 69 74 2c 20 6b 65 79 69 6d 70  s @ ulit, keyimp
5ac0: 6f 72 74 0a 20 20 20 20 6b 65 2d 6d 61 73 6b 20  ort.    ke-mask 
5ad0: 40 20 20 6b 65 2d 67 72 6f 75 70 73 20 24 40 6c  @  ke-groups $@l
5ae0: 65 6e 20 49 46 0a 09 6b 65 2d 67 72 6f 75 70 73  en IF..ke-groups
5af0: 20 24 40 20 32 64 75 70 20 24 2c 20 6b 65 79 67   $@ 2dup $, keyg
5b00: 72 6f 75 70 73 0a 09 67 72 6f 75 70 73 3e 6d 61  roups..groups>ma
5b10: 73 6b 20 69 6e 76 65 72 74 20 61 6e 64 20 20 54  sk invert and  T
5b20: 48 45 4e 0a 20 20 20 20 3f 64 75 70 2d 49 46 20  HEN.    ?dup-IF 
5b30: 20 6e 6c 69 74 2c 20 6b 65 79 6d 61 73 6b 20 20   nlit, keymask  
5b40: 54 48 45 4e 0a 20 20 20 20 6b 65 2d 70 65 74 73  THEN.    ke-pets
5b50: 5b 5d 20 5b 3a 20 24 2c 20 6b 65 79 70 65 74 20  [] [: $, keypet 
5b60: 3b 5d 20 24 5b 5d 6d 61 70 0a 20 20 20 20 6b 65  ;] $[]map.    ke
5b70: 2d 73 74 6f 72 65 6b 65 79 20 40 20 3e 73 74 6f  -storekey @ >sto
5b80: 72 65 6b 65 79 20 21 20 3b 0a 70 72 65 76 69 6f  rekey ! ;.previo
5b90: 75 73 0a 0a 3a 20 70 61 63 6b 2d 70 75 62 6b 65  us..: pack-pubke
5ba0: 79 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20  y ( o:key -- ). 
5bb0: 20 20 20 6b 65 79 3a 63 6f 64 65 0a 20 20 20 20     key:code.    
5bc0: 20 20 70 61 63 6b 2d 63 6f 72 65 6b 65 79 0a 20    pack-corekey. 
5bd0: 20 20 20 65 6e 64 3a 6b 65 79 20 3b 0a 3a 20 70     end:key ;.: p
5be0: 61 63 6b 2d 6f 75 74 6b 65 79 20 28 20 6f 3a 6b  ack-outkey ( o:k
5bf0: 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 3a  ey -- ).    key:
5c00: 63 6f 64 65 0a 20 20 20 20 20 20 22 6e 32 6f 22  code.      "n2o"
5c10: 20 6e 65 74 32 6f 2d 62 61 73 65 3a 34 63 63 2c   net2o-base:4cc,
5c20: 0a 20 20 20 20 20 20 70 61 63 6b 2d 73 69 67 6e  .      pack-sign
5c30: 6b 65 79 0a 20 20 20 20 65 6e 64 3a 6b 65 79 20  key.    end:key 
5c40: 3b 0a 3a 20 70 61 63 6b 2d 73 65 63 6b 65 79 20  ;.: pack-seckey 
5c50: 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20  ( o:key -- ).   
5c60: 20 6b 65 79 3a 63 6f 64 65 0a 20 20 20 20 20 20   key:code.      
5c70: 70 61 63 6b 2d 63 6f 72 65 6b 65 79 0a 20 20 20  pack-corekey.   
5c80: 20 20 20 6b 65 2d 73 6b 20 73 65 63 40 20 73 65     ke-sk sec@ se
5c90: 63 24 2c 20 70 72 69 76 6b 65 79 0a 20 20 20 20  c$, privkey.    
5ca0: 20 20 6b 65 2d 72 73 6b 20 73 65 63 40 20 64 75    ke-rsk sec@ du
5cb0: 70 20 49 46 20 20 73 65 63 24 2c 20 72 73 6b 6b  p IF  sec$, rskk
5cc0: 65 79 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20  ey  ELSE  2drop 
5cd0: 20 54 48 45 4e 0a 20 20 20 20 65 6e 64 3a 6b 65   THEN.    end:ke
5ce0: 79 20 3b 0a 3a 20 6b 65 79 6e 69 63 6b 24 20 28  y ;.: keynick$ (
5cf0: 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 64 72 20 75   o:key -- addr u
5d00: 20 29 0a 20 20 20 20 5c 47 20 67 65 74 20 74 68   ).    \G get th
5d10: 65 20 61 6e 6e 6f 74 61 74 69 6f 6e 73 20 77 69  e annotations wi
5d20: 74 68 20 73 69 67 6e 61 74 75 72 65 0a 20 20 20  th signature.   
5d30: 20 5b 27 5d 20 70 61 63 6b 2d 63 6f 72 65 20 67   ['] pack-core g
5d40: 65 6e 2d 63 6d 64 24 20 32 64 72 6f 70 0a 20 20  en-cmd$ 2drop.  
5d50: 20 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 40 20    ke-selfsig $@ 
5d60: 74 6d 70 24 20 24 2b 21 20 74 6d 70 24 20 24 40  tmp$ $+! tmp$ $@
5d70: 20 3b 0a 3a 20 6b 65 79 70 6b 32 6e 69 63 6b 24   ;.: keypk2nick$
5d80: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 64 72   ( o:key -- addr
5d90: 20 75 20 29 0a 20 20 20 20 5c 47 20 67 65 74 20   u ).    \G get 
5da0: 74 68 65 20 61 6e 6e 6f 74 61 74 69 6f 6e 73 20  the annotations 
5db0: 77 69 74 68 20 73 69 67 6e 61 74 75 72 65 0a 20  with signature. 
5dc0: 20 20 20 5b 27 5d 20 70 61 63 6b 2d 63 6f 72 65     ['] pack-core
5dd0: 20 67 65 6e 2d 63 6d 64 24 20 32 64 72 6f 70 0a   gen-cmd$ 2drop.
5de0: 20 20 20 20 6b 65 2d 70 6b 20 24 40 20 74 6d 70      ke-pk $@ tmp
5df0: 24 20 24 2b 21 20 6b 65 2d 73 65 6c 66 73 69 67  $ $+! ke-selfsig
5e00: 20 24 40 20 74 6d 70 24 20 24 2b 21 20 74 6d 70   $@ tmp$ $+! tmp
5e10: 24 20 24 40 20 3b 0a 3a 20 6d 79 6e 69 63 6b 2d  $ $@ ;.: mynick-
5e20: 6b 65 79 20 28 20 2d 2d 20 6f 20 29 0a 20 20 20  key ( -- o ).   
5e30: 20 70 6b 40 20 6b 65 79 7c 20 6b 65 79 23 20 23   pk@ key| key# #
5e40: 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3b 0a 3a  @ drop cell+ ;.:
5e50: 20 6d 79 6e 69 63 6b 24 20 28 20 2d 2d 20 61 64   mynick$ ( -- ad
5e60: 64 72 20 75 20 29 0a 20 20 20 20 5c 47 20 67 65  dr u ).    \G ge
5e70: 74 20 6d 79 20 6e 69 63 6b 20 77 69 74 68 20 73  t my nick with s
5e80: 69 67 6e 61 74 75 72 65 0a 20 20 20 20 6d 79 6e  ignature.    myn
5e90: 69 63 6b 2d 6b 65 79 20 2e 6b 65 79 6e 69 63 6b  ick-key .keynick
5ea0: 24 20 3b 0a 3a 20 6d 79 70 6b 32 6e 69 63 6b 24  $ ;.: mypk2nick$
5eb0: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 64 72   ( o:key -- addr
5ec0: 20 75 20 29 0a 20 20 20 20 5c 47 20 67 65 74 20   u ).    \G get 
5ed0: 6d 79 20 6e 69 63 6b 20 77 69 74 68 20 73 69 67  my nick with sig
5ee0: 6e 61 74 75 72 65 0a 20 20 20 20 6d 79 6e 69 63  nature.    mynic
5ef0: 6b 2d 6b 65 79 20 2e 6b 65 79 70 6b 32 6e 69 63  k-key .keypk2nic
5f00: 6b 24 20 3b 0a 3a 20 6b 65 79 2d 73 69 67 6e 20  k$ ;.: key-sign 
5f10: 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f 3a 6b 65 79  ( o:key -- o:key
5f20: 20 29 0a 20 20 20 20 5b 27 5d 20 70 61 63 6b 2d   ).    ['] pack-
5f30: 63 6f 72 65 20 67 65 6e 2d 63 6d 64 24 0a 20 20  core gen-cmd$.  
5f40: 20 20 5b 3a 20 74 79 70 65 20 6b 65 2d 70 6b 20    [: type ke-pk 
5f50: 24 40 20 74 79 70 65 20 3b 5d 20 24 74 6d 70 0a  $@ type ;] $tmp.
5f60: 20 20 20 20 6e 6f 77 3e 6e 65 76 65 72 20 63 3a      now>never c:
5f70: 30 6b 65 79 20 63 3a 68 61 73 68 20 5b 27 5d 20  0key c:hash ['] 
5f80: 2e 73 69 67 20 24 74 6d 70 20 6b 65 2d 73 65 6c  .sig $tmp ke-sel
5f90: 66 73 69 67 20 24 21 20 3b 0a 0a 56 61 72 69 61  fsig $! ;..Varia
5fa0: 62 6c 65 20 63 70 2d 74 6d 70 0a 0a 3a 20 73 61  ble cp-tmp..: sa
5fb0: 76 65 2d 70 75 62 6b 65 79 73 20 28 20 2d 2d 20  ve-pubkeys ( -- 
5fc0: 29 0a 20 20 20 20 6b 65 79 2d 70 66 64 20 3f 64  ).    key-pfd ?d
5fd0: 75 70 2d 49 46 20 20 63 6c 6f 73 65 2d 66 69 6c  up-IF  close-fil
5fe0: 65 20 74 68 72 6f 77 20 20 54 48 45 4e 0a 20 20  e throw  THEN.  
5ff0: 20 20 22 70 75 62 6b 65 79 73 2e 6b 32 6f 22 20    "pubkeys.k2o" 
6000: 2e 6b 65 79 73 2f 20 5b 3a 20 74 6f 20 6b 65 79  .keys/ [: to key
6010: 2d 70 66 64 0a 20 20 20 20 20 20 6b 65 79 23 20  -pfd.      key# 
6020: 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70  [: cell+ $@ drop
6030: 20 63 65 6c 6c 2b 20 3e 6f 0a 09 6b 65 2d 73 6b   cell+ >o..ke-sk
6040: 20 73 65 63 40 20 64 30 3d 20 49 46 20 20 70 61   sec@ d0= IF  pa
6050: 63 6b 2d 70 75 62 6b 65 79 0a 09 20 20 20 20 66  ck-pubkey..    f
6060: 6c 75 73 68 28 20 2e 22 20 73 61 76 69 6e 67 20  lush( ." saving 
6070: 22 20 2e 6e 69 63 6b 20 66 6f 72 74 68 3a 63 72  " .nick forth:cr
6080: 20 29 0a 09 20 20 20 20 6b 65 79 2d 63 72 79 70   )..    key-cryp
6090: 74 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 40 20  t ke-offset 64@ 
60a0: 6b 65 79 3e 70 66 69 6c 65 40 70 6f 73 0a 09 54  key>pfile@pos..T
60b0: 48 45 4e 20 6f 3e 20 3b 5d 20 23 6d 61 70 0a 20  HEN o> ;] #map. 
60c0: 20 20 20 30 20 74 6f 20 6b 65 79 2d 70 66 64 20     0 to key-pfd 
60d0: 3b 5d 20 73 61 76 65 2d 66 69 6c 65 20 20 3f 6b  ;] save-file  ?k
60e0: 65 79 2d 70 66 64 20 64 72 6f 70 20 3b 0a 0a 3a  ey-pfd drop ;..:
60f0: 20 73 61 76 65 2d 73 65 63 6b 65 79 73 20 28 20   save-seckeys ( 
6100: 2d 2d 20 29 0a 20 20 20 20 6b 65 79 2d 73 66 64  -- ).    key-sfd
6110: 20 3f 64 75 70 2d 49 46 20 20 63 6c 6f 73 65 2d   ?dup-IF  close-
6120: 66 69 6c 65 20 74 68 72 6f 77 20 20 54 48 45 4e  file throw  THEN
6130: 0a 20 20 20 20 22 73 65 63 6b 65 79 73 2e 6b 32  .    "seckeys.k2
6140: 6f 22 20 2e 6b 65 79 73 2f 20 5b 3a 20 74 6f 20  o" .keys/ [: to 
6150: 6b 65 79 2d 73 66 64 0a 20 20 20 20 20 20 6b 65  key-sfd.      ke
6160: 79 23 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64  y# [: cell+ $@ d
6170: 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 0a 09 6b 65  rop cell+ >o..ke
6180: 2d 73 6b 20 73 65 63 40 20 64 30 3c 3e 20 49 46  -sk sec@ d0<> IF
6190: 20 20 70 61 63 6b 2d 73 65 63 6b 65 79 0a 09 20    pack-seckey.. 
61a0: 20 20 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76     config:pw-lev
61b0: 65 6c 23 20 40 20 3e 72 20 20 6b 65 2d 70 77 6c  el# @ >r  ke-pwl
61c0: 65 76 65 6c 20 40 20 63 6f 6e 66 69 67 3a 70 77  evel @ config:pw
61d0: 2d 6c 65 76 65 6c 23 20 21 0a 09 20 20 20 20 6b  -level# !..    k
61e0: 65 79 2d 63 72 79 70 74 20 6b 65 2d 6f 66 66 73  ey-crypt ke-offs
61f0: 65 74 20 36 34 40 20 6b 65 79 3e 73 66 69 6c 65  et 64@ key>sfile
6200: 40 70 6f 73 0a 09 20 20 20 20 72 3e 20 63 6f 6e  @pos..    r> con
6210: 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23 20 21 0a  fig:pw-level# !.
6220: 09 54 48 45 4e 20 6f 3e 20 3b 5d 20 23 6d 61 70  .THEN o> ;] #map
6230: 0a 20 20 20 20 30 20 74 6f 20 6b 65 79 2d 73 66  .    0 to key-sf
6240: 64 20 3b 5d 20 73 61 76 65 2d 66 69 6c 65 20 20  d ;] save-file  
6250: 3f 6b 65 79 2d 73 66 64 20 64 72 6f 70 20 3b 0a  ?key-sfd drop ;.
6260: 0a 3a 20 73 61 76 65 2d 6b 65 79 73 20 28 20 2d  .: save-keys ( -
6270: 2d 20 29 20 20 3f 2e 6e 65 74 32 6f 2f 6b 65 79  - )  ?.net2o/key
6280: 73 0a 20 20 20 20 73 61 76 65 2d 70 75 62 6b 65  s.    save-pubke
6290: 79 73 20 73 61 76 65 2d 73 65 63 6b 65 79 73 20  ys save-seckeys 
62a0: 3b 0a 0a 5c 20 72 65 73 70 6f 6e 64 20 74 6f 20  ;..\ respond to 
62b0: 73 63 61 6e 6e 69 6e 67 20 6b 65 79 73 0a 0a 66  scanning keys..f
62c0: 6f 72 77 61 72 64 20 6e 32 6f 3a 70 6b 6c 6f 6f  orward n2o:pkloo
62d0: 6b 75 70 0a 66 6f 72 77 61 72 64 20 73 65 6e 64  kup.forward send
62e0: 2d 71 72 2d 69 6e 76 69 74 61 74 69 6f 6e 0a 0a  -qr-invitation..
62f0: 74 72 75 65 20 56 61 6c 75 65 20 73 63 61 6e 2d  true Value scan-
6300: 6f 6e 63 65 3f 0a 56 61 72 69 61 62 6c 65 20 73  once?.Variable s
6310: 63 61 6e 6e 65 64 2d 66 6c 61 67 73 0a 0a 3a 20  canned-flags..: 
6320: 73 63 61 6e 6e 65 64 2d 6b 65 79 2d 69 6e 20 28  scanned-key-in (
6330: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20   addr u -- ).   
6340: 20 2e 22 20 73 63 61 6e 6e 65 64 20 22 20 20 32   ." scanned "  2
6350: 64 75 70 20 2e 6b 65 79 2d 69 64 20 63 72 0a 20  dup .key-id cr. 
6360: 20 20 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20     key| key# #@ 
6370: 49 46 0a 09 63 65 6c 6c 2b 20 3e 6f 20 5b 20 31  IF..cell+ >o [ 1
6380: 20 69 6d 70 6f 72 74 23 73 63 61 6e 20 6c 73 68   import#scan lsh
6390: 69 66 74 20 5d 4c 20 6b 65 2d 69 6d 70 6f 72 74  ift ]L ke-import
63a0: 73 20 6f 72 21 0a 09 2e 6b 65 79 2d 6c 69 73 74  s or!...key-list
63b0: 20 63 72 20 6f 3e 0a 09 73 61 76 65 2d 6b 65 79   cr o>..save-key
63c0: 73 0a 20 20 20 20 45 4c 53 45 20 20 64 72 6f 70  s.    ELSE  drop
63d0: 20 20 54 48 45 4e 20 3b 0a 3a 20 3f 73 63 61 6e    THEN ;.: ?scan
63e0: 2d 6c 65 76 65 6c 20 28 20 2d 2d 20 29 0a 20 20  -level ( -- ).  
63f0: 20 20 5b 49 46 44 45 46 5d 20 61 6e 64 72 6f 69    [IFDEF] androi
6400: 64 20 5b 20 61 6c 73 6f 20 61 6e 64 72 6f 69 64  d [ also android
6410: 20 5d 0a 09 6c 65 76 65 6c 23 20 40 20 30 3e 20   ]..level# @ 0> 
6420: 73 63 61 6e 2d 6f 6e 63 65 3f 20 61 6e 64 20 6c  scan-once? and l
6430: 65 76 65 6c 23 20 2b 21 20 20 5b 20 70 72 65 76  evel# +!  [ prev
6440: 69 6f 75 73 20 5d 0a 20 20 20 20 5b 54 48 45 4e  ious ].    [THEN
6450: 5d 20 3b 0a 0a 3a 20 73 63 61 6e 6e 65 64 2d 6b  ] ;..: scanned-k
6460: 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29  ey ( addr u -- )
6470: 0a 20 20 20 20 73 63 61 6e 6e 65 64 2d 6b 65 79  .    scanned-key
6480: 2d 69 6e 20 3f 73 63 61 6e 2d 6c 65 76 65 6c 20  -in ?scan-level 
6490: 3b 0a 3a 20 73 63 61 6e 6e 65 64 2d 6f 77 6e 6b  ;.: scanned-ownk
64a0: 65 79 20 7b 20 64 3a 20 70 6b 20 2d 2d 20 7d 0a  ey { d: pk -- }.
64b0: 20 20 20 20 70 6b 20 73 63 61 6e 6e 65 64 2d 6b      pk scanned-k
64c0: 65 79 2d 69 6e 0a 20 20 20 20 70 6b 20 6e 32 6f  ey-in.    pk n2o
64d0: 3a 70 6b 6c 6f 6f 6b 75 70 20 73 65 6e 64 2d 71  :pklookup send-q
64e0: 72 2d 69 6e 76 69 74 61 74 69 6f 6e 20 3b 0a 5c  r-invitation ;.\
64f0: 20 74 68 65 20 69 64 65 61 20 6f 66 20 73 63 61   the idea of sca
6500: 6e 20 61 6e 20 6f 77 6e 20 6b 65 79 20 69 73 20  n an own key is 
6510: 74 6f 20 73 65 6e 64 20 61 20 69 6e 76 69 74 61  to send a invita
6520: 74 69 6f 6e 2c 0a 5c 20 61 6e 64 20 72 65 63 65  tion,.\ and rece
6530: 69 76 65 20 61 20 73 69 67 6e 61 74 75 72 65 20  ive a signature 
6540: 74 68 61 74 20 70 72 6f 6f 66 73 20 74 68 65 20  that proofs the 
6550: 73 63 61 6e 6e 65 64 20 64 65 76 69 63 65 0a 5c  scanned device.\
6560: 20 68 61 73 20 61 63 63 65 73 73 20 74 6f 20 74   has access to t
6570: 68 65 20 73 65 63 72 65 74 20 6b 65 79 0a 3a 20  he secret key.: 
6580: 73 63 61 6e 6e 65 64 2d 68 61 73 68 20 28 20 61  scanned-hash ( a
6590: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 2e  ddr u -- ).    .
65a0: 22 20 68 61 73 68 3a 20 22 20 38 35 74 79 70 65  " hash: " 85type
65b0: 20 63 72 20 3b 0a 3a 20 73 63 61 6e 6e 65 64 2d   cr ;.: scanned-
65c0: 6b 65 79 73 69 67 20 28 20 61 64 64 72 20 75 20  keysig ( addr u 
65d0: 2d 2d 20 29 0a 20 20 20 20 2e 22 20 73 69 67 3a  -- ).    ." sig:
65e0: 20 22 20 38 35 74 79 70 65 20 63 72 0a 20 20 20   " 85type cr.   
65f0: 20 3f 73 63 61 6e 2d 6c 65 76 65 6c 20 3b 0a 3a   ?scan-level ;.:
6600: 20 73 63 61 6e 6e 65 64 2d 73 65 63 72 65 74 20   scanned-secret 
6610: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20  ( addr u -- ).  
6620: 20 20 2e 22 20 73 65 63 72 65 74 3a 20 22 20 38    ." secret: " 8
6630: 35 74 79 70 65 20 63 72 0a 20 20 20 20 3f 73 63  5type cr.    ?sc
6640: 61 6e 2d 6c 65 76 65 6c 20 3b 0a 0a 43 72 65 61  an-level ;..Crea
6650: 74 65 20 73 63 61 6e 6e 65 64 2d 78 0a 27 20 73  te scanned-x.' s
6660: 63 61 6e 6e 65 64 2d 6f 77 6e 6b 65 79 20 2c 0a  canned-ownkey ,.
6670: 27 20 73 63 61 6e 6e 65 64 2d 6b 65 79 20 2c 0a  ' scanned-key ,.
6680: 27 20 73 63 61 6e 6e 65 64 2d 6b 65 79 73 69 67  ' scanned-keysig
6690: 20 2c 0a 27 20 73 63 61 6e 6e 65 64 2d 68 61 73   ,.' scanned-has
66a0: 68 20 2c 0a 27 20 73 63 61 6e 6e 65 64 2d 73 65  h ,.' scanned-se
66b0: 63 72 65 74 20 2c 0a 0a 68 65 72 65 20 73 63 61  cret ,..here sca
66c0: 6e 6e 65 64 2d 78 20 2d 20 63 65 6c 6c 2f 20 63  nned-x - cell/ c
66d0: 6f 6e 73 74 61 6e 74 20 73 63 61 6e 6e 65 64 2d  onstant scanned-
66e0: 6d 61 78 23 0a 0a 3a 20 73 63 61 6e 2d 72 65 73  max#..: scan-res
66f0: 75 6c 74 20 28 20 61 64 64 72 20 75 20 74 61 67  ult ( addr u tag
6700: 20 2d 2d 20 29 0a 20 20 20 20 31 20 6f 76 65 72   -- ).    1 over
6710: 20 6c 73 68 69 66 74 20 64 75 70 20 73 63 61 6e   lshift dup scan
6720: 6e 65 64 2d 66 6c 61 67 73 20 40 20 61 6e 64 20  ned-flags @ and 
6730: 49 46 20 20 32 64 72 6f 70 20 32 64 72 6f 70 20  IF  2drop 2drop 
6740: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20   EXIT  THEN.    
6750: 73 63 61 6e 6e 65 64 2d 66 6c 61 67 73 20 6f 72  scanned-flags or
6760: 21 0a 20 20 20 20 64 75 70 20 73 63 61 6e 6e 65  !.    dup scanne
6770: 64 2d 6d 61 78 23 20 75 3c 20 49 46 20 20 63 65  d-max# u< IF  ce
6780: 6c 6c 73 20 73 63 61 6e 6e 65 64 2d 78 20 2b 20  lls scanned-x + 
6790: 70 65 72 66 6f 72 6d 0a 20 20 20 20 45 4c 53 45  perform.    ELSE
67a0: 20 20 2e 22 20 75 6e 6b 6e 6f 77 6e 20 74 61 67    ." unknown tag
67b0: 20 22 20 68 65 78 2e 20 2e 22 20 73 63 61 6e 6e   " hex. ." scann
67c0: 65 64 20 22 20 38 35 74 79 70 65 20 63 72 20 20  ed " 85type cr  
67d0: 54 48 45 4e 20 3b 0a 0a 5c 20 67 65 6e 65 72 61  THEN ;..\ genera
67e0: 74 65 20 6b 65 79 73 0a 0a 3a 20 73 6b 73 69 67  te keys..: sksig
67f0: 21 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d  ! ( -- ).    ke-
6800: 70 6b 20 24 40 20 6b 65 2d 73 6b 20 73 65 63 40  pk $@ ke-sk sec@
6810: 20 63 3a 30 6b 65 79 20 3e 6b 65 79 65 64 2d 68   c:0key >keyed-h
6820: 61 73 68 20 6b 65 79 70 61 64 20 24 32 30 20 6b  ash keypad $20 k
6830: 65 63 63 61 6b 3e 0a 20 20 20 20 6b 65 79 70 61  eccak>.    keypa
6840: 64 20 6b 65 79 73 69 7a 65 20 6b 65 2d 73 6b 73  d keysize ke-sks
6850: 69 67 20 73 65 63 21 20 3b 0a 0a 3a 20 2b 67 65  ig sec! ;..: +ge
6860: 6e 2d 6b 65 79 73 20 28 20 6e 69 63 6b 20 75 20  n-keys ( nick u 
6870: 74 79 70 65 20 2d 2d 20 29 0a 20 20 20 20 67 65  type -- ).    ge
6880: 6e 2d 6b 65 79 73 20 20 36 34 23 2d 31 20 6b 65  n-keys  64#-1 ke
6890: 79 2d 72 65 61 64 2d 6f 66 66 73 65 74 20 36 34  y-read-offset 64
68a0: 21 0a 20 20 20 20 70 6b 63 20 6b 65 79 73 69 7a  !.    pkc keysiz
68b0: 65 32 20 6b 65 79 3a 6e 65 77 20 3e 6f 20 6f 20  e2 key:new >o o 
68c0: 6d 79 2d 6b 65 79 20 21 0a 20 20 20 20 5b 20 31  my-key !.    [ 1
68d0: 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 6c 73 68   import#self lsh
68e0: 69 66 74 20 31 20 69 6d 70 6f 72 74 23 6e 65 77  ift 1 import#new
68f0: 20 6c 73 68 69 66 74 20 6f 72 20 5d 4c 20 6b 65   lshift or ]L ke
6900: 2d 69 6d 70 6f 72 74 73 20 21 0a 20 20 20 20 6b  -imports !.    k
6910: 65 2d 74 79 70 65 20 21 20 20 6b 65 2d 6e 69 63  e-type !  ke-nic
6920: 6b 20 24 21 20 20 6e 69 63 6b 21 0a 20 20 20 20  k $!  nick!.    
6930: 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23  config:pw-level#
6940: 20 40 20 6b 65 2d 70 77 6c 65 76 65 6c 20 21 20   @ ke-pwlevel ! 
6950: 20 70 65 72 6d 25 6d 79 73 65 6c 66 20 6b 65 2d   perm%myself ke-
6960: 6d 61 73 6b 20 21 0a 20 20 20 20 73 6b 63 20 6b  mask !.    skc k
6970: 65 79 73 69 7a 65 20 6b 65 2d 73 6b 20 73 65 63  eysize ke-sk sec
6980: 21 20 20 2b 73 65 63 6b 65 79 0a 20 20 20 20 73  !  +seckey.    s
6990: 6b 72 65 76 20 6b 65 79 73 69 7a 65 20 6b 65 2d  krev keysize ke-
69a0: 72 73 6b 20 73 65 63 21 0a 20 20 20 20 73 6b 73  rsk sec!.    sks
69b0: 69 67 21 20 6b 65 79 2d 73 69 67 6e 20 6f 3e 20  ig! key-sign o> 
69c0: 3b 0a 0a 24 34 30 20 62 75 66 66 65 72 3a 20 6e  ;..$40 buffer: n
69d0: 69 63 6b 2d 62 75 66 0a 0a 3a 20 67 65 74 2d 6e  ick-buf..: get-n
69e0: 69 63 6b 20 28 20 2d 2d 20 61 64 64 72 20 75 20  ick ( -- addr u 
69f0: 29 0a 20 20 20 20 2e 22 20 6e 69 63 6b 3a 20 22  ).    ." nick: "
6a00: 20 6e 69 63 6b 2d 62 75 66 20 24 34 30 20 61 63   nick-buf $40 ac
6a10: 63 65 70 74 20 6e 69 63 6b 2d 62 75 66 20 73 77  cept nick-buf sw
6a20: 61 70 20 2d 74 72 61 69 6c 69 6e 67 20 63 72 20  ap -trailing cr 
6a30: 3b 0a 0a 66 61 6c 73 65 20 76 61 6c 75 65 20 3f  ;..false value ?
6a40: 79 65 73 0a 3a 20 79 65 73 3f 20 28 20 61 64 64  yes.: yes? ( add
6a50: 72 20 75 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20  r u -- flag ).  
6a60: 20 20 3f 79 65 73 20 49 46 20 20 32 64 72 6f 70    ?yes IF  2drop
6a70: 20 74 72 75 65 20 20 45 4c 53 45 20 20 74 79 70   true  ELSE  typ
6a80: 65 20 2e 22 20 20 28 79 2f 4e 29 22 20 6b 65 79  e ."  (y/N)" key
6a90: 20 63 72 20 27 79 27 20 3d 20 20 54 48 45 4e 20   cr 'y' =  THEN 
6aa0: 3b 0a 0a 3a 20 3f 72 73 6b 20 28 20 2d 2d 20 29  ;..: ?rsk ( -- )
6ab0: 0a 20 20 20 20 70 6b 40 20 6b 65 79 7c 20 6b 65  .    pk@ key| ke
6ac0: 79 2d 65 78 69 73 74 3f 20 64 75 70 20 30 3d 20  y-exist? dup 0= 
6ad0: 49 46 20 20 64 72 6f 70 20 20 45 58 49 54 20 20  IF  drop  EXIT  
6ae0: 54 48 45 4e 0a 20 20 20 20 3e 6f 20 6b 65 2d 72  THEN.    >o ke-r
6af0: 73 6b 20 73 65 63 40 20 64 75 70 20 30 3d 20 49  sk sec@ dup 0= I
6b00: 46 20 20 32 64 72 6f 70 20 6f 3e 20 20 45 58 49  F  2drop o>  EXI
6b10: 54 20 20 54 48 45 4e 0a 20 20 20 20 2e 22 20 59  T  THEN.    ." Y
6b20: 6f 75 20 73 74 69 6c 6c 20 68 61 76 65 6e 27 74  ou still haven't
6b30: 20 73 74 6f 72 65 64 20 79 6f 75 72 20 72 65 76   stored your rev
6b40: 6f 6b 65 20 6b 65 79 20 73 65 63 75 72 65 6c 79  oke key securely
6b50: 20 6f 66 66 2d 6c 69 6e 65 2e 22 20 63 72 0a 20   off-line." cr. 
6b60: 20 20 20 73 22 20 50 61 70 65 72 20 61 6e 64 20     s" Paper and 
6b70: 70 65 6e 63 69 6c 20 72 65 61 64 79 3f 22 20 79  pencil ready?" y
6b80: 65 73 3f 20 49 46 0a 09 2e 73 74 72 69 70 65 38  es? IF...stripe8
6b90: 35 0a 09 73 22 20 57 72 69 74 74 65 6e 20 64 6f  5..s" Written do
6ba0: 77 6e 3f 22 20 79 65 73 3f 20 49 46 0a 09 20 20  wn?" yes? IF..  
6bb0: 20 20 73 22 20 59 6f 75 20 77 6f 6e 27 74 20 73    s" You won't s
6bc0: 65 65 20 74 68 69 73 20 61 67 61 69 6e 21 20 44  ee this again! D
6bd0: 65 6c 65 74 65 3f 22 20 79 65 73 3f 0a 09 20 20  elete?" yes?..  
6be0: 20 20 49 46 20 6b 65 2d 72 73 6b 20 73 65 63 2d    IF ke-rsk sec-
6bf0: 6f 66 66 20 20 73 61 76 65 2d 6b 65 79 73 0a 09  off  save-keys..
6c00: 09 2e 22 20 72 65 76 6f 6b 65 20 6b 65 79 20 64  .." revoke key d
6c10: 65 6c 65 74 65 64 2e 22 20 63 72 20 6f 3e 20 20  eleted." cr o>  
6c20: 45 58 49 54 20 20 54 48 45 4e 20 20 54 48 45 4e  EXIT  THEN  THEN
6c30: 0a 20 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70  .    ELSE  2drop
6c40: 20 20 54 48 45 4e 0a 20 20 20 20 2e 22 20 49 27    THEN.    ." I'
6c50: 6d 20 6b 65 65 70 69 6e 67 20 79 6f 75 72 20 72  m keeping your r
6c60: 65 76 6f 6b 65 20 6b 65 79 2e 20 20 54 68 69 73  evoke key.  This
6c70: 20 77 69 6c 6c 20 73 68 6f 77 20 75 70 20 61 67   will show up ag
6c80: 61 69 6e 2e 22 20 63 72 20 6f 3e 20 3b 0a 0a 5c  ain." cr o> ;..\
6c90: 20 72 65 61 64 20 6b 65 79 20 66 69 6c 65 0a 0a   read key file..
6ca0: 3a 20 74 72 79 2d 64 65 63 72 79 70 74 2d 6b 65  : try-decrypt-ke
6cb0: 79 20 28 20 6b 65 79 20 75 31 20 2d 2d 20 61 64  y ( key u1 -- ad
6cc0: 64 72 20 75 32 20 66 6c 61 67 20 29 0a 20 20 20  dr u2 flag ).   
6cd0: 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b   keypack keypack
6ce0: 2d 64 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20  -d keypack-all# 
6cf0: 6d 6f 76 65 0a 20 20 20 20 6b 65 79 70 61 63 6b  move.    keypack
6d00: 2d 64 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20  -d keypack-all# 
6d10: 32 73 77 61 70 0a 20 20 20 20 64 75 70 20 24 32  2swap.    dup $2
6d20: 30 20 3d 20 49 46 20 20 64 65 63 72 79 70 74 24  0 = IF  decrypt$
6d30: 20 20 45 4c 53 45 0a 09 6b 65 79 70 61 63 6b 20    ELSE..keypack 
6d40: 63 40 20 24 46 20 61 6e 64 20 63 6f 6e 66 69 67  c@ $F and config
6d50: 3a 70 77 2d 6d 61 78 6c 65 76 65 6c 23 20 40 20  :pw-maxlevel# @ 
6d60: 3c 3d 0a 09 49 46 20 20 64 65 63 72 79 70 74 2d  <=..IF  decrypt-
6d70: 70 77 24 20 20 45 4c 53 45 20 20 32 64 72 6f 70  pw$  ELSE  2drop
6d80: 20 66 61 6c 73 65 20 20 54 48 45 4e 0a 20 20 20   false  THEN.   
6d90: 20 54 48 45 4e 20 3b 0a 0a 3a 20 74 72 79 2d 64   THEN ;..: try-d
6da0: 65 63 72 79 70 74 20 28 20 66 6c 61 67 20 2d 2d  ecrypt ( flag --
6db0: 20 61 64 64 72 20 75 20 2f 20 30 20 30 20 29 20   addr u / 0 0 ) 
6dc0: 7b 20 66 6c 61 67 20 7d 0a 20 20 20 20 6b 65 79  { flag }.    key
6dd0: 73 20 24 5b 5d 23 20 30 20 3f 44 4f 0a 09 49 20  s $[]# 0 ?DO..I 
6de0: 6b 65 79 73 20 73 65 63 5b 5d 40 20 64 75 70 20  keys sec[]@ dup 
6df0: 6b 65 79 73 69 7a 65 20 3d 20 66 6c 61 67 20 78  keysize = flag x
6e00: 6f 72 20 49 46 0a 09 20 20 20 20 74 72 79 2d 64  or IF..    try-d
6e10: 65 63 72 79 70 74 2d 6b 65 79 20 49 46 0a 09 09  ecrypt-key IF...
6e20: 49 20 6b 65 79 73 20 24 5b 5d 20 40 20 64 75 70  I keys $[] @ dup
6e30: 20 3e 73 74 6f 72 65 6b 65 79 20 21 20 64 65 66   >storekey ! def
6e40: 61 75 6c 74 6b 65 79 20 21 0a 09 09 75 6e 6c 6f  aultkey !...unlo
6e50: 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e 20 20  op  EXIT  THEN  
6e60: 54 48 45 4e 0a 09 32 64 72 6f 70 0a 20 20 20 20  THEN..2drop.    
6e70: 4c 4f 4f 50 20 20 30 20 30 20 3b 0a 0a 3a 20 3f  LOOP  0 0 ;..: ?
6e80: 70 65 72 6d 20 28 20 6f 3a 6b 65 79 20 2d 2d 20  perm ( o:key -- 
6e90: 29 0a 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 40  ).    ke-sk sec@
6ea0: 20 6e 69 70 20 64 75 70 20 49 46 20 20 70 65 72   nip dup IF  per
6eb0: 6d 25 6d 79 73 65 6c 66 20 20 45 4c 53 45 20 20  m%myself  ELSE  
6ec0: 70 65 72 6d 25 64 65 66 61 75 6c 74 20 20 54 48  perm%default  TH
6ed0: 45 4e 20 20 6b 65 2d 6d 61 73 6b 20 21 0a 20 20  EN  ke-mask !.  
6ee0: 20 20 49 46 20 20 22 5c 78 30 30 22 20 20 45 4c    IF  "\x00"  EL
6ef0: 53 45 20 20 22 5c 78 30 31 22 20 20 54 48 45 4e  SE  "\x01"  THEN
6f00: 20 20 6b 65 2d 67 72 6f 75 70 73 20 24 21 20 3b    ke-groups $! ;
6f10: 0a 0a 3a 20 64 6f 2d 6b 65 79 20 28 20 61 64 64  ..: do-key ( add
6f20: 72 20 75 20 2f 20 30 20 30 20 20 2d 2d 20 29 0a  r u / 0 0  -- ).
6f30: 20 20 20 20 64 75 70 20 30 3d 20 49 46 20 20 32      dup 0= IF  2
6f40: 64 72 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e  drop  EXIT  THEN
6f50: 0a 20 20 20 20 73 61 6d 70 6c 65 2d 6b 65 79 20  .    sample-key 
6f60: 3e 6f 20 6b 65 2d 73 6b 20 6b 65 2d 65 6e 64 20  >o ke-sk ke-end 
6f70: 6f 76 65 72 20 2d 20 65 72 61 73 65 20 20 64 6f  over - erase  do
6f80: 2d 63 6d 64 2d 6c 6f 6f 70 20 6f 3e 20 3b 0a 0a  -cmd-loop o> ;..
6f90: 3a 20 2e 6b 65 79 24 20 28 20 61 64 64 72 20 75  : .key$ ( addr u
6fa0: 20 2d 2d 20 29 0a 20 20 20 20 73 61 6d 70 6c 65   -- ).    sample
6fb0: 2d 6b 65 79 20 3e 6f 20 20 6b 65 2d 73 6b 20 6b  -key >o  ke-sk k
6fc0: 65 2d 65 6e 64 20 6f 76 65 72 20 2d 20 65 72 61  e-end over - era
6fd0: 73 65 0a 20 20 20 20 73 69 67 6e 65 64 2d 76 61  se.    signed-va
6fe0: 6c 20 76 61 6c 69 64 61 74 65 64 20 6f 72 21 20  l validated or! 
6ff0: 20 63 2d 73 74 61 74 65 20 6f 66 66 20 20 6e 65   c-state off  ne
7000: 73 74 2d 63 6d 64 2d 6c 6f 6f 70 0a 20 20 20 20  st-cmd-loop.    
7010: 73 69 67 6e 65 64 2d 76 61 6c 20 69 6e 76 65 72  signed-val inver
7020: 74 20 76 61 6c 69 64 61 74 65 64 20 61 6e 64 21  t validated and!
7030: 0a 20 20 20 20 2e 6b 65 79 2d 73 68 6f 72 74 20  .    .key-short 
7040: 66 72 65 65 2d 6b 65 79 20 6f 3e 20 3b 0a 0a 3a  free-key o> ;..:
7050: 20 72 65 61 64 2d 6b 65 79 73 2d 6c 6f 6f 70 20   read-keys-loop 
7060: 28 20 66 64 20 2d 2d 20 29 20 20 63 6f 64 65 2d  ( fd -- )  code-
7070: 6b 65 79 0a 20 20 20 20 3e 72 20 23 30 2e 20 72  key.    >r #0. r
7080: 40 20 72 65 70 6f 73 69 74 69 6f 6e 2d 66 69 6c  @ reposition-fil
7090: 65 20 74 68 72 6f 77 0a 20 20 20 20 42 45 47 49  e throw.    BEGI
70a0: 4e 0a 09 72 40 20 66 69 6c 65 2d 70 6f 73 69 74  N..r@ file-posit
70b0: 69 6f 6e 20 74 68 72 6f 77 20 64 3e 36 34 20 6b  ion throw d>64 k
70c0: 65 79 2d 72 65 61 64 2d 6f 66 66 73 65 74 20 36  ey-read-offset 6
70d0: 34 21 0a 09 6b 65 79 70 61 63 6b 20 6b 65 79 70  4!..keypack keyp
70e0: 61 63 6b 2d 61 6c 6c 23 20 72 40 20 72 65 61 64  ack-all# r@ read
70f0: 2d 66 69 6c 65 20 74 68 72 6f 77 0a 09 6b 65 79  -file throw..key
7100: 70 61 63 6b 2d 61 6c 6c 23 20 3d 20 57 48 49 4c  pack-all# = WHIL
7110: 45 0a 09 20 20 20 20 69 6d 70 6f 72 74 2d 74 79  E..    import-ty
7120: 70 65 20 40 20 69 6d 70 6f 72 74 23 73 65 6c 66  pe @ import#self
7130: 20 3d 20 74 72 79 2d 64 65 63 72 79 70 74 20 64   = try-decrypt d
7140: 6f 2d 6b 65 79 0a 20 20 20 20 52 45 50 45 41 54  o-key.    REPEAT
7150: 20 20 72 64 72 6f 70 20 20 63 6f 64 65 30 2d 62    rdrop  code0-b
7160: 75 66 20 3b 0a 3a 20 72 65 61 64 2d 6b 65 79 2d  uf ;.: read-key-
7170: 6c 6f 6f 70 20 28 20 2d 2d 20 29 0a 20 20 20 20  loop ( -- ).    
7180: 69 6d 70 6f 72 74 23 73 65 6c 66 20 69 6d 70 6f  import#self impo
7190: 72 74 2d 74 79 70 65 20 21 0a 20 20 20 20 3f 6b  rt-type !.    ?k
71a0: 65 79 2d 73 66 64 20 72 65 61 64 2d 6b 65 79 73  ey-sfd read-keys
71b0: 2d 6c 6f 6f 70 20 3b 0a 3a 20 72 65 61 64 2d 70  -loop ;.: read-p
71c0: 6b 65 79 2d 6c 6f 6f 70 20 28 20 2d 2d 20 29 0a  key-loop ( -- ).
71d0: 20 20 20 20 6c 61 73 74 6b 65 79 40 20 64 72 6f      lastkey@ dro
71e0: 70 20 64 65 66 61 75 6c 74 6b 65 79 20 21 20 5c  p defaultkey ! \
71f0: 20 61 74 20 6c 65 61 73 74 20 6f 6e 65 20 64 65   at least one de
7200: 66 61 75 6c 74 20 6b 65 79 20 61 76 61 69 6c 61  fault key availa
7210: 62 6c 65 0a 20 20 20 20 2d 31 20 63 6f 6e 66 69  ble.    -1 confi
7220: 67 3a 70 77 2d 6c 65 76 65 6c 23 0a 20 20 20 20  g:pw-level#.    
7230: 5b 3a 20 69 6d 70 6f 72 74 23 6e 65 77 20 69 6d  [: import#new im
7240: 70 6f 72 74 2d 74 79 70 65 20 21 20 3f 6b 65 79  port-type ! ?key
7250: 2d 70 66 64 20 72 65 61 64 2d 6b 65 79 73 2d 6c  -pfd read-keys-l
7260: 6f 6f 70 20 3b 5d 20 21 77 72 61 70 70 65 72 20  oop ;] !wrapper 
7270: 3b 0a 0a 3a 20 72 65 61 64 2d 6b 65 79 73 20 28  ;..: read-keys (
7280: 20 2d 2d 20 29 0a 20 20 20 20 72 65 61 64 2d 6b   -- ).    read-k
7290: 65 79 2d 6c 6f 6f 70 20 72 65 61 64 2d 70 6b 65  ey-loop read-pke
72a0: 79 2d 6c 6f 6f 70 20 69 6d 70 6f 72 74 23 6e 65  y-loop import#ne
72b0: 77 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20  w import-type ! 
72c0: 3b 0a 0a 3a 20 72 65 61 64 2d 70 6b 32 6b 65 79  ;..: read-pk2key
72d0: 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a  $ ( addr u -- ).
72e0: 20 20 20 20 5c 67 20 72 65 61 64 20 61 20 6e 65      \g read a ne
72f0: 73 74 65 64 20 6b 65 79 20 69 6e 74 6f 20 73 61  sted key into sa
7300: 6d 70 6c 65 2d 6b 65 79 0a 20 20 20 20 73 61 6d  mple-key.    sam
7310: 70 6c 65 2d 6b 65 79 20 3e 6f 20 63 2d 73 74 61  ple-key >o c-sta
7320: 74 65 20 6f 66 66 20 20 73 69 6d 2d 6e 69 63 6b  te off  sim-nick
7330: 21 20 6f 6e 0a 20 20 20 20 70 6b 32 2d 73 69 67  ! on.    pk2-sig
7340: 3f 20 21 21 73 69 67 21 21 20 73 69 67 70 6b 32  ? !!sig!! sigpk2
7350: 73 69 7a 65 23 20 2d 20 32 64 75 70 20 2b 20 3e  size# - 2dup + >
7360: 72 20 64 6f 2d 6e 65 73 74 73 69 67 0a 20 20 20  r do-nestsig.   
7370: 20 72 40 20 6b 65 79 73 69 7a 65 32 20 6b 65 2d   r@ keysize2 ke-
7380: 70 6b 20 24 21 0a 20 20 20 20 72 3e 20 6b 65 79  pk $!.    r> key
7390: 73 69 7a 65 32 20 2b 20 73 69 67 73 69 7a 65 23  size2 + sigsize#
73a0: 20 6b 65 2d 73 65 6c 66 73 69 67 20 24 21 0a 20   ke-selfsig $!. 
73b0: 20 20 20 6f 3e 20 20 73 69 6d 2d 6e 69 63 6b 21     o>  sim-nick!
73c0: 20 6f 66 66 20 3b 0a 0a 3a 20 2e 70 6b 32 6b 65   off ;..: .pk2ke
73d0: 79 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29  y$ ( addr u -- )
73e0: 0a 20 20 20 20 72 65 61 64 2d 70 6b 32 6b 65 79  .    read-pk2key
73f0: 24 20 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 0a  $ sample-key >o.
7400: 20 20 20 20 5b 20 31 20 69 6d 70 6f 72 74 23 69      [ 1 import#i
7410: 6e 76 69 74 65 64 20 6c 73 68 69 66 74 20 31 20  nvited lshift 1 
7420: 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68 69 66  import#new lshif
7430: 74 20 6f 72 20 5d 4c 20 6b 65 2d 69 6d 70 6f 72  t or ]L ke-impor
7440: 74 73 20 21 0a 20 20 20 20 2e 6b 65 79 2d 69 6e  ts !.    .key-in
7450: 76 69 74 65 20 66 72 65 65 2d 6b 65 79 20 6f 3e  vite free-key o>
7460: 20 3b 0a 0a 5c 20 73 65 6c 65 63 74 20 6b 65 79   ;..\ select key
7470: 20 62 79 20 6e 69 63 6b 0a 0a 46 6f 72 77 61 72   by nick..Forwar
7480: 64 20 21 6d 79 2d 61 64 64 72 24 0a 0a 3a 20 3e  d !my-addr$..: >
7490: 72 61 77 2d 6b 65 79 20 28 20 6f 20 2d 2d 20 29  raw-key ( o -- )
74a0: 0a 20 20 20 20 64 75 70 20 30 3d 20 21 21 6e 6f  .    dup 0= !!no
74b0: 2d 6e 69 63 6b 21 21 20 64 75 70 20 6d 79 2d 6b  -nick!! dup my-k
74c0: 65 79 2d 64 65 66 61 75 6c 74 20 21 20 3e 6f 0a  ey-default ! >o.
74d0: 20 20 20 20 73 6b 73 69 67 21 0a 20 20 20 20 6b      sksig!.    k
74e0: 65 2d 70 6b 20 24 40 20 70 6b 63 20 70 6b 72 6b  e-pk $@ pkc pkrk
74f0: 23 20 73 6d 6f 76 65 0a 20 20 20 20 6b 65 2d 73  # smove.    ke-s
7500: 6b 20 73 65 63 40 20 73 6b 63 20 73 77 61 70 20  k sec@ skc swap 
7510: 6b 65 79 7c 20 6d 6f 76 65 0a 20 20 20 20 6b 65  key| move.    ke
7520: 2d 73 6b 73 69 67 20 73 65 63 40 20 73 6b 73 69  -sksig sec@ sksi
7530: 67 20 6b 65 79 73 69 7a 65 20 73 6d 6f 76 65 20  g keysize smove 
7540: 6f 3e 0a 20 20 20 20 21 6d 79 2d 61 64 64 72 24  o>.    !my-addr$
7550: 20 3b 0a 0a 3a 20 3e 6b 65 79 20 28 20 61 64 64   ;..: >key ( add
7560: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79  r u -- ).    key
7570: 23 20 40 20 30 3d 20 49 46 20 20 72 65 61 64 2d  # @ 0= IF  read-
7580: 6b 65 79 73 20 20 54 48 45 4e 0a 20 20 20 20 6e  keys  THEN.    n
7590: 69 63 6b 2d 6b 65 79 20 3e 72 61 77 2d 6b 65 79  ick-key >raw-key
75a0: 20 3b 0a 0a 3a 20 69 27 6d 20 28 20 22 6e 61 6d   ;..: i'm ( "nam
75b0: 65 22 20 2d 2d 20 29 20 70 61 72 73 65 2d 6e 61  e" -- ) parse-na
75c0: 6d 65 20 3e 6b 65 79 20 3b 0a 3a 20 70 6b 27 20  me >key ;.: pk' 
75d0: 28 20 22 6e 61 6d 65 22 20 2d 2d 20 61 64 64 72  ( "name" -- addr
75e0: 20 75 20 29 0a 20 20 20 20 70 61 72 73 65 2d 6e   u ).    parse-n
75f0: 61 6d 65 20 6e 69 63 6b 3e 70 6b 20 3b 0a 0a 3a  ame nick>pk ;..:
7600: 20 64 65 73 74 2d 6b 65 79 20 28 20 61 64 64 72   dest-key ( addr
7610: 20 75 20 2d 2d 20 29 20 64 75 70 20 30 3d 20 49   u -- ) dup 0= I
7620: 46 20 20 32 64 72 6f 70 20 20 45 58 49 54 20 20  F  2drop  EXIT  
7630: 54 48 45 4e 0a 20 20 20 20 6e 69 63 6b 2d 6b 65  THEN.    nick-ke
7640: 79 20 3e 6f 20 6f 20 30 3d 20 21 21 75 6e 6b 6e  y >o o 0= !!unkn
7650: 6f 77 6e 2d 6b 65 79 21 21 0a 20 20 20 20 6b 65  own-key!!.    ke
7660: 2d 70 6b 20 24 40 20 6f 3e 0a 20 20 20 20 70 75  -pk $@ o>.    pu
7670: 62 6b 65 79 20 24 21 20 3b 0a 0a 3a 20 64 65 73  bkey $! ;..: des
7680: 74 2d 70 6b 20 28 20 61 64 64 72 20 75 20 2d 2d  t-pk ( addr u --
7690: 20 29 20 6b 65 79 32 7c 20 32 64 75 70 20 6b 65   ) key2| 2dup ke
76a0: 79 7c 20 6b 65 79 23 20 23 40 20 30 3d 20 49 46  y| key# #@ 0= IF
76b0: 0a 09 64 72 6f 70 20 20 70 65 72 6d 25 75 6e 6b  ..drop  perm%unk
76c0: 6e 6f 77 6e 0a 20 20 20 20 45 4c 53 45 20 20 63  nown.    ELSE  c
76d0: 65 6c 6c 2b 20 3e 6f 20 32 64 72 6f 70 0a 09 6b  ell+ >o 2drop..k
76e0: 65 2d 70 6b 20 24 40 20 6b 65 2d 6d 61 73 6b 20  e-pk $@ ke-mask 
76f0: 40 20 6f 3e 20 20 54 48 45 4e 0a 20 20 20 20 70  @ o>  THEN.    p
7700: 65 72 6d 2d 6d 61 73 6b 20 21 20 70 75 62 6b 65  erm-mask ! pubke
7710: 79 20 24 21 20 3b 0a 0a 3a 20 72 65 70 6c 61 63  y $! ;..: replac
7720: 65 2d 6b 65 79 20 31 20 2f 73 74 72 69 6e 67 20  e-key 1 /string 
7730: 7b 20 72 65 76 2d 61 64 64 72 20 75 20 2d 2d 20  { rev-addr u -- 
7740: 6f 20 7d 20 5c 20 72 65 76 6f 63 61 74 69 6f 6e  o } \ revocation
7750: 20 74 69 63 6b 65 74 0a 20 20 20 20 6b 65 79 28   ticket.    key(
7760: 20 2e 22 20 52 65 70 6c 61 63 65 3a 22 20 63 72   ." Replace:" cr
7770: 20 6f 20 63 65 6c 6c 2d 20 30 20 2e 6b 65 79 20   o cell- 0 .key 
7780: 29 0a 20 20 20 20 69 6d 70 6f 72 74 23 73 65 6c  ).    import#sel
7790: 66 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 0a  f import-type !.
77a0: 20 20 20 20 73 22 20 23 72 65 76 6f 6b 65 64 22      s" #revoked"
77b0: 20 64 75 70 20 3e 72 20 6b 65 2d 6e 69 63 6b 20   dup >r ke-nick 
77c0: 24 2b 21 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20  $+!.    ke-nick 
77d0: 24 40 20 72 3e 20 2d 20 6b 65 2d 70 72 6f 66 20  $@ r> - ke-prof 
77e0: 24 40 20 6b 65 2d 73 69 67 73 5b 5d 20 6b 65 2d  $@ ke-sigs[] ke-
77f0: 74 79 70 65 20 40 0a 20 20 20 20 72 65 76 2d 61  type @.    rev-a
7800: 64 64 72 20 70 6b 72 6b 23 20 6b 65 79 3f 6e 65  ddr pkrk# key?ne
7810: 77 20 3e 6f 0a 20 20 20 20 6b 65 2d 74 79 70 65  w >o.    ke-type
7820: 20 21 20 5b 3a 20 6b 65 2d 73 69 67 73 5b 5d 20   ! [: ke-sigs[] 
7830: 24 2b 5b 5d 21 20 3b 5d 20 24 5b 5d 6d 61 70 20  $+[]! ;] $[]map 
7840: 6b 65 2d 70 72 6f 66 20 24 21 20 6b 65 2d 6e 69  ke-prof $! ke-ni
7850: 63 6b 20 24 21 0a 20 20 20 20 72 65 76 2d 61 64  ck $!.    rev-ad
7860: 64 72 20 70 6b 72 6b 23 20 6b 65 2d 70 6b 20 24  dr pkrk# ke-pk $
7870: 21 0a 20 20 20 20 72 65 76 2d 61 64 64 72 20 75  !.    rev-addr u
7880: 20 2b 20 31 2d 20 64 75 70 20 63 40 20 32 2a 20   + 1- dup c@ 2* 
7890: 2d 20 24 31 30 20 2d 20 24 31 30 20 6b 65 2d 73  - $10 - $10 ke-s
78a0: 65 6c 66 73 69 67 20 24 21 0a 20 20 20 20 6b 65  elfsig $!.    ke
78b0: 79 28 20 2e 22 20 77 69 74 68 3a 22 20 63 72 20  y( ." with:" cr 
78c0: 6f 20 63 65 6c 6c 2d 20 30 20 2e 6b 65 79 20 29  o cell- 0 .key )
78d0: 20 6f 20 6f 3e 0a 20 20 20 20 69 6d 70 6f 72 74   o o>.    import
78e0: 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 79 70 65  #new import-type
78f0: 20 21 20 3b 0a 0a 3a 20 72 65 6e 65 77 2d 6b 65   ! ;..: renew-ke
7900: 79 20 28 20 72 65 76 61 64 64 72 20 75 31 20 6b  y ( revaddr u1 k
7910: 65 79 61 64 64 72 20 75 32 20 2d 2d 20 6f 20 29  eyaddr u2 -- o )
7920: 0a 20 20 20 20 63 75 72 72 65 6e 74 2d 6b 65 79  .    current-key
7930: 20 3e 6f 20 72 65 70 6c 61 63 65 2d 6b 65 79 20   >o replace-key 
7940: 6f 3e 0a 20 20 20 20 3e 6f 20 73 6b 63 20 6b 65  o>.    >o skc ke
7950: 79 73 69 7a 65 20 6b 65 2d 73 6b 20 73 65 63 21  ysize ke-sk sec!
7960: 20 6f 20 6f 3e 20 3b 0a 0a 5c 20 67 65 6e 65 72   o o> ;..\ gener
7970: 61 74 65 20 6e 65 77 20 6b 65 79 0a 0a 3a 20 6f  ate new key..: o
7980: 75 74 2d 6b 65 79 20 28 20 6f 20 2d 2d 20 29 0a  ut-key ( o -- ).
7990: 20 20 20 20 3e 6f 20 70 61 63 6b 2d 6f 75 74 6b      >o pack-outk
79a0: 65 79 20 5b 27 5d 20 2e 6e 69 63 6b 2d 62 61 73  ey ['] .nick-bas
79b0: 65 20 24 74 6d 70 20 66 6e 2d 73 61 6e 69 74 69  e $tmp fn-saniti
79c0: 7a 65 20 6f 3e 0a 20 20 20 20 5b 3a 20 2e 22 20  ze o>.    [: ." 
79d0: 7e 2f 22 20 74 79 70 65 20 2e 22 20 2e 6e 32 6f  ~/" type ." .n2o
79e0: 22 20 3b 5d 20 24 74 6d 70 20 77 2f 6f 20 63 72  " ;] $tmp w/o cr
79f0: 65 61 74 65 2d 66 69 6c 65 20 74 68 72 6f 77 0a  eate-file throw.
7a00: 20 20 20 20 3e 72 20 63 6d 64 62 75 66 24 20 72      >r cmdbuf$ r
7a10: 40 20 77 72 69 74 65 2d 66 69 6c 65 20 74 68 72  @ write-file thr
7a20: 6f 77 20 72 3e 20 63 6c 6f 73 65 2d 66 69 6c 65  ow r> close-file
7a30: 20 74 68 72 6f 77 20 3b 0a 3a 20 6f 75 74 2d 6d   throw ;.: out-m
7a40: 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 70 6b 40  e ( -- ).    pk@
7a50: 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 30 3d   key| key# #@ 0=
7a60: 20 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21   !!unknown-key!!
7a70: 20 5c 20 77 65 6c 6c 2c 20 79 6f 75 20 73 68 6f   \ well, you sho
7a80: 75 6c 64 20 6b 6e 6f 77 20 79 6f 75 72 73 65 6c  uld know yoursel
7a90: 66 0a 20 20 20 20 63 65 6c 6c 2b 20 6f 75 74 2d  f.    cell+ out-
7aa0: 6b 65 79 20 3b 0a 0a 56 61 72 69 61 62 6c 65 20  key ;..Variable 
7ab0: 64 68 74 72 6f 6f 74 2e 6e 32 6f 0a 0a 3a 20 2b  dhtroot.n2o..: +
7ac0: 64 68 74 72 6f 6f 74 20 28 20 2d 2d 20 29 0a 20  dhtroot ( -- ). 
7ad0: 20 20 20 64 65 66 61 75 6c 74 6b 65 79 20 40 20     defaultkey @ 
7ae0: 3e 73 74 6f 72 65 6b 65 79 20 21 0a 20 20 20 20  >storekey !.    
7af0: 69 6d 70 6f 72 74 23 6d 61 6e 75 61 6c 20 69 6d  import#manual im
7b00: 70 6f 72 74 2d 74 79 70 65 20 21 20 20 36 34 23  port-type !  64#
7b10: 2d 31 20 6b 65 79 2d 72 65 61 64 2d 6f 66 66 73  -1 key-read-offs
7b20: 65 74 20 36 34 21 0a 20 20 20 20 64 68 74 72 6f  et 64!.    dhtro
7b30: 6f 74 2e 6e 32 6f 20 24 40 20 64 6f 2d 6b 65 79  ot.n2o $@ do-key
7b40: 0a 20 20 20 20 6c 61 73 74 2d 6b 65 79 20 3e 6f  .    last-key >o
7b50: 20 22 5c 78 30 32 22 20 6b 65 2d 67 72 6f 75 70   "\x02" ke-group
7b60: 73 20 24 21 20 70 65 72 6d 25 64 68 74 72 6f 6f  s $! perm%dhtroo
7b70: 74 20 6b 65 2d 6d 61 73 6b 20 21 20 6f 3e 0a 20  t ke-mask ! o>. 
7b80: 20 20 20 69 6d 70 6f 72 74 23 6e 65 77 20 69 6d     import#new im
7b90: 70 6f 72 74 2d 74 79 70 65 20 21 20 3b 0a 0a 3a  port-type ! ;..:
7ba0: 20 6e 65 77 2d 6b 65 79 20 28 20 6e 69 63 6b 61   new-key ( nicka
7bb0: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 3f  ddr u -- ).    ?
7bc0: 63 68 65 63 6b 2d 72 6e 67 20 5c 20 62 65 66 6f  check-rng \ befo
7bd0: 72 65 20 67 65 6e 65 72 61 74 69 6e 67 20 61 20  re generating a 
7be0: 6b 65 79 2c 20 63 68 65 63 6b 20 74 68 65 20 72  key, check the r
7bf0: 6e 67 20 66 6f 72 20 68 65 61 6c 74 68 0a 20 20  ng for health.  
7c00: 20 20 2b 6e 65 77 70 68 72 61 73 65 20 6b 65 79    +newphrase key
7c10: 3e 64 65 66 61 75 6c 74 0a 20 20 20 20 6b 65 79  >default.    key
7c20: 23 75 73 65 72 20 2b 67 65 6e 2d 6b 65 79 73 0a  #user +gen-keys.
7c30: 20 20 20 20 73 65 63 72 65 74 2d 6b 65 79 73 23      secret-keys#
7c40: 20 31 2d 20 73 65 63 72 65 74 2d 6b 65 79 20 3e   1- secret-key >
7c50: 72 61 77 2d 6b 65 79 20 20 6c 61 73 74 6b 65 79  raw-key  lastkey
7c60: 40 20 64 72 6f 70 20 64 65 66 61 75 6c 74 6b 65  @ drop defaultke
7c70: 79 20 21 0a 20 20 20 20 6f 75 74 2d 6d 65 20 2b  y !.    out-me +
7c80: 64 68 74 72 6f 6f 74 20 73 61 76 65 2d 6b 65 79  dhtroot save-key
7c90: 73 20 3b 0a 0a 5c 20 72 65 76 6f 6b 61 74 69 6f  s ;..\ revokatio
7ca0: 6e 0a 0a 34 20 64 61 74 65 73 69 7a 65 23 20 2b  n..4 datesize# +
7cb0: 20 6b 65 79 73 69 7a 65 20 39 20 2a 20 2b 20 43   keysize 9 * + C
7cc0: 6f 6e 73 74 61 6e 74 20 72 65 76 73 69 7a 65 23  onstant revsize#
7cd0: 0a 0a 56 61 72 69 61 62 6c 65 20 72 65 76 74 6f  ..Variable revto
7ce0: 6b 65 6e 0a 0a 3a 20 30 6f 6c 64 6b 65 79 20 28  ken..: 0oldkey (
7cf0: 20 2d 2d 20 29 20 5c 20 70 75 62 6b 65 79 73 20   -- ) \ pubkeys 
7d00: 63 61 6e 20 73 74 61 79 0a 20 20 20 20 6f 6c 64  can stay.    old
7d10: 73 6b 63 20 6b 65 79 73 69 7a 65 20 65 72 61 73  skc keysize eras
7d20: 65 20 20 6f 6c 64 73 6b 72 65 76 20 6b 65 79 73  e  oldskrev keys
7d30: 69 7a 65 20 65 72 61 73 65 20 3b 0a 0a 3a 20 6b  ize erase ;..: k
7d40: 65 79 6d 6f 76 65 20 28 20 61 64 64 72 31 20 61  eymove ( addr1 a
7d50: 64 64 72 32 20 2d 2d 20 29 20 20 6b 65 79 73 69  ddr2 -- )  keysi
7d60: 7a 65 20 6d 6f 76 65 20 3b 0a 0a 3a 20 72 65 76  ze move ;..: rev
7d70: 6f 6b 65 2d 76 65 72 69 66 79 20 28 20 61 64 64  oke-verify ( add
7d80: 72 20 75 31 20 70 6b 20 73 74 72 69 6e 67 20 75  r u1 pk string u
7d90: 32 20 2d 2d 20 61 64 64 72 20 75 20 66 6c 61 67  2 -- addr u flag
7da0: 20 29 20 72 6f 74 20 3e 72 20 32 3e 72 20 63 3a   ) rot >r 2>r c:
7db0: 30 6b 65 79 0a 20 20 20 20 73 69 67 6f 6e 6c 79  0key.    sigonly
7dc0: 73 69 7a 65 23 20 2d 20 32 64 75 70 20 32 72 3e  size# - 2dup 2r>
7dd0: 20 3e 6b 65 79 65 64 2d 68 61 73 68 0a 20 20 20   >keyed-hash.   
7de0: 20 73 69 67 64 61 74 65 20 2b 64 61 74 65 0a 20   sigdate +date. 
7df0: 20 20 20 32 64 75 70 20 2b 20 72 3e 20 65 64 2d     2dup + r> ed-
7e00: 76 65 72 69 66 79 20 3b 0a 0a 3a 20 3e 72 65 76  verify ;..: >rev
7e10: 6f 6b 65 20 28 20 73 6b 72 65 76 20 2d 2d 20 29  oke ( skrev -- )
7e20: 20 20 73 6b 72 65 76 20 6b 65 79 6d 6f 76 65 20    skrev keymove 
7e30: 20 70 6b 63 20 63 68 65 63 6b 2d 72 65 76 3f 20   pkc check-rev? 
7e40: 30 3d 20 21 21 6e 6f 74 2d 6d 79 2d 72 65 76 73  0= !!not-my-revs
7e50: 6b 21 21 20 3b 0a 0a 3a 20 2b 72 65 76 73 69 67  k!! ;..: +revsig
7e60: 6e 20 28 20 73 6b 20 70 6b 20 2d 2d 20 29 20 20  n ( sk pk -- )  
7e70: 73 6b 73 69 67 20 2d 72 6f 74 20 65 64 2d 73 69  sksig -rot ed-si
7e80: 67 6e 20 72 65 76 74 6f 6b 65 6e 20 24 2b 21 20  gn revtoken $+! 
7e90: 62 6c 20 72 65 76 74 6f 6b 65 6e 20 63 24 2b 21  bl revtoken c$+!
7ea0: 20 3b 0a 0a 3a 20 73 69 67 6e 2d 74 6f 6b 65 6e   ;..: sign-token
7eb0: 2c 20 28 20 73 6b 20 70 6b 20 73 74 72 69 6e 67  , ( sk pk string
7ec0: 20 75 32 20 2d 2d 20 29 0a 20 20 20 20 63 3a 30   u2 -- ).    c:0
7ed0: 6b 65 79 20 72 65 76 74 6f 6b 65 6e 20 24 40 20  key revtoken $@ 
7ee0: 32 73 77 61 70 20 3e 6b 65 79 65 64 2d 68 61 73  2swap >keyed-has
7ef0: 68 0a 20 20 20 20 73 69 67 64 61 74 65 20 2b 64  h.    sigdate +d
7f00: 61 74 65 20 2b 72 65 76 73 69 67 6e 20 3b 0a 0a  ate +revsign ;..
7f10: 3a 20 72 65 76 6f 6b 65 2d 6b 65 79 20 28 20 2d  : revoke-key ( -
7f20: 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 73  - addr u ).    s
7f30: 6b 63 20 6f 6c 64 73 6b 63 20 6b 65 79 6d 6f 76  kc oldskc keymov
7f40: 65 20 20 70 6b 63 20 6f 6c 64 70 6b 63 20 6b 65  e  pkc oldpkc ke
7f50: 79 6d 6f 76 65 20 20 73 6b 72 65 76 20 6f 6c 64  ymove  skrev old
7f60: 73 6b 72 65 76 20 6b 65 79 6d 6f 76 65 0a 20 20  skrev keymove.  
7f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
7f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
7f90: 20 20 20 20 20 20 20 20 20 5c 20 62 61 63 6b 75           \ backu
7fa0: 70 20 6b 65 79 73 0a 20 20 20 20 6f 6c 64 73 6b  p keys.    oldsk
7fb0: 72 65 76 20 6f 6c 64 70 6b 72 65 76 20 73 6b 3e  rev oldpkrev sk>
7fc0: 70 6b 20 20 20 20 20 20 20 20 20 20 20 20 20 20  pk              
7fd0: 20 20 5c 20 67 65 6e 65 72 61 74 65 20 72 65 76    \ generate rev
7fe0: 6f 6b 61 74 69 6f 6e 20 70 75 62 6b 65 79 0a 20  okation pubkey. 
7ff0: 20 20 20 67 65 6e 2d 6b 65 79 73 20 20 20 20 20     gen-keys     
8000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
8010: 20 20 20 20 20 20 20 20 20 20 5c 20 67 65 6e 65            \ gene
8020: 72 61 74 65 20 6e 65 77 20 6b 65 79 73 0a 20 20  rate new keys.  
8030: 20 20 70 6b 63 20 6b 65 79 73 69 7a 65 32 20 72    pkc keysize2 r
8040: 65 76 74 6f 6b 65 6e 20 24 21 20 20 20 20 20 20  evtoken $!      
8050: 20 20 20 20 20 20 20 20 20 5c 20 6d 79 20 6e 65           \ my ne
8060: 77 20 6b 65 79 0a 20 20 20 20 6f 6c 64 70 6b 72  w key.    oldpkr
8070: 65 76 20 6b 65 79 73 69 7a 65 20 72 65 76 74 6f  ev keysize revto
8080: 6b 65 6e 20 24 2b 21 20 20 20 20 20 20 20 20 20  ken $+!         
8090: 20 5c 20 72 65 76 6f 6b 65 20 74 6f 6b 65 6e 0a   \ revoke token.
80a0: 20 20 20 20 6f 6c 64 73 6b 72 65 76 20 6f 6c 64      oldskrev old
80b0: 70 6b 72 65 76 20 22 72 65 76 6f 6b 65 22 20 73  pkrev "revoke" s
80c0: 69 67 6e 2d 74 6f 6b 65 6e 2c 20 5c 20 72 65 76  ign-token, \ rev
80d0: 6f 6b 65 20 73 69 67 6e 61 74 75 72 65 0a 20 20  oke signature.  
80e0: 20 20 73 6b 63 20 70 6b 63 20 22 73 65 6c 66 73    skc pkc "selfs
80f0: 69 67 6e 22 20 73 69 67 6e 2d 74 6f 6b 65 6e 2c  ign" sign-token,
8100: 20 20 20 20 20 20 20 20 20 5c 20 73 65 6c 66 20           \ self 
8110: 73 69 67 6e 65 64 20 77 69 74 68 20 6e 65 77 20  signed with new 
8120: 6b 65 79 0a 20 20 20 20 22 21 22 20 72 65 76 74  key.    "!" revt
8130: 6f 6b 65 6e 20 30 20 24 69 6e 73 20 20 20 20 20  oken 0 $ins     
8140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5c                 \
8150: 20 22 21 22 20 2b 20 6f 6c 64 6b 65 79 6c 65 6e   "!" + oldkeylen
8160: 2b 6e 65 77 6b 65 79 6c 65 6e 20 74 6f 20 66 6c  +newkeylen to fl
8170: 61 67 20 72 65 76 6f 6b 61 74 69 6f 6e 0a 20 20  ag revokation.  
8180: 20 20 72 65 76 74 6f 6b 65 6e 20 24 40 20 67 65    revtoken $@ ge
8190: 6e 3e 68 6f 73 74 20 32 64 72 6f 70 20 20 20 20  n>host 2drop    
81a0: 20 20 20 20 20 20 20 20 20 5c 20 73 69 67 6e 20           \ sign 
81b0: 68 6f 73 74 20 69 6e 66 6f 72 6d 61 74 69 6f 6e  host information
81c0: 20 77 69 74 68 20 6f 6c 64 20 6b 65 79 0a 20 20   with old key.  
81d0: 20 20 73 69 67 64 61 74 65 20 2b 64 61 74 65 20    sigdate +date 
81e0: 73 69 67 64 61 74 65 20 64 61 74 65 73 69 7a 65  sigdate datesize
81f0: 23 20 72 65 76 74 6f 6b 65 6e 20 24 2b 21 0a 20  # revtoken $+!. 
8200: 20 20 20 6f 6c 64 73 6b 63 20 6f 6c 64 70 6b 63     oldskc oldpkc
8210: 20 2b 72 65 76 73 69 67 6e 0a 20 20 20 20 30 6f   +revsign.    0o
8220: 6c 64 6b 65 79 20 72 65 76 74 6f 6b 65 6e 20 24  ldkey revtoken $
8230: 40 20 3b 0a 0a 5c 20 69 6e 76 69 74 61 74 69 6f  @ ;..\ invitatio
8240: 6e 0a 0a 56 61 72 69 61 62 6c 65 20 69 6e 76 69  n..Variable invi
8250: 74 61 74 69 6f 6e 73 0a 0a 65 76 65 6e 74 3a 20  tations..event: 
8260: 3a 3e 69 6e 76 69 74 65 20 28 20 61 64 64 72 20  :>invite ( addr 
8270: 75 20 2d 2d 20 29 0a 20 20 20 20 2e 22 20 69 6e  u -- ).    ." in
8280: 76 69 74 65 20 6d 65 3a 20 22 20 6f 76 65 72 20  vite me: " over 
8290: 3e 72 20 2e 70 6b 32 6b 65 79 24 20 63 72 20 72  >r .pk2key$ cr r
82a0: 3e 20 66 72 65 65 20 74 68 72 6f 77 20 63 74 72  > free throw ctr
82b0: 6c 20 4c 20 69 6e 73 6b 65 79 20 3b 0a 65 76 65  l L inskey ;.eve
82c0: 6e 74 3a 20 3a 3e 77 61 6b 65 6d 65 20 28 20 6f  nt: :>wakeme ( o
82d0: 20 2d 2d 20 29 20 72 65 73 74 61 72 74 20 3b 0a   -- ) restart ;.
82e0: 0a 3a 20 70 6b 32 6b 65 79 24 2d 61 64 64 20 28  .: pk2key$-add (
82f0: 20 61 64 64 72 20 75 20 70 65 72 6d 20 2d 2d 20   addr u perm -- 
8300: 29 20 7b 20 70 65 72 6d 20 7d 0a 20 20 20 20 73  ) { perm }.    s
8310: 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 69 6d 70  ample-key >o imp
8320: 6f 72 74 23 69 6e 76 69 74 65 64 20 69 6d 70 6f  ort#invited impo
8330: 72 74 2d 74 79 70 65 20 21 20 63 6d 64 3a 6e 65  rt-type ! cmd:ne
8340: 73 74 73 69 67 0a 20 20 20 20 70 65 72 6d 20 6b  stsig.    perm k
8350: 65 2d 6d 61 73 6b 20 21 0a 20 20 20 20 69 6d 70  e-mask !.    imp
8360: 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74  ort#new import-t
8370: 79 70 65 20 21 20 20 73 61 76 65 2d 70 75 62 6b  ype !  save-pubk
8380: 65 79 73 20 6f 3e 20 3b 0a 0a 3a 20 78 2d 65 72  eys o> ;..: x-er
8390: 61 73 65 20 28 20 6c 65 6e 20 2d 2d 20 29 0a 20  ase ( len -- ). 
83a0: 20 20 20 64 75 70 20 78 62 61 63 6b 2d 72 65 73     dup xback-res
83b0: 74 6f 72 65 20 20 64 75 70 20 73 70 61 63 65 73  tore  dup spaces
83c0: 20 20 78 62 61 63 6b 2d 72 65 73 74 6f 72 65 20    xback-restore 
83d0: 3b 0a 0a 3a 20 69 6e 76 69 74 65 2d 6b 65 79 20  ;..: invite-key 
83e0: 28 20 61 64 64 72 20 75 20 2d 2d 20 6b 65 79 20  ( addr u -- key 
83f0: 29 0a 20 20 20 20 32 64 75 70 20 78 2d 77 69 64  ).    2dup x-wid
8400: 74 68 20 7b 20 61 64 64 72 20 75 20 6c 65 6e 20  th { addr u len 
8410: 7d 0a 20 20 20 20 42 45 47 49 4e 20 20 61 64 64  }.    BEGIN  add
8420: 72 20 75 20 74 79 70 65 20 6b 65 79 20 20 6c 65  r u type key  le
8430: 6e 20 78 2d 65 72 61 73 65 0a 09 64 75 70 20 63  n x-erase..dup c
8440: 74 72 6c 20 5a 20 3d 0a 20 20 20 20 57 48 49 4c  trl Z =.    WHIL
8450: 45 20 20 64 72 6f 70 20 20 42 45 47 49 4e 20 20  E  drop  BEGIN  
8460: 6b 65 79 20 63 74 72 6c 20 4c 20 3d 20 20 55 4e  key ctrl L =  UN
8470: 54 49 4c 20 20 52 45 50 45 41 54 20 3b 0a 0a 3a  TIL  REPEAT ;..:
8480: 20 70 72 6f 63 65 73 73 2d 69 6e 76 69 74 61 74   process-invitat
8490: 69 6f 6e 20 28 20 61 64 64 72 20 75 20 2d 2d 20  ion ( addr u -- 
84a0: 29 0a 20 20 20 20 73 22 20 69 6e 76 69 74 65 20  ).    s" invite 
84b0: 28 79 2f 6e 2f 62 29 3f 22 20 69 6e 76 69 74 65  (y/n/b)?" invite
84c0: 2d 6b 65 79 0a 20 20 20 20 63 61 73 65 0a 09 27  -key.    case..'
84d0: 79 27 20 6f 66 20 20 70 65 72 6d 25 64 65 66 61  y' of  perm%defa
84e0: 75 6c 74 20 70 6b 32 6b 65 79 24 2d 61 64 64 20  ult pk2key$-add 
84f0: 20 2e 22 20 61 64 64 65 64 22 20 63 72 20 20 20   ." added" cr   
8500: 65 6e 64 6f 66 0a 09 27 62 27 20 6f 66 20 20 70  endof..'b' of  p
8510: 65 72 6d 25 62 6c 6f 63 6b 65 64 20 70 6b 32 6b  erm%blocked pk2k
8520: 65 79 24 2d 61 64 64 20 20 2e 22 20 62 6c 6f 63  ey$-add  ." bloc
8530: 6b 65 64 22 20 63 72 20 65 6e 64 6f 66 0a 09 32  ked" cr endof..2
8540: 64 72 6f 70 20 2e 22 20 69 67 6e 6f 72 65 64 22  drop ." ignored"
8550: 20 63 72 0a 20 20 20 20 65 6e 64 63 61 73 65 20   cr.    endcase 
8560: 3b 0a 0a 3a 20 61 64 64 2d 69 6e 76 69 74 61 74  ;..: add-invitat
8570: 69 6f 6e 20 28 20 61 64 64 72 20 75 20 2d 2d 20  ion ( addr u -- 
8580: 29 20 5c 20 61 64 64 20 69 6e 76 69 74 61 74 69  ) \ add invitati
8590: 6f 6e 20 77 69 74 68 6f 75 74 20 61 73 6b 69 6e  on without askin
85a0: 67 0a 20 20 20 20 70 65 72 6d 25 64 65 66 61 75  g.    perm%defau
85b0: 6c 74 20 70 6b 32 6b 65 79 24 2d 61 64 64 20 3b  lt pk2key$-add ;
85c0: 0a 0a 3a 20 66 69 6c 74 65 72 2d 69 6e 76 69 74  ..: filter-invit
85d0: 61 74 69 6f 6e 3f 20 28 20 61 64 64 72 20 75 20  ation? ( addr u 
85e0: 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 73 69  -- flag ).    si
85f0: 67 70 6b 32 73 69 7a 65 23 20 2d 20 2b 20 6b 65  gpk2size# - + ke
8600: 79 73 69 7a 65 20 6b 65 79 23 20 23 40 20 64 30  ysize key# #@ d0
8610: 3c 3e 20 3b 20 5c 20 61 6c 72 65 61 64 79 20 74  <> ; \ already t
8620: 68 65 72 65 0a 0a 3a 20 2e 69 6e 76 69 74 61 74  here..: .invitat
8630: 69 6f 6e 73 20 28 20 2d 2d 20 29 0a 20 20 20 20  ions ( -- ).    
8640: 69 6e 76 69 74 61 74 69 6f 6e 73 20 5b 3a 20 32  invitations [: 2
8650: 64 75 70 20 2e 70 6b 32 6b 65 79 24 20 63 72 20  dup .pk2key$ cr 
8660: 70 72 6f 63 65 73 73 2d 69 6e 76 69 74 61 74 69  process-invitati
8670: 6f 6e 20 3b 5d 20 24 5b 5d 6d 61 70 0a 20 20 20  on ;] $[]map.   
8680: 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 24 5b 5d   invitations $[]
8690: 6f 66 66 20 3b 0a 0a 3a 20 71 75 65 75 65 2d 69  off ;..: queue-i
86a0: 6e 76 69 74 61 74 69 6f 6e 20 28 20 61 64 64 72  nvitation ( addr
86b0: 20 75 20 2d 2d 20 29 0a 20 20 20 20 69 6e 76 69   u -- ).    invi
86c0: 74 61 74 69 6f 6e 73 20 24 5b 5d 23 20 3e 72 0a  tations $[]# >r.
86d0: 20 20 20 20 32 64 75 70 20 69 6e 76 69 74 61 74      2dup invitat
86e0: 69 6f 6e 73 20 24 69 6e 73 5b 5d 73 69 67 20 64  ions $ins[]sig d
86f0: 72 6f 70 0a 20 20 20 20 69 6e 76 69 74 61 74 69  rop.    invitati
8700: 6f 6e 73 20 24 5b 5d 23 20 72 3e 20 3c 3e 20 49  ons $[]# r> <> I
8710: 46 0a 09 73 61 76 65 2d 6d 65 6d 20 6d 61 69 6e  F..save-mem main
8720: 2d 75 70 40 20 3c 68 69 64 65 3e 0a 09 3c 65 76  -up@ <hide>..<ev
8730: 65 6e 74 20 65 24 2c 20 3a 3e 69 6e 76 69 74 65  ent e$, :>invite
8740: 20 75 70 40 20 65 6c 69 74 2c 20 3a 3e 77 61 6b   up@ elit, :>wak
8750: 65 6d 65 20 6d 61 69 6e 2d 75 70 40 20 65 76 65  eme main-up@ eve
8760: 6e 74 3e 20 73 74 6f 70 0a 20 20 20 20 45 4c 53  nt> stop.    ELS
8770: 45 20 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b  E  2drop  THEN ;
8780: 0a 0a 66 6f 72 77 61 72 64 20 2e 73 69 67 71 72  ..forward .sigqr
8790: 0a 65 76 65 6e 74 3a 20 3a 3e 73 68 6f 77 2d 6b  .event: :>show-k
87a0: 65 79 73 69 67 20 28 20 61 64 64 72 20 75 20 2d  eysig ( addr u -
87b0: 2d 20 29 20 70 61 67 65 20 2e 73 69 67 71 72 20  - ) page .sigqr 
87c0: 3b 0a 0a 3a 20 3e 69 6e 76 69 74 61 74 69 6f 6e  ;..: >invitation
87d0: 73 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a  s ( addr u -- ).
87e0: 20 20 20 20 71 72 2d 63 72 79 70 74 3f 20 49 46      qr-crypt? IF
87f0: 0a 09 6d 73 67 28 20 2e 22 20 51 52 20 69 6e 76  ..msg( ." QR inv
8800: 69 74 61 74 69 6f 6e 20 77 69 74 68 20 73 69 67  itation with sig
8810: 6e 61 74 75 72 65 22 20 66 6f 72 74 68 3a 63 72  nature" forth:cr
8820: 20 29 0a 09 32 64 75 70 20 66 69 6c 74 65 72 2d   )..2dup filter-
8830: 69 6e 76 69 74 61 74 69 6f 6e 3f 20 30 3d 20 49  invitation? 0= I
8840: 46 20 20 32 64 75 70 20 61 64 64 2d 69 6e 76 69  F  2dup add-invi
8850: 74 61 74 69 6f 6e 20 20 54 48 45 4e 0a 09 3c 65  tation  THEN..<e
8860: 76 65 6e 74 20 65 24 2c 20 3a 3e 73 68 6f 77 2d  vent e$, :>show-
8870: 6b 65 79 73 69 67 20 6d 61 69 6e 2d 75 70 40 20  keysig main-up@ 
8880: 65 76 65 6e 74 3e 0a 20 20 20 20 45 4c 53 45 0a  event>.    ELSE.
8890: 09 32 64 75 70 20 66 69 6c 74 65 72 2d 69 6e 76  .2dup filter-inv
88a0: 69 74 61 74 69 6f 6e 3f 20 49 46 20 20 32 64 72  itation? IF  2dr
88b0: 6f 70 20 45 58 49 54 20 20 54 48 45 4e 0a 09 6d  op EXIT  THEN..m
88c0: 73 67 28 20 2e 22 20 71 75 65 75 65 20 69 6e 76  sg( ." queue inv
88d0: 69 74 61 74 69 6f 6e 22 20 66 6f 72 74 68 3a 63  itation" forth:c
88e0: 72 20 29 0a 09 71 75 65 75 65 2d 69 6e 76 69 74  r )..queue-invit
88f0: 61 74 69 6f 6e 0a 20 20 20 20 54 48 45 4e 20 3b  ation.    THEN ;
8900: 0a 0a 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73  ..also net2o-bas
8910: 65 0a 0a 3a 20 69 6e 76 69 74 65 2d 6d 65 20 28  e..: invite-me (
8920: 20 2d 2d 20 29 0a 20 20 20 20 5b 3a 20 30 6b 65   -- ).    [: 0ke
8930: 79 2c 20 6e 65 73 74 5b 20 6d 79 70 6b 32 6e 69  y, nest[ mypk2ni
8940: 63 6b 24 20 24 2c 20 70 75 62 6b 65 79 20 24 40  ck$ $, pubkey $@
8950: 20 6b 65 79 7c 20 24 2c 20 69 6e 76 69 74 65 20   key| $, invite 
8960: 63 6f 6f 6b 69 65 2b 72 65 71 75 65 73 74 0a 20  cookie+request. 
8970: 20 20 20 20 20 5d 74 6d 70 6e 65 73 74 20 65 6e       ]tmpnest en
8980: 64 2d 63 6d 64 20 3b 5d 20 69 73 20 65 78 70 65  d-cmd ;] is expe
8990: 63 74 2d 72 65 70 6c 79 3f 20 3b 0a 3a 20 71 72  ct-reply? ;.: qr
89a0: 2d 63 68 61 6c 6c 65 6e 67 65 2c 20 28 20 2d 2d  -challenge, ( --
89b0: 20 29 0a 20 20 20 20 24 31 30 20 72 6e 67 24 20   ).    $10 rng$ 
89c0: 32 64 75 70 20 24 2c 20 71 72 2d 6b 65 79 20 24  2dup $, qr-key $
89d0: 38 0a 20 20 20 20 6d 73 67 28 20 2e 22 20 63 68  8.    msg( ." ch
89e0: 61 6c 6c 65 6e 67 65 3a 20 22 20 32 6f 76 65 72  allenge: " 2over
89f0: 20 38 35 74 79 70 65 20 73 70 61 63 65 20 32 64   85type space 2d
8a00: 75 70 20 78 74 79 70 65 20 66 6f 72 74 68 3a 63  up xtype forth:c
8a10: 72 20 29 0a 20 20 20 20 63 3a 30 6b 65 79 20 3e  r ).    c:0key >
8a20: 6b 65 79 65 64 2d 68 61 73 68 0a 20 20 20 20 71  keyed-hash.    q
8a30: 72 2d 68 61 73 68 20 24 34 30 20 63 3a 68 61 73  r-hash $40 c:has
8a40: 68 40 20 71 72 2d 68 61 73 68 20 24 31 30 20 24  h@ qr-hash $10 $
8a50: 2c 20 71 72 2d 63 68 61 6c 6c 65 6e 67 65 20 3b  , qr-challenge ;
8a60: 0a 3a 20 71 72 2d 69 6e 76 69 74 65 2d 6d 65 20  .: qr-invite-me 
8a70: 28 20 2d 2d 20 29 0a 20 20 20 20 5b 3a 20 30 6b  ( -- ).    [: 0k
8a80: 65 79 2c 20 6e 65 73 74 5b 20 71 72 2d 63 68 61  ey, nest[ qr-cha
8a90: 6c 6c 65 6e 67 65 2c 0a 20 20 20 20 20 20 6d 79  llenge,.      my
8aa0: 70 6b 32 6e 69 63 6b 24 20 24 2c 20 70 75 62 6b  pk2nick$ $, pubk
8ab0: 65 79 20 24 40 20 6b 65 79 7c 20 24 2c 20 69 6e  ey $@ key| $, in
8ac0: 76 69 74 65 20 63 6f 6f 6b 69 65 2b 72 65 71 75  vite cookie+requ
8ad0: 65 73 74 0a 20 20 20 20 20 20 5d 74 6d 70 6e 65  est.      ]tmpne
8ae0: 73 74 20 65 6e 64 2d 63 6d 64 20 3b 5d 20 69 73  st end-cmd ;] is
8af0: 20 65 78 70 65 63 74 2d 72 65 70 6c 79 3f 20 3b   expect-reply? ;
8b00: 0a 3a 20 73 65 6e 64 2d 69 6e 76 69 74 61 74 69  .: send-invitati
8b10: 6f 6e 20 28 20 2d 2d 20 29 20 0a 20 20 20 20 73  on ( -- ) .    s
8b20: 65 74 75 70 21 20 20 2b 72 65 73 65 6e 64 2d 63  etup!  +resend-c
8b30: 6d 64 20 20 67 65 6e 2d 74 6d 70 6b 65 79 73 0a  md  gen-tmpkeys.
8b40: 20 20 20 20 5b 27 5d 20 63 6f 6e 6e 65 63 74 2d      ['] connect-
8b50: 72 65 73 74 20 72 71 64 3f 0a 20 20 20 20 63 6d  rest rqd?.    cm
8b60: 64 28 20 69 6e 64 2d 61 64 64 72 20 40 20 49 46  d( ind-addr @ IF
8b70: 20 20 2e 22 20 69 6e 22 20 54 48 45 4e 20 2e 22    ." in" THEN ."
8b80: 20 64 69 72 65 63 74 20 63 6f 6e 6e 65 63 74 22   direct connect"
8b90: 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 20   forth:cr ).    
8ba0: 69 76 73 28 20 2e 22 20 67 65 6e 20 72 65 71 75  ivs( ." gen requ
8bb0: 65 73 74 22 20 66 6f 72 74 68 3a 63 72 20 29 0a  est" forth:cr ).
8bc0: 20 20 20 20 6e 65 74 32 6f 2d 63 6f 64 65 30 0a      net2o-code0.
8bd0: 20 20 20 20 6e 65 74 32 6f 2d 76 65 72 73 69 6f      net2o-versio
8be0: 6e 20 24 2c 20 67 65 74 2d 76 65 72 73 69 6f 6e  n $, get-version
8bf0: 20 20 30 6b 65 79 2c 0a 20 20 20 20 6e 65 73 74    0key,.    nest
8c00: 5b 20 63 6f 6f 6b 69 65 2c 20 5d 6e 65 73 74 0a  [ cookie, ]nest.
8c10: 20 20 20 20 74 70 6b 63 20 6b 65 79 73 69 7a 65      tpkc keysize
8c20: 20 24 2c 20 72 65 63 65 69 76 65 2d 74 6d 70 6b   $, receive-tmpk
8c30: 65 79 0a 20 20 20 20 74 6d 70 6b 65 79 2d 72 65  ey.    tmpkey-re
8c40: 71 75 65 73 74 20 74 6d 70 2d 73 65 63 72 65 74  quest tmp-secret
8c50: 2c 0a 20 20 20 20 6e 65 73 74 5b 20 72 65 71 75  ,.    nest[ requ
8c60: 65 73 74 2d 69 6e 76 69 74 61 74 69 6f 6e 20 72  est-invitation r
8c70: 65 71 75 65 73 74 2c 20 5d 6e 65 73 74 0a 20 20  equest, ]nest.  
8c80: 20 20 63 6c 6f 73 65 2d 74 6d 70 6e 65 73 74 0a    close-tmpnest.
8c90: 20 20 20 20 5b 27 5d 20 70 75 73 68 2d 63 6d 64      ['] push-cmd
8ca0: 20 49 53 20 65 78 70 65 63 74 2d 72 65 70 6c 79   IS expect-reply
8cb0: 3f 0a 20 20 20 20 65 6e 64 2d 63 6f 64 65 7c 0a  ?.    end-code|.
8cc0: 20 20 20 20 6e 32 6f 3a 64 69 73 70 6f 73 65 2d      n2o:dispose-
8cd0: 63 6f 6e 74 65 78 74 20 3b 0a 3a 20 73 65 6e 64  context ;.: send
8ce0: 2d 71 72 2d 69 6e 76 69 74 61 74 69 6f 6e 20 28  -qr-invitation (
8cf0: 20 2d 2d 20 29 0a 20 20 20 20 73 65 74 75 70 21   -- ).    setup!
8d00: 20 20 2b 72 65 73 65 6e 64 2d 63 6d 64 20 20 67    +resend-cmd  g
8d10: 65 6e 2d 74 6d 70 6b 65 79 73 0a 20 20 20 20 5b  en-tmpkeys.    [
8d20: 27 5d 20 63 6f 6e 6e 65 63 74 2d 72 65 73 74 20  '] connect-rest 
8d30: 72 71 64 3f 0a 20 20 20 20 63 6d 64 28 20 69 6e  rqd?.    cmd( in
8d40: 64 2d 61 64 64 72 20 40 20 49 46 20 20 2e 22 20  d-addr @ IF  ." 
8d50: 69 6e 22 20 54 48 45 4e 20 2e 22 20 64 69 72 65  in" THEN ." dire
8d60: 63 74 20 63 6f 6e 6e 65 63 74 22 20 66 6f 72 74  ct connect" fort
8d70: 68 3a 63 72 20 29 0a 20 20 20 20 69 76 73 28 20  h:cr ).    ivs( 
8d80: 2e 22 20 67 65 6e 20 72 65 71 75 65 73 74 22 20  ." gen request" 
8d90: 66 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 20 6e  forth:cr ).    n
8da0: 65 74 32 6f 2d 63 6f 64 65 30 0a 20 20 20 20 6e  et2o-code0.    n
8db0: 65 74 32 6f 2d 76 65 72 73 69 6f 6e 20 24 2c 20  et2o-version $, 
8dc0: 67 65 74 2d 76 65 72 73 69 6f 6e 20 20 30 6b 65  get-version  0ke
8dd0: 79 2c 0a 20 20 20 20 6e 65 73 74 5b 20 63 6f 6f  y,.    nest[ coo
8de0: 6b 69 65 2c 20 72 65 71 75 65 73 74 2c 20 5d 6e  kie, request, ]n
8df0: 65 73 74 0a 20 20 20 20 74 70 6b 63 20 6b 65 79  est.    tpkc key
8e00: 73 69 7a 65 20 24 2c 20 72 65 63 65 69 76 65 2d  size $, receive-
8e10: 74 6d 70 6b 65 79 0a 20 20 20 20 74 6d 70 6b 65  tmpkey.    tmpke
8e20: 79 2d 72 65 71 75 65 73 74 20 74 6d 70 2d 73 65  y-request tmp-se
8e30: 63 72 65 74 2c 0a 20 20 20 20 6e 65 73 74 5b 20  cret,.    nest[ 
8e40: 72 65 71 75 65 73 74 2d 71 72 2d 69 6e 76 69 74  request-qr-invit
8e50: 61 74 69 6f 6e 20 72 65 71 75 65 73 74 2c 20 5d  ation request, ]
8e60: 6e 65 73 74 0a 20 20 20 20 63 6c 6f 73 65 2d 74  nest.    close-t
8e70: 6d 70 6e 65 73 74 0a 20 20 20 20 5b 27 5d 20 70  mpnest.    ['] p
8e80: 75 73 68 2d 63 6d 64 20 49 53 20 65 78 70 65 63  ush-cmd IS expec
8e90: 74 2d 72 65 70 6c 79 3f 0a 20 20 20 20 65 6e 64  t-reply?.    end
8ea0: 2d 63 6f 64 65 7c 0a 20 20 20 20 6e 32 6f 3a 64  -code|.    n2o:d
8eb0: 69 73 70 6f 73 65 2d 63 6f 6e 74 65 78 74 20 3b  ispose-context ;
8ec0: 0a 70 72 65 76 69 6f 75 73 0a 0a 5c 20 6b 65 79  .previous..\ key
8ed0: 20 61 70 69 20 68 65 6c 70 65 72 73 0a 0a 3a 20   api helpers..: 
8ee0: 64 65 6c 2d 6c 61 73 74 2d 6b 65 79 20 28 20 2d  del-last-key ( -
8ef0: 2d 20 29 0a 20 20 20 20 6b 65 79 73 20 24 5b 5d  - ).    keys $[]
8f00: 23 20 31 2d 20 6b 65 79 73 20 24 5b 5d 20 73 65  # 1- keys $[] se
8f10: 63 2d 6f 66 66 0a 20 20 20 20 6b 65 79 73 20 24  c-off.    keys $
8f20: 40 6c 65 6e 20 63 65 6c 6c 2d 20 6b 65 79 73 20  @len cell- keys 
8f30: 24 21 6c 65 6e 20 3b 0a 0a 3a 20 73 74 6f 72 65  $!len ;..: store
8f40: 6b 65 79 21 20 28 20 2d 2d 20 29 0a 20 20 20 20  key! ( -- ).    
8f50: 3e 73 65 63 6b 65 79 20 6b 65 79 73 20 24 5b 5d  >seckey keys $[]
8f60: 23 20 30 20 3f 44 4f 20 20 32 64 75 70 20 49 20  # 0 ?DO  2dup I 
8f70: 6b 65 79 73 20 73 65 63 5b 5d 40 20 73 74 72 3d  keys sec[]@ str=
8f80: 20 49 46 0a 09 20 20 20 20 49 20 6b 65 79 73 20   IF..    I keys 
8f90: 73 65 63 5b 5d 40 20 64 72 6f 70 20 3e 73 74 6f  sec[]@ drop >sto
8fa0: 72 65 6b 65 79 20 21 20 20 4c 45 41 56 45 20 20  rekey !  LEAVE  
8fb0: 54 48 45 4e 20 20 4c 4f 4f 50 20 20 32 64 72 6f  THEN  LOOP  2dro
8fc0: 70 20 3b 0a 0a 3a 20 63 68 6f 6f 73 65 2d 6b 65  p ;..: choose-ke
8fd0: 79 20 28 20 2d 2d 20 6f 20 29 0a 20 20 20 20 30  y ( -- o ).    0
8fe0: 20 42 45 47 49 4e 20 20 64 72 6f 70 0a 09 2e 22   BEGIN  drop..."
8ff0: 20 43 68 6f 6f 73 65 20 6b 65 79 20 62 79 20 6e   Choose key by n
9000: 75 6d 62 65 72 3a 22 20 63 72 20 2e 73 65 63 72  umber:" cr .secr
9010: 65 74 2d 6e 69 63 6b 73 0a 09 42 45 47 49 4e 20  et-nicks..BEGIN 
9020: 20 6b 65 79 20 64 75 70 20 62 6c 20 3c 20 57 48   key dup bl < WH
9030: 49 4c 45 20 20 64 72 6f 70 20 20 52 45 50 45 41  ILE  drop  REPEA
9040: 54 20 5c 20 73 77 61 6c 6c 6f 77 20 63 6f 6e 74  T \ swallow cont
9050: 72 6f 6c 20 6b 65 79 73 0a 09 5b 27 5d 20 64 69  rol keys..['] di
9060: 67 69 74 3f 20 23 33 36 20 62 61 73 65 2d 65 78  git? #36 base-ex
9070: 65 63 75 74 65 20 30 3d 20 49 46 20 2d 31 20 54  ecute 0= IF -1 T
9080: 48 45 4e 0a 09 73 65 63 72 65 74 2d 6b 65 79 20  HEN..secret-key 
9090: 64 75 70 20 30 3d 20 57 48 49 4c 45 0a 09 20 20  dup 0= WHILE..  
90a0: 20 20 2e 22 20 50 6c 65 61 73 65 20 65 6e 74 65    ." Please ente
90b0: 72 20 61 20 62 61 73 65 2d 33 36 20 6e 75 6d 62  r a base-36 numb
90c0: 65 72 20 62 65 74 77 65 65 6e 20 30 20 61 6e 64  er between 0 and
90d0: 20 22 0a 09 20 20 20 20 73 65 63 72 65 74 2d 6b   "..    secret-k
90e0: 65 79 73 23 20 31 2d 20 5b 27 5d 20 2e 20 23 33  eys# 1- ['] . #3
90f0: 36 20 62 61 73 65 2d 65 78 65 63 75 74 65 20 63  6 base-execute c
9100: 72 20 20 72 64 72 6f 70 0a 20 20 20 20 52 45 50  r  rdrop.    REP
9110: 45 41 54 0a 20 20 20 20 64 75 70 20 2e 73 74 6f  EAT.    dup .sto
9120: 72 65 6b 65 79 21 20 20 3e 73 74 6f 72 65 6b 65  rekey!  >storeke
9130: 79 20 40 20 64 65 66 61 75 6c 74 6b 65 79 20 21  y @ defaultkey !
9140: 0a 20 20 20 20 2e 22 20 3d 3d 3d 3d 20 6b 65 79  .    ." ==== key
9150: 20 22 20 64 75 70 20 2e 2e 6e 69 63 6b 20 2e 22   " dup ..nick ."
9160: 20 20 63 68 6f 73 65 6e 20 3d 3d 3d 3d 22 20 63    chosen ====" c
9170: 72 20 3b 0a 0a 5c 20 77 69 6c 6c 20 61 73 6b 20  r ;..\ will ask 
9180: 66 6f 72 20 79 6f 75 72 20 70 61 73 73 77 6f 72  for your passwor
9190: 64 20 61 6e 64 20 69 66 20 70 6f 73 73 69 62 6c  d and if possibl
91a0: 65 20 61 75 74 6f 2d 73 65 6c 65 63 74 20 79 6f  e auto-select yo
91b0: 75 72 20 69 64 0a 0a 56 61 72 69 61 62 6c 65 20  ur id..Variable 
91c0: 74 72 69 65 73 23 0a 23 31 30 20 56 61 6c 75 65  tries#.#10 Value
91d0: 20 6d 61 78 74 72 69 65 73 23 0a 0a 3a 20 67 65   maxtries#..: ge
91e0: 74 2d 73 6b 63 20 28 20 2d 2d 20 29 0a 20 20 20  t-skc ( -- ).   
91f0: 20 73 65 63 72 65 74 2d 6b 65 79 73 23 20 3f 45   secret-keys# ?E
9200: 58 49 54 20 20 74 72 69 65 73 23 20 6f 66 66 0a  XIT  tries# off.
9210: 20 20 20 20 64 65 62 75 67 2d 76 65 63 74 6f 72      debug-vector
9220: 20 40 20 6f 70 2d 76 65 63 74 6f 72 20 21 40 20   @ op-vector !@ 
9230: 3e 72 20 3c 64 65 66 61 75 6c 74 3e 0a 20 20 20  >r <default>.   
9240: 20 73 65 63 72 65 74 2d 6b 65 79 73 23 0a 20 20   secret-keys#.  
9250: 20 20 42 45 47 49 4e 20 20 64 75 70 20 30 3d 20    BEGIN  dup 0= 
9260: 74 72 69 65 73 23 20 40 20 6d 61 78 74 72 69 65  tries# @ maxtrie
9270: 73 23 20 75 3c 20 61 6e 64 20 20 57 48 49 4c 45  s# u< and  WHILE
9280: 20 64 72 6f 70 0a 09 20 20 20 20 73 22 20 50 61   drop..    s" Pa
9290: 73 73 70 68 72 61 73 65 3a 20 22 20 2b 70 61 73  ssphrase: " +pas
92a0: 73 70 68 72 61 73 65 20 20 20 21 74 69 6d 65 0a  sphrase   !time.
92b0: 09 20 20 20 20 72 65 61 64 2d 6b 65 79 73 20 73  .    read-keys s
92c0: 65 63 72 65 74 2d 6b 65 79 73 23 20 64 75 70 20  ecret-keys# dup 
92d0: 30 3d 20 49 46 0a 09 09 5c 20 66 61 69 6c 20 72  0= IF...\ fail r
92e0: 69 67 68 74 20 61 66 74 65 72 20 74 68 65 20 66  ight after the f
92f0: 69 72 73 74 20 74 72 79 20 69 66 20 50 41 53 53  irst try if PASS
9300: 50 48 52 41 53 45 20 69 73 20 75 73 65 64 0a 09  PHRASE is used..
9310: 09 5c 20 61 6e 64 20 67 69 76 65 20 74 68 65 20  .\ and give the 
9320: 6d 61 78 69 6d 75 6d 20 77 61 69 74 69 6e 67 20  maximum waiting 
9330: 70 65 6e 61 6c 74 79 20 69 6e 20 74 68 61 74 20  penalty in that 
9340: 63 61 73 65 0a 09 09 31 20 6d 61 78 74 72 69 65  case...1 maxtrie
9350: 73 23 20 73 22 20 50 41 53 53 50 48 52 41 53 45  s# s" PASSPHRASE
9360: 22 20 67 65 74 65 6e 76 20 64 30 3d 20 73 65 6c  " getenv d0= sel
9370: 65 63 74 20 74 72 69 65 73 23 20 2b 21 0a 09 09  ect tries# +!...
9380: 3c 65 72 72 3e 20 2e 22 20 54 72 79 23 20 22 20  <err> ." Try# " 
9390: 74 72 69 65 73 23 20 40 20 30 20 2e 72 20 27 2f  tries# @ 0 .r '/
93a0: 27 20 65 6d 69 74 20 6d 61 78 74 72 69 65 73 23  ' emit maxtries#
93b0: 20 2e 0a 09 09 2e 22 20 66 61 69 6c 65 64 2c 20   ....." failed, 
93c0: 6e 6f 20 6b 65 79 20 66 6f 75 6e 64 2c 20 77 61  no key found, wa
93d0: 69 74 69 6e 67 20 22 0a 09 09 23 31 20 74 72 69  iting "...#1 tri
93e0: 65 73 23 20 40 20 32 2a 20 6c 73 68 69 66 74 20  es# @ 2* lshift 
93f0: 64 75 70 20 2e 20 2e 22 20 6d 73 2e 2e 2e 22 20  dup . ." ms..." 
9400: 6d 73 20 20 3c 64 65 66 61 75 6c 74 3e 20 63 72  ms  <default> cr
9410: 0a 09 09 64 65 6c 2d 6c 61 73 74 2d 6b 65 79 0a  ...del-last-key.
9420: 09 20 20 20 20 54 48 45 4e 0a 20 20 20 20 52 45  .    THEN.    RE
9430: 50 45 41 54 0a 20 20 20 20 64 75 70 20 30 3d 20  PEAT.    dup 0= 
9440: 49 46 20 20 23 2d 35 36 20 74 68 72 6f 77 20 20  IF  #-56 throw  
9450: 54 48 45 4e 0a 20 20 20 20 31 20 3d 20 49 46 20  THEN.    1 = IF 
9460: 20 30 20 73 65 63 72 65 74 2d 6b 65 79 0a 09 2e   0 secret-key...
9470: 22 20 3d 3d 3d 3d 20 6f 70 65 6e 65 64 3a 20 22  " ==== opened: "
9480: 20 64 75 70 20 2e 2e 6e 69 63 6b 20 2e 22 20 20   dup ..nick ."  
9490: 69 6e 20 22 20 2e 74 69 6d 65 20 2e 22 20 3d 3d  in " .time ." ==
94a0: 3d 3d 22 20 63 72 0a 20 20 20 20 45 4c 53 45 20  ==" cr.    ELSE 
94b0: 20 2e 22 20 3d 3d 3d 3d 20 6f 70 65 6e 65 64 20   ." ==== opened 
94c0: 69 6e 20 22 20 2e 74 69 6d 65 20 2e 22 20 3d 3d  in " .time ." ==
94d0: 3d 3d 22 20 63 72 20 63 68 6f 6f 73 65 2d 6b 65  ==" cr choose-ke
94e0: 79 20 20 54 48 45 4e 0a 20 20 20 20 3e 72 61 77  y  THEN.    >raw
94f0: 2d 6b 65 79 20 3f 72 73 6b 20 20 20 72 3e 20 6f  -key ?rsk   r> o
9500: 70 2d 76 65 63 74 6f 72 20 21 20 3b 0a 0a 73 63  p-vector ! ;..sc
9510: 6f 70 65 3a 20 6e 32 6f 0a 46 6f 72 77 61 72 64  ope: n2o.Forward
9520: 20 68 65 6c 70 0a 7d 73 63 6f 70 65 0a 0a 3a 20   help.}scope..: 
9530: 67 65 74 2d 6d 79 2d 6b 65 79 20 28 20 2d 2d 20  get-my-key ( -- 
9540: 78 74 20 29 0a 20 20 20 20 67 65 6e 2d 6b 65 79  xt ).    gen-key
9550: 73 2d 64 69 72 20 20 22 73 65 63 6b 65 79 73 2e  s-dir  "seckeys.
9560: 6b 32 6f 22 20 2e 6b 65 79 73 2f 20 32 64 75 70  k2o" .keys/ 2dup
9570: 20 66 69 6c 65 2d 73 74 61 74 75 73 20 6e 69 70   file-status nip
9580: 0a 20 20 20 20 30 3d 20 49 46 20 20 72 2f 6f 20  .    0= IF  r/o 
9590: 6f 70 65 6e 2d 66 69 6c 65 20 74 68 72 6f 77 20  open-file throw 
95a0: 3e 72 20 72 40 20 66 69 6c 65 2d 73 69 7a 65 20  >r r@ file-size 
95b0: 74 68 72 6f 77 20 64 30 3d 0a 09 72 3e 20 63 6c  throw d0=..r> cl
95c0: 6f 73 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 20  ose-file throw  
95d0: 45 4c 53 45 20 20 74 72 75 65 20 20 54 48 45 4e  ELSE  true  THEN
95e0: 0a 20 20 20 20 49 46 20 20 5b 3a 20 2e 22 20 47  .    IF  [: ." G
95f0: 65 6e 65 72 61 74 65 20 61 20 6e 65 77 20 6b 65  enerate a new ke
9600: 79 70 61 69 72 3a 22 20 63 72 0a 09 20 20 67 65  ypair:" cr..  ge
9610: 74 2d 6e 69 63 6b 20 64 75 70 20 30 3d 20 23 2d  t-nick dup 0= #-
9620: 35 36 20 61 6e 64 20 74 68 72 6f 77 20 5c 20 65  56 and throw \ e
9630: 6d 70 74 79 20 6e 69 63 6b 3a 20 70 72 65 74 65  mpty nick: prete
9640: 6e 64 20 74 6f 20 71 75 69 74 0a 09 20 20 6e 65  nd to quit..  ne
9650: 77 2d 6b 65 79 20 2e 6b 65 79 73 20 3f 72 73 6b  w-key .keys ?rsk
9660: 20 3b 5d 0a 20 20 20 20 45 4c 53 45 20 20 5b 27   ;].    ELSE  ['
9670: 5d 20 67 65 74 2d 73 6b 63 20 20 54 48 45 4e 20  ] get-skc  THEN 
9680: 3b 0a 0a 3a 20 2e 6b 65 79 69 6e 66 6f 20 28 20  ;..: .keyinfo ( 
9690: 2d 2d 20 29 0a 20 20 20 20 3c 77 61 72 6e 3e 20  -- ).    <warn> 
96a0: 2e 22 20 3d 3d 3d 3d 20 4e 6f 20 6b 65 79 20 6f  ." ==== No key o
96b0: 70 65 6e 65 64 20 3d 3d 3d 3d 22 20 63 72 0a 20  pened ====" cr. 
96c0: 20 20 20 3c 69 6e 66 6f 3e 20 2e 22 20 67 65 6e     <info> ." gen
96d0: 65 72 61 74 65 20 61 20 6e 65 77 20 6f 6e 65 20  erate a new one 
96e0: 77 69 74 68 20 27 6b 65 79 67 65 6e 27 22 20 63  with 'keygen'" c
96f0: 72 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 0a 3a  r <default> ;..:
9700: 20 67 65 74 2d 6d 65 20 28 20 2d 2d 20 29 0a 20   get-me ( -- ). 
9710: 20 20 20 67 65 74 2d 6d 79 2d 6b 65 79 20 63 61     get-my-key ca
9720: 74 63 68 20 64 75 70 20 23 2d 35 36 20 3d 20 49  tch dup #-56 = I
9730: 46 20 64 72 6f 70 20 2e 6b 65 79 69 6e 66 6f 20  F drop .keyinfo 
9740: 45 4c 53 45 20 74 68 72 6f 77 20 54 48 45 4e 20  ELSE throw THEN 
9750: 3b 0a 0a 3a 20 3f 67 65 74 2d 6d 65 20 28 20 2d  ;..: ?get-me ( -
9760: 2d 20 29 0a 20 20 20 20 5c 47 20 74 68 69 73 20  - ).    \G this 
9770: 76 65 72 73 69 6f 6e 20 6f 66 20 67 65 74 2d 6d  version of get-m
9780: 65 20 66 61 69 6c 73 20 68 61 72 64 20 69 66 20  e fails hard if 
9790: 6e 6f 20 6b 65 79 20 69 73 20 6f 70 65 6e 65 64  no key is opened
97a0: 0a 20 20 20 20 67 65 74 2d 6d 79 2d 6b 65 79 20  .    get-my-key 
97b0: 63 61 74 63 68 20 23 2d 35 36 20 3d 20 49 46 0a  catch #-56 = IF.
97c0: 09 2e 6b 65 79 69 6e 66 6f 20 74 72 75 65 20 21  ..keyinfo true !
97d0: 21 6e 6f 2d 6b 65 79 2d 6f 70 65 6e 21 21 0a 20  !no-key-open!!. 
97e0: 20 20 20 54 48 45 4e 20 3b 0a 0a 30 20 5b 49 46     THEN ;..0 [IF
97f0: 5d 0a 4c 6f 63 61 6c 20 56 61 72 69 61 62 6c 65  ].Local Variable
9800: 73 3a 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 77  s:.forth-local-w
9810: 6f 72 64 73 3a 0a 20 20 20 20 28 0a 20 20 20 20  ords:.    (.    
9820: 20 28 28 22 6e 65 74 32 6f 3a 22 20 22 2b 6e 65   (("net2o:" "+ne
9830: 74 32 6f 3a 22 29 20 64 65 66 69 6e 69 74 69 6f  t2o:") definitio
9840: 6e 2d 73 74 61 72 74 65 72 20 28 66 6f 6e 74 2d  n-starter (font-
9850: 6c 6f 63 6b 2d 6b 65 79 77 6f 72 64 2d 66 61 63  lock-keyword-fac
9860: 65 20 2e 20 31 29 0a 20 20 20 20 20 20 22 5b 20  e . 1).      "[ 
9870: 5c 74 5c 6e 5d 22 20 74 20 6e 61 6d 65 20 28 66  \t\n]" t name (f
9880: 6f 6e 74 2d 6c 6f 63 6b 2d 66 75 6e 63 74 69 6f  ont-lock-functio
9890: 6e 2d 6e 61 6d 65 2d 66 61 63 65 20 2e 20 33 29  n-name-face . 3)
98a0: 29 0a 20 20 20 20 20 28 28 22 64 65 62 75 67 3a  ).     (("debug:
98b0: 22 20 22 66 69 65 6c 64 3a 22 20 22 32 66 69 65  " "field:" "2fie
98c0: 6c 64 3a 22 20 22 73 66 66 69 65 6c 64 3a 22 20  ld:" "sffield:" 
98d0: 22 64 66 66 69 65 6c 64 3a 22 20 22 36 34 66 69  "dffield:" "64fi
98e0: 65 6c 64 3a 22 20 22 75 76 61 72 22 20 22 75 76  eld:" "uvar" "uv
98f0: 61 6c 75 65 22 29 20 6e 6f 6e 2d 69 6d 6d 65 64  alue") non-immed
9900: 69 61 74 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d  iate (font-lock-
9910: 74 79 70 65 2d 66 61 63 65 20 2e 20 32 29 0a 20  type-face . 2). 
9920: 20 20 20 20 20 22 5b 20 5c 74 5c 6e 5d 22 20 74       "[ \t\n]" t
9930: 20 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b   name (font-lock
9940: 2d 76 61 72 69 61 62 6c 65 2d 6e 61 6d 65 2d 66  -variable-name-f
9950: 61 63 65 20 2e 20 33 29 29 0a 20 20 20 20 20 28  ace . 3)).     (
9960: 22 5b 61 2d 7a 30 2d 39 5d 2b 28 22 20 69 6d 6d  "[a-z0-9]+(" imm
9970: 65 64 69 61 74 65 20 28 66 6f 6e 74 2d 6c 6f 63  ediate (font-loc
9980: 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 65 20 2e  k-comment-face .
9990: 20 31 29 0a 20 20 20 20 20 20 22 29 22 20 6e 69   1).      ")" ni
99a0: 6c 20 63 6f 6d 6d 65 6e 74 20 28 66 6f 6e 74 2d  l comment (font-
99b0: 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63  lock-comment-fac
99c0: 65 20 2e 20 31 29 29 0a 20 20 20 20 29 0a 66 6f  e . 1)).    ).fo
99d0: 72 74 68 2d 6c 6f 63 61 6c 2d 69 6e 64 65 6e 74  rth-local-indent
99e0: 2d 77 6f 72 64 73 3a 0a 20 20 20 20 28 0a 20 20  -words:.    (.  
99f0: 20 20 20 28 28 22 6e 65 74 32 6f 3a 22 20 22 2b     (("net2o:" "+
9a00: 6e 65 74 32 6f 3a 22 29 20 28 30 20 2e 20 32 29  net2o:") (0 . 2)
9a10: 20 28 30 20 2e 20 32 29 20 6e 6f 6e 2d 69 6d 6d   (0 . 2) non-imm
9a20: 65 64 69 61 74 65 29 0a 20 20 20 20 20 28 28 22  ediate).     (("
9a30: 5b 3a 22 20 22 6b 65 79 3a 63 6f 64 65 22 29 20  [:" "key:code") 
9a40: 28 30 20 2e 20 31 29 20 28 30 20 2e 20 31 29 20  (0 . 1) (0 . 1) 
9a50: 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 20  immediate).     
9a60: 28 28 22 3b 5d 22 20 22 65 6e 64 3a 6b 65 79 22  ((";]" "end:key"
9a70: 29 20 28 2d 31 20 2e 20 30 29 20 28 30 20 2e 20  ) (-1 . 0) (0 . 
9a80: 2d 31 29 20 69 6d 6d 65 64 69 61 74 65 29 0a 20  -1) immediate). 
9a90: 20 20 20 29 0a 45 6e 64 3a 0a 5b 54 48 45 4e 5d     ).End:.[THEN]