Hex Artifact Content
Not logged in

Artifact cc2db81da4b549a14197541f8b99e9926d5a6acd:


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 20 20 20 20 45  p old-emit.    E
0550: 4c 53 45 20 20 64 75 70 20 24 43 30 20 24 38 30  LSE  dup $C0 $80
0560: 20 77 69 74 68 69 6e 20 49 46 0a 09 20 20 20 20   within IF..    
0570: 5b 20 70 77 2a 20 27 20 78 65 6d 69 74 20 24 74  [ pw* ' xemit $t
0580: 6d 70 0a 09 20 20 20 20 62 6f 75 6e 64 73 20 5b  mp..    bounds [
0590: 3f 44 4f 5d 20 5b 49 5d 20 63 40 20 5d 4c 20 6f  ?DO] [I] c@ ]L o
05a0: 6c 64 2d 65 6d 69 74 20 5b 20 5b 4c 4f 4f 50 5d  ld-emit [ [LOOP]
05b0: 20 5d 0a 09 54 48 45 4e 0a 20 20 20 20 54 48 45   ]..THEN.    THE
05c0: 4e 0a 20 20 20 20 74 6f 75 70 70 65 72 20 27 41  N.    toupper 'A
05d0: 27 20 27 5b 27 20 77 69 74 68 69 6e 20 49 46 20  ' '[' within IF 
05e0: 20 65 73 63 2d 73 74 61 74 65 20 6f 66 66 20 20   esc-state off  
05f0: 54 48 45 4e 20 3b 0a 0a 3a 20 74 79 70 65 2d 70  THEN ;..: type-p
0600: 77 2a 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29  w* ( addr u -- )
0610: 20 20 32 64 75 70 20 62 6c 20 73 6b 69 70 20 6e    2dup bl skip n
0620: 69 70 20 30 3d 0a 20 20 20 20 49 46 20 20 20 20  ip 0=.    IF    
0630: 62 6f 75 6e 64 73 20 55 2b 44 4f 20 20 62 6c 20  bounds U+DO  bl 
0640: 6f 6c 64 2d 65 6d 69 74 20 20 20 20 4c 4f 4f 50  old-emit    LOOP
0650: 0a 20 20 20 20 45 4c 53 45 20 20 62 6f 75 6e 64  .    ELSE  bound
0660: 73 20 55 2b 44 4f 20 20 49 20 63 40 20 65 6d 69  s U+DO  I c@ emi
0670: 74 2d 70 77 2a 20 20 4c 4f 4f 50 20 20 54 48 45  t-pw*  LOOP  THE
0680: 4e 20 3b 0a 0a 3a 20 61 63 63 65 70 74 2a 20 28  N ;..: accept* (
0690: 20 61 64 64 72 20 75 20 2d 2d 20 75 27 20 29 0a   addr u -- u' ).
06a0: 20 20 20 20 5c 47 20 61 63 63 65 70 74 2d 6c 69      \G accept-li
06b0: 6b 65 20 69 6e 70 75 74 2c 20 62 75 74 20 74 79  ke input, but ty
06c0: 70 65 73 20 2a 20 69 6e 73 74 65 61 64 20 6f 66  pes * instead of
06d0: 20 74 68 65 20 63 68 61 72 61 63 74 65 72 0a 20   the character. 
06e0: 20 20 20 5c 47 20 64 6f 6e 27 74 20 73 61 76 65     \G don't save
06f0: 20 69 6e 74 6f 20 68 69 73 74 6f 72 79 0a 20 20   into history.  
0700: 20 20 68 69 73 74 6f 72 79 20 3e 72 20 20 77 68    history >r  wh
0710: 61 74 27 73 20 74 79 70 65 20 3e 72 20 20 77 68  at's type >r  wh
0720: 61 74 27 73 20 65 6d 69 74 20 69 73 20 6f 6c 64  at's emit is old
0730: 2d 65 6d 69 74 0a 20 20 20 20 75 74 66 2d 38 2a  -emit.    utf-8*
0740: 20 78 63 2d 76 65 63 74 6f 72 20 21 40 20 3e 72   xc-vector !@ >r
0750: 20 20 5b 27 5d 20 74 79 70 65 2d 70 77 2a 20 69    ['] type-pw* i
0760: 73 20 74 79 70 65 20 20 5b 27 5d 20 65 6d 69 74  s type  ['] emit
0770: 2d 70 77 2a 20 69 73 20 65 6d 69 74 0a 20 20 20  -pw* is emit.   
0780: 20 30 20 74 6f 20 68 69 73 74 6f 72 79 0a 20 20   0 to history.  
0790: 20 20 5b 27 5d 20 61 63 63 65 70 74 20 63 61 74    ['] accept cat
07a0: 63 68 0a 20 20 20 20 72 3e 20 78 63 2d 76 65 63  ch.    r> xc-vec
07b0: 74 6f 72 20 21 20 20 77 68 61 74 27 73 20 6f 6c  tor !  what's ol
07c0: 64 2d 65 6d 69 74 20 69 73 20 65 6d 69 74 20 20  d-emit is emit  
07d0: 72 3e 20 69 73 20 74 79 70 65 20 20 72 3e 20 74  r> is type  r> t
07e0: 6f 20 68 69 73 74 6f 72 79 0a 20 20 20 20 74 68  o history.    th
07f0: 72 6f 77 20 2d 31 20 30 20 61 74 2d 64 65 6c 74  row -1 0 at-delt
0800: 61 78 79 20 73 70 61 63 65 20 3b 0a 0a 5c 20 4b  axy space ;..\ K
0810: 65 79 73 20 61 72 65 20 70 61 73 73 77 6f 72 64  eys are password
0820: 73 20 61 6e 64 20 70 72 69 76 61 74 65 20 6b 65  s and private ke
0830: 79 73 20 28 73 65 6c 66 2d 6b 65 79 65 64 2c 20  ys (self-keyed, 
0840: 69 2e 65 2e 20 70 72 69 76 61 74 65 2a 70 75 62  i.e. private*pub
0850: 6c 69 63 20 6b 65 79 29 0a 0a 63 6d 64 2d 62 75  lic key)..cmd-bu
0860: 66 30 20 75 63 6c 61 73 73 20 63 6d 64 62 75 66  f0 uclass cmdbuf
0870: 2d 6f 0a 20 20 20 20 6d 61 78 64 61 74 61 20 2d  -o.    maxdata -
0880: 0a 20 20 20 20 6b 65 79 2d 73 61 6c 74 23 20 75  .    key-salt# u
0890: 76 61 72 20 6b 65 79 70 61 63 6b 0a 20 20 20 20  var keypack.    
08a0: 6b 65 79 70 61 63 6b 23 20 20 75 76 61 72 20 6b  keypack#  uvar k
08b0: 65 79 70 61 63 6b 2d 62 75 66 0a 20 20 20 20 6b  eypack-buf.    k
08c0: 65 79 2d 63 6b 73 75 6d 23 20 75 76 61 72 20 6b  ey-cksum# uvar k
08d0: 65 79 70 61 63 6b 2d 63 68 6b 73 75 6d 0a 65 6e  eypack-chksum.en
08e0: 64 2d 63 6c 61 73 73 20 63 6d 64 2d 6b 65 79 62  d-class cmd-keyb
08f0: 75 66 2d 63 0a 0a 63 6d 64 2d 6b 65 79 62 75 66  uf-c..cmd-keybuf
0900: 2d 63 20 27 20 6e 65 77 20 73 74 61 74 69 63 2d  -c ' new static-
0910: 61 20 77 69 74 68 2d 61 6c 6c 6f 63 61 74 65 72  a with-allocater
0920: 20 63 6f 64 65 2d 6b 65 79 5e 20 21 0a 27 20 63   code-key^ !.' c
0930: 6f 64 65 2d 6b 65 79 5e 20 63 6d 64 62 75 66 3a  ode-key^ cmdbuf:
0940: 20 63 6f 64 65 2d 6b 65 79 0a 0a 63 6f 64 65 2d   code-key..code-
0950: 6b 65 79 0a 63 6d 64 30 6c 6f 63 6b 20 30 20 70  key.cmd0lock 0 p
0960: 74 68 72 65 61 64 5f 6d 75 74 65 78 5f 69 6e 69  thread_mutex_ini
0970: 74 20 64 72 6f 70 0a 0a 3a 6e 6f 6e 61 6d 65 20  t drop..:noname 
0980: 28 20 2d 2d 20 61 64 64 72 20 75 20 29 20 6b 65  ( -- addr u ) ke
0990: 79 70 61 63 6b 2d 62 75 66 20 63 6d 64 62 75 66  ypack-buf cmdbuf
09a0: 23 20 40 20 3b 20 74 6f 20 63 6d 64 62 75 66 24  # @ ; to cmdbuf$
09b0: 0a 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d 20 6e 20  .:noname ( -- n 
09c0: 29 20 20 6b 65 79 70 61 63 6b 23 20 63 6d 64 62  )  keypack# cmdb
09d0: 75 66 23 20 40 20 2d 20 3b 20 74 6f 20 6d 61 78  uf# @ - ; to max
09e0: 73 74 72 69 6e 67 0a 0a 63 6f 64 65 30 2d 62 75  string..code0-bu
09f0: 66 0a 0a 3a 6e 6f 6e 61 6d 65 20 64 65 66 65 72  f..:noname defer
0a00: 73 20 61 6c 6c 6f 63 2d 63 6f 64 65 2d 62 75 66  s alloc-code-buf
0a10: 73 0a 20 20 20 20 63 6d 64 2d 6b 65 79 62 75 66  s.    cmd-keybuf
0a20: 2d 63 20 6e 65 77 20 63 6f 64 65 2d 6b 65 79 5e  -c new code-key^
0a30: 20 21 20 3b 20 69 73 20 61 6c 6c 6f 63 2d 63 6f   ! ; is alloc-co
0a40: 64 65 2d 62 75 66 73 0a 3a 6e 6f 6e 61 6d 65 20  de-bufs.:noname 
0a50: 64 65 66 65 72 73 20 66 72 65 65 2d 63 6f 64 65  defers free-code
0a60: 2d 62 75 66 73 0a 20 20 20 20 63 6f 64 65 2d 6b  -bufs.    code-k
0a70: 65 79 5e 20 40 20 2e 64 69 73 70 6f 73 65 20 3b  ey^ @ .dispose ;
0a80: 20 69 73 20 66 72 65 65 2d 63 6f 64 65 2d 62 75   is free-code-bu
0a90: 66 73 0a 0a 5c 20 68 61 73 68 65 64 20 6b 65 79  fs..\ hashed key
0aa0: 20 64 61 74 61 20 62 61 73 65 0a 0a 56 61 72 69   data base..Vari
0ab0: 61 62 6c 65 20 67 72 6f 75 70 73 5b 5d 20 5c 20  able groups[] \ 
0ac0: 6e 61 6d 65 73 20 6f 66 20 67 72 6f 75 70 73 2c  names of groups,
0ad0: 20 73 6f 72 74 65 64 20 62 79 20 6f 72 64 65 72   sorted by order
0ae0: 20 69 6e 20 67 72 6f 75 70 73 20 66 69 6c 65 0a   in groups file.
0af0: 0a 55 73 65 72 20 3e 73 74 6f 72 65 6b 65 79 0a  .User >storekey.
0b00: 56 61 72 69 61 62 6c 65 20 64 65 66 61 75 6c 74  Variable default
0b10: 6b 65 79 0a 0a 63 6d 64 2d 63 6c 61 73 73 20 63  key..cmd-class c
0b20: 6c 61 73 73 0a 20 20 20 20 66 69 65 6c 64 3a 20  lass.    field: 
0b30: 6b 65 2d 73 6b 20 20 20 20 20 20 20 5c 20 73 65  ke-sk       \ se
0b40: 63 72 65 74 20 6b 65 79 0a 20 20 20 20 66 69 65  cret key.    fie
0b50: 6c 64 3a 20 6b 65 2d 70 6b 20 20 20 20 20 20 20  ld: ke-pk       
0b60: 5c 20 70 75 62 6c 69 63 20 6b 65 79 0a 20 20 20  \ public key.   
0b70: 20 66 69 65 6c 64 3a 20 6b 65 2d 72 73 6b 20 20   field: ke-rsk  
0b80: 20 20 20 20 5c 20 72 65 76 6f 6b 65 20 73 65 63      \ revoke sec
0b90: 72 65 74 20 28 74 65 6d 70 6f 72 61 72 69 6c 79  ret (temporarily
0ba0: 20 73 74 6f 72 65 64 29 0a 20 20 20 20 66 69 65   stored).    fie
0bb0: 6c 64 3a 20 6b 65 2d 74 79 70 65 20 20 20 20 20  ld: ke-type     
0bc0: 5c 20 6b 65 79 20 74 79 70 65 0a 20 20 20 20 66  \ key type.    f
0bd0: 69 65 6c 64 3a 20 6b 65 2d 6e 69 63 6b 20 20 20  ield: ke-nick   
0be0: 20 20 5c 20 6b 65 79 20 6e 69 63 6b 0a 20 20 20    \ key nick.   
0bf0: 20 66 69 65 6c 64 3a 20 6b 65 2d 6e 69 63 6b 23   field: ke-nick#
0c00: 20 20 20 20 5c 20 74 6f 20 61 76 6f 69 64 20 63      \ to avoid c
0c10: 6f 6c 69 73 73 69 6f 6e 73 2c 20 61 64 64 20 61  olissions, add a
0c20: 20 6e 75 6d 62 65 72 20 68 65 72 65 0a 20 20 20   number here.   
0c30: 20 66 69 65 6c 64 3a 20 6b 65 2d 70 65 74 73 20   field: ke-pets 
0c40: 20 20 20 20 5c 20 6b 65 79 20 70 65 74 6e 61 6d      \ key petnam
0c50: 65 73 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65  es.    field: ke
0c60: 2d 70 65 74 73 23 20 20 20 20 5c 20 74 6f 20 61  -pets#    \ to a
0c70: 76 6f 69 64 20 63 6f 6c 69 73 73 69 6f 6e 73 2c  void colissions,
0c80: 20 61 64 64 20 61 20 6e 75 6d 62 65 72 20 68 65   add a number he
0c90: 72 65 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65  re.    field: ke
0ca0: 2d 70 72 6f 66 20 20 20 20 20 5c 20 70 72 6f 66  -prof     \ prof
0cb0: 69 6c 65 20 6f 62 6a 65 63 74 0a 20 20 20 20 66  ile object.    f
0cc0: 69 65 6c 64 3a 20 6b 65 2d 73 65 6c 66 73 69 67  ield: ke-selfsig
0cd0: 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 2d 73  .    field: ke-s
0ce0: 69 67 73 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b  igs.    field: k
0cf0: 65 2d 69 6d 70 6f 72 74 73 20 20 5c 20 62 69 74  e-imports  \ bit
0d00: 6d 61 73 6b 20 6f 66 20 6b 65 79 20 69 6d 70 6f  mask of key impo
0d10: 72 74 0a 20 20 20 20 66 69 65 6c 64 3a 20 6b 65  rt.    field: ke
0d20: 2d 73 74 6f 72 65 6b 65 79 20 5c 20 75 73 65 64  -storekey \ used
0d30: 20 74 6f 20 65 6e 63 72 79 70 74 20 6f 6e 20 73   to encrypt on s
0d40: 74 6f 72 61 67 65 0a 20 20 20 20 66 69 65 6c 64  torage.    field
0d50: 3a 20 6b 65 2d 6d 61 73 6b 20 20 20 20 20 5c 20  : ke-mask     \ 
0d60: 70 65 72 6d 69 73 73 69 6f 6e 20 6d 61 73 6b 0a  permission mask.
0d70: 20 20 20 20 66 69 65 6c 64 3a 20 6b 65 2d 67 72      field: ke-gr
0d80: 6f 75 70 73 20 20 20 5c 20 70 72 65 6d 69 73 73  oups   \ premiss
0d90: 69 6f 6e 20 67 72 6f 75 70 73 0a 20 20 20 20 36  ion groups.    6
0da0: 34 66 69 65 6c 64 3a 20 6b 65 2d 6f 66 66 73 65  4field: ke-offse
0db0: 74 20 5c 20 6f 66 66 73 65 74 20 69 6e 20 6b 65  t \ offset in ke
0dc0: 79 20 66 69 6c 65 0a 20 20 20 20 66 69 65 6c 64  y file.    field
0dd0: 3a 20 6b 65 2d 70 77 6c 65 76 65 6c 20 20 5c 20  : ke-pwlevel  \ 
0de0: 70 61 73 73 77 6f 72 64 20 73 74 72 65 6e 67 74  password strengt
0df0: 68 20 6c 65 76 65 6c 0a 20 20 20 20 30 20 2b 66  h level.    0 +f
0e00: 69 65 6c 64 20 6b 65 2d 65 6e 64 0a 65 6e 64 2d  ield ke-end.end-
0e10: 63 6c 61 73 73 20 6b 65 79 2d 65 6e 74 72 79 0a  class key-entry.
0e20: 0a 3a 20 66 72 65 65 2d 6b 65 79 20 28 20 6f 3a  .: free-key ( o:
0e30: 6b 65 79 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20  key -- o:key ). 
0e40: 20 20 20 5c 67 20 66 72 65 65 20 61 6c 6c 20 70     \g free all p
0e50: 61 72 74 73 20 6f 66 20 74 68 65 20 73 75 62 6b  arts of the subk
0e60: 65 79 0a 20 20 20 20 6b 65 2d 73 6b 20 73 65 63  ey.    ke-sk sec
0e70: 2d 6f 66 66 0a 20 20 20 20 6b 65 2d 70 6b 20 24  -off.    ke-pk $
0e80: 6f 66 66 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20  off.    ke-nick 
0e90: 24 6f 66 66 0a 20 20 20 20 6b 65 2d 73 65 6c 66  $off.    ke-self
0ea0: 73 69 67 20 24 6f 66 66 0a 20 20 20 20 6b 65 2d  sig $off.    ke-
0eb0: 73 69 67 73 20 24 5b 5d 6f 66 66 0a 20 20 20 20  sigs $[]off.    
0ec0: 6b 65 2d 70 65 74 73 20 24 5b 5d 6f 66 66 0a 20  ke-pets $[]off. 
0ed0: 20 20 20 6b 65 2d 70 65 74 73 23 20 24 6f 66 66     ke-pets# $off
0ee0: 20 3b 0a 0a 5c 20 6b 65 79 20 63 6c 61 73 73 0a   ;..\ key class.
0ef0: 0a 30 0a 65 6e 75 6d 20 6b 65 79 23 61 6e 6f 6e  .0.enum key#anon
0f00: 0a 65 6e 75 6d 20 6b 65 79 23 75 73 65 72 0a 65  .enum key#user.e
0f10: 6e 75 6d 20 6b 65 79 23 67 72 6f 75 70 0a 64 72  num key#group.dr
0f20: 6f 70 0a 0a 5c 20 6b 65 79 20 69 6d 70 6f 72 74  op..\ key import
0f30: 20 74 79 70 65 0a 0a 30 0a 65 6e 75 6d 20 69 6d   type..0.enum im
0f40: 70 6f 72 74 23 73 65 6c 66 20 20 20 20 20 20 5c  port#self      \
0f50: 20 70 72 69 76 61 74 65 20 6b 65 79 0a 65 6e 75   private key.enu
0f60: 6d 20 69 6d 70 6f 72 74 23 6d 61 6e 75 61 6c 20  m import#manual 
0f70: 20 20 20 5c 20 6d 61 6e 75 61 6c 20 69 6d 70 6f     \ manual impo
0f80: 72 74 0a 65 6e 75 6d 20 69 6d 70 6f 72 74 23 73  rt.enum import#s
0f90: 63 61 6e 20 20 20 20 20 20 5c 20 73 63 61 6e 20  can      \ scan 
0fa0: 69 6d 70 6f 72 74 0a 65 6e 75 6d 20 69 6d 70 6f  import.enum impo
0fb0: 72 74 23 63 68 61 74 20 20 20 20 20 20 5c 20 73  rt#chat      \ s
0fc0: 65 65 6e 20 69 6e 20 63 68 61 74 0a 65 6e 75 6d  een in chat.enum
0fd0: 20 69 6d 70 6f 72 74 23 64 68 74 20 20 20 20 20   import#dht     
0fe0: 20 20 5c 20 64 68 74 20 69 6d 70 6f 72 74 0a 65    \ dht import.e
0ff0: 6e 75 6d 20 69 6d 70 6f 72 74 23 69 6e 76 69 74  num import#invit
1000: 65 64 20 20 20 5c 20 69 6e 76 69 74 61 74 69 6f  ed   \ invitatio
1010: 6e 20 69 6d 70 6f 72 74 0a 65 6e 75 6d 20 69 6d  n import.enum im
1020: 70 6f 72 74 23 75 6e 74 72 75 73 74 65 64 20 5c  port#untrusted \
1030: 20 6d 75 73 74 20 62 65 20 6c 61 73 74 0a 64 72   must be last.dr
1040: 6f 70 0a 24 31 46 20 65 6e 75 6d 20 69 6d 70 6f  op.$1F enum impo
1050: 72 74 23 6e 65 77 20 20 20 5c 20 6e 65 77 20 66  rt#new   \ new f
1060: 6f 72 6d 61 74 0a 64 72 6f 70 0a 0a 43 72 65 61  ormat.drop..Crea
1070: 74 65 20 69 6d 70 6f 72 74 73 24 20 24 32 30 20  te imports$ $20 
1080: 61 6c 6c 6f 74 20 69 6d 70 6f 72 74 73 24 20 24  allot imports$ $
1090: 32 30 20 62 6c 20 66 69 6c 6c 0a 22 49 6d 73 63  20 bl fill."Imsc
10a0: 64 69 75 22 20 69 6d 70 6f 72 74 73 24 20 73 77  diu" imports$ sw
10b0: 61 70 20 6d 6f 76 65 0a 0a 56 61 72 69 61 62 6c  ap move..Variabl
10c0: 65 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 20 69  e import-type  i
10d0: 6d 70 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74  mport#new import
10e0: 2d 74 79 70 65 20 21 0a 0a 43 72 65 61 74 65 20  -type !..Create 
10f0: 3e 69 6d 2d 63 6f 6c 6f 72 20 20 24 42 36 30 20  >im-color  $B60 
1100: 2c 20 24 44 36 30 20 2c 20 24 39 36 30 20 2c 20  , $D60 , $960 , 
1110: 24 43 36 30 20 2c 20 24 41 36 30 20 2c 20 24 38  $C60 , $A60 , $8
1120: 42 31 20 2c 20 24 45 36 30 20 2c 0a 44 4f 45 53  B1 , $E60 ,.DOES
1130: 3e 20 73 77 61 70 20 38 20 63 65 6c 6c 73 20 30  > swap 8 cells 0
1140: 20 44 4f 20 20 64 75 70 20 31 20 61 6e 64 20 49   DO  dup 1 and I
1150: 46 20 20 64 72 6f 70 20 49 20 4c 45 41 56 45 20  F  drop I LEAVE 
1160: 20 54 48 45 4e 20 20 32 2f 20 20 4c 4f 4f 50 0a   THEN  2/  LOOP.
1170: 20 20 63 65 6c 6c 73 20 2b 20 40 20 61 74 74 72    cells + @ attr
1180: 21 20 3b 0a 0a 3a 20 2e 69 6d 70 6f 72 74 73 20  ! ;..: .imports 
1190: 28 20 6d 61 73 6b 20 2d 2d 20 29 0a 20 20 20 20  ( mask -- ).    
11a0: 69 6d 70 6f 72 74 73 24 20 69 6d 70 6f 72 74 23  imports$ import#
11b0: 6e 65 77 20 62 6f 75 6e 64 73 20 44 4f 0a 09 64  new bounds DO..d
11c0: 75 70 20 31 20 61 6e 64 20 49 46 20 20 49 20 63  up 1 and IF  I c
11d0: 40 20 65 6d 69 74 20 20 54 48 45 4e 20 20 32 2f  @ emit  THEN  2/
11e0: 20 4c 4f 4f 50 0a 20 20 20 20 64 72 6f 70 20 3b   LOOP.    drop ;
11f0: 0a 0a 5c 20 73 61 6d 70 6c 65 20 6b 65 79 0a 0a  ..\ sample key..
1200: 6b 65 79 2d 65 6e 74 72 79 20 27 20 6e 65 77 20  key-entry ' new 
1210: 73 74 61 74 69 63 2d 61 20 77 69 74 68 2d 61 6c  static-a with-al
1220: 6c 6f 63 61 74 65 72 20 43 6f 6e 73 74 61 6e 74  locater Constant
1230: 20 73 61 6d 70 6c 65 2d 6b 65 79 0a 0a 56 61 72   sample-key..Var
1240: 69 61 62 6c 65 20 6b 65 79 23 20 5c 20 6b 65 79  iable key# \ key
1250: 20 68 61 73 68 20 74 61 62 6c 65 0a 56 61 72 69   hash table.Vari
1260: 61 62 6c 65 20 6e 69 63 6b 23 20 5c 20 6e 69 63  able nick# \ nic
1270: 6b 20 68 61 73 68 20 74 61 62 6c 65 0a 0a 36 34  k hash table..64
1280: 56 61 72 69 61 62 6c 65 20 6b 65 79 2d 72 65 61  Variable key-rea
1290: 64 2d 6f 66 66 73 65 74 0a 0a 3a 20 63 75 72 72  d-offset..: curr
12a0: 65 6e 74 2d 6b 65 79 20 28 20 61 64 64 72 20 75  ent-key ( addr u
12b0: 20 2d 2d 20 6f 20 29 0a 20 20 20 20 32 64 75 70   -- o ).    2dup
12c0: 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 64 72   key| key# #@ dr
12d0: 6f 70 0a 20 20 20 20 64 75 70 20 30 3d 20 49 46  op.    dup 0= IF
12e0: 20 20 64 72 6f 70 20 2e 22 20 75 6e 6b 6e 6f 77    drop ." unknow
12f0: 6e 20 6b 65 79 3a 20 22 20 38 35 74 79 70 65 20  n key: " 85type 
1300: 63 72 20 20 30 20 45 58 49 54 20 20 54 48 45 4e  cr  0 EXIT  THEN
1310: 0a 20 20 20 20 63 65 6c 6c 2b 20 3e 6f 20 6b 65  .    cell+ >o ke
1320: 2d 70 6b 20 24 21 20 6f 20 6f 3e 20 3b 0a 0a 56  -pk $! o o> ;..V
1330: 61 72 69 61 62 6c 65 20 73 69 6d 2d 6e 69 63 6b  ariable sim-nick
1340: 21 0a 0a 3a 20 6e 69 63 6b 21 20 28 20 2d 2d 20  !..: nick! ( -- 
1350: 29 20 73 69 6d 2d 6e 69 63 6b 21 20 40 20 3f 45  ) sim-nick! @ ?E
1360: 58 49 54 20 20 6f 20 7b 20 77 5e 20 6f 70 74 72  XIT  o { w^ optr
1370: 20 7d 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 24   }.    ke-nick $
1380: 40 20 6e 69 63 6b 23 20 23 40 20 64 30 3d 20 49  @ nick# #@ d0= I
1390: 46 0a 09 6f 70 74 72 20 63 65 6c 6c 20 6b 65 2d  F..optr cell ke-
13a0: 6e 69 63 6b 20 24 40 20 6e 69 63 6b 23 20 23 21  nick $@ nick# #!
13b0: 20 30 0a 20 20 20 20 45 4c 53 45 0a 09 6c 61 73   0.    ELSE..las
13c0: 74 23 20 63 65 6c 6c 2b 20 24 40 6c 65 6e 20 63  t# cell+ $@len c
13d0: 65 6c 6c 2f 0a 09 6f 70 74 72 20 63 65 6c 6c 20  ell/..optr cell 
13e0: 6c 61 73 74 23 20 63 65 6c 6c 2b 20 24 2b 21 0a  last# cell+ $+!.
13f0: 20 20 20 20 54 48 45 4e 20 20 6b 65 2d 6e 69 63      THEN  ke-nic
1400: 6b 23 20 21 20 3b 0a 0a 3a 20 23 2e 6e 69 63 6b  k# ! ;..: #.nick
1410: 20 28 20 68 61 73 68 20 2d 2d 20 29 0a 20 20 20   ( hash -- ).   
1420: 20 64 75 70 20 24 40 20 74 79 70 65 20 27 23 27   dup $@ type '#'
1430: 20 65 6d 69 74 20 63 65 6c 6c 2b 20 24 40 6c 65   emit cell+ $@le
1440: 6e 20 63 65 6c 6c 2f 20 2e 20 3b 0a 0a 3a 20 6c  n cell/ . ;..: l
1450: 61 73 74 2d 70 65 74 40 20 28 20 2d 2d 20 61 64  ast-pet@ ( -- ad
1460: 64 72 20 75 20 29 0a 20 20 20 20 6b 65 2d 70 65  dr u ).    ke-pe
1470: 74 73 20 24 5b 5d 23 20 3f 64 75 70 2d 49 46 20  ts $[]# ?dup-IF 
1480: 20 31 2d 20 6b 65 2d 70 65 74 73 20 24 5b 5d 40   1- ke-pets $[]@
1490: 20 20 45 4c 53 45 20 20 23 30 2e 20 20 54 48 45    ELSE  #0.  THE
14a0: 4e 20 3b 0a 0a 3a 20 70 65 74 21 20 28 20 2d 2d  N ;..: pet! ( --
14b0: 20 29 20 73 69 6d 2d 6e 69 63 6b 21 20 40 20 3f   ) sim-nick! @ ?
14c0: 45 58 49 54 20 20 6f 20 7b 20 77 5e 20 6f 70 74  EXIT  o { w^ opt
14d0: 72 20 7d 0a 20 20 20 20 6c 61 73 74 2d 70 65 74  r }.    last-pet
14e0: 40 20 6e 69 63 6b 23 20 23 40 20 64 30 3d 20 49  @ nick# #@ d0= I
14f0: 46 0a 09 6f 70 74 72 20 63 65 6c 6c 20 6c 61 73  F..optr cell las
1500: 74 2d 70 65 74 40 20 6e 69 63 6b 23 20 23 21 20  t-pet@ nick# #! 
1510: 30 0a 20 20 20 20 45 4c 53 45 0a 09 6c 61 73 74  0.    ELSE..last
1520: 23 20 63 65 6c 6c 2b 20 24 40 6c 65 6e 20 63 65  # cell+ $@len ce
1530: 6c 6c 2f 0a 09 6f 70 74 72 20 63 65 6c 6c 20 6c  ll/..optr cell l
1540: 61 73 74 23 20 63 65 6c 6c 2b 20 24 2b 21 0a 20  ast# cell+ $+!. 
1550: 20 20 20 54 48 45 4e 20 20 6b 65 2d 70 65 74 73     THEN  ke-pets
1560: 20 24 5b 5d 23 20 31 2d 20 6b 65 2d 70 65 74 73   $[]# 1- ke-pets
1570: 23 20 24 5b 5d 20 21 20 3b 0a 0a 3a 20 6b 65 79  # $[] ! ;..: key
1580: 3a 6e 65 77 20 28 20 61 64 64 72 20 75 20 2d 2d  :new ( addr u --
1590: 20 6f 20 29 0a 20 20 20 20 5c 47 20 63 72 65 61   o ).    \G crea
15a0: 74 65 20 6e 65 77 20 6b 65 79 2c 20 61 64 64 72  te new key, addr
15b0: 20 75 20 69 73 20 74 68 65 20 70 75 62 6c 69 63   u is the public
15c0: 20 6b 65 79 0a 20 20 20 20 73 61 6d 70 6c 65 2d   key.    sample-
15d0: 6b 65 79 20 3e 6f 20 20 6b 65 2d 73 6b 20 6b 65  key >o  ke-sk ke
15e0: 2d 65 6e 64 20 6f 76 65 72 20 2d 20 65 72 61 73  -end over - eras
15f0: 65 0a 20 20 20 20 6b 65 79 2d 65 6e 74 72 79 2d  e.    key-entry-
1600: 74 61 62 6c 65 20 40 20 74 6f 6b 65 6e 2d 74 61  table @ token-ta
1610: 62 6c 65 20 21 0a 20 20 20 20 3e 73 74 6f 72 65  ble !.    >store
1620: 6b 65 79 20 40 20 6b 65 2d 73 74 6f 72 65 6b 65  key @ ke-storeke
1630: 79 20 21 0a 20 20 20 20 6b 65 79 2d 72 65 61 64  y !.    key-read
1640: 2d 6f 66 66 73 65 74 20 36 34 40 20 6b 65 2d 6f  -offset 64@ ke-o
1650: 66 66 73 65 74 20 36 34 21 0a 20 20 20 20 31 20  ffset 64!.    1 
1660: 69 6d 70 6f 72 74 2d 74 79 70 65 20 40 20 6c 73  import-type @ ls
1670: 68 69 66 74 20 5b 20 31 20 69 6d 70 6f 72 74 23  hift [ 1 import#
1680: 6e 65 77 20 6c 73 68 69 66 74 20 5d 4c 20 6f 72  new lshift ]L or
1690: 20 6b 65 2d 69 6d 70 6f 72 74 73 20 21 0a 20 20   ke-imports !.  
16a0: 20 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 6e    keypack-all# n
16b0: 3e 36 34 20 6b 65 79 2d 72 65 61 64 2d 6f 66 66  >64 key-read-off
16c0: 73 65 74 20 36 34 2b 21 20 6f 20 63 65 6c 6c 2d  set 64+! o cell-
16d0: 20 6b 65 2d 65 6e 64 20 6f 76 65 72 20 2d 0a 20   ke-end over -. 
16e0: 20 20 20 32 6f 76 65 72 20 6b 65 79 7c 20 6b 65     2over key| ke
16f0: 79 23 20 23 21 20 6f 3e 0a 20 20 20 20 63 75 72  y# #! o>.    cur
1700: 72 65 6e 74 2d 6b 65 79 20 3b 0a 0a 30 20 56 61  rent-key ;..0 Va
1710: 6c 75 65 20 6c 61 73 74 2d 6b 65 79 0a 0a 3a 20  lue last-key..: 
1720: 6b 65 79 3f 6e 65 77 20 28 20 61 64 64 72 20 75  key?new ( addr u
1730: 20 2d 2d 20 6f 20 29 0a 20 20 20 20 5c 47 20 43   -- o ).    \G C
1740: 72 65 61 74 65 20 6f 72 20 6c 6f 6f 6b 75 70 20  reate or lookup 
1750: 6e 65 77 20 6b 65 79 0a 20 20 20 20 32 64 75 70  new key.    2dup
1760: 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20 64 72   key| key# #@ dr
1770: 6f 70 0a 20 20 20 20 64 75 70 20 30 3d 20 49 46  op.    dup 0= IF
1780: 20 20 64 72 6f 70 20 6b 65 79 3a 6e 65 77 0a 20    drop key:new. 
1790: 20 20 20 45 4c 53 45 20 20 6e 69 70 20 6e 69 70     ELSE  nip nip
17a0: 20 63 65 6c 6c 2b 20 20 31 20 69 6d 70 6f 72 74   cell+  1 import
17b0: 2d 74 79 70 65 20 40 20 6c 73 68 69 66 74 20 6f  -type @ lshift o
17c0: 76 65 72 20 2e 6b 65 2d 69 6d 70 6f 72 74 73 20  ver .ke-imports 
17d0: 6f 72 21 20 20 54 48 45 4e 0a 20 20 20 20 64 75  or!  THEN.    du
17e0: 70 20 74 6f 20 6c 61 73 74 2d 6b 65 79 20 3b 0a  p to last-key ;.
17f0: 0a 5c 20 73 65 61 72 63 68 20 66 6f 72 20 6b 65  .\ search for ke
1800: 79 73 20 2d 20 6e 6f 74 20 6f 70 74 69 6d 69 7a  ys - not optimiz
1810: 65 64 0a 0a 3a 20 23 73 70 6c 69 74 20 28 20 61  ed..: #split ( a
1820: 64 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75 20  ddr u -- addr u 
1830: 6e 20 29 0a 20 20 20 20 5b 3a 20 32 64 75 70 20  n ).    [: 2dup 
1840: 27 23 27 20 2d 73 63 61 6e 20 6e 69 70 20 3e 72  '#' -scan nip >r
1850: 0a 20 20 20 20 20 20 72 40 20 30 3d 20 49 46 20  .      r@ 0= IF 
1860: 20 72 64 72 6f 70 20 30 20 20 45 58 49 54 20 20   rdrop 0  EXIT  
1870: 54 48 45 4e 0a 20 20 20 20 20 20 23 30 2e 20 32  THEN.      #0. 2
1880: 6f 76 65 72 20 72 40 20 2f 73 74 72 69 6e 67 20  over r@ /string 
1890: 3e 6e 75 6d 62 65 72 0a 20 20 20 20 20 20 30 3d  >number.      0=
18a0: 20 49 46 20 20 6e 69 70 20 64 72 6f 70 20 6e 69   IF  nip drop ni
18b0: 70 20 72 3e 20 31 2d 20 73 77 61 70 20 20 45 4c  p r> 1- swap  EL
18c0: 53 45 0a 09 20 20 72 64 72 6f 70 20 64 72 6f 70  SE..  rdrop drop
18d0: 20 32 64 72 6f 70 20 30 20 20 20 54 48 45 4e 20   2drop 0   THEN 
18e0: 3b 5d 20 23 31 30 20 62 61 73 65 2d 65 78 65 63  ;] #10 base-exec
18f0: 75 74 65 20 3b 0a 0a 3a 20 6e 69 63 6b 2d 6b 65  ute ;..: nick-ke
1900: 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 6f 20  y ( addr u -- o 
1910: 2f 20 30 20 29 20 5c 20 73 65 61 72 63 68 20 66  / 0 ) \ search f
1920: 6f 72 20 6b 65 79 20 6e 69 63 6b 6e 61 6d 65 0a  or key nickname.
1930: 20 20 20 20 23 73 70 6c 69 74 20 3e 72 20 6e 69      #split >r ni
1940: 63 6b 23 20 23 40 20 32 64 75 70 20 64 30 3d 20  ck# #@ 2dup d0= 
1950: 49 46 20 20 72 64 72 6f 70 20 64 72 6f 70 20 20  IF  rdrop drop  
1960: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 72  EXIT  THEN.    r
1970: 3e 20 63 65 6c 6c 73 20 73 61 66 65 2f 73 74 72  > cells safe/str
1980: 69 6e 67 20 30 3d 20 49 46 20 20 64 72 6f 70 20  ing 0= IF  drop 
1990: 30 20 20 45 58 49 54 20 20 54 48 45 4e 20 20 40  0  EXIT  THEN  @
19a0: 20 3b 0a 0a 3a 20 73 65 63 72 65 74 2d 6b 65 79   ;..: secret-key
19b0: 73 23 20 28 20 2d 2d 20 6e 20 29 0a 20 20 20 20  s# ( -- n ).    
19c0: 30 20 6b 65 79 23 20 5b 3a 20 63 65 6c 6c 2b 20  0 key# [: cell+ 
19d0: 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f  $@ drop cell+ >o
19e0: 20 6b 65 2d 73 6b 20 40 20 30 3c 3e 20 2d 20 6f   ke-sk @ 0<> - o
19f0: 3e 20 3b 5d 20 23 6d 61 70 20 3b 0a 3a 20 73 65  > ;] #map ;.: se
1a00: 63 72 65 74 2d 6b 65 79 20 28 20 6e 20 2d 2d 20  cret-key ( n -- 
1a10: 6f 2f 30 20 29 0a 20 20 20 20 30 20 74 75 63 6b  o/0 ).    0 tuck
1a20: 20 6b 65 79 23 20 5b 3a 20 63 65 6c 6c 2b 20 24   key# [: cell+ $
1a30: 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 20  @ drop cell+ >o 
1a40: 6b 65 2d 73 6b 20 40 20 49 46 0a 09 20 20 32 64  ke-sk @ IF..  2d
1a50: 75 70 20 3d 20 49 46 20 20 72 6f 74 20 64 72 6f  up = IF  rot dro
1a60: 70 20 6f 20 2d 72 6f 74 20 20 54 48 45 4e 20 20  p o -rot  THEN  
1a70: 31 2b 0a 20 20 20 20 20 20 54 48 45 4e 20 20 6f  1+.      THEN  o
1a80: 3e 20 3b 5d 20 23 6d 61 70 20 32 64 72 6f 70 20  > ;] #map 2drop 
1a90: 3b 0a 3a 20 2e 23 20 28 20 6e 20 2d 2d 20 29 20  ;.: .# ( n -- ) 
1aa0: 3f 64 75 70 2d 49 46 20 20 27 23 27 20 65 6d 69  ?dup-IF  '#' emi
1ab0: 74 20 30 20 2e 72 20 20 54 48 45 4e 20 3b 0a 3a  t 0 .r  THEN ;.:
1ac0: 20 2e 6e 69 63 6b 2d 62 61 73 65 20 28 20 6f 3a   .nick-base ( o:
1ad0: 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d  key -- ).    ke-
1ae0: 6e 69 63 6b 20 24 2e 20 20 6b 65 2d 6e 69 63 6b  nick $.  ke-nick
1af0: 23 20 40 20 2e 23 20 3b 0a 3a 20 2e 70 65 74 2d  # @ .# ;.: .pet-
1b00: 62 61 73 65 20 28 20 6f 3a 6b 65 79 20 2d 2d 20  base ( o:key -- 
1b10: 29 0a 20 20 20 20 30 20 6b 65 2d 70 65 74 73 20  ).    0 ke-pets 
1b20: 5b 3a 20 73 70 61 63 65 20 74 79 70 65 0a 20 20  [: space type.  
1b30: 20 20 20 20 64 75 70 20 6b 65 2d 70 65 74 73 23      dup ke-pets#
1b40: 20 24 5b 5d 20 40 20 2e 23 20 20 31 2b 20 3b 5d   $[] @ .#  1+ ;]
1b50: 20 24 5b 5d 6d 61 70 20 64 72 6f 70 20 3b 0a 3a   $[]map drop ;.:
1b60: 20 2e 70 65 74 30 2d 62 61 73 65 20 28 20 6f 3a   .pet0-base ( o:
1b70: 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d  key -- ).    ke-
1b80: 70 65 74 73 20 24 5b 5d 23 20 49 46 20 20 30 20  pets $[]# IF  0 
1b90: 6b 65 2d 70 65 74 73 20 24 5b 5d 40 20 74 79 70  ke-pets $[]@ typ
1ba0: 65 20 30 20 6b 65 2d 70 65 74 73 23 20 24 5b 5d  e 0 ke-pets# $[]
1bb0: 20 40 20 2e 23 0a 20 20 20 20 45 4c 53 45 20 20   @ .#.    ELSE  
1bc0: 2e 6e 69 63 6b 2d 62 61 73 65 20 20 54 48 45 4e  .nick-base  THEN
1bd0: 20 3b 0a 3a 20 2e 72 65 61 6c 2d 6e 69 63 6b 20   ;.: .real-nick 
1be0: 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 20 20 20 6b  ( o:key -- )   k
1bf0: 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e 69 6d 2d  e-imports @ >im-
1c00: 63 6f 6c 6f 72 20 2e 6e 69 63 6b 2d 62 61 73 65  color .nick-base
1c10: 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 3a 20 2e   <default> ;.: .
1c20: 6e 69 63 6b 20 28 20 6f 3a 6b 65 79 20 2d 2d 20  nick ( o:key -- 
1c30: 29 20 20 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40  )   ke-imports @
1c40: 20 3e 69 6d 2d 63 6f 6c 6f 72 20 2e 70 65 74 30   >im-color .pet0
1c50: 2d 62 61 73 65 20 3c 64 65 66 61 75 6c 74 3e 20  -base <default> 
1c60: 3b 0a 3a 20 2e 6e 69 63 6b 2b 70 65 74 20 28 20  ;.: .nick+pet ( 
1c70: 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b  o:key -- ).    k
1c80: 65 2d 69 6d 70 6f 72 74 73 20 40 20 3e 69 6d 2d  e-imports @ >im-
1c90: 63 6f 6c 6f 72 20 2e 6e 69 63 6b 2d 62 61 73 65  color .nick-base
1ca0: 20 2e 70 65 74 2d 62 61 73 65 20 3c 64 65 66 61   .pet-base <defa
1cb0: 75 6c 74 3e 20 3b 0a 0a 3a 20 6e 69 63 6b 3e 70  ult> ;..: nick>p
1cc0: 6b 20 28 20 6e 69 63 6b 20 75 20 2d 2d 20 70 6b  k ( nick u -- pk
1cd0: 20 75 20 29 0a 20 20 20 20 6e 69 63 6b 2d 6b 65   u ).    nick-ke
1ce0: 79 20 3f 64 75 70 2d 49 46 20 2e 6b 65 2d 70 6b  y ?dup-IF .ke-pk
1cf0: 20 24 40 20 45 4c 53 45 20 30 20 30 20 54 48 45   $@ ELSE 0 0 THE
1d00: 4e 20 3b 0a 3a 20 68 6f 73 74 2e 6e 69 63 6b 3e  N ;.: host.nick>
1d10: 70 6b 20 28 20 61 64 64 72 20 75 20 2d 2d 20 70  pk ( addr u -- p
1d20: 6b 20 75 27 20 29 0a 20 20 20 20 27 2e 27 20 24  k u' ).    '.' $
1d30: 73 70 6c 69 74 20 64 75 70 20 30 3d 20 49 46 20  split dup 0= IF 
1d40: 20 32 73 77 61 70 20 20 54 48 45 4e 20 5b 3a 20   2swap  THEN [: 
1d50: 6e 69 63 6b 3e 70 6b 20 74 79 70 65 20 74 79 70  nick>pk type typ
1d60: 65 20 3b 5d 20 24 74 6d 70 20 3b 0a 0a 3a 20 6b  e ;] $tmp ;..: k
1d70: 65 79 2d 65 78 69 73 74 3f 20 28 20 61 64 64 72  ey-exist? ( addr
1d80: 20 75 20 2d 2d 20 6f 2f 30 20 29 0a 20 20 20 20   u -- o/0 ).    
1d90: 6b 65 79 23 20 23 40 20 49 46 20 20 63 65 6c 6c  key# #@ IF  cell
1da0: 2b 20 20 54 48 45 4e 20 3b 20 0a 0a 5c 20 70 65  +  THEN ; ..\ pe
1db0: 72 6d 69 73 73 69 6f 6e 20 6d 6f 64 69 66 69 63  rmission modific
1dc0: 61 74 69 6f 6e 0a 0a 32 36 20 62 75 66 66 65 72  ation..26 buffer
1dd0: 3a 20 70 65 72 6d 2d 63 68 61 72 73 0a 30 20 70  : perm-chars.0 p
1de0: 65 72 6d 24 20 63 6f 75 6e 74 20 62 6f 75 6e 64  erm$ count bound
1df0: 73 20 5b 44 4f 5d 20 64 75 70 20 5b 49 5d 20 63  s [DO] dup [I] c
1e00: 40 20 27 61 27 20 2d 20 70 65 72 6d 2d 63 68 61  @ 'a' - perm-cha
1e10: 72 73 20 2b 20 63 21 20 31 2b 20 5b 4c 4f 4f 50  rs + c! 1+ [LOOP
1e20: 5d 20 64 72 6f 70 0a 0a 3a 20 2e 70 65 72 6d 20  ] drop..: .perm 
1e30: 28 20 70 65 72 6d 69 73 73 69 6f 6e 20 2d 2d 20  ( permission -- 
1e40: 29 20 20 31 20 70 65 72 6d 24 20 63 6f 75 6e 74  )  1 perm$ count
1e50: 20 62 6f 75 6e 64 73 20 44 4f 0a 09 32 64 75 70   bounds DO..2dup
1e60: 20 61 6e 64 20 30 3c 3e 20 49 20 63 40 20 27 2d   and 0<> I c@ '-
1e70: 27 20 72 6f 74 20 73 65 6c 65 63 74 20 65 6d 69  ' rot select emi
1e80: 74 20 32 2a 0a 20 20 20 20 4c 4f 4f 50 20 20 32  t 2*.    LOOP  2
1e90: 64 72 6f 70 20 3b 0a 3a 20 70 65 72 6d 61 6e 64  drop ;.: permand
1ea0: 20 28 20 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f   ( permand permo
1eb0: 72 20 6e 65 77 20 2d 2d 20 70 65 72 6d 61 6e 64  r new -- permand
1ec0: 27 20 70 65 72 6d 6f 72 20 29 0a 20 20 20 20 69  ' permor ).    i
1ed0: 6e 76 65 72 74 20 74 75 63 6b 20 61 6e 64 20 3e  nvert tuck and >
1ee0: 72 20 61 6e 64 20 72 3e 20 3b 0a 3a 20 3e 70 65  r and r> ;.: >pe
1ef0: 72 6d 2d 6d 6f 64 20 28 20 70 65 72 6d 61 6e 64  rm-mod ( permand
1f00: 20 70 65 72 6d 6f 72 20 2d 2d 20 70 65 72 6d 61   permor -- perma
1f10: 6e 64 27 20 70 65 72 6d 6f 72 20 29 0a 20 20 20  nd' permor ).   
1f20: 20 73 77 61 70 20 64 75 70 20 30 3d 20 49 46 20   swap dup 0= IF 
1f30: 20 64 72 6f 70 20 64 75 70 20 69 6e 76 65 72 74   drop dup invert
1f40: 20 20 54 48 45 4e 20 73 77 61 70 20 3b 0a 3a 20    THEN swap ;.: 
1f50: 3e 70 65 72 6d 20 28 20 61 64 64 72 20 75 20 2d  >perm ( addr u -
1f60: 2d 20 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72  - permand permor
1f70: 20 29 0a 20 20 20 20 5c 47 20 70 61 72 73 65 20   ).    \G parse 
1f80: 70 65 72 6d 69 73 73 69 6f 6e 73 3a 20 2b 20 61  permissions: + a
1f90: 64 64 73 2c 20 2d 20 72 65 6d 6f 76 65 73 20 70  dds, - removes p
1fa0: 65 72 6d 69 73 73 69 6f 6e 73 2c 0a 20 20 20 20  ermissions,.    
1fb0: 5c 47 20 6e 6f 20 6d 6f 64 69 66 69 65 72 20 73  \G no modifier s
1fc0: 65 74 73 20 70 65 72 6d 69 73 73 6f 6e 73 2e 0a  ets permissons..
1fd0: 20 20 20 20 30 20 30 20 5b 27 5d 20 6f 72 20 7b      0 0 ['] or {
1fe0: 20 78 74 20 7d 0a 20 20 20 20 32 73 77 61 70 20   xt }.    2swap 
1ff0: 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 20 63 40  bounds ?DO..I c@
2000: 20 63 61 73 65 0a 09 20 20 20 20 27 2b 27 20 6f   case..    '+' o
2010: 66 20 20 3e 70 65 72 6d 2d 6d 6f 64 20 5b 27 5d  f  >perm-mod [']
2020: 20 6f 72 20 74 6f 20 78 74 20 65 6e 64 6f 66 0a   or to xt endof.
2030: 09 20 20 20 20 27 2d 27 20 6f 66 20 20 3e 70 65  .    '-' of  >pe
2040: 72 6d 2d 6d 6f 64 20 5b 27 5d 20 70 65 72 6d 61  rm-mod ['] perma
2050: 6e 64 20 74 6f 20 78 74 20 20 65 6e 64 6f 66 0a  nd to xt  endof.
2060: 09 20 20 20 20 27 3d 27 20 6f 66 20 20 32 64 72  .    '=' of  2dr
2070: 6f 70 20 70 65 72 6d 25 64 65 66 61 75 6c 74 20  op perm%default 
2080: 64 75 70 20 5b 27 5d 20 6f 72 20 74 6f 20 78 74  dup ['] or to xt
2090: 20 20 65 6e 64 6f 66 0a 09 20 20 20 20 27 61 27    endof..    'a'
20a0: 20 2d 20 64 75 70 20 27 7a 27 20 75 3c 3d 20 20   - dup 'z' u<=  
20b0: 49 46 0a 09 09 70 65 72 6d 2d 63 68 61 72 73 20  IF...perm-chars 
20c0: 2b 20 63 40 20 31 20 73 77 61 70 20 6c 73 68 69  + c@ 1 swap lshi
20d0: 66 74 20 78 74 20 65 78 65 63 75 74 65 0a 09 09  ft xt execute...
20e0: 30 20 28 20 64 75 6d 6d 79 20 66 6f 72 20 65 6e  0 ( dummy for en
20f0: 64 63 61 73 65 20 29 0a 09 20 20 20 20 54 48 45  dcase )..    THE
2100: 4e 20 20 65 6e 64 63 61 73 65 0a 20 20 20 20 4c  N  endcase.    L
2110: 4f 4f 50 20 3b 0a 3a 20 2e 70 65 72 6d 61 6e 64  OOP ;.: .permand
2120: 6f 72 20 28 20 70 65 72 6d 61 6e 64 20 70 65 72  or ( permand per
2130: 6d 6f 72 20 2d 2d 20 29 0a 20 20 20 20 30 20 7b  mor -- ).    0 {
2140: 20 2b 2d 20 7d 0a 20 20 20 20 31 20 70 65 72 6d   +- }.    1 perm
2150: 24 20 63 6f 75 6e 74 20 62 6f 75 6e 64 73 20 44  $ count bounds D
2160: 4f 20 20 3e 72 0a 09 6f 76 65 72 20 72 40 20 61  O  >r..over r@ a
2170: 6e 64 20 30 3d 20 49 46 20 20 27 2d 27 20 64 75  nd 0= IF  '-' du
2180: 70 20 2b 2d 20 3c 3e 20 49 46 20 20 64 75 70 20  p +- <> IF  dup 
2190: 74 6f 20 2b 2d 20 65 6d 69 74 0a 09 20 20 20 20  to +- emit..    
21a0: 45 4c 53 45 20 20 64 72 6f 70 20 20 54 48 45 4e  ELSE  drop  THEN
21b0: 20 72 3e 20 20 49 20 63 40 20 65 6d 69 74 20 20   r>  I c@ emit  
21c0: 3e 72 20 54 48 45 4e 0a 09 64 75 70 20 20 72 40  >r THEN..dup  r@
21d0: 20 61 6e 64 20 20 20 20 49 46 20 20 27 2b 27 20   and    IF  '+' 
21e0: 64 75 70 20 2b 2d 20 3c 3e 20 49 46 20 20 64 75  dup +- <> IF  du
21f0: 70 20 74 6f 20 2b 2d 20 65 6d 69 74 0a 09 20 20  p to +- emit..  
2200: 20 20 45 4c 53 45 20 20 64 72 6f 70 20 20 54 48    ELSE  drop  TH
2210: 45 4e 20 72 3e 20 20 49 20 63 40 20 65 6d 69 74  EN r>  I c@ emit
2220: 20 20 3e 72 20 54 48 45 4e 0a 09 72 3e 20 32 2a    >r THEN..r> 2*
2230: 0a 20 20 20 20 4c 4f 4f 50 20 20 64 72 6f 70 20  .    LOOP  drop 
2240: 32 64 72 6f 70 20 3b 0a 0a 5c 20 72 65 61 64 20  2drop ;..\ read 
2250: 69 6e 20 70 65 72 6d 69 73 73 69 6f 6e 20 67 72  in permission gr
2260: 6f 75 70 73 2c 20 67 72 6f 75 70 73 20 69 73 20  oups, groups is 
2270: 69 6e 20 74 68 65 20 2e 6e 65 74 32 6f 20 64 69  in the .net2o di
2280: 72 65 63 74 6f 72 79 0a 0a 3a 20 3e 67 72 6f 75  rectory..: >grou
2290: 70 2d 69 64 20 28 20 61 64 64 72 20 75 20 2d 2d  p-id ( addr u --
22a0: 20 69 64 2f 2d 31 20 29 0a 20 20 20 20 2d 31 20   id/-1 ).    -1 
22b0: 30 20 67 72 6f 75 70 73 5b 5d 20 5b 3a 20 32 73  0 groups[] [: 2s
22c0: 77 61 70 20 32 3e 72 20 32 20 63 65 6c 6c 73 20  wap 2>r 2 cells 
22d0: 2f 73 74 72 69 6e 67 0a 20 20 20 20 20 20 32 6f  /string.      2o
22e0: 76 65 72 20 73 74 72 69 6e 67 2d 70 72 65 66 69  ver string-prefi
22f0: 78 3f 20 49 46 20 20 32 72 3e 20 6e 69 70 20 64  x? IF  2r> nip d
2300: 75 70 0a 20 20 20 20 20 20 45 4c 53 45 20 20 32  up.      ELSE  2
2310: 72 3e 20 20 54 48 45 4e 20 20 31 2b 20 3b 5d 20  r>  THEN  1+ ;] 
2320: 24 5b 5d 6d 61 70 0a 20 20 20 20 32 6e 69 70 20  $[]map.    2nip 
2330: 64 72 6f 70 20 3b 0a 0a 3a 20 3e 67 72 6f 75 70  drop ;..: >group
2340: 73 20 28 20 61 64 64 72 20 75 20 70 61 6e 64 20  s ( addr u pand 
2350: 70 6f 72 20 2d 2d 20 29 0a 20 20 20 20 73 22 20  por -- ).    s" 
2360: 22 20 67 72 6f 75 70 73 5b 5d 20 24 2b 5b 5d 21  " groups[] $+[]!
2370: 0a 20 20 20 20 5b 3a 20 7b 20 64 5e 20 70 61 6e  .    [: { d^ pan
2380: 64 6f 72 20 7d 20 70 61 6e 64 6f 72 20 32 20 63  dor } pandor 2 c
2390: 65 6c 6c 73 20 74 79 70 65 20 20 74 79 70 65 20  ells type  type 
23a0: 3b 5d 0a 20 20 20 20 67 72 6f 75 70 73 5b 5d 20  ;].    groups[] 
23b0: 64 75 70 20 24 5b 5d 23 20 31 2d 20 73 77 61 70  dup $[]# 1- swap
23c0: 20 24 5b 5d 20 24 65 78 65 63 20 3b 0a 0a 3a 20   $[] $exec ;..: 
23d0: 69 6e 69 74 2d 67 72 6f 75 70 73 20 28 20 2d 2d  init-groups ( --
23e0: 20 29 0a 20 20 20 20 22 6d 79 73 65 6c 66 22 20   ).    "myself" 
23f0: 20 70 65 72 6d 25 6d 79 73 65 6c 66 20 20 64 75   perm%myself  du
2400: 70 20 3e 67 72 6f 75 70 73 0a 20 20 20 20 22 70  p >groups.    "p
2410: 65 65 72 22 20 20 20 20 70 65 72 6d 25 64 65 66  eer"    perm%def
2420: 61 75 6c 74 20 64 75 70 20 3e 67 72 6f 75 70 73  ault dup >groups
2430: 0a 20 20 20 20 22 64 68 74 22 20 20 20 20 20 70  .    "dht"     p
2440: 65 72 6d 25 64 68 74 72 6f 6f 74 20 64 75 70 20  erm%dhtroot dup 
2450: 3e 67 72 6f 75 70 73 0a 20 20 20 20 22 75 6e 6b  >groups.    "unk
2460: 6e 6f 77 6e 22 20 70 65 72 6d 25 75 6e 6b 6e 6f  nown" perm%unkno
2470: 77 6e 20 64 75 70 20 3e 67 72 6f 75 70 73 0a 20  wn dup >groups. 
2480: 20 20 20 22 62 6c 6f 63 6b 65 64 22 20 70 65 72     "blocked" per
2490: 6d 25 62 6c 6f 63 6b 65 64 20 70 65 72 6d 25 69  m%blocked perm%i
24a0: 6e 64 69 72 65 63 74 20 6f 72 20 64 75 70 20 3e  ndirect or dup >
24b0: 67 72 6f 75 70 73 20 3b 0a 0a 3a 20 2e 67 72 6f  groups ;..: .gro
24c0: 75 70 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 67  ups ( -- ).    g
24d0: 72 6f 75 70 73 5b 5d 20 5b 3a 20 32 64 75 70 20  roups[] [: 2dup 
24e0: 32 20 63 65 6c 6c 73 20 2f 73 74 72 69 6e 67 20  2 cells /string 
24f0: 74 79 70 65 20 73 70 61 63 65 0a 20 20 20 20 20  type space.     
2500: 20 64 72 6f 70 20 32 40 20 2e 70 65 72 6d 61 6e   drop 2@ .perman
2510: 64 6f 72 20 63 72 20 3b 5d 20 24 5b 5d 6d 61 70  dor cr ;] $[]map
2520: 20 3b 0a 0a 3a 20 2e 69 6e 2d 67 72 6f 75 70 73   ;..: .in-groups
2530: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20   ( addr u -- ). 
2540: 20 20 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49     bounds ?DO..I
2550: 20 70 40 2b 20 49 20 2d 20 3e 72 20 36 34 3e 6e   p@+ I - >r 64>n
2560: 20 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 40 20 32   groups[] $[]@ 2
2570: 20 63 65 6c 6c 73 20 2f 73 74 72 69 6e 67 20 73   cells /string s
2580: 70 61 63 65 20 74 79 70 65 0a 20 20 20 20 72 3e  pace type.    r>
2590: 20 2b 4c 4f 4f 50 20 3b 0a 0a 3a 20 77 72 69 74   +LOOP ;..: writ
25a0: 65 2d 67 72 6f 75 70 73 20 28 20 2d 2d 20 29 0a  e-groups ( -- ).
25b0: 20 20 20 20 5b 3a 20 2e 22 20 67 72 6f 75 70 73      [: ." groups
25c0: 2b 22 20 67 65 74 70 69 64 20 30 20 2e 72 20 3b  +" getpid 0 .r ;
25d0: 5d 20 24 74 6d 70 20 2e 6e 65 74 32 6f 2f 20 32  ] $tmp .net2o/ 2
25e0: 64 75 70 20 77 2f 6f 20 63 72 65 61 74 65 2d 66  dup w/o create-f
25f0: 69 6c 65 20 74 68 72 6f 77 20 3e 72 0a 20 20 20  ile throw >r.   
2600: 20 5b 27 5d 20 2e 67 72 6f 75 70 73 20 72 40 20   ['] .groups r@ 
2610: 6f 75 74 66 69 6c 65 2d 65 78 65 63 75 74 65 0a  outfile-execute.
2620: 20 20 20 20 72 3e 20 63 6c 6f 73 65 2d 66 69 6c      r> close-fil
2630: 65 20 74 68 72 6f 77 20 27 2b 27 20 2d 73 63 61  e throw '+' -sca
2640: 6e 20 31 2d 20 3e 62 61 63 6b 75 70 20 3b 0a 0a  n 1- >backup ;..
2650: 3a 20 67 72 6f 75 70 2d 6c 69 6e 65 20 28 20 2d  : group-line ( -
2660: 2d 20 29 0a 20 20 20 20 70 61 72 73 65 2d 6e 61  - ).    parse-na
2670: 6d 65 20 70 61 72 73 65 2d 6e 61 6d 65 20 3e 70  me parse-name >p
2680: 65 72 6d 20 3e 67 72 6f 75 70 73 20 3b 0a 0a 3a  erm >groups ;..:
2690: 20 72 65 61 64 2d 67 72 6f 75 70 73 2d 6c 6f 6f   read-groups-loo
26a0: 70 20 28 20 2d 2d 20 29 0a 20 20 20 20 42 45 47  p ( -- ).    BEG
26b0: 49 4e 20 20 72 65 66 69 6c 6c 20 20 57 48 49 4c  IN  refill  WHIL
26c0: 45 20 20 67 72 6f 75 70 2d 6c 69 6e 65 20 20 52  E  group-line  R
26d0: 45 50 45 41 54 20 3b 0a 0a 3a 20 72 65 61 64 2d  EPEAT ;..: read-
26e0: 67 72 6f 75 70 73 20 28 20 2d 2d 20 29 0a 20 20  groups ( -- ).  
26f0: 20 20 22 67 72 6f 75 70 73 22 20 2e 6e 65 74 32    "groups" .net2
2700: 6f 2f 20 32 64 75 70 20 66 69 6c 65 2d 73 74 61  o/ 2dup file-sta
2710: 74 75 73 20 6e 69 70 20 6e 6f 2d 66 69 6c 65 23  tus nip no-file#
2720: 20 3d 20 49 46 0a 09 69 6e 69 74 2d 67 72 6f 75   = IF..init-grou
2730: 70 73 20 77 72 69 74 65 2d 67 72 6f 75 70 73 20  ps write-groups 
2740: 32 64 72 6f 70 20 20 45 58 49 54 0a 20 20 20 20  2drop  EXIT.    
2750: 54 48 45 4e 20 20 3e 69 6e 63 6c 75 64 65 64 20  THEN  >included 
2760: 74 68 72 6f 77 0a 20 20 20 20 5b 27 5d 20 72 65  throw.    ['] re
2770: 61 64 2d 67 72 6f 75 70 73 2d 6c 6f 6f 70 20 65  ad-groups-loop e
2780: 78 65 63 75 74 65 2d 70 61 72 73 69 6e 67 2d 6e  xecute-parsing-n
2790: 61 6d 65 64 2d 66 69 6c 65 20 3b 0a 0a 3a 20 67  amed-file ;..: g
27a0: 72 6f 75 70 73 3e 6d 61 73 6b 20 28 20 61 64 64  roups>mask ( add
27b0: 72 20 75 20 2d 2d 20 6d 61 73 6b 20 29 0a 20 20  r u -- mask ).  
27c0: 20 20 30 20 2d 72 6f 74 20 62 6f 75 6e 64 73 20    0 -rot bounds 
27d0: 3f 44 4f 0a 09 49 20 70 40 2b 20 49 20 2d 20 3e  ?DO..I p@+ I - >
27e0: 72 0a 09 36 34 3e 6e 20 64 75 70 20 67 72 6f 75  r..64>n dup grou
27f0: 70 73 5b 5d 20 24 5b 5d 23 20 75 3e 3d 20 21 21  ps[] $[]# u>= !!
2800: 6e 6f 2d 67 72 6f 75 70 21 21 0a 09 67 72 6f 75  no-group!!..grou
2810: 70 73 5b 5d 20 24 5b 5d 40 20 64 72 6f 70 20 32  ps[] $[]@ drop 2
2820: 40 20 3e 72 20 61 6e 64 20 72 3e 20 6f 72 0a 20  @ >r and r> or. 
2830: 20 20 20 72 3e 20 2b 4c 4f 4f 50 20 3b 0a 0a 3a     r> +LOOP ;..:
2840: 20 3f 3e 67 72 6f 75 70 73 20 28 20 6d 61 73 6b   ?>groups ( mask
2850: 20 2d 2d 20 6d 61 73 6b 27 20 29 0a 20 20 20 20   -- mask' ).    
2860: 6b 65 2d 67 72 6f 75 70 73 20 24 40 6c 65 6e 20  ke-groups $@len 
2870: 30 3d 20 49 46 0a 09 67 72 6f 75 70 73 5b 5d 20  0= IF..groups[] 
2880: 24 5b 5d 23 20 30 20 44 4f 0a 09 20 20 20 20 64  $[]# 0 DO..    d
2890: 75 70 20 49 20 67 72 6f 75 70 73 5b 5d 20 24 5b  up I groups[] $[
28a0: 5d 40 20 64 72 6f 70 20 40 0a 09 20 20 20 20 6f  ]@ drop @..    o
28b0: 72 20 6f 76 65 72 20 3d 20 49 46 0a 09 09 49 20  r over = IF...I 
28c0: 6b 65 2d 67 72 6f 75 70 73 20 63 24 2b 21 0a 09  ke-groups c$+!..
28d0: 09 49 20 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 40  .I groups[] $[]@
28e0: 20 64 72 6f 70 20 63 65 6c 6c 2b 20 40 20 69 6e   drop cell+ @ in
28f0: 76 65 72 74 20 61 6e 64 0a 09 20 20 20 20 54 48  vert and..    TH
2900: 45 4e 0a 09 4c 4f 4f 50 0a 20 20 20 20 54 48 45  EN..LOOP.    THE
2910: 4e 20 20 64 72 6f 70 20 3b 0a 0a 3a 6e 6f 6e 61  N  drop ;..:nona
2920: 6d 65 20 64 65 66 65 72 73 20 27 63 6f 6c 64 20  me defers 'cold 
2930: 20 67 72 6f 75 70 73 5b 5d 20 6f 66 66 20 72 65   groups[] off re
2940: 61 64 2d 67 72 6f 75 70 73 20 3b 20 69 73 20 27  ad-groups ; is '
2950: 63 6f 6c 64 0a 0a 5c 20 6b 65 79 20 64 69 73 70  cold..\ key disp
2960: 6c 61 79 0a 0a 5b 49 46 55 4e 44 45 46 5d 20 6d  lay..[IFUNDEF] m
2970: 61 67 65 6e 74 61 20 20 62 72 6f 77 6e 20 63 6f  agenta  brown co
2980: 6e 73 74 61 6e 74 20 6d 61 67 65 6e 74 61 20 5b  nstant magenta [
2990: 54 48 45 4e 5d 0a 5b 49 46 44 45 46 5d 20 67 6c  THEN].[IFDEF] gl
29a0: 2d 74 79 70 65 20 3a 20 62 67 7c 20 3e 62 67 20  -type : bg| >bg 
29b0: 6f 72 20 3b 20 5b 45 4c 53 45 5d 20 3a 20 62 67  or ; [ELSE] : bg
29c0: 7c 20 64 72 6f 70 20 3b 20 5b 54 48 45 4e 5d 0a  | drop ; [THEN].
29d0: 0a 43 72 65 61 74 65 20 38 35 63 6f 6c 6f 72 73  .Create 85colors
29e0: 2d 62 77 0a 30 20 2c 20 69 6e 76 65 72 73 20 2c  -bw.0 , invers ,
29f0: 0a 69 6e 76 65 72 73 20 2c 20 30 20 2c 0a 30 20  .invers , 0 ,.0 
2a00: 2c 20 69 6e 76 65 72 73 20 2c 0a 69 6e 76 65 72  , invers ,.inver
2a10: 73 20 2c 20 30 20 2c 0a 43 72 65 61 74 65 20 38  s , 0 ,.Create 8
2a20: 35 63 6f 6c 6f 72 73 2d 63 6c 0a 79 65 6c 6c 6f  5colors-cl.yello
2a30: 77 20 3e 66 67 20 62 6c 75 65 20 3e 62 67 20 6f  w >fg blue >bg o
2a40: 72 20 62 6f 6c 64 20 6f 72 20 2c 20 72 65 64 20  r bold or , red 
2a50: 3e 66 67 20 77 68 69 74 65 20 62 67 7c 20 2c 0a  >fg white bg| ,.
2a60: 62 6c 61 63 6b 20 3e 66 67 20 63 79 61 6e 20 62  black >fg cyan b
2a70: 67 7c 20 2c 20 67 72 65 65 6e 20 3e 66 67 20 62  g| , green >fg b
2a80: 6c 61 63 6b 20 3e 62 67 20 6f 72 20 62 6f 6c 64  lack >bg or bold
2a90: 20 6f 72 20 2c 0a 77 68 69 74 65 20 3e 66 67 20   or ,.white >fg 
2aa0: 62 6c 61 63 6b 20 3e 62 67 20 6f 72 20 62 6f 6c  black >bg or bol
2ab0: 64 20 6f 72 20 2c 20 6d 61 67 65 6e 74 61 20 3e  d or , magenta >
2ac0: 66 67 20 79 65 6c 6c 6f 77 20 62 67 7c 20 2c 0a  fg yellow bg| ,.
2ad0: 62 6c 75 65 20 3e 66 67 20 79 65 6c 6c 6f 77 20  blue >fg yellow 
2ae0: 62 67 7c 20 2c 20 63 79 61 6e 20 3e 66 67 20 72  bg| , cyan >fg r
2af0: 65 64 20 3e 62 67 20 6f 72 20 62 6f 6c 64 20 6f  ed >bg or bold o
2b00: 72 20 2c 0a 0a 5b 49 46 44 45 46 5d 20 67 6c 2d  r ,..[IFDEF] gl-
2b10: 74 79 70 65 20 38 35 63 6f 6c 6f 72 73 2d 63 6c  type 85colors-cl
2b20: 20 5b 45 4c 53 45 5d 20 38 35 63 6f 6c 6f 72 73   [ELSE] 85colors
2b30: 2d 62 77 20 5b 54 48 45 4e 5d 20 56 61 6c 75 65  -bw [THEN] Value
2b40: 20 38 35 63 6f 6c 6f 72 73 0a 0a 3a 20 2e 73 74   85colors..: .st
2b50: 72 69 70 65 38 35 20 28 20 61 64 64 72 20 75 20  ripe85 ( addr u 
2b60: 2d 2d 20 29 20 20 30 20 2d 72 6f 74 20 62 6f 75  -- )  0 -rot bou
2b70: 6e 64 73 20 3f 44 4f 0a 09 64 75 70 20 63 65 6c  nds ?DO..dup cel
2b80: 6c 73 20 38 35 63 6f 6c 6f 72 73 20 2b 20 40 20  ls 85colors + @ 
2b90: 61 74 74 72 21 20 31 2b 0a 09 49 20 34 20 38 35  attr! 1+..I 4 85
2ba0: 74 79 70 65 20 20 64 75 70 20 63 65 6c 6c 73 20  type  dup cells 
2bb0: 38 35 63 6f 6c 6f 72 73 20 2b 20 40 20 61 74 74  85colors + @ att
2bc0: 72 21 20 31 2b 0a 20 20 20 20 49 20 34 20 2b 20  r! 1+.    I 4 + 
2bd0: 34 20 38 35 74 79 70 65 20 3c 64 65 66 61 75 6c  4 85type <defaul
2be0: 74 3e 20 63 72 20 38 20 2b 4c 4f 4f 50 20 20 64  t> cr 8 +LOOP  d
2bf0: 72 6f 70 20 3b 0a 3a 20 2e 69 6d 70 6f 72 74 38  rop ;.: .import8
2c00: 35 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a  5 ( addr u -- ).
2c10: 20 20 20 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40      ke-imports @
2c20: 20 3e 69 6d 2d 63 6f 6c 6f 72 20 38 35 74 79 70   >im-color 85typ
2c30: 65 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 3a 20  e <default> ;.: 
2c40: 2e 72 73 6b 20 28 20 6e 69 63 6b 20 75 20 2d 2d  .rsk ( nick u --
2c50: 20 29 0a 20 20 20 20 73 6b 72 65 76 20 24 32 30   ).    skrev $20
2c60: 20 2e 73 74 72 69 70 65 38 35 20 73 70 61 63 65   .stripe85 space
2c70: 20 74 79 70 65 20 2e 22 20 20 28 6b 65 65 70 20   type ."  (keep 
2c80: 6f 66 66 6c 69 6e 65 20 63 6f 70 79 21 29 22 20  offline copy!)" 
2c90: 63 72 20 3b 0a 3a 20 2e 6b 65 79 20 28 20 61 64  cr ;.: .key ( ad
2ca0: 64 72 20 75 20 2d 2d 20 29 20 64 72 6f 70 20 63  dr u -- ) drop c
2cb0: 65 6c 6c 2b 20 3e 6f 0a 20 20 20 20 2e 22 20 6e  ell+ >o.    ." n
2cc0: 69 63 6b 3a 20 20 20 22 20 2e 6e 69 63 6b 20 63  ick:   " .nick c
2cd0: 72 0a 20 20 20 20 2e 22 20 70 75 62 6b 65 79 3a  r.    ." pubkey:
2ce0: 20 22 20 6b 65 2d 70 6b 20 24 40 20 38 35 74 79   " ke-pk $@ 85ty
2cf0: 70 65 20 63 72 0a 20 20 20 20 6b 65 2d 73 6b 20  pe cr.    ke-sk 
2d00: 40 20 49 46 0a 09 2e 22 20 73 65 63 6b 65 79 3a  @ IF..." seckey:
2d10: 20 22 20 6b 65 2d 73 6b 20 73 65 63 40 20 2e 62   " ke-sk sec@ .b
2d20: 6c 61 63 6b 38 35 20 2e 22 20 20 28 6b 65 65 70  lack85 ."  (keep
2d30: 20 73 65 63 72 65 74 21 29 22 20 63 72 20 20 54   secret!)" cr  T
2d40: 48 45 4e 0a 20 20 20 20 2e 22 20 76 61 6c 69 64  HEN.    ." valid
2d50: 3a 20 20 22 20 6b 65 2d 73 65 6c 66 73 69 67 20  :  " ke-selfsig 
2d60: 24 40 20 2e 73 69 67 64 61 74 65 73 20 63 72 0a  $@ .sigdates cr.
2d70: 20 20 20 20 2e 22 20 67 72 6f 75 70 73 3a 20 22      ." groups: "
2d80: 20 6b 65 2d 67 72 6f 75 70 73 20 24 40 20 2e 69   ke-groups $@ .i
2d90: 6e 2d 67 72 6f 75 70 73 20 63 72 0a 20 20 20 20  n-groups cr.    
2da0: 2e 22 20 70 65 72 6d 3a 20 20 20 22 20 6b 65 2d  ." perm:   " ke-
2db0: 6d 61 73 6b 20 40 20 2e 70 65 72 6d 20 63 72 0a  mask @ .perm cr.
2dc0: 20 20 20 20 6f 3e 20 3b 0a 3a 20 2e 6b 65 79 2d      o> ;.: .key-
2dd0: 72 65 73 74 20 28 20 6f 3a 6b 65 79 20 2d 2d 20  rest ( o:key -- 
2de0: 6f 3a 6b 65 79 20 29 0a 20 20 20 20 6b 65 2d 70  o:key ).    ke-p
2df0: 6b 20 24 40 20 6b 65 79 7c 20 2e 69 6d 70 6f 72  k $@ key| .impor
2e00: 74 38 35 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73  t85.    ke-selfs
2e10: 69 67 20 24 40 20 73 70 61 63 65 20 2e 73 69 67  ig $@ space .sig
2e20: 64 61 74 65 73 0a 20 20 20 20 6b 65 2d 67 72 6f  dates.    ke-gro
2e30: 75 70 73 20 24 40 20 32 64 75 70 20 2e 69 6e 2d  ups $@ 2dup .in-
2e40: 67 72 6f 75 70 73 20 67 72 6f 75 70 73 3e 6d 61  groups groups>ma
2e50: 73 6b 20 69 6e 76 65 72 74 0a 20 20 20 20 73 70  sk invert.    sp
2e60: 61 63 65 20 6b 65 2d 6d 61 73 6b 20 40 20 61 6e  ace ke-mask @ an
2e70: 64 20 2d 31 20 73 77 61 70 20 2e 70 65 72 6d 61  d -1 swap .perma
2e80: 6e 64 6f 72 0a 20 20 20 20 23 74 61 62 20 65 6d  ndor.    #tab em
2e90: 69 74 20 6b 65 2d 69 6d 70 6f 72 74 73 20 40 20  it ke-imports @ 
2ea0: 2e 69 6d 70 6f 72 74 73 0a 20 20 20 20 73 70 61  .imports.    spa
2eb0: 63 65 20 2e 6e 69 63 6b 2b 70 65 74 20 3b 0a 3a  ce .nick+pet ;.:
2ec0: 20 2e 6b 65 79 2d 6c 69 73 74 20 28 20 6f 3a 6b   .key-list ( o:k
2ed0: 65 79 20 2d 2d 20 6f 3a 6b 65 79 20 29 0a 20 20  ey -- o:key ).  
2ee0: 20 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 40 20    ke-offset 64@ 
2ef0: 36 34 3e 64 20 6b 65 79 70 61 63 6b 2d 61 6c 6c  64>d keypack-all
2f00: 23 20 66 6d 2f 6d 6f 64 20 6e 69 70 20 33 20 2e  # fm/mod nip 3 .
2f10: 72 20 73 70 61 63 65 0a 20 20 20 20 2e 6b 65 79  r space.    .key
2f20: 2d 72 65 73 74 20 63 72 20 3b 0a 3a 20 2e 73 65  -rest cr ;.: .se
2f30: 63 72 65 74 2d 6e 69 63 6b 73 20 28 20 2d 2d 20  cret-nicks ( -- 
2f40: 29 0a 20 20 20 20 30 20 6b 65 79 23 20 5b 3a 20  ).    0 key# [: 
2f50: 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 20 63 65  cell+ $@ drop ce
2f60: 6c 6c 2b 20 3e 6f 20 6b 65 2d 73 6b 20 40 20 49  ll+ >o ke-sk @ I
2f70: 46 0a 09 20 20 5b 3a 20 64 75 70 20 31 20 2e 72  F..  [: dup 1 .r
2f80: 20 3b 5d 20 23 33 36 20 62 61 73 65 2d 65 78 65   ;] #36 base-exe
2f90: 63 75 74 65 20 73 70 61 63 65 20 2e 6b 65 79 2d  cute space .key-
2fa0: 72 65 73 74 20 63 72 20 31 2b 0a 20 20 20 20 20  rest cr 1+.     
2fb0: 20 54 48 45 4e 20 6f 3e 20 3b 5d 20 23 6d 61 70   THEN o> ;] #map
2fc0: 20 64 72 6f 70 20 3b 0a 3a 20 2e 6b 65 79 2d 69   drop ;.: .key-i
2fd0: 6e 76 69 74 65 20 28 20 6f 3a 6b 65 79 20 2d 2d  nvite ( o:key --
2fe0: 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 6b 65 2d   o:key ).    ke-
2ff0: 70 6b 20 24 40 20 6b 65 79 73 69 7a 65 20 75 6d  pk $@ keysize um
3000: 69 6e 0a 20 20 20 20 6b 65 2d 69 6d 70 6f 72 74  in.    ke-import
3010: 73 20 40 20 3e 69 6d 2d 63 6f 6c 6f 72 20 38 35  s @ >im-color 85
3020: 74 79 70 65 20 3c 64 65 66 61 75 6c 74 3e 0a 20  type <default>. 
3030: 20 20 20 73 70 61 63 65 20 2e 6e 69 63 6b 20 73     space .nick s
3040: 70 61 63 65 20 3b 0a 3a 20 2e 6b 65 79 2d 73 68  pace ;.: .key-sh
3050: 6f 72 74 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 6f  ort ( o:key -- o
3060: 3a 6b 65 79 20 29 0a 20 20 20 20 6b 65 2d 6e 69  :key ).    ke-ni
3070: 63 6b 20 24 2e 20 6b 65 2d 70 72 6f 66 20 24 40  ck $. ke-prof $@
3080: 6c 65 6e 20 49 46 20 2e 22 20 20 70 72 6f 66 69  len IF ."  profi
3090: 6c 65 3a 20 22 20 6b 65 2d 70 72 6f 66 20 24 40  le: " ke-prof $@
30a0: 20 38 35 74 79 70 65 20 54 48 45 4e 20 3b 0a 3a   85type THEN ;.:
30b0: 20 6c 69 73 74 2d 6b 65 79 73 20 28 20 2d 2d 20   list-keys ( -- 
30c0: 29 0a 20 20 20 20 2e 22 20 6e 75 6d 20 70 75 62  ).    ." num pub
30d0: 6b 65 79 20 20 20 20 20 20 20 20 20 20 20 20 20  key             
30e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
30f0: 20 20 20 20 20 20 64 61 74 65 20 20 20 20 20 20        date      
3100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67                 g
3110: 72 70 2b 70 65 72 6d 09 68 20 6e 69 63 6b 22 20  rp+perm.h nick" 
3120: 63 72 0a 20 20 20 20 6b 65 79 23 20 5b 3a 20 63  cr.    key# [: c
3130: 65 6c 6c 2b 20 24 40 20 64 72 6f 70 20 63 65 6c  ell+ $@ drop cel
3140: 6c 2b 20 2e 2e 6b 65 79 2d 6c 69 73 74 20 3b 5d  l+ ..key-list ;]
3150: 20 23 6d 61 70 20 3b 0a 3a 20 6c 69 73 74 2d 6e   #map ;.: list-n
3160: 69 63 6b 73 20 28 20 2d 2d 20 29 0a 20 20 20 20  icks ( -- ).    
3170: 6e 69 63 6b 23 20 5b 3a 20 64 75 70 20 24 2e 20  nick# [: dup $. 
3180: 2e 22 20 3a 22 20 63 72 20 63 65 6c 6c 2b 20 24  ." :" cr cell+ $
3190: 40 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 20 20  @ bounds ?DO..  
31a0: 49 20 40 20 2e 2e 6b 65 79 2d 6c 69 73 74 20 20  I @ ..key-list  
31b0: 63 65 6c 6c 20 2b 4c 4f 4f 50 20 3b 5d 20 23 6d  cell +LOOP ;] #m
31c0: 61 70 20 3b 0a 0a 3a 20 64 75 6d 70 6b 65 79 20  ap ;..: dumpkey 
31d0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 64 72  ( addr u -- ) dr
31e0: 6f 70 20 63 65 6c 6c 2b 20 3e 6f 0a 20 20 20 20  op cell+ >o.    
31f0: 2e 5c 22 20 78 5c 22 20 22 20 6b 65 2d 70 6b 20  .\" x\" " ke-pk 
3200: 24 40 20 38 35 74 79 70 65 20 2e 5c 22 20 5c 22  $@ 85type .\" \"
3210: 20 6b 65 79 3f 6e 65 77 22 20 63 72 0a 20 20 20   key?new" cr.   
3220: 20 6b 65 2d 73 6b 20 40 20 49 46 20 20 2e 5c 22   ke-sk @ IF  .\"
3230: 20 78 5c 22 20 22 20 6b 65 2d 73 6b 20 40 20 6b   x\" " ke-sk @ k
3240: 65 79 73 69 7a 65 20 38 35 74 79 70 65 20 2e 5c  eysize 85type .\
3250: 22 20 5c 22 20 6b 65 2d 73 6b 20 73 65 63 21 20  " \" ke-sk sec! 
3260: 2b 73 65 63 6b 65 79 22 20 63 72 20 20 54 48 45  +seckey" cr  THE
3270: 4e 0a 20 20 20 20 27 22 27 20 65 6d 69 74 20 2e  N.    '"' emit .
3280: 6e 69 63 6b 20 2e 5c 22 20 5c 22 20 6b 65 2d 6e  nick .\" \" ke-n
3290: 69 63 6b 20 24 21 20 22 0a 20 20 20 20 6b 65 2d  ick $! ".    ke-
32a0: 73 65 6c 66 73 69 67 20 24 40 20 64 72 6f 70 20  selfsig $@ drop 
32b0: 36 34 40 20 36 34 3e 64 20 5b 3a 20 27 24 27 20  64@ 64>d [: '$' 
32c0: 65 6d 69 74 20 30 20 75 64 2e 72 20 3b 5d 20 24  emit 0 ud.r ;] $
32d0: 31 30 20 62 61 73 65 2d 65 78 65 63 75 74 65 0a  10 base-execute.
32e0: 20 20 20 20 2e 22 20 2e 20 64 3e 36 34 20 6b 65      ." . d>64 ke
32f0: 2d 66 69 72 73 74 21 20 22 20 6b 65 2d 74 79 70  -first! " ke-typ
3300: 65 20 40 20 2e 20 2e 22 20 6b 65 2d 74 79 70 65  e @ . ." ke-type
3310: 20 21 22 20 20 63 72 20 6f 3e 20 3b 0a 0a 3a 20   !"  cr o> ;..: 
3320: 2e 6b 65 79 73 20 28 20 2d 2d 20 29 20 6b 65 79  .keys ( -- ) key
3330: 23 20 5b 3a 20 2e 22 20 69 6e 64 65 78 3a 20 22  # [: ." index: "
3340: 20 64 75 70 20 24 40 20 38 35 74 79 70 65 20 63   dup $@ 85type c
3350: 72 20 63 65 6c 6c 2b 20 24 40 20 2e 6b 65 79 20  r cell+ $@ .key 
3360: 3b 5d 20 23 6d 61 70 20 3b 0a 3a 20 64 75 6d 70  ;] #map ;.: dump
3370: 6b 65 79 73 20 28 20 2d 2d 20 29 20 6b 65 79 23  keys ( -- ) key#
3380: 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 75 6d   [: cell+ $@ dum
3390: 70 6b 65 79 20 3b 5d 20 23 6d 61 70 20 3b 0a 0a  pkey ;] #map ;..
33a0: 3a 20 6b 65 79 3e 6e 69 63 6b 20 28 20 61 64 64  : key>nick ( add
33b0: 72 6b 65 79 20 75 31 20 2d 2d 20 6e 69 63 6b 20  rkey u1 -- nick 
33c0: 75 32 20 29 0a 20 20 20 20 5c 47 20 63 6f 6e 76  u2 ).    \G conv
33d0: 65 72 74 20 6b 65 79 20 74 6f 20 6e 69 63 6b 0a  ert key to nick.
33e0: 20 20 20 20 6b 65 79 7c 20 6b 65 79 23 20 23 40      key| key# #@
33f0: 20 30 3d 20 49 46 20 20 64 72 6f 70 20 23 30 2e   0= IF  drop #0.
3400: 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20    EXIT  THEN.   
3410: 20 63 65 6c 6c 2b 20 2e 6b 65 2d 6e 69 63 6b 20   cell+ .ke-nick 
3420: 24 40 20 3b 0a 3a 20 6b 65 79 3e 6b 65 79 20 28  $@ ;.: key>key (
3430: 20 61 64 64 72 6b 65 79 20 75 31 20 2d 2d 20 6b   addrkey u1 -- k
3440: 65 79 20 75 32 20 29 0a 20 20 20 20 5c 47 20 65  ey u2 ).    \G e
3450: 78 70 61 6e 64 20 6b 65 79 20 74 6f 20 66 75 6c  xpand key to ful
3460: 6c 20 73 69 7a 65 20 61 6e 64 20 63 68 65 63 6b  l size and check
3470: 20 69 66 20 77 65 20 6b 6e 6f 77 20 69 74 0a 20   if we know it. 
3480: 20 20 20 6b 65 79 7c 20 6b 65 79 23 20 23 40 20     key| key# #@ 
3490: 30 3d 20 49 46 20 20 64 72 6f 70 20 23 30 2e 20  0= IF  drop #0. 
34a0: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20   EXIT  THEN.    
34b0: 63 65 6c 6c 2b 20 2e 6b 65 2d 70 6b 20 24 40 20  cell+ .ke-pk $@ 
34c0: 3b 0a 0a 3a 20 2e 6b 65 79 23 20 28 20 61 64 64  ;..: .key# ( add
34d0: 72 20 75 20 2d 2d 20 29 20 6b 65 79 7c 0a 20 20  r u -- ) key|.  
34e0: 20 20 2e 22 20 4b 65 79 20 27 22 20 6b 65 79 23    ." Key '" key#
34f0: 20 23 40 20 30 3d 20 49 46 20 64 72 6f 70 20 45   #@ 0= IF drop E
3500: 58 49 54 20 54 48 45 4e 0a 20 20 20 20 63 65 6c  XIT THEN.    cel
3510: 6c 2b 20 2e 2e 6e 69 63 6b 20 2e 22 20 27 20 6f  l+ ..nick ." ' o
3520: 6b 22 20 63 72 20 3b 0a 0a 44 65 66 65 72 20 64  k" cr ;..Defer d
3530: 68 74 2d 6e 69 63 6b 3f 0a 65 76 65 6e 74 3a 20  ht-nick?.event: 
3540: 2d 3e 73 65 61 72 63 68 2d 6b 65 79 20 20 6b 65  ->search-key  ke
3550: 79 7c 20 6f 76 65 72 20 3e 72 20 64 68 74 2d 6e  y| over >r dht-n
3560: 69 63 6b 3f 20 72 3e 20 66 72 65 65 20 74 68 72  ick? r> free thr
3570: 6f 77 20 3b 0a 0a 3a 20 2e 75 6e 6b 65 79 2d 69  ow ;..: .unkey-i
3580: 64 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20  d ( addr u -- ) 
3590: 3c 65 72 72 3e 20 38 20 75 6d 69 6e 20 38 35 74  <err> 8 umin 85t
35a0: 79 70 65 20 2e 22 20 28 75 6e 6b 6e 6f 77 6e 29  ype ." (unknown)
35b0: 22 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 0a 56  " <default> ;..V
35c0: 61 72 69 61 62 6c 65 20 75 6e 6b 65 79 2d 69 64  ariable unkey-id
35d0: 23 0a 23 36 30 2e 30 30 30 2e 30 30 30 2e 30 30  #.#60.000.000.00
35e0: 30 20 64 3e 36 34 20 36 34 43 6f 6e 73 74 61 6e  0 d>64 64Constan
35f0: 74 20 75 6e 6b 65 79 2d 74 6f 23 0a 3a 20 3f 75  t unkey-to#.: ?u
3600: 6e 6b 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d  nkey ( addr u --
3610: 20 66 6c 61 67 20 29 0a 20 20 20 20 75 6e 6b 65   flag ).    unke
3620: 79 2d 69 64 23 20 23 40 0a 20 20 20 20 49 46 20  y-id# #@.    IF 
3630: 20 36 34 40 20 75 6e 6b 65 79 2d 74 6f 23 20 36   64@ unkey-to# 6
3640: 34 2b 20 74 69 63 6b 73 20 36 34 2d 20 36 34 2d  4+ ticks 64- 64-
3650: 30 3e 3d 20 20 54 48 45 4e 20 20 30 3d 20 3b 0a  0>=  THEN  0= ;.
3660: 20 20 20 20 0a 3a 20 2e 6b 65 79 2d 69 64 20 28      .: .key-id (
3670: 20 61 64 64 72 20 75 20 2d 2d 20 29 20 6b 65 79   addr u -- ) key
3680: 7c 20 32 64 75 70 20 6b 65 79 23 20 23 40 20 30  | 2dup key# #@ 0
3690: 3d 0a 20 20 20 20 49 46 20 20 64 72 6f 70 20 75  =.    IF  drop u
36a0: 70 40 20 72 65 63 65 69 76 65 72 2d 74 61 73 6b  p@ receiver-task
36b0: 20 3d 20 49 46 0a 09 20 20 20 20 3c 65 76 65 6e   = IF..    <even
36c0: 74 20 32 64 75 70 20 73 61 76 65 2d 6d 65 6d 20  t 2dup save-mem 
36d0: 65 24 2c 20 2d 3e 73 65 61 72 63 68 2d 6b 65 79  e$, ->search-key
36e0: 20 6d 61 69 6e 2d 75 70 40 20 65 76 65 6e 74 3e   main-up@ event>
36f0: 0a 09 20 20 20 20 2e 75 6e 6b 65 79 2d 69 64 20  ..    .unkey-id 
3700: 45 58 49 54 20 20 54 48 45 4e 0a 09 32 64 75 70  EXIT  THEN..2dup
3710: 20 3f 75 6e 6b 65 79 20 20 49 46 0a 09 20 20 20   ?unkey  IF..   
3720: 20 74 69 63 6b 73 20 7b 20 36 34 5e 20 74 78 20   ticks { 64^ tx 
3730: 7d 20 74 78 20 31 20 36 34 73 20 32 6f 76 65 72  } tx 1 64s 2over
3740: 20 75 6e 6b 65 79 2d 69 64 23 20 23 21 0a 09 20   unkey-id# #!.. 
3750: 20 20 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 3e 72     connection >r
3760: 20 32 64 75 70 20 5b 27 5d 20 64 68 74 2d 6e 69   2dup ['] dht-ni
3770: 63 6b 3f 20 63 6d 64 2d 6e 65 73 74 20 72 3e 20  ck? cmd-nest r> 
3780: 74 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e 0a 09 20  to connection.. 
3790: 20 20 20 32 64 75 70 20 6b 65 79 23 20 23 40 20     2dup key# #@ 
37a0: 30 3d 20 49 46 20 20 64 72 6f 70 20 2e 75 6e 6b  0= IF  drop .unk
37b0: 65 79 2d 69 64 20 45 58 49 54 0a 09 20 20 20 20  ey-id EXIT..    
37c0: 45 4c 53 45 20 20 3e 72 20 32 64 75 70 20 75 6e  ELSE  >r 2dup un
37d0: 6b 65 79 2d 69 64 23 20 23 6f 66 66 20 72 3e 20  key-id# #off r> 
37e0: 20 54 48 45 4e 0a 09 45 4c 53 45 20 20 2e 75 6e   THEN..ELSE  .un
37f0: 6b 65 79 2d 69 64 20 20 45 58 49 54 20 20 54 48  key-id  EXIT  TH
3800: 45 4e 0a 20 20 20 20 54 48 45 4e 0a 20 20 20 20  EN.    THEN.    
3810: 63 65 6c 6c 2b 20 2e 2e 6e 69 63 6b 20 32 64 72  cell+ ..nick 2dr
3820: 6f 70 20 3b 0a 0a 3a 20 2e 63 6f 6e 2d 69 64 20  op ;..: .con-id 
3830: 28 20 6f 3a 63 6f 6e 6e 65 63 74 69 6f 6e 20 2d  ( o:connection -
3840: 2d 20 29 20 70 75 62 6b 65 79 20 24 40 20 2e 6b  - ) pubkey $@ .k
3850: 65 79 2d 69 64 20 3b 0a 0a 3a 20 2e 73 69 6d 70  ey-id ;..: .simp
3860: 6c 65 2d 69 64 20 28 20 61 64 64 72 20 75 20 2d  le-id ( addr u -
3870: 2d 20 29 20 6b 65 79 3e 6e 69 63 6b 20 74 79 70  - ) key>nick typ
3880: 65 20 3b 0a 0a 3a 20 63 68 65 63 6b 2d 6b 65 79  e ;..: check-key
3890: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20   ( addr u -- ). 
38a0: 20 20 20 6f 20 49 46 20 20 70 75 62 6b 65 79 20     o IF  pubkey 
38b0: 40 20 49 46 0a 09 20 20 20 20 32 64 75 70 20 70  @ IF..    2dup p
38c0: 75 62 6b 65 79 20 24 40 20 6b 65 79 7c 20 73 74  ubkey $@ key| st
38d0: 72 3d 20 30 3d 20 49 46 0a 09 09 5b 3a 20 2e 22  r= 0= IF...[: ."
38e0: 20 77 61 6e 74 3a 20 22 20 70 75 62 6b 65 79 20   want: " pubkey 
38f0: 24 40 20 6b 65 79 7c 20 38 35 74 79 70 65 20 63  $@ key| 85type c
3900: 72 0a 09 09 20 20 2e 22 20 67 6f 74 20 3a 20 22  r...  ." got : "
3910: 20 32 64 75 70 20 38 35 74 79 70 65 20 63 72 20   2dup 85type cr 
3920: 3b 5d 20 24 65 72 72 0a 09 09 74 72 75 65 20 21  ;] $err...true !
3930: 21 77 72 6f 6e 67 2d 6b 65 79 21 21 0a 09 20 20  !wrong-key!!..  
3940: 20 20 54 48 45 4e 0a 09 20 20 20 20 63 6f 6e 6e    THEN..    conn
3950: 65 63 74 28 20 2e 6b 65 79 23 20 29 65 6c 73 65  ect( .key# )else
3960: 28 20 32 64 72 6f 70 20 29 20 20 45 58 49 54 0a  ( 2drop )  EXIT.
3970: 09 54 48 45 4e 20 20 54 48 45 4e 0a 20 20 20 20  .THEN  THEN.    
3980: 32 64 75 70 20 6b 65 79 2d 65 78 69 73 74 3f 0a  2dup key-exist?.
3990: 20 20 20 20 3f 64 75 70 2d 30 3d 2d 49 46 20 20      ?dup-0=-IF  
39a0: 70 65 72 6d 25 75 6e 6b 6e 6f 77 6e 20 20 45 4c  perm%unknown  EL
39b0: 53 45 20 20 2e 6b 65 2d 6d 61 73 6b 20 40 20 20  SE  .ke-mask @  
39c0: 54 48 45 4e 20 20 74 6d 70 2d 70 65 72 6d 20 21  THEN  tmp-perm !
39d0: 0a 20 20 20 20 63 6f 6e 6e 65 63 74 28 20 32 64  .    connect( 2d
39e0: 75 70 20 2e 6b 65 79 23 20 29 0a 20 20 20 20 74  up .key# ).    t
39f0: 6d 70 2d 70 65 72 6d 20 40 20 70 65 72 6d 25 62  mp-perm @ perm%b
3a00: 6c 6f 63 6b 65 64 20 61 6e 64 20 49 46 0a 09 5b  locked and IF..[
3a10: 3a 20 2e 22 20 55 6e 6b 6e 6f 77 6e 20 6b 65 79  : ." Unknown key
3a20: 2c 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 72 65 66  , connection ref
3a30: 75 73 65 64 3a 20 22 20 38 35 74 79 70 65 20 63  used: " 85type c
3a40: 72 20 3b 5d 20 24 65 72 72 0a 09 74 72 75 65 20  r ;] $err..true 
3a50: 21 21 63 6f 6e 6e 65 63 74 2d 70 65 72 6d 21 21  !!connect-perm!!
3a60: 0a 20 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70  .    ELSE  2drop
3a70: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 73 65 61 72    THEN ;..: sear
3a80: 63 68 2d 6b 65 79 20 28 20 70 6b 63 20 2d 2d 20  ch-key ( pkc -- 
3a90: 73 6b 63 20 29 0a 20 20 20 20 6b 65 79 73 69 7a  skc ).    keysiz
3aa0: 65 20 6b 65 79 23 20 23 40 20 30 3d 20 21 21 75  e key# #@ 0= !!u
3ab0: 6e 6b 6e 6f 77 6e 2d 6b 65 79 21 21 0a 20 20 20  nknown-key!!.   
3ac0: 20 63 65 6c 6c 2b 20 2e 6b 65 2d 73 6b 20 73 65   cell+ .ke-sk se
3ad0: 63 40 20 30 3d 20 21 21 75 6e 6b 6e 6f 77 6e 2d  c@ 0= !!unknown-
3ae0: 6b 65 79 21 21 20 3b 0a 0a 5c 20 61 70 70 6c 79  key!! ;..\ apply
3af0: 20 70 65 72 6d 69 73 73 69 6f 6e 73 26 67 72 6f   permissions&gro
3b00: 75 70 73 0a 0a 3a 20 61 70 70 6c 79 2d 70 65 72  ups..: apply-per
3b10: 6d 69 73 73 69 6f 6e 20 28 20 70 65 72 6d 61 6e  mission ( perman
3b20: 64 20 70 65 72 6d 6f 72 20 6f 3a 6b 65 79 20 2d  d permor o:key -
3b30: 2d 20 70 65 72 6d 61 6e 64 20 70 65 72 6d 6f 72  - permand permor
3b40: 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 6f 76 65   o:key ).    ove
3b50: 72 20 6b 65 2d 6d 61 73 6b 20 40 20 61 6e 64 20  r ke-mask @ and 
3b60: 6f 76 65 72 20 6f 72 20 6b 65 2d 6d 61 73 6b 20  over or ke-mask 
3b70: 21 20 2e 6b 65 79 2d 6c 69 73 74 20 3b 0a 0a 3a  ! .key-list ;..:
3b80: 20 2d 67 72 6f 75 70 2d 70 65 72 6d 20 28 20 6f   -group-perm ( o
3b90: 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65  :key -- ).    ke
3ba0: 2d 67 72 6f 75 70 73 20 24 40 20 67 72 6f 75 70  -groups $@ group
3bb0: 73 3e 6d 61 73 6b 20 69 6e 76 65 72 74 20 6b 65  s>mask invert ke
3bc0: 2d 6d 61 73 6b 20 61 6e 64 21 20 3b 0a 3a 20 2b  -mask and! ;.: +
3bd0: 67 72 6f 75 70 2d 70 65 72 6d 20 28 20 6f 3a 6b  group-perm ( o:k
3be0: 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b 65 2d 67  ey -- ).    ke-g
3bf0: 72 6f 75 70 73 20 24 40 20 67 72 6f 75 70 73 3e  roups $@ groups>
3c00: 6d 61 73 6b 20 20 20 20 20 20 20 20 6b 65 2d 6d  mask        ke-m
3c10: 61 73 6b 20 6f 72 21 20 3b 0a 0a 3a 20 61 64 64  ask or! ;..: add
3c20: 2d 67 72 6f 75 70 20 28 20 69 64 20 6f 3a 6b 65  -group ( id o:ke
3c30: 79 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 2d  y -- ).    dup -
3c40: 31 20 3d 20 21 21 6e 6f 2d 67 72 6f 75 70 21 21  1 = !!no-group!!
3c50: 20 2d 67 72 6f 75 70 2d 70 65 72 6d 20 75 3e 36   -group-perm u>6
3c60: 34 20 63 6d 64 74 6d 70 24 20 6b 65 2d 67 72 6f  4 cmdtmp$ ke-gro
3c70: 75 70 73 20 24 2b 21 20 2b 67 72 6f 75 70 2d 70  ups $+! +group-p
3c80: 65 72 6d 20 3b 0a 3a 20 73 65 74 2d 67 72 6f 75  erm ;.: set-grou
3c90: 70 20 28 20 69 64 20 6f 3a 6b 65 79 20 2d 2d 20  p ( id o:key -- 
3ca0: 29 0a 20 20 20 20 64 75 70 20 2d 31 20 3d 20 21  ).    dup -1 = !
3cb0: 21 6e 6f 2d 67 72 6f 75 70 21 21 20 2d 67 72 6f  !no-group!! -gro
3cc0: 75 70 2d 70 65 72 6d 20 75 3e 36 34 20 63 6d 64  up-perm u>64 cmd
3cd0: 74 6d 70 24 20 6b 65 2d 67 72 6f 75 70 73 20 24  tmp$ ke-groups $
3ce0: 21 20 2b 67 72 6f 75 70 2d 70 65 72 6d 20 3b 0a  ! +group-perm ;.
3cf0: 3a 20 73 75 62 2d 67 72 6f 75 70 20 28 20 69 64  : sub-group ( id
3d00: 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20   o:key -- ).    
3d10: 64 75 70 20 2d 31 20 3d 20 21 21 6e 6f 2d 67 72  dup -1 = !!no-gr
3d20: 6f 75 70 21 21 20 2d 67 72 6f 75 70 2d 70 65 72  oup!! -group-per
3d30: 6d 20 75 3e 36 34 20 63 6d 64 74 6d 70 24 20 6b  m u>64 cmdtmp$ k
3d40: 65 2d 67 72 6f 75 70 73 20 24 40 20 32 6f 76 65  e-groups $@ 2ove
3d50: 72 20 73 65 61 72 63 68 0a 20 20 20 20 49 46 20  r search.    IF 
3d60: 20 20 6e 69 70 20 3e 72 20 6e 69 70 20 6b 65 2d    nip >r nip ke-
3d70: 67 72 6f 75 70 73 20 64 75 70 20 24 40 6c 65 6e  groups dup $@len
3d80: 20 72 3e 20 2d 20 72 6f 74 20 24 64 65 6c 0a 20   r> - rot $del. 
3d90: 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 32     ELSE  2drop 2
3da0: 64 72 6f 70 20 20 54 48 45 4e 20 2b 67 72 6f 75  drop  THEN +grou
3db0: 70 2d 70 65 72 6d 20 3b 0a 0a 3a 20 61 70 70 6c  p-perm ;..: appl
3dc0: 79 2d 67 72 6f 75 70 20 28 20 61 64 64 72 20 75  y-group ( addr u
3dd0: 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20   o:key -- ).    
3de0: 6f 76 65 72 20 63 40 20 27 2b 27 20 3d 20 49 46  over c@ '+' = IF
3df0: 20 20 31 20 2f 73 74 72 69 6e 67 20 3e 67 72 6f    1 /string >gro
3e00: 75 70 2d 69 64 20 61 64 64 2d 67 72 6f 75 70 20  up-id add-group 
3e10: 2e 6b 65 79 2d 6c 69 73 74 20 20 45 58 49 54 20  .key-list  EXIT 
3e20: 20 54 48 45 4e 0a 20 20 20 20 6f 76 65 72 20 63   THEN.    over c
3e30: 40 20 27 2d 27 20 3d 20 49 46 20 20 31 20 2f 73  @ '-' = IF  1 /s
3e40: 74 72 69 6e 67 20 3e 67 72 6f 75 70 2d 69 64 20  tring >group-id 
3e50: 73 75 62 2d 67 72 6f 75 70 20 2e 6b 65 79 2d 6c  sub-group .key-l
3e60: 69 73 74 20 20 45 58 49 54 20 20 54 48 45 4e 0a  ist  EXIT  THEN.
3e70: 20 20 20 20 3e 67 72 6f 75 70 2d 69 64 20 73 65      >group-id se
3e80: 74 2d 67 72 6f 75 70 20 2e 6b 65 79 2d 6c 69 73  t-group .key-lis
3e90: 74 20 3b 0a 0a 5c 20 67 65 74 20 70 61 73 73 70  t ;..\ get passp
3ea0: 68 72 61 73 65 0a 0a 33 20 56 61 6c 75 65 20 70  hrase..3 Value p
3eb0: 61 73 73 70 68 72 61 73 65 2d 72 65 74 72 79 23  assphrase-retry#
3ec0: 0a 24 31 30 30 20 43 6f 6e 73 74 61 6e 74 20 6d  .$100 Constant m
3ed0: 61 78 2d 70 61 73 73 70 68 72 61 73 65 23 20 5c  ax-passphrase# \
3ee0: 20 32 35 36 20 63 68 61 72 61 63 74 65 72 73 20   256 characters 
3ef0: 73 68 6f 75 6c 64 20 62 65 20 65 6e 6f 75 67 68  should be enough
3f00: 2e 2e 2e 0a 6d 61 78 2d 70 61 73 73 70 68 72 61  ....max-passphra
3f10: 73 65 23 20 62 75 66 66 65 72 3a 20 70 61 73 73  se# buffer: pass
3f20: 70 68 72 61 73 65 0a 0a 3a 20 70 61 73 73 70 68  phrase..: passph
3f30: 72 61 73 65 2d 69 6e 20 28 20 61 64 64 72 20 75  rase-in ( addr u
3f40: 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20   -- addr u ).   
3f50: 20 22 50 41 53 53 50 48 52 41 53 45 22 20 67 65   "PASSPHRASE" ge
3f60: 74 65 6e 76 20 32 64 75 70 20 64 30 3d 20 49 46  tenv 2dup d0= IF
3f70: 20 20 32 64 72 6f 70 20 74 79 70 65 0a 09 70 61    2drop type..pa
3f80: 73 73 70 68 72 61 73 65 20 64 75 70 20 6d 61 78  ssphrase dup max
3f90: 2d 70 61 73 73 70 68 72 61 73 65 23 20 61 63 63  -passphrase# acc
3fa0: 65 70 74 2a 20 63 72 0a 20 20 20 20 45 4c 53 45  ept* cr.    ELSE
3fb0: 20 20 32 6e 69 70 20 20 54 48 45 4e 20 3b 0a 0a    2nip  THEN ;..
3fc0: 3a 20 3e 70 61 73 73 70 68 72 61 73 65 20 28 20  : >passphrase ( 
3fd0: 61 64 64 72 20 75 20 2d 2d 20 61 64 64 72 20 75  addr u -- addr u
3fe0: 20 29 0a 20 20 20 20 5c 47 20 63 72 65 61 74 65   ).    \G create
3ff0: 20 61 20 35 31 32 20 62 69 74 20 68 61 73 68 20   a 512 bit hash 
4000: 6f 66 20 74 68 65 20 70 61 73 73 70 68 72 61 73  of the passphras
4010: 65 0a 20 20 20 20 6e 6f 2d 6b 65 79 20 3e 63 3a  e.    no-key >c:
4020: 6b 65 79 20 63 3a 68 61 73 68 0a 20 20 20 20 6b  key c:hash.    k
4030: 65 63 63 61 6b 2d 70 61 64 64 65 64 20 63 3a 6b  eccak-padded c:k
4040: 65 79 3e 20 6b 65 63 63 61 6b 2d 70 61 64 64 65  ey> keccak-padde
4050: 64 20 6b 65 63 63 61 6b 23 6d 61 78 20 32 2f 20  d keccak#max 2/ 
4060: 3b 0a 0a 3a 20 67 65 74 2d 70 61 73 73 70 68 72  ;..: get-passphr
4070: 61 73 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20  ase ( addr u -- 
4080: 61 64 64 72 20 75 20 29 0a 20 20 20 20 70 61 73  addr u ).    pas
4090: 73 70 68 72 61 73 65 2d 69 6e 20 3e 70 61 73 73  sphrase-in >pass
40a0: 70 68 72 61 73 65 20 3b 0a 0a 56 61 72 69 61 62  phrase ;..Variab
40b0: 6c 65 20 6b 65 79 73 0a 0a 3a 20 6c 61 73 74 6b  le keys..: lastk
40c0: 65 79 40 20 28 20 2d 2d 20 61 64 64 72 20 75 20  ey@ ( -- addr u 
40d0: 29 20 6b 65 79 73 20 24 5b 5d 23 20 31 2d 20 6b  ) keys $[]# 1- k
40e0: 65 79 73 20 73 65 63 5b 5d 40 20 3b 0a 3a 20 6b  eys sec[]@ ;.: k
40f0: 65 79 3e 64 65 66 61 75 6c 74 20 28 20 2d 2d 20  ey>default ( -- 
4100: 29 20 6c 61 73 74 6b 65 79 40 20 64 72 6f 70 20  ) lastkey@ drop 
4110: 3e 73 74 6f 72 65 6b 65 79 20 21 20 3b 0a 3a 20  >storekey ! ;.: 
4120: 2b 6b 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d  +key ( addr u --
4130: 20 29 20 6b 65 79 73 20 73 65 63 2b 5b 5d 21 20   ) keys sec+[]! 
4140: 3b 0a 3a 20 2b 70 61 73 73 70 68 72 61 73 65 20  ;.: +passphrase 
4150: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 20 67  ( addr u -- )  g
4160: 65 74 2d 70 61 73 73 70 68 72 61 73 65 20 2b 6b  et-passphrase +k
4170: 65 79 20 3b 0a 3a 20 2b 63 68 65 63 6b 70 68 72  ey ;.: +checkphr
4180: 61 73 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20  ase ( addr u -- 
4190: 66 6c 61 67 20 29 20 67 65 74 2d 70 61 73 73 70  flag ) get-passp
41a0: 68 72 61 73 65 20 6c 61 73 74 6b 65 79 40 20 73  hrase lastkey@ s
41b0: 74 72 3d 20 3b 0a 3a 20 2b 6e 65 77 70 68 72 61  tr= ;.: +newphra
41c0: 73 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 42 45  se ( -- ).    BE
41d0: 47 49 4e 0a 09 73 22 20 50 61 73 73 70 68 72 61  GIN..s" Passphra
41e0: 73 65 3a 20 22 20 2b 70 61 73 73 70 68 72 61 73  se: " +passphras
41f0: 65 0a 09 73 22 20 52 65 74 79 70 65 20 70 6c 73  e..s" Retype pls
4200: 3a 20 22 20 2b 63 68 65 63 6b 70 68 72 61 73 65  : " +checkphrase
4210: 20 30 3d 20 57 48 49 4c 45 0a 09 20 20 20 20 63   0= WHILE..    c
4220: 72 20 2e 22 20 20 64 69 64 6e 27 74 20 6d 61 74  r ."  didn't mat
4230: 63 68 2c 20 74 72 79 20 61 67 61 69 6e 20 70 6c  ch, try again pl
4240: 65 61 73 65 22 20 63 72 0a 20 20 20 20 52 45 50  ease" cr.    REP
4250: 45 41 54 20 63 72 20 3b 0a 0a 3a 20 22 3e 70 61  EAT cr ;..: ">pa
4260: 73 73 70 68 72 61 73 65 20 28 20 61 64 64 72 20  ssphrase ( addr 
4270: 75 20 2d 2d 20 29 20 3e 70 61 73 73 70 68 72 61  u -- ) >passphra
4280: 73 65 20 2b 6b 65 79 20 3b 0a 3a 20 3e 73 65 63  se +key ;.: >sec
4290: 6b 65 79 20 28 20 2d 2d 20 61 64 64 72 20 75 20  key ( -- addr u 
42a0: 29 0a 20 20 20 20 6b 65 2d 73 6b 20 40 20 6b 65  ).    ke-sk @ ke
42b0: 2d 70 6b 20 24 40 20 64 72 6f 70 20 6b 65 79 70  -pk $@ drop keyp
42c0: 61 64 20 65 64 2d 64 68 20 3b 0a 3a 20 2b 73 65  ad ed-dh ;.: +se
42d0: 63 6b 65 79 20 28 20 2d 2d 20 29 20 3e 73 65 63  ckey ( -- ) >sec
42e0: 6b 65 79 20 2b 6b 65 79 20 3b 0a 0a 5c 20 22 22  key +key ;..\ ""
42f0: 20 22 3e 70 61 73 73 70 68 72 61 73 65 20 5c 20   ">passphrase \ 
4300: 66 6f 6c 6c 6f 77 69 6e 67 20 74 68 65 20 65 6e  following the en
4310: 63 72 79 70 74 2d 65 76 65 72 79 74 68 69 6e 67  crypt-everything
4320: 20 70 61 72 61 64 69 67 6d 2c 0a 5c 20 6e 6f 20   paradigm,.\ no 
4330: 70 61 73 73 77 6f 72 64 20 69 73 20 74 68 65 20  password is the 
4340: 65 6d 70 74 79 20 73 74 72 69 6e 67 21 20 20 49  empty string!  I
4350: 74 27 73 20 73 74 69 6c 6c 20 65 6e 63 72 79 70  t's still encryp
4360: 74 65 64 20 3b 2d 29 21 0a 0a 5c 20 61 20 73 65  ted ;-)!..\ a se
4370: 63 72 65 74 20 6b 65 79 20 6a 75 73 74 20 6e 65  cret key just ne
4380: 65 64 73 20 61 20 6e 69 63 6b 20 61 6e 64 20 61  eds a nick and a
4390: 20 74 79 70 65 2e 0a 5c 20 53 65 63 72 65 74 20   type..\ Secret 
43a0: 6b 65 79 73 20 63 61 6e 20 62 65 20 70 65 72 73  keys can be pers
43b0: 6f 6e 73 20 61 6e 64 20 67 72 6f 75 70 73 2e 0a  ons and groups..
43c0: 0a 5c 20 61 20 70 75 62 6c 69 63 20 6b 65 79 20  .\ a public key 
43d0: 6e 65 65 64 73 20 6d 6f 72 65 3a 20 6e 69 63 6b  needs more: nick
43e0: 2c 20 74 79 70 65 2c 20 70 72 6f 66 69 6c 65 2e  , type, profile.
43f0: 0a 5c 20 54 68 65 20 70 72 6f 66 69 6c 65 20 69  .\ The profile i
4400: 73 20 61 20 73 74 72 75 63 74 75 72 65 64 20 64  s a structured d
4410: 6f 63 75 6d 65 6e 74 2c 20 69 2e 65 2e 20 70 6f  ocument, i.e. po
4420: 69 6e 74 65 64 20 74 6f 20 62 79 20 61 20 68 61  inted to by a ha
4430: 73 68 2e 0a 0a 5c 20 61 20 73 69 67 6e 61 74 75  sh...\ a signatu
4440: 72 65 20 63 6f 6e 74 61 69 6e 73 20 61 20 70 75  re contains a pu
4450: 62 6b 65 79 2c 20 61 20 63 68 65 63 6b 62 6f 78  bkey, a checkbox
4460: 20 62 69 74 6d 61 73 6b 2c 0a 5c 20 61 20 64 61   bitmask,.\ a da
4470: 74 65 2c 20 61 6e 20 65 78 70 69 72 61 74 69 6f  te, an expiratio
4480: 6e 20 64 61 74 65 2c 20 74 68 65 20 73 69 67 6e  n date, the sign
4490: 65 72 27 73 20 70 75 62 6b 65 79 20 61 6e 64 20  er's pubkey and 
44a0: 74 68 65 20 73 69 67 6e 61 74 75 72 65 20 69 74  the signature it
44b0: 73 65 6c 66 0a 5c 20 28 72 2b 73 29 2e 20 20 54  self.\ (r+s).  T
44c0: 68 65 72 65 20 69 73 20 61 6e 20 6f 70 74 69 6f  here is an optio
44d0: 6e 61 6c 20 73 69 67 6e 69 6e 67 20 70 72 6f 74  nal signing prot
44e0: 6f 63 6f 6c 20 64 6f 63 75 6d 65 6e 74 20 28 68  ocol document (h
44f0: 61 73 68 29 2e 0a 0a 5c 20 77 65 20 73 74 6f 72  ash)...\ we stor
4500: 65 20 65 61 63 68 20 69 74 65 6d 20 69 6e 20 61  e each item in a
4510: 20 32 35 36 20 62 79 74 65 73 20 65 6e 63 72 79   256 bytes encry
4520: 70 74 65 64 20 73 74 72 69 6e 67 2c 20 69 2e 65  pted string, i.e
4530: 2e 20 77 69 74 68 20 61 20 31 36 0a 5c 20 62 79  . with a 16.\ by
4540: 74 65 20 73 61 6c 74 20 61 6e 64 20 61 20 31 36  te salt and a 16
4550: 20 62 79 74 65 20 63 68 65 63 6b 73 75 6d 2e 0a   byte checksum..
4560: 0a 3a 20 6b 65 2d 6c 61 73 74 21 20 28 20 36 34  .: ke-last! ( 64
4570: 64 61 74 65 20 2d 2d 20 29 0a 20 20 20 20 6b 65  date -- ).    ke
4580: 2d 73 65 6c 66 73 69 67 20 24 40 6c 65 6e 20 24  -selfsig $@len $
4590: 31 30 20 75 6d 61 78 20 6b 65 2d 73 65 6c 66 73  10 umax ke-selfs
45a0: 69 67 20 24 21 6c 65 6e 0a 20 20 20 20 6b 65 2d  ig $!len.    ke-
45b0: 73 65 6c 66 73 69 67 20 24 40 20 64 72 6f 70 20  selfsig $@ drop 
45c0: 36 34 27 2b 20 36 34 21 20 3b 0a 3a 20 6b 65 2d  64'+ 64! ;.: ke-
45d0: 66 69 72 73 74 21 20 28 20 36 34 64 61 74 65 20  first! ( 64date 
45e0: 2d 2d 20 29 20 36 34 23 2d 31 20 6b 65 2d 6c 61  -- ) 64#-1 ke-la
45f0: 73 74 21 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73  st!.    ke-selfs
4600: 69 67 20 24 40 20 64 72 6f 70 20 36 34 21 20 3b  ig $@ drop 64! ;
4610: 0a 0a 73 63 6f 70 65 7b 20 6e 65 74 32 6f 2d 62  ..scope{ net2o-b
4620: 61 73 65 0a 0a 63 6d 64 2d 74 61 62 6c 65 20 24  ase..cmd-table $
4630: 40 20 69 6e 68 65 72 69 74 2d 74 61 62 6c 65 20  @ inherit-table 
4640: 6b 65 79 2d 65 6e 74 72 79 2d 74 61 62 6c 65 0a  key-entry-table.
4650: 5c 67 20 0a 5c 67 20 23 23 23 20 6b 65 79 20 73  \g .\g ### key s
4660: 74 6f 72 61 67 65 20 63 6f 6d 6d 61 6e 64 73 20  torage commands 
4670: 23 23 23 0a 5c 67 20 0a 24 31 31 20 6e 65 74 32  ###.\g .$11 net2
4680: 6f 3a 20 70 72 69 76 6b 65 79 20 28 20 24 3a 73  o: privkey ( $:s
4690: 74 72 69 6e 67 20 2d 2d 20 29 0a 20 20 20 20 5c  tring -- ).    \
46a0: 67 20 70 72 69 76 61 74 65 20 6b 65 79 0a 20 20  g private key.  
46b0: 20 20 5c 20 64 6f 65 73 20 6e 6f 74 20 6e 65 65    \ does not nee
46c0: 64 20 74 6f 20 62 65 20 73 69 67 6e 65 64 2c 20  d to be signed, 
46d0: 74 68 65 20 73 65 63 72 65 74 20 6b 65 79 20 76  the secret key v
46e0: 65 72 69 66 69 65 73 20 69 74 73 65 6c 66 0a 20  erifies itself. 
46f0: 20 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 24     !!unsigned? $
4700: 34 30 20 21 21 3e 3d 6f 72 64 65 72 3f 0a 20 20  40 !!>=order?.  
4710: 20 20 6b 65 79 70 61 63 6b 20 63 40 20 24 46 20    keypack c@ $F 
4720: 61 6e 64 20 6b 65 2d 70 77 6c 65 76 65 6c 20 21  and ke-pwlevel !
4730: 0a 20 20 20 20 24 3e 20 6f 76 65 72 20 6b 65 79  .    $> over key
4740: 70 61 64 20 73 6b 3e 70 6b 20 5c 20 67 65 6e 65  pad sk>pk \ gene
4750: 72 61 74 65 20 70 75 62 6b 65 79 0a 20 20 20 20  rate pubkey.    
4760: 6b 65 79 70 61 64 20 6b 65 2d 70 6b 20 24 40 20  keypad ke-pk $@ 
4770: 64 72 6f 70 20 6b 65 79 73 69 7a 65 20 74 75 63  drop keysize tuc
4780: 6b 20 73 74 72 3d 20 30 3d 20 21 21 77 72 6f 6e  k str= 0= !!wron
4790: 67 2d 6b 65 79 21 21 0a 20 20 20 20 6b 65 2d 73  g-key!!.    ke-s
47a0: 6b 20 73 65 63 21 20 2b 73 65 63 6b 65 79 20 22  k sec! +seckey "
47b0: 5c 30 22 20 6b 65 2d 67 72 6f 75 70 73 20 24 21  \0" ke-groups $!
47c0: 20 30 20 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 40   0 groups[] $[]@
47d0: 20 64 72 6f 70 20 40 20 6b 65 2d 6d 61 73 6b 20   drop @ ke-mask 
47e0: 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 74  ! ;.+net2o: keyt
47f0: 79 70 65 20 28 20 6e 20 2d 2d 20 29 20 20 20 20  ype ( n -- )    
4800: 20 20 20 20 20 20 20 21 21 73 69 67 6e 65 64 3f         !!signed?
4810: 20 20 20 31 20 21 21 3e 6f 72 64 65 72 3f 20 36     1 !!>order? 6
4820: 34 3e 6e 20 6b 65 2d 74 79 70 65 20 21 20 3b 0a  4>n ke-type ! ;.
4830: 20 20 20 20 5c 67 20 6b 65 79 20 74 79 70 65 20      \g key type 
4840: 28 30 3a 20 61 6e 6f 6e 2c 20 31 3a 20 75 73 65  (0: anon, 1: use
4850: 72 2c 20 32 3a 20 67 72 6f 75 70 29 0a 2b 6e 65  r, 2: group).+ne
4860: 74 32 6f 3a 20 6b 65 79 6e 69 63 6b 20 28 20 24  t2o: keynick ( $
4870: 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 20 20 20  :string -- )    
4880: 21 21 73 69 67 6e 65 64 3f 20 20 20 32 20 21 21  !!signed?   2 !!
4890: 3e 6f 72 64 65 72 3f 20 24 3e 20 6b 65 2d 6e 69  >order? $> ke-ni
48a0: 63 6b 20 24 21 0a 20 20 20 20 5c 67 20 6b 65 79  ck $!.    \g key
48b0: 20 6e 69 63 6b 0a 20 20 20 20 6e 69 63 6b 21 20   nick.    nick! 
48c0: 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 70 72 6f  ;.+net2o: keypro
48d0: 66 69 6c 65 20 28 20 24 3a 73 74 72 69 6e 67 20  file ( $:string 
48e0: 2d 2d 20 29 20 21 21 73 69 67 6e 65 64 3f 20 20  -- ) !!signed?  
48f0: 20 34 20 21 21 3e 6f 72 64 65 72 3f 20 24 3e 20   4 !!>order? $> 
4900: 6b 65 2d 70 72 6f 66 20 24 21 20 3b 0a 20 20 20  ke-prof $! ;.   
4910: 20 5c 67 20 6b 65 79 20 70 72 6f 66 69 6c 65 20   \g key profile 
4920: 28 68 61 73 68 20 6f 66 20 61 20 72 65 73 6f 75  (hash of a resou
4930: 72 63 65 29 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79  rce).+net2o: key
4940: 6d 61 73 6b 20 28 20 78 20 2d 2d 20 29 20 20 20  mask ( x -- )   
4950: 20 20 20 20 20 20 21 21 75 6e 73 69 67 6e 65 64        !!unsigned
4960: 3f 20 24 34 30 20 21 21 3e 3d 6f 72 64 65 72 3f  ? $40 !!>=order?
4970: 20 36 34 3e 6e 0a 20 20 20 20 5c 67 20 6b 65 79   64>n.    \g key
4980: 20 61 63 63 65 73 73 20 72 69 67 68 74 20 6d 61   access right ma
4990: 73 6b 0a 20 20 20 20 31 20 69 6d 70 6f 72 74 2d  sk.    1 import-
49a0: 74 79 70 65 20 40 20 6c 73 68 69 66 74 0a 20 20  type @ lshift.  
49b0: 20 20 5b 20 31 20 69 6d 70 6f 72 74 23 73 65 6c    [ 1 import#sel
49c0: 66 20 6c 73 68 69 66 74 20 31 20 69 6d 70 6f 72  f lshift 1 impor
49d0: 74 23 6e 65 77 20 6c 73 68 69 66 74 20 6f 72 20  t#new lshift or 
49e0: 5d 4c 0a 20 20 20 20 61 6e 64 20 30 3d 20 49 46  ]L.    and 0= IF
49f0: 20 20 64 72 6f 70 20 70 65 72 6d 25 64 65 66 61    drop perm%defa
4a00: 75 6c 74 20 20 54 48 45 4e 20 20 64 75 70 20 6b  ult  THEN  dup k
4a10: 65 2d 6d 61 73 6b 20 6f 72 21 20 3f 3e 67 72 6f  e-mask or! ?>gro
4a20: 75 70 73 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65  ups ;.+net2o: ke
4a30: 79 67 72 6f 75 70 73 20 28 20 24 3a 67 72 6f 75  ygroups ( $:grou
4a40: 70 73 20 2d 2d 20 29 20 21 21 75 6e 73 69 67 6e  ps -- ) !!unsign
4a50: 65 64 3f 20 24 32 30 20 21 21 3e 6f 72 64 65 72  ed? $20 !!>order
4a60: 3f 20 24 3e 0a 20 20 20 20 5c 67 20 61 63 63 65  ? $>.    \g acce
4a70: 73 73 20 67 72 6f 75 70 73 0a 20 20 20 20 31 20  ss groups.    1 
4a80: 69 6d 70 6f 72 74 2d 74 79 70 65 20 40 20 6c 73  import-type @ ls
4a90: 68 69 66 74 0a 20 20 20 20 5b 20 31 20 69 6d 70  hift.    [ 1 imp
4aa0: 6f 72 74 23 73 65 6c 66 20 6c 73 68 69 66 74 20  ort#self lshift 
4ab0: 31 20 69 6d 70 6f 72 74 23 6e 65 77 20 6c 73 68  1 import#new lsh
4ac0: 69 66 74 20 6f 72 20 5d 4c 0a 20 20 20 20 61 6e  ift or ]L.    an
4ad0: 64 20 30 3d 20 49 46 20 20 32 64 72 6f 70 20 22  d 0= IF  2drop "
4ae0: 5c 78 30 31 22 20 20 54 48 45 4e 0a 20 20 20 20  \x01"  THEN.    
4af0: 32 64 75 70 20 6b 65 2d 67 72 6f 75 70 73 20 24  2dup ke-groups $
4b00: 21 20 67 72 6f 75 70 73 3e 6d 61 73 6b 20 6b 65  ! groups>mask ke
4b10: 2d 6d 61 73 6b 20 21 20 3b 0a 2b 6e 65 74 32 6f  -mask ! ;.+net2o
4b20: 3a 20 2b 6b 65 79 73 69 67 20 28 20 24 3a 73 74  : +keysig ( $:st
4b30: 72 69 6e 67 20 2d 2d 20 29 20 20 21 21 75 6e 73  ring -- )  !!uns
4b40: 69 67 6e 65 64 3f 20 24 31 30 20 21 21 3e 3d 6f  igned? $10 !!>=o
4b50: 72 64 65 72 3f 20 24 3e 20 6b 65 2d 73 69 67 73  rder? $> ke-sigs
4b60: 20 24 2b 5b 5d 21 20 3b 0a 20 20 20 20 5c 67 20   $+[]! ;.    \g 
4b70: 61 64 64 20 61 20 6b 65 79 20 73 69 67 6e 61 74  add a key signat
4b80: 75 72 65 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 69  ure.+net2o: keyi
4b90: 6d 70 6f 72 74 20 28 20 6e 20 2d 2d 20 29 20 20  mport ( n -- )  
4ba0: 20 20 20 20 20 21 21 75 6e 73 69 67 6e 65 64 3f       !!unsigned?
4bb0: 20 24 31 30 20 21 21 3e 3d 6f 72 64 65 72 3f 0a   $10 !!>=order?.
4bc0: 20 20 20 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65      config:pw-le
4bd0: 76 65 6c 23 20 40 20 30 3c 20 49 46 20 20 36 34  vel# @ 0< IF  64
4be0: 3e 6e 0a 09 64 75 70 20 5b 20 31 20 69 6d 70 6f  >n..dup [ 1 impo
4bf0: 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 5d 4c  rt#new lshift ]L
4c00: 20 61 6e 64 20 30 3d 20 49 46 0a 09 20 20 20 20   and 0= IF..    
4c10: 69 6d 70 6f 72 74 23 75 6e 74 72 75 73 74 65 64  import#untrusted
4c20: 20 75 6d 69 6e 20 31 20 73 77 61 70 20 6c 73 68   umin 1 swap lsh
4c30: 69 66 74 20 5b 20 31 20 69 6d 70 6f 72 74 23 6e  ift [ 1 import#n
4c40: 65 77 20 6c 73 68 69 66 74 20 5d 4c 20 6f 72 0a  ew lshift ]L or.
4c50: 09 45 4c 53 45 0a 09 20 20 20 20 5b 20 32 20 69  .ELSE..    [ 2 i
4c60: 6d 70 6f 72 74 23 75 6e 74 72 75 73 74 65 64 20  mport#untrusted 
4c70: 6c 73 68 69 66 74 20 31 2d 20 31 20 69 6d 70 6f  lshift 1- 1 impo
4c80: 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 6f 72  rt#new lshift or
4c90: 20 5d 4c 20 61 6e 64 0a 09 54 48 45 4e 0a 09 6b   ]L and..THEN..k
4ca0: 65 2d 69 6d 70 6f 72 74 73 20 6f 72 21 0a 20 20  e-imports or!.  
4cb0: 20 20 45 4c 53 45 20 20 36 34 64 72 6f 70 20 20    ELSE  64drop  
4cc0: 54 48 45 4e 20 3b 0a 2b 6e 65 74 32 6f 3a 20 72  THEN ;.+net2o: r
4cd0: 73 6b 6b 65 79 20 28 20 24 3a 73 74 72 69 6e 67  skkey ( $:string
4ce0: 20 2d 2d 2d 20 29 0a 20 20 20 20 5c 67 20 72 65   --- ).    \g re
4cf0: 76 6f 6b 65 20 6b 65 79 2c 20 74 65 6d 70 6f 72  voke key, tempor
4d00: 61 72 69 6c 79 20 73 74 6f 72 65 64 0a 20 20 20  arily stored.   
4d10: 20 5c 20 64 6f 65 73 20 6e 6f 74 20 6e 65 65 64   \ does not need
4d20: 20 74 6f 20 62 65 20 73 69 67 6e 65 64 2c 20 74   to be signed, t
4d30: 68 65 20 72 65 76 6f 6b 65 20 6b 65 79 20 76 65  he revoke key ve
4d40: 72 69 66 69 65 73 20 69 74 73 65 6c 66 0a 20 20  rifies itself.  
4d50: 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 24 38    !!unsigned? $8
4d60: 30 20 21 21 3e 3d 6f 72 64 65 72 3f 0a 20 20 20  0 !!>=order?.   
4d70: 20 24 3e 20 32 64 75 70 20 73 6b 72 65 76 20 73   $> 2dup skrev s
4d80: 77 61 70 20 6b 65 79 7c 20 6d 6f 76 65 20 6b 65  wap key| move ke
4d90: 2d 70 6b 20 24 40 20 64 72 6f 70 20 63 68 65 63  -pk $@ drop chec
4da0: 6b 2d 72 65 76 3f 20 30 3d 20 21 21 6e 6f 74 2d  k-rev? 0= !!not-
4db0: 6d 79 2d 72 65 76 73 6b 21 21 0a 20 20 20 20 70  my-revsk!!.    p
4dc0: 6b 72 65 76 20 6b 65 79 73 69 7a 65 32 20 65 72  krev keysize2 er
4dd0: 61 73 65 20 20 6b 65 2d 72 73 6b 20 73 65 63 21  ase  ke-rsk sec!
4de0: 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6b 65 79 70 65   ;.+net2o: keype
4df0: 74 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20  t ( $:string -- 
4e00: 29 20 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 20  )  !!unsigned?  
4e10: 24 3e 0a 20 20 20 20 63 6f 6e 66 69 67 3a 70 77  $>.    config:pw
4e20: 2d 6c 65 76 65 6c 23 20 40 20 30 3c 20 49 46 20  -level# @ 0< IF 
4e30: 20 6b 65 2d 70 65 74 73 20 24 2b 5b 5d 21 20 70   ke-pets $+[]! p
4e40: 65 74 21 20 20 45 4c 53 45 20 20 32 64 72 6f 70  et!  ELSE  2drop
4e50: 20 20 54 48 45 4e 20 3b 0a 7d 73 63 6f 70 65 0a    THEN ;.}scope.
4e60: 0a 67 65 6e 2d 74 61 62 6c 65 20 24 66 72 65 65  .gen-table $free
4e70: 7a 65 0a 27 20 63 6f 6e 74 65 78 74 2d 74 61 62  ze.' context-tab
4e80: 6c 65 20 69 73 20 67 65 6e 2d 74 61 62 6c 65 0a  le is gen-table.
4e90: 0a 3a 20 6b 65 79 3a 6e 65 73 74 2d 73 69 67 20  .: key:nest-sig 
4ea0: 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 64 72  ( addr u -- addr
4eb0: 20 75 27 20 66 6c 61 67 20 29 0a 20 20 20 20 70   u' flag ).    p
4ec0: 6b 32 2d 73 69 67 3f 20 64 75 70 20 3f 45 58 49  k2-sig? dup ?EXI
4ed0: 54 20 64 72 6f 70 0a 20 20 20 20 32 64 75 70 20  T drop.    2dup 
4ee0: 2b 20 73 69 67 73 69 7a 65 23 20 2d 20 73 69 67  + sigsize# - sig
4ef0: 73 69 7a 65 23 20 3e 24 0a 20 20 20 20 73 69 67  size# >$.    sig
4f00: 70 6b 32 73 69 7a 65 23 20 2d 20 32 64 75 70 20  pk2size# - 2dup 
4f10: 2b 20 6b 65 79 73 69 7a 65 32 20 6b 65 79 3f 6e  + keysize2 key?n
4f20: 65 77 20 6e 3a 3e 6f 20 24 3e 20 6b 65 2d 73 65  ew n:>o $> ke-se
4f30: 6c 66 73 69 67 20 24 21 0a 20 20 20 20 73 69 6d  lfsig $!.    sim
4f40: 2d 6e 69 63 6b 21 20 6f 66 66 20 63 2d 73 74 61  -nick! off c-sta
4f50: 74 65 20 6f 66 66 20 73 69 67 2d 6f 6b 20 3b 0a  te off sig-ok ;.
4f60: 27 20 6b 65 79 3a 6e 65 73 74 2d 73 69 67 20 6b  ' key:nest-sig k
4f70: 65 79 2d 65 6e 74 72 79 20 74 6f 20 6e 65 73 74  ey-entry to nest
4f80: 2d 73 69 67 0a 0a 73 61 6d 70 6c 65 2d 6b 65 79  -sig..sample-key
4f90: 20 3e 6f 20 6b 65 79 2d 65 6e 74 72 79 2d 74 61   >o key-entry-ta
4fa0: 62 6c 65 20 40 20 74 6f 6b 65 6e 2d 74 61 62 6c  ble @ token-tabl
4fb0: 65 20 21 20 6f 3e 0a 0a 3a 20 6b 65 79 3a 63 6f  e ! o>..: key:co
4fc0: 64 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 63 6f  de ( -- ).    co
4fd0: 64 65 2d 6b 65 79 20 20 63 6d 64 6c 6f 63 6b 20  de-key  cmdlock 
4fe0: 6c 6f 63 6b 0a 20 20 20 20 6b 65 79 70 61 63 6b  lock.    keypack
4ff0: 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 65 72   keypack-all# er
5000: 61 73 65 0a 20 20 20 20 63 6d 64 72 65 73 65 74  ase.    cmdreset
5010: 20 69 6e 69 74 2d 72 65 70 6c 79 20 61 6c 73 6f   init-reply also
5020: 20 6e 65 74 32 6f 2d 62 61 73 65 20 3b 0a 63 6f   net2o-base ;.co
5030: 6d 70 3a 20 3a 2c 20 61 6c 73 6f 20 6e 65 74 32  mp: :, also net2
5040: 6f 2d 62 61 73 65 20 3b 0a 0a 73 63 6f 70 65 7b  o-base ;..scope{
5050: 20 6e 65 74 32 6f 2d 62 61 73 65 0a 0a 3a 20 65   net2o-base..: e
5060: 6e 64 3a 6b 65 79 20 28 20 2d 2d 20 29 0a 20 20  nd:key ( -- ).  
5070: 20 20 65 6e 64 2d 77 69 74 68 20 70 72 65 76 69    end-with previ
5080: 6f 75 73 20 63 6d 64 6c 6f 63 6b 20 75 6e 6c 6f  ous cmdlock unlo
5090: 63 6b 20 3b 0a 63 6f 6d 70 3a 20 3a 2c 20 70 72  ck ;.comp: :, pr
50a0: 65 76 69 6f 75 73 20 3b 0a 0a 7d 73 63 6f 70 65  evious ;..}scope
50b0: 0a 0a 3a 20 6b 65 79 2d 63 72 79 70 74 20 28 20  ..: key-crypt ( 
50c0: 2d 2d 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b  -- ).    keypack
50d0: 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 0a 20 20   keypack-all#.  
50e0: 20 20 3e 73 74 6f 72 65 6b 65 79 20 73 65 63 40    >storekey sec@
50f0: 20 64 75 70 20 24 32 30 20 75 3c 3d 20 5c 20 69   dup $20 u<= \ i
5100: 73 20 61 20 73 65 63 72 65 74 2c 20 6e 6f 20 6e  s a secret, no n
5110: 65 65 64 20 74 6f 20 62 65 20 73 6c 6f 77 0a 20  eed to be slow. 
5120: 20 20 20 49 46 20 20 65 6e 63 72 79 70 74 24 20     IF  encrypt$ 
5130: 20 45 4c 53 45 20 20 63 6f 6e 66 69 67 3a 70 77   ELSE  config:pw
5140: 2d 6c 65 76 65 6c 23 20 40 20 65 6e 63 72 79 70  -level# @ encryp
5150: 74 2d 70 77 24 20 20 54 48 45 4e 20 3b 0a 0a 30  t-pw$  THEN ;..0
5160: 20 56 61 6c 75 65 20 6b 65 79 2d 73 66 64 20 5c   Value key-sfd \
5170: 20 73 65 63 72 65 74 20 6b 65 79 73 0a 30 20 56   secret keys.0 V
5180: 61 6c 75 65 20 6b 65 79 2d 70 66 64 20 5c 20 70  alue key-pfd \ p
5190: 75 62 6b 65 79 73 0a 0a 5c 20 6c 65 67 61 63 79  ubkeys..\ legacy
51a0: 20 66 6f 72 20 65 61 72 6c 79 20 76 65 72 73 69   for early versi
51b0: 6f 6e 73 20 6f 66 20 6e 65 74 32 6f 20 70 72 69  ons of net2o pri
51c0: 6f 72 20 32 30 31 36 30 36 30 36 0a 0a 3a 20 6e  or 20160606..: n
51d0: 65 74 32 6f 3e 6b 65 79 73 20 7b 20 61 64 64 72  et2o>keys { addr
51e0: 20 75 20 2d 2d 20 7d 0a 20 20 20 20 61 64 64 72   u -- }.    addr
51f0: 20 75 20 2e 6e 65 74 32 6f 2f 20 20 61 64 64 72   u .net2o/  addr
5200: 20 75 20 2e 6b 65 79 73 2f 20 72 65 6e 61 6d 65   u .keys/ rename
5210: 2d 66 69 6c 65 20 64 72 6f 70 20 3b 0a 3a 20 3f  -file drop ;.: ?
5220: 6c 65 67 61 63 79 2d 6b 65 79 73 20 28 20 66 6c  legacy-keys ( fl
5230: 61 67 20 2d 2d 20 29 0a 20 20 20 20 5c 20 21 21  ag -- ).    \ !!
5240: 46 49 58 4d 45 21 21 20 6e 65 65 64 73 20 74 6f  FIXME!! needs to
5250: 20 62 65 20 72 65 6d 6f 76 65 64 20 77 68 65 6e   be removed when
5260: 20 61 6c 6c 20 63 75 72 72 65 6e 74 20 75 73 65   all current use
5270: 72 73 0a 20 20 20 20 5c 20 68 61 76 65 20 6d 69  rs.    \ have mi
5280: 67 72 61 74 65 64 0a 20 20 20 20 49 46 0a 09 22  grated.    IF.."
5290: 70 75 62 6b 65 79 73 2e 6b 32 6f 22 20 6e 65 74  pubkeys.k2o" net
52a0: 32 6f 3e 6b 65 79 73 0a 09 22 73 65 63 6b 65 79  2o>keys.."seckey
52b0: 73 2e 6b 32 6f 22 20 6e 65 74 32 6f 3e 6b 65 79  s.k2o" net2o>key
52c0: 73 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a 3a 20  s.    THEN ;..: 
52d0: 67 65 6e 2d 6b 65 79 73 2d 64 69 72 20 28 20 2d  gen-keys-dir ( -
52e0: 2d 20 29 0a 20 20 20 20 69 6e 69 74 2d 64 69 72  - ).    init-dir
52f0: 73 20 3f 2e 6e 65 74 32 6f 2f 6b 65 79 73 20 3f  s ?.net2o/keys ?
5300: 6c 65 67 61 63 79 2d 6b 65 79 73 0a 20 20 20 20  legacy-keys.    
5310: 67 72 6f 75 70 73 5b 5d 20 24 5b 5d 23 20 30 3d  groups[] $[]# 0=
5320: 20 49 46 20 20 72 65 61 64 2d 67 72 6f 75 70 73   IF  read-groups
5330: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 3f 66 64 2d    THEN ;..: ?fd-
5340: 6b 65 79 73 20 28 20 66 64 20 61 64 64 72 20 75  keys ( fd addr u
5350: 20 2d 2d 20 66 64 27 20 29 20 7b 20 61 64 64 72   -- fd' ) { addr
5360: 20 75 20 7d 20 64 75 70 20 3f 45 58 49 54 20 64   u } dup ?EXIT d
5370: 72 6f 70 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73  rop.    gen-keys
5380: 2d 64 69 72 0a 20 20 20 20 61 64 64 72 20 75 20  -dir.    addr u 
5390: 72 2f 77 20 6f 70 65 6e 2d 66 69 6c 65 20 64 75  r/w open-file du
53a0: 70 20 6e 6f 2d 66 69 6c 65 23 20 3d 20 49 46 0a  p no-file# = IF.
53b0: 09 32 64 72 6f 70 20 61 64 64 72 20 75 20 72 2f  .2drop addr u r/
53c0: 77 20 63 72 65 61 74 65 2d 66 69 6c 65 0a 20 20  w create-file.  
53d0: 20 20 54 48 45 4e 20 20 74 68 72 6f 77 20 3b 0a    THEN  throw ;.
53e0: 0a 3a 20 3f 6b 65 79 2d 73 66 64 20 28 20 2d 2d  .: ?key-sfd ( --
53f0: 20 66 64 20 29 0a 20 20 20 20 6b 65 79 2d 73 66   fd ).    key-sf
5400: 64 20 22 73 65 63 6b 65 79 73 2e 6b 32 6f 22 20  d "seckeys.k2o" 
5410: 2e 6b 65 79 73 2f 20 3f 66 64 2d 6b 65 79 73 20  .keys/ ?fd-keys 
5420: 64 75 70 20 74 6f 20 6b 65 79 2d 73 66 64 20 3b  dup to key-sfd ;
5430: 0a 3a 20 3f 6b 65 79 2d 70 66 64 20 28 20 2d 2d  .: ?key-pfd ( --
5440: 20 66 64 20 29 0a 20 20 20 20 6b 65 79 2d 70 66   fd ).    key-pf
5450: 64 20 22 70 75 62 6b 65 79 73 2e 6b 32 6f 22 20  d "pubkeys.k2o" 
5460: 2e 6b 65 79 73 2f 20 3f 66 64 2d 6b 65 79 73 20  .keys/ ?fd-keys 
5470: 64 75 70 20 74 6f 20 6b 65 79 2d 70 66 64 20 3b  dup to key-pfd ;
5480: 0a 0a 3a 20 6b 65 79 3e 73 66 69 6c 65 20 28 20  ..: key>sfile ( 
5490: 2d 2d 20 29 0a 20 20 20 20 6b 65 79 70 61 63 6b  -- ).    keypack
54a0: 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3f 6b   keypack-all# ?k
54b0: 65 79 2d 73 66 64 20 61 70 70 65 6e 64 2d 66 69  ey-sfd append-fi
54c0: 6c 65 20 6b 65 2d 6f 66 66 73 65 74 20 36 34 21  le ke-offset 64!
54d0: 20 3b 0a 3a 20 6b 65 79 3e 70 66 69 6c 65 20 28   ;.: key>pfile (
54e0: 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 70 61 63   -- ).    keypac
54f0: 6b 20 6b 65 79 70 61 63 6b 2d 61 6c 6c 23 20 3f  k keypack-all# ?
5500: 6b 65 79 2d 70 66 64 20 61 70 70 65 6e 64 2d 66  key-pfd append-f
5510: 69 6c 65 20 6b 65 2d 6f 66 66 73 65 74 20 36 34  ile ke-offset 64
5520: 21 20 3b 0a 0a 3a 20 6b 65 79 3e 73 66 69 6c 65  ! ;..: key>sfile
5530: 40 70 6f 73 20 28 20 36 34 70 6f 73 20 2d 2d 20  @pos ( 64pos -- 
5540: 29 20 36 34 64 75 70 20 36 34 23 2d 31 20 36 34  ) 64dup 64#-1 64
5550: 3d 20 49 46 20 20 36 34 64 72 6f 70 20 6b 65 79  = IF  64drop key
5560: 3e 73 66 69 6c 65 0a 20 20 20 20 45 4c 53 45 20  >sfile.    ELSE 
5570: 20 36 34 3e 72 20 6b 65 79 70 61 63 6b 20 6b 65   64>r keypack ke
5580: 79 70 61 63 6b 2d 61 6c 6c 23 20 36 34 72 3e 20  ypack-all# 64r> 
5590: 3f 6b 65 79 2d 73 66 64 20 77 72 69 74 65 40 70  ?key-sfd write@p
55a0: 6f 73 2d 66 69 6c 65 20 20 54 48 45 4e 20 3b 0a  os-file  THEN ;.
55b0: 3a 20 6b 65 79 3e 70 66 69 6c 65 40 70 6f 73 20  : key>pfile@pos 
55c0: 28 20 36 34 70 6f 73 20 2d 2d 20 29 20 36 34 64  ( 64pos -- ) 64d
55d0: 75 70 20 36 34 23 2d 31 20 36 34 3d 20 49 46 20  up 64#-1 64= IF 
55e0: 20 36 34 64 72 6f 70 20 6b 65 79 3e 70 66 69 6c   64drop key>pfil
55f0: 65 0a 20 20 20 20 45 4c 53 45 20 20 36 34 3e 72  e.    ELSE  64>r
5600: 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b   keypack keypack
5610: 2d 61 6c 6c 23 20 36 34 72 3e 20 3f 6b 65 79 2d  -all# 64r> ?key-
5620: 70 66 64 20 77 72 69 74 65 40 70 6f 73 2d 66 69  pfd write@pos-fi
5630: 6c 65 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 72 6e  le  THEN ;..: rn
5640: 64 3e 73 66 69 6c 65 20 28 20 2d 2d 20 29 0a 20  d>sfile ( -- ). 
5650: 20 20 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61     keypack keypa
5660: 63 6b 2d 61 6c 6c 23 20 3e 72 6e 67 24 20 6b 65  ck-all# >rng$ ke
5670: 79 3e 73 66 69 6c 65 20 3b 0a 3a 20 72 6e 64 3e  y>sfile ;.: rnd>
5680: 70 66 69 6c 65 20 28 20 2d 2d 20 29 0a 20 20 20  pfile ( -- ).   
5690: 20 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b   keypack keypack
56a0: 2d 61 6c 6c 23 20 3e 72 6e 67 24 20 6b 65 79 3e  -all# >rng$ key>
56b0: 70 66 69 6c 65 20 3b 0a 0a 3a 20 3e 6b 65 79 73  pfile ;..: >keys
56c0: 20 28 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 61   ( -- ).    \G a
56d0: 64 64 20 73 68 61 72 65 64 20 73 65 63 72 65 74  dd shared secret
56e0: 20 74 6f 20 6c 69 73 74 20 6f 66 20 70 6f 73 73   to list of poss
56f0: 69 62 6c 65 20 6b 65 79 73 0a 20 20 20 20 73 6b  ible keys.    sk
5700: 63 20 70 6b 63 20 6b 65 79 70 61 64 20 65 64 2d  c pkc keypad ed-
5710: 64 68 20 2b 6b 65 79 20 3b 0a 0a 5c 20 6b 65 79  dh +key ;..\ key
5720: 20 67 65 6e 65 72 61 74 69 6f 6e 0a 5c 20 66 6f   generation.\ fo
5730: 72 20 72 65 70 72 6f 64 75 63 69 62 69 6c 69 74  r reproducibilit
5740: 79 20 6f 66 20 74 68 65 20 73 65 6c 66 73 69 67  y of the selfsig
5750: 2c 20 61 6c 77 61 79 73 20 75 73 65 20 74 68 65  , always use the
5760: 20 73 61 6d 65 20 6f 72 64 65 72 3a 0a 5c 20 22   same order:.\ "
5770: 70 75 62 6b 65 79 22 20 6e 65 77 6b 65 79 20 3c  pubkey" newkey <
5780: 6e 3e 20 6b 65 79 74 79 70 65 20 22 6e 69 63 6b  n> keytype "nick
5790: 22 20 6b 65 79 6e 69 63 6b 20 22 73 69 67 22 20  " keynick "sig" 
57a0: 6b 65 79 73 65 6c 66 73 69 67 0a 0a 55 73 65 72  keyselfsig..User
57b0: 20 70 6b 2b 73 69 67 24 0a 0a 6b 65 79 73 69 7a   pk+sig$..keysiz
57c0: 65 32 20 43 6f 6e 73 74 61 6e 74 20 70 6b 72 6b  e2 Constant pkrk
57d0: 23 0a 0a 3a 20 5d 70 6b 2b 73 69 67 6e 20 28 20  #..: ]pk+sign ( 
57e0: 61 64 64 72 20 75 20 2d 2d 20 29 20 2b 63 6d 64  addr u -- ) +cmd
57f0: 62 75 66 20 5d 73 69 67 6e 20 3b 0a 0a 3a 20 70  buf ]sign ;..: p
5800: 61 63 6b 2d 6b 65 79 20 28 20 74 79 70 65 20 6e  ack-key ( type n
5810: 69 63 6b 20 75 20 2d 2d 20 29 0a 20 20 20 20 6e  ick u -- ).    n
5820: 6f 77 3e 6e 65 76 65 72 0a 20 20 20 20 6b 65 79  ow>never.    key
5830: 3a 63 6f 64 65 0a 20 20 20 20 20 20 73 69 67 6e  :code.      sign
5840: 5b 0a 20 20 20 20 20 20 72 6f 74 20 75 6c 69 74  [.      rot ulit
5850: 2c 20 6b 65 79 74 79 70 65 20 24 2c 20 6b 65 79  , keytype $, key
5860: 6e 69 63 6b 0a 20 20 20 20 20 20 70 6b 63 20 70  nick.      pkc p
5870: 6b 72 6b 23 20 5d 70 6b 2b 73 69 67 6e 0a 20 20  krk# ]pk+sign.  
5880: 20 20 20 20 73 6b 63 20 6b 65 79 73 69 7a 65 20      skc keysize 
5890: 73 65 63 24 2c 20 70 72 69 76 6b 65 79 0a 20 20  sec$, privkey.  
58a0: 20 20 65 6e 64 3a 6b 65 79 20 3b 0a 0a 61 6c 73    end:key ;..als
58b0: 6f 20 6e 65 74 32 6f 2d 62 61 73 65 0a 3a 20 70  o net2o-base.: p
58c0: 61 63 6b 2d 63 6f 72 65 20 28 20 6f 3a 6b 65 79  ack-core ( o:key
58d0: 20 2d 2d 20 29 20 5c 20 63 6f 72 65 20 77 69 74   -- ) \ core wit
58e0: 68 6f 75 74 20 6b 65 79 0a 20 20 20 20 6b 65 2d  hout key.    ke-
58f0: 74 79 70 65 20 40 20 75 6c 69 74 2c 20 6b 65 79  type @ ulit, key
5900: 74 79 70 65 0a 20 20 20 20 6b 65 2d 6e 69 63 6b  type.    ke-nick
5910: 20 24 40 20 24 2c 20 6b 65 79 6e 69 63 6b 0a 20   $@ $, keynick. 
5920: 20 20 20 6b 65 2d 70 72 6f 66 20 24 40 20 64 75     ke-prof $@ du
5930: 70 20 49 46 20 20 24 2c 20 6b 65 79 70 72 6f 66  p IF  $, keyprof
5940: 69 6c 65 20 20 45 4c 53 45 20 20 32 64 72 6f 70  ile  ELSE  2drop
5950: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 70 61 63 6b    THEN ;..: pack
5960: 2d 73 69 67 6e 6b 65 79 20 28 20 6f 3a 6b 65 79  -signkey ( o:key
5970: 20 2d 2d 20 29 0a 20 20 20 20 73 69 67 6e 5b 0a   -- ).    sign[.
5980: 20 20 20 20 70 61 63 6b 2d 63 6f 72 65 0a 20 20      pack-core.  
5990: 20 20 6b 65 2d 70 6b 20 24 40 20 2b 63 6d 64 62    ke-pk $@ +cmdb
59a0: 75 66 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73 69  uf.    ke-selfsi
59b0: 67 20 24 40 20 2b 63 6d 64 62 75 66 20 63 6d 64  g $@ +cmdbuf cmd
59c0: 2d 72 65 73 6f 6c 76 65 3e 20 32 64 72 6f 70 20  -resolve> 2drop 
59d0: 6e 65 73 74 73 69 67 20 3b 0a 0a 3a 20 70 61 63  nestsig ;..: pac
59e0: 6b 2d 63 6f 72 65 6b 65 79 20 28 20 6f 3a 6b 65  k-corekey ( o:ke
59f0: 79 20 2d 2d 20 29 0a 20 20 20 20 70 61 63 6b 2d  y -- ).    pack-
5a00: 73 69 67 6e 6b 65 79 0a 20 20 20 20 6b 65 2d 69  signkey.    ke-i
5a10: 6d 70 6f 72 74 73 20 40 20 75 6c 69 74 2c 20 6b  mports @ ulit, k
5a20: 65 79 69 6d 70 6f 72 74 0a 20 20 20 20 6b 65 2d  eyimport.    ke-
5a30: 6d 61 73 6b 20 40 20 20 6b 65 2d 67 72 6f 75 70  mask @  ke-group
5a40: 73 20 24 40 6c 65 6e 20 49 46 0a 09 6b 65 2d 67  s $@len IF..ke-g
5a50: 72 6f 75 70 73 20 24 40 20 32 64 75 70 20 24 2c  roups $@ 2dup $,
5a60: 20 6b 65 79 67 72 6f 75 70 73 0a 09 67 72 6f 75   keygroups..grou
5a70: 70 73 3e 6d 61 73 6b 20 69 6e 76 65 72 74 20 61  ps>mask invert a
5a80: 6e 64 20 20 54 48 45 4e 0a 20 20 20 20 3f 64 75  nd  THEN.    ?du
5a90: 70 2d 49 46 20 20 6e 6c 69 74 2c 20 6b 65 79 6d  p-IF  nlit, keym
5aa0: 61 73 6b 20 20 54 48 45 4e 0a 20 20 20 20 6b 65  ask  THEN.    ke
5ab0: 2d 70 65 74 73 20 5b 3a 20 24 2c 20 6b 65 79 70  -pets [: $, keyp
5ac0: 65 74 20 3b 5d 20 24 5b 5d 6d 61 70 0a 20 20 20  et ;] $[]map.   
5ad0: 20 6b 65 2d 73 74 6f 72 65 6b 65 79 20 40 20 3e   ke-storekey @ >
5ae0: 73 74 6f 72 65 6b 65 79 20 21 20 3b 0a 70 72 65  storekey ! ;.pre
5af0: 76 69 6f 75 73 0a 0a 3a 20 70 61 63 6b 2d 70 75  vious..: pack-pu
5b00: 62 6b 65 79 20 28 20 6f 3a 6b 65 79 20 2d 2d 20  bkey ( o:key -- 
5b10: 29 0a 20 20 20 20 6b 65 79 3a 63 6f 64 65 0a 20  ).    key:code. 
5b20: 20 20 20 20 20 70 61 63 6b 2d 63 6f 72 65 6b 65       pack-coreke
5b30: 79 0a 20 20 20 20 65 6e 64 3a 6b 65 79 20 3b 0a  y.    end:key ;.
5b40: 3a 20 70 61 63 6b 2d 6f 75 74 6b 65 79 20 28 20  : pack-outkey ( 
5b50: 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20 20 20 6b  o:key -- ).    k
5b60: 65 79 3a 63 6f 64 65 0a 20 20 20 20 20 20 22 6e  ey:code.      "n
5b70: 32 6f 22 20 6e 65 74 32 6f 2d 62 61 73 65 3a 34  2o" net2o-base:4
5b80: 63 63 2c 0a 20 20 20 20 20 20 70 61 63 6b 2d 73  cc,.      pack-s
5b90: 69 67 6e 6b 65 79 0a 20 20 20 20 65 6e 64 3a 6b  ignkey.    end:k
5ba0: 65 79 20 3b 0a 3a 20 70 61 63 6b 2d 73 65 63 6b  ey ;.: pack-seck
5bb0: 65 79 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a  ey ( o:key -- ).
5bc0: 20 20 20 20 6b 65 79 3a 63 6f 64 65 0a 20 20 20      key:code.   
5bd0: 20 20 20 70 61 63 6b 2d 63 6f 72 65 6b 65 79 0a     pack-corekey.
5be0: 20 20 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 40        ke-sk sec@
5bf0: 20 73 65 63 24 2c 20 70 72 69 76 6b 65 79 0a 20   sec$, privkey. 
5c00: 20 20 20 20 20 6b 65 2d 72 73 6b 20 73 65 63 40       ke-rsk sec@
5c10: 20 64 75 70 20 49 46 20 20 73 65 63 24 2c 20 72   dup IF  sec$, r
5c20: 73 6b 6b 65 79 20 20 45 4c 53 45 20 20 32 64 72  skkey  ELSE  2dr
5c30: 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 65 6e 64  op  THEN.    end
5c40: 3a 6b 65 79 20 3b 0a 3a 20 6b 65 79 6e 69 63 6b  :key ;.: keynick
5c50: 24 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 61 64 64  $ ( o:key -- add
5c60: 72 20 75 20 29 0a 20 20 20 20 5c 47 20 67 65 74  r u ).    \G get
5c70: 20 74 68 65 20 61 6e 6e 6f 74 61 74 69 6f 6e 73   the annotations
5c80: 20 77 69 74 68 20 73 69 67 6e 61 74 75 72 65 0a   with signature.
5c90: 20 20 20 20 5b 27 5d 20 70 61 63 6b 2d 63 6f 72      ['] pack-cor
5ca0: 65 20 67 65 6e 2d 63 6d 64 24 20 32 64 72 6f 70  e gen-cmd$ 2drop
5cb0: 0a 20 20 20 20 6b 65 2d 73 65 6c 66 73 69 67 20  .    ke-selfsig 
5cc0: 24 40 20 74 6d 70 24 20 24 2b 21 20 74 6d 70 24  $@ tmp$ $+! tmp$
5cd0: 20 24 40 20 3b 0a 3a 20 6b 65 79 70 6b 32 6e 69   $@ ;.: keypk2ni
5ce0: 63 6b 24 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 61  ck$ ( o:key -- a
5cf0: 64 64 72 20 75 20 29 0a 20 20 20 20 5c 47 20 67  ddr u ).    \G g
5d00: 65 74 20 74 68 65 20 61 6e 6e 6f 74 61 74 69 6f  et the annotatio
5d10: 6e 73 20 77 69 74 68 20 73 69 67 6e 61 74 75 72  ns with signatur
5d20: 65 0a 20 20 20 20 5b 27 5d 20 70 61 63 6b 2d 63  e.    ['] pack-c
5d30: 6f 72 65 20 67 65 6e 2d 63 6d 64 24 20 32 64 72  ore gen-cmd$ 2dr
5d40: 6f 70 0a 20 20 20 20 6b 65 2d 70 6b 20 24 40 20  op.    ke-pk $@ 
5d50: 74 6d 70 24 20 24 2b 21 20 6b 65 2d 73 65 6c 66  tmp$ $+! ke-self
5d60: 73 69 67 20 24 40 20 74 6d 70 24 20 24 2b 21 20  sig $@ tmp$ $+! 
5d70: 74 6d 70 24 20 24 40 20 3b 0a 3a 20 6d 79 6e 69  tmp$ $@ ;.: myni
5d80: 63 6b 2d 6b 65 79 20 28 20 2d 2d 20 6f 20 29 0a  ck-key ( -- o ).
5d90: 20 20 20 20 70 6b 63 20 6b 65 79 73 69 7a 65 20      pkc keysize 
5da0: 6b 65 79 23 20 23 40 20 64 72 6f 70 20 63 65 6c  key# #@ drop cel
5db0: 6c 2b 20 3b 0a 3a 20 6d 79 6e 69 63 6b 24 20 28  l+ ;.: mynick$ (
5dc0: 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20   -- addr u ).   
5dd0: 20 5c 47 20 67 65 74 20 6d 79 20 6e 69 63 6b 20   \G get my nick 
5de0: 77 69 74 68 20 73 69 67 6e 61 74 75 72 65 0a 20  with signature. 
5df0: 20 20 20 6d 79 6e 69 63 6b 2d 6b 65 79 20 2e 6b     mynick-key .k
5e00: 65 79 6e 69 63 6b 24 20 3b 0a 3a 20 6d 79 70 6b  eynick$ ;.: mypk
5e10: 32 6e 69 63 6b 24 20 28 20 6f 3a 6b 65 79 20 2d  2nick$ ( o:key -
5e20: 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 5c  - addr u ).    \
5e30: 47 20 67 65 74 20 6d 79 20 6e 69 63 6b 20 77 69  G get my nick wi
5e40: 74 68 20 73 69 67 6e 61 74 75 72 65 0a 20 20 20  th signature.   
5e50: 20 6d 79 6e 69 63 6b 2d 6b 65 79 20 2e 6b 65 79   mynick-key .key
5e60: 70 6b 32 6e 69 63 6b 24 20 3b 0a 3a 20 6b 65 79  pk2nick$ ;.: key
5e70: 2d 73 69 67 6e 20 28 20 6f 3a 6b 65 79 20 2d 2d  -sign ( o:key --
5e80: 20 6f 3a 6b 65 79 20 29 0a 20 20 20 20 5b 27 5d   o:key ).    [']
5e90: 20 70 61 63 6b 2d 63 6f 72 65 20 67 65 6e 2d 63   pack-core gen-c
5ea0: 6d 64 24 0a 20 20 20 20 5b 3a 20 74 79 70 65 20  md$.    [: type 
5eb0: 6b 65 2d 70 6b 20 24 40 20 74 79 70 65 20 3b 5d  ke-pk $@ type ;]
5ec0: 20 24 74 6d 70 0a 20 20 20 20 6e 6f 77 3e 6e 65   $tmp.    now>ne
5ed0: 76 65 72 20 63 3a 30 6b 65 79 20 63 3a 68 61 73  ver c:0key c:has
5ee0: 68 20 5b 27 5d 20 2e 73 69 67 20 24 74 6d 70 20  h ['] .sig $tmp 
5ef0: 6b 65 2d 73 65 6c 66 73 69 67 20 24 21 20 3b 0a  ke-selfsig $! ;.
5f00: 0a 56 61 72 69 61 62 6c 65 20 63 70 2d 74 6d 70  .Variable cp-tmp
5f10: 0a 0a 3a 20 73 61 76 65 2d 70 75 62 6b 65 79 73  ..: save-pubkeys
5f20: 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 2d   ( -- ).    key-
5f30: 70 66 64 20 3f 64 75 70 2d 49 46 20 20 63 6c 6f  pfd ?dup-IF  clo
5f40: 73 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 20 54  se-file throw  T
5f50: 48 45 4e 0a 20 20 20 20 22 70 75 62 6b 65 79 73  HEN.    "pubkeys
5f60: 2e 6b 32 6f 22 20 2e 6b 65 79 73 2f 20 5b 3a 20  .k2o" .keys/ [: 
5f70: 74 6f 20 6b 65 79 2d 70 66 64 0a 20 20 20 20 20  to key-pfd.     
5f80: 20 6b 65 79 23 20 5b 3a 20 63 65 6c 6c 2b 20 24   key# [: cell+ $
5f90: 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 3e 6f 0a  @ drop cell+ >o.
5fa0: 09 6b 65 2d 73 6b 20 73 65 63 40 20 64 30 3d 20  .ke-sk sec@ d0= 
5fb0: 49 46 20 20 70 61 63 6b 2d 70 75 62 6b 65 79 0a  IF  pack-pubkey.
5fc0: 09 20 20 20 20 66 6c 75 73 68 28 20 2e 22 20 73  .    flush( ." s
5fd0: 61 76 69 6e 67 20 22 20 2e 6e 69 63 6b 20 66 6f  aving " .nick fo
5fe0: 72 74 68 3a 63 72 20 29 0a 09 20 20 20 20 6b 65  rth:cr )..    ke
5ff0: 79 2d 63 72 79 70 74 20 6b 65 2d 6f 66 66 73 65  y-crypt ke-offse
6000: 74 20 36 34 40 20 6b 65 79 3e 70 66 69 6c 65 40  t 64@ key>pfile@
6010: 70 6f 73 0a 09 54 48 45 4e 20 6f 3e 20 3b 5d 20  pos..THEN o> ;] 
6020: 23 6d 61 70 0a 20 20 20 20 30 20 74 6f 20 6b 65  #map.    0 to ke
6030: 79 2d 70 66 64 20 3b 5d 20 73 61 76 65 2d 66 69  y-pfd ;] save-fi
6040: 6c 65 20 20 3f 6b 65 79 2d 70 66 64 20 64 72 6f  le  ?key-pfd dro
6050: 70 20 3b 0a 0a 3a 20 73 61 76 65 2d 73 65 63 6b  p ;..: save-seck
6060: 65 79 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b  eys ( -- ).    k
6070: 65 79 2d 73 66 64 20 3f 64 75 70 2d 49 46 20 20  ey-sfd ?dup-IF  
6080: 63 6c 6f 73 65 2d 66 69 6c 65 20 74 68 72 6f 77  close-file throw
6090: 20 20 54 48 45 4e 0a 20 20 20 20 22 73 65 63 6b    THEN.    "seck
60a0: 65 79 73 2e 6b 32 6f 22 20 2e 6b 65 79 73 2f 20  eys.k2o" .keys/ 
60b0: 5b 3a 20 74 6f 20 6b 65 79 2d 73 66 64 0a 20 20  [: to key-sfd.  
60c0: 20 20 20 20 6b 65 79 23 20 5b 3a 20 63 65 6c 6c      key# [: cell
60d0: 2b 20 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20  + $@ drop cell+ 
60e0: 3e 6f 0a 09 6b 65 2d 73 6b 20 73 65 63 40 20 64  >o..ke-sk sec@ d
60f0: 30 3c 3e 20 49 46 20 20 70 61 63 6b 2d 73 65 63  0<> IF  pack-sec
6100: 6b 65 79 0a 09 20 20 20 20 63 6f 6e 66 69 67 3a  key..    config:
6110: 70 77 2d 6c 65 76 65 6c 23 20 40 20 3e 72 20 20  pw-level# @ >r  
6120: 6b 65 2d 70 77 6c 65 76 65 6c 20 40 20 63 6f 6e  ke-pwlevel @ con
6130: 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23 20 21 0a  fig:pw-level# !.
6140: 09 20 20 20 20 6b 65 79 2d 63 72 79 70 74 20 6b  .    key-crypt k
6150: 65 2d 6f 66 66 73 65 74 20 36 34 40 20 6b 65 79  e-offset 64@ key
6160: 3e 73 66 69 6c 65 40 70 6f 73 0a 09 20 20 20 20  >sfile@pos..    
6170: 72 3e 20 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76  r> config:pw-lev
6180: 65 6c 23 20 21 0a 09 54 48 45 4e 20 6f 3e 20 3b  el# !..THEN o> ;
6190: 5d 20 23 6d 61 70 0a 20 20 20 20 30 20 74 6f 20  ] #map.    0 to 
61a0: 6b 65 79 2d 73 66 64 20 3b 5d 20 73 61 76 65 2d  key-sfd ;] save-
61b0: 66 69 6c 65 20 20 3f 6b 65 79 2d 73 66 64 20 64  file  ?key-sfd d
61c0: 72 6f 70 20 3b 0a 0a 3a 20 73 61 76 65 2d 6b 65  rop ;..: save-ke
61d0: 79 73 20 28 20 2d 2d 20 29 20 20 3f 2e 6e 65 74  ys ( -- )  ?.net
61e0: 32 6f 2f 6b 65 79 73 0a 20 20 20 20 73 61 76 65  2o/keys.    save
61f0: 2d 70 75 62 6b 65 79 73 20 73 61 76 65 2d 73 65  -pubkeys save-se
6200: 63 6b 65 79 73 20 3b 0a 0a 3a 20 2b 67 65 6e 2d  ckeys ;..: +gen-
6210: 6b 65 79 73 20 28 20 6e 69 63 6b 20 75 20 74 79  keys ( nick u ty
6220: 70 65 20 2d 2d 20 29 0a 20 20 20 20 67 65 6e 2d  pe -- ).    gen-
6230: 6b 65 79 73 20 20 36 34 23 2d 31 20 6b 65 79 2d  keys  64#-1 key-
6240: 72 65 61 64 2d 6f 66 66 73 65 74 20 36 34 21 20  read-offset 64! 
6250: 20 70 6b 63 20 6b 65 79 73 69 7a 65 32 20 6b 65   pkc keysize2 ke
6260: 79 3a 6e 65 77 20 3e 6f 0a 20 20 20 20 5b 20 31  y:new >o.    [ 1
6270: 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 6c 73 68   import#self lsh
6280: 69 66 74 20 31 20 69 6d 70 6f 72 74 23 6e 65 77  ift 1 import#new
6290: 20 6c 73 68 69 66 74 20 6f 72 20 5d 4c 20 6b 65   lshift or ]L ke
62a0: 2d 69 6d 70 6f 72 74 73 20 21 0a 20 20 20 20 6b  -imports !.    k
62b0: 65 2d 74 79 70 65 20 21 20 20 6b 65 2d 6e 69 63  e-type !  ke-nic
62c0: 6b 20 24 21 20 20 6e 69 63 6b 21 0a 20 20 20 20  k $!  nick!.    
62d0: 63 6f 6e 66 69 67 3a 70 77 2d 6c 65 76 65 6c 23  config:pw-level#
62e0: 20 40 20 6b 65 2d 70 77 6c 65 76 65 6c 20 21 20   @ ke-pwlevel ! 
62f0: 20 70 65 72 6d 25 6d 79 73 65 6c 66 20 6b 65 2d   perm%myself ke-
6300: 6d 61 73 6b 20 21 0a 20 20 20 20 73 6b 63 20 6b  mask !.    skc k
6310: 65 79 73 69 7a 65 20 6b 65 2d 73 6b 20 73 65 63  eysize ke-sk sec
6320: 21 20 20 2b 73 65 63 6b 65 79 0a 20 20 20 20 73  !  +seckey.    s
6330: 6b 72 65 76 20 6b 65 79 73 69 7a 65 20 6b 65 2d  krev keysize ke-
6340: 72 73 6b 20 73 65 63 21 0a 20 20 20 20 6b 65 79  rsk sec!.    key
6350: 2d 73 69 67 6e 20 6f 3e 20 3b 0a 0a 24 34 30 20  -sign o> ;..$40 
6360: 62 75 66 66 65 72 3a 20 6e 69 63 6b 2d 62 75 66  buffer: nick-buf
6370: 0a 0a 3a 20 67 65 74 2d 6e 69 63 6b 20 28 20 2d  ..: get-nick ( -
6380: 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 2e  - addr u ).    .
6390: 22 20 6e 69 63 6b 3a 20 22 20 6e 69 63 6b 2d 62  " nick: " nick-b
63a0: 75 66 20 24 34 30 20 61 63 63 65 70 74 20 6e 69  uf $40 accept ni
63b0: 63 6b 2d 62 75 66 20 73 77 61 70 20 2d 74 72 61  ck-buf swap -tra
63c0: 69 6c 69 6e 67 20 63 72 20 3b 0a 0a 66 61 6c 73  iling cr ;..fals
63d0: 65 20 76 61 6c 75 65 20 3f 79 65 73 0a 3a 20 79  e value ?yes.: y
63e0: 65 73 3f 20 28 20 61 64 64 72 20 75 20 2d 2d 20  es? ( addr u -- 
63f0: 66 6c 61 67 20 29 0a 20 20 20 20 3f 79 65 73 20  flag ).    ?yes 
6400: 49 46 20 20 32 64 72 6f 70 20 74 72 75 65 20 20  IF  2drop true  
6410: 45 4c 53 45 20 20 74 79 70 65 20 2e 22 20 20 28  ELSE  type ."  (
6420: 79 2f 4e 29 22 20 6b 65 79 20 63 72 20 27 79 27  y/N)" key cr 'y'
6430: 20 3d 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 3f 72   =  THEN ;..: ?r
6440: 73 6b 20 28 20 2d 2d 20 29 0a 20 20 20 20 70 6b  sk ( -- ).    pk
6450: 63 20 6b 65 79 73 69 7a 65 20 6b 65 79 2d 65 78  c keysize key-ex
6460: 69 73 74 3f 20 64 75 70 20 30 3d 20 49 46 20 20  ist? dup 0= IF  
6470: 64 72 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e  drop  EXIT  THEN
6480: 0a 20 20 20 20 3e 6f 20 6b 65 2d 72 73 6b 20 73  .    >o ke-rsk s
6490: 65 63 40 20 64 75 70 20 30 3d 20 49 46 20 20 32  ec@ dup 0= IF  2
64a0: 64 72 6f 70 20 6f 3e 20 20 45 58 49 54 20 20 54  drop o>  EXIT  T
64b0: 48 45 4e 0a 20 20 20 20 2e 22 20 59 6f 75 20 73  HEN.    ." You s
64c0: 74 69 6c 6c 20 68 61 76 65 6e 27 74 20 73 74 6f  till haven't sto
64d0: 72 65 64 20 79 6f 75 72 20 72 65 76 6f 6b 65 20  red your revoke 
64e0: 6b 65 79 20 73 65 63 75 72 65 6c 79 20 6f 66 66  key securely off
64f0: 2d 6c 69 6e 65 2e 22 20 63 72 0a 20 20 20 20 73  -line." cr.    s
6500: 22 20 50 61 70 65 72 20 61 6e 64 20 70 65 6e 63  " Paper and penc
6510: 69 6c 20 72 65 61 64 79 3f 22 20 79 65 73 3f 20  il ready?" yes? 
6520: 49 46 0a 09 2e 73 74 72 69 70 65 38 35 0a 09 73  IF...stripe85..s
6530: 22 20 57 72 69 74 74 65 6e 20 64 6f 77 6e 3f 22  " Written down?"
6540: 20 79 65 73 3f 20 49 46 0a 09 20 20 20 20 73 22   yes? IF..    s"
6550: 20 59 6f 75 20 77 6f 6e 27 74 20 73 65 65 20 74   You won't see t
6560: 68 69 73 20 61 67 61 69 6e 21 20 44 65 6c 65 74  his again! Delet
6570: 65 3f 22 20 79 65 73 3f 0a 09 20 20 20 20 49 46  e?" yes?..    IF
6580: 20 6b 65 2d 72 73 6b 20 73 65 63 2d 6f 66 66 20   ke-rsk sec-off 
6590: 20 73 61 76 65 2d 6b 65 79 73 0a 09 09 2e 22 20   save-keys...." 
65a0: 72 65 76 6f 6b 65 20 6b 65 79 20 64 65 6c 65 74  revoke key delet
65b0: 65 64 2e 22 20 63 72 20 6f 3e 20 20 45 58 49 54  ed." cr o>  EXIT
65c0: 20 20 54 48 45 4e 20 20 54 48 45 4e 0a 20 20 20    THEN  THEN.   
65d0: 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48   ELSE  2drop  TH
65e0: 45 4e 0a 20 20 20 20 2e 22 20 49 27 6d 20 6b 65  EN.    ." I'm ke
65f0: 65 70 69 6e 67 20 79 6f 75 72 20 72 65 76 6f 6b  eping your revok
6600: 65 20 6b 65 79 2e 20 20 54 68 69 73 20 77 69 6c  e key.  This wil
6610: 6c 20 73 68 6f 77 20 75 70 20 61 67 61 69 6e 2e  l show up again.
6620: 22 20 63 72 20 6f 3e 20 3b 0a 0a 5c 20 72 65 61  " cr o> ;..\ rea
6630: 64 20 6b 65 79 20 66 69 6c 65 0a 0a 3a 20 74 72  d key file..: tr
6640: 79 2d 64 65 63 72 79 70 74 2d 6b 65 79 20 28 20  y-decrypt-key ( 
6650: 6b 65 79 20 75 31 20 2d 2d 20 61 64 64 72 20 75  key u1 -- addr u
6660: 32 20 66 6c 61 67 20 29 0a 20 20 20 20 6b 65 79  2 flag ).    key
6670: 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d 64 20 6b  pack keypack-d k
6680: 65 79 70 61 63 6b 2d 61 6c 6c 23 20 6d 6f 76 65  eypack-all# move
6690: 0a 20 20 20 20 6b 65 79 70 61 63 6b 2d 64 20 6b  .    keypack-d k
66a0: 65 79 70 61 63 6b 2d 61 6c 6c 23 20 32 73 77 61  eypack-all# 2swa
66b0: 70 0a 20 20 20 20 64 75 70 20 24 32 30 20 3d 20  p.    dup $20 = 
66c0: 49 46 20 20 64 65 63 72 79 70 74 24 20 20 45 4c  IF  decrypt$  EL
66d0: 53 45 0a 09 6b 65 79 70 61 63 6b 20 63 40 20 24  SE..keypack c@ $
66e0: 46 20 61 6e 64 20 63 6f 6e 66 69 67 3a 70 77 2d  F and config:pw-
66f0: 6d 61 78 6c 65 76 65 6c 23 20 40 20 3c 3d 0a 09  maxlevel# @ <=..
6700: 49 46 20 20 64 65 63 72 79 70 74 2d 70 77 24 20  IF  decrypt-pw$ 
6710: 20 45 4c 53 45 20 20 32 64 72 6f 70 20 66 61 6c   ELSE  2drop fal
6720: 73 65 20 20 54 48 45 4e 0a 20 20 20 20 54 48 45  se  THEN.    THE
6730: 4e 20 3b 0a 0a 3a 20 74 72 79 2d 64 65 63 72 79  N ;..: try-decry
6740: 70 74 20 28 20 66 6c 61 67 20 2d 2d 20 61 64 64  pt ( flag -- add
6750: 72 20 75 20 2f 20 30 20 30 20 29 20 7b 20 66 6c  r u / 0 0 ) { fl
6760: 61 67 20 7d 0a 20 20 20 20 6b 65 79 73 20 24 5b  ag }.    keys $[
6770: 5d 23 20 30 20 3f 44 4f 0a 09 49 20 6b 65 79 73  ]# 0 ?DO..I keys
6780: 20 73 65 63 5b 5d 40 20 64 75 70 20 6b 65 79 73   sec[]@ dup keys
6790: 69 7a 65 20 3d 20 66 6c 61 67 20 78 6f 72 20 49  ize = flag xor I
67a0: 46 0a 09 20 20 20 20 74 72 79 2d 64 65 63 72 79  F..    try-decry
67b0: 70 74 2d 6b 65 79 20 49 46 0a 09 09 49 20 6b 65  pt-key IF...I ke
67c0: 79 73 20 24 5b 5d 20 40 20 64 75 70 20 3e 73 74  ys $[] @ dup >st
67d0: 6f 72 65 6b 65 79 20 21 20 64 65 66 61 75 6c 74  orekey ! default
67e0: 6b 65 79 20 21 0a 09 09 75 6e 6c 6f 6f 70 20 20  key !...unloop  
67f0: 45 58 49 54 20 20 54 48 45 4e 20 20 54 48 45 4e  EXIT  THEN  THEN
6800: 0a 09 32 64 72 6f 70 0a 20 20 20 20 4c 4f 4f 50  ..2drop.    LOOP
6810: 20 20 30 20 30 20 3b 0a 0a 3a 20 3f 70 65 72 6d    0 0 ;..: ?perm
6820: 20 28 20 6f 3a 6b 65 79 20 2d 2d 20 29 0a 20 20   ( o:key -- ).  
6830: 20 20 6b 65 2d 73 6b 20 73 65 63 40 20 6e 69 70    ke-sk sec@ nip
6840: 20 64 75 70 20 49 46 20 20 70 65 72 6d 25 6d 79   dup IF  perm%my
6850: 73 65 6c 66 20 20 45 4c 53 45 20 20 70 65 72 6d  self  ELSE  perm
6860: 25 64 65 66 61 75 6c 74 20 20 54 48 45 4e 20 20  %default  THEN  
6870: 6b 65 2d 6d 61 73 6b 20 21 0a 20 20 20 20 49 46  ke-mask !.    IF
6880: 20 20 22 5c 78 30 30 22 20 20 45 4c 53 45 20 20    "\x00"  ELSE  
6890: 22 5c 78 30 31 22 20 20 54 48 45 4e 20 20 6b 65  "\x01"  THEN  ke
68a0: 2d 67 72 6f 75 70 73 20 24 21 20 3b 0a 0a 3a 20  -groups $! ;..: 
68b0: 64 6f 2d 6b 65 79 20 28 20 61 64 64 72 20 75 20  do-key ( addr u 
68c0: 2f 20 30 20 30 20 20 2d 2d 20 29 0a 20 20 20 20  / 0 0  -- ).    
68d0: 64 75 70 20 30 3d 20 49 46 20 20 32 64 72 6f 70  dup 0= IF  2drop
68e0: 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20    EXIT  THEN.   
68f0: 20 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 6b   sample-key >o k
6900: 65 2d 73 6b 20 6b 65 2d 65 6e 64 20 6f 76 65 72  e-sk ke-end over
6910: 20 2d 20 65 72 61 73 65 20 20 64 6f 2d 63 6d 64   - erase  do-cmd
6920: 2d 6c 6f 6f 70 20 6f 3e 20 3b 0a 0a 3a 20 2e 6b  -loop o> ;..: .k
6930: 65 79 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20  ey$ ( addr u -- 
6940: 29 0a 20 20 20 20 73 61 6d 70 6c 65 2d 6b 65 79  ).    sample-key
6950: 20 3e 6f 20 20 6b 65 2d 73 6b 20 6b 65 2d 65 6e   >o  ke-sk ke-en
6960: 64 20 6f 76 65 72 20 2d 20 65 72 61 73 65 0a 20  d over - erase. 
6970: 20 20 20 73 69 67 6e 65 64 2d 76 61 6c 20 76 61     signed-val va
6980: 6c 69 64 61 74 65 64 20 6f 72 21 20 20 63 2d 73  lidated or!  c-s
6990: 74 61 74 65 20 6f 66 66 20 20 6e 65 73 74 2d 63  tate off  nest-c
69a0: 6d 64 2d 6c 6f 6f 70 0a 20 20 20 20 73 69 67 6e  md-loop.    sign
69b0: 65 64 2d 76 61 6c 20 69 6e 76 65 72 74 20 76 61  ed-val invert va
69c0: 6c 69 64 61 74 65 64 20 61 6e 64 21 0a 20 20 20  lidated and!.   
69d0: 20 2e 6b 65 79 2d 73 68 6f 72 74 20 66 72 65 65   .key-short free
69e0: 2d 6b 65 79 20 6f 3e 20 3b 0a 0a 3a 20 72 65 61  -key o> ;..: rea
69f0: 64 2d 6b 65 79 73 2d 6c 6f 6f 70 20 28 20 66 64  d-keys-loop ( fd
6a00: 20 2d 2d 20 29 20 20 63 6f 64 65 2d 6b 65 79 0a   -- )  code-key.
6a10: 20 20 20 20 3e 72 20 23 30 2e 20 72 40 20 72 65      >r #0. r@ re
6a20: 70 6f 73 69 74 69 6f 6e 2d 66 69 6c 65 20 74 68  position-file th
6a30: 72 6f 77 0a 20 20 20 20 42 45 47 49 4e 0a 09 72  row.    BEGIN..r
6a40: 40 20 66 69 6c 65 2d 70 6f 73 69 74 69 6f 6e 20  @ file-position 
6a50: 74 68 72 6f 77 20 64 3e 36 34 20 6b 65 79 2d 72  throw d>64 key-r
6a60: 65 61 64 2d 6f 66 66 73 65 74 20 36 34 21 0a 09  ead-offset 64!..
6a70: 6b 65 79 70 61 63 6b 20 6b 65 79 70 61 63 6b 2d  keypack keypack-
6a80: 61 6c 6c 23 20 72 40 20 72 65 61 64 2d 66 69 6c  all# r@ read-fil
6a90: 65 20 74 68 72 6f 77 0a 09 6b 65 79 70 61 63 6b  e throw..keypack
6aa0: 2d 61 6c 6c 23 20 3d 20 57 48 49 4c 45 0a 09 20  -all# = WHILE.. 
6ab0: 20 20 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 40     import-type @
6ac0: 20 69 6d 70 6f 72 74 23 73 65 6c 66 20 3d 20 74   import#self = t
6ad0: 72 79 2d 64 65 63 72 79 70 74 20 64 6f 2d 6b 65  ry-decrypt do-ke
6ae0: 79 0a 20 20 20 20 52 45 50 45 41 54 20 20 72 64  y.    REPEAT  rd
6af0: 72 6f 70 20 20 63 6f 64 65 30 2d 62 75 66 20 3b  rop  code0-buf ;
6b00: 0a 3a 20 72 65 61 64 2d 6b 65 79 2d 6c 6f 6f 70  .: read-key-loop
6b10: 20 28 20 2d 2d 20 29 0a 20 20 20 20 69 6d 70 6f   ( -- ).    impo
6b20: 72 74 23 73 65 6c 66 20 69 6d 70 6f 72 74 2d 74  rt#self import-t
6b30: 79 70 65 20 21 0a 20 20 20 20 3f 6b 65 79 2d 73  ype !.    ?key-s
6b40: 66 64 20 72 65 61 64 2d 6b 65 79 73 2d 6c 6f 6f  fd read-keys-loo
6b50: 70 20 3b 0a 3a 20 72 65 61 64 2d 70 6b 65 79 2d  p ;.: read-pkey-
6b60: 6c 6f 6f 70 20 28 20 2d 2d 20 29 0a 20 20 20 20  loop ( -- ).    
6b70: 6c 61 73 74 6b 65 79 40 20 64 72 6f 70 20 64 65  lastkey@ drop de
6b80: 66 61 75 6c 74 6b 65 79 20 21 20 5c 20 61 74 20  faultkey ! \ at 
6b90: 6c 65 61 73 74 20 6f 6e 65 20 64 65 66 61 75 6c  least one defaul
6ba0: 74 20 6b 65 79 20 61 76 61 69 6c 61 62 6c 65 0a  t key available.
6bb0: 20 20 20 20 2d 31 20 63 6f 6e 66 69 67 3a 70 77      -1 config:pw
6bc0: 2d 6c 65 76 65 6c 23 0a 20 20 20 20 5b 3a 20 69  -level#.    [: i
6bd0: 6d 70 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74  mport#new import
6be0: 2d 74 79 70 65 20 21 20 3f 6b 65 79 2d 70 66 64  -type ! ?key-pfd
6bf0: 20 72 65 61 64 2d 6b 65 79 73 2d 6c 6f 6f 70 20   read-keys-loop 
6c00: 3b 5d 20 21 77 72 61 70 70 65 72 20 3b 0a 0a 3a  ;] !wrapper ;..:
6c10: 20 72 65 61 64 2d 6b 65 79 73 20 28 20 2d 2d 20   read-keys ( -- 
6c20: 29 0a 20 20 20 20 72 65 61 64 2d 6b 65 79 2d 6c  ).    read-key-l
6c30: 6f 6f 70 20 72 65 61 64 2d 70 6b 65 79 2d 6c 6f  oop read-pkey-lo
6c40: 6f 70 20 69 6d 70 6f 72 74 23 6e 65 77 20 69 6d  op import#new im
6c50: 70 6f 72 74 2d 74 79 70 65 20 21 20 3b 0a 0a 3a  port-type ! ;..:
6c60: 20 72 65 61 64 2d 70 6b 32 6b 65 79 24 20 28 20   read-pk2key$ ( 
6c70: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20  addr u -- ).    
6c80: 5c 67 20 72 65 61 64 20 61 20 6e 65 73 74 65 64  \g read a nested
6c90: 20 6b 65 79 20 69 6e 74 6f 20 73 61 6d 70 6c 65   key into sample
6ca0: 2d 6b 65 79 0a 20 20 20 20 73 61 6d 70 6c 65 2d  -key.    sample-
6cb0: 6b 65 79 20 3e 6f 20 63 2d 73 74 61 74 65 20 6f  key >o c-state o
6cc0: 66 66 20 20 73 69 6d 2d 6e 69 63 6b 21 20 6f 6e  ff  sim-nick! on
6cd0: 0a 20 20 20 20 70 6b 32 2d 73 69 67 3f 20 21 21  .    pk2-sig? !!
6ce0: 73 69 67 21 21 20 73 69 67 70 6b 32 73 69 7a 65  sig!! sigpk2size
6cf0: 23 20 2d 20 32 64 75 70 20 2b 20 3e 72 20 64 6f  # - 2dup + >r do
6d00: 2d 6e 65 73 74 73 69 67 0a 20 20 20 20 72 40 20  -nestsig.    r@ 
6d10: 6b 65 79 73 69 7a 65 32 20 6b 65 2d 70 6b 20 24  keysize2 ke-pk $
6d20: 21 0a 20 20 20 20 72 3e 20 6b 65 79 73 69 7a 65  !.    r> keysize
6d30: 32 20 2b 20 73 69 67 73 69 7a 65 23 20 6b 65 2d  2 + sigsize# ke-
6d40: 73 65 6c 66 73 69 67 20 24 21 0a 20 20 20 20 6f  selfsig $!.    o
6d50: 3e 20 20 73 69 6d 2d 6e 69 63 6b 21 20 6f 66 66  >  sim-nick! off
6d60: 20 3b 0a 0a 3a 20 2e 70 6b 32 6b 65 79 24 20 28   ;..: .pk2key$ (
6d70: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20   addr u -- ).   
6d80: 20 72 65 61 64 2d 70 6b 32 6b 65 79 24 20 73 61   read-pk2key$ sa
6d90: 6d 70 6c 65 2d 6b 65 79 20 3e 6f 0a 20 20 20 20  mple-key >o.    
6da0: 5b 20 31 20 69 6d 70 6f 72 74 23 69 6e 76 69 74  [ 1 import#invit
6db0: 65 64 20 6c 73 68 69 66 74 20 31 20 69 6d 70 6f  ed lshift 1 impo
6dc0: 72 74 23 6e 65 77 20 6c 73 68 69 66 74 20 6f 72  rt#new lshift or
6dd0: 20 5d 4c 20 6b 65 2d 69 6d 70 6f 72 74 73 20 21   ]L ke-imports !
6de0: 0a 20 20 20 20 2e 6b 65 79 2d 69 6e 76 69 74 65  .    .key-invite
6df0: 20 66 72 65 65 2d 6b 65 79 20 6f 3e 20 3b 0a 0a   free-key o> ;..
6e00: 5c 20 73 65 6c 65 63 74 20 6b 65 79 20 62 79 20  \ select key by 
6e10: 6e 69 63 6b 0a 0a 3a 20 3e 72 61 77 2d 6b 65 79  nick..: >raw-key
6e20: 20 28 20 6f 20 2d 2d 20 29 0a 20 20 20 20 64 75   ( o -- ).    du
6e30: 70 20 30 3d 20 21 21 6e 6f 2d 6e 69 63 6b 21 21  p 0= !!no-nick!!
6e40: 20 3e 6f 0a 20 20 20 20 6b 65 2d 70 6b 20 24 40   >o.    ke-pk $@
6e50: 20 70 6b 63 20 70 6b 72 6b 23 20 73 6d 6f 76 65   pkc pkrk# smove
6e60: 0a 20 20 20 20 6b 65 2d 73 6b 20 73 65 63 40 20  .    ke-sk sec@ 
6e70: 73 6b 63 20 73 77 61 70 20 6b 65 79 7c 20 6d 6f  skc swap key| mo
6e80: 76 65 0a 20 20 20 20 3e 73 6b 73 69 67 20 6f 3e  ve.    >sksig o>
6e90: 20 3b 0a 0a 3a 20 3e 6b 65 79 20 28 20 61 64 64   ;..: >key ( add
6ea0: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79  r u -- ).    key
6eb0: 23 20 40 20 30 3d 20 49 46 20 20 72 65 61 64 2d  # @ 0= IF  read-
6ec0: 6b 65 79 73 20 20 54 48 45 4e 0a 20 20 20 20 6e  keys  THEN.    n
6ed0: 69 63 6b 2d 6b 65 79 20 3e 72 61 77 2d 6b 65 79  ick-key >raw-key
6ee0: 20 3b 0a 0a 3a 20 69 27 6d 20 28 20 22 6e 61 6d   ;..: i'm ( "nam
6ef0: 65 22 20 2d 2d 20 29 20 70 61 72 73 65 2d 6e 61  e" -- ) parse-na
6f00: 6d 65 20 3e 6b 65 79 20 3b 0a 3a 20 70 6b 27 20  me >key ;.: pk' 
6f10: 28 20 22 6e 61 6d 65 22 20 2d 2d 20 61 64 64 72  ( "name" -- addr
6f20: 20 75 20 29 0a 20 20 20 20 70 61 72 73 65 2d 6e   u ).    parse-n
6f30: 61 6d 65 20 6e 69 63 6b 3e 70 6b 20 3b 0a 0a 3a  ame nick>pk ;..:
6f40: 20 64 65 73 74 2d 6b 65 79 20 28 20 61 64 64 72   dest-key ( addr
6f50: 20 75 20 2d 2d 20 29 20 64 75 70 20 30 3d 20 49   u -- ) dup 0= I
6f60: 46 20 20 32 64 72 6f 70 20 20 45 58 49 54 20 20  F  2drop  EXIT  
6f70: 54 48 45 4e 0a 20 20 20 20 6e 69 63 6b 2d 6b 65  THEN.    nick-ke
6f80: 79 20 3e 6f 20 6f 20 30 3d 20 21 21 75 6e 6b 6e  y >o o 0= !!unkn
6f90: 6f 77 6e 2d 6b 65 79 21 21 0a 20 20 20 20 6b 65  own-key!!.    ke
6fa0: 2d 70 6b 20 24 40 20 6f 3e 0a 20 20 20 20 70 75  -pk $@ o>.    pu
6fb0: 62 6b 65 79 20 24 21 20 3b 0a 0a 3a 20 64 65 73  bkey $! ;..: des
6fc0: 74 2d 70 6b 20 28 20 61 64 64 72 20 75 20 2d 2d  t-pk ( addr u --
6fd0: 20 29 20 6b 65 79 32 7c 20 32 64 75 70 20 6b 65   ) key2| 2dup ke
6fe0: 79 7c 20 6b 65 79 23 20 23 40 20 30 3d 20 49 46  y| key# #@ 0= IF
6ff0: 0a 09 64 72 6f 70 20 70 75 62 6b 65 79 20 24 21  ..drop pubkey $!
7000: 20 20 70 65 72 6d 25 75 6e 6b 6e 6f 77 6e 20 70    perm%unknown p
7010: 65 72 6d 2d 6d 61 73 6b 20 21 0a 20 20 20 20 45  erm-mask !.    E
7020: 4c 53 45 20 20 63 65 6c 6c 2b 20 3e 6f 0a 09 6b  LSE  cell+ >o..k
7030: 65 2d 6d 61 73 6b 20 40 0a 09 6b 65 2d 70 6b 20  e-mask @..ke-pk 
7040: 24 40 20 6f 3e 0a 09 70 75 62 6b 65 79 20 24 21  $@ o>..pubkey $!
7050: 20 20 70 65 72 6d 2d 6d 61 73 6b 20 21 20 20 32    perm-mask !  2
7060: 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 3a 20  drop  THEN ;..: 
7070: 72 65 70 6c 61 63 65 2d 6b 65 79 20 31 20 2f 73  replace-key 1 /s
7080: 74 72 69 6e 67 20 7b 20 72 65 76 2d 61 64 64 72  tring { rev-addr
7090: 20 75 20 2d 2d 20 6f 20 7d 20 5c 20 72 65 76 6f   u -- o } \ revo
70a0: 63 61 74 69 6f 6e 20 74 69 63 6b 65 74 0a 20 20  cation ticket.  
70b0: 20 20 6b 65 79 28 20 2e 22 20 52 65 70 6c 61 63    key( ." Replac
70c0: 65 3a 22 20 63 72 20 6f 20 63 65 6c 6c 2d 20 30  e:" cr o cell- 0
70d0: 20 2e 6b 65 79 20 29 0a 20 20 20 20 69 6d 70 6f   .key ).    impo
70e0: 72 74 23 73 65 6c 66 20 69 6d 70 6f 72 74 2d 74  rt#self import-t
70f0: 79 70 65 20 21 0a 20 20 20 20 73 22 20 23 72 65  ype !.    s" #re
7100: 76 6f 6b 65 64 22 20 64 75 70 20 3e 72 20 6b 65  voked" dup >r ke
7110: 2d 6e 69 63 6b 20 24 2b 21 0a 20 20 20 20 6b 65  -nick $+!.    ke
7120: 2d 6e 69 63 6b 20 24 40 20 72 3e 20 2d 20 6b 65  -nick $@ r> - ke
7130: 2d 70 72 6f 66 20 24 40 20 6b 65 2d 73 69 67 73  -prof $@ ke-sigs
7140: 20 6b 65 2d 74 79 70 65 20 40 0a 20 20 20 20 72   ke-type @.    r
7150: 65 76 2d 61 64 64 72 20 70 6b 72 6b 23 20 6b 65  ev-addr pkrk# ke
7160: 79 3f 6e 65 77 20 3e 6f 0a 20 20 20 20 6b 65 2d  y?new >o.    ke-
7170: 74 79 70 65 20 21 20 5b 3a 20 6b 65 2d 73 69 67  type ! [: ke-sig
7180: 73 20 24 2b 5b 5d 21 20 3b 5d 20 24 5b 5d 6d 61  s $+[]! ;] $[]ma
7190: 70 20 6b 65 2d 70 72 6f 66 20 24 21 20 6b 65 2d  p ke-prof $! ke-
71a0: 6e 69 63 6b 20 24 21 0a 20 20 20 20 72 65 76 2d  nick $!.    rev-
71b0: 61 64 64 72 20 70 6b 72 6b 23 20 6b 65 2d 70 6b  addr pkrk# ke-pk
71c0: 20 24 21 0a 20 20 20 20 72 65 76 2d 61 64 64 72   $!.    rev-addr
71d0: 20 75 20 2b 20 31 2d 20 64 75 70 20 63 40 20 32   u + 1- dup c@ 2
71e0: 2a 20 2d 20 24 31 30 20 2d 20 24 31 30 20 6b 65  * - $10 - $10 ke
71f0: 2d 73 65 6c 66 73 69 67 20 24 21 0a 20 20 20 20  -selfsig $!.    
7200: 6b 65 79 28 20 2e 22 20 77 69 74 68 3a 22 20 63  key( ." with:" c
7210: 72 20 6f 20 63 65 6c 6c 2d 20 30 20 2e 6b 65 79  r o cell- 0 .key
7220: 20 29 20 6f 20 6f 3e 0a 20 20 20 20 69 6d 70 6f   ) o o>.    impo
7230: 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d 74 79  rt#new import-ty
7240: 70 65 20 21 20 3b 0a 0a 3a 20 72 65 6e 65 77 2d  pe ! ;..: renew-
7250: 6b 65 79 20 28 20 72 65 76 61 64 64 72 20 75 31  key ( revaddr u1
7260: 20 6b 65 79 61 64 64 72 20 75 32 20 2d 2d 20 6f   keyaddr u2 -- o
7270: 20 29 0a 20 20 20 20 63 75 72 72 65 6e 74 2d 6b   ).    current-k
7280: 65 79 20 3e 6f 20 72 65 70 6c 61 63 65 2d 6b 65  ey >o replace-ke
7290: 79 20 6f 3e 0a 20 20 20 20 3e 6f 20 73 6b 63 20  y o>.    >o skc 
72a0: 6b 65 79 73 69 7a 65 20 6b 65 2d 73 6b 20 73 65  keysize ke-sk se
72b0: 63 21 20 6f 20 6f 3e 20 3b 0a 0a 5c 20 67 65 6e  c! o o> ;..\ gen
72c0: 65 72 61 74 65 20 6e 65 77 20 6b 65 79 0a 0a 3a  erate new key..:
72d0: 20 6f 75 74 2d 6b 65 79 20 28 20 6f 20 2d 2d 20   out-key ( o -- 
72e0: 29 0a 20 20 20 20 3e 6f 20 70 61 63 6b 2d 6f 75  ).    >o pack-ou
72f0: 74 6b 65 79 20 5b 27 5d 20 2e 6e 69 63 6b 2d 62  tkey ['] .nick-b
7300: 61 73 65 20 24 74 6d 70 20 66 6e 2d 73 61 6e 69  ase $tmp fn-sani
7310: 74 69 7a 65 20 6f 3e 0a 20 20 20 20 5b 3a 20 2e  tize o>.    [: .
7320: 22 20 7e 2f 22 20 74 79 70 65 20 2e 22 20 2e 6e  " ~/" type ." .n
7330: 32 6f 22 20 3b 5d 20 24 74 6d 70 20 77 2f 6f 20  2o" ;] $tmp w/o 
7340: 63 72 65 61 74 65 2d 66 69 6c 65 20 74 68 72 6f  create-file thro
7350: 77 0a 20 20 20 20 3e 72 20 63 6d 64 62 75 66 24  w.    >r cmdbuf$
7360: 20 72 40 20 77 72 69 74 65 2d 66 69 6c 65 20 74   r@ write-file t
7370: 68 72 6f 77 20 72 3e 20 63 6c 6f 73 65 2d 66 69  hrow r> close-fi
7380: 6c 65 20 74 68 72 6f 77 20 3b 0a 3a 20 6f 75 74  le throw ;.: out
7390: 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 70  -me ( -- ).    p
73a0: 6b 63 20 6b 65 79 73 69 7a 65 20 6b 65 79 23 20  kc keysize key# 
73b0: 23 40 20 30 3d 20 21 21 75 6e 6b 6e 6f 77 6e 2d  #@ 0= !!unknown-
73c0: 6b 65 79 21 21 0a 20 20 20 20 63 65 6c 6c 2b 20  key!!.    cell+ 
73d0: 6f 75 74 2d 6b 65 79 20 3b 0a 0a 56 61 72 69 61  out-key ;..Varia
73e0: 62 6c 65 20 64 68 74 72 6f 6f 74 2e 6e 32 6f 0a  ble dhtroot.n2o.
73f0: 0a 3a 20 2b 64 68 74 72 6f 6f 74 20 28 20 2d 2d  .: +dhtroot ( --
7400: 20 29 0a 20 20 20 20 64 65 66 61 75 6c 74 6b 65   ).    defaultke
7410: 79 20 40 20 3e 73 74 6f 72 65 6b 65 79 20 21 0a  y @ >storekey !.
7420: 20 20 20 20 69 6d 70 6f 72 74 23 6d 61 6e 75 61      import#manua
7430: 6c 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20  l import-type ! 
7440: 20 36 34 23 2d 31 20 6b 65 79 2d 72 65 61 64 2d   64#-1 key-read-
7450: 6f 66 66 73 65 74 20 36 34 21 0a 20 20 20 20 64  offset 64!.    d
7460: 68 74 72 6f 6f 74 2e 6e 32 6f 20 24 40 20 64 6f  htroot.n2o $@ do
7470: 2d 6b 65 79 0a 20 20 20 20 6c 61 73 74 2d 6b 65  -key.    last-ke
7480: 79 20 3e 6f 20 22 5c 78 30 32 22 20 6b 65 2d 67  y >o "\x02" ke-g
7490: 72 6f 75 70 73 20 24 21 20 70 65 72 6d 25 64 68  roups $! perm%dh
74a0: 74 72 6f 6f 74 20 6b 65 2d 6d 61 73 6b 20 21 20  troot ke-mask ! 
74b0: 6f 3e 0a 20 20 20 20 69 6d 70 6f 72 74 23 6e 65  o>.    import#ne
74c0: 77 20 69 6d 70 6f 72 74 2d 74 79 70 65 20 21 20  w import-type ! 
74d0: 3b 0a 0a 3a 20 6e 65 77 2d 6b 65 79 20 28 20 6e  ;..: new-key ( n
74e0: 69 63 6b 61 64 64 72 20 75 20 2d 2d 20 29 0a 20  ickaddr u -- ). 
74f0: 20 20 20 3f 63 68 65 63 6b 2d 72 6e 67 20 5c 20     ?check-rng \ 
7500: 62 65 66 6f 72 65 20 67 65 6e 65 72 61 74 69 6e  before generatin
7510: 67 20 61 20 6b 65 79 2c 20 63 68 65 63 6b 20 74  g a key, check t
7520: 68 65 20 72 6e 67 20 66 6f 72 20 68 65 61 6c 74  he rng for healt
7530: 68 0a 20 20 20 20 2b 6e 65 77 70 68 72 61 73 65  h.    +newphrase
7540: 20 6b 65 79 3e 64 65 66 61 75 6c 74 0a 20 20 20   key>default.   
7550: 20 6b 65 79 23 75 73 65 72 20 2b 67 65 6e 2d 6b   key#user +gen-k
7560: 65 79 73 0a 20 20 20 20 73 65 63 72 65 74 2d 6b  eys.    secret-k
7570: 65 79 73 23 20 31 2d 20 73 65 63 72 65 74 2d 6b  eys# 1- secret-k
7580: 65 79 20 3e 72 61 77 2d 6b 65 79 20 20 6c 61 73  ey >raw-key  las
7590: 74 6b 65 79 40 20 64 72 6f 70 20 64 65 66 61 75  tkey@ drop defau
75a0: 6c 74 6b 65 79 20 21 0a 20 20 20 20 6f 75 74 2d  ltkey !.    out-
75b0: 6d 65 20 2b 64 68 74 72 6f 6f 74 20 73 61 76 65  me +dhtroot save
75c0: 2d 6b 65 79 73 20 3b 0a 0a 5c 20 72 65 76 6f 6b  -keys ;..\ revok
75d0: 61 74 69 6f 6e 0a 0a 34 20 64 61 74 65 73 69 7a  ation..4 datesiz
75e0: 65 23 20 2b 20 6b 65 79 73 69 7a 65 20 39 20 2a  e# + keysize 9 *
75f0: 20 2b 20 43 6f 6e 73 74 61 6e 74 20 72 65 76 73   + Constant revs
7600: 69 7a 65 23 0a 0a 56 61 72 69 61 62 6c 65 20 72  ize#..Variable r
7610: 65 76 74 6f 6b 65 6e 0a 0a 3a 20 30 6f 6c 64 6b  evtoken..: 0oldk
7620: 65 79 20 28 20 2d 2d 20 29 20 5c 20 70 75 62 6b  ey ( -- ) \ pubk
7630: 65 79 73 20 63 61 6e 20 73 74 61 79 0a 20 20 20  eys can stay.   
7640: 20 6f 6c 64 73 6b 63 20 6b 65 79 73 69 7a 65 20   oldskc keysize 
7650: 65 72 61 73 65 20 20 6f 6c 64 73 6b 72 65 76 20  erase  oldskrev 
7660: 6b 65 79 73 69 7a 65 20 65 72 61 73 65 20 3b 0a  keysize erase ;.
7670: 0a 3a 20 6b 65 79 6d 6f 76 65 20 28 20 61 64 64  .: keymove ( add
7680: 72 31 20 61 64 64 72 32 20 2d 2d 20 29 20 20 6b  r1 addr2 -- )  k
7690: 65 79 73 69 7a 65 20 6d 6f 76 65 20 3b 0a 0a 3a  eysize move ;..:
76a0: 20 72 65 76 6f 6b 65 2d 76 65 72 69 66 79 20 28   revoke-verify (
76b0: 20 61 64 64 72 20 75 31 20 70 6b 20 73 74 72 69   addr u1 pk stri
76c0: 6e 67 20 75 32 20 2d 2d 20 61 64 64 72 20 75 20  ng u2 -- addr u 
76d0: 66 6c 61 67 20 29 20 72 6f 74 20 3e 72 20 32 3e  flag ) rot >r 2>
76e0: 72 20 63 3a 30 6b 65 79 0a 20 20 20 20 73 69 67  r c:0key.    sig
76f0: 6f 6e 6c 79 73 69 7a 65 23 20 2d 20 32 64 75 70  onlysize# - 2dup
7700: 20 32 72 3e 20 3e 6b 65 79 65 64 2d 68 61 73 68   2r> >keyed-hash
7710: 0a 20 20 20 20 73 69 67 64 61 74 65 20 2b 64 61  .    sigdate +da
7720: 74 65 0a 20 20 20 20 32 64 75 70 20 2b 20 72 3e  te.    2dup + r>
7730: 20 65 64 2d 76 65 72 69 66 79 20 3b 0a 0a 3a 20   ed-verify ;..: 
7740: 3e 72 65 76 6f 6b 65 20 28 20 73 6b 72 65 76 20  >revoke ( skrev 
7750: 2d 2d 20 29 20 20 73 6b 72 65 76 20 6b 65 79 6d  -- )  skrev keym
7760: 6f 76 65 20 20 70 6b 63 20 63 68 65 63 6b 2d 72  ove  pkc check-r
7770: 65 76 3f 20 30 3d 20 21 21 6e 6f 74 2d 6d 79 2d  ev? 0= !!not-my-
7780: 72 65 76 73 6b 21 21 20 3b 0a 0a 3a 20 2b 72 65  revsk!! ;..: +re
7790: 76 73 69 67 6e 20 28 20 73 6b 20 70 6b 20 2d 2d  vsign ( sk pk --
77a0: 20 29 20 20 73 6b 73 69 67 20 2d 72 6f 74 20 65   )  sksig -rot e
77b0: 64 2d 73 69 67 6e 20 72 65 76 74 6f 6b 65 6e 20  d-sign revtoken 
77c0: 24 2b 21 20 62 6c 20 72 65 76 74 6f 6b 65 6e 20  $+! bl revtoken 
77d0: 63 24 2b 21 20 3b 0a 0a 3a 20 73 69 67 6e 2d 74  c$+! ;..: sign-t
77e0: 6f 6b 65 6e 2c 20 28 20 73 6b 20 70 6b 20 73 74  oken, ( sk pk st
77f0: 72 69 6e 67 20 75 32 20 2d 2d 20 29 0a 20 20 20  ring u2 -- ).   
7800: 20 63 3a 30 6b 65 79 20 72 65 76 74 6f 6b 65 6e   c:0key revtoken
7810: 20 24 40 20 32 73 77 61 70 20 3e 6b 65 79 65 64   $@ 2swap >keyed
7820: 2d 68 61 73 68 0a 20 20 20 20 73 69 67 64 61 74  -hash.    sigdat
7830: 65 20 2b 64 61 74 65 20 2b 72 65 76 73 69 67 6e  e +date +revsign
7840: 20 3b 0a 0a 3a 20 72 65 76 6f 6b 65 2d 6b 65 79   ;..: revoke-key
7850: 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20   ( -- addr u ). 
7860: 20 20 20 73 6b 63 20 6f 6c 64 73 6b 63 20 6b 65     skc oldskc ke
7870: 79 6d 6f 76 65 20 20 70 6b 63 20 6f 6c 64 70 6b  ymove  pkc oldpk
7880: 63 20 6b 65 79 6d 6f 76 65 20 20 73 6b 72 65 76  c keymove  skrev
7890: 20 6f 6c 64 73 6b 72 65 76 20 6b 65 79 6d 6f 76   oldskrev keymov
78a0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  e.              
78b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
78c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 5c 20 62               \ b
78d0: 61 63 6b 75 70 20 6b 65 79 73 0a 20 20 20 20 6f  ackup keys.    o
78e0: 6c 64 73 6b 72 65 76 20 6f 6c 64 70 6b 72 65 76  ldskrev oldpkrev
78f0: 20 73 6b 3e 70 6b 20 20 20 20 20 20 20 20 20 20   sk>pk          
7900: 20 20 20 20 20 20 5c 20 67 65 6e 65 72 61 74 65        \ generate
7910: 20 72 65 76 6f 6b 61 74 69 6f 6e 20 70 75 62 6b   revokation pubk
7920: 65 79 0a 20 20 20 20 67 65 6e 2d 6b 65 79 73 20  ey.    gen-keys 
7930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
7940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5c 20                \ 
7950: 67 65 6e 65 72 61 74 65 20 6e 65 77 20 6b 65 79  generate new key
7960: 73 0a 20 20 20 20 70 6b 63 20 6b 65 79 73 69 7a  s.    pkc keysiz
7970: 65 32 20 72 65 76 74 6f 6b 65 6e 20 24 21 20 20  e2 revtoken $!  
7980: 20 20 20 20 20 20 20 20 20 20 20 20 20 5c 20 6d               \ m
7990: 79 20 6e 65 77 20 6b 65 79 0a 20 20 20 20 6f 6c  y new key.    ol
79a0: 64 70 6b 72 65 76 20 6b 65 79 73 69 7a 65 20 72  dpkrev keysize r
79b0: 65 76 74 6f 6b 65 6e 20 24 2b 21 20 20 20 20 20  evtoken $+!     
79c0: 20 20 20 20 20 5c 20 72 65 76 6f 6b 65 20 74 6f       \ revoke to
79d0: 6b 65 6e 0a 20 20 20 20 6f 6c 64 73 6b 72 65 76  ken.    oldskrev
79e0: 20 6f 6c 64 70 6b 72 65 76 20 22 72 65 76 6f 6b   oldpkrev "revok
79f0: 65 22 20 73 69 67 6e 2d 74 6f 6b 65 6e 2c 20 5c  e" sign-token, \
7a00: 20 72 65 76 6f 6b 65 20 73 69 67 6e 61 74 75 72   revoke signatur
7a10: 65 0a 20 20 20 20 73 6b 63 20 70 6b 63 20 22 73  e.    skc pkc "s
7a20: 65 6c 66 73 69 67 6e 22 20 73 69 67 6e 2d 74 6f  elfsign" sign-to
7a30: 6b 65 6e 2c 20 20 20 20 20 20 20 20 20 5c 20 73  ken,         \ s
7a40: 65 6c 66 20 73 69 67 6e 65 64 20 77 69 74 68 20  elf signed with 
7a50: 6e 65 77 20 6b 65 79 0a 20 20 20 20 22 21 22 20  new key.    "!" 
7a60: 72 65 76 74 6f 6b 65 6e 20 30 20 24 69 6e 73 20  revtoken 0 $ins 
7a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
7a80: 20 20 20 5c 20 22 21 22 20 2b 20 6f 6c 64 6b 65     \ "!" + oldke
7a90: 79 6c 65 6e 2b 6e 65 77 6b 65 79 6c 65 6e 20 74  ylen+newkeylen t
7aa0: 6f 20 66 6c 61 67 20 72 65 76 6f 6b 61 74 69 6f  o flag revokatio
7ab0: 6e 0a 20 20 20 20 72 65 76 74 6f 6b 65 6e 20 24  n.    revtoken $
7ac0: 40 20 67 65 6e 3e 68 6f 73 74 20 32 64 72 6f 70  @ gen>host 2drop
7ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 5c 20 73               \ s
7ae0: 69 67 6e 20 68 6f 73 74 20 69 6e 66 6f 72 6d 61  ign host informa
7af0: 74 69 6f 6e 20 77 69 74 68 20 6f 6c 64 20 6b 65  tion with old ke
7b00: 79 0a 20 20 20 20 73 69 67 64 61 74 65 20 2b 64  y.    sigdate +d
7b10: 61 74 65 20 73 69 67 64 61 74 65 20 64 61 74 65  ate sigdate date
7b20: 73 69 7a 65 23 20 72 65 76 74 6f 6b 65 6e 20 24  size# revtoken $
7b30: 2b 21 0a 20 20 20 20 6f 6c 64 73 6b 63 20 6f 6c  +!.    oldskc ol
7b40: 64 70 6b 63 20 2b 72 65 76 73 69 67 6e 0a 20 20  dpkc +revsign.  
7b50: 20 20 30 6f 6c 64 6b 65 79 20 72 65 76 74 6f 6b    0oldkey revtok
7b60: 65 6e 20 24 40 20 3b 0a 0a 5c 20 69 6e 76 69 74  en $@ ;..\ invit
7b70: 61 74 69 6f 6e 0a 0a 56 61 72 69 61 62 6c 65 20  ation..Variable 
7b80: 69 6e 76 69 74 61 74 69 6f 6e 73 0a 0a 65 76 65  invitations..eve
7b90: 6e 74 3a 20 2d 3e 69 6e 76 69 74 65 20 28 20 61  nt: ->invite ( a
7ba0: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 2e  ddr u -- ).    .
7bb0: 22 20 69 6e 76 69 74 65 20 6d 65 3a 20 22 20 6f  " invite me: " o
7bc0: 76 65 72 20 3e 72 20 2e 70 6b 32 6b 65 79 24 20  ver >r .pk2key$ 
7bd0: 63 72 20 72 3e 20 66 72 65 65 20 74 68 72 6f 77  cr r> free throw
7be0: 20 63 74 72 6c 20 4c 20 69 6e 73 6b 65 79 20 3b   ctrl L inskey ;
7bf0: 0a 65 76 65 6e 74 3a 20 2d 3e 77 61 6b 65 6d 65  .event: ->wakeme
7c00: 20 28 20 6f 20 2d 2d 20 29 20 3c 65 76 65 6e 74   ( o -- ) <event
7c10: 20 2d 3e 77 61 6b 65 20 65 76 65 6e 74 3e 20 3b   ->wake event> ;
7c20: 0a 0a 3a 20 70 6b 32 6b 65 79 24 2d 61 64 64 20  ..: pk2key$-add 
7c30: 28 20 61 64 64 72 20 75 20 70 65 72 6d 20 2d 2d  ( addr u perm --
7c40: 20 29 20 7b 20 70 65 72 6d 20 7d 0a 20 20 20 20   ) { perm }.    
7c50: 73 61 6d 70 6c 65 2d 6b 65 79 20 3e 6f 20 69 6d  sample-key >o im
7c60: 70 6f 72 74 23 69 6e 76 69 74 65 64 20 69 6d 70  port#invited imp
7c70: 6f 72 74 2d 74 79 70 65 20 21 20 63 6d 64 3a 6e  ort-type ! cmd:n
7c80: 65 73 74 73 69 67 0a 20 20 20 20 70 65 72 6d 20  estsig.    perm 
7c90: 6b 65 2d 6d 61 73 6b 20 21 0a 20 20 20 20 69 6d  ke-mask !.    im
7ca0: 70 6f 72 74 23 6e 65 77 20 69 6d 70 6f 72 74 2d  port#new import-
7cb0: 74 79 70 65 20 21 20 20 73 61 76 65 2d 70 75 62  type !  save-pub
7cc0: 6b 65 79 73 20 6f 3e 20 3b 0a 0a 3a 20 78 2d 65  keys o> ;..: x-e
7cd0: 72 61 73 65 20 28 20 6c 65 6e 20 2d 2d 20 29 0a  rase ( len -- ).
7ce0: 20 20 20 20 64 75 70 20 78 62 61 63 6b 2d 72 65      dup xback-re
7cf0: 73 74 6f 72 65 20 20 64 75 70 20 73 70 61 63 65  store  dup space
7d00: 73 20 20 78 62 61 63 6b 2d 72 65 73 74 6f 72 65  s  xback-restore
7d10: 20 3b 0a 0a 3a 20 69 6e 76 69 74 65 2d 6b 65 79   ;..: invite-key
7d20: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 6b 65 79   ( addr u -- key
7d30: 20 29 0a 20 20 20 20 32 64 75 70 20 78 2d 77 69   ).    2dup x-wi
7d40: 64 74 68 20 7b 20 61 64 64 72 20 75 20 6c 65 6e  dth { addr u len
7d50: 20 7d 0a 20 20 20 20 42 45 47 49 4e 20 20 61 64   }.    BEGIN  ad
7d60: 64 72 20 75 20 74 79 70 65 20 6b 65 79 20 20 6c  dr u type key  l
7d70: 65 6e 20 78 2d 65 72 61 73 65 0a 09 64 75 70 20  en x-erase..dup 
7d80: 63 74 72 6c 20 5a 20 3d 0a 20 20 20 20 57 48 49  ctrl Z =.    WHI
7d90: 4c 45 20 20 64 72 6f 70 20 20 42 45 47 49 4e 20  LE  drop  BEGIN 
7da0: 20 6b 65 79 20 63 74 72 6c 20 4c 20 3d 20 20 55   key ctrl L =  U
7db0: 4e 54 49 4c 20 20 52 45 50 45 41 54 20 3b 0a 0a  NTIL  REPEAT ;..
7dc0: 3a 20 70 72 6f 63 65 73 73 2d 69 6e 76 69 74 61  : process-invita
7dd0: 74 69 6f 6e 20 28 20 61 64 64 72 20 75 20 2d 2d  tion ( addr u --
7de0: 20 29 0a 20 20 20 20 73 22 20 69 6e 76 69 74 65   ).    s" invite
7df0: 20 28 79 2f 6e 2f 62 29 3f 22 20 69 6e 76 69 74   (y/n/b)?" invit
7e00: 65 2d 6b 65 79 0a 20 20 20 20 63 61 73 65 0a 09  e-key.    case..
7e10: 27 79 27 20 6f 66 20 20 70 65 72 6d 25 64 65 66  'y' of  perm%def
7e20: 61 75 6c 74 20 70 6b 32 6b 65 79 24 2d 61 64 64  ault pk2key$-add
7e30: 20 20 2e 22 20 61 64 64 65 64 22 20 63 72 20 20    ." added" cr  
7e40: 20 65 6e 64 6f 66 0a 09 27 62 27 20 6f 66 20 20   endof..'b' of  
7e50: 70 65 72 6d 25 62 6c 6f 63 6b 65 64 20 70 6b 32  perm%blocked pk2
7e60: 6b 65 79 24 2d 61 64 64 20 20 2e 22 20 62 6c 6f  key$-add  ." blo
7e70: 63 6b 65 64 22 20 63 72 20 65 6e 64 6f 66 0a 09  cked" cr endof..
7e80: 32 64 72 6f 70 20 2e 22 20 69 67 6e 6f 72 65 64  2drop ." ignored
7e90: 22 20 63 72 0a 20 20 20 20 65 6e 64 63 61 73 65  " cr.    endcase
7ea0: 20 3b 0a 0a 3a 20 66 69 6c 74 65 72 2d 69 6e 76   ;..: filter-inv
7eb0: 69 74 61 74 69 6f 6e 3f 20 28 20 61 64 64 72 20  itation? ( addr 
7ec0: 75 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20  u -- flag ).    
7ed0: 73 69 67 70 6b 32 73 69 7a 65 23 20 2d 20 2b 20  sigpk2size# - + 
7ee0: 6b 65 79 73 69 7a 65 20 6b 65 79 23 20 23 40 20  keysize key# #@ 
7ef0: 64 30 3c 3e 20 3b 20 5c 20 61 6c 72 65 61 64 79  d0<> ; \ already
7f00: 20 74 68 65 72 65 0a 0a 3a 20 2e 69 6e 76 69 74   there..: .invit
7f10: 61 74 69 6f 6e 73 20 28 20 2d 2d 20 29 0a 20 20  ations ( -- ).  
7f20: 20 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 5b 3a    invitations [:
7f30: 20 32 64 75 70 20 2e 70 6b 32 6b 65 79 24 20 63   2dup .pk2key$ c
7f40: 72 20 70 72 6f 63 65 73 73 2d 69 6e 76 69 74 61  r process-invita
7f50: 74 69 6f 6e 20 3b 5d 20 24 5b 5d 6d 61 70 0a 20  tion ;] $[]map. 
7f60: 20 20 20 69 6e 76 69 74 61 74 69 6f 6e 73 20 24     invitations $
7f70: 5b 5d 6f 66 66 20 3b 0a 0a 3a 20 3e 69 6e 76 69  []off ;..: >invi
7f80: 74 61 74 69 6f 6e 73 20 28 20 61 64 64 72 20 75  tations ( addr u
7f90: 20 2d 2d 20 29 0a 20 20 20 20 32 64 75 70 20 66   -- ).    2dup f
7fa0: 69 6c 74 65 72 2d 69 6e 76 69 74 61 74 69 6f 6e  ilter-invitation
7fb0: 3f 20 49 46 20 20 32 64 72 6f 70 20 45 58 49 54  ? IF  2drop EXIT
7fc0: 20 20 54 48 45 4e 0a 20 20 20 20 69 6e 76 69 74    THEN.    invit
7fd0: 61 74 69 6f 6e 73 20 24 5b 5d 23 20 3e 72 0a 20  ations $[]# >r. 
7fe0: 20 20 20 32 64 75 70 20 69 6e 76 69 74 61 74 69     2dup invitati
7ff0: 6f 6e 73 20 24 69 6e 73 5b 5d 73 69 67 20 64 72  ons $ins[]sig dr
8000: 6f 70 0a 20 20 20 20 69 6e 76 69 74 61 74 69 6f  op.    invitatio
8010: 6e 73 20 24 5b 5d 23 20 72 3e 20 3c 3e 20 49 46  ns $[]# r> <> IF
8020: 0a 09 73 61 76 65 2d 6d 65 6d 20 6d 61 69 6e 2d  ..save-mem main-
8030: 75 70 40 20 3c 68 69 64 65 3e 0a 09 3c 65 76 65  up@ <hide>..<eve
8040: 6e 74 20 65 24 2c 20 2d 3e 69 6e 76 69 74 65 20  nt e$, ->invite 
8050: 75 70 40 20 65 6c 69 74 2c 20 2d 3e 77 61 6b 65  up@ elit, ->wake
8060: 6d 65 20 6d 61 69 6e 2d 75 70 40 20 65 76 65 6e  me main-up@ even
8070: 74 3e 20 73 74 6f 70 0a 20 20 20 20 45 4c 53 45  t> stop.    ELSE
8080: 20 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a    2drop  THEN ;.
8090: 0a 3a 20 73 65 6e 64 2d 69 6e 76 69 74 61 74 69  .: send-invitati
80a0: 6f 6e 20 28 20 70 6b 20 75 20 2d 2d 20 29 0a 20  on ( pk u -- ). 
80b0: 20 20 20 73 65 74 75 70 21 20 6d 79 70 6b 32 6e     setup! mypk2n
80c0: 69 63 6b 24 20 32 3e 72 0a 20 20 20 20 67 65 6e  ick$ 2>r.    gen
80d0: 2d 74 6d 70 6b 65 79 73 20 64 72 6f 70 20 74 73  -tmpkeys drop ts
80e0: 6b 63 20 73 77 61 70 20 6b 65 79 70 61 64 20 65  kc swap keypad e
80f0: 64 2d 64 68 20 64 6f 2d 6b 65 79 70 61 64 20 73  d-dh do-keypad s
8100: 65 63 21 0a 20 20 20 20 6e 65 74 32 6f 2d 63 6f  ec!.    net2o-co
8110: 64 65 30 0a 20 20 20 20 74 70 6b 63 20 6b 65 79  de0.    tpkc key
8120: 73 69 7a 65 20 24 2c 20 6f 6e 65 73 68 6f 74 2d  size $, oneshot-
8130: 74 6d 70 6b 65 79 0a 20 20 20 20 6e 65 73 74 5b  tmpkey.    nest[
8140: 20 32 72 3e 20 24 2c 20 69 6e 76 69 74 65 20 5d   2r> $, invite ]
8150: 74 6d 70 6e 65 73 74 0a 20 20 20 20 63 6f 6f 6b  tmpnest.    cook
8160: 69 65 2b 72 65 71 75 65 73 74 0a 20 20 20 20 65  ie+request.    e
8170: 6e 64 2d 63 6f 64 65 7c 20 3b 0a 0a 5c 20 6b 65  nd-code| ;..\ ke
8180: 79 20 61 70 69 20 68 65 6c 70 65 72 73 0a 0a 3a  y api helpers..:
8190: 20 64 65 6c 2d 6c 61 73 74 2d 6b 65 79 20 28 20   del-last-key ( 
81a0: 2d 2d 20 29 0a 20 20 20 20 6b 65 79 73 20 24 5b  -- ).    keys $[
81b0: 5d 23 20 31 2d 20 6b 65 79 73 20 24 5b 5d 20 73  ]# 1- keys $[] s
81c0: 65 63 2d 6f 66 66 0a 20 20 20 20 6b 65 79 73 20  ec-off.    keys 
81d0: 24 40 6c 65 6e 20 63 65 6c 6c 2d 20 6b 65 79 73  $@len cell- keys
81e0: 20 24 21 6c 65 6e 20 3b 0a 0a 3a 20 73 74 6f 72   $!len ;..: stor
81f0: 65 6b 65 79 21 20 28 20 2d 2d 20 29 0a 20 20 20  ekey! ( -- ).   
8200: 20 3e 73 65 63 6b 65 79 20 6b 65 79 73 20 24 5b   >seckey keys $[
8210: 5d 23 20 30 20 3f 44 4f 20 20 32 64 75 70 20 49  ]# 0 ?DO  2dup I
8220: 20 6b 65 79 73 20 73 65 63 5b 5d 40 20 73 74 72   keys sec[]@ str
8230: 3d 20 49 46 0a 09 20 20 20 20 49 20 6b 65 79 73  = IF..    I keys
8240: 20 73 65 63 5b 5d 40 20 64 72 6f 70 20 3e 73 74   sec[]@ drop >st
8250: 6f 72 65 6b 65 79 20 21 20 20 4c 45 41 56 45 20  orekey !  LEAVE 
8260: 20 54 48 45 4e 20 20 4c 4f 4f 50 20 20 32 64 72   THEN  LOOP  2dr
8270: 6f 70 20 3b 0a 0a 3a 20 63 68 6f 6f 73 65 2d 6b  op ;..: choose-k
8280: 65 79 20 28 20 2d 2d 20 6f 20 29 0a 20 20 20 20  ey ( -- o ).    
8290: 30 20 42 45 47 49 4e 20 20 64 72 6f 70 0a 09 2e  0 BEGIN  drop...
82a0: 22 20 43 68 6f 6f 73 65 20 6b 65 79 20 62 79 20  " Choose key by 
82b0: 6e 75 6d 62 65 72 3a 22 20 63 72 20 2e 73 65 63  number:" cr .sec
82c0: 72 65 74 2d 6e 69 63 6b 73 0a 09 42 45 47 49 4e  ret-nicks..BEGIN
82d0: 20 20 6b 65 79 20 64 75 70 20 62 6c 20 3c 20 57    key dup bl < W
82e0: 48 49 4c 45 20 20 64 72 6f 70 20 20 52 45 50 45  HILE  drop  REPE
82f0: 41 54 20 5c 20 73 77 61 6c 6c 6f 77 20 63 6f 6e  AT \ swallow con
8300: 74 72 6f 6c 20 6b 65 79 73 0a 09 5b 27 5d 20 64  trol keys..['] d
8310: 69 67 69 74 3f 20 23 33 36 20 62 61 73 65 2d 65  igit? #36 base-e
8320: 78 65 63 75 74 65 20 30 3d 20 49 46 20 2d 31 20  xecute 0= IF -1 
8330: 54 48 45 4e 0a 09 73 65 63 72 65 74 2d 6b 65 79  THEN..secret-key
8340: 20 64 75 70 20 30 3d 20 57 48 49 4c 45 0a 09 20   dup 0= WHILE.. 
8350: 20 20 20 2e 22 20 50 6c 65 61 73 65 20 65 6e 74     ." Please ent
8360: 65 72 20 61 20 62 61 73 65 2d 33 36 20 6e 75 6d  er a base-36 num
8370: 62 65 72 20 62 65 74 77 65 65 6e 20 30 20 61 6e  ber between 0 an
8380: 64 20 22 0a 09 20 20 20 20 73 65 63 72 65 74 2d  d "..    secret-
8390: 6b 65 79 73 23 20 31 2d 20 5b 27 5d 20 2e 20 23  keys# 1- ['] . #
83a0: 33 36 20 62 61 73 65 2d 65 78 65 63 75 74 65 20  36 base-execute 
83b0: 63 72 20 20 72 64 72 6f 70 0a 20 20 20 20 52 45  cr  rdrop.    RE
83c0: 50 45 41 54 0a 20 20 20 20 64 75 70 20 2e 73 74  PEAT.    dup .st
83d0: 6f 72 65 6b 65 79 21 20 20 3e 73 74 6f 72 65 6b  orekey!  >storek
83e0: 65 79 20 40 20 64 65 66 61 75 6c 74 6b 65 79 20  ey @ defaultkey 
83f0: 21 0a 20 20 20 20 2e 22 20 3d 3d 3d 3d 20 6b 65  !.    ." ==== ke
8400: 79 20 22 20 64 75 70 20 2e 2e 6e 69 63 6b 20 2e  y " dup ..nick .
8410: 22 20 20 63 68 6f 73 65 6e 20 3d 3d 3d 3d 22 20  "  chosen ====" 
8420: 63 72 20 3b 0a 0a 5c 20 77 69 6c 6c 20 61 73 6b  cr ;..\ will ask
8430: 20 66 6f 72 20 79 6f 75 72 20 70 61 73 73 77 6f   for your passwo
8440: 72 64 20 61 6e 64 20 69 66 20 70 6f 73 73 69 62  rd and if possib
8450: 6c 65 20 61 75 74 6f 2d 73 65 6c 65 63 74 20 79  le auto-select y
8460: 6f 75 72 20 69 64 0a 0a 56 61 72 69 61 62 6c 65  our id..Variable
8470: 20 74 72 69 65 73 23 0a 23 31 30 20 56 61 6c 75   tries#.#10 Valu
8480: 65 20 6d 61 78 74 72 69 65 73 23 0a 0a 3a 20 67  e maxtries#..: g
8490: 65 74 2d 73 6b 63 20 28 20 2d 2d 20 29 0a 20 20  et-skc ( -- ).  
84a0: 20 20 73 65 63 72 65 74 2d 6b 65 79 73 23 20 3f    secret-keys# ?
84b0: 45 58 49 54 20 20 74 72 69 65 73 23 20 6f 66 66  EXIT  tries# off
84c0: 0a 20 20 20 20 64 65 62 75 67 2d 76 65 63 74 6f  .    debug-vecto
84d0: 72 20 40 20 6f 70 2d 76 65 63 74 6f 72 20 21 40  r @ op-vector !@
84e0: 20 3e 72 20 3c 64 65 66 61 75 6c 74 3e 0a 20 20   >r <default>.  
84f0: 20 20 73 65 63 72 65 74 2d 6b 65 79 73 23 0a 20    secret-keys#. 
8500: 20 20 20 42 45 47 49 4e 20 20 64 75 70 20 30 3d     BEGIN  dup 0=
8510: 20 74 72 69 65 73 23 20 40 20 6d 61 78 74 72 69   tries# @ maxtri
8520: 65 73 23 20 75 3c 20 61 6e 64 20 20 57 48 49 4c  es# u< and  WHIL
8530: 45 20 64 72 6f 70 0a 09 20 20 20 20 73 22 20 50  E drop..    s" P
8540: 61 73 73 70 68 72 61 73 65 3a 20 22 20 2b 70 61  assphrase: " +pa
8550: 73 73 70 68 72 61 73 65 20 20 20 21 74 69 6d 65  ssphrase   !time
8560: 0a 09 20 20 20 20 72 65 61 64 2d 6b 65 79 73 20  ..    read-keys 
8570: 73 65 63 72 65 74 2d 6b 65 79 73 23 20 64 75 70  secret-keys# dup
8580: 20 30 3d 20 49 46 0a 09 09 5c 20 66 61 69 6c 20   0= IF...\ fail 
8590: 72 69 67 68 74 20 61 66 74 65 72 20 74 68 65 20  right after the 
85a0: 66 69 72 73 74 20 74 72 79 20 69 66 20 50 41 53  first try if PAS
85b0: 53 50 48 52 41 53 45 20 69 73 20 75 73 65 64 0a  SPHRASE is used.
85c0: 09 09 5c 20 61 6e 64 20 67 69 76 65 20 74 68 65  ..\ and give the
85d0: 20 6d 61 78 69 6d 75 6d 20 77 61 69 74 69 6e 67   maximum waiting
85e0: 20 70 65 6e 61 6c 74 79 20 69 6e 20 74 68 61 74   penalty in that
85f0: 20 63 61 73 65 0a 09 09 31 20 6d 61 78 74 72 69   case...1 maxtri
8600: 65 73 23 20 73 22 20 50 41 53 53 50 48 52 41 53  es# s" PASSPHRAS
8610: 45 22 20 67 65 74 65 6e 76 20 64 30 3d 20 73 65  E" getenv d0= se
8620: 6c 65 63 74 20 74 72 69 65 73 23 20 2b 21 0a 09  lect tries# +!..
8630: 09 3c 65 72 72 3e 20 2e 22 20 54 72 79 23 20 22  .<err> ." Try# "
8640: 20 74 72 69 65 73 23 20 40 20 30 20 2e 72 20 27   tries# @ 0 .r '
8650: 2f 27 20 65 6d 69 74 20 6d 61 78 74 72 69 65 73  /' emit maxtries
8660: 23 20 2e 0a 09 09 2e 22 20 66 61 69 6c 65 64 2c  # ....." failed,
8670: 20 6e 6f 20 6b 65 79 20 66 6f 75 6e 64 2c 20 77   no key found, w
8680: 61 69 74 69 6e 67 20 22 0a 09 09 23 31 20 74 72  aiting "...#1 tr
8690: 69 65 73 23 20 40 20 32 2a 20 6c 73 68 69 66 74  ies# @ 2* lshift
86a0: 20 64 75 70 20 2e 20 2e 22 20 6d 73 2e 2e 2e 22   dup . ." ms..."
86b0: 20 6d 73 20 20 3c 64 65 66 61 75 6c 74 3e 20 63   ms  <default> c
86c0: 72 0a 09 09 64 65 6c 2d 6c 61 73 74 2d 6b 65 79  r...del-last-key
86d0: 0a 09 20 20 20 20 54 48 45 4e 0a 20 20 20 20 52  ..    THEN.    R
86e0: 45 50 45 41 54 0a 20 20 20 20 64 75 70 20 30 3d  EPEAT.    dup 0=
86f0: 20 49 46 20 20 23 2d 35 36 20 74 68 72 6f 77 20   IF  #-56 throw 
8700: 20 54 48 45 4e 0a 20 20 20 20 31 20 3d 20 49 46   THEN.    1 = IF
8710: 20 20 30 20 73 65 63 72 65 74 2d 6b 65 79 0a 09    0 secret-key..
8720: 2e 22 20 3d 3d 3d 3d 20 6f 70 65 6e 65 64 3a 20  ." ==== opened: 
8730: 22 20 64 75 70 20 2e 2e 6e 69 63 6b 20 2e 22 20  " dup ..nick ." 
8740: 20 69 6e 20 22 20 2e 74 69 6d 65 20 2e 22 20 3d   in " .time ." =
8750: 3d 3d 3d 22 20 63 72 0a 20 20 20 20 45 4c 53 45  ===" cr.    ELSE
8760: 20 20 2e 22 20 3d 3d 3d 3d 20 6f 70 65 6e 65 64    ." ==== opened
8770: 20 69 6e 20 22 20 2e 74 69 6d 65 20 2e 22 20 3d   in " .time ." =
8780: 3d 3d 3d 22 20 63 72 20 63 68 6f 6f 73 65 2d 6b  ===" cr choose-k
8790: 65 79 20 20 54 48 45 4e 0a 20 20 20 20 3e 72 61  ey  THEN.    >ra
87a0: 77 2d 6b 65 79 20 3f 72 73 6b 20 20 20 72 3e 20  w-key ?rsk   r> 
87b0: 6f 70 2d 76 65 63 74 6f 72 20 21 20 3b 0a 0a 73  op-vector ! ;..s
87c0: 63 6f 70 65 3a 20 6e 32 6f 0a 46 6f 72 77 61 72  cope: n2o.Forwar
87d0: 64 20 68 65 6c 70 0a 7d 73 63 6f 70 65 0a 0a 3a  d help.}scope..:
87e0: 20 67 65 74 2d 6d 79 2d 6b 65 79 20 28 20 2d 2d   get-my-key ( --
87f0: 20 78 74 20 29 0a 20 20 20 20 67 65 6e 2d 6b 65   xt ).    gen-ke
8800: 79 73 2d 64 69 72 20 20 22 73 65 63 6b 65 79 73  ys-dir  "seckeys
8810: 2e 6b 32 6f 22 20 2e 6b 65 79 73 2f 20 32 64 75  .k2o" .keys/ 2du
8820: 70 20 66 69 6c 65 2d 73 74 61 74 75 73 20 6e 69  p file-status ni
8830: 70 0a 20 20 20 20 30 3d 20 49 46 20 20 72 2f 6f  p.    0= IF  r/o
8840: 20 6f 70 65 6e 2d 66 69 6c 65 20 74 68 72 6f 77   open-file throw
8850: 20 3e 72 20 72 40 20 66 69 6c 65 2d 73 69 7a 65   >r r@ file-size
8860: 20 74 68 72 6f 77 20 64 30 3d 0a 09 72 3e 20 63   throw d0=..r> c
8870: 6c 6f 73 65 2d 66 69 6c 65 20 74 68 72 6f 77 20  lose-file throw 
8880: 20 45 4c 53 45 20 20 74 72 75 65 20 20 54 48 45   ELSE  true  THE
8890: 4e 0a 20 20 20 20 49 46 20 20 5b 3a 20 2e 22 20  N.    IF  [: ." 
88a0: 47 65 6e 65 72 61 74 65 20 61 20 6e 65 77 20 6b  Generate a new k
88b0: 65 79 70 61 69 72 3a 22 20 63 72 0a 09 20 20 67  eypair:" cr..  g
88c0: 65 74 2d 6e 69 63 6b 20 64 75 70 20 30 3d 20 23  et-nick dup 0= #
88d0: 2d 35 36 20 61 6e 64 20 74 68 72 6f 77 20 5c 20  -56 and throw \ 
88e0: 65 6d 70 74 79 20 6e 69 63 6b 3a 20 70 72 65 74  empty nick: pret
88f0: 65 6e 64 20 74 6f 20 71 75 69 74 0a 09 20 20 6e  end to quit..  n
8900: 65 77 2d 6b 65 79 20 2e 6b 65 79 73 20 3f 72 73  ew-key .keys ?rs
8910: 6b 20 3b 5d 0a 20 20 20 20 45 4c 53 45 20 20 5b  k ;].    ELSE  [
8920: 27 5d 20 67 65 74 2d 73 6b 63 20 20 54 48 45 4e  '] get-skc  THEN
8930: 20 3b 0a 0a 3a 20 2e 6b 65 79 69 6e 66 6f 20 28   ;..: .keyinfo (
8940: 20 2d 2d 20 29 0a 20 20 20 20 3c 77 61 72 6e 3e   -- ).    <warn>
8950: 20 2e 22 20 3d 3d 3d 3d 20 4e 6f 20 6b 65 79 20   ." ==== No key 
8960: 6f 70 65 6e 65 64 20 3d 3d 3d 3d 22 20 63 72 0a  opened ====" cr.
8970: 20 20 20 20 3c 69 6e 66 6f 3e 20 2e 22 20 67 65      <info> ." ge
8980: 6e 65 72 61 74 65 20 61 20 6e 65 77 20 6f 6e 65  nerate a new one
8990: 20 77 69 74 68 20 27 6b 65 79 67 65 6e 27 22 20   with 'keygen'" 
89a0: 63 72 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 0a  cr <default> ;..
89b0: 3a 20 67 65 74 2d 6d 65 20 28 20 2d 2d 20 29 0a  : get-me ( -- ).
89c0: 20 20 20 20 67 65 74 2d 6d 79 2d 6b 65 79 20 63      get-my-key c
89d0: 61 74 63 68 20 64 75 70 20 23 2d 35 36 20 3d 20  atch dup #-56 = 
89e0: 49 46 20 64 72 6f 70 20 2e 6b 65 79 69 6e 66 6f  IF drop .keyinfo
89f0: 20 45 4c 53 45 20 74 68 72 6f 77 20 54 48 45 4e   ELSE throw THEN
8a00: 20 3b 0a 0a 3a 20 3f 67 65 74 2d 6d 65 20 28 20   ;..: ?get-me ( 
8a10: 2d 2d 20 29 0a 20 20 20 20 5c 47 20 74 68 69 73  -- ).    \G this
8a20: 20 76 65 72 73 69 6f 6e 20 6f 66 20 67 65 74 2d   version of get-
8a30: 6d 65 20 66 61 69 6c 73 20 68 61 72 64 20 69 66  me fails hard if
8a40: 20 6e 6f 20 6b 65 79 20 69 73 20 6f 70 65 6e 65   no key is opene
8a50: 64 0a 20 20 20 20 67 65 74 2d 6d 79 2d 6b 65 79  d.    get-my-key
8a60: 20 63 61 74 63 68 20 23 2d 35 36 20 3d 20 49 46   catch #-56 = IF
8a70: 0a 09 2e 6b 65 79 69 6e 66 6f 20 74 72 75 65 20  ...keyinfo true 
8a80: 21 21 6e 6f 2d 6b 65 79 2d 6f 70 65 6e 21 21 0a  !!no-key-open!!.
8a90: 20 20 20 20 54 48 45 4e 20 3b 0a 0a 30 20 5b 49      THEN ;..0 [I
8aa0: 46 5d 0a 4c 6f 63 61 6c 20 56 61 72 69 61 62 6c  F].Local Variabl
8ab0: 65 73 3a 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d  es:.forth-local-
8ac0: 77 6f 72 64 73 3a 0a 20 20 20 20 28 0a 20 20 20  words:.    (.   
8ad0: 20 20 28 28 22 6e 65 74 32 6f 3a 22 20 22 2b 6e    (("net2o:" "+n
8ae0: 65 74 32 6f 3a 22 29 20 64 65 66 69 6e 69 74 69  et2o:") definiti
8af0: 6f 6e 2d 73 74 61 72 74 65 72 20 28 66 6f 6e 74  on-starter (font
8b00: 2d 6c 6f 63 6b 2d 6b 65 79 77 6f 72 64 2d 66 61  -lock-keyword-fa
8b10: 63 65 20 2e 20 31 29 0a 20 20 20 20 20 20 22 5b  ce . 1).      "[
8b20: 20 5c 74 5c 6e 5d 22 20 74 20 6e 61 6d 65 20 28   \t\n]" t name (
8b30: 66 6f 6e 74 2d 6c 6f 63 6b 2d 66 75 6e 63 74 69  font-lock-functi
8b40: 6f 6e 2d 6e 61 6d 65 2d 66 61 63 65 20 2e 20 33  on-name-face . 3
8b50: 29 29 0a 20 20 20 20 20 28 28 22 64 65 62 75 67  )).     (("debug
8b60: 3a 22 20 22 66 69 65 6c 64 3a 22 20 22 32 66 69  :" "field:" "2fi
8b70: 65 6c 64 3a 22 20 22 73 66 66 69 65 6c 64 3a 22  eld:" "sffield:"
8b80: 20 22 64 66 66 69 65 6c 64 3a 22 20 22 36 34 66   "dffield:" "64f
8b90: 69 65 6c 64 3a 22 20 22 75 76 61 72 22 20 22 75  ield:" "uvar" "u
8ba0: 76 61 6c 75 65 22 29 20 6e 6f 6e 2d 69 6d 6d 65  value") non-imme
8bb0: 64 69 61 74 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b  diate (font-lock
8bc0: 2d 74 79 70 65 2d 66 61 63 65 20 2e 20 32 29 0a  -type-face . 2).
8bd0: 20 20 20 20 20 20 22 5b 20 5c 74 5c 6e 5d 22 20        "[ \t\n]" 
8be0: 74 20 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f 63  t name (font-loc
8bf0: 6b 2d 76 61 72 69 61 62 6c 65 2d 6e 61 6d 65 2d  k-variable-name-
8c00: 66 61 63 65 20 2e 20 33 29 29 0a 20 20 20 20 20  face . 3)).     
8c10: 28 22 5b 61 2d 7a 30 2d 39 5d 2b 28 22 20 69 6d  ("[a-z0-9]+(" im
8c20: 6d 65 64 69 61 74 65 20 28 66 6f 6e 74 2d 6c 6f  mediate (font-lo
8c30: 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 65 20  ck-comment-face 
8c40: 2e 20 31 29 0a 20 20 20 20 20 20 22 29 22 20 6e  . 1).      ")" n
8c50: 69 6c 20 63 6f 6d 6d 65 6e 74 20 28 66 6f 6e 74  il comment (font
8c60: 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61  -lock-comment-fa
8c70: 63 65 20 2e 20 31 29 29 0a 20 20 20 20 29 0a 66  ce . 1)).    ).f
8c80: 6f 72 74 68 2d 6c 6f 63 61 6c 2d 69 6e 64 65 6e  orth-local-inden
8c90: 74 2d 77 6f 72 64 73 3a 0a 20 20 20 20 28 0a 20  t-words:.    (. 
8ca0: 20 20 20 20 28 28 22 6e 65 74 32 6f 3a 22 20 22      (("net2o:" "
8cb0: 2b 6e 65 74 32 6f 3a 22 29 20 28 30 20 2e 20 32  +net2o:") (0 . 2
8cc0: 29 20 28 30 20 2e 20 32 29 20 6e 6f 6e 2d 69 6d  ) (0 . 2) non-im
8cd0: 6d 65 64 69 61 74 65 29 0a 20 20 20 20 20 28 28  mediate).     ((
8ce0: 22 5b 3a 22 20 22 6b 65 79 3a 63 6f 64 65 22 29  "[:" "key:code")
8cf0: 20 28 30 20 2e 20 31 29 20 28 30 20 2e 20 31 29   (0 . 1) (0 . 1)
8d00: 20 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20   immediate).    
8d10: 20 28 28 22 3b 5d 22 20 22 65 6e 64 3a 6b 65 79   ((";]" "end:key
8d20: 22 29 20 28 2d 31 20 2e 20 30 29 20 28 30 20 2e  ") (-1 . 0) (0 .
8d30: 20 2d 31 29 20 69 6d 6d 65 64 69 61 74 65 29 0a   -1) immediate).
8d40: 20 20 20 20 29 0a 45 6e 64 3a 0a 5b 54 48 45 4e      ).End:.[THEN
8d50: 5d                                               ]