Artifact
e49bc59cb412293f5e7a5e98c773869d197a63f6:
- File
net2o-keys.fs
— part of check-in
[7b2865b60c]
at
2012-12-11 01:00:09
on branch trunk
— Key file 'data base'
(user:
bernd
size: 4480)
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 62 65 67 69 6e 2d ata base..begin-
0040: 73 74 72 75 63 74 75 72 65 20 6b 65 79 2d 65 6e structure key-en
0050: 74 72 79 0a 66 69 65 6c 64 3a 20 6b 65 2d 73 6b try.field: ke-sk
0060: 0a 66 69 65 6c 64 3a 20 6b 65 2d 6e 69 63 6b 0a .field: ke-nick.
0070: 66 69 65 6c 64 3a 20 6b 65 2d 6e 61 6d 65 0a 66 field: ke-name.f
0080: 69 65 6c 64 3a 20 6b 65 2d 73 69 67 73 0a 36 34 ield: ke-sigs.64
0090: 66 69 65 6c 64 3a 20 6b 65 2d 63 72 65 61 74 65 field: ke-create
00a0: 64 0a 36 34 66 69 65 6c 64 3a 20 6b 65 2d 65 78 d.64field: ke-ex
00b0: 70 69 72 65 73 0a 65 6e 64 2d 73 74 72 75 63 74 pires.end-struct
00c0: 75 72 65 0a 0a 6b 65 79 2d 65 6e 74 72 79 20 62 ure..key-entry b
00d0: 75 66 66 65 72 3a 20 73 61 6d 70 6c 65 2d 6b 65 uffer: sample-ke
00e0: 79 0a 0a 56 61 72 69 61 62 6c 65 20 6b 65 79 2d y..Variable key-
00f0: 74 61 62 6c 65 0a 56 61 72 69 61 62 6c 65 20 74 table.Variable t
0100: 68 69 73 2d 6b 65 79 0a 73 61 6d 70 6c 65 2d 6b his-key.sample-k
0110: 65 79 20 74 68 69 73 2d 6b 65 79 20 21 20 5c 20 ey this-key ! \
0120: 64 75 6d 6d 79 0a 0a 3a 20 6e 65 77 2d 6b 65 79 dummy..: new-key
0130: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 ( addr u -- ).
0140: 20 20 20 5c 20 61 64 64 72 20 75 20 69 73 20 74 \ addr u is t
0150: 68 65 20 70 75 62 6c 69 63 20 6b 65 79 0a 20 20 he public key.
0160: 20 20 73 61 6d 70 6c 65 2d 6b 65 79 20 6b 65 79 sample-key key
0170: 2d 65 6e 74 72 79 20 32 64 75 70 20 65 72 61 73 -entry 2dup eras
0180: 65 0a 20 20 20 20 32 6f 76 65 72 20 6b 65 79 2d e. 2over key-
0190: 74 61 62 6c 65 20 23 21 20 6b 65 79 2d 74 61 62 table #! key-tab
01a0: 6c 65 20 23 40 20 64 72 6f 70 20 74 68 69 73 2d le #@ drop this-
01b0: 6b 65 79 20 21 20 3b 0a 0a 3a 20 28 64 69 67 69 key ! ;..: (digi
01c0: 74 73 3e 24 29 20 28 20 61 64 64 72 20 75 20 2d ts>$) ( addr u -
01d0: 2d 20 61 64 64 72 27 20 75 27 20 29 20 73 61 76 - addr' u' ) sav
01e0: 65 2d 6d 65 6d 0a 20 20 20 20 3e 72 20 64 75 70 e-mem. >r dup
01f0: 20 64 75 70 20 72 3e 20 62 6f 75 6e 64 73 20 3f dup r> bounds ?
0200: 44 4f 0a 09 49 20 32 20 73 3e 6e 75 6d 62 65 72 DO..I 2 s>number
0210: 20 64 72 6f 70 20 6f 76 65 72 20 63 21 20 63 68 drop over c! ch
0220: 61 72 2b 20 0a 20 20 20 20 32 20 2b 4c 4f 4f 50 ar+ . 2 +LOOP
0230: 20 20 6f 76 65 72 20 2d 20 3b 0a 0a 3a 20 68 65 over - ;..: he
0240: 78 3e 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20 x>$ ( addr u --
0250: 61 64 64 72 27 20 75 27 20 29 0a 20 20 20 20 5b addr' u' ). [
0260: 27 5d 20 28 64 69 67 69 74 73 3e 24 29 20 24 31 '] (digits>$) $1
0270: 30 20 62 61 73 65 2d 65 78 65 63 75 74 65 20 3b 0 base-execute ;
0280: 0a 0a 3a 20 78 22 20 28 20 22 68 65 78 73 74 72 ..: x" ( "hexstr
0290: 69 6e 67 22 20 2d 2d 20 61 64 64 72 20 75 20 29 ing" -- addr u )
02a0: 0a 20 20 20 20 27 22 27 20 70 61 72 73 65 20 68 . '"' parse h
02b0: 65 78 3e 24 20 3b 0a 63 6f 6d 70 69 6c 65 3e 20 ex>$ ;.compile>
02c0: 65 78 65 63 75 74 65 20 70 6f 73 74 70 6f 6e 65 execute postpone
02d0: 20 53 4c 69 74 65 72 61 6c 20 3b 0a 0a 56 6f 63 SLiteral ;..Voc
02e0: 61 62 75 6c 61 72 79 20 6b 65 79 2d 70 61 72 73 abulary key-pars
02f0: 65 72 0a 0a 61 6c 73 6f 20 6b 65 79 2d 70 61 72 er..also key-par
0300: 73 65 72 20 64 65 66 69 6e 69 74 69 6f 6e 73 0a ser definitions.
0310: 0a 3a 20 69 64 3a 20 28 20 22 69 64 22 20 2d 2d .: id: ( "id" --
0320: 20 29 20 30 20 70 61 72 73 65 20 68 65 78 3e 24 ) 0 parse hex>$
0330: 20 6e 65 77 2d 6b 65 79 20 3b 0a 3a 20 73 6b 3a new-key ;.: sk:
0340: 20 28 20 22 73 6b 22 20 2d 2d 20 29 20 30 20 70 ( "sk" -- ) 0 p
0350: 61 72 73 65 20 68 65 78 3e 24 20 74 68 69 73 2d arse hex>$ this-
0360: 6b 65 79 20 40 20 6b 65 2d 73 6b 20 24 21 20 3b key @ ke-sk $! ;
0370: 0a 3a 20 6e 69 63 6b 3a 20 28 20 22 73 6b 22 20 .: nick: ( "sk"
0380: 2d 2d 20 29 20 30 20 70 61 72 73 65 20 74 68 69 -- ) 0 parse thi
0390: 73 2d 6b 65 79 20 40 20 6b 65 2d 6e 69 63 6b 20 s-key @ ke-nick
03a0: 24 21 20 3b 0a 3a 20 6e 61 6d 65 3a 20 28 20 22 $! ;.: name: ( "
03b0: 73 6b 22 20 2d 2d 20 29 20 30 20 70 61 72 73 65 sk" -- ) 0 parse
03c0: 20 74 68 69 73 2d 6b 65 79 20 40 20 6b 65 2d 6e this-key @ ke-n
03d0: 61 6d 65 20 24 21 20 3b 0a 3a 20 63 72 65 61 74 ame $! ;.: creat
03e0: 65 64 3a 20 28 20 22 6e 75 6d 62 65 72 22 20 2d ed: ( "number" -
03f0: 2d 20 29 20 20 70 61 72 73 65 2d 6e 61 6d 65 20 - ) parse-name
0400: 73 3e 6e 75 6d 62 65 72 20 64 3e 36 34 20 74 68 s>number d>64 th
0410: 69 73 2d 6b 65 79 20 40 20 6b 65 2d 63 72 65 61 is-key @ ke-crea
0420: 74 65 64 20 36 34 21 20 3b 0a 3a 20 65 78 70 69 ted 64! ;.: expi
0430: 72 65 73 3a 20 28 20 22 6e 75 6d 62 65 72 22 20 res: ( "number"
0440: 2d 2d 20 29 20 20 70 61 72 73 65 2d 6e 61 6d 65 -- ) parse-name
0450: 20 73 3e 6e 75 6d 62 65 72 20 64 3e 36 34 20 74 s>number d>64 t
0460: 68 69 73 2d 6b 65 79 20 40 20 6b 65 2d 65 78 70 his-key @ ke-exp
0470: 69 72 65 73 20 36 34 21 20 3b 0a 0a 70 72 65 76 ires 64! ;..prev
0480: 69 6f 75 73 20 64 65 66 69 6e 69 74 69 6f 6e 73 ious definitions
0490: 0a 0a 3a 20 2e 6b 65 79 20 28 20 61 64 64 72 20 ..: .key ( addr
04a0: 2d 2d 20 29 20 20 64 75 70 20 40 20 30 3d 20 49 -- ) dup @ 0= I
04b0: 46 20 20 64 72 6f 70 20 20 45 58 49 54 20 20 54 F drop EXIT T
04c0: 48 45 4e 0a 20 20 20 20 2e 22 20 69 64 3a 20 22 HEN. ." id: "
04d0: 20 20 20 64 75 70 20 24 40 20 78 74 79 70 65 20 dup $@ xtype
04e0: 63 72 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 cr cell+ $@ drop
04f0: 20 3e 72 0a 20 20 20 20 72 40 20 6b 65 2d 73 6b >r. r@ ke-sk
0500: 20 20 20 40 20 49 46 20 20 2e 22 20 73 6b 3a 20 @ IF ." sk:
0510: 22 20 20 20 72 40 20 6b 65 2d 73 6b 20 24 40 20 " r@ ke-sk $@
0520: 78 74 79 70 65 20 63 72 20 20 54 48 45 4e 0a 20 xtype cr THEN.
0530: 20 20 20 72 40 20 6b 65 2d 6e 69 63 6b 20 40 20 r@ ke-nick @
0540: 49 46 20 20 2e 22 20 6e 69 63 6b 3a 20 22 20 72 IF ." nick: " r
0550: 40 20 6b 65 2d 6e 69 63 6b 20 24 40 20 74 79 70 @ ke-nick $@ typ
0560: 65 20 63 72 20 20 54 48 45 4e 0a 20 20 20 20 72 e cr THEN. r
0570: 40 20 6b 65 2d 6e 61 6d 65 20 40 20 49 46 20 20 @ ke-name @ IF
0580: 2e 22 20 6e 61 6d 65 3a 20 22 20 72 40 20 6b 65 ." name: " r@ ke
0590: 2d 6e 61 6d 65 20 24 40 20 74 79 70 65 20 63 72 -name $@ type cr
05a0: 20 20 54 48 45 4e 0a 20 20 20 20 72 40 20 6b 65 THEN. r@ ke
05b0: 2d 63 72 65 61 74 65 64 20 36 34 40 20 36 34 64 -created 64@ 64d
05c0: 75 70 20 36 34 2d 30 3d 20 49 46 20 20 36 34 64 up 64-0= IF 64d
05d0: 72 6f 70 0a 20 20 20 20 45 4c 53 45 20 20 2e 22 rop. ELSE ."
05e0: 20 63 72 65 61 74 65 64 3a 20 22 20 36 34 3e 64 created: " 64>d
05f0: 20 64 2e 20 63 72 20 20 54 48 45 4e 0a 20 20 20 d. cr THEN.
0600: 20 72 40 20 6b 65 2d 65 78 70 69 72 65 73 20 36 r@ ke-expires 6
0610: 34 40 20 36 34 64 75 70 20 36 34 2d 30 3d 20 49 4@ 64dup 64-0= I
0620: 46 20 20 36 34 64 72 6f 70 0a 20 20 20 20 45 4c F 64drop. EL
0630: 53 45 20 20 2e 22 20 65 78 70 69 72 65 73 3a 20 SE ." expires:
0640: 22 20 36 34 3e 64 20 64 2e 20 63 72 20 20 54 48 " 64>d d. cr TH
0650: 45 4e 0a 20 20 20 20 72 64 72 6f 70 20 63 72 20 EN. rdrop cr
0660: 3b 0a 0a 3a 20 64 75 6d 70 2d 6b 65 79 73 20 28 ;..: dump-keys (
0670: 20 66 64 20 2d 2d 20 29 20 5b 3a 20 6b 65 79 2d fd -- ) [: key-
0680: 74 61 62 6c 65 20 5b 27 5d 20 2e 6b 65 79 20 23 table ['] .key #
0690: 6d 61 70 20 3b 5d 20 73 77 61 70 20 6f 75 74 66 map ;] swap outf
06a0: 69 6c 65 2d 65 78 65 63 75 74 65 20 3b 0a 0a 3a ile-execute ;..:
06b0: 20 6e 3e 72 20 28 20 78 31 20 2e 2e 20 78 6e 20 n>r ( x1 .. xn
06c0: 6e 20 2d 2d 20 72 3a 78 6e 2e 2e 78 31 20 72 3a n -- r:xn..x1 r:
06d0: 6e 20 29 0a 20 20 20 20 72 3e 20 7b 20 6e 20 72 n ). r> { n r
06e0: 65 74 20 7d 0a 20 20 20 20 30 20 20 42 45 47 49 et }. 0 BEGI
06f0: 4e 20 20 64 75 70 20 6e 20 3c 20 20 57 48 49 4c N dup n < WHIL
0700: 45 20 20 73 77 61 70 20 3e 72 20 31 2b 20 20 52 E swap >r 1+ R
0710: 45 50 45 41 54 20 20 3e 72 0a 20 20 20 20 72 65 EPEAT >r. re
0720: 74 20 3e 72 20 3b 0a 3a 20 6e 72 3e 20 28 20 72 t >r ;.: nr> ( r
0730: 3a 78 6e 2e 2e 78 31 20 72 3a 6e 20 2d 2d 20 78 :xn..x1 r:n -- x
0740: 31 20 2e 2e 20 78 6e 20 6e 20 29 0a 20 20 20 20 1 .. xn n ).
0750: 72 3e 20 72 3e 20 7b 20 72 65 74 20 6e 20 7d 0a r> r> { ret n }.
0760: 20 20 20 20 30 20 20 42 45 47 49 4e 20 20 64 75 0 BEGIN du
0770: 70 20 6e 20 3c 20 20 57 48 49 4c 45 20 20 72 3e p n < WHILE r>
0780: 20 73 77 61 70 20 31 2b 20 20 52 45 50 45 41 54 swap 1+ REPEAT
0790: 0a 20 20 20 20 72 65 74 20 3e 72 20 3b 0a 0a 3a . ret >r ;..:
07a0: 20 73 63 61 6e 2d 6b 65 79 73 20 28 20 66 64 20 scan-keys ( fd
07b0: 2d 2d 20 29 20 20 67 65 74 2d 6f 72 64 65 72 20 -- ) get-order
07c0: 6e 3e 72 0a 20 20 20 20 6f 6e 6c 79 20 70 72 65 n>r. only pre
07d0: 76 69 6f 75 73 20 20 6b 65 79 2d 70 61 72 73 65 vious key-parse
07e0: 72 20 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 20 r include-file
07f0: 20 6e 72 3e 20 73 65 74 2d 6f 72 64 65 72 20 3b nr> set-order ;
0800: 0a 0a 5c 20 61 63 63 65 70 74 20 66 6f 72 20 70 ..\ accept for p
0810: 61 73 73 77 6f 72 64 20 65 6e 74 72 79 0a 0a 3a assword entry..:
0820: 20 61 63 63 65 70 74 2a 20 28 20 61 64 64 72 20 accept* ( addr
0830: 75 20 2d 2d 20 75 27 20 29 0a 20 20 20 20 5c 20 u -- u' ). \
0840: 61 63 63 65 70 74 2d 6c 69 6b 65 20 69 6e 70 75 accept-like inpu
0850: 74 2c 20 62 75 74 20 74 79 70 65 73 20 2a 20 69 t, but types * i
0860: 6e 73 74 65 61 64 20 6f 66 20 74 68 65 20 63 68 nstead of the ch
0870: 61 72 61 63 74 65 72 0a 20 20 20 20 64 75 70 20 aracter. dup
0880: 3e 72 0a 20 20 20 20 42 45 47 49 4e 20 20 78 6b >r. BEGIN xk
0890: 65 79 20 64 75 70 20 23 63 72 20 3c 3e 20 57 48 ey dup #cr <> WH
08a0: 49 4c 45 0a 09 20 20 20 20 64 75 70 20 23 62 73 ILE.. dup #bs
08b0: 20 3d 20 6f 76 65 72 20 23 64 65 6c 20 3d 20 6f = over #del = o
08c0: 72 20 49 46 0a 09 09 64 72 6f 70 20 64 75 70 20 r IF...drop dup
08d0: 72 40 20 75 3c 20 49 46 0a 09 09 20 20 20 20 6f r@ u< IF... o
08e0: 76 65 72 20 2b 20 3e 72 20 78 63 68 61 72 2d 20 ver + >r xchar-
08f0: 72 3e 20 6f 76 65 72 20 2d 0a 09 09 20 20 20 20 r> over -...
0900: 31 20 62 61 63 6b 73 70 61 63 65 73 20 73 70 61 1 backspaces spa
0910: 63 65 20 31 20 62 61 63 6b 73 70 61 63 65 73 0a ce 1 backspaces.
0920: 09 09 45 4c 53 45 0a 09 09 20 20 20 20 62 65 6c ..ELSE... bel
0930: 6c 0a 09 09 54 48 45 4e 0a 09 20 20 20 20 45 4c l...THEN.. EL
0940: 53 45 0a 09 09 2d 72 6f 74 20 78 63 21 2b 3f 20 SE...-rot xc!+?
0950: 30 3d 20 49 46 20 20 62 65 6c 6c 20 20 45 4c 53 0= IF bell ELS
0960: 45 20 20 27 2a 27 20 65 6d 69 74 20 20 54 48 45 E '*' emit THE
0970: 4e 0a 09 20 20 20 20 54 48 45 4e 0a 20 20 20 20 N.. THEN.
0980: 52 45 50 45 41 54 20 20 64 72 6f 70 20 20 6e 69 REPEAT drop ni
0990: 70 20 72 3e 20 73 77 61 70 20 2d 20 3b 0a 0a 3a p r> swap - ;..:
09a0: 20 3f 2e 6e 65 74 32 6f 20 28 20 2d 2d 20 29 0a ?.net2o ( -- ).
09b0: 20 20 20 20 73 22 20 7e 2f 2e 6e 65 74 32 6f 22 s" ~/.net2o"
09c0: 20 72 2f 6f 20 6f 70 65 6e 2d 66 69 6c 65 20 6e r/o open-file n
09d0: 69 70 20 49 46 0a 09 73 22 20 7e 2f 2e 6e 65 74 ip IF..s" ~/.net
09e0: 32 6f 22 20 24 31 43 30 20 6d 6b 64 69 72 2d 70 2o" $1C0 mkdir-p
09f0: 61 72 65 6e 74 73 20 74 68 72 6f 77 0a 20 20 20 arents throw.
0a00: 20 54 48 45 4e 20 3b 0a 0a 3a 20 6b 65 79 73 2d THEN ;..: keys-
0a10: 69 6e 20 28 20 70 6b 63 20 73 6b 63 20 61 64 64 in ( pkc skc add
0a20: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 72 2f 6f r u -- ). r/o
0a30: 20 6f 70 65 6e 2d 66 69 6c 65 20 74 68 72 6f 77 open-file throw
0a40: 20 7b 20 66 64 20 7d 20 73 77 61 70 0a 20 20 20 { fd } swap.
0a50: 20 6b 65 79 73 69 7a 65 20 66 64 20 72 65 61 64 keysize fd read
0a60: 2d 66 69 6c 65 20 74 68 72 6f 77 20 6b 65 79 73 -file throw keys
0a70: 69 7a 65 20 3c 3e 20 21 21 6e 6f 6b 65 79 21 21 ize <> !!nokey!!
0a80: 0a 20 20 20 20 6b 65 79 73 69 7a 65 20 66 64 20 . keysize fd
0a90: 72 65 61 64 2d 66 69 6c 65 20 74 68 72 6f 77 20 read-file throw
0aa0: 6b 65 79 73 69 7a 65 20 3c 3e 20 21 21 6e 6f 6b keysize <> !!nok
0ab0: 65 79 21 21 0a 20 20 20 20 66 64 20 63 6c 6f 73 ey!!. fd clos
0ac0: 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 3b 0a 0a e-file throw ;..
0ad0: 3a 20 6b 65 79 73 2d 6f 75 74 20 28 20 70 6b 63 : keys-out ( pkc
0ae0: 20 73 6b 63 20 61 64 64 72 20 75 20 2d 2d 20 29 skc addr u -- )
0af0: 0a 20 20 20 20 72 2f 77 20 63 72 65 61 74 65 2d . r/w create-
0b00: 66 69 6c 65 20 74 68 72 6f 77 20 7b 20 66 64 20 file throw { fd
0b10: 7d 20 73 77 61 70 0a 20 20 20 20 6b 65 79 73 69 } swap. keysi
0b20: 7a 65 20 66 64 20 77 72 69 74 65 2d 66 69 6c 65 ze fd write-file
0b30: 20 74 68 72 6f 77 0a 20 20 20 20 6b 65 79 73 69 throw. keysi
0b40: 7a 65 20 66 64 20 77 72 69 74 65 2d 66 69 6c 65 ze fd write-file
0b50: 20 74 68 72 6f 77 0a 20 20 20 20 66 64 20 63 6c throw. fd cl
0b60: 6f 73 65 2d 66 69 6c 65 20 74 68 72 6f 77 20 3b ose-file throw ;
0b70: 0a 0a 6b 65 79 73 69 7a 65 20 62 75 66 66 65 72 ..keysize buffer
0b80: 3a 20 74 65 73 74 6b 65 79 0a 6b 65 79 73 69 7a : testkey.keysiz
0b90: 65 20 62 75 66 66 65 72 3a 20 74 65 73 74 73 6b e buffer: testsk
0ba0: 63 0a 6b 65 79 73 69 7a 65 20 62 75 66 66 65 72 c.keysize buffer
0bb0: 3a 20 70 61 73 73 73 6b 63 0a 0a 3a 20 63 68 65 : passskc..: che
0bc0: 63 6b 2d 6b 65 79 3f 20 28 20 61 64 64 72 20 2d ck-key? ( addr -
0bd0: 2d 20 66 6c 61 67 20 29 20 20 3e 72 0a 20 20 20 - flag ) >r.
0be0: 20 74 65 73 74 6b 65 79 20 72 40 20 62 61 73 65 testkey r@ base
0bf0: 39 20 63 72 79 70 74 6f 5f 73 63 61 6c 61 72 6d 9 crypto_scalarm
0c00: 75 6c 74 0a 20 20 20 20 74 65 73 74 6b 65 79 20 ult. testkey
0c10: 6b 65 79 73 69 7a 65 20 70 6b 63 20 6f 76 65 72 keysize pkc over
0c20: 20 73 74 72 3d 20 49 46 20 20 72 40 20 73 6b 63 str= IF r@ skc
0c30: 20 6b 65 79 73 69 7a 65 20 6d 6f 76 65 20 20 74 keysize move t
0c40: 72 75 65 0a 20 20 20 20 45 4c 53 45 20 20 66 61 rue. ELSE fa
0c50: 6c 73 65 20 20 54 48 45 4e 20 20 72 64 72 6f 70 lse THEN rdrop
0c60: 20 3b 0a 0a 33 20 56 61 6c 75 65 20 70 61 73 73 ;..3 Value pass
0c70: 70 68 72 61 73 65 2d 72 65 74 72 79 23 0a 24 31 phrase-retry#.$1
0c80: 30 30 20 56 61 6c 75 65 20 70 61 73 73 70 68 72 00 Value passphr
0c90: 61 73 65 2d 64 69 66 66 75 73 65 23 0a 0a 3a 20 ase-diffuse#..:
0ca0: 67 65 74 2d 70 61 73 73 70 68 72 61 73 65 20 28 get-passphrase (
0cb0: 20 61 64 64 72 69 6e 20 2d 2d 20 61 64 64 72 6f addrin -- addro
0cc0: 75 74 20 29 0a 20 20 20 20 70 61 73 73 73 6b 63 ut ). passskc
0cd0: 20 6b 65 79 73 69 7a 65 20 6d 6f 76 65 20 20 20 keysize move
0ce0: 77 75 72 73 74 2d 73 6f 75 72 63 65 20 21 6b 65 wurst-source !ke
0cf0: 79 0a 20 20 20 20 6d 65 73 73 61 67 65 20 73 74 y. message st
0d00: 61 74 65 23 20 38 20 2a 20 32 64 75 70 20 61 63 ate# 8 * 2dup ac
0d10: 63 65 70 74 2a 20 64 75 70 20 3e 72 20 73 61 66 cept* dup >r saf
0d20: 65 2f 73 74 72 69 6e 67 20 65 72 61 73 65 0a 20 e/string erase.
0d30: 20 20 20 72 3e 20 49 46 0a 09 73 6f 75 72 63 65 r> IF..source
0d40: 2d 69 6e 69 74 20 77 75 72 73 74 2d 6b 65 79 20 -init wurst-key
0d50: 68 61 73 68 2d 69 6e 69 74 0a 09 6d 65 73 73 61 hash-init..messa
0d60: 67 65 20 72 6f 75 6e 64 73 68 23 20 72 6f 75 6e ge roundsh# roun
0d70: 64 73 0a 09 70 61 73 73 70 68 72 61 73 65 2d 64 ds..passphrase-d
0d80: 69 66 66 75 73 65 23 20 30 20 3f 44 4f 20 20 73 iffuse# 0 ?DO s
0d90: 74 61 72 74 2d 64 69 66 66 75 73 65 20 20 4c 4f tart-diffuse LO
0da0: 4f 50 20 5c 20 6a 75 73 74 20 74 6f 20 77 61 73 OP \ just to was
0db0: 74 65 20 74 69 6d 65 20 3b 2d 29 0a 09 77 75 72 te time ;-)..wur
0dc0: 73 74 2d 73 74 61 74 65 20 70 61 73 73 73 6b 63 st-state passskc
0dd0: 20 6b 65 79 73 69 7a 65 20 78 6f 72 73 0a 09 77 keysize xors..w
0de0: 75 72 73 74 2d 73 74 61 74 65 20 6b 65 79 73 69 urst-state keysi
0df0: 7a 65 20 2b 20 70 61 73 73 73 6b 63 20 6b 65 79 ze + passskc key
0e00: 73 69 7a 65 20 78 6f 72 73 0a 20 20 20 20 54 48 size xors. TH
0e10: 45 4e 20 20 70 61 73 73 73 6b 63 20 3b 0a 0a 56 EN passskc ;..V
0e20: 61 72 69 61 62 6c 65 20 6b 65 79 66 69 6c 65 0a ariable keyfile.
0e30: 0a 3a 20 3e 6b 65 79 2d 6e 61 6d 65 20 28 20 61 .: >key-name ( a
0e40: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 73 ddr u -- ). s
0e50: 22 20 7e 2f 2e 6e 65 74 32 6f 2f 22 20 6b 65 79 " ~/.net2o/" key
0e60: 66 69 6c 65 20 24 21 20 0a 20 20 20 20 6b 65 79 file $! . key
0e70: 66 69 6c 65 20 24 2b 21 20 73 22 20 2e 65 63 63 file $+! s" .ecc
0e80: 22 20 6b 65 79 66 69 6c 65 20 24 2b 21 20 3b 0a " keyfile $+! ;.
0e90: 0a 3a 20 6b 65 79 2d 6e 61 6d 65 20 28 20 2d 2d .: key-name ( --
0ea0: 20 29 20 20 6b 65 79 66 69 6c 65 20 40 20 3f 45 ) keyfile @ ?E
0eb0: 58 49 54 0a 20 20 20 20 2e 22 20 49 44 20 6e 61 XIT. ." ID na
0ec0: 6d 65 3a 20 22 20 70 61 64 20 31 30 30 20 61 63 me: " pad 100 ac
0ed0: 63 65 70 74 20 70 61 64 20 73 77 61 70 20 3e 6b cept pad swap >k
0ee0: 65 79 2d 6e 61 6d 65 20 3b 0a 0a 3a 20 72 65 61 ey-name ;..: rea
0ef0: 64 2d 6b 65 79 73 20 28 20 2d 2d 20 29 20 20 3f d-keys ( -- ) ?
0f00: 2e 6e 65 74 32 6f 20 6b 65 79 2d 6e 61 6d 65 0a .net2o key-name.
0f10: 20 20 20 20 70 6b 63 20 74 65 73 74 73 6b 63 20 pkc testskc
0f20: 6b 65 79 66 69 6c 65 20 24 40 20 6b 65 79 73 2d keyfile $@ keys-
0f30: 69 6e 0a 20 20 20 20 74 65 73 74 73 6b 63 20 63 in. testskc c
0f40: 68 65 63 6b 2d 6b 65 79 3f 20 3f 45 58 49 54 0a heck-key? ?EXIT.
0f50: 20 20 20 20 70 61 73 73 70 68 72 61 73 65 2d 72 passphrase-r
0f60: 65 74 72 79 23 20 30 20 3f 44 4f 0a 09 63 72 20 etry# 0 ?DO..cr
0f70: 2e 22 20 50 61 73 73 70 68 72 61 73 65 3a 20 22 ." Passphrase: "
0f80: 0a 09 74 65 73 74 73 6b 63 20 67 65 74 2d 70 61 ..testskc get-pa
0f90: 73 73 70 68 72 61 73 65 20 63 68 65 63 6b 2d 6b ssphrase check-k
0fa0: 65 79 3f 20 49 46 20 20 75 6e 6c 6f 6f 70 20 20 ey? IF unloop
0fb0: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 4c EXIT THEN. L
0fc0: 4f 4f 50 20 20 21 21 6e 6f 6b 65 79 21 21 20 3b OOP !!nokey!! ;
0fd0: 0a 0a 3a 20 6e 65 77 2d 70 61 73 73 70 68 72 61 ..: new-passphra
0fe0: 73 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 70 61 se ( -- ). pa
0ff0: 73 73 70 68 72 61 73 65 2d 72 65 74 72 79 23 20 ssphrase-retry#
1000: 30 20 3f 44 4f 0a 09 63 72 20 2e 22 20 45 6e 74 0 ?DO..cr ." Ent
1010: 65 72 20 50 61 73 73 70 68 72 61 73 65 3a 20 22 er Passphrase: "
1020: 20 20 20 20 20 20 20 73 6b 63 20 67 65 74 2d 70 skc get-p
1030: 61 73 73 70 68 72 61 73 65 0a 09 74 65 73 74 73 assphrase..tests
1040: 6b 63 20 6b 65 79 73 69 7a 65 20 6d 6f 76 65 0a kc keysize move.
1050: 09 63 72 20 2e 22 20 52 65 65 6e 74 65 72 20 50 .cr ." Reenter P
1060: 61 73 73 70 68 72 61 73 65 3a 20 22 20 20 20 20 assphrase: "
1070: 20 73 6b 63 20 67 65 74 2d 70 61 73 73 70 68 72 skc get-passphr
1080: 61 73 65 0a 09 74 65 73 74 73 6b 63 20 6b 65 79 ase..testskc key
1090: 73 69 7a 65 20 74 75 63 6b 20 73 74 72 3d 20 49 size tuck str= I
10a0: 46 20 20 75 6e 6c 6f 6f 70 20 20 45 58 49 54 20 F unloop EXIT
10b0: 20 54 48 45 4e 0a 20 20 20 20 4c 4f 4f 50 20 20 THEN. LOOP
10c0: 21 21 6e 6f 6b 65 79 21 21 20 3b 0a 0a 3a 20 77 !!nokey!! ;..: w
10d0: 72 69 74 65 2d 6b 65 79 73 20 28 20 2d 2d 20 29 rite-keys ( -- )
10e0: 20 20 3f 2e 6e 65 74 32 6f 20 6b 65 79 2d 6e 61 ?.net2o key-na
10f0: 6d 65 0a 20 20 20 20 6e 65 77 2d 70 61 73 73 70 me. new-passp
1100: 68 72 61 73 65 0a 20 20 20 20 70 6b 63 20 74 65 hrase. pkc te
1110: 73 74 73 6b 63 20 6b 65 79 66 69 6c 65 20 24 40 stskc keyfile $@
1120: 20 6b 65 79 73 2d 6f 75 74 20 3b 0a 0a 3a 20 3f keys-out ;..: ?
1130: 6b 65 79 70 61 69 72 20 28 20 2d 2d 20 29 0a 20 keypair ( -- ).
1140: 20 20 20 5b 27 5d 20 72 65 61 64 2d 6b 65 79 73 ['] read-keys
1150: 20 63 61 74 63 68 20 49 46 20 20 6e 6f 74 68 72 catch IF nothr
1160: 6f 77 20 67 65 6e 2d 6b 65 79 73 20 77 72 69 74 ow gen-keys writ
1170: 65 2d 6b 65 79 73 20 20 54 48 45 4e 20 3b 0a 0a e-keys THEN ;..