# ACTIVESTATE TEAPOT-PKG BEGIN TM -*- tcl -*- # -- Tcl Module # @@ Meta Begin # Package tcl::transform::rot 1 # Meta as::build::date 2015-05-25 # Meta as::origin http://sourceforge.net/projects/tcllib # Meta category Reflected/virtual channel support # Meta description rot-encryption # Meta license BSD # Meta platform tcl # Meta require {Tcl 8.6} # Meta require tcl::transform::core # Meta subject {virtual channel} {channel transformation} rot13 rot # Meta subject decryption {tip 230} {caesar cipher} transformation # Meta subject {reflected channel} encryption cipher # Meta summary tcl::transform::rot # @@ Meta End # ACTIVESTATE TEAPOT-PKG BEGIN REQUIREMENTS package require Tcl 8.6 package require tcl::transform::core # ACTIVESTATE TEAPOT-PKG END REQUIREMENTS # ACTIVESTATE TEAPOT-PKG BEGIN DECLARE package provide tcl::transform::rot 1 # ACTIVESTATE TEAPOT-PKG END DECLARE # ACTIVESTATE TEAPOT-PKG END TM # -*- tcl -*- # # ## ### ##### ######## ############# # (C) 2009 Andreas Kupries # @@ Meta Begin # Package tcl::transform::rot 1 # Meta as::author {Andreas Kupries} # Meta as::copyright 2009 # Meta as::license BSD # Meta description Implementation of a rot # Meta description encryption transformation. Based on Tcl # Meta description 8.6's transformation reflection support. # Meta description The key byte is # Meta description configured at construction time. Exports # Meta description a single command adding a new # Meta description transformation of this type to a channel. # Meta description Two arguments, the channel to extend, # Meta description plus the key byte. # Meta description No result. # Meta platform tcl # Meta require tcl::transform::core # Meta require {Tcl 8.6} # @@ Meta End # # ## ### ##### ######## ############# package require Tcl 8.6 package require tcl::transform::core # # ## ### ##### ######## ############# namespace eval ::tcl::transform {} proc ::tcl::transform::rot {chan key} { ::chan push $chan [rot::implementation new $key] } oo::class create ::tcl::transform::rot::implementation { superclass tcl::transform::core ;# -> initialize, finalize, destructor # This transformation is intended for streaming operation. Seeking # the channel while it is active may cause undesirable # output. Proper behaviour may require the destruction of the # transform before seeking. method write {c data} { return [my Rot $data $key] } method read {c data} { return [my Rot $data $ikey] } # # ## ### ##### ######## ############# constructor {thekey} { set key [expr {$thekey % 26}] set ikey [expr {26 - $key}] return } # # ## ### ##### ######## ############# variable key ikey # # ## ### ##### ######## ############# method Rot {data key} { # rot'ation is done byte-wise. Note that we are having binary # data at this point, making it necessary to convert into # numbers (scan), and back (binary format). set result {} foreach d [split $data {}] { set dx [scan $d %c] if {(65 <= $dx) && ($dx <= 90)} { set n [binary format c \ [expr { (($dx - 65 + $key) % 26) + 65 }]] } elseif {(97 <= $dx) && ($dx <= 122)} { set n [binary format c \ [expr { (($dx - 97 + $key) % 26) + 97 }]] } else { set n $d } append result $n } return $result } } # # ## ### ##### ######## ############# package provide tcl::transform::rot 1 return