#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) # # >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 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::' 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 -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 -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 -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" }