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
#
# 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]
<> Package | Cryptography