Artifact
1932964b51883c24f5d0a3beee77bf27f3a79da1:
- File
vault.fs
— part of check-in
[2326543d3a]
at
2019-06-20 22:13:20
on branch trunk
— Replace msg-logs by msg:log[]
(user:
bernd
size: 7189)
0000: 5c 20 65 6e 63 72 79 70 74 65 64 20 66 69 6c 65 \ encrypted file
0010: 73 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s
0020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0030: 20 20 20 20 20 31 30 66 65 62 32 30 31 35 70 79 10feb2015py
0040: 0a 0a 5c 20 43 6f 70 79 72 69 67 68 74 20 28 43 ..\ Copyright (C
0050: 29 20 32 30 31 35 20 20 20 42 65 72 6e 64 20 50 ) 2015 Bernd P
0060: 61 79 73 61 6e 0a 0a 5c 20 54 68 69 73 20 70 72 aysan..\ This pr
0070: 6f 67 72 61 6d 20 69 73 20 66 72 65 65 20 73 6f ogram is free so
0080: 66 74 77 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 ftware: you can
0090: 72 65 64 69 73 74 72 69 62 75 74 65 20 69 74 20 redistribute it
00a0: 61 6e 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 5c 20 and/or modify.\
00b0: 69 74 20 75 6e 64 65 72 20 74 68 65 20 74 65 72 it under the ter
00c0: 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 20 41 66 ms of the GNU Af
00d0: 66 65 72 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 fero General Pub
00e0: 6c 69 63 20 4c 69 63 65 6e 73 65 20 61 73 20 70 lic License as p
00f0: 75 62 6c 69 73 68 65 64 20 62 79 0a 5c 20 74 68 ublished by.\ th
0100: 65 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 20 e Free Software
0110: 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 68 Foundation, eith
0120: 65 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 20 er version 3 of
0130: 74 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 0a the License, or.
0140: 5c 20 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f \ (at your optio
0150: 6e 29 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 n) any later ver
0160: 73 69 6f 6e 2e 0a 0a 5c 20 54 68 69 73 20 70 72 sion...\ This pr
0170: 6f 67 72 61 6d 20 69 73 20 64 69 73 74 72 69 62 ogram is distrib
0180: 75 74 65 64 20 69 6e 20 74 68 65 20 68 6f 70 65 uted in the hope
0190: 20 74 68 61 74 20 69 74 20 77 69 6c 6c 20 62 65 that it will be
01a0: 20 75 73 65 66 75 6c 2c 0a 5c 20 62 75 74 20 57 useful,.\ but W
01b0: 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 ITHOUT ANY WARRA
01c0: 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 NTY; without eve
01d0: 6e 20 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 n the implied wa
01e0: 72 72 61 6e 74 79 20 6f 66 0a 5c 20 4d 45 52 43 rranty of.\ MERC
01f0: 48 41 4e 54 41 42 49 4c 49 54 59 20 6f 72 20 46 HANTABILITY or F
0200: 49 54 4e 45 53 53 20 46 4f 52 20 41 20 50 41 52 ITNESS FOR A PAR
0210: 54 49 43 55 4c 41 52 20 50 55 52 50 4f 53 45 2e TICULAR PURPOSE.
0220: 20 20 53 65 65 20 74 68 65 0a 5c 20 47 4e 55 20 See the.\ GNU
0230: 41 66 66 65 72 6f 20 47 65 6e 65 72 61 6c 20 50 Affero General P
0240: 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 66 6f ublic License fo
0250: 72 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 2e 0a r more details..
0260: 0a 5c 20 59 6f 75 20 73 68 6f 75 6c 64 20 68 61 .\ You should ha
0270: 76 65 20 72 65 63 65 69 76 65 64 20 61 20 63 6f ve received a co
0280: 70 79 20 6f 66 20 74 68 65 20 47 4e 55 20 41 66 py of the GNU Af
0290: 66 65 72 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 fero General Pub
02a0: 6c 69 63 20 4c 69 63 65 6e 73 65 0a 5c 20 61 6c lic License.\ al
02b0: 6f 6e 67 20 77 69 74 68 20 74 68 69 73 20 70 72 ong with this pr
02c0: 6f 67 72 61 6d 2e 20 20 49 66 20 6e 6f 74 2c 20 ogram. If not,
02d0: 73 65 65 20 3c 68 74 74 70 3a 2f 2f 77 77 77 2e see <http://www.
02e0: 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 6e 73 65 73 gnu.org/licenses
02f0: 2f 3e 2e 0a 0a 72 65 71 75 69 72 65 20 6e 65 74 />...require net
0300: 32 6f 2e 66 73 0a 0a 63 6d 64 2d 63 6c 61 73 73 2o.fs..cmd-class
0310: 20 63 6c 61 73 73 0a 20 20 20 20 4b 45 59 42 59 class. KEYBY
0320: 54 45 53 20 2b 66 69 65 6c 64 20 76 2d 64 68 65 TES +field v-dhe
0330: 20 5c 20 64 69 66 66 69 65 20 68 65 6c 6c 6d 61 \ diffie hellma
0340: 6e 20 65 78 63 68 61 6e 67 65 20 74 6d 70 6b 65 n exchange tmpke
0350: 79 0a 20 20 20 20 73 74 61 74 65 23 20 2b 66 69 y. state# +fi
0360: 65 6c 64 20 76 2d 6b 65 79 20 5c 20 66 69 6c 65 eld v-key \ file
0370: 20 76 61 75 6c 74 20 6b 65 79 2c 20 6d 61 78 69 vault key, maxi
0380: 6d 75 6d 20 36 34 20 62 79 74 65 73 0a 20 20 20 mum 64 bytes.
0390: 20 6b 65 63 63 61 6b 23 20 2b 66 69 65 6c 64 20 keccak# +field
03a0: 76 2d 6b 73 74 61 74 65 0a 20 20 20 20 32 66 69 v-kstate. 2fi
03b0: 65 6c 64 3a 20 76 2d 64 61 74 61 0a 20 20 20 20 eld: v-data.
03c0: 32 66 69 65 6c 64 3a 20 76 2d 73 69 67 0a 20 20 2field: v-sig.
03d0: 20 20 76 61 6c 75 65 3a 20 76 2d 6d 6f 64 65 20 value: v-mode
03e0: 5c 20 63 72 79 70 74 6f 20 6d 6f 64 65 20 61 6e \ crypto mode an
03f0: 64 20 6b 65 79 20 73 69 7a 65 0a 20 20 20 20 76 d key size. v
0400: 61 6c 75 65 3a 20 76 2f 62 6c 6b 32 20 5c 20 62 alue: v/blk2 \ b
0410: 6c 6f 63 6b 20 73 69 7a 65 20 70 6f 77 65 72 20 lock size power
0420: 6f 66 20 74 77 6f 0a 65 6e 64 2d 63 6c 61 73 73 of two.end-class
0430: 20 76 61 75 6c 74 2d 63 6c 61 73 73 0a 0a 44 65 vault-class..De
0440: 66 65 72 20 77 72 69 74 65 2d 64 65 63 72 79 70 fer write-decryp
0450: 74 0a 44 65 66 65 72 20 72 65 61 64 2d 65 6e 63 t.Defer read-enc
0460: 72 79 70 74 0a 0a 3a 20 3e 76 61 75 6c 74 20 28 rypt..: >vault (
0470: 20 2d 2d 20 6f 3a 76 61 75 6c 74 20 29 20 5c 20 -- o:vault ) \
0480: 70 75 73 68 20 61 20 76 61 75 6c 74 20 6f 62 6a push a vault obj
0490: 65 63 74 0a 20 20 20 20 76 61 75 6c 74 2d 63 6c ect. vault-cl
04a0: 61 73 73 20 6e 65 77 20 6e 3a 3e 6f 20 76 61 75 ass new n:>o vau
04b0: 6c 74 2d 74 61 62 6c 65 20 40 20 74 6f 6b 65 6e lt-table @ token
04c0: 2d 74 61 62 6c 65 20 21 0a 20 20 20 20 6d 79 2d -table !. my-
04d0: 6b 65 79 2d 64 65 66 61 75 6c 74 20 74 6f 20 6d key-default to m
04e0: 79 2d 6b 65 79 20 3b 0a 3a 20 76 2d 6d 6f 64 65 y-key ;.: v-mode
04f0: 3e 63 72 79 70 74 32 20 28 20 2d 2d 20 29 0a 20 >crypt2 ( -- ).
0500: 20 20 20 76 2d 6d 6f 64 65 20 24 31 30 20 72 73 v-mode $10 rs
0510: 68 69 66 74 20 24 46 46 20 61 6e 64 20 3e 63 72 hift $FF and >cr
0520: 79 70 74 20 3b 0a 0a 76 61 75 6c 74 2d 74 61 62 ypt ;..vault-tab
0530: 6c 65 20 3e 74 61 62 6c 65 0a 0a 73 63 6f 70 65 le >table..scope
0540: 7b 20 6e 65 74 32 6f 2d 62 61 73 65 0a 0a 63 6d { net2o-base..cm
0550: 64 2d 74 61 62 6c 65 20 24 40 20 69 6e 68 65 72 d-table $@ inher
0560: 69 74 2d 74 61 62 6c 65 20 76 61 75 6c 74 2d 74 it-table vault-t
0570: 61 62 6c 65 0a 5c 67 20 0a 5c 67 20 23 23 23 20 able.\g .\g ###
0580: 76 61 75 6c 74 20 63 6f 6d 6d 61 6e 64 73 20 23 vault commands #
0590: 23 23 0a 5c 67 20 0a 6e 65 74 32 6f 27 20 65 6d ##.\g .net2o' em
05a0: 69 74 20 6e 65 74 32 6f 3a 20 64 68 65 20 28 20 it net2o: dhe (
05b0: 24 3a 70 75 62 6b 65 79 20 2d 2d 20 29 20 63 2d $:pubkey -- ) c-
05c0: 73 74 61 74 65 20 40 20 21 21 69 6e 76 2d 6f 72 state @ !!inv-or
05d0: 64 65 72 21 21 0a 20 20 20 20 5c 67 20 73 74 61 der!!. \g sta
05e0: 72 74 20 64 69 66 66 69 65 20 68 65 6c 6c 6d 61 rt diffie hellma
05f0: 6e 20 65 78 63 68 61 6e 67 65 0a 20 20 20 20 24 n exchange. $
0600: 3e 20 3f 6b 65 79 73 69 7a 65 20 73 6b 40 20 64 > ?keysize sk@ d
0610: 72 6f 70 20 73 77 61 70 20 76 2d 64 68 65 20 65 rop swap v-dhe e
0620: 64 2d 64 68 20 32 64 72 6f 70 0a 20 20 20 20 76 d-dh 2drop. v
0630: 2d 6b 65 79 20 73 74 61 74 65 23 20 65 72 61 73 -key state# eras
0640: 65 20 31 20 63 2d 73 74 61 74 65 20 6f 72 21 20 e 1 c-state or!
0650: 3b 0a 2b 6e 65 74 32 6f 3a 20 76 61 75 6c 74 2d ;.+net2o: vault-
0660: 6b 65 79 73 20 28 20 24 3a 6b 65 79 73 20 2d 2d keys ( $:keys --
0670: 20 29 20 63 2d 73 74 61 74 65 20 40 20 31 20 3c ) c-state @ 1 <
0680: 3e 20 21 21 6e 6f 2d 74 6d 70 6b 65 79 21 21 0a > !!no-tmpkey!!.
0690: 20 20 20 20 5c 67 20 76 61 75 6c 74 20 6b 65 79 \g vault key
06a0: 73 20 63 61 6e 20 62 65 20 6f 70 65 6e 65 64 20 s can be opened
06b0: 77 69 74 68 20 74 68 65 20 64 68 65 20 73 65 63 with the dhe sec
06c0: 72 65 74 3b 20 65 61 63 68 20 6b 65 79 20 69 73 ret; each key is
06d0: 20 49 56 2b 73 65 73 73 69 6f 6e 20 6b 65 79 2b IV+session key+
06e0: 63 68 65 63 6b 73 75 6d 0a 20 20 20 20 76 2d 6d checksum. v-m
06f0: 6f 64 65 20 64 75 70 20 24 46 46 20 61 6e 64 20 ode dup $FF and
0700: 73 74 61 74 65 23 20 75 6d 61 78 20 7b 20 76 6b state# umax { vk
0710: 23 20 7d 20 38 20 72 73 68 69 66 74 20 24 46 46 # } 8 rshift $FF
0720: 20 61 6e 64 20 3e 63 72 79 70 74 0a 20 20 20 20 and >crypt.
0730: 24 3e 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 $> bounds ?DO..I
0740: 27 20 49 20 2d 20 76 6b 23 20 75 3e 3d 20 49 46 ' I - vk# u>= IF
0750: 0a 09 20 20 20 20 49 20 76 61 75 6c 74 6b 65 79 .. I vaultkey
0760: 20 76 6b 23 20 6d 6f 76 65 0a 09 20 20 20 20 76 vk# move.. v
0770: 61 75 6c 74 6b 65 79 20 76 6b 23 20 76 2d 64 68 aultkey vk# v-dh
0780: 65 20 6b 65 79 73 69 7a 65 20 64 65 63 72 79 70 e keysize decryp
0790: 74 24 20 49 46 0a 09 09 64 75 70 20 73 74 61 74 t$ IF...dup stat
07a0: 65 23 20 31 2b 20 6b 65 79 73 69 7a 65 20 77 69 e# 1+ keysize wi
07b0: 74 68 69 6e 20 21 21 6b 65 79 73 69 7a 65 21 21 thin !!keysize!!
07c0: 0a 09 09 76 2d 6b 65 79 20 73 74 61 74 65 23 20 ...v-key state#
07d0: 6d 6f 76 65 2d 72 65 70 0a 09 09 76 6b 65 79 28 move-rep...vkey(
07e0: 20 2e 22 20 76 6b 65 79 20 6b 65 79 78 3a 20 22 ." vkey keyx: "
07f0: 20 76 2d 6b 65 79 20 73 74 61 74 65 23 20 38 35 v-key state# 85
0800: 74 79 70 65 20 66 6f 72 74 68 3a 63 72 20 29 0a type forth:cr ).
0810: 09 09 32 20 63 2d 73 74 61 74 65 20 6f 72 21 20 ..2 c-state or!
0820: 20 4c 45 41 56 45 0a 09 20 20 20 20 45 4c 53 45 LEAVE.. ELSE
0830: 20 20 32 64 72 6f 70 20 20 54 48 45 4e 0a 09 54 2drop THEN..T
0840: 48 45 4e 0a 20 20 20 20 76 6b 23 20 2b 4c 4f 4f HEN. vk# +LOO
0850: 50 20 20 30 20 3e 63 72 79 70 74 20 3b 0a 2b 6e P 0 >crypt ;.+n
0860: 65 74 32 6f 3a 20 76 61 75 6c 74 2d 66 69 6c 65 et2o: vault-file
0870: 20 28 20 24 3a 63 6f 6e 74 65 6e 74 20 2d 2d 20 ( $:content --
0880: 29 20 63 2d 73 74 61 74 65 20 40 20 33 20 3c 3e ) c-state @ 3 <>
0890: 20 21 21 6e 6f 2d 74 6d 70 6b 65 79 21 21 0a 20 !!no-tmpkey!!.
08a0: 20 20 20 5c 67 20 74 68 69 73 20 69 73 20 74 68 \g this is th
08b0: 65 20 61 63 74 75 61 6c 20 63 6f 6e 74 65 6e 74 e actual content
08c0: 20 6f 66 20 74 68 65 20 76 61 75 6c 74 0a 20 20 of the vault.
08d0: 20 20 5c 67 20 69 66 20 62 6c 6f 63 6b 77 69 73 \g if blockwis
08e0: 65 2c 20 74 68 65 72 65 20 6d 61 79 20 62 65 20 e, there may be
08f0: 6d 75 6c 74 69 70 6c 65 20 70 61 72 74 73 0a 20 multiple parts.
0900: 20 20 20 76 2d 6d 6f 64 65 3e 63 72 79 70 74 32 v-mode>crypt2
0910: 0a 20 20 20 20 6e 6f 2d 6b 65 79 20 73 74 61 74 . no-key stat
0920: 65 23 20 3e 63 72 79 70 74 2d 73 6f 75 72 63 65 e# >crypt-source
0930: 20 20 76 2d 6b 65 79 20 73 74 61 74 65 23 20 3e v-key state# >
0940: 63 72 79 70 74 2d 6b 65 79 0a 20 20 20 20 76 6b crypt-key. vk
0950: 65 79 28 20 2e 22 20 76 6b 65 79 20 66 69 6c 65 ey( ." vkey file
0960: 78 3a 20 22 20 76 2d 6b 65 79 20 73 74 61 74 65 x: " v-key state
0970: 23 20 38 35 74 79 70 65 20 66 6f 72 74 68 3a 63 # 85type forth:c
0980: 72 20 29 0a 20 20 20 20 24 3e 20 32 64 75 70 20 r ). $> 2dup
0990: 63 3a 64 65 63 72 79 70 74 20 76 2d 64 61 74 61 c:decrypt v-data
09a0: 20 32 21 0a 20 20 20 20 63 3a 64 69 66 66 75 73 2!. c:diffus
09b0: 65 20 5c 20 6f 6e 65 20 65 78 74 72 61 20 64 69 e \ one extra di
09c0: 66 66 75 73 69 6f 6e 20 72 6f 75 6e 64 0a 20 20 ffusion round.
09d0: 20 20 30 20 3e 63 72 79 70 74 20 20 34 20 63 2d 0 >crypt 4 c-
09e0: 73 74 61 74 65 20 6f 72 21 20 3b 20 5c 20 6b 65 state or! ; \ ke
09f0: 65 70 20 66 6f 72 20 73 69 67 6e 61 74 75 72 65 ep for signature
0a00: 0a 2b 6e 65 74 32 6f 3a 20 76 61 75 6c 74 2d 73 .+net2o: vault-s
0a10: 69 67 20 28 20 24 3a 73 69 67 20 2d 2d 20 29 20 ig ( $:sig -- )
0a20: 63 2d 73 74 61 74 65 20 40 20 37 20 3c 3e 20 21 c-state @ 7 <> !
0a30: 21 6e 6f 2d 64 61 74 61 21 21 0a 20 20 20 20 5c !no-data!!. \
0a40: 67 20 74 68 65 20 73 69 67 6e 61 74 75 72 65 20 g the signature
0a50: 6f 66 20 74 68 65 20 76 61 75 6c 74 2c 20 75 73 of the vault, us
0a60: 69 6e 67 20 74 68 65 20 6b 65 79 65 64 20 68 61 ing the keyed ha
0a70: 73 68 20 6f 76 65 72 20 74 68 65 20 66 69 6c 65 sh over the file
0a80: 0a 20 20 20 20 76 6b 65 79 28 20 2e 22 20 76 6b . vkey( ." vk
0a90: 65 79 20 73 69 67 78 3a 20 22 20 76 2d 6b 65 79 ey sigx: " v-key
0aa0: 20 73 74 61 74 65 23 20 38 35 74 79 70 65 20 66 state# 85type f
0ab0: 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 20 63 3a orth:cr ). c:
0ac0: 6b 65 79 40 20 76 2d 6b 73 74 61 74 65 20 63 3a key@ v-kstate c:
0ad0: 6b 65 79 23 20 6d 6f 76 65 0a 20 20 20 20 24 3e key# move. $>
0ae0: 20 76 2d 6b 65 79 20 73 74 61 74 65 23 20 64 65 v-key state# de
0af0: 63 72 79 70 74 24 20 30 3d 20 21 21 6e 6f 2d 64 crypt$ 0= !!no-d
0b00: 65 63 72 79 70 74 21 21 0a 20 20 20 20 76 2d 6d ecrypt!!. v-m
0b10: 6f 64 65 3e 63 72 79 70 74 32 0a 20 20 20 20 76 ode>crypt2. v
0b20: 2d 6b 73 74 61 74 65 20 63 3a 6b 65 79 40 20 63 -kstate c:key@ c
0b30: 3a 6b 65 79 23 20 6d 6f 76 65 0a 20 20 20 20 76 :key# move. v
0b40: 65 72 69 66 79 2d 74 61 67 20 21 21 73 69 67 21 erify-tag !!sig!
0b50: 21 0a 20 20 20 20 32 64 75 70 20 64 75 70 20 73 !. 2dup dup s
0b60: 69 67 70 6b 73 69 7a 65 23 20 2d 20 2f 73 74 72 igpksize# - /str
0b70: 69 6e 67 20 76 2d 73 69 67 20 32 21 0a 20 20 20 ing v-sig 2!.
0b80: 20 73 69 67 70 6b 73 69 7a 65 23 20 2d 20 49 46 sigpksize# - IF
0b90: 20 20 70 40 2b 20 64 72 6f 70 20 36 34 3e 6e 20 p@+ drop 64>n
0ba0: 6e 65 67 61 74 65 20 76 2d 64 61 74 61 20 2b 21 negate v-data +!
0bb0: 20 20 45 4c 53 45 20 20 64 72 6f 70 20 20 54 48 ELSE drop TH
0bc0: 45 4e 0a 20 20 20 20 30 20 3e 63 72 79 70 74 20 EN. 0 >crypt
0bd0: 38 20 63 2d 73 74 61 74 65 20 6f 72 21 20 3b 0a 8 c-state or! ;.
0be0: 2b 6e 65 74 32 6f 3a 20 76 61 75 6c 74 2d 63 72 +net2o: vault-cr
0bf0: 79 70 74 20 28 20 6e 20 2d 2d 20 29 20 5c 67 20 ypt ( n -- ) \g
0c00: 73 65 74 20 65 6e 63 72 79 70 74 69 6f 6e 20 6d set encryption m
0c10: 6f 64 65 20 61 6e 64 20 6b 65 79 20 77 72 61 70 ode and key wrap
0c20: 20 73 69 7a 65 0a 20 20 20 20 63 2d 73 74 61 74 size. c-stat
0c30: 65 20 40 20 31 20 75 3e 20 21 21 69 6e 76 2d 6f e @ 1 u> !!inv-o
0c40: 72 64 65 72 21 21 20 20 36 34 3e 6e 20 74 6f 20 rder!! 64>n to
0c50: 76 2d 6d 6f 64 65 20 3b 0a 2b 6e 65 74 32 6f 3a v-mode ;.+net2o:
0c60: 20 76 61 75 6c 74 2d 61 75 74 68 20 28 20 24 3a vault-auth ( $:
0c70: 61 75 74 68 20 2d 2d 20 29 0a 20 20 20 20 5c 67 auth -- ). \g
0c80: 20 62 6c 6f 63 6b 20 61 75 74 68 65 6e 74 69 63 block authentic
0c90: 61 74 69 6f 6e 2c 20 36 34 20 62 79 74 65 20 62 ation, 64 byte b
0ca0: 6c 6f 63 6b 0a 20 20 20 20 63 2d 73 74 61 74 65 lock. c-state
0cb0: 20 40 20 37 20 3c 3e 20 21 21 6e 6f 2d 64 61 74 @ 7 <> !!no-dat
0cc0: 61 21 21 0a 20 20 20 20 5c 20 6f 74 68 65 72 77 a!!. \ otherw
0cd0: 69 73 65 20 77 6f 75 6c 64 20 65 78 70 6f 73 65 ise would expose
0ce0: 20 73 6f 6d 65 20 64 61 74 61 0a 20 20 20 20 24 some data. $
0cf0: 3e 20 76 2d 6b 73 74 61 74 65 20 63 3a 6b 65 79 > v-kstate c:key
0d00: 3e 20 76 2d 6b 73 74 61 74 65 20 24 34 30 20 73 > v-kstate $40 s
0d10: 74 72 3d 20 30 3d 20 21 21 76 61 75 6c 74 2d 61 tr= 0= !!vault-a
0d20: 75 74 68 21 21 0a 20 20 20 20 77 72 69 74 65 2d uth!!. write-
0d30: 64 65 63 72 79 70 74 20 5c 20 77 72 69 74 65 20 decrypt \ write
0d40: 61 20 63 68 75 6e 6b 20 6f 75 74 0a 20 20 20 20 a chunk out.
0d50: 34 20 63 2d 73 74 61 74 65 20 78 6f 72 21 20 3b 4 c-state xor! ;
0d60: 20 5c 20 73 74 65 70 20 62 61 63 6b 20 74 6f 20 \ step back to
0d70: 61 6c 6c 6f 77 20 66 61 75 6c 74 2d 66 69 6c 65 allow fault-file
0d80: 0a 2b 6e 65 74 32 6f 3a 20 76 61 75 6c 74 2d 64 .+net2o: vault-d
0d90: 68 65 2d 6b 65 79 73 20 28 20 24 3a 64 68 65 2b he-keys ( $:dhe+
0da0: 6b 65 79 73 20 2d 2d 20 29 20 20 63 2d 73 74 61 keys -- ) c-sta
0db0: 74 65 20 40 20 21 21 69 6e 76 2d 6f 72 64 65 72 te @ !!inv-order
0dc0: 21 21 0a 20 20 20 20 24 3e 20 76 2d 64 65 63 24 !!. $> v-dec$
0dd0: 20 32 64 75 70 20 64 30 3d 20 21 21 75 6e 6b 6e 2dup d0= !!unkn
0de0: 6f 77 6e 2d 6b 65 79 21 21 20 20 76 2d 6b 65 79 own-key!! v-key
0df0: 20 73 74 61 74 65 23 20 6d 6f 76 65 2d 72 65 70 state# move-rep
0e00: 0a 20 20 20 20 33 20 63 2d 73 74 61 74 65 20 6f . 3 c-state o
0e10: 72 21 20 3b 0a 0a 76 61 75 6c 74 2d 74 61 62 6c r! ;..vault-tabl
0e20: 65 20 24 73 61 76 65 0a 27 20 63 6f 6e 74 65 78 e $save.' contex
0e30: 74 2d 74 61 62 6c 65 20 69 73 20 67 65 6e 2d 74 t-table is gen-t
0e40: 61 62 6c 65 0a 0a 61 6c 73 6f 20 7d 73 63 6f 70 able..also }scop
0e50: 65 0a 0a 24 38 30 20 43 6f 6e 73 74 61 6e 74 20 e..$80 Constant
0e60: 6d 69 6e 2d 61 6c 69 67 6e 23 0a 24 34 30 30 20 min-align#.$400
0e70: 43 6f 6e 73 74 61 6e 74 20 70 6f 77 2d 61 6c 69 Constant pow-ali
0e80: 67 6e 23 0a 0a 3a 20 76 61 75 6c 74 2d 61 6c 69 gn#..: vault-ali
0e90: 67 6e 65 64 20 28 20 6c 65 6e 20 2d 2d 20 6c 65 gned ( len -- le
0ea0: 6e 27 20 29 0a 20 20 20 20 5c 47 20 41 6c 69 67 n' ). \G Alig
0eb0: 6e 20 76 61 75 6c 74 20 74 6f 20 6d 69 6e 69 6d n vault to minim
0ec0: 75 6d 20 67 72 61 6e 75 6c 61 72 69 74 79 20 70 um granularity p
0ed0: 6c 75 73 20 72 65 6c 61 74 69 76 65 20 61 6c 69 lus relative ali
0ee0: 67 6e 6d 65 6e 74 0a 20 20 20 20 5c 47 20 74 6f gnment. \G to
0ef0: 20 68 69 64 65 20 74 68 65 20 61 63 74 75 61 6c hide the actual
0f00: 20 66 69 6c 65 2d 73 69 7a 65 0a 20 20 20 20 31 file-size. 1
0f10: 2d 20 30 20 3e 72 20 20 42 45 47 49 4e 20 20 64 - 0 >r BEGIN d
0f20: 75 70 20 70 6f 77 2d 61 6c 69 67 6e 23 20 75 3e up pow-align# u>
0f30: 20 20 57 48 49 4c 45 20 20 31 20 72 73 68 69 66 WHILE 1 rshif
0f40: 74 20 72 3e 20 31 2b 20 3e 72 20 20 52 45 50 45 t r> 1+ >r REPE
0f50: 41 54 0a 20 20 20 20 31 2b 20 72 3e 20 6c 73 68 AT. 1+ r> lsh
0f60: 69 66 74 20 20 6d 69 6e 2d 61 6c 69 67 6e 23 20 ift min-align#
0f70: 31 2d 20 2b 20 6d 69 6e 2d 61 6c 69 67 6e 23 20 1- + min-align#
0f80: 6e 65 67 61 74 65 20 61 6e 64 20 3b 0a 0a 56 61 negate and ;..Va
0f90: 72 69 61 62 6c 65 20 65 6e 63 2d 6d 6f 64 65 0a riable enc-mode.
0fa0: 0a 3a 20 65 6e 63 2d 6b 65 63 63 61 6b 20 28 20 .: enc-keccak (
0fb0: 2d 2d 20 29 20 20 20 20 20 20 20 20 24 36 30 20 -- ) $60
0fc0: 65 6e 63 2d 6d 6f 64 65 20 21 20 3b 20 5c 20 77 enc-mode ! ; \ w
0fd0: 72 61 70 20 77 69 74 68 20 6b 65 63 63 61 6b 0a rap with keccak.
0fe0: 3a 20 65 6e 63 2d 74 68 72 65 65 66 69 73 68 20 : enc-threefish
0ff0: 28 20 2d 2d 20 29 20 24 30 31 30 31 36 30 20 65 ( -- ) $010160 e
1000: 6e 63 2d 6d 6f 64 65 20 21 20 3b 20 5c 20 77 72 nc-mode ! ; \ wr
1010: 61 70 20 77 69 74 68 20 74 68 72 65 65 66 69 73 ap with threefis
1020: 68 0a 3a 20 65 6e 63 3e 63 72 79 70 74 32 20 28 h.: enc>crypt2 (
1030: 20 2d 2d 20 29 0a 20 20 20 20 65 6e 63 2d 6d 6f -- ). enc-mo
1040: 64 65 20 40 20 24 31 30 20 72 73 68 69 66 74 20 de @ $10 rshift
1050: 24 46 46 20 61 6e 64 20 3e 63 72 79 70 74 20 3b $FF and >crypt ;
1060: 0a 0a 65 6e 63 2d 6b 65 63 63 61 6b 0a 0a 3a 20 ..enc-keccak..:
1070: 70 6b 2d 6f 66 66 20 28 20 2d 2d 20 29 20 6b 65 pk-off ( -- ) ke
1080: 79 2d 6c 69 73 74 20 24 5b 5d 6f 66 66 20 3b 0a y-list $[]off ;.
1090: 0a 3a 20 76 64 68 65 2c 20 28 20 2d 2d 20 29 20 .: vdhe, ( -- )
10a0: 20 20 73 74 73 6b 63 20 73 74 70 6b 63 20 65 64 stskc stpkc ed
10b0: 2d 6b 65 79 70 61 69 72 20 73 74 70 6b 63 20 6b -keypair stpkc k
10c0: 65 79 73 69 7a 65 20 24 2c 20 64 68 65 20 3b 0a eysize $, dhe ;.
10d0: 3a 20 76 6b 65 79 73 2c 20 28 20 6b 65 79 2d 6c : vkeys, ( key-l
10e0: 69 73 74 20 2d 2d 20 29 0a 20 20 20 20 76 61 75 ist -- ). vau
10f0: 6c 74 6b 65 79 20 24 31 30 30 20 65 72 61 73 65 ltkey $100 erase
1100: 0a 20 20 20 20 65 6e 63 2d 6d 6f 64 65 20 40 20 . enc-mode @
1110: 24 46 46 20 61 6e 64 20 24 32 30 20 2d 20 72 6e $FF and $20 - rn
1120: 67 24 20 76 6b 65 79 20 73 74 61 74 65 23 20 6d g$ vkey state# m
1130: 6f 76 65 2d 72 65 70 0a 20 20 20 20 76 6b 65 79 ove-rep. vkey
1140: 28 20 2e 22 20 76 6b 65 79 20 6b 65 79 3a 20 22 ( ." vkey key: "
1150: 20 76 6b 65 79 20 73 74 61 74 65 23 20 38 35 74 vkey state# 85t
1160: 79 70 65 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 ype forth:cr ).
1170: 20 20 20 65 6e 63 2d 6d 6f 64 65 20 40 20 64 75 enc-mode @ du
1180: 70 20 75 6c 69 74 2c 20 76 61 75 6c 74 2d 63 72 p ulit, vault-cr
1190: 79 70 74 20 38 20 72 73 68 69 66 74 20 24 46 46 ypt 8 rshift $FF
11a0: 20 61 6e 64 20 3e 63 72 79 70 74 0a 20 20 20 20 and >crypt.
11b0: 5b 3a 20 5b 3a 20 64 72 6f 70 20 73 74 73 6b 63 [: [: drop stskc
11c0: 20 73 77 61 70 20 6b 65 79 67 65 6e 64 68 20 65 swap keygendh e
11d0: 64 2d 64 68 20 32 3e 72 0a 09 20 20 20 20 76 6b d-dh 2>r.. vk
11e0: 65 79 20 76 61 75 6c 74 6b 65 79 20 24 31 30 20 ey vaultkey $10
11f0: 2b 20 65 6e 63 2d 6d 6f 64 65 20 40 20 24 46 46 + enc-mode @ $FF
1200: 20 61 6e 64 20 24 32 30 20 2d 20 6d 6f 76 65 0a and $20 - move.
1210: 09 20 20 20 20 76 61 75 6c 74 6b 65 79 20 65 6e . vaultkey en
1220: 63 2d 6d 6f 64 65 20 40 20 24 46 46 20 61 6e 64 c-mode @ $FF and
1230: 20 32 72 3e 20 65 6e 63 72 79 70 74 24 0a 09 20 2r> encrypt$..
1240: 20 20 20 76 61 75 6c 74 6b 65 79 20 65 6e 63 2d vaultkey enc-
1250: 6d 6f 64 65 20 40 20 24 46 46 20 61 6e 64 20 66 mode @ $FF and f
1260: 6f 72 74 68 3a 74 79 70 65 20 3b 5d 20 24 5b 5d orth:type ;] $[]
1270: 6d 61 70 20 3b 5d 20 24 74 6d 70 0a 20 20 20 20 map ;] $tmp.
1280: 24 2c 20 76 61 75 6c 74 2d 6b 65 79 73 20 30 20 $, vault-keys 0
1290: 3e 63 72 79 70 74 20 3b 0a 3a 20 76 64 68 65 2d >crypt ;.: vdhe-
12a0: 6b 65 79 73 2c 20 28 20 6b 65 79 2d 6c 69 73 74 keys, ( key-list
12b0: 20 2d 2d 20 29 0a 20 20 20 20 76 2d 65 6e 63 24 -- ). v-enc$
12c0: 20 24 2c 20 76 61 75 6c 74 2d 64 68 65 2d 6b 65 $, vault-dhe-ke
12d0: 79 73 20 20 30 20 3e 63 72 79 70 74 20 3b 0a 3a ys 0 >crypt ;.:
12e0: 20 76 66 69 6c 65 2d 69 6e 20 28 20 2d 2d 20 29 vfile-in ( -- )
12f0: 0a 20 20 20 20 65 6e 63 2d 66 69 6c 65 6e 61 6d . enc-filenam
1300: 65 20 24 40 20 65 6e 63 2d 66 69 6c 65 20 24 73 e $@ enc-file $s
1310: 6c 75 72 70 2d 66 69 6c 65 20 3b 0a 3a 20 76 66 lurp-file ;.: vf
1320: 69 6c 65 2d 70 61 64 20 28 20 2d 2d 20 29 0a 20 ile-pad ( -- ).
1330: 20 20 20 65 6e 63 2d 66 69 6c 65 20 24 40 6c 65 enc-file $@le
1340: 6e 20 64 75 70 20 3e 72 20 76 61 75 6c 74 2d 61 n dup >r vault-a
1350: 6c 69 67 6e 65 64 20 65 6e 63 2d 66 69 6c 65 20 ligned enc-file
1360: 24 21 6c 65 6e 0a 20 20 20 20 65 6e 63 2d 66 69 $!len. enc-fi
1370: 6c 65 20 24 40 20 72 3e 20 2f 73 74 72 69 6e 67 le $@ r> /string
1380: 20 64 75 70 20 65 6e 63 2d 70 61 64 64 69 6e 67 dup enc-padding
1390: 20 21 20 65 72 61 73 65 20 3b 0a 3a 20 76 66 69 ! erase ;.: vfi
13a0: 6c 65 2d 65 6e 63 20 28 20 2d 2d 20 29 0a 20 20 le-enc ( -- ).
13b0: 20 20 76 6b 65 79 28 20 2e 22 20 76 6b 65 79 20 vkey( ." vkey
13c0: 66 69 6c 65 3a 20 22 20 76 6b 65 79 20 73 74 61 file: " vkey sta
13d0: 74 65 23 20 38 35 74 79 70 65 20 66 6f 72 74 68 te# 85type forth
13e0: 3a 63 72 20 29 0a 20 20 20 20 65 6e 63 3e 63 72 :cr ). enc>cr
13f0: 79 70 74 32 0a 20 20 20 20 6e 6f 2d 6b 65 79 20 ypt2. no-key
1400: 73 74 61 74 65 23 20 3e 63 72 79 70 74 2d 73 6f state# >crypt-so
1410: 75 72 63 65 0a 20 20 20 20 76 6b 65 79 20 73 74 urce. vkey st
1420: 61 74 65 23 20 3e 63 72 79 70 74 2d 6b 65 79 20 ate# >crypt-key
1430: 65 6e 63 2d 66 69 6c 65 20 24 40 20 63 3a 65 6e enc-file $@ c:en
1440: 63 72 79 70 74 20 63 3a 64 69 66 66 75 73 65 0a crypt c:diffuse.
1450: 20 20 20 20 65 6e 63 2d 66 69 6c 65 20 24 40 20 enc-file $@
1460: 24 2c 20 76 61 75 6c 74 2d 66 69 6c 65 20 30 20 $, vault-file 0
1470: 3e 63 72 79 70 74 20 65 6e 63 2d 66 69 6c 65 20 >crypt enc-file
1480: 24 66 72 65 65 20 3b 0a 3a 20 76 66 69 6c 65 2c $free ;.: vfile,
1490: 20 28 20 2d 2d 20 29 0a 20 20 20 20 76 66 69 6c ( -- ). vfil
14a0: 65 2d 70 61 64 20 76 66 69 6c 65 2d 65 6e 63 20 e-pad vfile-enc
14b0: 3b 0a 3a 20 76 73 69 67 2c 20 28 20 2d 2d 20 29 ;.: vsig, ( -- )
14c0: 0a 20 20 20 20 65 6e 63 3e 63 72 79 70 74 32 0a . enc>crypt2.
14d0: 20 20 20 20 5b 3a 20 24 31 30 20 73 70 61 63 65 [: $10 space
14e0: 73 20 6e 6f 77 3e 6e 65 76 65 72 20 65 6e 63 2d s now>never enc-
14f0: 70 61 64 64 69 6e 67 20 40 20 6e 3e 36 34 20 63 padding @ n>64 c
1500: 6d 64 74 6d 70 24 20 66 6f 72 74 68 3a 74 79 70 mdtmp$ forth:typ
1510: 65 0a 20 20 20 20 20 20 2e 70 6b 20 2e 73 69 67 e. .pk .sig
1520: 20 24 31 30 20 73 70 61 63 65 73 20 3b 5d 20 24 $10 spaces ;] $
1530: 74 6d 70 0a 20 20 20 20 30 20 3e 63 72 79 70 74 tmp. 0 >crypt
1540: 0a 20 20 20 20 76 6b 65 79 28 20 2e 22 20 76 6b . vkey( ." vk
1550: 65 79 20 73 69 67 3a 20 22 20 76 6b 65 79 20 73 ey sig: " vkey s
1560: 74 61 74 65 23 20 38 35 74 79 70 65 20 66 6f 72 tate# 85type for
1570: 74 68 3a 63 72 20 29 0a 20 20 20 20 32 64 75 70 th:cr ). 2dup
1580: 20 76 6b 65 79 20 73 74 61 74 65 23 20 65 6e 63 vkey state# enc
1590: 72 79 70 74 24 20 24 2c 20 76 61 75 6c 74 2d 73 rypt$ $, vault-s
15a0: 69 67 20 3b 0a 0a 3a 20 65 6e 63 66 69 6c 65 2d ig ;..: encfile-
15b0: 72 65 73 74 20 28 20 6b 65 79 2d 6c 69 73 74 20 rest ( key-list
15c0: 2d 2d 20 29 20 3e 76 61 75 6c 74 20 3e 72 0a 20 -- ) >vault >r.
15d0: 20 20 20 63 6f 64 65 2d 62 75 66 24 20 63 6d 64 code-buf$ cmd
15e0: 72 65 73 65 74 20 69 6e 69 74 2d 72 65 70 6c 79 reset init-reply
15f0: 0a 20 20 20 20 70 6b 40 20 6b 65 79 7c 20 72 40 . pk@ key| r@
1600: 20 24 2b 5b 5d 21 20 5c 20 65 6e 63 72 79 70 74 $+[]! \ encrypt
1610: 20 66 6f 72 20 6f 75 72 73 65 6c 66 0a 20 20 20 for ourself.
1620: 20 22 76 32 6f 22 20 34 63 63 2c 0a 20 20 20 20 "v2o" 4cc,.
1630: 6e 65 77 76 61 75 6c 74 28 20 72 3e 20 76 64 68 newvault( r> vdh
1640: 65 2d 6b 65 79 73 2c 20 29 65 6c 73 65 28 20 76 e-keys, )else( v
1650: 64 68 65 2c 20 72 3e 20 76 6b 65 79 73 2c 20 29 dhe, r> vkeys, )
1660: 0a 20 20 20 20 76 66 69 6c 65 2c 20 76 73 69 67 . vfile, vsig
1670: 2c 0a 20 20 20 20 73 22 20 2e 76 32 6f 22 20 65 ,. s" .v2o" e
1680: 6e 63 2d 66 69 6c 65 6e 61 6d 65 20 24 2b 21 0a nc-filename $+!.
1690: 20 20 20 20 65 6e 63 2d 66 69 6c 65 6e 61 6d 65 enc-filename
16a0: 20 24 40 20 5b 3a 20 3e 72 20 63 6d 64 24 20 24 $@ [: >r cmd$ $
16b0: 40 20 72 3e 20 77 72 69 74 65 2d 66 69 6c 65 20 @ r> write-file
16c0: 74 68 72 6f 77 20 3b 5d 20 6e 65 77 2d 66 69 6c throw ;] new-fil
16d0: 65 0a 20 20 20 20 63 6f 64 65 30 2d 62 75 66 20 e. code0-buf
16e0: 64 69 73 70 6f 73 65 20 6e 3a 6f 3e 20 3b 0a 0a dispose n:o> ;..
16f0: 3a 20 65 6e 63 72 79 70 74 2d 66 69 6c 65 20 28 : encrypt-file (
1700: 20 66 69 6c 65 6e 61 6d 65 20 75 20 6b 65 79 2d filename u key-
1710: 6c 69 73 74 20 2d 2d 20 29 0a 20 20 20 20 3e 72 list -- ). >r
1720: 20 65 6e 63 2d 66 69 6c 65 6e 61 6d 65 20 24 21 enc-filename $!
1730: 20 76 66 69 6c 65 2d 69 6e 20 72 3e 20 65 6e 63 vfile-in r> enc
1740: 66 69 6c 65 2d 72 65 73 74 20 3b 0a 0a 3a 20 3f file-rest ;..: ?
1750: 65 6e 63 2d 66 64 20 28 20 2d 2d 20 66 64 20 29 enc-fd ( -- fd )
1760: 0a 20 20 20 20 65 6e 63 2d 66 64 20 40 20 64 75 . enc-fd @ du
1770: 70 20 3f 45 58 49 54 20 20 64 72 6f 70 0a 20 20 p ?EXIT drop.
1780: 20 20 65 6e 63 2d 66 69 6c 65 6e 61 6d 65 20 24 enc-filename $
1790: 40 20 32 64 75 70 20 64 75 70 20 34 20 2d 20 30 @ 2dup dup 4 - 0
17a0: 20 6d 61 78 20 73 61 66 65 2f 73 74 72 69 6e 67 max safe/string
17b0: 20 73 22 20 2e 76 32 6f 22 20 73 74 72 3d 0a 20 s" .v2o" str=.
17c0: 20 20 20 49 46 20 20 34 20 2d 20 20 54 48 45 4e IF 4 - THEN
17d0: 0a 20 20 20 20 77 2f 6f 20 63 72 65 61 74 65 2d . w/o create-
17e0: 66 69 6c 65 20 74 68 72 6f 77 20 20 64 75 70 20 file throw dup
17f0: 65 6e 63 2d 66 64 20 21 20 3b 0a 0a 3a 20 77 72 enc-fd ! ;..: wr
1800: 69 74 65 2d 31 66 69 6c 65 20 28 20 61 64 64 72 ite-1file ( addr
1810: 20 75 20 2d 2d 20 29 20 3f 65 6e 63 2d 66 64 20 u -- ) ?enc-fd
1820: 77 72 69 74 65 2d 66 69 6c 65 20 74 68 72 6f 77 write-file throw
1830: 20 3b 0a 3a 20 76 61 75 6c 74 3e 66 69 6c 65 20 ;.: vault>file
1840: 5b 27 5d 20 77 72 69 74 65 2d 31 66 69 6c 65 20 ['] write-1file
1850: 69 73 20 77 72 69 74 65 2d 64 65 63 72 79 70 74 is write-decrypt
1860: 20 3b 0a 76 61 75 6c 74 3e 66 69 6c 65 0a 3a 20 ;.vault>file.:
1870: 76 61 75 6c 74 3e 6f 75 74 20 5b 27 5d 20 66 6f vault>out ['] fo
1880: 72 74 68 3a 74 79 70 65 20 69 73 20 77 72 69 74 rth:type is writ
1890: 65 2d 64 65 63 72 79 70 74 20 3b 0a 0a 3a 20 3e e-decrypt ;..: >
18a0: 64 65 63 72 79 70 74 20 28 20 2d 2d 20 61 64 64 decrypt ( -- add
18b0: 72 20 75 20 66 6c 61 67 20 29 0a 20 20 20 20 65 r u flag ). e
18c0: 6e 63 2d 66 69 6c 65 6e 61 6d 65 20 24 21 0a 20 nc-filename $!.
18d0: 20 20 20 65 6e 63 2d 66 69 6c 65 6e 61 6d 65 20 enc-filename
18e0: 24 40 20 65 6e 63 2d 66 69 6c 65 20 24 73 6c 75 $@ enc-file $slu
18f0: 72 70 2d 66 69 6c 65 0a 20 20 20 20 65 6e 63 2d rp-file. enc-
1900: 66 69 6c 65 20 24 40 20 3e 76 61 75 6c 74 20 5b file $@ >vault [
1910: 27 5d 20 64 6f 2d 63 6d 64 2d 6c 6f 6f 70 20 63 '] do-cmd-loop c
1920: 61 74 63 68 20 30 20 3e 63 72 79 70 74 20 74 68 atch 0 >crypt th
1930: 72 6f 77 0a 20 20 20 20 63 2d 73 74 61 74 65 20 row. c-state
1940: 40 20 24 46 20 3d 20 3b 0a 0a 3a 20 64 65 63 72 @ $F = ;..: decr
1950: 79 70 74 40 20 28 20 66 69 6c 65 6e 61 6d 65 20 ypt@ ( filename
1960: 75 20 2d 2d 20 61 64 64 72 20 75 20 29 20 6c 61 u -- addr u ) la
1970: 73 74 23 20 3e 72 20 3e 64 65 63 72 79 70 74 0a st# >r >decrypt.
1980: 20 20 20 20 49 46 0a 09 6d 73 67 28 20 76 2d 73 IF..msg( v-s
1990: 69 67 20 32 40 20 32 64 75 70 20 2e 73 69 67 64 ig 2@ 2dup .sigd
19a0: 61 74 65 73 20 73 70 61 63 65 20 2e 6b 65 79 2d ates space .key-
19b0: 69 64 20 66 6f 72 74 68 3a 63 72 20 29 0a 09 76 id forth:cr )..v
19c0: 2d 64 61 74 61 20 32 40 0a 20 20 20 20 45 4c 53 -data 2@. ELS
19d0: 45 0a 09 23 30 2e 0a 20 20 20 20 54 48 45 4e 20 E..#0.. THEN
19e0: 64 69 73 70 6f 73 65 20 6e 3a 6f 3e 20 72 3e 20 dispose n:o> r>
19f0: 74 6f 20 6c 61 73 74 23 20 3b 0a 0a 3a 20 64 65 to last# ;..: de
1a00: 63 72 79 70 74 2d 66 69 6c 65 20 28 20 66 69 6c crypt-file ( fil
1a10: 65 6e 61 6d 65 20 75 20 2d 2d 20 29 0a 20 20 20 ename u -- ).
1a20: 20 64 65 63 72 79 70 74 40 20 77 72 69 74 65 2d decrypt@ write-
1a30: 64 65 63 72 79 70 74 20 65 6e 63 2d 66 69 6c 65 decrypt enc-file
1a40: 20 24 66 72 65 65 0a 20 20 20 20 65 6e 63 2d 66 $free. enc-f
1a50: 64 20 40 20 3f 64 75 70 2d 49 46 20 20 66 6f 72 d @ ?dup-IF for
1a60: 74 68 3a 63 6c 6f 73 65 2d 66 69 6c 65 20 74 68 th:close-file th
1a70: 72 6f 77 20 20 54 48 45 4e 20 3b 0a 70 72 65 76 row THEN ;.prev
1a80: 69 6f 75 73 0a 0a 5c 5c 5c 0a 4c 6f 63 61 6c 20 ious..\\\.Local
1a90: 56 61 72 69 61 62 6c 65 73 3a 0a 66 6f 72 74 68 Variables:.forth
1aa0: 2d 6c 6f 63 61 6c 2d 77 6f 72 64 73 3a 0a 20 20 -local-words:.
1ab0: 20 20 28 0a 20 20 20 20 20 28 28 22 6e 65 74 32 (. (("net2
1ac0: 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20 64 o:" "+net2o:") d
1ad0: 65 66 69 6e 69 74 69 6f 6e 2d 73 74 61 72 74 65 efinition-starte
1ae0: 72 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 6b 65 79 r (font-lock-key
1af0: 77 6f 72 64 2d 66 61 63 65 20 2e 20 31 29 0a 20 word-face . 1).
1b00: 20 20 20 20 20 22 5b 20 5c 74 5c 6e 5d 22 20 74 "[ \t\n]" t
1b10: 20 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b name (font-lock
1b20: 2d 66 75 6e 63 74 69 6f 6e 2d 6e 61 6d 65 2d 66 -function-name-f
1b30: 61 63 65 20 2e 20 33 29 29 0a 20 20 20 20 20 28 ace . 3)). (
1b40: 22 5b 61 2d 7a 5c 2d 30 2d 39 5d 2b 28 22 20 69 "[a-z\-0-9]+(" i
1b50: 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e 74 2d 6c mmediate (font-l
1b60: 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 65 ock-comment-face
1b70: 20 2e 20 31 29 0a 20 20 20 20 20 20 22 29 22 20 . 1). ")"
1b80: 6e 69 6c 20 63 6f 6d 6d 65 6e 74 20 28 66 6f 6e nil comment (fon
1b90: 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d 66 t-lock-comment-f
1ba0: 61 63 65 20 2e 20 31 29 29 0a 20 20 20 20 29 0a ace . 1)). ).
1bb0: 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 69 6e 64 65 forth-local-inde
1bc0: 6e 74 2d 77 6f 72 64 73 3a 0a 20 20 20 20 28 0a nt-words:. (.
1bd0: 20 20 20 20 20 28 28 22 6e 65 74 32 6f 3a 22 20 (("net2o:"
1be0: 22 2b 6e 65 74 32 6f 3a 22 29 20 28 30 20 2e 20 "+net2o:") (0 .
1bf0: 32 29 20 28 30 20 2e 20 32 29 20 6e 6f 6e 2d 69 2) (0 . 2) non-i
1c00: 6d 6d 65 64 69 61 74 65 29 0a 20 20 20 20 29 0a mmediate). ).
1c10: 45 6e 64 3a 0a End:.