\ encrypted files 10feb2015py
\ Copyright (C) 2015 Bernd Paysan
\ This program is free software: you can redistribute it and/or modify
\ it under the terms of the GNU Affero General Public License as published by
\ the Free Software Foundation, either version 3 of the License, or
\ (at your option) any later version.
\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
\ GNU Affero General Public License for more details.
\ You should have received a copy of the GNU Affero General Public License
\ along with this program. If not, see <http://www.gnu.org/licenses/>.
require net2o.fs
cmd-class class
KEYBYTES +field v-dhe \ diffie hellman exchange tmpkey
state# +field v-key \ file vault key, maximum 64 bytes
keccak# +field v-kstate
2field: v-data
2field: v-sig
value: v-mode \ crypto mode and key size
value: v/blk2 \ block size power of two
end-class vault-class
Defer write-decrypt
Defer read-encrypt
: >vault ( -- o:vault ) \ push a vault object
vault-class new n:>o vault-table @ token-table !
my-key-default to my-key ;
: v-mode>crypt2 ( -- )
v-mode $10 rshift $FF and >crypt ;
vault-table >table
scope{ net2o-base
cmd-table $@ inherit-table vault-table
\g
\g ### vault commands ###
\g
net2o' emit net2o: dhe ( $:pubkey -- ) c-state @ !!inv-order!!
\g start diffie hellman exchange
$> ?keysize sk@ drop swap v-dhe ed-dh 2drop
v-key state# erase 1 c-state or! ;
+net2o: vault-keys ( $:keys -- ) c-state @ 1 <> !!no-tmpkey!!
\g vault keys can be opened with the dhe secret; each key is IV+session key+checksum
v-mode dup $FF and state# umax { vk# } 8 rshift $FF and >crypt
$> bounds ?DO
I' I - vk# u>= IF
I vaultkey vk# move
vaultkey vk# v-dhe keysize decrypt$ IF
dup state# 1+ keysize within !!keysize!!
v-key state# move-rep
vkey( ." vkey keyx: " v-key state# 85type forth:cr )
2 c-state or! LEAVE
ELSE 2drop THEN
THEN
vk# +LOOP 0 >crypt ;
+net2o: vault-file ( $:content -- ) c-state @ 3 <> !!no-tmpkey!!
\g this is the actual content of the vault
\g if blockwise, there may be multiple parts
v-mode>crypt2
no-key state# >crypt-source v-key state# >crypt-key
vkey( ." vkey filex: " v-key state# 85type forth:cr )
$> 2dup c:decrypt v-data 2!
c:diffuse \ one extra diffusion round
0 >crypt 4 c-state or! ; \ keep for signature
+net2o: vault-sig ( $:sig -- ) c-state @ 7 <> !!no-data!!
\g the signature of the vault, using the keyed hash over the file
vkey( ." vkey sigx: " v-key state# 85type forth:cr )
c:key@ v-kstate c:key# move
$> v-key state# decrypt$ 0= !!no-decrypt!!
v-mode>crypt2
v-kstate c:key@ c:key# move
verify-tag !!sig!!
2dup dup sigpksize# - /string v-sig 2!
sigpksize# - IF p@+ drop 64>n negate v-data +! ELSE drop THEN
0 >crypt 8 c-state or! ;
+net2o: vault-crypt ( n -- ) \g set encryption mode and key wrap size
c-state @ 1 u> !!inv-order!! 64>n to v-mode ;
+net2o: vault-auth ( $:auth -- )
\g block authentication, 64 byte block
c-state @ 7 <> !!no-data!!
\ otherwise would expose some data
$> v-kstate c:key> v-kstate $40 str= 0= !!vault-auth!!
write-decrypt \ write a chunk out
4 c-state xor! ; \ step back to allow fault-file
vault-table $save
' context-table is gen-table
also }scope
$80 Constant min-align#
$400 Constant pow-align#
: vault-aligned ( len -- len' )
\G Align vault to minimum granularity plus relative alignment
\G to hide the actual file-size
1- 0 >r BEGIN dup pow-align# u> WHILE 2/ r> 1+ >r REPEAT
1+ r> lshift min-align# 1- + min-align# negate and ;
Variable enc-mode
: enc-keccak ( -- ) $60 enc-mode ! ; \ wrap with keccak
: enc-threefish ( -- ) $010160 enc-mode ! ; \ wrap with threefish
: enc>crypt2 ( -- )
enc-mode @ $10 rshift $FF and >crypt ;
enc-keccak
: pk-off ( -- ) key-list $[]off ;
: vdhe, ( -- ) vsk vpk ed-keypair vpk keysize $, dhe ;
: vkeys, ( key-list -- )
vaultkey $100 erase
enc-mode @ $FF and $20 - rng$ vkey state# move-rep
vkey( ." vkey key: " vkey state# 85type forth:cr )
enc-mode @ dup ulit, vault-crypt 8 rshift $FF and >crypt
[: [: drop vsk swap keygendh ed-dh 2>r
vkey vaultkey $10 + enc-mode @ $FF and $20 - move
vaultkey enc-mode @ $FF and 2r> encrypt$
vaultkey enc-mode @ $FF and forth:type ;] $[]map ;] $tmp
$, vault-keys 0 >crypt ;
: vfile-in ( -- )
enc-filename $@ enc-file $slurp-file ;
: vfile-pad ( -- )
enc-file $@len dup >r vault-aligned enc-file $!len
enc-file $@ r> /string dup enc-padding ! erase ;
: vfile-enc ( -- )
vkey( ." vkey file: " vkey state# 85type forth:cr )
enc>crypt2
no-key state# >crypt-source
vkey state# >crypt-key enc-file $@ c:encrypt c:diffuse
enc-file $@ $, vault-file 0 >crypt enc-file $free ;
: vfile, ( -- )
vfile-pad vfile-enc ;
: vsig, ( -- )
enc>crypt2
[: $10 spaces now>never enc-padding @ n>64 cmdtmp$ forth:type
.pk .sig $10 spaces ;] $tmp
0 >crypt
vkey( ." vkey sig: " vkey state# 85type forth:cr )
2dup vkey state# encrypt$ $, vault-sig ;
: encfile-rest ( key-list -- ) >vault >r
code-buf$ cmdreset init-reply
pk@ key| r@ $+[]! \ encrypt for ourself
"v2o" 4cc, vdhe, r> vkeys, vfile, vsig,
s" .v2o" enc-filename $+!
enc-filename $@ [: >r cmd$ $@ r> write-file throw ;] new-file
code0-buf dispose n:o> ;
: encrypt-file ( filename u key-list -- )
>r enc-filename $! vfile-in r> encfile-rest ;
: ?enc-fd ( -- fd )
enc-fd @ dup ?EXIT drop
enc-filename $@ 2dup dup 4 - 0 max safe/string s" .v2o" str=
IF 4 - THEN
w/o create-file throw dup enc-fd ! ;
: write-1file ( addr u -- ) ?enc-fd write-file throw ;
: vault>file ['] write-1file is write-decrypt ;
vault>file
: vault>out ['] forth:type is write-decrypt ;
: >decrypt ( -- addr u flag )
enc-filename $!
enc-filename $@ enc-file $slurp-file
enc-file $@ >vault ['] do-cmd-loop catch 0 >crypt throw
c-state @ $F = ;
: decrypt@ ( filename u -- addr u ) last# >r >decrypt
IF
msg( v-sig 2@ 2dup .sigdates space .key-id forth:cr )
v-data 2@
ELSE
#0.
THEN dispose n:o> r> to last# ;
: decrypt-file ( filename u -- )
decrypt@ write-decrypt enc-file $free
enc-fd @ ?dup-IF forth:close-file throw THEN ;
previous
\\\
Local Variables:
forth-local-words:
(
(("net2o:" "+net2o:") definition-starter (font-lock-keyword-face . 1)
"[ \t\n]" t name (font-lock-function-name-face . 3))
("[a-z\-0-9]+(" immediate (font-lock-comment-face . 1)
")" nil comment (font-lock-comment-face . 1))
)
forth-local-indent-words:
(
(("net2o:" "+net2o:") (0 . 2) (0 . 2) non-immediate)
)
End: