Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Transposition Cipher

by pauloesb (Initiate)
on May 03, 2014 at 22:18 UTC ( #1084903=perlquestion: print w/ replies, xml ) Need Help??
pauloesb has asked for the wisdom of the Perl Monks concerning the following question:

Hello everybody, my name is Paul and I'm beginner in perl language. I'm doing a college work on the transposition cipher, and decided to do in Perl, because I enjoyed the language, but I'm having some problems of logic to solve this in the Perl language, could you guys could help me? I wrote an encryptor and decryptor transposition perl, apparently the encryption is working perfectly, but the decryption is not working, would you orient me about this problem? Follow the code below

Transposition Cipher
open KEYWORD, "<", "key.txt" or die $!; open CLEANTEXT, "<", "cleanText.txt" or die $!; open CIPHERTEXT, ">", "cipherText.txt" or die $!; my ($data, $n, $offset); my @cleanTextArray; while(($n = read CLEANTEXT, $data, 1)!=0) { push @cleanTextArray, $data; } my $textSize = $#cleanTextArray; $key = &to26(<KEYWORD>); # Get keys from command line # and transform to upper case. #$option = $ARGV[1]; $keylength = length($key); print "Length of key: $keylength --- "; @keylist = split(//, $key); # Split key into single # characters. print "Key: "; foreach $k (@keylist) {print "$k ";} print "\n"; $permut[0] = 0; for ($i = 1; $i < $keylength; $i++) { $j = 0; $found = 0; while (!$found) { if (($j >= $i) || ($keylist[$i] lt $keylist[$permut[$j]])) { splice(@permut, $j, 0, $i); # Insert $i at position $j $found = 1;} else {$j++;} } } print "Permutation:"; foreach $p (@permut) {print " $p";} print "\n"; my $lines = $keylength; my $columns = int($textSize/$keylength); if (($textSize % $keylength) > 0) { $columns += 1; } $matrixSize = $columns*$lines; print "Number of rows: $colums -- size of tableau: $matrixSize\n"; for ($i = $textSize; $i < $matrixSize; $i++) {$cleanTextArray[$i] = "0 +";} print "Arrangement of plaintext in columns:\n"; for ($i = 0; $i < $columns; $i++) { for ($j = 0; $j < $lines; $j++) { print "$cleanTextArray[$lines*$i + $j] "; } print "\n"; } for ($i = 0; $i < $columns; $i++) { for ($j = 0; $j < $lines; $j++) { print CIPHERTEXT "$cleanTextArray[$lines*$i + $ permut[$j]]"; } print "\n"; } close KEYWORD; close CLEANTEXT; close CIPHERTEXT; sub to26 { local($mytext) = $_[0]; # Get input string. # $mytext =~ tr/a-z/A-Z/; # Translate to upper case. $mytext =~ s/0/zero/g; # Numbers to verbal description. $mytext =~ s/1/um/g; $mytext =~ s/2/dois/g; $mytext =~ s/3/tres/g; $mytext =~ s/4/quatro/g; $mytext =~ s/5/cinco/g; $mytext =~ s/6/seis/g; $mytext =~ s/7/sete/g; $mytext =~ s/8/oito/g; $mytext =~ s/9/nove/g; return $mytext; }
Transposition Decipher
open KEYWORD, "<", "key.txt" or die $!; open CIPHERTEXT, "<", "cipherText.txt" or die $!; open DECIPHERTEXT, ">", "decipherText.txt" or die $!; my ($data, $n, $offset); my @cipherTextArray; while(($n = read CIPHERTEXT, $data, 1)!=0) { push @cipherTextArray, $data; } my $textSize = $#cipherTextArray; $key = &to26(<KEYWORD>); # Get keys from command line # and transform to upper case. #$option = $ARGV[1]; $keylength = length($key); print "Length of key: $keylength --- "; @keylist = split(//, $key); # Split key into single # characters. print "Key: "; foreach $k (@keylist) {print "$k ";} print "\n"; $permut[0] = 0; for ($i = 1; $i < $keylength; $i++) { $j = 0; $found = 0; while (!$found) { if (($j >= $i) || ($keylist[$i] lt $keylist[$permut[$j]])) { splice(@permut, $j, 0, $i); # Insert $i at position $j $found = 1;} else {$j++;} } } $invpermut[0] = 0; for ($i = 1; $i < $keylength; $i++) { $j = 0; $found = 0; while (!$found) { if (($j >= $i) || ($permut[$i] lt $permut[$invpermut[$j]])) { splice(@invpermut, $j, 0, $i); # Insert $i at position $j $found = 1;} else {$j++;} } } print "Permutation:"; foreach $p (@permut) {print " $p";} print "\n"; print "Inverse Permutation:"; foreach $p (@invpermut) {print " $p";} print "\n"; my $lines = $keylength; my $columns = int($textSize/$keylength); if (($textSize % $keylength) > 0) { $columns += 1; } $matrixSize = $columns*$lines; print "Number of rows: $colums -- size of tableau: $matrixSize\n"; for ($i = $textSize; $i < $matrixSize; $i++) {$cipherTextArray[$i] = " +0";} print "Arrangement of ciphertext in columns:\n"; for ($i = 0; $i < $columns; $i++) { for ($j = 0; $j < $lines; $j++) { print "$cipherTextArray[$lines*$i + $permut[$j]] "; } print "\n"; } print "Arrangement of deciphertext in columns: \n"; for ($i = 0; $i < $columns; $i++) { for ($j = 0; $j < $lines; $j++) { print "$cipherTextArray[$lines*$i + $invpermut[$j]]"; } print "\n"; } close KEYWORD; close CIPHERTEXT; close DECIPHERTEXT; sub to26 { local($mytext) = $_[0]; # Get input string. # $mytext =~ tr/a-z/A-Z/; # Translate to upper case. $mytext =~ s/0/zero/g; # Numbers to verbal description. $mytext =~ s/1/um/g; $mytext =~ s/2/dois/g; $mytext =~ s/3/tres/g; $mytext =~ s/4/quatro/g; $mytext =~ s/5/cinco/g; $mytext =~ s/6/seis/g; $mytext =~ s/7/sete/g; $mytext =~ s/8/oito/g; $mytext =~ s/9/nove/g; return $mytext; }
cleanTxt.txt contains "ola eu sou o paulo 1234567890" key.txt contains "secretmachine"

Comment on Transposition Cipher
Select or Download Code
Re: Transposition Cipher
by GrandFather (Cardinal) on May 04, 2014 at 02:10 UTC

    I started out thinking I would point out style and other issues with your code item by item, but instead I've essentially rewritten it rather than try to fix a whole series of (mostly small) issues.

    The key problem with your decrypt is that it is "indexing the wrong way round" so in effect it re-encrypts the encrypted text instead of decrypting it.

    I've changed the structure of the code so that it is clear that the encryption is block based so instead of breaking the plain text into characters, it breaks it into key length blocks and deals with those.

    #!user/bin/perl use warnings; use strict; my $plainTextIn = <<EOF; abcdefghijklmnopqrs1234567890 EOF my $keyTextIn = <<EOF; secretmachine EOF test('testing'); sub test { my ($testing) = @_; open my $plainIn, "<", \$plainTextIn; my $plainText = <$plainIn>; chomp $plainText; close $plainIn; open my $keyIn, "<", \$keyTextIn; my $key = to26(<$keyIn>, $testing); close $keyIn; my $cipherText = encrypt($key, $plainText, $testing); print ">>>>>>>>>>>>>\n" if $testing; my $decryptText = decrypt($key, $cipherText, $testing); print <<TEXT $plainText ----------- $cipherText ----------- $decryptText TEXT } sub encrypt { my ($key, $plainText, $testing) = @_; my $keylength = length ($key); my @blocks = $plainText =~ /(.{1,$keylength})/g; my $matrixSize = @blocks * $keylength; print "-- Length of key: $keylength --- Key: '$key'\n" if $testing +; print "-- Plain text: '$plainText'\n" if $testing +; my @permut = calcPermut($key); print "-- Permutation: @permut\n" if $testing; print "-- Size of tableau: $matrixSize\n" if $testing; $blocks[-1] .= '0' x ($keylength - length $blocks[-1]); # 0 pad +last block for my $line (@blocks) { print "-- '$line'\n" if $testing; $line = join '', map {substr $line, $permut[$_], 1} 0 .. $keyl +ength - 1; } return join '', @blocks; } sub decrypt { my ($key, $cipherText, $testing) = @_; my $keylength = length ($key); my @blocks = $cipherText =~ /(.{1,$keylength})/g; my $matrixSize = @blocks * $keylength; print "-- Length of key: $keylength --- Key: '$key'\n" if $testing +; print "-- Cipher text: '$cipherText'\n" if $testing +; my @permut = calcPermut($key); print "-- Permutation: @permut\n" if $testing; print "-- Size of tableau: $matrixSize\n" if $testing; for my $line (@blocks) { my @newLine; print "-- '$line'\n" if $testing; $newLine[$permut[$_]] = substr $line, 0, 1, '' for 0 .. $#perm +ut; $line = join '', @newLine; } return join '', @blocks; } sub to26 { my ($mytext, $testing) = @_; # Get input string. chomp $mytext; print "-- to26:'$mytext'\n" if $testing; $mytext =~ s/0/zero/g; # Numbers to verbal description. $mytext =~ s/1/um/g; $mytext =~ s/2/dois/g; $mytext =~ s/3/tres/g; $mytext =~ s/4/quatro/g; $mytext =~ s/5/cinco/g; $mytext =~ s/6/seis/g; $mytext =~ s/7/sete/g; $mytext =~ s/8/oito/g; $mytext =~ s/9/nove/g; return $mytext; } sub calcPermut { my ($key) = @_; my @keylist = split //, $key; my @permut; $permut[0] = 0; for my $i (1 .. @keylist - 1) { my $j = 0; while (1) { if (($j >= $i) || ($keylist[$i] lt $keylist[$permut[$j]])) + { splice (@permut, $j, 0, $i); # Insert $i at positio +n $j last; } $j++; } } return @permut; }

    Prints:

    -- to26:'secretmachine' -- Length of key: 13 --- Key: 'secretmachine' -- Plain text: 'abcdefghijklmnopqrs1234567890' -- Permutation: 7 2 8 1 4 12 9 10 6 11 3 0 5 -- Size of tableau: 39 -- 'abcdefghijklm' -- 'nopqrs1234567' -- '8900000000000' >>>>>>>>>>>>> -- Length of key: 13 --- Key: 'secretmachine' -- Cipher text: 'hcibemjkgldaf2p3or74516qns0009000000080' -- Permutation: 7 2 8 1 4 12 9 10 6 11 3 0 5 -- Size of tableau: 39 -- 'hcibemjkgldaf' -- '2p3or74516qns' -- '0009000000080' abcdefghijklmnopqrs1234567890 ----------- hcibemjkgldaf2p3or74516qns0009000000080 ----------- abcdefghijklmnopqrs12345678900000000000

    Update: removed unused sub show

    Perl is the programming world's equivalent of English

      Thank you very much GrandFather, i can see much better now with a modulated code, i couldn't see my error on code about this wrong indexing. I'm still having some issues to understand some parts, but i'm searching for the parts that i dont understand about Pearl Language in google. Thanks again...

        "I'm still having some issues to understand some parts, but i'm searching for the parts that i dont understand about Pearl Language in google."

        I'd recommend looking in http://perldoc.perl.org/perl.html, using perldoc from your command line, or searching this site with Super Search before reaching for a generic search engine.

        If there's anything you still don't understand, you can always ask here. If you give a link back to this thread, that will provide context for your question. Also, indicating what research you've already undertaken, and how the results of that were lacking, will get you a better answer: for instance, if you ask about X, you'll likely get replies about just X; if you say you've found X but not some specific aspect of X, you'll likely get replies about that specific aspect of X.

        By the way, if you search for "Pearl", you'll find information about oysters and necklaces. :-)

        -- Ken

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1084903]
Approved by GrandFather
Front-paged by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (14)
As of 2014-12-22 19:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (126 votes), past polls