You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1459 lines
68 KiB
1459 lines
68 KiB
#JMN 2021 |
|
#public domain |
|
|
|
|
|
#--------------------------------------------------------- |
|
#todo - see if we can include twofish https://wiki.tcl-lang.org/page/Twofish+in+Tcl |
|
# - that twofish implementation relies on Itcl. todo - create .tm package for it. (change oo system?) |
|
#--------------------------------------------------------- |
|
# |
|
# encryption decryption howto |
|
|
|
# patternciper::>AES .. Create >obj |
|
# set [>obj . cipherkey .] $16bytes |
|
# >obj . encrypt $arbitray_data_of_any_length |
|
# (returns number of bytes stored) |
|
# <repeat as many times as necessary> |
|
# >obj . encrypt $any_size_string -last 1 |
|
# (the -last flag will make the encryption system pad the last chunk) |
|
# >obj . ciphertext .. As my_encrypted_data_variable |
|
# set checkplaintext [>obj . decrypt] |
|
# (this can be used to verify decryption and resets the cbc encryption ready for another round) |
|
# |
|
# |
|
|
|
|
|
package provide patterncipher [namespace eval patterncipher { |
|
variable version |
|
set version 0.1.1 |
|
}] |
|
|
|
|
|
|
|
#Change History |
|
#------------------------------------------------------------------------------- |
|
# 2021 - start out with blowfish as although it's outdated, it's easily available in tcllib. Todo - add twofish, AES |
|
#------------------------------------------------------------------------------- |
|
|
|
package require ascii85 ;#tcllib |
|
package require pattern |
|
::pattern::init ;# initialises (if not already) |
|
|
|
namespace eval ::patterncipher { |
|
namespace eval algo::txt { |
|
set tokenid 0 |
|
set tokendata [dict create] |
|
set data_block_bytes 0 ;#means don't care |
|
set iv_bytes 16 |
|
set key_byte_sizes [list 8 16] |
|
|
|
|
|
proc Init {mode keydata iv} { |
|
variable tokenid |
|
variable tokendata |
|
if {[string length $iv] != 16} { |
|
error "[namespace::current] Init IV must be 16 bytes long" |
|
} |
|
|
|
dict set tokendata $tokenid [list mode $mode key $keydata iv $iv lastblock "" ] |
|
return [lindex [list [namespace current]::$tokenid [incr tokenid]] 0] ;#post increment via inline K combinator |
|
} |
|
proc Encrypt {token data} { |
|
variable tokendata |
|
variable data_block_bytes |
|
set tokenid [namespace tail $token] |
|
if {![dict exists $tokendata $tokenid]} { |
|
error "([namespace current]::Encrypt) invalid tokenid $tokenid token:$token" |
|
} |
|
if {$data_block_bytes != 0} { |
|
if {([string length $data] % $data_block_bytes) != 0} { |
|
error "([namespace current]::Encrypt) invalid block size for data. Must be $data_block_bytes bytes." |
|
} |
|
set idx [expr {$data_block_bytes - 1}] |
|
dict set tokendata $tokenid lastblock [string range $data end-$idx end] |
|
} |
|
set client_mode [dict get $tokendata $tokenid mode] |
|
set iv_as_mode [string trim [dict get $tokendata $tokenid iv] _] |
|
|
|
|
|
|
|
if {$iv_as_mode ne $client_mode} { |
|
set enc [encoding convertto $iv_as_mode [encoding convertfrom $client_mode $data]] |
|
} else { |
|
set enc [encoding convertfrom $client_mode $data] |
|
} |
|
|
|
return $enc |
|
} |
|
proc Decrypt {token data} { |
|
variable tokendata |
|
set tokenid [namespace tail $token] |
|
if {![dict exists $tokendata $tokenid]} { |
|
error "([namespace current]::Decrypt) invalid tokenid $tokenid token:$token" |
|
} |
|
set client_mode [dict get $tokendata $tokenid mode] |
|
set iv_mode [string trim [dict get $tokendata $tokenid iv] _] |
|
|
|
if {$iv_mode ne $client_mode} { |
|
set dec [encoding convertfrom $iv_mode $data] |
|
} else { |
|
set dec $data |
|
} |
|
set dec [encoding convertto $client_mode $dec] |
|
|
|
return $dec |
|
} |
|
proc Reset {token iv} { |
|
variable tokendata |
|
set tokenid [namespace tail $token] |
|
if {![dict exists $tokendata $tokenid]} { |
|
error "([namespace current]::Reset) invalid tokenid $tokenid token:$token" |
|
} |
|
dict set tokendata $tokenid lastblock "" |
|
|
|
} |
|
proc Final {token} { |
|
variable tokendata |
|
set tokenid [namespace tail $token] |
|
if {![dict exists $tokendata $tokenid]} { |
|
error "([namespace current]::Final) invalid tokenid $tokenid token:$token" |
|
} |
|
dict unset tokendata $tokenid |
|
} |
|
} |
|
|
|
} |
|
|
|
namespace eval ::patterncipher { |
|
#namespace export {[a-z]*} |
|
#namespace export {[>]*} |
|
proc help {} { |
|
set cipherlib ::patterncipher::libs::>lib_standard |
|
set definitions [$cipherlib . cipher_definitions] |
|
set m "" |
|
append m "\n" |
|
append m "Create cipher-specific objects with name of your choosing for encryption and decryption:\n" |
|
|
|
foreach cn [$cipherlib . ciphernames] { |
|
append m "patterncipher::>$cn .. Create >my-[dict get $definitions $cn cipherid]-encryptor\n" |
|
} |
|
|
|
append m "\n" |
|
append m "--------------------------------------------------------------------------------------------------\n" |
|
append m "Get cipher specific help e.g patterncipher::>blowfish, patterncipher::>AES etc :\n" |
|
append m "patterncipher::>AES . help ;#patterncipher::>AES is the prototype from which we create objects.\n" |
|
append m " ;# The prototype itself has a help method which is not inherited by objects created from it\n" |
|
} |
|
|
|
|
|
|
|
namespace eval libs {} ;#namespace for >lib instances |
|
|
|
|
|
patternlib::>collection .. Create >libs |
|
|
|
>pattern .. Create >lib |
|
>lib .. Method help {} { |
|
set help { |
|
To create a custom library: |
|
::patterncipher::>lib .. Create ::patterncipher::libs::>my-lib -name "mylib" .. As mylib |
|
or |
|
set mylib [::patterncipher::>lib .. Create ::patterncipher::libs::>my-lib -name "mylib"] |
|
|
|
The object will automatically be added to the collection ::patterncipher::>libs |
|
The latest element added to this collection will be the one used by new cipher instances. |
|
To create a cipher using a specific >lib instance, use -patterncipherlib when constructing instances |
|
|
|
} |
|
return $help |
|
} |
|
|
|
>lib .. PatternProperty name |
|
>lib .. PatternPropertyWrite name {newname} { |
|
var o_name |
|
if {$o_name eq "standard"} { |
|
#!todo - allow -force option in case caller knows what they're doing? |
|
error "(>lib-instance . name (write)) ERROR: cannot rename 'standard' library." |
|
} |
|
::patterncipher::>libs . reKey $o_name $newname |
|
set o_name $newname |
|
} |
|
|
|
>lib .. Constructor {args} { |
|
var this o_name o_padding_schemes o_bucketsize_by_hex1 o_ascii85_wraplen |
|
var o_frame_boundaries o_hex1_by_bucketsize o_bucketsize_by_hex4 o_hex4_by_bucketsize |
|
var o_cipher_definitions o_cipherids |
|
set this @this@ |
|
#---------------------------------------------------------------------------- |
|
set known_opts [list -name] |
|
dict set default -name "" |
|
if {([llength $args] % 2) != 0} { |
|
error "(>lib-instance .. Constructor) ERROR: uneven options supplied - must be of form '-option value' " |
|
} |
|
foreach {k v} $args { |
|
if {$k ni $known_opts} { |
|
error "((>lib-instance .. Constructor) ERROR: option '$k' not in known options: '$known_opts'" |
|
} |
|
} |
|
set opts [dict merge $default $args] |
|
set o_name [dict get $opts -name] |
|
#---------------------------------------------------------------------------- |
|
if {![string length $o_name]} { |
|
error "((>lib-instance .. Constructor) ERROR: -name value is required." |
|
} |
|
|
|
if {[::patterncipher::>libs . hasKey $o_name]} { |
|
error "((>lib-instance .. Constructor) ERROR: -name value is already in the ::patterncipher::>libs collection - choose another name." |
|
} |
|
|
|
::patterncipher::>libs . add ::patterncipher::libs::>lib_standard $o_name ;# now avail as '::patterncipher::>libs $o_name' |
|
|
|
#Once the standard lib is in the collection, overlay a >keayvalprotector on >libs to stop the standard lib being removed too easily |
|
if {$o_name eq "standard"} { |
|
::patternlib::>keyvalprotector .. Create ::patterncipher::>libs -keys [list standard] -vals [list $this] |
|
} |
|
|
|
#----------------------------------------------------------------------------------------------------- |
|
#set up stream chunk boundaries |
|
#64 bytes selected as the smallest chunk size. Obfuscates lengths for small pieces of data - plus 5Byte header overhead not too bad. |
|
## starting data - redistributed |
|
##set block1 [list 512 512 512 512 512 512 512 512] |
|
##set block2 [list 1024 1024 1024 1024] |
|
##set block3 [list 2048 2048] |
|
set block1 [list 64 192 320 448 576 704 832 960 ] ; #128 spacing |
|
set block2 [list 976 1008 1040 1072] ;# 32 spacing |
|
set block3 [list 1984 2112] ;#128 spacing |
|
set block4 [list 4096] |
|
# 4096 4096 4096 ... repeated until final chunk detected. |
|
#This gives 15 values. Hex 1 to F, leaving 0 for the final arbitrary length rest-of-stream. |
|
# ie 64 = 1 192 = 2 ... 1040 = B 4096 = F |
|
|
|
#If the blocks above are played with - streaming incompatibilities/inefficiences will occur with previous/other versions of patterncipher. |
|
set code_check 1 |
|
if $code_check { |
|
set o_frame_boundaries [concat $block1 $block2 $block3 $block4] |
|
foreach l [list $block1 $block2 $block3 ] { |
|
if {[expr [join $l +]] != 4096} { |
|
error "frame_boundaries list is not configured as a 4096 multiple" |
|
} |
|
} |
|
if {![expr [join $o_frame_boundaries +]] == 16384} { |
|
#This boundary sequence that should be a multiple of 4K. |
|
error "frame_boundaries list is not configured as a 4096 multiple" |
|
} |
|
foreach len $o_frame_boundaries { |
|
if {($len % 8) != 0} { |
|
error "stream boundary '$len' is not a multiple of 8 bytes" |
|
} |
|
} |
|
} |
|
#set up bucketids |
|
set bucket_hex4 [list] |
|
foreach len $o_frame_boundaries { |
|
lappend bucket_hex4 [format %04x $len] ;# e.g 192 = 00c0 4096 = 1000 |
|
} |
|
|
|
set o_bucketsize_by_hex1 [concat {*}[lmap c {1 2 3 4 5 6 7 8 9 A B C D E F} s $o_frame_boundaries {list $c $s}]] ;#dict |
|
set o_bucketsize_by_hex4 [concat {*}[lmap h $bucket_hex4 s $o_frame_boundaries {list $h $s}]] ;#dict |
|
|
|
set o_hex1_by_bucketsize [concat {*}[lmap s $o_frame_boundaries c {1 2 3 4 5 6 7 8 9 A B C D E F} {list $s $c}]] ;#dict |
|
set o_hex4_by_bucketsize [concat {*}[lmap s $o_frame_boundaries h $bucket_hex4 {list $s $h}]] ;#dict |
|
|
|
|
|
set o_padding_schemes [list 0 text-minpad 1 text-buckets 2 binary-minpad 3 binary-buckets] |
|
#whichever padding_scheme is used, the frame_boundaries will still be used to determine where to split the data |
|
set o_ascii85_wraplen 120 |
|
|
|
|
|
#------------------ |
|
#For cipherid "TXT" |
|
#pull out desired default encoding and put it at the front of the list |
|
set encnames [encoding names] |
|
set default "utf-8" ;#must be one that's in the list |
|
set idx [lsearch $encnames $default] |
|
set encnames [lreplace $encnames $idx $idx] |
|
set encnames [concat $default $encnames] |
|
#------------------ |
|
|
|
#---------------------------------------------------- |
|
#iv_static should only be 1 for testing, or for specific definitions such as 'TXT' which use IV to carry the text encoding hint. |
|
# |
|
#notes: |
|
#- always list the default mode first in modes |
|
#- iv_method is a method with arguments of the patterncipher library. |
|
# New methods can be grafted onto the lib as necessary. |
|
# The argument %ivb will be substituted with iv_bytes value |
|
# The argument %cn will be substituted with the key used in o_cipher_definitions |
|
# (this could then be used in a method to retrieve any of the other defined values) |
|
# The iv_method must be able to handle -userdata <value> user-supplied IV data (or empty string if none). |
|
# Can be verified/ignored etc. |
|
#- cipherid must be 3 bytes long and is used in the default header building mechanism |
|
# !todo - add a member such as 'hdr_method' to allow the lib to define a totally different header system. |
|
#- pkgrequire & algocommand together define the underlying encryption library command. |
|
# This must provide the API as used by various tcllib encryption functions such as AES & blowfish |
|
# A custom algocommand e.g some commands placed in '::patterncipher::algo::<something>' may be able to wrap other |
|
# libraries/functionalities if the semantics are not too dissimilar. |
|
# The API used by the tcllib encryption functions has commands: Init,Encrypt,Decrypt,Reset,Final. |
|
# |
|
set o_cipher_definitions [dict create] |
|
dict set o_cipher_definitions "text" [list \ |
|
enabled 1\ |
|
cipherid "TXT" \ |
|
pkgrequire patterncipher\ |
|
algocommand ::patterncipher::algo::txt\ |
|
data_block_bytes 0\ |
|
iv_bytes 16\ |
|
iv_static 1\ |
|
iv_method [list get_iv_for_ciphername %cn]\ |
|
key_byte_sizes [list 8]\ |
|
modes $encnames\ |
|
] |
|
|
|
dict set o_cipher_definitions "blowfish" [list \ |
|
enabled 1\ |
|
cipherid "BFS" \ |
|
pkgrequire blowfish\ |
|
algocommand ::blowfish\ |
|
data_block_bytes 8\ |
|
iv_bytes 8\ |
|
iv_static 0\ |
|
iv_method [list get_random_bytes %ivb -method basic ]\ |
|
key_byte_sizes [list 8]\ |
|
modes [list cbc ecb]\ |
|
] |
|
|
|
dict set o_cipher_definitions "AES" [list \ |
|
enabled 1\ |
|
cipherid "AES"\ |
|
pkgrequire aes\ |
|
algocommand ::aes\ |
|
data_block_bytes 16\ |
|
iv_bytes 16\ |
|
iv_static 0\ |
|
iv_method [list get_random_bytes %ivb -method basic]\ |
|
key_byte_sizes [list 16 24 32]\ |
|
modes [list cbc ecb]\ |
|
] |
|
dict set o_cipher_definitions "AES-128" [list \ |
|
enabled 1\ |
|
cipherid "A16"\ |
|
pkgrequire aes\ |
|
algocommand ::aes\ |
|
data_block_bytes 16\ |
|
iv_bytes 16\ |
|
iv_static 0\ |
|
iv_method [list get_random_bytes %ivb -method basic]\ |
|
key_byte_sizes [list 16]\ |
|
modes [list cbc ecb]\ |
|
] |
|
dict set o_cipher_definitions "AES-192" [list \ |
|
enabled 1\ |
|
cipherid "A24"\ |
|
pkgrequire aes\ |
|
algocommand ::aes\ |
|
data_block_bytes 16\ |
|
iv_bytes 16\ |
|
iv_static 0\ |
|
iv_method [list get_random_bytes %ivb -method basic]\ |
|
key_byte_sizes [list 24]\ |
|
modes [list cbc ecb]\ |
|
] |
|
dict set o_cipher_definitions "AES-256" [list \ |
|
enabled 1\ |
|
cipherid "A32"\ |
|
pkgrequire aes\ |
|
algocommand ::aes\ |
|
data_block_bytes 16\ |
|
iv_bytes 16\ |
|
iv_static 0\ |
|
iv_method [list get_random_bytes %ivb -method basic]\ |
|
key_byte_sizes [list 32]\ |
|
modes [list cbc ecb]\ |
|
] |
|
dict set o_cipher_definitions "DES" [list \ |
|
enabled 1\ |
|
cipherid "DES"\ |
|
pkgrequire des\ |
|
algocommand ::DES\ |
|
data_block_bytes 8\ |
|
iv_bytes 8\ |
|
iv_static 0\ |
|
iv_method [list get_random_bytes %ivb -method basic]\ |
|
key_byte_sizes [list 8 32]\ |
|
modes [list cbc ecb cfb ofb]\ |
|
] |
|
|
|
$this . rebuild_cipher_ids_and_names |
|
|
|
puts stdout "padding_buckets hex1code: $o_bucketsize_by_hex1" |
|
puts stdout "padding_buckets hex4code: $o_bucketsize_by_hex4" |
|
#----------------------------------------------------------------------------------------------------- |
|
} |
|
|
|
>lib .. PatternMethod cipher_disable {ciphername} { |
|
var this o_cipher_definitions |
|
if {$ciphername ni [dict keys $o_cipher_definitions]} { |
|
error "(>lib . cipher_disable) ciphername $ciphername not in list of defined ciphers: [dict keys $o_cipher_definitions]" |
|
} |
|
dict set o_cipher_definitions $ciphername enabled 0 |
|
$this . rebuild_cipher_ids_and_names |
|
return 1 |
|
} |
|
|
|
>lib .. PatternMethod cipher_enable {ciphername} { |
|
var o_cipher_definitions |
|
if {$ciphername ni [dict keys $o_cipher_definitions]} { |
|
error "(>lib . cipher_enable) ciphername $ciphername not in list of defined ciphers: [dict keys $o_cipher_definitions]" |
|
} |
|
dict set o_cipher_definitions $ciphername enabled 1 |
|
$this . rebuild_cipher_ids_and_names |
|
return 1 |
|
} |
|
>lib .. PatternMethod rebuild_cipher_ids_and_names {} { |
|
var o_cipherids o_ciphernames o_cipher_definitions |
|
set o_cipherids [list] |
|
set o_ciphernames [list] |
|
foreach k [dict keys $o_cipher_definitions] { |
|
if {[dict get $o_cipher_definitions $k enabled]} { |
|
lappend o_cipherids [dict get $o_cipher_definitions $k cipherid] |
|
lappend o_ciphernames $k |
|
} |
|
} |
|
return $o_cipherids |
|
} |
|
|
|
>lib .. PatternProperty cipher_definitions [dict create] |
|
|
|
#the cipherids must be 3 bytes - to form part of the ciphertexts 8byte header. e.g BFS = blowfish has headers like 1BFSC42E |
|
>lib .. PatternProperty cipherids [list] |
|
>lib .. PatternProperty ciphernames [list] |
|
|
|
>lib .. PatternProperty padding_schemes |
|
>lib .. PatternProperty ascii85_wraplen |
|
|
|
>lib .. PatternProperty frame_boundaries |
|
>lib .. PatternPropertyWrite frame_boundaries {boundarylist} { |
|
var o_name o_frame_boundaries |
|
if {$o_name eq "standard"} { |
|
error "(>lib-instance . frame_boundaries (write)) ERROR: frame_boundaries is read-only. Create a new patterncipher::>lib object for different behaviour" |
|
} |
|
set o_frame_boundaries $boundarylist |
|
} |
|
>lib .. PatternProperty hex1_by_bucketsize |
|
>lib .. PatternPropertyWrite hex1_by_bucketsize {newval} { |
|
#calculated from $o_frame_boundaries - never needs to be writable |
|
error "(>lib-instance . hex1_by_bucketsize (write)) ERROR: hex1_by_bucketsize is read-only." |
|
} |
|
>lib .. PatternProperty bucketsize_by_hex1 |
|
>lib .. PatternPropertyWrite bucketsize_by_hex1 {newval} { |
|
#calculated from $o_frame_boundaries - never needs to be writable |
|
error "(>lib-instance . bucketsize_by_hex1 (write)) ERROR: hex1_by_bucketsize is read-only." |
|
} |
|
|
|
>lib .. PatternProperty hex4_by_bucketsize |
|
>lib .. PatternPropertyWrite hex4_by_bucketsize {newval} { |
|
#calculated from $o_frame_boundaries - never needs to be writable |
|
error "(>lib-instance . hex4_by_bucketsize (write)) ERROR: hex4_by_bucketsize is read-only." |
|
} |
|
>lib .. PatternProperty bucketsize_by_hex4 |
|
>lib .. PatternPropertyWrite bucketsize_by_hex4 {newval} { |
|
#calculated from $o_frame_boundaries - never needs to be writable |
|
error "(>lib-instance . bucketsize_by_hex4 (write)) ERROR: hex4_by_bucketsize is read-only." |
|
} |
|
|
|
#K can be used by some cipher_definitions to set the iv to a string - alternatively - lindex [list "value" _dontcare] 0 |
|
#also it is known as the K combinator |
|
>lib .. PatternMethod K {a args} {set a} |
|
|
|
|
|
>lib .. PatternMethod get_iv_for_ciphername {cname args} { |
|
#any specific customizations we need to get an IV for a specific cipher |
|
var this o_cipher_definitions |
|
#---------------------------------------------------------------------------- |
|
set known_args [list -userdata] |
|
if {([llength $args] % 2) != 0} { |
|
error "(get_iv_for_ciphername) ERROR: odd number of options supplied. Usage: '. get_iv_for_ciphername \$ciphername \[-option val\]*' where -option one of '$known_args' " |
|
} |
|
if {[llength $args]} { |
|
foreach {a b} $args { |
|
if {$a ni $known_args} { |
|
error "(get_random_bytes) ERROR: unknown option '$a'. Usage: '. get_iv_for_ciphername \$ciphername \[-option val\]*' where -option one of '$known_args' " |
|
} |
|
} |
|
} |
|
dict set default -userdata "" |
|
set opts [dict merge $default $args] |
|
set userdata [dict get $opts -userdata] |
|
#---------------------------------------------------------------------------- |
|
|
|
|
|
set ivb [dict get $o_cipher_definitions $cname iv_bytes] |
|
switch $cname { |
|
"text" { |
|
if {![string length $userdata]} { |
|
set m [lindex [dict get $o_cipher_definitions $cname modes] 0] |
|
if {![string length $m]} { |
|
error "($this get_iv_for_ciphername) Error: can't calculate IV" |
|
} |
|
set iv "$m[string repeat _ $ivb]" |
|
set iv [string range $iv 0 $ivb-1] |
|
# e.g "utf-8___________" |
|
return $iv |
|
} else { |
|
if {[string length $userdata] == $ivb} { |
|
#assume they know what they're doing if length exactly right and pass through as is |
|
return $userdata |
|
} else { |
|
#It's valid to supply an encoding name such as utf-8 or unicode - check that the system knows it first though |
|
if {$userdata in [dict get $o_cipher_definitions $cname modes]} { |
|
set iv "$userdata[string repeat _ $ivb]" |
|
return [string range $iv 0 $ivb-1] |
|
} else { |
|
error "($this get_iv_for_ciphername) Error: can't calculate IV from user supplied data '$userdata'" |
|
} |
|
} |
|
} |
|
} |
|
default { |
|
return [$this . get_random_bytes $ivb -userdata $userdata] |
|
} |
|
} |
|
} |
|
|
|
>lib .. PatternVariable o_get_random_bytes_calls 0 ;#additional data for random seed values - ensure no two calls have same seed even if called in quick succession. |
|
>lib .. PatternMethod get_random_bytes {len args} { |
|
var o_get_random_bytes_calls |
|
incr o_get_random_bytes_calls |
|
#puts stdout "get_random_bytes call:$o_get_random_bytes_calls" |
|
|
|
#---------------------------------------------------------------------------- |
|
set known_args [list -method -ascii85 -userdata] |
|
if {([llength $args] % 2) != 0} { |
|
error "(get_random_bytes) ERROR: odd number of options supplied. Usage: '. get_random_bytes \$numbytes \[-option val\]*' where -option one of '$known_args' " |
|
} |
|
if {[llength $args]} { |
|
foreach {a b} $args { |
|
if {$a ni $known_args} { |
|
error "(get_random_bytes) ERROR: unknown option '$a'. Usage: '. get_random_bytes \$numbytes \[-option val\]*' where -option one of '$known_args' " |
|
} |
|
} |
|
} |
|
dict set default -method basic |
|
dict set default -ascii85 0 |
|
dict set default -userdata "" |
|
set opts [dict merge $default $args] |
|
set method [dict get $opts -method] |
|
set ascii85 [dict get $opts -ascii85] |
|
set userdata [dict get $opts -userdata] |
|
#---------------------------------------------------------------------------- |
|
|
|
|
|
set known_methods [list basic] |
|
switch [string tolower $method] { |
|
"basic" { |
|
#considered cryptographically insecure. |
|
#pick $len numbers 0 to 255 |
|
set seed [clock seconds] |
|
append seed [clock clicks] $o_get_random_bytes_calls [pid] |
|
#!todo - add some unpredictable things to the seed. |
|
expr {srand($seed)} ;#srand seems to be able to handle artibrarily large numbers |
|
set bytelist [list] |
|
for {set i 0} {$i < $len} {incr i} { |
|
lappend bytelist [expr {int(rand()*256)}] ;# 0 to 255 |
|
} |
|
#puts stdout ">>bytelist $bytelist" |
|
if {$ascii85} { |
|
#Note. Do not wrap here. (e.g do not use o_ascii85_wraplen). Manually do it later so linebreaks in final result are consistent. |
|
# - also, ascii85::encode uses regular expressions where maxlen can't be > 256 |
|
set random_binstr [binary format c$len $bytelist] |
|
#always truncate to proper length before encoding.. |
|
set combined [string range $userdata$random_binstr 0 $len-1] |
|
|
|
set text [ascii85::encode -maxlen 0 $combined] |
|
return [string range $text 0 $len-1] ;#truncate again in case it grew |
|
} else { |
|
|
|
set random_binstr [binary format c${len} $bytelist] |
|
|
|
return [string range $userdata$random_binstr 0 $len-1] |
|
} |
|
} |
|
default { |
|
error "(get_random_bytes) ERROR: Unknown randomisation method '$method'. Expected one of '$known_methods'" |
|
} |
|
} |
|
} |
|
>lib .. PatternMethod get_bucket_info {size_of_ascii85} { |
|
var o_frame_boundaries o_hex1_by_bucketsize o_hex4_by_bucketsize |
|
set hex1 F ;#default if no other code matched - means 'Final' and payload limit of 4080 |
|
set hex4 00 ;#Final - and payload limit of 65535 |
|
set size 0 ;#indicates unspecified/unlimited |
|
foreach bucketsize $o_frame_boundaries { |
|
if {$size_of_ascii85 < $bucketsize} { |
|
set hex1 [dict get $o_hex1_by_bucketsize $bucketsize] |
|
set hex4 [dict get $o_hex4_by_bucketsize $bucketsize] |
|
set size $bucketsize |
|
break |
|
} |
|
} |
|
puts stdout "... get_bucket_info [list hex1 $hex1 hex4 $hex4 size $size]" |
|
return [list hex1 $hex1 hex4 $hex4 size $size] |
|
} |
|
>lib .. Create ::patterncipher::libs::>lib_standard -name "standard" |
|
|
|
} |
|
|
|
|
|
namespace eval ::patterncipher { |
|
|
|
#--------------------------------------------------------------------------- |
|
#overlay/mixin - (created in constructor) these also become properties on the >blowfish/>aes instances |
|
# - |
|
# - These are cipher-specific settings not intended to be user configurable. |
|
>pattern .. Create >cipher_bytesizes |
|
>cipher_bytesizes .. Constructor {args} { |
|
var this o_data_block_bytes o_iv_bytes o_key_byte_sizes o_spud |
|
set this @this@ |
|
puts stdout "---->cipher_bytesizes Constructor running with args $args creating $this" |
|
#---------------------------------------------------------------------------- |
|
set known_opts [list] |
|
set required_opts [list] |
|
set default [dict create] |
|
#dict set default -something etc |
|
if {([llength $args] % 2) != 0} { |
|
error "($this . Constructor) ERROR: uneven options supplied - must be of form '-option value' " |
|
} |
|
foreach {k v} $args { |
|
if {$k ni $known_opts} { |
|
error "(($this . Constructor) ERROR: option '$k' not in known options: '$known_opts'" |
|
} |
|
} |
|
foreach o $required_opts { |
|
if {$o ni $args} { |
|
error "(($this . Constructor) ERROR: the following options are not actually optional: '$required_opts'" |
|
} |
|
} |
|
set opts [dict merge $default $args] |
|
#---------------------------------------------------------------------------- |
|
|
|
} |
|
#Hidden - variables with PropertyRead and/or PropertyWrite become a hidden property |
|
# readonly & hidden |
|
>cipher_bytesizes .. PatternVariable o_data_block_bytes |
|
>cipher_bytesizes .. PatternPropertyRead data_block_bytes {} { |
|
var o_data_block_bytes |
|
return $o_data_block_bytes |
|
} |
|
|
|
#readonly & hidden |
|
>cipher_bytesizes .. PatternVariable o_iv_bytes |
|
>cipher_bytesizes .. PatternPropertyRead iv_bytes {} { |
|
var o_iv_bytes |
|
return $o_iv_bytes |
|
} |
|
|
|
#readonly and visible |
|
>cipher_bytesizes .. PatternProperty key_byte_sizes |
|
>cipher_bytesizes .. PatternPropertyWrite key_byte_sizes {not_writable} { |
|
var this |
|
error "($this . key_byte_sizes (write)) ERROR: property key_byte_sizes is read only." |
|
} |
|
|
|
#--------------------------------------------------------------------------- |
|
|
|
|
|
|
|
} |
|
|
|
|
|
namespace eval ::patterncipher { |
|
|
|
|
|
#mixin via Clone mechanism to the >cipher prototype |
|
::patterncipher::>cipher_bytesizes .. Clone [namespace current]::>ciphermaster |
|
|
|
|
|
>ciphermaster .. Construct {} { |
|
var this |
|
set this @this@ |
|
} |
|
>ciphermaster .. Method help {} { |
|
var this o_ciphername |
|
set this @this@ |
|
#o_data_block_bytes o_iv_bytes o_key_byte_sizes |
|
set cipherlib ::patterncipher::libs::>lib_standard |
|
set cipherdefs [$cipherlib . cipher_definitions] |
|
set key_byte_sizes [dict get $cipherdefs $o_ciphername key_byte_sizes] |
|
set data_block_bytes [dict get $cipherdefs $o_ciphername data_block_bytes] |
|
|
|
#a sample key of correct length for first key size in $key_byte_sizes |
|
set longkey "8BYTES1\]8BYTES2\]8BYTES3\]8BYTES4\]8BYTES5\]8BYTES6\]8BYTES7\]8BYTES8\]" |
|
set keysample [string range $longkey 0 [lindex $key_byte_sizes 0]-1] |
|
|
|
set help { |
|
|
|
patterncipher::>object .. Create >b1 |
|
set [>b1 . key .] %kb1 ;#encipherment key. Allowed number of bytes: '%kbs%' |
|
>b1 . encrypt \$something ;#chunks added don't have to be multiple of %dbs% bytes |
|
>b1 . encrypt \"some-data-123\" ;# - they will be buffered,concatenated and finally padded. |
|
>b1 . encrypt "\[command yielding data\]" -last 1 ;# '. encrypt -last 1' can take empty string if needed |
|
;# - alternatively you can call '. encryptlast' or '. encryptlast $lastchunk' instead |
|
set encrypted_data [>b1 . ciphertext] ;# defaults to hex encoded |
|
set raw_encrypted_data [>b1 . ciphertext -raw 1] ;# binary output |
|
set verify [>b1 . decrypt_and_reset] ;# Only after calling this ( or '. reset' ) |
|
;# - can we start a new encrypting/decrypting cycle |
|
|
|
-------------------------------------------------------------------------------------------------------- |
|
#To decrypt: |
|
set [>b1 . ciphertext .] $encrypted_data ;# expects hex encoded, with 8-char header e.g '0BFS0FFF' |
|
set plaintext [>b1 . decrypt_and_reset] |
|
|
|
} |
|
set help [string map [list ">object" >$o_ciphername ">b1" >${o_ciphername}-instance %kb1 $keysample %kbs% $key_byte_sizes %dbs% $data_block_bytes] $help] |
|
} |
|
|
|
|
|
>ciphermaster .. Constructor {args} { |
|
var this o_patterncipherlib o_ciphername |
|
set this @this@ |
|
puts stdout "(>cipher $this .. Constructor) running with args $args creating $this vars:[info vars]" |
|
#---------------------------------------------------------------------------- |
|
set known_opts [list -patterncipherlib] |
|
dict set default -patterncipherlib [::patterncipher::>libs -1 ] ;#last item added to the >libs collection |
|
if {([llength $args] % 2) != 0} { |
|
error "(>cipher $this .. Constructor) ERROR: uneven options supplied - must be of form '-option value' " |
|
} |
|
foreach {k v} $args { |
|
if {$k ni $known_opts} { |
|
error "((>cipher $this .. Constructor) ERROR: option '$k' not in known options: '$known_opts'" |
|
} |
|
} |
|
set opts [dict merge $default $args] |
|
set o_patterncipherlib [dict get $opts -patterncipherlib] |
|
#---------------------------------------------------------------------------- |
|
|
|
$this . _init_cipher_from_definitions $o_ciphername |
|
#set [$this . ciphername .] $o_ciphername |
|
|
|
|
|
#run the next constructor (from object cloned onto this one) |
|
#var o_data_block_bytes o_iv_bytes o_key_byte_sizes |
|
puts stderr ">>>>>> here <<<" |
|
#@next@ -data_block_bytes $o_data_block_bytes -iv_bytes $o_iv_bytes -key_byte_sizes $o_key_byte_sizes |
|
#mixin |
|
#$this .. PatternExpand |
|
#::patterncipher::>cipher_bytesizes .. Create $this -data_block_bytes 8 -iv_bytes 8 -key_byte_sizes [list 8] |
|
} |
|
|
|
|
|
#We won't have private methods until the interface mechanism of patternpunk is settled. :/ |
|
>ciphermaster .. PatternMethod _init_cipher_from_definitions {name} { |
|
#don't declare any vars - so we get them all (?) |
|
set definitions [$o_patterncipherlib . cipher_definitions] |
|
set pkgname [dict get $definitions $name pkgrequire] |
|
#! todo - add option to require exact version? |
|
if {[catch {package require $pkgname} errMsg]} { |
|
error "($this . ciphername (prop write)) unable to load package '$pkgname' for ciphername '$name' err: $errMsg" |
|
} |
|
set o_algocommand [dict get $definitions $name algocommand] |
|
set o_cipherid [dict get $definitions $name cipherid] |
|
set o_data_block_bytes [dict get $definitions $name data_block_bytes] |
|
set o_iv_bytes [dict get $definitions $name iv_bytes] |
|
set o_iv_static [dict get $definitions $name iv_static] |
|
set o_iv_method [string map [list %ivb $o_iv_bytes %cn $name] [dict get $definitions $name iv_method]] |
|
set o_key_byte_sizes [dict get $definitions $name key_byte_sizes] |
|
set o_ciphermodes [dict get $definitions $name modes] |
|
set o_mode [lindex $o_ciphermodes 0] |
|
set o_ciphername $name |
|
puts stdout "init_cipher_from_definitions running in [namespace current]" |
|
} |
|
|
|
|
|
>ciphermaster .. PatternProperty ciphername |
|
>ciphermaster .. PatternPropertyWrite ciphername {name} { |
|
var this o_patterncipherlib o_ciphername o_cipherid o_mode o_ciphertoken o_cipherbin |
|
var o_data_block_bytes o_iv_bytes o_iv_static o_iv_method o_key_byte_sizes o_algocommand o_ciphermodes |
|
|
|
set definitions [$o_patterncipherlib . cipher_definitions] |
|
|
|
if {$name ni [dict keys $definitions]} { |
|
puts stdout "known ciphernames: [dict keys $definitions]" |
|
error "($this . ciphername (prop write)) cipher '$name' not known in this patterncipherlib: $o_patterncipherlib" |
|
} |
|
|
|
if {[string length $o_cipherbin]} { |
|
$this . ciphertext_header_info [string range $o_cipherbin 0 9] .. As header_info |
|
if {[dict get $header_info status] != 1} { |
|
error "($this . reset) Cannot reset IV while there is unfinalised ciphertext. call 'decrypt_and_reset' or 'abandon' first" |
|
} |
|
} |
|
|
|
|
|
if {[string length $o_ciphername]} { |
|
if {$name ne $o_ciphername} { |
|
#changing from one cipher to another |
|
|
|
|
|
if {[string length $o_ciphertoken]} { |
|
$this . abandon |
|
|
|
#if {[catch {${o_algocommand}::Final $o_ciphertoken} errMsg]} { |
|
# puts stderr "($this . ciphername (prop write)) changing ciphername $o_ciphername to $name . err calling Final with previous token $o_ciphertoken. Err: $errMsg" |
|
#} |
|
} |
|
|
|
} else { |
|
#same name as before - warning because this is the wrong way to reset - if that's what was intended. |
|
#puts stderr "($this . ciphername (prop write)) WARNING ciphername is already '$name'" |
|
# constructor legitimately does this though - and in that case we need to run the reset operations below |
|
|
|
} |
|
} |
|
|
|
#loads packages and sets vars |
|
$this . _init_cipher_from_definitions $name |
|
|
|
|
|
set o_ciphername $name |
|
|
|
#$this . reset |
|
return $name |
|
} |
|
|
|
#vars need to be declared as a PatternVariable or PatternProperty if we ever want them auto-declared |
|
>ciphermaster .. PatternVariable o_algocommand |
|
>ciphermaster .. PatternVariable o_iv_method |
|
>ciphermaster .. PatternVariable o_ciphermodes |
|
>ciphermaster .. PatternVariable o_iv_manually_set 0;#bool indicates was set via '. iv'. Resets each round unless o_iv_static is true. |
|
>ciphermaster .. PatternVariable o_tailbuffer "" ;#remaining 1 to ($data_block_bytes -1) characters from when encrypt called with data not a multiple of $data_block_bytes bytes |
|
>ciphermaster .. PatternVariable o_cipherpadding_numbytes 0 |
|
|
|
|
|
|
|
#NOTE - other properties are overlayed/mixed in during object construction in the Constructor |
|
# e.g from >cipher_bytesizes |
|
>ciphermaster .. PatternProperty patterncipherlib |
|
>ciphermaster .. PatternProperty key "" ;# encryption key of size in $key_byte_sizes |
|
>ciphermaster .. PatternProperty iv "" ;#$iv_bytes initialisation vector. Will be randomly created each round unless explicitly set. |
|
>ciphermaster .. PatternProperty mode |
|
>ciphermaster .. PatternProperty padschemeid 0;#1 = text based, ascii85 encoded, with paddingsize buckets |
|
>ciphermaster .. PatternProperty padschemename ;# |
|
>ciphermaster .. PatternProperty iv_static ;#whether or not random IV used each reset/init |
|
|
|
|
|
>ciphermaster .. PatternProperty cipherid BFS ;#default - will only be used if cipherkey is not empty string |
|
>ciphermaster .. PatternPropertyWrite cipherid {id} { |
|
var o_cipherid o_patterncipherlib |
|
if {$id ni [$o_patterncipherlib . cipherids]} { |
|
error "($this . cipherid (property write)) cipherid '$id' not in list of known ciphers '[$o_patterncipherlib . cipherids]'" |
|
} |
|
error "not safe" |
|
set o_cipherid $id |
|
} |
|
|
|
>ciphermaster .. PatternVariable o_ciphertoken "" |
|
>ciphermaster .. PatternPropertyRead ciphertoken "" { |
|
var o_ciphertoken |
|
return $o_ciphertoken |
|
} |
|
>ciphermaster .. PatternProperty cipherbin "" |
|
|
|
>ciphermaster .. PatternVariable o_chunknum 0 ;# |
|
>ciphermaster .. PatternPropertyRead chunknum {} { |
|
var o_chunknum |
|
return o_chunknum |
|
} |
|
>ciphermaster .. PatternVariable o_chunklist [list] ;#no need for chunknum? |
|
|
|
>ciphermaster .. PatternProperty ciphertext ;#leave unset - underlying variable should never have a value. ciphertext is a dynamic property based on cipherbin |
|
|
|
|
|
>ciphermaster .. PatternMethod padschemeinfo {{schemeid ""}} { |
|
switch $schemeid { |
|
"0" { |
|
return [list scheme "text-minpad" notes "ascii85 encoded, minimum padding - at least 1 at most $o_data_block_bytes"] |
|
} |
|
"1" { |
|
return [list scheme "text-buckets" notes "ascii85 encoded"] |
|
} |
|
"2" { |
|
return [list scheme "binary-minpad" notes ""] |
|
} |
|
"3" { |
|
return [list scheme "binary-buckets" notes ""] |
|
} |
|
default { |
|
return [list scheme "unknown" notes "implemented padding schemes are [$o_patterncipherlib . padding_schemes]"] |
|
} |
|
} |
|
} |
|
|
|
>ciphermaster .. PatternPropertyRead token {} { |
|
var o_ciphertoken |
|
return $o_ciphertoken |
|
} |
|
>ciphermaster .. PatternPropertyWrite mode {m} { |
|
var this o_mode o_ciphermodes |
|
if {$m ni $o_ciphermodes} { |
|
error "($this . mode (write)) ERROR: supported modes are $o_ciphermodes" |
|
} |
|
set o_mode $m |
|
} |
|
>ciphermaster .. PatternPropertyRead ciphertext {args} { |
|
var this o_cipherbin o_cipherpadding_numbytes o_cipherid o_patterncipherlib |
|
if {$args eq [list -interim 1]} { |
|
#allow bypassing header check for debug/test |
|
set ascii85_payload [ascii85::encode -maxlen [$o_patterncipherlib . ascii85_wraplen] $o_cipherbin] |
|
return "INTERIM.$ascii85_payload" |
|
} |
|
|
|
$this . ciphertext_header_info $o_cipherbin .. As header_info |
|
if {([dict get $header_info status] != 1)} { |
|
if {([dict get $header_info hdr_cipherid] eq $o_cipherid ) && ([llength [dict get $header_info errors]])} { |
|
#A finalisation header has been written - but something went wrong |
|
error "(cipherbin) Something went wrong. Suggest calling '. abandon' and retrying. errors: [dict get $header_info errors]" |
|
} else { |
|
error "(cipherbin) Not yet retrievable - call '. encrypt <data_or_empty_string> -last 1' first." |
|
} |
|
} else { |
|
set header [string range $o_cipherbin 0 7] |
|
set ascii85_payload [ascii85::encode -maxlen [$o_patterncipherlib . ascii85_wraplen] [string range $o_cipherbin 8 end]] |
|
return $header$ascii85_payload ;#cyphertext with header |
|
} |
|
} |
|
>ciphermaster .. PatternPropertyWrite ciphertext {frame_of_encrypted_data} { |
|
var this o_patterncipherlib o_cipherbin o_cipherpadding_numbytes o_cipherid o_ciphertoken |
|
if {[string length $o_cipherbin]} { |
|
error "(cipherbin property write) There already seems to be an encryption operation underway - call decrypt to retrieve it." |
|
} |
|
#check header |
|
$this . ciphertext_header_info $frame_of_encrypted_data .. As header_info |
|
if {[dict get $header_info status] == 1} { |
|
if {[dict get $header_info hdr_cipherid] ne $o_cipherid } { |
|
error "(cipherbin property write) cipher in ciphertext [dict get $header_info hdr_cipherid] doesn't match currently configured cipher $o_cipherid" |
|
} |
|
|
|
if {![string length $o_ciphertoken]} { |
|
$this . initcipher |
|
} |
|
set schemeid [dict get $header_info hdr_schemeid] |
|
set bucketid [dict get $header_info hdr_bucketid] |
|
set paybytes [dict get $header_info hdr_paybytes] |
|
set paylen [dict get $header_info paylen] |
|
set padlen [dict get $header_info padlen] |
|
set o_cipherpadding_numbytes $padlen |
|
if {$schemeid in {0 1}} { |
|
#text based ascii85 |
|
set head [string range $frame_of_encrypted_data 0 7] |
|
set binary [::ascii85::decode [string range $frame_of_encrypted_data 8 end]] |
|
set o_cipherbin $head$binary |
|
} else { |
|
#already binary |
|
set o_cipherbin $frame_of_encrypted_data |
|
} |
|
|
|
} else { |
|
error "(ciphertext property write) ciphertext doesn't have proper header e.g 0BFS0FFF" |
|
} |
|
|
|
} |
|
>ciphermaster .. PatternPropertyRead cipherbin {args} { |
|
var this o_cipherbin o_cipherpadding_numbytes o_cipherid |
|
if {$args eq [list -interim 1]} { |
|
#allow bypassing header check for debug/test |
|
return $o_cipherbin |
|
} |
|
|
|
|
|
#check for #AAA0XXX header where # is a number from 1 to 8 and AAA is a cipher hint such as BFS or AES - this indicates --last has been called on encrypt and the ciphertext is ready to retrieve. |
|
$this . ciphertext_header_info $o_cipherbin .. As header_info |
|
|
|
if {([dict get $header_info status] != 1)} { |
|
if {([dict get $header_info hdr_cipherid] eq $o_cipherid ) && ([llength [dict get $header_info errors]])} { |
|
#A finalisation header has been written - but something went wrong |
|
error "(cipherbin) Something went wrong. Suggest calling '. abandon' and retrying. errors: [dict get $header_info errors]" |
|
} else { |
|
error "(cipherbin) Not yet retrievable - call '. encrypt <data_or_empty_string> -last 1' first." |
|
} |
|
} else { |
|
return $o_cipherbin ;#cyphertext with header |
|
} |
|
} |
|
>ciphermaster .. PatternPropertyWrite cipherbin {encrypted_data} { |
|
var this o_patterncipherlib o_cipherbin o_cipherpadding_numbytes o_cipherid o_ciphertoken |
|
if {[string length $o_cipherbin]} { |
|
error "(cipherbin property write) There already seems to be an encryption operation underway - call decrypt to retrieve it." |
|
} |
|
|
|
#check header |
|
$this . ciphertext_header_info $encrypted_data .. As header_info |
|
if {[dict get $header_info status] == 1} { |
|
if {[dict get $header_info hdr_cipherid] ne $o_cipherid } { |
|
error "(cipherbin property write) cipher in ciphertext [dict get $header_info hdr_cipher] doesn't match currently configured cipher $o_cipherid" |
|
} |
|
|
|
if {![string length $o_ciphertoken]} { |
|
$this . initcipher |
|
} |
|
set schemeid [dict get $header_info hdr_schemeid] |
|
set bucketid [dict get $header_info hdr_bucketid] |
|
set paybytes [dict get $header_info hdr_paybytes] |
|
set paylen [dict get $header_info paylen] |
|
set padlen [dict get $header_info padlen] |
|
set o_cipherpadding_numbytes $padlen |
|
|
|
|
|
set o_cipherbin $encrypted_data |
|
} else { |
|
error "(cipherbin property write) ciphertext doesn't have proper header e.g 0BFS0FFF" |
|
} |
|
} |
|
>ciphermaster .. PatternPropertyUnset cipherbin {keypattern} { |
|
var o_cipherbin |
|
if {[string length $o_cipherbin]} { |
|
error "($this . cipherbin (unset)) ERROR: cannot unset cipherbin - currently contains [string length $o_cipherbin] bytes." |
|
} |
|
} |
|
>ciphermaster .. PatternPropertyWrite key {key_or_emptystring} { |
|
var this o_data_block_bytes o_key o_ciphername o_key_byte_sizes |
|
set datalen [string length $key_or_emptystring] |
|
if {$datalen} { |
|
if {($datalen ni $o_key_byte_sizes)} { |
|
error "($this . key (write)) ERROR: bad key. $o_ciphername valid keylengths: '$o_key_byte_sizes'. Received $datalen bytes." |
|
} |
|
set newkey $key_or_emptystring |
|
set oldkey $o_key |
|
if {[string length $oldkey]} { |
|
if {$newkey ne $oldkey} { |
|
puts stderr "($this . key (write)) WARNING: changing $o_ciphername encipherment key '$oldkey' -> $newkey" |
|
} |
|
} |
|
|
|
} |
|
set o_key $key_or_emptystring |
|
} |
|
|
|
>ciphermaster .. PatternPropertyWrite iv {new_iv} { |
|
var this o_ciphertoken o_iv o_iv_bytes o_iv_manually_set o_cipherbin o_algocommand |
|
var o_iv_method o_patterncipherlib |
|
|
|
#puts "----> o_iv_method: $o_iv_method" |
|
if {[string length $o_cipherbin]} { |
|
error "($this . iv (write)) Cannot set IV while there is active cipher ciphertext. call 'decrypt_and_reset' or 'abandon' first" |
|
} |
|
|
|
set library_passed_iv [{*}[concat $o_patterncipherlib . $o_iv_method -userdata $new_iv]] |
|
|
|
if {[string length $library_passed_iv] != $o_iv_bytes} { |
|
error "($this . iv (write))IV returned by '[concat $o_patterncipherlib . $o_iv_method -userdata $new_iv]' was not $o_iv_bytes bytes long. Cipher configuration/library error?" |
|
} |
|
set o_iv $library_passed_iv |
|
set o_iv_manually_set 1 |
|
if {[string length $o_ciphertoken]} { |
|
${o_algocommand}::Reset $o_ciphertoken $o_iv |
|
} |
|
} |
|
|
|
|
|
>ciphermaster .. PatternMethod reset {} { |
|
var this o_ciphertoken o_iv o_iv_static o_iv_manually_set o_iv_bytes o_iv_method o_cipherbin |
|
var o_tailbuffer o_cipherpadding_numbytes o_patterncipherlib o_algocommand |
|
if {[string length $o_cipherbin]} { |
|
$this . ciphertext_header_info [string range $o_cipherbin 0 9] .. As header_info |
|
if {[dict get $header_info status] != 1} { |
|
error "($this . reset) Cannot reset IV while there is unfinalised ciphertext. call 'decrypt_and_reset' or 'abandon' first" |
|
} |
|
} |
|
if {$o_iv_static} { |
|
#leave state of o_iv and o_iv_manually set as is |
|
} else { |
|
set o_iv_manually_set 0 |
|
#set o_iv [$o_patterncipherlib . get_random_bytes $o_iv_bytes] |
|
set o_iv [{*}[concat $o_patterncipherlib . $o_iv_method]] |
|
} |
|
set o_cipherbin "" |
|
set o_tailbuffer "" |
|
set o_cipherpadding_numbytes 0 |
|
if {[string length $o_ciphertoken]} { |
|
${o_algocommand}::Reset $o_ciphertoken $o_iv |
|
} |
|
} |
|
>ciphermaster .. PatternMethod initcipher {} { |
|
var this o_key o_key_byte_sizes o_iv o_iv_bytes o_iv_static o_iv_method o_iv_manually_set o_iv_previous |
|
var o_ciphertoken o_mode o_cipherbin o_patterncipherlib o_algocommand |
|
if {[string length $o_cipherbin]} { |
|
error "($this . init) Cannot init while there is active cipher ciphertext. call 'decrypt_and_reset' or 'abandon' first or 'reset' if ciphertext has been finalised" |
|
} |
|
|
|
|
|
if {!$o_iv_manually_set} { |
|
#set o_iv [$o_patterncipherlib . get_random_bytes $o_iv_bytes] |
|
set o_iv [{*}[concat $o_patterncipherlib . $o_iv_method]] |
|
|
|
} else { |
|
if {$o_iv_static} { |
|
#leave state of o_iv because it was manually configured and static |
|
} else { |
|
if {$o_iv eq $o_iv_previous} { |
|
#change because not meant to be static |
|
#set o_iv [$o_patterncipherlib . get_random_bytes $o_iv_bytes] |
|
set o_iv [{*}[concat $o_patterncipherlib . $o_iv_method]] |
|
} |
|
} |
|
} |
|
set o_iv_previous $o_iv |
|
|
|
if {[string length $o_key] ni $o_key_byte_sizes} { |
|
error "(initcipher) '$this . key' current keylength:[string length $o_key] is wrong. Allowed lengths in bytes: '$o_key_byte_sizes'" |
|
} |
|
|
|
set o_ciphertoken [${o_algocommand}::Init $o_mode $o_key $o_iv] |
|
} |
|
|
|
>ciphermaster .. PatternMethod encryptlast {{newdata ""}} { |
|
tailcall encrypt $_ID_ $newdata -last 1 |
|
} |
|
>ciphermaster .. PatternMethod encrypt {newdata args} { |
|
var this o_ciphertoken o_cipherbin o_data_block_bytes o_key o_iv o_iv_bytes o_cipherpadding_numbytes o_tailbuffer o_patterncipherlib o_padschemeid o_cipherid o_algocommand |
|
|
|
#---------------------------------------------------------------------------- |
|
set known_opts [list -last -show -key -iv] |
|
dict set default -last 0 ;#when -last 1 do padding |
|
dict set default -show 0 ;#echo $o_cipherbin to stdout |
|
dict set default -reopen 0 ;#todo add -reopen by adding another bucket? |
|
if {([llength $args] % 2) != 0} { |
|
error "($this . encrypt) ERROR: uneven options supplied - must be of form '-option value' " |
|
} |
|
foreach {k v} $args { |
|
if {$k ni $known_opts} { |
|
error "(($this . encrypt) ERROR: option '$k' not in known options: '$known_opts'" |
|
} |
|
} |
|
set opts [dict merge $default $args] |
|
set option_last [dict get $opts -last] |
|
set option_show [dict get $opts -show] |
|
set option_reopen [dict get $opts -reopen] |
|
#---------------------------------------------------------------------------- |
|
|
|
if {![string length $o_ciphertoken]} { |
|
$this . initcipher |
|
} |
|
if {$o_cipherpadding_numbytes > 0} { |
|
#once there is padding in the ciphertext data - we know this encrypt round is at an end. |
|
error "($this . encrypt) Ciphertext is already finalised. Retrieve with '. ciphertext' and verify with '. decrypt_and_reset' before retrying." |
|
} |
|
|
|
set newdata "$o_tailbuffer$newdata" ;#data we're adding in this method call |
|
set o_tailbuffer "" |
|
|
|
if {$o_data_block_bytes > 0} { |
|
set last_data_block_size [expr {[string length $newdata] % $o_data_block_bytes}] ;#if 0, newdata was a multiple of $o_data_block_bytes bytes |
|
set blocksize $o_data_block_bytes |
|
} else { |
|
#non 'block-based' data - we'll never need padding |
|
set blocksize [string length $newdata] |
|
set last_data_block_size [string length $newdata] |
|
} |
|
set padding "" |
|
|
|
|
|
if {![string length $o_cipherbin]} { |
|
#first chunk to store in ciphertext. ciphertext requires 8 byte iv prepended |
|
set o_cipherbin $o_iv ;# IV required for decryption |
|
} |
|
#o_cipherbin always has iv data at start now. |
|
set iv_plus_content_size [expr {[string length $o_cipherbin ] + [string length $newdata]}] ;#iv + data is the payload the encrypter operates on |
|
|
|
if {$option_last} { |
|
#treat as full bucket |
|
set end_of_bucket 1 |
|
} else { |
|
#detect if we've filled a bucket |
|
set end_of_bucket 0 |
|
} |
|
|
|
|
|
if {$end_of_bucket} { |
|
#if we're already at a multiple of data_block_bytes bytes, still add padding so we can use o_cipherpadding_numbytes = 0 as a flag |
|
|
|
#New header of form #BFSHXLl where # is padding scheme X, BFSH is cipher, X is bucket code and Ll is the payload size (not including header) |
|
#calculate size of the bucket needed for ascii85 encoded version of the payload + 8byte header + $blocksize bytes of minpadding |
|
|
|
#!todo - lookup text/vs binary from schemeinfo |
|
if {$o_padschemeid in {0 1}} { |
|
#text schemes |
|
set hex_pay_len [format %04x $iv_plus_content_size] |
|
set possible_newlines [expr {entier($iv_plus_content_size / [$o_patterncipherlib . ascii85_wraplen])}] |
|
#review - guess vs redundant ascii85 encoding work? |
|
set ascii85_content_size_guess [expr {entier(ceil(($iv_plus_content_size/4.0)*5)) + $possible_newlines}] ;#why guess? |
|
set ascii85_payload [ascii85::encode -maxlen [$o_patterncipherlib . ascii85_wraplen] $o_cipherbin$newdata] |
|
|
|
if {$ascii85_content_size_guess != [string length $ascii85_payload]} { |
|
puts stdout "(encrypt) WARNING: ascii85 guess: '$ascii85_content_size_guess' vs ascii85 actual: '[string length $ascii85_payload]'" |
|
} |
|
|
|
set bucket_info [$o_patterncipherlib . get_bucket_info $ascii85_content_size_guess] |
|
set bucket_hex1 [dict get $bucket_info hex1] ; #1 byte hex |
|
set bucket_size [dict get $bucket_info size] |
|
|
|
if {$o_padschemeid eq "0"} { |
|
#text-minpad |
|
set data_needed_bytes [expr {$blocksize - $last_data_block_size}] ;# assertion: needed_bytes is always 1 to $o_data_block_bytes |
|
set needed_bytes $data_needed_bytes |
|
set padding [string repeat * $needed_bytes] ;#primitive padding - #!todo review. |
|
|
|
set header "0${o_cipherid}0[string range ${hex_pay_len} 1 end]" |
|
} elseif {$o_padschemeid eq "1"} { |
|
#text-buckets |
|
set data_needed_bytes [expr {$blocksize - $last_data_block_size}] |
|
puts stdout ">> data_needed_bytes: $data_needed_bytes" |
|
set needed_bytes [expr {$bucket_size - 8 - $iv_plus_content_size}] |
|
if {(8 + $iv_plus_content_size + $needed_bytes) != $bucket_size} { |
|
error "(encrypt) ERROR: sanity_check 8 + iv&content ($iv_plus_content_size) + padding ($needed_bytes) != bucket_size ($bucket_size) - programming bug!" |
|
} |
|
|
|
puts stdout ">> needed_bytes: $needed_bytes" |
|
puts stdout ">>bucket_size: $bucket_size iv_plus_content_size: $iv_plus_content_size" |
|
set padding [string repeat * $needed_bytes] |
|
set header "1${o_cipherid}${bucket_hex1}[string range ${hex_pay_len} 1 end]" |
|
} |
|
|
|
} elseif {$o_padschemeid in {2 3}} { |
|
set hex_pay_len [format %04x $iv_plus_content_size] |
|
|
|
set bucket_info [$o_patterncipherlib . get_bucket_info $iv_plus_content_size] |
|
set bucket_hex1 [dict get $bucket_info hex1] |
|
set bucket_size [dict get $bucket_info size] |
|
|
|
set msb [string range $hex_pay_len 0 1] |
|
set lsb [string range $hex_pay_len 2 3] |
|
set bin_pay_len [binary format c2 [list "0x$msb" "0x$lsb"] |
|
if {$o_padschemeid eq "2"} { |
|
#binary-minpad |
|
set data_needed_bytes [expr {$blocksize - $last_data_block_size}] ;# assertion: needed_bytes is always 1-$o_data_block_bytes |
|
set needed_bytes $data_needed_bytes |
|
set padding [$o_patterncipherlib . get_random_bytes $needed_bytes] |
|
|
|
set header "2${o_cipherid}${bucket_hex1}$bin_pay_len" |
|
} elseif {$o_padschemeid eq "3"} { |
|
#binary-buckets |
|
set data_needed_bytes [expr {$blocksize - $last_data_block_size}] ;# assertion: needed_bytes is always 1-$o_data_block_bytes |
|
set needed_bytes [expr {$bucket_size - 8 - $iv_plus_content_size}] |
|
if {(8 + $iv_plus_content_size + $needed_bytes) != $bucket_size} { |
|
error "(encrypt) ERROR: sanity_check 8 + iv&content ($iv_plus_content_size) + padding ($needed_bytes) != bucket_size ($bucket_size) - programming bug!" |
|
} |
|
set padding [$o_patterncipherlib . get_random_bytes $needed_bytes] |
|
set header "3${o_cipherid}${bucket_hex1}$bin_pay_len" |
|
} |
|
} |
|
|
|
set o_cipherpadding_numbytes [string length $padding] ;#assertion: always non zero here |
|
|
|
set padded_data "$newdata$padding" |
|
append o_cipherbin [${o_algocommand}::Encrypt $o_ciphertoken $padded_data] |
|
|
|
set o_cipherbin ${header}$o_cipherbin ;#header will make the '. ciphertext' property readable |
|
|
|
puts stdout "ciphertext final: >>> $o_cipherbin <<<" |
|
#puts stderr ">>$padded_data<< [string length $padded_data] bytes" |
|
set payload_bytes [expr [string length $o_cipherbin] - 8 - [string length $padding] - $o_iv_bytes] ;#account for IV and padding bytes to give caller an indication of |
|
if {($payload_bytes + $o_iv_bytes) != $iv_plus_content_size} { |
|
puts stderr "(encrypt) WARNING payloadbytes $payload_bytes != iv_plus_content_size $iv_plus_content_size" |
|
} |
|
|
|
return [list payload_bytes $payload_bytes padding_bytes [string length $padding] header $header buffer_bytes [string length $o_tailbuffer] final 1] |
|
} else { |
|
if {$blocksize > 0} { |
|
if {([string length $newdata] % $blocksize) != 0} { |
|
#error "($this . encrypt) data chunk must be a multiple of $data_block_bytes bytes - call decrypt after one or more calls to encrypt, and/or call '. encrypt data_or_empty_string -last 1" |
|
if {$last_data_block_size != 0} { |
|
set o_tailbuffer [string range $newdata end-[expr {$last_data_block_size -1}] end] |
|
set newdata [string range $newdata 0 end-$last_data_block_size] |
|
} |
|
|
|
if {[string length $newdata]} { |
|
puts stdout "1encrypt !! about to call ${o_algocommand}::Encrypt $o_ciphertoken $newdata" |
|
append o_cipherbin [${o_algocommand}::Encrypt $o_ciphertoken $newdata] |
|
} |
|
} else { |
|
puts stdout "2encrypt !! about to call ${o_algocommand}::Encrypt $o_ciphertoken $newdata" |
|
append o_cipherbin [${o_algocommand}::Encrypt $o_ciphertoken $newdata] |
|
} |
|
} else { |
|
puts stdout "3encrypt !! about to call ${o_algocommand}::Encrypt $o_ciphertoken $newdata" |
|
append o_cipherbin [${o_algocommand}::Encrypt $o_ciphertoken $newdata] |
|
} |
|
set payload_bytes [expr [string length $o_cipherbin] - $o_iv_bytes] ;#account for IV to give caller an indication of payload bytes |
|
|
|
puts stdout "ciphertext: >>> $o_cipherbin padding:$padding should still be 0<<<" |
|
return [list payload_bytes $payload_bytes padding_bytes [string length $padding] buffer_bytes [string length $o_tailbuffer] final 0] |
|
} |
|
|
|
} |
|
|
|
|
|
#abandon any currently-building ciphertext - drop the token |
|
>ciphermaster .. PatternMethod abandon {} { |
|
var this o_ciphertoken o_cipherbin o_cipherpadding_numbytes o_algocommand o_tailbuffer o_iv o_iv_manually_set |
|
puts stdout "($this . abandon) Abandoning any active ciphertext. Encipherment key unchanged. Key-schedule will be regenerated (previous token Finalised)" |
|
|
|
catch {${o_algocommand}::Final $o_ciphertoken} |
|
|
|
set o_ciphertoken "" |
|
set o_cipherbin "" |
|
set o_tailbuffer "" |
|
set o_iv "" |
|
set o_iv_manually_set 0 |
|
set o_cipherpadding_numbytes 0 |
|
} |
|
|
|
#for some schemes - the info returned by ciphertext_header_info is only accurate if the full ciphertext is supplied - not just the header |
|
# hdr_ fields can be trusted if an appropriately truncated ciphertext is supplied, but fields such as padlen may require the complete bucket. |
|
>ciphermaster .. PatternMethod ciphertext_header_info {ciphertext} { |
|
set schemeid [string range $ciphertext 0 0] ;#e.g 0, 1, 2 |
|
set cipherid [string range $ciphertext 1 3] ;#e.g BFS, AES |
|
set bucketid [string range $ciphertext 4 4] ;#hexchar 0-F |
|
set paybytes [string range $ciphertext 5 7] ;#3bytes hex or binary payload length |
|
set endiv [expr {(8 + $o_iv_bytes) -1}] |
|
set cipheriv [string range $ciphertext 8 $endiv] ;# Initialisation vector |
|
set errors [list] |
|
#8 byte header for all schemeids for now |
|
|
|
if {(![string is integer -strict $schemeid]) || ($cipherid ni [$o_patterncipherlib . cipherids]) || (![string is xdigit -strict $bucketid]) || ([string length $paybytes] != 3)} { |
|
lappend errors [expr {(![string is integer -strict $schemeid]) ? "bad schemeid" : ""}] |
|
lappend errors [expr {($cipherid ni [$o_patterncipherlib . cipherids]) ? "cipherid '$cipherid' unknown" : ""}] |
|
lappend errors [expr {(![string is xdigit -strict $bucketid]) ? "non-hex bucketid" : ""}] |
|
lappend errors [expr {([string length $paybytes] != 3) ? "paybytes len != 3" : ""}] |
|
set errors [lsearch -all -inline -not -exact $errors ""] ;#strip empty strings from error list |
|
return [list status 0 hdr_schemeid $schemeid hdr_cipherid $cipherid hdr_bucketid $bucketid hdr_paybytes $paybytes iv $cipheriv errors $errors] |
|
} |
|
|
|
#calculate payload length from paybytes |
|
#for now - hard code the schemes here |
|
set paylen_is_hex 0 |
|
set paylen_is_binary 0 |
|
if {$schemeid in {0 1}} { |
|
set paylen_is_hex 1 |
|
} elseif {$schemeid in {2 3}} { |
|
set paylen_is_binary 1 |
|
} else { |
|
error "schemeid $schemeid unimplemented" |
|
} |
|
|
|
if {$paylen_is_hex} { |
|
set paylen [scan $paybytes %x] |
|
} elseif {$paylen_is_binary} { |
|
#test create a paylen with something like: set bin [binary format c3 {0x00 0x01 0x0A} |
|
#H bigendian h smallendian |
|
binary scan $paylen H3 v ;# turn to hex such as 00010a |
|
set paylen [scan $v %x] ;# back to decimal |
|
} |
|
|
|
if {$bucketid != 0} { |
|
set bucketsize [dict get [$o_patterncipherlib . bucketsize_by_hex1] $bucketid] |
|
set padlen [expr {$bucketsize - 8 - $paylen}] |
|
} else { |
|
set bucketsize 0 |
|
set padlen [expr {[string length $ciphertext] - 8 - $paylen}] |
|
} |
|
|
|
return [list status 1 hdr_schemeid $schemeid hdr_cipherid $cipherid hdr_bucketid $bucketid hdr_paybytes $paybytes iv $cipheriv bucketsize $bucketsize paylen $paylen padlen $padlen errors [list]] ;#always return errors member even if empty |
|
|
|
} |
|
|
|
#todo - detect if ciphertext hasn't been retrieved |
|
>ciphermaster .. PatternMethod decrypt {} { |
|
error "(decrypt) Call decrypt_and_reset to verify after retrieving encrypted data with '. ciphertext'" |
|
} |
|
|
|
>ciphermaster .. PatternMethod decrypt_and_reset {} { |
|
var this o_ciphertoken o_cipherbin o_tailbuffer o_cipherpadding_numbytes |
|
var o_iv o_iv_bytes o_iv_static o_iv_method o_patterncipherlib o_cipherid o_algocommand |
|
|
|
if {![string length $o_cipherbin]} { |
|
error "No data to decrypt - call encrypt first. After one or more calls to encrypt ending with '. encrypt -last', retrieve '. ciphertext' and call decrypt_and_reset to retrieve/verify plaintext chunk." |
|
} |
|
$this . ciphertext_header_info $o_cipherbin .. As header_info |
|
if {([dict get $header_info status] != 1)} { |
|
if {([dict get $header_info hdr_cipherid] eq $o_cipherid ) && ([llength [dict get $header_info errors]])} { |
|
#A finalisation header has been written - but something went wrong |
|
error "(decrypt_and_reset) Something went wrong. Suggest calling '. abandon' and retrying. errors: [dict get $header_info errors]" |
|
} else { |
|
error "(decrypt_and_reset) Not yet retrievable - call '. encrypt <data_or_empty_string> -last 1' first." |
|
} |
|
} |
|
|
|
set bucketid [dict get $header_info hdr_bucketid] |
|
set bucketsize [dict get $header_info bucketsize] |
|
|
|
set padlen [dict get $header_info padlen] |
|
set paylen [dict get $header_info paylen] |
|
#sanity checks |
|
if {$o_cipherpadding_numbytes != $padlen} { |
|
puts stderr "WARNING!! stored o_cipherpadding_numbytes '$o_cipherpadding_numbytes' != '. ciphertext_header_info' padlen '$padlen'" |
|
} |
|
if {([string length $o_cipherbin] -8 -$padlen) != $paylen} { |
|
puts stderr "WARNING!! length of stored o_cipherbin - 8 '[expr {[string length $o_cipherbin] -8}]' != '.ciphertext_header_info' paylen '$paylen'" |
|
} |
|
|
|
puts stdout "------------------------------------------------------" |
|
puts stdout "About to decrypt: IV+encdata '[string range $o_cipherbin 8 80]...' with token $o_ciphertoken" |
|
puts stdout "------------------------------------------------------" |
|
set plaintext [${o_algocommand}::Decrypt $o_ciphertoken [string range $o_cipherbin 8 end]] ;#don't pass our #BFSXXXX- header to the ${o_algocommand} library |
|
puts stdout "full decrypted plaintext [string length $plaintext] bytes including iv and padding (padlen:$padlen paylen $paylen bucketsize: $bucketsize) :" |
|
puts stdout "------------------------------------------------------" |
|
puts stdout "$plaintext" |
|
puts stdout "------------------------------------------------------" |
|
|
|
#set padlength $o_cipherpadding_numbytes |
|
#reset |
|
|
|
#${o_algocommand}::Final $o_ciphertoken |
|
#set o_ciphertoken "" |
|
#set o_iv [$o_patterncipherlib . get_random_bytes $o_iv_bytes] |
|
if {!$o_iv_static} { |
|
set o_iv [{*}[concat $o_patterncipherlib . $o_iv_method]] |
|
} |
|
|
|
${o_algocommand}::Reset $o_ciphertoken $o_iv |
|
|
|
set o_cipherbin "" |
|
set o_tailbuffer "" |
|
set o_cipherpadding_numbytes 0 ;#important to reset this |
|
#strip iv and padding to recover original data |
|
return [string range $plaintext $o_iv_bytes end-$padlen] |
|
} |
|
|
|
>ciphermaster .. Destructor {} { |
|
var o_ciphertoken o_algocommand |
|
${o_algocommand}::Final $o_ciphertoken |
|
} |
|
|
|
} |
|
|
|
|
|
namespace eval ::patterncipher { |
|
|
|
set created_cipherpatterns [list] |
|
foreach ciphername [::patterncipher::libs::>lib_standard . ciphernames] { |
|
>pattern .. Create >cipher1 |
|
>cipher1 .. Variable o_ciphername $ciphername ;#for help method on the prototype object |
|
>cipher1 .. PatternVariable o_ciphername $ciphername |
|
>cipher1 .. Clone >$ciphername ;#clone brings along its default values |
|
>cipher1 .. Destroy |
|
|
|
>ciphermaster .. Clone >$ciphername |
|
lappend created_cipherpatterns [namespace current]::>$ciphername |
|
} |
|
puts stdout "Created patterncipher cipherpattern objects: $created_cipherpatterns" |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|