Inspired by Re: Polyglot (crypto) which at first glance looked something like this, I implemented the famous Vigenère Cypher, once lauded as chifre indéchiffrable, in Perl.

The use of multiple rotating cipher alphabets, such as the 8-way used in Polyglot, was developed in an essay by Battista Alberti sometime during the 1460's.

Eventually in 1586, Blaise de Vigenère wove together the concepts written by Alberti, Trithemius, and Porta into a polished product, a truely revolutionary cipher.

This was the invention of the "Key", whereby knowing the algorithm is not enough, but the process (chart and pen in those days) was reused through different keys.

It was not broken until 1854 when Charles Babbage figured out that he could do n-way frequency analysis, where n is the number of chars in the key. The Brits kept that a secret until it was independantly invented by Friedrich Wilhelm Kasiski in 1863.

I suppose this was some blow to commerce, spys, and others who suddenly had their "unbreakable code" compromised. It was in the era where businessmen and generals started using secure communications via telegraph, much as we need SSL/TLS on some web pages today. It wasn't until typewriter-like machines (such as Enigma) came into being decades later that clerks could once again produce "unbreakable" encodings without undo effort or logistical problems.

—John

Here is the example from The Code Book encoded and decoded by this class: 

require 5.6.1;
use utf8;
use strict;
use warnings;
use Vigenere;

my $v= new Vigenere;
my $key= "white";

# print join ("\n", $v->print_square());

$v->set_key ($key);
my $s1= "divert troops to east ridge";
my $output= $v->encode ($s1);
print "plaintext : $s1\nciphertext: $output\n";

$v->set_key ($key);
my $decode= $v->decode ($output);
print "decoded   : $decode\n";

[download]
Here is the complete Perl module. Note that it can be instantiated with an arbitrary alphabet; it defaults to 'a'..'z'. 
=head1 NAME

Vigenere Cypher Module
 
=head1 SYNOPSIS

    use Vigenere;
    
    my $v= new Vigenere;
    my $key= "white";
    
    print join ("\n", $v->print_square());
    
    $v->set_key ($key);
    my $s1= "divert troops to east ridge";
    my $output= $v->encode ($s1);
    print "plaintext : $s1\nciphertext: $output\n";
    
    $v->set_key ($key);
    my $decode= $v->decode ($output);
    print "decoded   : $decode\n";

=head1 DESCRIPTION

This implements the Vigenere cypher, as described in chapter 2 of 
"The Code Book" by Simon Singh.

=head1 AUTHOR

John M. Dlugosz, john@dlugosz.com, http://www.dlugosz.com

=cut

use utf8;
package Vigenere;
use strict;
use warnings;

sub new
 {
 my ($class, $alphabet)= @_;
 $alphabet ||= join ('', 'a'..'z');
 my %table= _make_table ($alphabet);
 my %index= _make_index ($alphabet);
 my $self= bless {
    alphabet => $alphabet,
    table => \%table,
    index => \%index
    }, $class;
 }

sub set_key
 {
 my $self= shift;
 $self->{key}= shift;
 }
 
sub _make_table ($)
 {
 my @alphabet= split (//, shift);
 my %table;
 foreach (1.. scalar @alphabet) {
    my $L= shift @alphabet;
    push @alphabet, $L;
    $table{$alphabet[0]}= [ @alphabet ];
    }
 return %table;
 }

sub _make_index ($)
 {
 my @alphabet= split (//, shift);
 my %index;
 my $ord;
 foreach my $L (@alphabet) {
    $index{$L}= $ord++;
    }
 return %index;
 }

sub print_square
 {
 my $self= shift;
 my @results;
 push @results, "    $self->{alphabet}";
 foreach my $L (split(//,$self->{alphabet})) {
    my @row= @{$self->{table}{$L}};
    push @results, "$L - " . join ('', @row);
    }
 return @results;
 }

sub encode
 {
 my $self= shift;
 my $plaintext= shift;
 my $cyphertext;
 my $O;
 foreach my $C (split(//,$plaintext)) {
    # TODO: massage case, other transformations of input.
    my $N= $self->{index}{$C};
    if (defined $N) {
       my $K= $self->_nextkeychar();
       $O= $self->{table}{$K}[$N];
       }
    else {
       $O= $C;  # not in alphabet, pass through unchanged.
       }
    $cyphertext .= $O;
    }
 return $cyphertext;
 }

sub decode
 {
 my $self= shift;
 my $cyphertext= shift;
 my $plaintext;
 my $O;
 foreach my $C (split(//,$cyphertext)) {
    if ($self->{alphabet} =~ /\Q$C\E/) {
       my $K= $self->_nextkeychar();
       my $row= $self->{table}{$K};
       # OK, which position in this row matches $C ?
       my $N= _find_ord ($C, $row);
       $O= substr ($self->{alphabet}, $N, 1);
       }
    else {
       $O= $C;  # not in alphabet, pass through unchanged.
       }
    $plaintext .= $O;
    }
 return $plaintext;
 }

sub _find_ord ($$)
 {
 my ($C, $list)= @_;
 my $count= 0;
 foreach my $x (@$list) {
    return $count  if $x eq $C;
    ++$count;
    }
 }
 
sub _nextkeychar
 {
 my $self= shift;
 $self->{key} =~ s/^(.)(.*)$/$2$1/;
 return $1;
 }
 
1;  # loaded OK

[download]

Replies are listed 'Best First'.
Re: Vigenère Cypher
by beretboy (Chaplain) on Jun 23, 2001 at 03:13 UTC
    I'm Happy to see I have inspired something like this. ++ John M. Dlugosz
[reply]

Back to Cool Uses for Perl