Hex Artifact Content
Not logged in

Artifact 39694197ece3ec06141d7ec2226f734c6161626d:


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 20 7e 7e 0a 20 20 20 20 45  perform ~~.    E
67a0: 4c 53 45 20 20 2e 22 20 75 6e 6b 6e 6f 77 6e 20  LSE  ." unknown 
67b0: 74 61 67 20 22 20 68 65 78 2e 20 2e 22 20 73 63  tag " hex. ." sc
67c0: 61 6e 6e 65 64 20 22 20 38 35 74 79 70 65 20 63  anned " 85type c
67d0: 72 20 20 54 48 45 4e 20 3b 0a 0a 5c 20 67 65 6e  r  THEN ;..\ gen
67e0: 65 72 61 74 65 20 6b 65 79 73 0a 0a 3a 20 73 6b  erate keys..: sk
67f0: 73 69 67 21 20 28 20 2d 2d 20 29 0a 20 20 20 20  sig! ( -- ).    
6800: 6b 65 2d 70 6b 20 24 40 20 6b 65 2d 73 6b 20 73  ke-pk $@ ke-sk s
6810: 65 63 40 20 63 3a 30 6b 65 79 20 3e 6b 65 79 65  ec@ c:0key >keye
6820: 64 2d 68 61 73 68 20 6b 65 79 70 61 64 20 24 32  d-hash keypad $2
6830: 30 20 6b 65 63 63 61 6b 3e 0a 20 20 20 20 6b 65  0 keccak>.    ke
6840: 79 70 61 64 20 6b 65 79 73 69 7a 65 20 6b 65 2d  ypad keysize ke-
6850: 73 6b 73 69 67 20 73 65 63 21 20 3b 0a 0a 3a 20  sksig sec! ;..: 
6860: 2b 67 65 6e 2d 6b 65 79 73 20 28 20 6e 69 63 6b  +gen-keys ( nick
6870: 20 75 20 74 79 70 65 20 2d 2d 20 29 0a 20 20 20   u type -- ).   
6880: 20 67 65 6e 2d 6b 65 79 73 20 20 36 34 23 2d 31   gen-keys  64#-1
6890: 20 6b 65 79 2d 72 65 61 64 2d 6f 66 66 73 65 74   key-read-offset
68a0: 20 36 34 21 0a 20 20 20 20 70 6b 63 20 6b 65 79   64!.    pkc key
68b0: 73 69 7a 65 32 20 6b 65 79 3a 6e 65 77 20 3e 6f  size2 key:new >o
68c0: 20 6f 20 6d 79 2d 6b 65 79 20 21 0a 20 20 20 20   o my-key !.    
68d0: 5b 20 31 20 69 6d 70 6f 72 74 23 73 65 6c 66 20  [ 1 import#self 
68e0: 6c 73 68 69 66 74 20 31 20 69 6d 70 6f 72 74 23  lshift 1 import#
68f0: 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 20 5d 4c  new lshift or ]L
6900: 20 6b 65 2d 69 6d 70 6f 72 74 73 20 21 0a 20 20   ke-imports !.  
6910: 20 20 6b 65 2d 74 79 70 65 20 21 20 20 6b 65 2d    ke-type !  ke-
6920: 6e 69 63 6b 20 24 21 20 20 6e 69 63 6b 21 0a 20  nick $!  nick!. 
6930: 20 20 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76     config:pw-lev
6940: 65 6c 23 20 40 20 6b 65 2d 70 77 6c 65 76 65 6c  el# @ ke-pwlevel
6950: 20 21 20 20 70 65 72 6d 25 6d 79 73 65 6c 66 20   !  perm%myself 
6960: 6b 65 2d 6d 61 73 6b 20 21 0a 20 20 20 20 73 6b  ke-mask !.    sk
6970: 63 20 6b 65 79 73 69 7a 65 20 6b 65 2d 73 6b 20  c keysize ke-sk 
6980: 73 65 63 21 20 20 2b 73 65 63 6b 65 79 0a 20 20  sec!  +seckey.  
6990: 20 20 73 6b 72 65 76 20 6b 65 79 73 69 7a 65 20    skrev keysize 
69a0: 6b 65 2d 72 73 6b 20 73 65 63 21 0a 20 20 20 20  ke-rsk sec!.    
69b0: 73 6b 73 69 67 21 20 6b 65 79 2d 73 69 67 6e 20  sksig! key-sign 
69c0: 6f 3e 20 3b 0a 0a 24 34 30 20 62 75 66 66 65 72  o> ;..$40 buffer
69d0: 3a 20 6e 69 63 6b 2d 62 75 66 0a 0a 3a 20 67 65  : nick-buf..: ge
69e0: 74 2d 6e 69 63 6b 20 28 20 2d 2d 20 61 64 64 72  t-nick ( -- addr
69f0: 20 75 20 29 0a 20 20 20 20 2e 22 20 6e 69 63 6b   u ).    ." nick
6a00: 3a 20 22 20 6e 69 63 6b 2d 62 75 66 20 24 34 30  : " nick-buf $40
6a10: 20 61 63 63 65 70 74 20 6e 69 63 6b 2d 62 75 66   accept nick-buf
6a20: 20 73 77 61 70 20 2d 74 72 61 69 6c 69 6e 67 20   swap -trailing 
6a30: 63 72 20 3b 0a 0a 66 61 6c 73 65 20 76 61 6c 75  cr ;..false valu
6a40: 65 20 3f 79 65 73 0a 3a 20 79 65 73 3f 20 28 20  e ?yes.: yes? ( 
6a50: 61 64 64 72 20 75 20 2d 2d 20 66 6c 61 67 20 29  addr u -- flag )
6a60: 0a 20 20 20 20 3f 79 65 73 20 49 46 20 20 32 64  .    ?yes IF  2d
6a70: 72 6f 70 20 74 72 75 65 20 20 45 4c 53 45 20 20  rop true  ELSE  
6a80: 74 79 70 65 20 2e 22 20 20 28 79 2f 4e 29 22 20  type ."  (y/N)" 
6a90: 6b 65 79 20 63 72 20 27 79 27 20 3d 20 20 54 48  key cr 'y' =  TH
6aa0: 45 4e 20 3b 0a 0a 3a 20 3f 72 73 6b 20 28 20 2d  EN ;..: ?rsk ( -
6ab0: 2d 20 29 0a 20 20 20 20 70 6b 40 20 6b 65 79 7c  - ).    pk@ key|
6ac0: 20 6b 65 79 2d 65 78 69 73 74 3f 20 64 75 70 20   key-exist? dup 
6ad0: 30 3d 20 49 46 20 20 64 72 6f 70 20 20 45 58 49  0= IF  drop  EXI
6ae0: 54 20 20 54 48 45 4e 0a 20 20 20 20 3e 6f 20 6b  T  THEN.    >o k
6af0: 65 2d 72 73 6b 20 73 65 63 40 20 64 75 70 20 30  e-rsk sec@ dup 0
6b00: 3d 20 49 46 20 20 32 64 72 6f 70 20 6f 3e 20 20  = IF  2drop o>  
6b10: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 2e  EXIT  THEN.    .
6b20: 22 20 59 6f 75 20 73 74 69 6c 6c 20 68 61 76 65  " You still have
6b30: 6e 27 74 20 73 74 6f 72 65 64 20 79 6f 75 72 20  n't stored your 
6b40: 72 65 76 6f 6b 65 20 6b 65 79 20 73 65 63 75 72  revoke key secur
6b50: 65 6c 79 20 6f 66 66 2d 6c 69 6e 65 2e 22 20 63  ely off-line." c
6b60: 72 0a 20 20 20 20 73 22 20 50 61 70 65 72 20 61  r.    s" Paper a
6b70: 6e 64 20 70 65 6e 63 69 6c 20 72 65 61 64 79 3f  nd pencil ready?
6b80: 22 20 79 65 73 3f 20 49 46 0a 09 2e 73 74 72 69  " yes? IF...stri
6b90: 70 65 38 35 0a 09 73 22 20 57 72 69 74 74 65 6e  pe85..s" Written
6ba0: 20 64 6f 77 6e 3f 22 20 79 65 73 3f 20 49 46 0a   down?" yes? IF.
6bb0: 09 20 20 20 20 73 22 20 59 6f 75 20 77 6f 6e 27  .    s" You won'
6bc0: 74 20 73 65 65 20 74 68 69 73 20 61 67 61 69 6e  t see this again
6bd0: 21 20 44 65 6c 65 74 65 3f 22 20 79 65 73 3f 0a  ! Delete?" yes?.
6be0: 09 20 20 20 20 49 46 20 6b 65 2d 72 73 6b 20 73  .    IF ke-rsk s
6bf0: 65 63 2d 6f 66 66 20 20 73 61 76 65 2d 6b 65 79  ec-off  save-key
6c00: 73 0a 09 09 2e 22 20 72 65 76 6f 6b 65 20 6b 65  s...." revoke ke
6c10: 79 20 64 65 6c 65 74 65 64 2e 22 20 63 72 20 6f  y deleted." cr o
6c20: 3e 20 20 45 58 49 54 20 20 54 48 45 4e 20 20 54  >  EXIT  THEN  T
6c30: 48 45 4e 0a 20 20 20 20 45 4c 53 45 20 20 32 64  HEN.    ELSE  2d
6c40: 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 2e 22  rop  THEN.    ."
6c50: 20 49 27 6d 20 6b 65 65 70 69 6e 67 20 79 6f 75   I'm keeping you
6c60: 72 20 72 65 76 6f 6b 65 20 6b 65 79 2e 20 20 54  r revoke key.  T
6c70: 68 69 73 20 77 69 6c 6c 20 73 68 6f 77 20 75 70  his will show up
6c80: 20 61 67 61 69 6e 2e 22 20 63 72 20 6f 3e 20 3b   again." cr o> ;
6c90: 0a 0a 5c 20 72 65 61 64 20 6b 65 79 20 66 69 6c  ..\ read key fil
6ca0: 65 0a 0a 3a 20 74 72 79 2d 64 65 63 72 79 70 74  e..: try-decrypt
6cb0: 2d 6b 65 79 20 28 20 6b 65 79 20 75 31 20 2d 2d  -key ( key u1 --
6cc0: 20 61 64 64 72 20 75 32 20 66 6c 61 67 20 29 0a   addr u2 flag ).
6cd0: 20 20 20 20 6b 65 79 70 61 63 6b 20 6b 65 79 70      keypack keyp
6ce0: 61 63 6b 2d 64 20 6b 65 79 70 61 63 6b 2d 61 6c  ack-d keypack-al
6cf0: 6c 23 20 6d 6f 76 65 0a 20 20 20 20 6b 65 79 70  l# move.    keyp
6d00: 61 63 6b 2d 64 20 6b 65 79 70 61 63 6b 2d 61 6c  ack-d keypack-al
6d10: 6c 23 20 32 73 77 61 70 0a 20 20 20 20 64 75 70  l# 2swap.    dup
6d20: 20 24 32 30 20 3d 20 49 46 20 20 64 65 63 72 79   $20 = IF  decry
6d30: 70 74 24 20 20 45 4c 53 45 0a 09 6b 65 79 70 61  pt$  ELSE..keypa
6d40: 63 6b 20 63 40 20 24 46 20 61 6e 64 20 63 6f 6e  ck c@ $F and con
6d50: 66 69 67 3a 70 77 2d 6d 61 78 6c 65 76 65 6c 23  fig:pw-maxlevel#
6d60: 20 40 20 3c 3d 0a 09 49 46 20 20 64 65 63 72 79   @ <=..IF  decry
6d70: 70 74 2d 70 77 24 20 20 45 4c 53 45 20 20 32 64  pt-pw$  ELSE  2d
6d80: 72 6f 70 20 66 61 6c 73 65 20 20 54 48 45 4e 0a  rop false  THEN.
6d90: 20 20 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 74 72      THEN ;..: tr
6da0: 79 2d 64 65 63 72 79 70 74 20 28 20 66 6c 61 67  y-decrypt ( flag
6db0: 20 2d 2d 20 61 64 64 72 20 75 20 2f 20 30 20 30   -- addr u / 0 0
6dc0: 20 29 20 7b 20 66 6c 61 67 20 7d 0a 20 20 20 20   ) { flag }.    
6dd0: 6b 65 79 73 20 24 5b 5d 23 20 30 20 3f 44 4f 0a  keys $[]# 0 ?DO.
6de0: 09 49 20 6b 65 79 73 20 73 65 63 5b 5d 40 20 64  .I keys sec[]@ d
6df0: 75 70 20 6b 65 79 73 69 7a 65 20 3d 20 66 6c 61  up keysize = fla
6e00: 67 20 78 6f 72 20 49 46 0a 09 20 20 20 20 74 72  g xor IF..    tr
6e10: 79 2d 64 65 63 72 79 70 74 2d 6b 65 79 20 49 46  y-decrypt-key IF
6e20: 0a 09 09 49 20 6b 65 79 73 20 24 5b 5d 20 40 20  ...I keys $[] @ 
6e30: 64 75 70 20 3e 73 74 6f 72 65 6b 65 79 20 21 20  dup >storekey ! 
6e40: 64 65 66 61 75 6c 74 6b 65 79 20 21 0a 09 09 75  defaultkey !...u
6e50: 6e 6c 6f 6f 70 20 20 45 58 49 54 20 20 54 48 45  nloop  EXIT  THE
6e60: 4e 20 20 54 48 45 4e 0a 09 32 64 72 6f 70 0a 20  N  THEN..2drop. 
6e70: 20 20 20 4c 4f 4f 50 20 20 30 20 30 20 3b 0a 0a     LOOP  0 0 ;..
6e80: 3a 20 3f 70 65 72 6d 20 28 20 6f 3a 6b 65 79 20  : ?perm ( o:key 
6e90: 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 73 6b 20 73  -- ).    ke-sk s
6ea0: 65 63 40 20 6e 69 70 20 64 75 70 20 49 46 20 20  ec@ nip dup IF  
6eb0: 70 65 72 6d 25 6d 79 73 65 6c 66 20 20 45 4c 53  perm%myself  ELS
6ec0: 45 20 20 70 65 72 6d 25 64 65 66 61 75 6c 74 20  E  perm%default 
6ed0: 20 54 48 45 4e 20 20 6b 65 2d 6d 61 73 6b 20 21   THEN  ke-mask !
6ee0: 0a 20 20 20 20 49 46 20 20 22 5c 78 30 30 22 20  .    IF  "\x00" 
6ef0: 20 45 4c 53 45 20 20 22 5c 78 30 31 22 20 20 54   ELSE  "\x01"  T
6f00: 48 45 4e 20 20 6b 65 2d 67 72 6f 75 70 73 20 24  HEN  ke-groups $
6f10: 21 20 3b 0a 0a 3a 20 64 6f 2d 6b 65 79 20 28 20  ! ;..: do-key ( 
6f20: 61 64 64 72 20 75 20 2f 20 30 20 30 20 20 2d 2d  addr u / 0 0  --
6f30: 20 29 0a 20 20 20 20 64 75 70 20 30 3d 20 49 46   ).    dup 0= IF
6f40: 20 20 32 64 72 6f 70 20 20 45 58 49 54 20 20 54    2drop  EXIT  T
6f50: 48 45 4e 0a 20 20 20 20 73 61 6d 70 6c 65 2d 6b  HEN.    sample-k
6f60: 65 79 20 3e 6f 20 6b 65 2d 73 6b 20 6b 65 2d 65  ey >o ke-sk ke-e
6f70: 6e 64 20 6f 76 65 72 20 2d 20 65 72 61 73 65 20  nd over - erase 
6f80: 20 64 6f 2d 63 6d 64 2d 6c 6f 6f 70 20 6f 3e 20   do-cmd-loop o> 
6f90: 3b 0a 0a 3a 20 2e 6b 65 79 24 20 28 20 61 64 64  ;..: .key$ ( add
6fa0: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 73 61 6d  r u -- ).    sam
6fb0: 70 6c 65 2d 6b 65 79 20 3e 6f 20 20 6b 65 2d 73  ple-key >o  ke-s
6fc0: 6b 20 6b 65 2d 65 6e 64 20 6f 76 65 72 20 2d 20  k ke-end over - 
6fd0: 65 72 61 73 65 0a 20 20 20 20 73 69 67 6e 65 64  erase.    signed
6fe0: 2d 76 61 6c 20 76 61 6c 69 64 61 74 65 64 20 6f  -val validated o
6ff0: 72 21 20 20 63 2d 73 74 61 74 65 20 6f 66 66 20  r!  c-state off 
7000: 20 6e 65 73 74 2d 63 6d 64 2d 6c 6f 6f 70 0a 20   nest-cmd-loop. 
7010: 20 20 20 73 69 67 6e 65 64 2d 76 61 6c 20 69 6e     signed-val in
7020: 76 65 72 74 20 76 61 6c 69 64 61 74 65 64 20 61  vert validated a
7030: 6e 64 21 0a 20 20 20 20 2e 6b 65 79 2d 73 68 6f  nd!.    .key-sho
7040: 72 74 20 66 72 65 65 2d 6b 65 79 20 6f 3e 20 3b  rt free-key o> ;
7050: 0a 0a 3a 20 72 65 61 64 2d 6b 65 79 73 2d 6c 6f  ..: read-keys-lo
7060: 6f 70 20 28 20 66 64 20 2d 2d 20 29 20 20 63 6f  op ( fd -- )  co
7070: 64 65 2d 6b 65 79 0a 20 20 20 20 3e 72 20 23 30  de-key.    >r #0
7080: 2e 20 72 40 20 72 65 70 6f 73 69 74 69 6f 6e 2d  . r@ reposition-
7090: 66 69 6c 65 20 74 68 72 6f 77 0a 20 20 20 20 42  file throw.    B
70a0: 45 47 49 4e 0a 09 72 40 20 66 69 6c 65 2d 70 6f  EGIN..r@ file-po
70b0: 73 69 74 69 6f 6e 20 74 68 72 6f 77 20 64 3e 36  sition throw d>6
70c0: 34 20 6b 65 79 2d 72 65 61 64 2d 6f 66 66 73 65  4 key-read-offse
70d0: 74 20 36 34 21 0a 09 6b 65 79 70 61 63 6b 20 6b  t 64!..keypack k
70e0: 65 79 70 61 63 6b 2d 61 6c 6c 23 20 72 40 20 72  eypack-all# r@ r
70f0: 65 61 64 2d 66 69 6c 65 20 74 68 72 6f 77 0a 09  ead-file throw..
7100: 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3d 20 57  keypack-all# = W
7110: 48 49 4c 45 0a 09 20 20 20 20 69 6d 70 6f 72 74  HILE..    import
7120: 2d 74 79 70 65 20 40 20 69 6d 70 6f 72 74 23 73  -type @ import#s
7130: 65 6c 66 20 3d 20 74 72 79 2d 64 65 63 72 79 70  elf = try-decryp
7140: 74 20 64 6f 2d 6b 65 79 0a 20 20 20 20 52 45 50  t do-key.    REP
7150: 45 41 54 20 20 72 64 72 6f 70 20 20 63 6f 64 65  EAT  rdrop  code
7160: 30 2d 62 75 66 20 3b 0a 3a 20 72 65 61 64 2d 6b  0-buf ;.: read-k
7170: 65 79 2d 6c 6f 6f 70 20 28 20 2d 2d 20 29 0a 20  ey-loop ( -- ). 
7180: 20 20 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 69     import#self i
7190: 6d 70 6f 72 74 2d 74 79 70 65 20 21 0a 20 20 20  mport-type !.   
71a0: 20 3f 6b 65 79 2d 73 66 64 20 72 65 61 64 2d 6b   ?key-sfd read-k
71b0: 65 79 73 2d 6c 6f 6f 70 20 3b 0a 3a 20 72 65 61  eys-loop ;.: rea
71c0: 64 2d 70 6b 65 79 2d 6c 6f 6f 70 20 28 20 2d 2d  d-pkey-loop ( --
71d0: 20 29 0a 20 20 20 20 6c 61 73 74 6b 65 79 40 20   ).    lastkey@ 
71e0: 64 72 6f 70 20 64 65 66 61 75 6c 74 6b 65 79 20  drop defaultkey 
71f0: 21 20 5c 20 61 74 20 6c 65 61 73 74 20 6f 6e 65  ! \ at least one
7200: 20 64 65 66 61 75 6c 74 20 6b 65 79 20 61 76 61   default key ava
7210: 69 6c 61 62 6c 65 0a 20 20 20 20 2d 31 20 63 6f  ilable.    -1 co
7220: 6e 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23 0a 20  nfig:pw-level#. 
7230: 20 20 20 5b 3a 20 69 6d 70 6f 72 74 23 6e 65 77     [: import#new
7240: 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 3f   import-type ! ?
7250: 6b 65 79 2d 70 66 64 20 72 65 61 64 2d 6b 65 79  key-pfd read-key
7260: 73 2d 6c 6f 6f 70 20 3b 5d 20 21 77 72 61 70 70  s-loop ;] !wrapp
7270: 65 72 20 3b 0a 0a 3a 20 72 65 61 64 2d 6b 65 79  er ;..: read-key
7280: 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 72 65 61  s ( -- ).    rea
7290: 64 2d 6b 65 79 2d 6c 6f 6f 70 20 72 65 61 64 2d  d-key-loop read-
72a0: 70 6b 65 79 2d 6c 6f 6f 70 20 69 6d 70 6f 72 74  pkey-loop import
72b0: 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 79 70 65  #new import-type
72c0: 20 21 20 3b 0a 0a 3a 20 72 65 61 64 2d 70 6b 32   ! ;..: read-pk2
72d0: 6b 65 79 24 20 28 20 61 64 64 72 20 75 20 2d 2d  key$ ( addr u --
72e0: 20 29 0a 20 20 20 20 5c 67 20 72 65 61 64 20 61   ).    \g read a
72f0: 20 6e 65 73 74 65 64 20 6b 65 79 20 69 6e 74 6f   nested key into
7300: 20 73 61 6d 70 6c 65 2d 6b 65 79 0a 20 20 20 20   sample-key.    
7310: 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 63 2d  sample-key >o c-
7320: 73 74 61 74 65 20 6f 66 66 20 20 73 69 6d 2d 6e  state off  sim-n
7330: 69 63 6b 21 20 6f 6e 0a 20 20 20 20 70 6b 32 2d  ick! on.    pk2-
7340: 73 69 67 3f 20 21 21 73 69 67 21 21 20 73 69 67  sig? !!sig!! sig
7350: 70 6b 32 73 69 7a 65 23 20 2d 20 32 64 75 70 20  pk2size# - 2dup 
7360: 2b 20 3e 72 20 64 6f 2d 6e 65 73 74 73 69 67 0a  + >r do-nestsig.
7370: 20 20 20 20 72 40 20 6b 65 79 73 69 7a 65 32 20      r@ keysize2 
7380: 6b 65 2d 70 6b 20 24 21 0a 20 20 20 20 72 3e 20  ke-pk $!.    r> 
7390: 6b 65 79 73 69 7a 65 32 20 2b 20 73 69 67 73 69  keysize2 + sigsi
73a0: 7a 65 23 20 6b 65 2d 73 65 6c 66 73 69 67 20 24  ze# ke-selfsig $
73b0: 21 0a 20 20 20 20 6f 3e 20 20 73 69 6d 2d 6e 69  !.    o>  sim-ni
73c0: 63 6b 21 20 6f 66 66 20 3b 0a 0a 3a 20 2e 70 6b  ck! off ;..: .pk
73d0: 32 6b 65 79 24 20 28 20 61 64 64 72 20 75 20 2d  2key$ ( addr u -
73e0: 2d 20 29 0a 20 20 20 20 72 65 61 64 2d 70 6b 32  - ).    read-pk2
73f0: 6b 65 79 24 20 73 61 6d 70 6c 65 2d 6b 65 79 20  key$ sample-key 
7400: 3e 6f 0a 20 20 20 20 5b 20 31 20 69 6d 70 6f 72  >o.    [ 1 impor
7410: 74 23 69 6e 76 69 74 65 64 20 6c 73 68 69 66 74  t#invited lshift
7420: 20 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73   1 import#new ls
7430: 68 69 66 74 20 6f 72 20 5d 4c 20 6b 65 2d 69 6d  hift or ]L ke-im
7440: 70 6f 72 74 73 20 21 0a 20 20 20 20 2e 6b 65 79  ports !.    .key
7450: 2d 69 6e 76 69 74 65 20 66 72 65 65 2d 6b 65 79  -invite free-key
7460: 20 6f 3e 20 3b 0a 0a 5c 20 73 65 6c 65 63 74 20   o> ;..\ select 
7470: 6b 65 79 20 62 79 20 6e 69 63 6b 0a 0a 46 6f 72  key by nick..For
7480: 77 61 72 64 20 21 6d 79 2d 61 64 64 72 24 0a 0a  ward !my-addr$..
7490: 3a 20 3e 72 61 77 2d 6b 65 79 20 28 20 6f 20 2d  : >raw-key ( o -
74a0: 2d 20 29 0a 20 20 20 20 64 75 70 20 30 3d 20 21  - ).    dup 0= !
74b0: 21 6e 6f 2d 6e 69 63 6b 21 21 20 64 75 70 20 6d  !no-nick!! dup m
74c0: 79 2d 6b 65 79 2d 64 65 66 61 75 6c 74 20 21 20  y-key-default ! 
74d0: 3e 6f 0a 20 20 20 20 73 6b 73 69 67 21 0a 20 20  >o.    sksig!.  
74e0: 20 20 6b 65 2d 70 6b 20 24 40 20 70 6b 63 20 70    ke-pk $@ pkc p
74f0: 6b 72 6b 23 20 73 6d 6f 76 65 0a 20 20 20 20 6b  krk# smove.    k
7500: 65 2d 73 6b 20 73 65 63 40 20 73 6b 63 20 73 77  e-sk sec@ skc sw
7510: 61 70 20 6b 65 79 7c 20 6d 6f 76 65 0a 20 20 20  ap key| move.   
7520: 20 6b 65 2d 73 6b 73 69 67 20 73 65 63 40 20 73   ke-sksig sec@ s
7530: 6b 73 69 67 20 6b 65 79 73 69 7a 65 20 73 6d 6f  ksig keysize smo
7540: 76 65 20 6f 3e 0a 20 20 20 20 21 6d 79 2d 61 64  ve o>.    !my-ad
7550: 64 72 24 20 3b 0a 0a 3a 20 3e 6b 65 79 20 28 20  dr$ ;..: >key ( 
7560: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20  addr u -- ).    
7570: 6b 65 79 23 20 40 20 30 3d 20 49 46 20 20 72 65  key# @ 0= IF  re
7580: 61 64 2d 6b 65 79 73 20 20 54 48 45 4e 0a 20 20  ad-keys  THEN.  
7590: 20 20 6e 69 63 6b 2d 6b 65 79 20 3e 72 61 77 2d    nick-key >raw-
75a0: 6b 65 79 20 3b 0a 0a 3a 20 69 27 6d 20 28 20 22  key ;..: i'm ( "
75b0: 6e 61 6d 65 22 20 2d 2d 20 29 20 70 61 72 73 65  name" -- ) parse
75c0: 2d 6e 61 6d 65 20 3e 6b 65 79 20 3b 0a 3a 20 70  -name >key ;.: p
75d0: 6b 27 20 28 20 22 6e 61 6d 65 22 20 2d 2d 20 61  k' ( "name" -- a
75e0: 64 64 72 20 75 20 29 0a 20 20 20 20 70 61 72 73  ddr u ).    pars
75f0: 65 2d 6e 61 6d 65 20 6e 69 63 6b 3e 70 6b 20 3b  e-name nick>pk ;
7600: 0a 0a 3a 20 64 65 73 74 2d 6b 65 79 20 28 20 61  ..: dest-key ( a
7610: 64 64 72 20 75 20 2d 2d 20 29 20 64 75 70 20 30  ddr u -- ) dup 0
7620: 3d 20 49 46 20 20 32 64 72 6f 70 20 20 45 58 49  = IF  2drop  EXI
7630: 54 20 20 54 48 45 4e 0a 20 20 20 20 6e 69 63 6b  T  THEN.    nick
7640: 2d 6b 65 79 20 3e 6f 20 6f 20 30 3d 20 21 21 75  -key >o o 0= !!u
7650: 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21 0a 20 20 20  nknown-key!!.   
7660: 20 6b 65 2d 70 6b 20 24 40 20 6f 3e 0a 20 20 20   ke-pk $@ o>.   
7670: 20 70 75 62 6b 65 79 20 24 21 20 3b 0a 0a 3a 20   pubkey $! ;..: 
7680: 64 65 73 74 2d 70 6b 20 28 20 61 64 64 72 20 75  dest-pk ( addr u
7690: 20 2d 2d 20 29 20 6b 65 79 32 7c 20 32 64 75 70   -- ) key2| 2dup
76a0: 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 30 3d   key| key# #@ 0=
76b0: 20 49 46 0a 09 64 72 6f 70 20 20 70 65 72 6d 25   IF..drop  perm%
76c0: 75 6e 6b 6e 6f 77 6e 0a 20 20 20 20 45 4c 53 45  unknown.    ELSE
76d0: 20 20 63 65 6c 6c 2b 20 3e 6f 20 32 64 72 6f 70    cell+ >o 2drop
76e0: 0a 09 6b 65 2d 70 6b 20 24 40 20 6b 65 2d 6d 61  ..ke-pk $@ ke-ma
76f0: 73 6b 20 40 20 6f 3e 20 20 54 48 45 4e 0a 20 20  sk @ o>  THEN.  
7700: 20 20 70 65 72 6d 2d 6d 61 73 6b 20 21 20 70 75    perm-mask ! pu
7710: 62 6b 65 79 20 24 21 20 3b 0a 0a 3a 20 72 65 70  bkey $! ;..: rep
7720: 6c 61 63 65 2d 6b 65 79 20 31 20 2f 73 74 72 69  lace-key 1 /stri
7730: 6e 67 20 7b 20 72 65 76 2d 61 64 64 72 20 75 20  ng { rev-addr u 
7740: 2d 2d 20 6f 20 7d 20 5c 20 72 65 76 6f 63 61 74  -- o } \ revocat
7750: 69 6f 6e 20 74 69 63 6b 65 74 0a 20 20 20 20 6b  ion ticket.    k
7760: 65 79 28 20 2e 22 20 52 65 70 6c 61 63 65 3a 22  ey( ." Replace:"
7770: 20 63 72 20 6f 20 63 65 6c 6c 2d 20 30 20 2e 6b   cr o cell- 0 .k
7780: 65 79 20 29 0a 20 20 20 20 69 6d 70 6f 72 74 23  ey ).    import#
7790: 73 65 6c 66 20 69 6d 70 6f 72 74 2d 74 79 70 65  self import-type
77a0: 20 21 0a 20 20 20 20 73 22 20 23 72 65 76 6f 6b   !.    s" #revok
77b0: 65 64 22 20 64 75 70 20 3e 72 20 6b 65 2d 6e 69  ed" dup >r ke-ni
77c0: 63 6b 20 24 2b 21 0a 20 20 20 20 6b 65 2d 6e 69  ck $+!.    ke-ni
77d0: 63 6b 20 24 40 20 72 3e 20 2d 20 6b 65 2d 70 72  ck $@ r> - ke-pr
77e0: 6f 66 20 24 40 20 6b 65 2d 73 69 67 73 5b 5d 20  of $@ ke-sigs[] 
77f0: 6b 65 2d 74 79 70 65 20 40 0a 20 20 20 20 72 65  ke-type @.    re
7800: 76 2d 61 64 64 72 20 70 6b 72 6b 23 20 6b 65 79  v-addr pkrk# key
7810: 3f 6e 65 77 20 3e 6f 0a 20 20 20 20 6b 65 2d 74  ?new >o.    ke-t
7820: 79 70 65 20 21 20 5b 3a 20 6b 65 2d 73 69 67 73  ype ! [: ke-sigs
7830: 5b 5d 20 24 2b 5b 5d 21 20 3b 5d 20 24 5b 5d 6d  [] $+[]! ;] $[]m
7840: 61 70 20 6b 65 2d 70 72 6f 66 20 24 21 20 6b 65  ap ke-prof $! ke
7850: 2d 6e 69 63 6b 20 24 21 0a 20 20 20 20 72 65 76  -nick $!.    rev
7860: 2d 61 64 64 72 20 70 6b 72 6b 23 20 6b 65 2d 70  -addr pkrk# ke-p
7870: 6b 20 24 21 0a 20 20 20 20 72 65 76 2d 61 64 64  k $!.    rev-add
7880: 72 20 75 20 2b 20 31 2d 20 64 75 70 20 63 40 20  r u + 1- dup c@ 
7890: 32 2a 20 2d 20 24 31 30 20 2d 20 24 31 30 20 6b  2* - $10 - $10 k
78a0: 65 2d 73 65 6c 66 73 69 67 20 24 21 0a 20 20 20  e-selfsig $!.   
78b0: 20 6b 65 79 28 20 2e 22 20 77 69 74 68 3a 22 20   key( ." with:" 
78c0: 63 72 20 6f 20 63 65 6c 6c 2d 20 30 20 2e 6b 65  cr o cell- 0 .ke
78d0: 79 20 29 20 6f 20 6f 3e 0a 20 20 20 20 69 6d 70  y ) o o>.    imp
78e0: 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74  ort#new import-t
78f0: 79 70 65 20 21 20 3b 0a 0a 3a 20 72 65 6e 65 77  ype ! ;..: renew
7900: 2d 6b 65 79 20 28 20 72 65 76 61 64 64 72 20 75  -key ( revaddr u
7910: 31 20 6b 65 79 61 64 64 72 20 75 32 20 2d 2d 20  1 keyaddr u2 -- 
7920: 6f 20 29 0a 20 20 20 20 63 75 72 72 65 6e 74 2d  o ).    current-
7930: 6b 65 79 20 3e 6f 20 72 65 70 6c 61 63 65 2d 6b  key >o replace-k
7940: 65 79 20 6f 3e 0a 20 20 20 20 3e 6f 20 73 6b 63  ey o>.    >o skc
7950: 20 6b 65 79 73 69 7a 65 20 6b 65 2d 73 6b 20 73   keysize ke-sk s
7960: 65 63 21 20 6f 20 6f 3e 20 3b 0a 0a 5c 20 67 65  ec! o o> ;..\ ge
7970: 6e 65 72 61 74 65 20 6e 65 77 20 6b 65 79 0a 0a  nerate new key..
7980: 3a 20 6f 75 74 2d 6b 65 79 20 28 20 6f 20 2d 2d  : out-key ( o --
7990: 20 29 0a 20 20 20 20 3e 6f 20 70 61 63 6b 2d 6f   ).    >o pack-o
79a0: 75 74 6b 65 79 20 5b 27 5d 20 2e 6e 69 63 6b 2d  utkey ['] .nick-
79b0: 62 61 73 65 20 24 74 6d 70 20 66 6e 2d 73 61 6e  base $tmp fn-san
79c0: 69 74 69 7a 65 20 6f 3e 0a 20 20 20 20 5b 3a 20  itize o>.    [: 
79d0: 2e 22 20 7e 2f 22 20 74 79 70 65 20 2e 22 20 2e  ." ~/" type ." .
79e0: 6e 32 6f 22 20 3b 5d 20 24 74 6d 70 20 77 2f 6f  n2o" ;] $tmp w/o
79f0: 20 63 72 65 61 74 65 2d 66 69 6c 65 20 74 68 72   create-file thr
7a00: 6f 77 0a 20 20 20 20 3e 72 20 63 6d 64 62 75 66  ow.    >r cmdbuf
7a10: 24 20 72 40 20 77 72 69 74 65 2d 66 69 6c 65 20  $ r@ write-file 
7a20: 74 68 72 6f 77 20 72 3e 20 63 6c 6f 73 65 2d 66  throw r> close-f
7a30: 69 6c 65 20 74 68 72 6f 77 20 3b 0a 3a 20 6f 75  ile throw ;.: ou
7a40: 74 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 20 20 20  t-me ( -- ).    
7a50: 70 6b 40 20 6b 65 79 7c 20 6b 65 79 23 20 23 40  pk@ key| key# #@
7a60: 20 30 3d 20 21 21 75 6e 6b 6e 6f 77 6e 2d 6b 65   0= !!unknown-ke
7a70: 79 21 21 20 5c 20 77 65 6c 6c 2c 20 79 6f 75 20  y!! \ well, you 
7a80: 73 68 6f 75 6c 64 20 6b 6e 6f 77 20 79 6f 75 72  should know your
7a90: 73 65 6c 66 0a 20 20 20 20 63 65 6c 6c 2b 20 6f  self.    cell+ o
7aa0: 75 74 2d 6b 65 79 20 3b 0a 0a 56 61 72 69 61 62  ut-key ;..Variab
7ab0: 6c 65 20 64 68 74 72 6f 6f 74 2e 6e 32 6f 0a 0a  le dhtroot.n2o..
7ac0: 3a 20 2b 64 68 74 72 6f 6f 74 20 28 20 2d 2d 20  : +dhtroot ( -- 
7ad0: 29 0a 20 20 20 20 64 65 66 61 75 6c 74 6b 65 79  ).    defaultkey
7ae0: 20 40 20 3e 73 74 6f 72 65 6b 65 79 20 21 0a 20   @ >storekey !. 
7af0: 20 20 20 69 6d 70 6f 72 74 23 6d 61 6e 75 61 6c     import#manual
7b00: 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 20   import-type !  
7b10: 36 34 23 2d 31 20 6b 65 79 2d 72 65 61 64 2d 6f  64#-1 key-read-o
7b20: 66 66 73 65 74 20 36 34 21 0a 20 20 20 20 64 68  ffset 64!.    dh
7b30: 74 72 6f 6f 74 2e 6e 32 6f 20 24 40 20 64 6f 2d  troot.n2o $@ do-
7b40: 6b 65 79 0a 20 20 20 20 6c 61 73 74 2d 6b 65 79  key.    last-key
7b50: 20 3e 6f 20 22 5c 78 30 32 22 20 6b 65 2d 67 72   >o "\x02" ke-gr
7b60: 6f 75 70 73 20 24 21 20 70 65 72 6d 25 64 68 74  oups $! perm%dht
7b70: 72 6f 6f 74 20 6b 65 2d 6d 61 73 6b 20 21 20 6f  root ke-mask ! o
7b80: 3e 0a 20 20 20 20 69 6d 70 6f 72 74 23 6e 65 77  >.    import#new
7b90: 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 3b   import-type ! ;
7ba0: 0a 0a 3a 20 6e 65 77 2d 6b 65 79 20 28 20 6e 69  ..: new-key ( ni
7bb0: 63 6b 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20  ckaddr u -- ).  
7bc0: 20 20 3f 63 68 65 63 6b 2d 72 6e 67 20 5c 20 62    ?check-rng \ b
7bd0: 65 66 6f 72 65 20 67 65 6e 65 72 61 74 69 6e 67  efore generating
7be0: 20 61 20 6b 65 79 2c 20 63 68 65 63 6b 20 74 68   a key, check th
7bf0: 65 20 72 6e 67 20 66 6f 72 20 68 65 61 6c 74 68  e rng for health
7c00: 0a 20 20 20 20 2b 6e 65 77 70 68 72 61 73 65 20  .    +newphrase 
7c10: 6b 65 79 3e 64 65 66 61 75 6c 74 0a 20 20 20 20  key>default.    
7c20: 6b 65 79 23 75 73 65 72 20 2b 67 65 6e 2d 6b 65  key#user +gen-ke
7c30: 79 73 0a 20 20 20 20 73 65 63 72 65 74 2d 6b 65  ys.    secret-ke
7c40: 79 73 23 20 31 2d 20 73 65 63 72 65 74 2d 6b 65  ys# 1- secret-ke
7c50: 79 20 3e 72 61 77 2d 6b 65 79 20 20 6c 61 73 74  y >raw-key  last
7c60: 6b 65 79 40 20 64 72 6f 70 20 64 65 66 61 75 6c  key@ drop defaul
7c70: 74 6b 65 79 20 21 0a 20 20 20 20 6f 75 74 2d 6d  tkey !.    out-m
7c80: 65 20 2b 64 68 74 72 6f 6f 74 20 73 61 76 65 2d  e +dhtroot save-
7c90: 6b 65 79 73 20 3b 0a 0a 5c 20 72 65 76 6f 6b 61  keys ;..\ revoka
7ca0: 74 69 6f 6e 0a 0a 34 20 64 61 74 65 73 69 7a 65  tion..4 datesize
7cb0: 23 20 2b 20 6b 65 79 73 69 7a 65 20 39 20 2a 20  # + keysize 9 * 
7cc0: 2b 20 43 6f 6e 73 74 61 6e 74 20 72 65 76 73 69  + Constant revsi
7cd0: 7a 65 23 0a 0a 56 61 72 69 61 62 6c 65 20 72 65  ze#..Variable re
7ce0: 76 74 6f 6b 65 6e 0a 0a 3a 20 30 6f 6c 64 6b 65  vtoken..: 0oldke
7cf0: 79 20 28 20 2d 2d 20 29 20 5c 20 70 75 62 6b 65  y ( -- ) \ pubke
7d00: 79 73 20 63 61 6e 20 73 74 61 79 0a 20 20 20 20  ys can stay.    
7d10: 6f 6c 64 73 6b 63 20 6b 65 79 73 69 7a 65 20 65  oldskc keysize e
7d20: 72 61 73 65 20 20 6f 6c 64 73 6b 72 65 76 20 6b  rase  oldskrev k
7d30: 65 79 73 69 7a 65 20 65 72 61 73 65 20 3b 0a 0a  eysize erase ;..
7d40: 3a 20 6b 65 79 6d 6f 76 65 20 28 20 61 64 64 72  : keymove ( addr
7d50: 31 20 61 64 64 72 32 20 2d 2d 20 29 20 20 6b 65  1 addr2 -- )  ke
7d60: 79 73 69 7a 65 20 6d 6f 76 65 20 3b 0a 0a 3a 20  ysize move ;..: 
7d70: 72 65 76 6f 6b 65 2d 76 65 72 69 66 79 20 28 20  revoke-verify ( 
7d80: 61 64 64 72 20 75 31 20 70 6b 20 73 74 72 69 6e  addr u1 pk strin
7d90: 67 20 75 32 20 2d 2d 20 61 64 64 72 20 75 20 66  g u2 -- addr u f
7da0: 6c 61 67 20 29 20 72 6f 74 20 3e 72 20 32 3e 72  lag ) rot >r 2>r
7db0: 20 63 3a 30 6b 65 79 0a 20 20 20 20 73 69 67 6f   c:0key.    sigo
7dc0: 6e 6c 79 73 69 7a 65 23 20 2d 20 32 64 75 70 20  nlysize# - 2dup 
7dd0: 32 72 3e 20 3e 6b 65 79 65 64 2d 68 61 73 68 0a  2r> >keyed-hash.
7de0: 20 20 20 20 73 69 67 64 61 74 65 20 2b 64 61 74      sigdate +dat
7df0: 65 0a 20 20 20 20 32 64 75 70 20 2b 20 72 3e 20  e.    2dup + r> 
7e00: 65 64 2d 76 65 72 69 66 79 20 3b 0a 0a 3a 20 3e  ed-verify ;..: >
7e10: 72 65 76 6f 6b 65 20 28 20 73 6b 72 65 76 20 2d  revoke ( skrev -
7e20: 2d 20 29 20 20 73 6b 72 65 76 20 6b 65 79 6d 6f  - )  skrev keymo
7e30: 76 65 20 20 70 6b 63 20 63 68 65 63 6b 2d 72 65  ve  pkc check-re
7e40: 76 3f 20 30 3d 20 21 21 6e 6f 74 2d 6d 79 2d 72  v? 0= !!not-my-r
7e50: 65 76 73 6b 21 21 20 3b 0a 0a 3a 20 2b 72 65 76  evsk!! ;..: +rev
7e60: 73 69 67 6e 20 28 20 73 6b 20 70 6b 20 2d 2d 20  sign ( sk pk -- 
7e70: 29 20 20 73 6b 73 69 67 20 2d 72 6f 74 20 65 64  )  sksig -rot ed
7e80: 2d 73 69 67 6e 20 72 65 76 74 6f 6b 65 6e 20 24  -sign revtoken $
7e90: 2b 21 20 62 6c 20 72 65 76 74 6f 6b 65 6e 20 63  +! bl revtoken c
7ea0: 24 2b 21 20 3b 0a 0a 3a 20 73 69 67 6e 2d 74 6f  $+! ;..: sign-to
7eb0: 6b 65 6e 2c 20 28 20 73 6b 20 70 6b 20 73 74 72  ken, ( sk pk str
7ec0: 69 6e 67 20 75 32 20 2d 2d 20 29 0a 20 20 20 20  ing u2 -- ).    
7ed0: 63 3a 30 6b 65 79 20 72 65 76 74 6f 6b 65 6e 20  c:0key revtoken 
7ee0: 24 40 20 32 73 77 61 70 20 3e 6b 65 79 65 64 2d  $@ 2swap >keyed-
7ef0: 68 61 73 68 0a 20 20 20 20 73 69 67 64 61 74 65  hash.    sigdate
7f00: 20 2b 64 61 74 65 20 2b 72 65 76 73 69 67 6e 20   +date +revsign 
7f10: 3b 0a 0a 3a 20 72 65 76 6f 6b 65 2d 6b 65 79 20  ;..: revoke-key 
7f20: 28 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20  ( -- addr u ).  
7f30: 20 20 73 6b 63 20 6f 6c 64 73 6b 63 20 6b 65 79    skc oldskc key
7f40: 6d 6f 76 65 20 20 70 6b 63 20 6f 6c 64 70 6b 63  move  pkc oldpkc
7f50: 20 6b 65 79 6d 6f 76 65 20 20 73 6b 72 65 76 20   keymove  skrev 
7f60: 6f 6c 64 73 6b 72 65 76 20 6b 65 79 6d 6f 76 65  oldskrev keymove
7f70: 0a 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 20 20 20 5c 20 62 61              \ ba
7fa0: 63 6b 75 70 20 6b 65 79 73 0a 20 20 20 20 6f 6c  ckup keys.    ol
7fb0: 64 73 6b 72 65 76 20 6f 6c 64 70 6b 72 65 76 20  dskrev oldpkrev 
7fc0: 73 6b 3e 70 6b 20 20 20 20 20 20 20 20 20 20 20  sk>pk           
7fd0: 20 20 20 20 20 5c 20 67 65 6e 65 72 61 74 65 20       \ generate 
7fe0: 72 65 76 6f 6b 61 74 69 6f 6e 20 70 75 62 6b 65  revokation pubke
7ff0: 79 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 20 20  y.    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 20 20 20 5c 20 67               \ g
8020: 65 6e 65 72 61 74 65 20 6e 65 77 20 6b 65 79 73  enerate new keys
8030: 0a 20 20 20 20 70 6b 63 20 6b 65 79 73 69 7a 65  .    pkc keysize
8040: 32 20 72 65 76 74 6f 6b 65 6e 20 24 21 20 20 20  2 revtoken $!   
8050: 20 20 20 20 20 20 20 20 20 20 20 20 5c 20 6d 79              \ my
8060: 20 6e 65 77 20 6b 65 79 0a 20 20 20 20 6f 6c 64   new key.    old
8070: 70 6b 72 65 76 20 6b 65 79 73 69 7a 65 20 72 65  pkrev keysize re
8080: 76 74 6f 6b 65 6e 20 24 2b 21 20 20 20 20 20 20  vtoken $+!      
8090: 20 20 20 20 5c 20 72 65 76 6f 6b 65 20 74 6f 6b      \ revoke tok
80a0: 65 6e 0a 20 20 20 20 6f 6c 64 73 6b 72 65 76 20  en.    oldskrev 
80b0: 6f 6c 64 70 6b 72 65 76 20 22 72 65 76 6f 6b 65  oldpkrev "revoke
80c0: 22 20 73 69 67 6e 2d 74 6f 6b 65 6e 2c 20 5c 20  " sign-token, \ 
80d0: 72 65 76 6f 6b 65 20 73 69 67 6e 61 74 75 72 65  revoke signature
80e0: 0a 20 20 20 20 73 6b 63 20 70 6b 63 20 22 73 65  .    skc pkc "se
80f0: 6c 66 73 69 67 6e 22 20 73 69 67 6e 2d 74 6f 6b  lfsign" sign-tok
8100: 65 6e 2c 20 20 20 20 20 20 20 20 20 5c 20 73 65  en,         \ se
8110: 6c 66 20 73 69 67 6e 65 64 20 77 69 74 68 20 6e  lf signed with n
8120: 65 77 20 6b 65 79 0a 20 20 20 20 22 21 22 20 72  ew key.    "!" r
8130: 65 76 74 6f 6b 65 6e 20 30 20 24 69 6e 73 20 20  evtoken 0 $ins  
8140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
8150: 20 20 5c 20 22 21 22 20 2b 20 6f 6c 64 6b 65 79    \ "!" + oldkey
8160: 6c 65 6e 2b 6e 65 77 6b 65 79 6c 65 6e 20 74 6f  len+newkeylen to
8170: 20 66 6c 61 67 20 72 65 76 6f 6b 61 74 69 6f 6e   flag revokation
8180: 0a 20 20 20 20 72 65 76 74 6f 6b 65 6e 20 24 40  .    revtoken $@
8190: 20 67 65 6e 3e 68 6f 73 74 20 32 64 72 6f 70 20   gen>host 2drop 
81a0: 20 20 20 20 20 20 20 20 20 20 20 20 5c 20 73 69              \ si
81b0: 67 6e 20 68 6f 73 74 20 69 6e 66 6f 72 6d 61 74  gn host informat
81c0: 69 6f 6e 20 77 69 74 68 20 6f 6c 64 20 6b 65 79  ion with old key
81d0: 0a 20 20 20 20 73 69 67 64 61 74 65 20 2b 64 61  .    sigdate +da
81e0: 74 65 20 73 69 67 64 61 74 65 20 64 61 74 65 73  te sigdate dates
81f0: 69 7a 65 23 20 72 65 76 74 6f 6b 65 6e 20 24 2b  ize# revtoken $+
8200: 21 0a 20 20 20 20 6f 6c 64 73 6b 63 20 6f 6c 64  !.    oldskc old
8210: 70 6b 63 20 2b 72 65 76 73 69 67 6e 0a 20 20 20  pkc +revsign.   
8220: 20 30 6f 6c 64 6b 65 79 20 72 65 76 74 6f 6b 65   0oldkey revtoke
8230: 6e 20 24 40 20 3b 0a 0a 5c 20 69 6e 76 69 74 61  n $@ ;..\ invita
8240: 74 69 6f 6e 0a 0a 56 61 72 69 61 62 6c 65 20 69  tion..Variable i
8250: 6e 76 69 74 61 74 69 6f 6e 73 0a 0a 65 76 65 6e  nvitations..even
8260: 74 3a 20 3a 3e 69 6e 76 69 74 65 20 28 20 61 64  t: :>invite ( ad
8270: 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 2e 22  dr u -- ).    ."
8280: 20 69 6e 76 69 74 65 20 6d 65 3a 20 22 20 6f 76   invite me: " ov
8290: 65 72 20 3e 72 20 2e 70 6b 32 6b 65 79 24 20 63  er >r .pk2key$ c
82a0: 72 20 72 3e 20 66 72 65 65 20 74 68 72 6f 77 20  r r> free throw 
82b0: 63 74 72 6c 20 4c 20 69 6e 73 6b 65 79 20 3b 0a  ctrl L inskey ;.
82c0: 65 76 65 6e 74 3a 20 3a 3e 77 61 6b 65 6d 65 20  event: :>wakeme 
82d0: 28 20 6f 20 2d 2d 20 29 20 72 65 73 74 61 72 74  ( o -- ) restart
82e0: 20 3b 0a 0a 3a 20 70 6b 32 6b 65 79 24 2d 61 64   ;..: pk2key$-ad
82f0: 64 20 28 20 61 64 64 72 20 75 20 70 65 72 6d 20  d ( addr u perm 
8300: 2d 2d 20 29 20 7b 20 70 65 72 6d 20 7d 0a 20 20  -- ) { perm }.  
8310: 20 20 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20    sample-key >o 
8320: 69 6d 70 6f 72 74 23 69 6e 76 69 74 65 64 20 69  import#invited i
8330: 6d 70 6f 72 74 2d 74 79 70 65 20 21 20 63 6d 64  mport-type ! cmd
8340: 3a 6e 65 73 74 73 69 67 0a 20 20 20 20 70 65 72  :nestsig.    per
8350: 6d 20 6b 65 2d 6d 61 73 6b 20 21 0a 20 20 20 20  m ke-mask !.    
8360: 69 6d 70 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72  import#new impor
8370: 74 2d 74 79 70 65 20 21 20 20 73 61 76 65 2d 70  t-type !  save-p
8380: 75 62 6b 65 79 73 20 6f 3e 20 3b 0a 0a 3a 20 78  ubkeys o> ;..: x
8390: 2d 65 72 61 73 65 20 28 20 6c 65 6e 20 2d 2d 20  -erase ( len -- 
83a0: 29 0a 20 20 20 20 64 75 70 20 78 62 61 63 6b 2d  ).    dup xback-
83b0: 72 65 73 74 6f 72 65 20 20 64 75 70 20 73 70 61  restore  dup spa
83c0: 63 65 73 20 20 78 62 61 63 6b 2d 72 65 73 74 6f  ces  xback-resto
83d0: 72 65 20 3b 0a 0a 3a 20 69 6e 76 69 74 65 2d 6b  re ;..: invite-k
83e0: 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 6b  ey ( addr u -- k
83f0: 65 79 20 29 0a 20 20 20 20 32 64 75 70 20 78 2d  ey ).    2dup x-
8400: 77 69 64 74 68 20 7b 20 61 64 64 72 20 75 20 6c  width { addr u l
8410: 65 6e 20 7d 0a 20 20 20 20 42 45 47 49 4e 20 20  en }.    BEGIN  
8420: 61 64 64 72 20 75 20 74 79 70 65 20 6b 65 79 20  addr u type key 
8430: 20 6c 65 6e 20 78 2d 65 72 61 73 65 0a 09 64 75   len x-erase..du
8440: 70 20 63 74 72 6c 20 5a 20 3d 0a 20 20 20 20 57  p ctrl Z =.    W
8450: 48 49 4c 45 20 20 64 72 6f 70 20 20 42 45 47 49  HILE  drop  BEGI
8460: 4e 20 20 6b 65 79 20 63 74 72 6c 20 4c 20 3d 20  N  key ctrl L = 
8470: 20 55 4e 54 49 4c 20 20 52 45 50 45 41 54 20 3b   UNTIL  REPEAT ;
8480: 0a 0a 3a 20 70 72 6f 63 65 73 73 2d 69 6e 76 69  ..: process-invi
8490: 74 61 74 69 6f 6e 20 28 20 61 64 64 72 20 75 20  tation ( addr u 
84a0: 2d 2d 20 29 0a 20 20 20 20 73 22 20 69 6e 76 69  -- ).    s" invi
84b0: 74 65 20 28 79 2f 6e 2f 62 29 3f 22 20 69 6e 76  te (y/n/b)?" inv
84c0: 69 74 65 2d 6b 65 79 0a 20 20 20 20 63 61 73 65  ite-key.    case
84d0: 0a 09 27 79 27 20 6f 66 20 20 70 65 72 6d 25 64  ..'y' of  perm%d
84e0: 65 66 61 75 6c 74 20 70 6b 32 6b 65 79 24 2d 61  efault pk2key$-a
84f0: 64 64 20 20 2e 22 20 61 64 64 65 64 22 20 63 72  dd  ." added" cr
8500: 20 20 20 65 6e 64 6f 66 0a 09 27 62 27 20 6f 66     endof..'b' of
8510: 20 20 70 65 72 6d 25 62 6c 6f 63 6b 65 64 20 70    perm%blocked p
8520: 6b 32 6b 65 79 24 2d 61 64 64 20 20 2e 22 20 62  k2key$-add  ." b
8530: 6c 6f 63 6b 65 64 22 20 63 72 20 65 6e 64 6f 66  locked" cr endof
8540: 0a 09 32 64 72 6f 70 20 2e 22 20 69 67 6e 6f 72  ..2drop ." ignor
8550: 65 64 22 20 63 72 0a 20 20 20 20 65 6e 64 63 61  ed" cr.    endca
8560: 73 65 20 3b 0a 0a 3a 20 61 64 64 2d 69 6e 76 69  se ;..: add-invi
8570: 74 61 74 69 6f 6e 20 28 20 61 64 64 72 20 75 20  tation ( addr u 
8580: 2d 2d 20 29 20 5c 20 61 64 64 20 69 6e 76 69 74  -- ) \ add invit
8590: 61 74 69 6f 6e 20 77 69 74 68 6f 75 74 20 61 73  ation without as
85a0: 6b 69 6e 67 0a 20 20 20 20 70 65 72 6d 25 64 65  king.    perm%de
85b0: 66 61 75 6c 74 20 70 6b 32 6b 65 79 24 2d 61 64  fault pk2key$-ad
85c0: 64 20 3b 0a 0a 3a 20 66 69 6c 74 65 72 2d 69 6e  d ;..: filter-in
85d0: 76 69 74 61 74 69 6f 6e 3f 20 28 20 61 64 64 72  vitation? ( addr
85e0: 20 75 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20   u -- flag ).   
85f0: 20 73 69 67 70 6b 32 73 69 7a 65 23 20 2d 20 2b   sigpk2size# - +
8600: 20 6b 65 79 73 69 7a 65 20 6b 65 79 23 20 23 40   keysize key# #@
8610: 20 64 30 3c 3e 20 3b 20 5c 20 61 6c 72 65 61 64   d0<> ; \ alread
8620: 79 20 74 68 65 72 65 0a 0a 3a 20 2e 69 6e 76 69  y there..: .invi
8630: 74 61 74 69 6f 6e 73 20 28 20 2d 2d 20 29 0a 20  tations ( -- ). 
8640: 20 20 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 5b     invitations [
8650: 3a 20 32 64 75 70 20 2e 70 6b 32 6b 65 79 24 20  : 2dup .pk2key$ 
8660: 63 72 20 70 72 6f 63 65 73 73 2d 69 6e 76 69 74  cr process-invit
8670: 61 74 69 6f 6e 20 3b 5d 20 24 5b 5d 6d 61 70 0a  ation ;] $[]map.
8680: 20 20 20 20 69 6e 76 69 74 61 74 69 6f 6e 73 20      invitations 
8690: 24 5b 5d 6f 66 66 20 3b 0a 0a 3a 20 71 75 65 75  $[]off ;..: queu
86a0: 65 2d 69 6e 76 69 74 61 74 69 6f 6e 20 28 20 61  e-invitation ( a
86b0: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 69  ddr u -- ).    i
86c0: 6e 76 69 74 61 74 69 6f 6e 73 20 24 5b 5d 23 20  nvitations $[]# 
86d0: 3e 72 0a 20 20 20 20 32 64 75 70 20 69 6e 76 69  >r.    2dup invi
86e0: 74 61 74 69 6f 6e 73 20 24 69 6e 73 5b 5d 73 69  tations $ins[]si
86f0: 67 20 64 72 6f 70 0a 20 20 20 20 69 6e 76 69 74  g drop.    invit
8700: 61 74 69 6f 6e 73 20 24 5b 5d 23 20 72 3e 20 3c  ations $[]# r> <
8710: 3e 20 49 46 0a 09 73 61 76 65 2d 6d 65 6d 20 6d  > IF..save-mem m
8720: 61 69 6e 2d 75 70 40 20 3c 68 69 64 65 3e 0a 09  ain-up@ <hide>..
8730: 3c 65 76 65 6e 74 20 65 24 2c 20 3a 3e 69 6e 76  <event e$, :>inv
8740: 69 74 65 20 75 70 40 20 65 6c 69 74 2c 20 3a 3e  ite up@ elit, :>
8750: 77 61 6b 65 6d 65 20 6d 61 69 6e 2d 75 70 40 20  wakeme main-up@ 
8760: 65 76 65 6e 74 3e 20 73 74 6f 70 0a 20 20 20 20  event> stop.    
8770: 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 45  ELSE  2drop  THE
8780: 4e 20 3b 0a 0a 66 6f 72 77 61 72 64 20 2e 73 69  N ;..forward .si
8790: 67 71 72 0a 65 76 65 6e 74 3a 20 3a 3e 73 68 6f  gqr.event: :>sho
87a0: 77 2d 6b 65 79 73 69 67 20 28 20 61 64 64 72 20  w-keysig ( addr 
87b0: 75 20 2d 2d 20 29 20 2e 73 69 67 71 72 20 3b 0a  u -- ) .sigqr ;.
87c0: 0a 3a 20 3e 69 6e 76 69 74 61 74 69 6f 6e 73 20  .: >invitations 
87d0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20  ( addr u -- ).  
87e0: 20 20 71 72 2d 63 72 79 70 74 3f 20 49 46 0a 09    qr-crypt? IF..
87f0: 6d 73 67 28 20 2e 22 20 51 52 20 69 6e 76 69 74  msg( ." QR invit
8800: 61 74 69 6f 6e 20 77 69 74 68 20 73 69 67 6e 61  ation with signa
8810: 74 75 72 65 22 20 66 6f 72 74 68 3a 63 72 20 29  ture" forth:cr )
8820: 0a 09 32 64 75 70 20 66 69 6c 74 65 72 2d 69 6e  ..2dup filter-in
8830: 76 69 74 61 74 69 6f 6e 3f 20 30 3d 20 49 46 20  vitation? 0= IF 
8840: 20 32 64 75 70 20 61 64 64 2d 69 6e 76 69 74 61   2dup add-invita
8850: 74 69 6f 6e 20 20 54 48 45 4e 0a 09 3c 65 76 65  tion  THEN..<eve
8860: 6e 74 20 65 24 2c 20 3a 3e 73 68 6f 77 2d 6b 65  nt e$, :>show-ke
8870: 79 73 69 67 20 6d 61 69 6e 2d 75 70 40 20 65 76  ysig main-up@ ev
8880: 65 6e 74 3e 0a 20 20 20 20 45 4c 53 45 0a 09 32  ent>.    ELSE..2
8890: 64 75 70 20 66 69 6c 74 65 72 2d 69 6e 76 69 74  dup filter-invit
88a0: 61 74 69 6f 6e 3f 20 49 46 20 20 32 64 72 6f 70  ation? IF  2drop
88b0: 20 45 58 49 54 20 20 54 48 45 4e 0a 09 6d 73 67   EXIT  THEN..msg
88c0: 28 20 2e 22 20 71 75 65 75 65 20 69 6e 76 69 74  ( ." queue invit
88d0: 61 74 69 6f 6e 22 20 66 6f 72 74 68 3a 63 72 20  ation" forth:cr 
88e0: 29 0a 09 71 75 65 75 65 2d 69 6e 76 69 74 61 74  )..queue-invitat
88f0: 69 6f 6e 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a  ion.    THEN ;..
8900: 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73 65 0a  also net2o-base.
8910: 0a 3a 20 69 6e 76 69 74 65 2d 6d 65 20 28 20 2d  .: invite-me ( -
8920: 2d 20 29 0a 20 20 20 20 5b 3a 20 6e 65 73 74 5b  - ).    [: nest[
8930: 20 6d 79 70 6b 32 6e 69 63 6b 24 20 24 2c 20 69   mypk2nick$ $, i
8940: 6e 76 69 74 65 20 63 6f 6f 6b 69 65 2b 72 65 71  nvite cookie+req
8950: 75 65 73 74 20 5d 74 6d 70 6e 65 73 74 0a 20 20  uest ]tmpnest.  
8960: 20 20 20 20 65 6e 64 2d 63 6d 64 20 3b 5d 20 69      end-cmd ;] i
8970: 73 20 65 78 70 65 63 74 2d 72 65 70 6c 79 3f 20  s expect-reply? 
8980: 3b 0a 3a 20 71 72 2d 69 6e 76 69 74 65 2d 6d 65  ;.: qr-invite-me
8990: 20 28 20 2d 2d 20 29 0a 20 20 20 20 5b 3a 20 6e   ( -- ).    [: n
89a0: 65 73 74 5b 20 6d 79 70 6b 32 6e 69 63 6b 24 20  est[ mypk2nick$ 
89b0: 24 2c 20 69 6e 76 69 74 65 20 63 6f 6f 6b 69 65  $, invite cookie
89c0: 2b 72 65 71 75 65 73 74 20 5d 74 6d 70 6e 65 73  +request ]tmpnes
89d0: 74 0a 20 20 20 20 20 20 65 6e 64 2d 63 6d 64 20  t.      end-cmd 
89e0: 3b 5d 20 69 73 20 65 78 70 65 63 74 2d 72 65 70  ;] is expect-rep
89f0: 6c 79 3f 20 3b 0a 3a 20 73 65 6e 64 2d 69 6e 76  ly? ;.: send-inv
8a00: 69 74 61 74 69 6f 6e 20 28 20 2d 2d 20 29 20 0a  itation ( -- ) .
8a10: 20 20 20 20 73 65 74 75 70 21 20 20 2b 72 65 73      setup!  +res
8a20: 65 6e 64 2d 63 6d 64 20 20 67 65 6e 2d 74 6d 70  end-cmd  gen-tmp
8a30: 6b 65 79 73 0a 20 20 20 20 5b 3a 20 63 6f 6e 6e  keys.    [: conn
8a40: 65 63 74 2d 72 65 73 74 20 64 65 73 74 2d 30 6b  ect-rest dest-0k
8a50: 65 79 20 40 20 69 6e 73 2d 30 6b 65 79 20 3b 5d  ey @ ins-0key ;]
8a60: 20 72 71 64 3f 0a 20 20 20 20 63 6d 64 28 20 69   rqd?.    cmd( i
8a70: 6e 64 2d 61 64 64 72 20 40 20 49 46 20 20 2e 22  nd-addr @ IF  ."
8a80: 20 69 6e 22 20 54 48 45 4e 20 2e 22 20 64 69 72   in" THEN ." dir
8a90: 65 63 74 20 63 6f 6e 6e 65 63 74 22 20 66 6f 72  ect connect" for
8aa0: 74 68 3a 63 72 20 29 0a 20 20 20 20 69 76 73 28  th:cr ).    ivs(
8ab0: 20 2e 22 20 67 65 6e 20 72 65 71 75 65 73 74 22   ." gen request"
8ac0: 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 20   forth:cr ).    
8ad0: 6e 65 74 32 6f 2d 63 6f 64 65 30 0a 20 20 20 20  net2o-code0.    
8ae0: 6e 65 74 32 6f 2d 76 65 72 73 69 6f 6e 20 24 2c  net2o-version $,
8af0: 20 67 65 74 2d 76 65 72 73 69 6f 6e 0a 20 20 20   get-version.   
8b00: 20 6e 65 73 74 5b 20 63 6f 6f 6b 69 65 2c 20 5d   nest[ cookie, ]
8b10: 6e 65 73 74 0a 20 20 20 20 74 70 6b 63 20 6b 65  nest.    tpkc ke
8b20: 79 73 69 7a 65 20 24 2c 20 72 65 63 65 69 76 65  ysize $, receive
8b30: 2d 74 6d 70 6b 65 79 0a 20 20 20 20 74 6d 70 6b  -tmpkey.    tmpk
8b40: 65 79 2d 72 65 71 75 65 73 74 20 74 6d 70 2d 73  ey-request tmp-s
8b50: 65 63 72 65 74 2c 0a 20 20 20 20 6e 65 73 74 5b  ecret,.    nest[
8b60: 20 72 65 71 75 65 73 74 2d 69 6e 76 69 74 61 74   request-invitat
8b70: 69 6f 6e 20 72 65 71 75 65 73 74 2c 20 5d 6e 65  ion request, ]ne
8b80: 73 74 0a 20 20 20 20 27 5d 74 6d 70 6e 65 73 74  st.    ']tmpnest
8b90: 0a 20 20 20 20 5b 27 5d 20 70 75 73 68 2d 63 6d  .    ['] push-cm
8ba0: 64 20 49 53 20 65 78 70 65 63 74 2d 72 65 70 6c  d IS expect-repl
8bb0: 79 3f 0a 20 20 20 20 65 6e 64 2d 63 6f 64 65 7c  y?.    end-code|
8bc0: 0a 20 20 20 20 6e 32 6f 3a 64 69 73 70 6f 73 65  .    n2o:dispose
8bd0: 2d 63 6f 6e 74 65 78 74 20 3b 0a 3a 20 73 65 6e  -context ;.: sen
8be0: 64 2d 71 72 2d 69 6e 76 69 74 61 74 69 6f 6e 20  d-qr-invitation 
8bf0: 28 20 2d 2d 20 29 0a 20 20 20 20 73 65 74 75 70  ( -- ).    setup
8c00: 21 20 20 2b 72 65 73 65 6e 64 2d 63 6d 64 20 20  !  +resend-cmd  
8c10: 67 65 6e 2d 74 6d 70 6b 65 79 73 0a 20 20 20 20  gen-tmpkeys.    
8c20: 5b 3a 20 63 6f 6e 6e 65 63 74 2d 72 65 73 74 20  [: connect-rest 
8c30: 64 65 73 74 2d 30 6b 65 79 20 40 20 69 6e 73 2d  dest-0key @ ins-
8c40: 30 6b 65 79 20 3b 5d 20 72 71 64 3f 0a 20 20 20  0key ;] rqd?.   
8c50: 20 63 6d 64 28 20 69 6e 64 2d 61 64 64 72 20 40   cmd( ind-addr @
8c60: 20 49 46 20 20 2e 22 20 69 6e 22 20 54 48 45 4e   IF  ." in" THEN
8c70: 20 2e 22 20 64 69 72 65 63 74 20 63 6f 6e 6e 65   ." direct conne
8c80: 63 74 22 20 66 6f 72 74 68 3a 63 72 20 29 0a 20  ct" forth:cr ). 
8c90: 20 20 20 69 76 73 28 20 2e 22 20 67 65 6e 20 72     ivs( ." gen r
8ca0: 65 71 75 65 73 74 22 20 66 6f 72 74 68 3a 63 72  equest" forth:cr
8cb0: 20 29 0a 20 20 20 20 6e 65 74 32 6f 2d 63 6f 64   ).    net2o-cod
8cc0: 65 30 0a 20 20 20 20 6e 65 74 32 6f 2d 76 65 72  e0.    net2o-ver
8cd0: 73 69 6f 6e 20 24 2c 20 67 65 74 2d 76 65 72 73  sion $, get-vers
8ce0: 69 6f 6e 0a 20 20 20 20 6e 65 73 74 5b 20 63 6f  ion.    nest[ co
8cf0: 6f 6b 69 65 2c 20 72 65 71 75 65 73 74 2c 20 5d  okie, request, ]
8d00: 6e 65 73 74 0a 20 20 20 20 74 70 6b 63 20 6b 65  nest.    tpkc ke
8d10: 79 73 69 7a 65 20 24 2c 20 71 72 2d 74 6d 70 6b  ysize $, qr-tmpk
8d20: 65 79 0a 20 20 20 20 71 72 6b 65 79 2d 72 65 71  ey.    qrkey-req
8d30: 75 65 73 74 20 74 6d 70 2d 73 65 63 72 65 74 2c  uest tmp-secret,
8d40: 0a 20 20 20 20 6e 65 73 74 5b 20 72 65 71 75 65  .    nest[ reque
8d50: 73 74 2d 71 72 2d 69 6e 76 69 74 61 74 69 6f 6e  st-qr-invitation
8d60: 20 72 65 71 75 65 73 74 2c 20 5d 6e 65 73 74 0a   request, ]nest.
8d70: 20 20 20 20 27 5d 74 6d 70 6e 65 73 74 0a 20 20      ']tmpnest.  
8d80: 20 20 5b 27 5d 20 70 75 73 68 2d 63 6d 64 20 49    ['] push-cmd I
8d90: 53 20 65 78 70 65 63 74 2d 72 65 70 6c 79 3f 0a  S expect-reply?.
8da0: 20 20 20 20 65 6e 64 2d 63 6f 64 65 7c 0a 20 20      end-code|.  
8db0: 20 20 6e 32 6f 3a 64 69 73 70 6f 73 65 2d 63 6f    n2o:dispose-co
8dc0: 6e 74 65 78 74 20 3b 0a 70 72 65 76 69 6f 75 73  ntext ;.previous
8dd0: 0a 0a 5c 20 6b 65 79 20 61 70 69 20 68 65 6c 70  ..\ key api help
8de0: 65 72 73 0a 0a 3a 20 64 65 6c 2d 6c 61 73 74 2d  ers..: del-last-
8df0: 6b 65 79 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b  key ( -- ).    k
8e00: 65 79 73 20 24 5b 5d 23 20 31 2d 20 6b 65 79 73  eys $[]# 1- keys
8e10: 20 24 5b 5d 20 73 65 63 2d 6f 66 66 0a 20 20 20   $[] sec-off.   
8e20: 20 6b 65 79 73 20 24 40 6c 65 6e 20 63 65 6c 6c   keys $@len cell
8e30: 2d 20 6b 65 79 73 20 24 21 6c 65 6e 20 3b 0a 0a  - keys $!len ;..
8e40: 3a 20 73 74 6f 72 65 6b 65 79 21 20 28 20 2d 2d  : storekey! ( --
8e50: 20 29 0a 20 20 20 20 3e 73 65 63 6b 65 79 20 6b   ).    >seckey k
8e60: 65 79 73 20 24 5b 5d 23 20 30 20 3f 44 4f 20 20  eys $[]# 0 ?DO  
8e70: 32 64 75 70 20 49 20 6b 65 79 73 20 73 65 63 5b  2dup I keys sec[
8e80: 5d 40 20 73 74 72 3d 20 49 46 0a 09 20 20 20 20  ]@ str= IF..    
8e90: 49 20 6b 65 79 73 20 73 65 63 5b 5d 40 20 64 72  I keys sec[]@ dr
8ea0: 6f 70 20 3e 73 74 6f 72 65 6b 65 79 20 21 20 20  op >storekey !  
8eb0: 4c 45 41 56 45 20 20 54 48 45 4e 20 20 4c 4f 4f  LEAVE  THEN  LOO
8ec0: 50 20 20 32 64 72 6f 70 20 3b 0a 0a 3a 20 63 68  P  2drop ;..: ch
8ed0: 6f 6f 73 65 2d 6b 65 79 20 28 20 2d 2d 20 6f 20  oose-key ( -- o 
8ee0: 29 0a 20 20 20 20 30 20 42 45 47 49 4e 20 20 64  ).    0 BEGIN  d
8ef0: 72 6f 70 0a 09 2e 22 20 43 68 6f 6f 73 65 20 6b  rop..." Choose k
8f00: 65 79 20 62 79 20 6e 75 6d 62 65 72 3a 22 20 63  ey by number:" c
8f10: 72 20 2e 73 65 63 72 65 74 2d 6e 69 63 6b 73 0a  r .secret-nicks.
8f20: 09 42 45 47 49 4e 20 20 6b 65 79 20 64 75 70 20  .BEGIN  key dup 
8f30: 62 6c 20 3c 20 57 48 49 4c 45 20 20 64 72 6f 70  bl < WHILE  drop
8f40: 20 20 52 45 50 45 41 54 20 5c 20 73 77 61 6c 6c    REPEAT \ swall
8f50: 6f 77 20 63 6f 6e 74 72 6f 6c 20 6b 65 79 73 0a  ow control keys.
8f60: 09 5b 27 5d 20 64 69 67 69 74 3f 20 23 33 36 20  .['] digit? #36 
8f70: 62 61 73 65 2d 65 78 65 63 75 74 65 20 30 3d 20  base-execute 0= 
8f80: 49 46 20 2d 31 20 54 48 45 4e 0a 09 73 65 63 72  IF -1 THEN..secr
8f90: 65 74 2d 6b 65 79 20 64 75 70 20 30 3d 20 57 48  et-key dup 0= WH
8fa0: 49 4c 45 0a 09 20 20 20 20 2e 22 20 50 6c 65 61  ILE..    ." Plea
8fb0: 73 65 20 65 6e 74 65 72 20 61 20 62 61 73 65 2d  se enter a base-
8fc0: 33 36 20 6e 75 6d 62 65 72 20 62 65 74 77 65 65  36 number betwee
8fd0: 6e 20 30 20 61 6e 64 20 22 0a 09 20 20 20 20 73  n 0 and "..    s
8fe0: 65 63 72 65 74 2d 6b 65 79 73 23 20 31 2d 20 5b  ecret-keys# 1- [
8ff0: 27 5d 20 2e 20 23 33 36 20 62 61 73 65 2d 65 78  '] . #36 base-ex
9000: 65 63 75 74 65 20 63 72 20 20 72 64 72 6f 70 0a  ecute cr  rdrop.
9010: 20 20 20 20 52 45 50 45 41 54 0a 20 20 20 20 64      REPEAT.    d
9020: 75 70 20 2e 73 74 6f 72 65 6b 65 79 21 20 20 3e  up .storekey!  >
9030: 73 74 6f 72 65 6b 65 79 20 40 20 64 65 66 61 75  storekey @ defau
9040: 6c 74 6b 65 79 20 21 0a 20 20 20 20 2e 22 20 3d  ltkey !.    ." =
9050: 3d 3d 3d 20 6b 65 79 20 22 20 64 75 70 20 2e 2e  === key " dup ..
9060: 6e 69 63 6b 20 2e 22 20 20 63 68 6f 73 65 6e 20  nick ."  chosen 
9070: 3d 3d 3d 3d 22 20 63 72 20 3b 0a 0a 5c 20 77 69  ====" cr ;..\ wi
9080: 6c 6c 20 61 73 6b 20 66 6f 72 20 79 6f 75 72 20  ll ask for your 
9090: 70 61 73 73 77 6f 72 64 20 61 6e 64 20 69 66 20  password and if 
90a0: 70 6f 73 73 69 62 6c 65 20 61 75 74 6f 2d 73 65  possible auto-se
90b0: 6c 65 63 74 20 79 6f 75 72 20 69 64 0a 0a 56 61  lect your id..Va
90c0: 72 69 61 62 6c 65 20 74 72 69 65 73 23 0a 23 31  riable tries#.#1
90d0: 30 20 56 61 6c 75 65 20 6d 61 78 74 72 69 65 73  0 Value maxtries
90e0: 23 0a 0a 3a 20 67 65 74 2d 73 6b 63 20 28 20 2d  #..: get-skc ( -
90f0: 2d 20 29 0a 20 20 20 20 73 65 63 72 65 74 2d 6b  - ).    secret-k
9100: 65 79 73 23 20 3f 45 58 49 54 20 20 74 72 69 65  eys# ?EXIT  trie
9110: 73 23 20 6f 66 66 0a 20 20 20 20 64 65 62 75 67  s# off.    debug
9120: 2d 76 65 63 74 6f 72 20 40 20 6f 70 2d 76 65 63  -vector @ op-vec
9130: 74 6f 72 20 21 40 20 3e 72 20 3c 64 65 66 61 75  tor !@ >r <defau
9140: 6c 74 3e 0a 20 20 20 20 73 65 63 72 65 74 2d 6b  lt>.    secret-k
9150: 65 79 73 23 0a 20 20 20 20 42 45 47 49 4e 20 20  eys#.    BEGIN  
9160: 64 75 70 20 30 3d 20 74 72 69 65 73 23 20 40 20  dup 0= tries# @ 
9170: 6d 61 78 74 72 69 65 73 23 20 75 3c 20 61 6e 64  maxtries# u< and
9180: 20 20 57 48 49 4c 45 20 64 72 6f 70 0a 09 20 20    WHILE drop..  
9190: 20 20 73 22 20 50 61 73 73 70 68 72 61 73 65 3a    s" Passphrase:
91a0: 20 22 20 2b 70 61 73 73 70 68 72 61 73 65 20 20   " +passphrase  
91b0: 20 21 74 69 6d 65 0a 09 20 20 20 20 72 65 61 64   !time..    read
91c0: 2d 6b 65 79 73 20 73 65 63 72 65 74 2d 6b 65 79  -keys secret-key
91d0: 73 23 20 64 75 70 20 30 3d 20 49 46 0a 09 09 5c  s# dup 0= IF...\
91e0: 20 66 61 69 6c 20 72 69 67 68 74 20 61 66 74 65   fail right afte
91f0: 72 20 74 68 65 20 66 69 72 73 74 20 74 72 79 20  r the first try 
9200: 69 66 20 50 41 53 53 50 48 52 41 53 45 20 69 73  if PASSPHRASE is
9210: 20 75 73 65 64 0a 09 09 5c 20 61 6e 64 20 67 69   used...\ and gi
9220: 76 65 20 74 68 65 20 6d 61 78 69 6d 75 6d 20 77  ve the maximum w
9230: 61 69 74 69 6e 67 20 70 65 6e 61 6c 74 79 20 69  aiting penalty i
9240: 6e 20 74 68 61 74 20 63 61 73 65 0a 09 09 31 20  n that case...1 
9250: 6d 61 78 74 72 69 65 73 23 20 73 22 20 50 41 53  maxtries# s" PAS
9260: 53 50 48 52 41 53 45 22 20 67 65 74 65 6e 76 20  SPHRASE" getenv 
9270: 64 30 3d 20 73 65 6c 65 63 74 20 74 72 69 65 73  d0= select tries
9280: 23 20 2b 21 0a 09 09 3c 65 72 72 3e 20 2e 22 20  # +!...<err> ." 
9290: 54 72 79 23 20 22 20 74 72 69 65 73 23 20 40 20  Try# " tries# @ 
92a0: 30 20 2e 72 20 27 2f 27 20 65 6d 69 74 20 6d 61  0 .r '/' emit ma
92b0: 78 74 72 69 65 73 23 20 2e 0a 09 09 2e 22 20 66  xtries# ....." f
92c0: 61 69 6c 65 64 2c 20 6e 6f 20 6b 65 79 20 66 6f  ailed, no key fo
92d0: 75 6e 64 2c 20 77 61 69 74 69 6e 67 20 22 0a 09  und, waiting "..
92e0: 09 23 31 20 74 72 69 65 73 23 20 40 20 32 2a 20  .#1 tries# @ 2* 
92f0: 6c 73 68 69 66 74 20 64 75 70 20 2e 20 2e 22 20  lshift dup . ." 
9300: 6d 73 2e 2e 2e 22 20 6d 73 20 20 3c 64 65 66 61  ms..." ms  <defa
9310: 75 6c 74 3e 20 63 72 0a 09 09 64 65 6c 2d 6c 61  ult> cr...del-la
9320: 73 74 2d 6b 65 79 0a 09 20 20 20 20 54 48 45 4e  st-key..    THEN
9330: 0a 20 20 20 20 52 45 50 45 41 54 0a 20 20 20 20  .    REPEAT.    
9340: 64 75 70 20 30 3d 20 49 46 20 20 23 2d 35 36 20  dup 0= IF  #-56 
9350: 74 68 72 6f 77 20 20 54 48 45 4e 0a 20 20 20 20  throw  THEN.    
9360: 31 20 3d 20 49 46 20 20 30 20 73 65 63 72 65 74  1 = IF  0 secret
9370: 2d 6b 65 79 0a 09 2e 22 20 3d 3d 3d 3d 20 6f 70  -key..." ==== op
9380: 65 6e 65 64 3a 20 22 20 64 75 70 20 2e 2e 6e 69  ened: " dup ..ni
9390: 63 6b 20 2e 22 20 20 69 6e 20 22 20 2e 74 69 6d  ck ."  in " .tim
93a0: 65 20 2e 22 20 3d 3d 3d 3d 22 20 63 72 0a 20 20  e ." ====" cr.  
93b0: 20 20 45 4c 53 45 20 20 2e 22 20 3d 3d 3d 3d 20    ELSE  ." ==== 
93c0: 6f 70 65 6e 65 64 20 69 6e 20 22 20 2e 74 69 6d  opened in " .tim
93d0: 65 20 2e 22 20 3d 3d 3d 3d 22 20 63 72 20 63 68  e ." ====" cr ch
93e0: 6f 6f 73 65 2d 6b 65 79 20 20 54 48 45 4e 0a 20  oose-key  THEN. 
93f0: 20 20 20 3e 72 61 77 2d 6b 65 79 20 3f 72 73 6b     >raw-key ?rsk
9400: 20 20 20 72 3e 20 6f 70 2d 76 65 63 74 6f 72 20     r> op-vector 
9410: 21 20 3b 0a 0a 73 63 6f 70 65 3a 20 6e 32 6f 0a  ! ;..scope: n2o.
9420: 46 6f 72 77 61 72 64 20 68 65 6c 70 0a 7d 73 63  Forward help.}sc
9430: 6f 70 65 0a 0a 3a 20 67 65 74 2d 6d 79 2d 6b 65  ope..: get-my-ke
9440: 79 20 28 20 2d 2d 20 78 74 20 29 0a 20 20 20 20  y ( -- xt ).    
9450: 67 65 6e 2d 6b 65 79 73 2d 64 69 72 20 20 22 73  gen-keys-dir  "s
9460: 65 63 6b 65 79 73 2e 6b 32 6f 22 20 2e 6b 65 79  eckeys.k2o" .key
9470: 73 2f 20 32 64 75 70 20 66 69 6c 65 2d 73 74 61  s/ 2dup file-sta
9480: 74 75 73 20 6e 69 70 0a 20 20 20 20 30 3d 20 49  tus nip.    0= I
9490: 46 20 20 72 2f 6f 20 6f 70 65 6e 2d 66 69 6c 65  F  r/o open-file
94a0: 20 74 68 72 6f 77 20 3e 72 20 72 40 20 66 69 6c   throw >r r@ fil
94b0: 65 2d 73 69 7a 65 20 74 68 72 6f 77 20 64 30 3d  e-size throw d0=
94c0: 0a 09 72 3e 20 63 6c 6f 73 65 2d 66 69 6c 65 20  ..r> close-file 
94d0: 74 68 72 6f 77 20 20 45 4c 53 45 20 20 74 72 75  throw  ELSE  tru
94e0: 65 20 20 54 48 45 4e 0a 20 20 20 20 49 46 20 20  e  THEN.    IF  
94f0: 5b 3a 20 2e 22 20 47 65 6e 65 72 61 74 65 20 61  [: ." Generate a
9500: 20 6e 65 77 20 6b 65 79 70 61 69 72 3a 22 20 63   new keypair:" c
9510: 72 0a 09 20 20 67 65 74 2d 6e 69 63 6b 20 64 75  r..  get-nick du
9520: 70 20 30 3d 20 23 2d 35 36 20 61 6e 64 20 74 68  p 0= #-56 and th
9530: 72 6f 77 20 5c 20 65 6d 70 74 79 20 6e 69 63 6b  row \ empty nick
9540: 3a 20 70 72 65 74 65 6e 64 20 74 6f 20 71 75 69  : pretend to qui
9550: 74 0a 09 20 20 6e 65 77 2d 6b 65 79 20 2e 6b 65  t..  new-key .ke
9560: 79 73 20 3f 72 73 6b 20 3b 5d 0a 20 20 20 20 45  ys ?rsk ;].    E
9570: 4c 53 45 20 20 5b 27 5d 20 67 65 74 2d 73 6b 63  LSE  ['] get-skc
9580: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 2e 6b 65 79    THEN ;..: .key
9590: 69 6e 66 6f 20 28 20 2d 2d 20 29 0a 20 20 20 20  info ( -- ).    
95a0: 3c 77 61 72 6e 3e 20 2e 22 20 3d 3d 3d 3d 20 4e  <warn> ." ==== N
95b0: 6f 20 6b 65 79 20 6f 70 65 6e 65 64 20 3d 3d 3d  o key opened ===
95c0: 3d 22 20 63 72 0a 20 20 20 20 3c 69 6e 66 6f 3e  =" cr.    <info>
95d0: 20 2e 22 20 67 65 6e 65 72 61 74 65 20 61 20 6e   ." generate a n
95e0: 65 77 20 6f 6e 65 20 77 69 74 68 20 27 6b 65 79  ew one with 'key
95f0: 67 65 6e 27 22 20 63 72 20 3c 64 65 66 61 75 6c  gen'" cr <defaul
9600: 74 3e 20 3b 0a 0a 3a 20 67 65 74 2d 6d 65 20 28  t> ;..: get-me (
9610: 20 2d 2d 20 29 0a 20 20 20 20 67 65 74 2d 6d 79   -- ).    get-my
9620: 2d 6b 65 79 20 63 61 74 63 68 20 64 75 70 20 23  -key catch dup #
9630: 2d 35 36 20 3d 20 49 46 20 64 72 6f 70 20 2e 6b  -56 = IF drop .k
9640: 65 79 69 6e 66 6f 20 45 4c 53 45 20 74 68 72 6f  eyinfo ELSE thro
9650: 77 20 54 48 45 4e 20 3b 0a 0a 3a 20 3f 67 65 74  w THEN ;..: ?get
9660: 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 5c  -me ( -- ).    \
9670: 47 20 74 68 69 73 20 76 65 72 73 69 6f 6e 20 6f  G this version o
9680: 66 20 67 65 74 2d 6d 65 20 66 61 69 6c 73 20 68  f get-me fails h
9690: 61 72 64 20 69 66 20 6e 6f 20 6b 65 79 20 69 73  ard if no key is
96a0: 20 6f 70 65 6e 65 64 0a 20 20 20 20 67 65 74 2d   opened.    get-
96b0: 6d 79 2d 6b 65 79 20 63 61 74 63 68 20 23 2d 35  my-key catch #-5
96c0: 36 20 3d 20 49 46 0a 09 2e 6b 65 79 69 6e 66 6f  6 = IF...keyinfo
96d0: 20 74 72 75 65 20 21 21 6e 6f 2d 6b 65 79 2d 6f   true !!no-key-o
96e0: 70 65 6e 21 21 0a 20 20 20 20 54 48 45 4e 20 3b  pen!!.    THEN ;
96f0: 0a 0a 30 20 5b 49 46 5d 0a 4c 6f 63 61 6c 20 56  ..0 [IF].Local V
9700: 61 72 69 61 62 6c 65 73 3a 0a 66 6f 72 74 68 2d  ariables:.forth-
9710: 6c 6f 63 61 6c 2d 77 6f 72 64 73 3a 0a 20 20 20  local-words:.   
9720: 20 28 0a 20 20 20 20 20 28 28 22 6e 65 74 32 6f   (.     (("net2o
9730: 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20 64 65  :" "+net2o:") de
9740: 66 69 6e 69 74 69 6f 6e 2d 73 74 61 72 74 65 72  finition-starter
9750: 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 6b 65 79 77   (font-lock-keyw
9760: 6f 72 64 2d 66 61 63 65 20 2e 20 31 29 0a 20 20  ord-face . 1).  
9770: 20 20 20 20 22 5b 20 5c 74 5c 6e 5d 22 20 74 20      "[ \t\n]" t 
9780: 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d  name (font-lock-
9790: 66 75 6e 63 74 69 6f 6e 2d 6e 61 6d 65 2d 66 61  function-name-fa
97a0: 63 65 20 2e 20 33 29 29 0a 20 20 20 20 20 28 28  ce . 3)).     ((
97b0: 22 64 65 62 75 67 3a 22 20 22 66 69 65 6c 64 3a  "debug:" "field:
97c0: 22 20 22 32 66 69 65 6c 64 3a 22 20 22 73 66 66  " "2field:" "sff
97d0: 69 65 6c 64 3a 22 20 22 64 66 66 69 65 6c 64 3a  ield:" "dffield:
97e0: 22 20 22 36 34 66 69 65 6c 64 3a 22 20 22 75 76  " "64field:" "uv
97f0: 61 72 22 20 22 75 76 61 6c 75 65 22 29 20 6e 6f  ar" "uvalue") no
9800: 6e 2d 69 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e  n-immediate (fon
9810: 74 2d 6c 6f 63 6b 2d 74 79 70 65 2d 66 61 63 65  t-lock-type-face
9820: 20 2e 20 32 29 0a 20 20 20 20 20 20 22 5b 20 5c   . 2).      "[ \
9830: 74 5c 6e 5d 22 20 74 20 6e 61 6d 65 20 28 66 6f  t\n]" t name (fo
9840: 6e 74 2d 6c 6f 63 6b 2d 76 61 72 69 61 62 6c 65  nt-lock-variable
9850: 2d 6e 61 6d 65 2d 66 61 63 65 20 2e 20 33 29 29  -name-face . 3))
9860: 0a 20 20 20 20 20 28 22 5b 61 2d 7a 30 2d 39 5d  .     ("[a-z0-9]
9870: 2b 28 22 20 69 6d 6d 65 64 69 61 74 65 20 28 66  +(" immediate (f
9880: 6f 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74  ont-lock-comment
9890: 2d 66 61 63 65 20 2e 20 31 29 0a 20 20 20 20 20  -face . 1).     
98a0: 20 22 29 22 20 6e 69 6c 20 63 6f 6d 6d 65 6e 74   ")" nil comment
98b0: 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d   (font-lock-comm
98c0: 65 6e 74 2d 66 61 63 65 20 2e 20 31 29 29 0a 20  ent-face . 1)). 
98d0: 20 20 20 29 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c     ).forth-local
98e0: 2d 69 6e 64 65 6e 74 2d 77 6f 72 64 73 3a 0a 20  -indent-words:. 
98f0: 20 20 20 28 0a 20 20 20 20 20 28 28 22 6e 65 74     (.     (("net
9900: 32 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20  2o:" "+net2o:") 
9910: 28 30 20 2e 20 32 29 20 28 30 20 2e 20 32 29 20  (0 . 2) (0 . 2) 
9920: 6e 6f 6e 2d 69 6d 6d 65 64 69 61 74 65 29 0a 20  non-immediate). 
9930: 20 20 20 20 28 28 22 5b 3a 22 20 22 6b 65 79 3a      (("[:" "key:
9940: 63 6f 64 65 22 29 20 28 30 20 2e 20 31 29 20 28  code") (0 . 1) (
9950: 30 20 2e 20 31 29 20 69 6d 6d 65 64 69 61 74 65  0 . 1) immediate
9960: 29 0a 20 20 20 20 20 28 28 22 3b 5d 22 20 22 65  ).     ((";]" "e
9970: 6e 64 3a 6b 65 79 22 29 20 28 2d 31 20 2e 20 30  nd:key") (-1 . 0
9980: 29 20 28 30 20 2e 20 2d 31 29 20 69 6d 6d 65 64  ) (0 . -1) immed
9990: 69 61 74 65 29 0a 20 20 20 20 29 0a 45 6e 64 3a  iate).    ).End:
99a0: 0a 5b 54 48 45 4e 5d                             .[THEN]