Artifact
e71b4d70a49e002bfe63b80af36a253454cc428f:
- File
net2o-keys.fs
— part of check-in
[02776c0559]
at
2013-01-22 23:42:31
on branch trunk
— Keys with current object
(user:
bernd
size: 5100)
0000: 5c 20 6b 65 79 20 68 61 6e 64 6c 69 6e 67 0a 0a \ key handling..
0010: 72 65 71 75 69 72 65 20 6d 6b 64 69 72 2e 66 73 require mkdir.fs
0020: 0a 0a 5c 20 68 61 73 68 65 64 20 6b 65 79 20 64 ..\ hashed key d
0030: 61 74 61 20 62 61 73 65 0a 0a 6f 62 6a 65 63 74 ata base..object
0040: 20 63 6c 61 73 73 0a 66 69 65 6c 64 3a 20 6b 65 class.field: ke
0050: 2d 73 6b 0a 66 69 65 6c 64 3a 20 6b 65 2d 6e 69 -sk.field: ke-ni
0060: 63 6b 0a 66 69 65 6c 64 3a 20 6b 65 2d 6e 61 6d ck.field: ke-nam
0070: 65 0a 66 69 65 6c 64 3a 20 6b 65 2d 73 69 67 73 e.field: ke-sigs
0080: 0a 36 34 66 69 65 6c 64 3a 20 6b 65 2d 63 72 65 .64field: ke-cre
0090: 61 74 65 64 0a 36 34 66 69 65 6c 64 3a 20 6b 65 ated.64field: ke
00a0: 2d 65 78 70 69 72 65 73 0a 65 6e 64 2d 63 6c 61 -expires.end-cla
00b0: 73 73 20 6b 65 79 2d 65 6e 74 72 79 0a 0a 6b 65 ss key-entry..ke
00c0: 79 2d 65 6e 74 72 79 20 40 20 62 75 66 66 65 72 y-entry @ buffer
00d0: 3a 20 73 61 6d 70 6c 65 2d 6b 65 79 0a 0a 56 61 : sample-key..Va
00e0: 72 69 61 62 6c 65 20 6b 65 79 2d 74 61 62 6c 65 riable key-table
00f0: 0a 56 61 72 69 61 62 6c 65 20 74 68 69 73 2d 6b .Variable this-k
0100: 65 79 0a 56 61 72 69 61 62 6c 65 20 74 68 69 73 ey.Variable this
0110: 2d 6b 65 79 69 64 0a 73 61 6d 70 6c 65 2d 6b 65 -keyid.sample-ke
0120: 79 20 74 68 69 73 2d 6b 65 79 20 21 20 5c 20 64 y this-key ! \ d
0130: 75 6d 6d 79 0a 0a 3a 20 63 75 72 72 65 6e 74 2d ummy..: current-
0140: 6b 65 79 20 28 20 61 64 64 72 20 75 20 2d 2d 20 key ( addr u --
0150: 29 0a 20 20 20 20 6b 65 79 2d 74 61 62 6c 65 20 ). key-table
0160: 23 40 20 64 72 6f 70 20 64 75 70 20 74 68 69 73 #@ drop dup this
0170: 2d 6b 65 79 20 21 20 3e 6f 20 72 64 72 6f 70 20 -key ! >o rdrop
0180: 3b 0a 3a 20 6d 61 6b 65 2d 74 68 69 73 6b 65 79 ;.: make-thiskey
0190: 20 28 20 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 ( addr -- ).
01a0: 20 64 75 70 20 24 40 20 64 72 6f 70 20 74 68 69 dup $@ drop thi
01b0: 73 2d 6b 65 79 69 64 20 21 20 20 63 65 6c 6c 2b s-keyid ! cell+
01c0: 20 24 40 20 64 72 6f 70 20 64 75 70 20 74 68 69 $@ drop dup thi
01d0: 73 2d 6b 65 79 20 21 20 3e 6f 20 72 64 72 6f 70 s-key ! >o rdrop
01e0: 20 3b 0a 0a 3a 20 6e 65 77 2d 6b 65 79 20 28 20 ;..: new-key (
01f0: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 addr u -- ).
0200: 5c 20 61 64 64 72 20 75 20 69 73 20 74 68 65 20 \ addr u is the
0210: 70 75 62 6c 69 63 20 6b 65 79 0a 20 20 20 20 73 public key. s
0220: 61 6d 70 6c 65 2d 6b 65 79 20 6b 65 79 2d 65 6e ample-key key-en
0230: 74 72 79 20 40 20 32 64 75 70 20 65 72 61 73 65 try @ 2dup erase
0240: 0a 20 20 20 20 32 6f 76 65 72 20 6b 65 79 2d 74 . 2over key-t
0250: 61 62 6c 65 20 23 21 20 63 75 72 72 65 6e 74 2d able #! current-
0260: 6b 65 79 20 3b 0a 0a 3a 20 28 64 69 67 69 74 73 key ;..: (digits
0270: 3e 24 29 20 28 20 61 64 64 72 20 75 20 2d 2d 20 >$) ( addr u --
0280: 61 64 64 72 27 20 75 27 20 29 20 73 61 76 65 2d addr' u' ) save-
0290: 6d 65 6d 0a 20 20 20 20 3e 72 20 64 75 70 20 64 mem. >r dup d
02a0: 75 70 20 72 3e 20 62 6f 75 6e 64 73 20 3f 44 4f up r> bounds ?DO
02b0: 0a 09 49 20 32 20 73 3e 6e 75 6d 62 65 72 20 64 ..I 2 s>number d
02c0: 72 6f 70 20 6f 76 65 72 20 63 21 20 63 68 61 72 rop over c! char
02d0: 2b 20 0a 20 20 20 20 32 20 2b 4c 4f 4f 50 20 20 + . 2 +LOOP
02e0: 6f 76 65 72 20 2d 20 3b 0a 0a 3a 20 68 65 78 3e over - ;..: hex>
02f0: 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 $ ( addr u -- ad
0300: 64 72 27 20 75 27 20 29 0a 20 20 20 20 5b 27 5d dr' u' ). [']
0310: 20 28 64 69 67 69 74 73 3e 24 29 20 24 31 30 20 (digits>$) $10
0320: 62 61 73 65 2d 65 78 65 63 75 74 65 20 3b 0a 0a base-execute ;..
0330: 3a 20 78 22 20 28 20 22 68 65 78 73 74 72 69 6e : x" ( "hexstrin
0340: 67 22 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 g" -- addr u ).
0350: 20 20 20 27 22 27 20 70 61 72 73 65 20 68 65 78 '"' parse hex
0360: 3e 24 20 3b 0a 63 6f 6d 70 69 6c 65 3e 20 65 78 >$ ;.compile> ex
0370: 65 63 75 74 65 20 70 6f 73 74 70 6f 6e 65 20 53 ecute postpone S
0380: 4c 69 74 65 72 61 6c 20 3b 0a 0a 56 6f 63 61 62 Literal ;..Vocab
0390: 75 6c 61 72 79 20 6b 65 79 2d 70 61 72 73 65 72 ulary key-parser
03a0: 0a 0a 3a 20 5e 6b 65 79 20 28 20 2d 2d 20 66 73 ..: ^key ( -- fs
03b0: 74 61 72 74 20 29 20 20 74 68 69 73 2d 6b 65 79 tart ) this-key
03c0: 20 40 20 3b 0a 0a 61 6c 73 6f 20 6b 65 79 2d 70 @ ;..also key-p
03d0: 61 72 73 65 72 20 64 65 66 69 6e 69 74 69 6f 6e arser definition
03e0: 73 0a 0a 3a 20 69 64 3a 20 28 20 22 69 64 22 20 s..: id: ( "id"
03f0: 2d 2d 20 29 20 30 20 70 61 72 73 65 20 68 65 78 -- ) 0 parse hex
0400: 3e 24 20 6e 65 77 2d 6b 65 79 20 3b 0a 3a 20 73 >$ new-key ;.: s
0410: 6b 3a 20 28 20 22 73 6b 22 20 2d 2d 20 29 20 30 k: ( "sk" -- ) 0
0420: 20 70 61 72 73 65 20 68 65 78 3e 24 20 6b 65 2d parse hex>$ ke-
0430: 73 6b 20 24 21 20 3b 0a 3a 20 6e 69 63 6b 3a 20 sk $! ;.: nick:
0440: 28 20 22 73 6b 22 20 2d 2d 20 29 20 30 20 70 61 ( "sk" -- ) 0 pa
0450: 72 73 65 20 6b 65 2d 6e 69 63 6b 20 24 21 20 3b rse ke-nick $! ;
0460: 0a 3a 20 6e 61 6d 65 3a 20 28 20 22 73 6b 22 20 .: name: ( "sk"
0470: 2d 2d 20 29 20 30 20 70 61 72 73 65 20 6b 65 2d -- ) 0 parse ke-
0480: 6e 61 6d 65 20 24 21 20 3b 0a 3a 20 63 72 65 61 name $! ;.: crea
0490: 74 65 64 3a 20 28 20 22 6e 75 6d 62 65 72 22 20 ted: ( "number"
04a0: 2d 2d 20 29 20 20 70 61 72 73 65 2d 6e 61 6d 65 -- ) parse-name
04b0: 20 73 3e 6e 75 6d 62 65 72 20 64 3e 36 34 20 6b s>number d>64 k
04c0: 65 2d 63 72 65 61 74 65 64 20 36 34 21 20 3b 0a e-created 64! ;.
04d0: 3a 20 65 78 70 69 72 65 73 3a 20 28 20 22 6e 75 : expires: ( "nu
04e0: 6d 62 65 72 22 20 2d 2d 20 29 20 20 70 61 72 73 mber" -- ) pars
04f0: 65 2d 6e 61 6d 65 20 73 3e 6e 75 6d 62 65 72 20 e-name s>number
0500: 64 3e 36 34 20 6b 65 2d 65 78 70 69 72 65 73 20 d>64 ke-expires
0510: 36 34 21 20 3b 0a 0a 70 72 65 76 69 6f 75 73 20 64! ;..previous
0520: 64 65 66 69 6e 69 74 69 6f 6e 73 0a 0a 3a 20 2e definitions..: .
0530: 6b 65 79 20 28 20 61 64 64 72 20 2d 2d 20 29 20 key ( addr -- )
0540: 20 64 75 70 20 40 20 30 3d 20 49 46 20 20 64 72 dup @ 0= IF dr
0550: 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 op EXIT THEN.
0560: 20 20 20 2e 22 20 69 64 3a 20 22 20 20 20 64 75 ." id: " du
0570: 70 20 24 40 20 78 74 79 70 65 20 63 72 20 63 65 p $@ xtype cr ce
0580: 6c 6c 2b 20 24 40 20 64 72 6f 70 20 3e 6f 0a 20 ll+ $@ drop >o.
0590: 20 20 20 6b 65 2d 73 6b 20 20 20 40 20 49 46 20 ke-sk @ IF
05a0: 20 2e 22 20 73 6b 3a 20 22 20 20 20 6b 65 2d 73 ." sk: " ke-s
05b0: 6b 20 24 40 20 78 74 79 70 65 20 63 72 20 20 54 k $@ xtype cr T
05c0: 48 45 4e 0a 20 20 20 20 6b 65 2d 6e 69 63 6b 20 HEN. ke-nick
05d0: 40 20 49 46 20 20 2e 22 20 6e 69 63 6b 3a 20 22 @ IF ." nick: "
05e0: 20 6b 65 2d 6e 69 63 6b 20 24 40 20 74 79 70 65 ke-nick $@ type
05f0: 20 63 72 20 20 54 48 45 4e 0a 20 20 20 20 6b 65 cr THEN. ke
0600: 2d 6e 61 6d 65 20 40 20 49 46 20 20 2e 22 20 6e -name @ IF ." n
0610: 61 6d 65 3a 20 22 20 6b 65 2d 6e 61 6d 65 20 24 ame: " ke-name $
0620: 40 20 74 79 70 65 20 63 72 20 20 54 48 45 4e 0a @ type cr THEN.
0630: 20 20 20 20 6b 65 2d 63 72 65 61 74 65 64 20 36 ke-created 6
0640: 34 40 20 36 34 64 75 70 20 36 34 2d 30 3d 20 49 4@ 64dup 64-0= I
0650: 46 20 20 36 34 64 72 6f 70 0a 20 20 20 20 45 4c F 64drop. EL
0660: 53 45 20 20 2e 22 20 63 72 65 61 74 65 64 3a 20 SE ." created:
0670: 22 20 36 34 3e 64 20 64 2e 20 63 72 20 20 54 48 " 64>d d. cr TH
0680: 45 4e 0a 20 20 20 20 6b 65 2d 65 78 70 69 72 65 EN. ke-expire
0690: 73 20 36 34 40 20 36 34 64 75 70 20 36 34 2d 30 s 64@ 64dup 64-0
06a0: 3d 20 49 46 20 20 36 34 64 72 6f 70 0a 20 20 20 = IF 64drop.
06b0: 20 45 4c 53 45 20 20 2e 22 20 65 78 70 69 72 65 ELSE ." expire
06c0: 73 3a 20 22 20 36 34 3e 64 20 64 2e 20 63 72 20 s: " 64>d d. cr
06d0: 20 54 48 45 4e 0a 20 20 20 20 6f 3e 20 63 72 20 THEN. o> cr
06e0: 3b 0a 0a 3a 20 2e 73 6b 65 79 20 28 20 61 64 64 ;..: .skey ( add
06f0: 72 20 2d 2d 20 29 20 20 64 75 70 20 63 65 6c 6c r -- ) dup cell
0700: 2b 20 24 40 20 64 72 6f 70 20 40 20 20 20 20 49 + $@ drop @ I
0710: 46 20 20 2e 6b 65 79 20 20 45 4c 53 45 20 20 64 F .key ELSE d
0720: 72 6f 70 20 20 54 48 45 4e 20 3b 0a 3a 20 2e 70 rop THEN ;.: .p
0730: 6b 65 79 20 28 20 61 64 64 72 20 2d 2d 20 29 20 key ( addr -- )
0740: 20 64 75 70 20 63 65 6c 6c 2b 20 24 40 20 64 72 dup cell+ $@ dr
0750: 6f 70 20 40 20 30 3d 20 49 46 20 20 2e 6b 65 79 op @ 0= IF .key
0760: 20 20 45 4c 53 45 20 20 64 72 6f 70 20 20 54 48 ELSE drop TH
0770: 45 4e 20 3b 0a 0a 3a 20 64 75 6d 70 2d 73 6b 65 EN ;..: dump-ske
0780: 79 73 20 28 20 66 64 20 2d 2d 20 29 0a 20 20 20 ys ( fd -- ).
0790: 20 5b 3a 20 6b 65 79 2d 74 61 62 6c 65 20 5b 27 [: key-table ['
07a0: 5d 20 2e 73 6b 65 79 20 23 6d 61 70 20 3b 5d 20 ] .skey #map ;]
07b0: 73 77 61 70 20 6f 75 74 66 69 6c 65 2d 65 78 65 swap outfile-exe
07c0: 63 75 74 65 20 3b 0a 3a 20 64 75 6d 70 2d 70 6b cute ;.: dump-pk
07d0: 65 79 73 20 28 20 66 64 20 2d 2d 20 29 0a 20 20 eys ( fd -- ).
07e0: 20 20 5b 3a 20 6b 65 79 2d 74 61 62 6c 65 20 5b [: key-table [
07f0: 27 5d 20 2e 70 6b 65 79 20 23 6d 61 70 20 3b 5d '] .pkey #map ;]
0800: 20 73 77 61 70 20 6f 75 74 66 69 6c 65 2d 65 78 swap outfile-ex
0810: 65 63 75 74 65 20 3b 0a 0a 3a 20 3f 2e 6e 65 74 ecute ;..: ?.net
0820: 32 6f 20 28 20 2d 2d 20 29 0a 20 20 20 20 73 22 2o ( -- ). s"
0830: 20 7e 2f 2e 6e 65 74 32 6f 22 20 72 2f 6f 20 6f ~/.net2o" r/o o
0840: 70 65 6e 2d 66 69 6c 65 20 6e 69 70 20 49 46 0a pen-file nip IF.
0850: 09 73 22 20 7e 2f 2e 6e 65 74 32 6f 22 20 24 31 .s" ~/.net2o" $1
0860: 43 30 20 6d 6b 64 69 72 2d 70 61 72 65 6e 74 73 C0 mkdir-parents
0870: 20 74 68 72 6f 77 0a 20 20 20 20 54 48 45 4e 20 throw. THEN
0880: 3b 0a 0a 3a 20 64 75 6d 70 2d 6b 65 79 73 20 28 ;..: dump-keys (
0890: 20 2d 2d 20 29 20 20 3f 2e 6e 65 74 32 6f 0a 20 -- ) ?.net2o.
08a0: 20 20 20 73 22 20 7e 2f 2e 6e 65 74 32 6f 2f 73 s" ~/.net2o/s
08b0: 65 63 6b 65 79 73 2e 6e 32 6f 22 20 72 2f 77 20 eckeys.n2o" r/w
08c0: 6f 70 65 6e 2d 66 69 6c 65 20 74 68 72 6f 77 0a open-file throw.
08d0: 20 20 20 20 64 75 70 20 3e 72 20 64 75 6d 70 2d dup >r dump-
08e0: 73 6b 65 79 73 20 72 3e 20 63 6c 6f 73 65 2d 66 skeys r> close-f
08f0: 69 6c 65 20 74 68 72 6f 77 20 0a 20 20 20 20 73 ile throw . s
0900: 22 20 7e 2f 2e 6e 65 74 32 6f 2f 70 75 62 6b 65 " ~/.net2o/pubke
0910: 79 73 2e 6e 32 6f 22 20 72 2f 77 20 6f 70 65 6e ys.n2o" r/w open
0920: 2d 66 69 6c 65 20 74 68 72 6f 77 0a 20 20 20 20 -file throw.
0930: 64 75 70 20 3e 72 20 64 75 6d 70 2d 70 6b 65 79 dup >r dump-pkey
0940: 73 20 72 3e 20 63 6c 6f 73 65 2d 66 69 6c 65 20 s r> close-file
0950: 74 68 72 6f 77 20 3b 0a 0a 3a 20 6e 3e 72 20 28 throw ;..: n>r (
0960: 20 78 31 20 2e 2e 20 78 6e 20 6e 20 2d 2d 20 72 x1 .. xn n -- r
0970: 3a 78 6e 2e 2e 78 31 20 72 3a 6e 20 29 0a 20 20 :xn..x1 r:n ).
0980: 20 20 72 3e 20 7b 20 6e 20 72 65 74 20 7d 0a 20 r> { n ret }.
0990: 20 20 20 30 20 20 42 45 47 49 4e 20 20 64 75 70 0 BEGIN dup
09a0: 20 6e 20 3c 20 20 57 48 49 4c 45 20 20 73 77 61 n < WHILE swa
09b0: 70 20 3e 72 20 31 2b 20 20 52 45 50 45 41 54 20 p >r 1+ REPEAT
09c0: 20 3e 72 0a 20 20 20 20 72 65 74 20 3e 72 20 3b >r. ret >r ;
09d0: 0a 3a 20 6e 72 3e 20 28 20 72 3a 78 6e 2e 2e 78 .: nr> ( r:xn..x
09e0: 31 20 72 3a 6e 20 2d 2d 20 78 31 20 2e 2e 20 78 1 r:n -- x1 .. x
09f0: 6e 20 6e 20 29 0a 20 20 20 20 72 3e 20 72 3e 20 n n ). r> r>
0a00: 7b 20 72 65 74 20 6e 20 7d 0a 20 20 20 20 30 20 { ret n }. 0
0a10: 20 42 45 47 49 4e 20 20 64 75 70 20 6e 20 3c 20 BEGIN dup n <
0a20: 20 57 48 49 4c 45 20 20 72 3e 20 73 77 61 70 20 WHILE r> swap
0a30: 31 2b 20 20 52 45 50 45 41 54 0a 20 20 20 20 72 1+ REPEAT. r
0a40: 65 74 20 3e 72 20 3b 0a 0a 3a 20 73 63 61 6e 2d et >r ;..: scan-
0a50: 6b 65 79 73 20 28 20 66 64 20 2d 2d 20 29 20 20 keys ( fd -- )
0a60: 30 20 3e 6f 20 67 65 74 2d 6f 72 64 65 72 20 6e 0 >o get-order n
0a70: 3e 72 0a 20 20 20 20 6f 6e 6c 79 20 70 72 65 76 >r. only prev
0a80: 69 6f 75 73 20 20 6b 65 79 2d 70 61 72 73 65 72 ious key-parser
0a90: 20 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 20 20 include-file
0aa0: 6e 72 3e 20 73 65 74 2d 6f 72 64 65 72 20 6f 3e nr> set-order o>
0ab0: 20 3b 0a 0a 3a 20 3f 73 63 61 6e 2d 6b 65 79 73 ;..: ?scan-keys
0ac0: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 ( addr u -- ).
0ad0: 20 20 20 72 2f 77 20 6f 70 65 6e 2d 66 69 6c 65 r/w open-file
0ae0: 20 30 3d 20 49 46 20 73 63 61 6e 2d 6b 65 79 73 0= IF scan-keys
0af0: 20 45 4c 53 45 20 64 72 6f 70 20 54 48 45 4e 20 ELSE drop THEN
0b00: 3b 0a 0a 3a 20 72 65 61 64 2d 6b 65 79 73 20 28 ;..: read-keys (
0b10: 20 2d 2d 20 29 0a 20 20 20 20 73 22 20 64 65 66 -- ). s" def
0b20: 61 75 6c 74 2e 6e 32 6f 22 20 3f 73 63 61 6e 2d ault.n2o" ?scan-
0b30: 6b 65 79 73 0a 20 20 20 20 73 22 20 7e 2f 2e 6e keys. s" ~/.n
0b40: 65 74 32 6f 2f 73 65 63 6b 65 79 73 2e 6e 32 6f et2o/seckeys.n2o
0b50: 22 20 3f 73 63 61 6e 2d 6b 65 79 73 0a 20 20 20 " ?scan-keys.
0b60: 20 73 22 20 7e 2f 2e 6e 65 74 32 6f 2f 70 75 62 s" ~/.net2o/pub
0b70: 6b 65 79 73 2e 6e 32 6f 22 20 3f 73 63 61 6e 2d keys.n2o" ?scan-
0b80: 6b 65 79 73 20 3b 0a 0a 5c 20 73 65 61 72 63 68 keys ;..\ search
0b90: 20 66 6f 72 20 6b 65 79 73 20 62 79 20 6e 61 6d for keys by nam
0ba0: 65 20 61 6e 64 20 6e 69 63 6b 0a 5c 20 21 21 46 e and nick.\ !!F
0bb0: 49 58 4d 45 21 21 20 6e 6f 74 20 6f 70 74 69 6d IXME!! not optim
0bc0: 69 7a 65 64 0a 0a 3a 20 6e 69 63 6b 2d 6b 65 79 ized..: nick-key
0bd0: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 5c ( addr u -- ) \
0be0: 20 73 65 61 72 63 68 20 66 6f 72 20 6b 65 79 20 search for key
0bf0: 6e 69 63 6b 6e 61 6d 65 20 61 6e 64 20 6d 61 6b nickname and mak
0c00: 65 20 63 75 72 72 65 6e 74 0a 20 20 20 20 6b 65 e current. ke
0c10: 79 2d 74 61 62 6c 65 20 0a 20 20 20 20 5b 3a 20 y-table . [:
0c20: 64 75 70 20 3e 72 20 63 65 6c 6c 2b 20 24 40 20 dup >r cell+ $@
0c30: 64 72 6f 70 20 3e 6f 20 6b 65 2d 6e 69 63 6b 20 drop >o ke-nick
0c40: 24 40 20 6f 3e 20 32 6f 76 65 72 20 73 74 72 3d $@ o> 2over str=
0c50: 20 49 46 0a 09 72 40 20 6d 61 6b 65 2d 74 68 69 IF..r@ make-thi
0c60: 73 6b 65 79 0a 20 20 20 20 54 48 45 4e 20 20 72 skey. THEN r
0c70: 64 72 6f 70 20 3b 5d 20 23 6d 61 70 20 32 64 72 drop ;] #map 2dr
0c80: 6f 70 20 3b 0a 0a 3a 20 6e 61 6d 65 2d 6b 65 79 op ;..: name-key
0c90: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 5c ( addr u -- ) \
0ca0: 20 73 65 61 72 63 68 20 66 6f 72 20 6b 65 79 20 search for key
0cb0: 6e 61 6d 65 20 61 6e 64 20 6d 61 6b 65 20 63 75 name and make cu
0cc0: 72 72 65 6e 74 0a 20 20 20 20 6b 65 79 2d 74 61 rrent. key-ta
0cd0: 62 6c 65 20 0a 20 20 20 20 5b 3a 20 64 75 70 20 ble . [: dup
0ce0: 3e 72 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 >r cell+ $@ drop
0cf0: 20 3e 6f 20 6b 65 2d 6e 61 6d 65 20 24 40 20 6f >o ke-name $@ o
0d00: 3e 20 32 6f 76 65 72 20 73 74 72 3d 20 49 46 0a > 2over str= IF.
0d10: 09 72 40 20 6d 61 6b 65 2d 74 68 69 73 6b 65 79 .r@ make-thiskey
0d20: 0a 20 20 20 20 54 48 45 4e 20 20 72 64 72 6f 70 . THEN rdrop
0d30: 20 3b 5d 20 23 6d 61 70 20 3b 0a 0a 5c 20 61 63 ;] #map ;..\ ac
0d40: 63 65 70 74 20 66 6f 72 20 70 61 73 73 77 6f 72 cept for passwor
0d50: 64 20 65 6e 74 72 79 0a 0a 3a 20 61 63 63 65 70 d entry..: accep
0d60: 74 2a 20 28 20 61 64 64 72 20 75 20 2d 2d 20 75 t* ( addr u -- u
0d70: 27 20 29 0a 20 20 20 20 5c 20 61 63 63 65 70 74 ' ). \ accept
0d80: 2d 6c 69 6b 65 20 69 6e 70 75 74 2c 20 62 75 74 -like input, but
0d90: 20 74 79 70 65 73 20 2a 20 69 6e 73 74 65 61 64 types * instead
0da0: 20 6f 66 20 74 68 65 20 63 68 61 72 61 63 74 65 of the characte
0db0: 72 0a 20 20 20 20 64 75 70 20 3e 72 0a 20 20 20 r. dup >r.
0dc0: 20 42 45 47 49 4e 20 20 78 6b 65 79 20 64 75 70 BEGIN xkey dup
0dd0: 20 23 63 72 20 3c 3e 20 57 48 49 4c 45 0a 09 20 #cr <> WHILE..
0de0: 20 20 20 64 75 70 20 23 62 73 20 3d 20 6f 76 65 dup #bs = ove
0df0: 72 20 23 64 65 6c 20 3d 20 6f 72 20 49 46 0a 09 r #del = or IF..
0e00: 09 64 72 6f 70 20 64 75 70 20 72 40 20 75 3c 20 .drop dup r@ u<
0e10: 49 46 0a 09 09 20 20 20 20 6f 76 65 72 20 2b 20 IF... over +
0e20: 3e 72 20 78 63 68 61 72 2d 20 72 3e 20 6f 76 65 >r xchar- r> ove
0e30: 72 20 2d 0a 09 09 20 20 20 20 31 20 62 61 63 6b r -... 1 back
0e40: 73 70 61 63 65 73 20 73 70 61 63 65 20 31 20 62 spaces space 1 b
0e50: 61 63 6b 73 70 61 63 65 73 0a 09 09 45 4c 53 45 ackspaces...ELSE
0e60: 0a 09 09 20 20 20 20 62 65 6c 6c 0a 09 09 54 48 ... bell...TH
0e70: 45 4e 0a 09 20 20 20 20 45 4c 53 45 0a 09 09 2d EN.. ELSE...-
0e80: 72 6f 74 20 78 63 21 2b 3f 20 30 3d 20 49 46 20 rot xc!+? 0= IF
0e90: 20 62 65 6c 6c 20 20 45 4c 53 45 20 20 27 2a 27 bell ELSE '*'
0ea0: 20 65 6d 69 74 20 20 54 48 45 4e 0a 09 20 20 20 emit THEN..
0eb0: 20 54 48 45 4e 0a 20 20 20 20 52 45 50 45 41 54 THEN. REPEAT
0ec0: 20 20 64 72 6f 70 20 20 6e 69 70 20 72 3e 20 73 drop nip r> s
0ed0: 77 61 70 20 2d 20 3b 0a 0a 6b 65 79 73 69 7a 65 wap - ;..keysize
0ee0: 20 62 75 66 66 65 72 3a 20 74 65 73 74 6b 65 79 buffer: testkey
0ef0: 0a 6b 65 79 73 69 7a 65 20 62 75 66 66 65 72 3a .keysize buffer:
0f00: 20 74 65 73 74 73 6b 63 0a 6b 65 79 73 69 7a 65 testskc.keysize
0f10: 20 62 75 66 66 65 72 3a 20 70 61 73 73 73 6b 63 buffer: passskc
0f20: 0a 0a 3a 20 63 68 65 63 6b 2d 6b 65 79 3f 20 28 ..: check-key? (
0f30: 20 61 64 64 72 20 2d 2d 20 66 6c 61 67 20 29 20 addr -- flag )
0f40: 20 3e 72 0a 20 20 20 20 74 65 73 74 6b 65 79 20 >r. testkey
0f50: 72 40 20 62 61 73 65 39 20 63 72 79 70 74 6f 5f r@ base9 crypto_
0f60: 73 63 61 6c 61 72 6d 75 6c 74 0a 20 20 20 20 74 scalarmult. t
0f70: 65 73 74 6b 65 79 20 6b 65 79 73 69 7a 65 20 70 estkey keysize p
0f80: 6b 63 20 6f 76 65 72 20 73 74 72 3d 20 49 46 20 kc over str= IF
0f90: 20 72 40 20 73 6b 63 20 6b 65 79 73 69 7a 65 20 r@ skc keysize
0fa0: 6d 6f 76 65 20 20 74 72 75 65 0a 20 20 20 20 45 move true. E
0fb0: 4c 53 45 20 20 66 61 6c 73 65 20 20 54 48 45 4e LSE false THEN
0fc0: 20 20 72 64 72 6f 70 20 3b 0a 0a 33 20 56 61 6c rdrop ;..3 Val
0fd0: 75 65 20 70 61 73 73 70 68 72 61 73 65 2d 72 65 ue passphrase-re
0fe0: 74 72 79 23 0a 24 31 30 30 20 56 61 6c 75 65 20 try#.$100 Value
0ff0: 70 61 73 73 70 68 72 61 73 65 2d 64 69 66 66 75 passphrase-diffu
1000: 73 65 23 0a 0a 3a 20 67 65 74 2d 70 61 73 73 70 se#..: get-passp
1010: 68 72 61 73 65 20 28 20 61 64 64 72 69 6e 20 2d hrase ( addrin -
1020: 2d 20 61 64 64 72 6f 75 74 20 29 0a 20 20 20 20 - addrout ).
1030: 70 61 73 73 73 6b 63 20 6b 65 79 73 69 7a 65 20 passskc keysize
1040: 6d 6f 76 65 20 20 20 77 75 72 73 74 2d 73 6f 75 move wurst-sou
1050: 72 63 65 20 72 6f 75 6e 64 73 2d 73 65 74 6b 65 rce rounds-setke
1060: 79 0a 20 20 20 20 6d 65 73 73 61 67 65 20 73 74 y. message st
1070: 61 74 65 23 20 38 20 2a 20 32 64 75 70 20 61 63 ate# 8 * 2dup ac
1080: 63 65 70 74 2a 20 64 75 70 20 3e 72 20 73 61 66 cept* dup >r saf
1090: 65 2f 73 74 72 69 6e 67 20 65 72 61 73 65 0a 20 e/string erase.
10a0: 20 20 20 72 3e 20 49 46 0a 09 73 6f 75 72 63 65 r> IF..source
10b0: 2d 69 6e 69 74 20 77 75 72 73 74 2d 6b 65 79 20 -init wurst-key
10c0: 68 61 73 68 2d 69 6e 69 74 0a 09 6d 65 73 73 61 hash-init..messa
10d0: 67 65 20 72 6f 75 6e 64 73 68 23 20 72 6f 75 6e ge roundsh# roun
10e0: 64 73 2d 65 6e 63 72 79 70 74 0a 09 70 61 73 73 ds-encrypt..pass
10f0: 70 68 72 61 73 65 2d 64 69 66 66 75 73 65 23 20 phrase-diffuse#
1100: 30 20 3f 44 4f 20 20 73 74 61 72 74 2d 64 69 66 0 ?DO start-dif
1110: 66 75 73 65 20 20 4c 4f 4f 50 20 5c 20 6a 75 73 fuse LOOP \ jus
1120: 74 20 74 6f 20 77 61 73 74 65 20 74 69 6d 65 20 t to waste time
1130: 3b 2d 29 0a 09 77 75 72 73 74 2d 73 74 61 74 65 ;-)..wurst-state
1140: 20 70 61 73 73 73 6b 63 20 6b 65 79 73 69 7a 65 passskc keysize
1150: 20 78 6f 72 73 0a 09 77 75 72 73 74 2d 73 74 61 xors..wurst-sta
1160: 74 65 20 6b 65 79 73 69 7a 65 20 2b 20 70 61 73 te keysize + pas
1170: 73 73 6b 63 20 6b 65 79 73 69 7a 65 20 78 6f 72 sskc keysize xor
1180: 73 0a 20 20 20 20 54 48 45 4e 20 20 70 61 73 73 s. THEN pass
1190: 73 6b 63 20 3b 0a 0a 3a 20 6e 65 77 2d 70 61 73 skc ;..: new-pas
11a0: 73 70 68 72 61 73 65 20 28 20 2d 2d 20 29 0a 20 sphrase ( -- ).
11b0: 20 20 20 70 61 73 73 70 68 72 61 73 65 2d 72 65 passphrase-re
11c0: 74 72 79 23 20 30 20 3f 44 4f 0a 09 63 72 20 2e try# 0 ?DO..cr .
11d0: 22 20 45 6e 74 65 72 20 50 61 73 73 70 68 72 61 " Enter Passphra
11e0: 73 65 3a 20 22 20 20 20 20 20 20 20 73 6b 63 20 se: " skc
11f0: 67 65 74 2d 70 61 73 73 70 68 72 61 73 65 0a 09 get-passphrase..
1200: 74 65 73 74 73 6b 63 20 6b 65 79 73 69 7a 65 20 testskc keysize
1210: 6d 6f 76 65 0a 09 63 72 20 2e 22 20 52 65 65 6e move..cr ." Reen
1220: 74 65 72 20 50 61 73 73 70 68 72 61 73 65 3a 20 ter Passphrase:
1230: 22 20 20 20 20 20 73 6b 63 20 67 65 74 2d 70 61 " skc get-pa
1240: 73 73 70 68 72 61 73 65 0a 09 74 65 73 74 73 6b ssphrase..testsk
1250: 63 20 6b 65 79 73 69 7a 65 20 74 75 63 6b 20 73 c keysize tuck s
1260: 74 72 3d 20 49 46 20 20 75 6e 6c 6f 6f 70 20 20 tr= IF unloop
1270: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 4c EXIT THEN. L
1280: 4f 4f 50 20 20 21 21 6e 6f 6b 65 79 21 21 20 3b OOP !!nokey!! ;
1290: 0a 0a 3a 20 64 65 63 72 79 70 74 2d 73 6b 63 20 ..: decrypt-skc
12a0: 20 28 20 2d 2d 20 29 0a 20 20 20 20 74 65 73 74 ( -- ). test
12b0: 73 6b 63 20 63 68 65 63 6b 2d 6b 65 79 3f 20 3f skc check-key? ?
12c0: 45 58 49 54 0a 20 20 20 20 70 61 73 73 70 68 72 EXIT. passphr
12d0: 61 73 65 2d 72 65 74 72 79 23 20 30 20 3f 44 4f ase-retry# 0 ?DO
12e0: 0a 20 20 20 20 20 20 20 63 72 20 2e 22 20 50 61 . cr ." Pa
12f0: 73 73 70 68 72 61 73 65 3a 20 22 0a 20 20 20 20 ssphrase: ".
1300: 20 20 20 74 65 73 74 73 6b 63 20 67 65 74 2d 70 testskc get-p
1310: 61 73 73 70 68 72 61 73 65 20 63 68 65 63 6b 2d assphrase check-
1320: 6b 65 79 3f 20 49 46 20 20 75 6e 6c 6f 6f 70 20 key? IF unloop
1330: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 EXIT THEN.
1340: 4c 4f 4f 50 20 20 21 21 6e 6f 6b 65 79 21 21 20 LOOP !!nokey!!
1350: 3b 0a 0a 3a 20 3e 6b 65 79 20 28 20 61 64 64 72 ;..: >key ( addr
1360: 20 75 20 2d 2d 20 29 0a 20 20 20 20 6b 65 79 2d u -- ). key-
1370: 74 61 62 6c 65 20 40 20 30 3d 20 49 46 20 20 72 table @ 0= IF r
1380: 65 61 64 2d 6b 65 79 73 20 20 54 48 45 4e 0a 20 ead-keys THEN.
1390: 20 20 20 6e 69 63 6b 2d 6b 65 79 0a 20 20 20 20 nick-key.
13a0: 74 68 69 73 2d 6b 65 79 69 64 20 40 20 70 6b 63 this-keyid @ pkc
13b0: 20 6b 65 79 73 69 7a 65 20 6d 6f 76 65 0a 20 20 keysize move.
13c0: 20 20 6b 65 2d 73 6b 20 24 40 20 74 65 73 74 73 ke-sk $@ tests
13d0: 6b 63 20 73 77 61 70 20 6d 6f 76 65 20 20 64 65 kc swap move de
13e0: 63 72 79 70 74 2d 73 6b 63 20 3b 0a crypt-skc ;.