caesar

The Caesar cipher is a monoalphabetic cipher where the plaintext is encrypted by character substitution against a rotated alphabet. Supposedly first used by Julius Caesar and more recently popularised by usenet as rot13, the Wiki page of which has some interesting implementations as well (FW)..

References

M. Gardner, Codes, Ciphers, and Secret Writing, Dover Publications, Inc., 1972
http://www.trincoll.edu/depts/cpsc/cryptography/caesar.html

Usage

 % caesar::caesar -rot 3 {The Tcl'ers Wiki}
 Wkh Wfo'huv Zlnl
 % caesar::caesar -rot 3 -mode decode {Wkh Wfo'huv Zlnl}
 The Tcl'ers Wiki

 % caesar::rot13 {The Tcl'ers Wiki}
 Gur Gpy'ref Jvxv
 % caesar::rot13 -mode decode {Gur Gpy'ref Jvxv}
 The Tcl'ers Wiki

# caesar.tcl - Copyright (C) 2002 Pat Thoyts <[email protected]>
#
# Provide a Tcl only implementation of the caesar and ROT-13 cipher.
#
# The Caesar cipher is a monoalphabetic cipher where the plaintext is encrypted
# by character substitution against a rotated alphabet. Supposedly first used
# by Julius Caesar and more recently popularised by usenet as rot-13.
#
# Re:
#  M. Gardner, Codes, Ciphers, and Secret Writing, Dover Publications, Inc., 1972 
#  http://www.trincoll.edu/depts/cpsc/cryptography/caesar.html
#
# -------------------------------------------------------------------------
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# -------------------------------------------------------------------------
# @(#)$Id: 2885,v 1.15 2002-12-11 09:00:43 jcw Exp $
 
namespace eval caesar {
     namespace export caesar rot13
 
     # The rot13(1) cipher is simply the 13 rotation version of the caesar
     # cipher.
     interp alias {} [namespace current]::rot13 \
         {} [namespace current]::caesar -rotation 13
}
 
# -------------------------------------------------------------------------
# Description:
#  Tcl implementation of the Caesar algorithm. Takes the input data and
#  enciphers by mapping against a rotated alphabet. Ignores non-alphabetic
#  characters.
#
proc caesar::encode {s {n 13}} {
     set r {}
     binary scan $s c* d
     foreach {c} $d {
         append r [format %c [expr {
                        (($c ^ 0x40) & 0x5F) < 27 ? 
                        (((($c ^ 0x40) & 0x5F) + $n - 1) % 26 + 1) | ($c & 0xe0)
                        : $c
                    }]]
     }
     return $r
}
 
proc caesar::decode {s {n 13}} {
     set n [expr {abs($n - 26)}]
     return [encode $s $n]
}
 
# -------------------------------------------------------------------------
# Description:
#  Encrypt data using the caesar cipher (also known as rot or rot13). For this
#  cipher decryption is achieved by repeating the algorithm over the 
#  encrypted data.
# Notes:
#  insecure
#
proc caesar::caesar {args} {
     array set opts {filename {} rotation 13 mode encode}
     while {[string match -* [lindex $args 0]]} {
         switch -glob -- [lindex $args 0] {
             -m* {
                 set opts(mode) [lindex $args 1]
                 set args [lreplace $args 0 0]
             }                
             -r* {
                 set opts(rotation) [lindex $args 1]
                 set args [lreplace $args 0 0]
             }
             -f* {
                 set opts(filename) [lindex $args 1]
                 set args [lreplace $args 0 0]
             }
             -- {
                 set args [lreplace $args 0 0]
                 break
             }
             default {
                 return -code error "bad option [lindex $args 0]:\
                       must be -mode, -rotation, -filename or --"
             }
         }
         set args [lreplace $args 0 0]
     }
 
     if {$opts(filename) != {}} {
         set f [open $opts(filename) r]
         #fconfigure $f -translation binary
         set data [read $f]
         close $f
     } else {
         if {[llength $args] != 1} {
             return -code error "wrong \# args: should be\
                   \"caesar ?-mode mode? ?-rotation n? -file name | data\""
         }
         set data [lindex $args 0]
     }
 
     if {[string match "encode" $opts(mode)]} {
         return [encode $data $opts(rotation)]
     } else {
         return [decode $data $opts(rotation)]
     }
}
 
# -------------------------------------------------------------------------
 
package provide caesar 1.0
 
# -------------------------------------------------------------------------
#
# Local variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End:

RS: Here's my variation (use negative n to decode):

proc caesar {s {n 13}} {
    if {$n<0} {incr n 26}
    set from {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
    set to [concat [lrange $from $n end] [lrange $from 0 [expr {$n-1}]]]
    set map {}
    foreach i $from j $to {
        lappend map $i $j [string tolower $i] [string tolower $j]
    }
    string map $map $s
}

PT: Well it appear this version is about 25% faster than mine plus it has the advantage of being able to cope with alternative alphabets where mine is tied to ascii pretty firmly. Nice!

Reinhard Max proposed in the Tcl chatroom: rmax: If the same map is supposed to be used more than once it would be even faster if map generation was factored out.

rmax: ... or maps would be cached.

rmax: And for robustness the first line should read

 set n [expr {$n % 26}] ;# or even (after exchanging line 1 and 2) 
 set n [expr {$n % [llength $from]}]

Here's a fast but boring, unrolled version for rot13:

 interp alias {} caesar {} string map {
    A N a n B O b o C P c p D Q d q E R e r F S f s G T g t H U h u I V i v \
    J W j w K X k x L Y l y M Z m z N A n a O B o b P C p c Q D q d R E r e \
    S F s f T G t g U H u h V I v i W J w j X K x k Y L y l Z M z m} ;# RS

KBK - Monoalphabetic substitutions are quite easily broken by statistical methods. Solving cryptograms written in such ciphers isn't at all difficult.

See also vignere, rot13, uuencode, base64

Category Package

Category Cryptography