| Revision: | 1.2 |
| Committed: | Wed Jun 27 09:37:55 2007 UTC (17 years, 10 months ago) by eulisse |
| Content type: | application/x-perl |
| Branch: | MAIN |
| CVS Tags: | V01-03-47, V01-03-46, V01-03-45, V01-03-44, V01-03-43, V01-03-42, V01-03-41, V01-03-40, V01-03-39, V01-03-38, V01-03-37, V01-03-36, DBS_3_S2_0_pre2, V01-03-35, V01-03-34, V01-03-33, V01-03-32, V01-03-31, V01-03-30, V01-03-29, V01-03-28, V01-03-27, V01-03-26, V01-03-25, V01_03_25, V01-03-24, V01-03-23, V01-03-22, V01-03-21, V01-03-20, V01-03-19, V01-03-18, V01-03-17, V01-03-16, V01-03-15, V01-03-14, V01-03-13, V01-03-12, V01-03-11, V01-03-10, SiteDB_100708_1, V01-03-09, SiteDB_030608_1, V01-03-08, SiteDB_280508_1, V01-03-07, SiteDB_160408, V01-03-06, SiteDB_080408, V01-03-05, SiteDB_170308, SiteDB_160308, SiteDB_140308, SiteDB_120308, V01-03-04, V01-03-03, V01-03-02, SiteDB_080227, V01-03-01, V01-03-00, SiteDB_SM_Nightly_150208, SiteDB_SM_Nightly_070108, V01-02-04, V01-02-03, V01-02-02, V01-02-01, V01-02-00, V01-00-12, HEAD |
| Changes since 1.1: | +2 -2 lines |
| Error occurred while calculating annotation data. | |
| Log Message: | * uses /usr/bin/env perl rather than /usr/bin/perl in the shebang. |
| # | Content |
|---|---|
| 1 | #!/usr/bin/env perl |
| 2 | |
| 3 | ################################################################ |
| 4 | # crypttest.pl |
| 5 | # |
| 6 | # Version info: $Id: crypttest.pl,v 1.1 2007/02/07 11:46:11 dfeichti Exp $ |
| 7 | ################################################################ |
| 8 | |
| 9 | use Crypt::CBC; |
| 10 | use Carp; |
| 11 | use Getopt::Std; |
| 12 | use MIME::Base64; |
| 13 | use strict; |
| 14 | |
| 15 | |
| 16 | ##################################################### |
| 17 | # PARAMETERS |
| 18 | # |
| 19 | # we use a 56 byte key |
| 20 | my $key = 'abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabde'; |
| 21 | ##################################################### |
| 22 | |
| 23 | |
| 24 | sub usage { |
| 25 | print <<"EOF"; |
| 26 | usage: crypttest.pl -d/-e [-i iv-vector] "message" |
| 27 | options: |
| 28 | -e : encrypt |
| 29 | -d : decrypt |
| 30 | -i iv-vector : provide a 8 byte init vector for encryption |
| 31 | EOF |
| 32 | |
| 33 | } |
| 34 | |
| 35 | my $iv; |
| 36 | my $mode='e'; |
| 37 | |
| 38 | # OPTION PARSING |
| 39 | my %option=(); |
| 40 | getopts("edhi:",\%option); |
| 41 | |
| 42 | if (defined $option{h}) { |
| 43 | usage(); |
| 44 | exit(0); |
| 45 | } |
| 46 | |
| 47 | if (defined $option{e}) { |
| 48 | $mode='e'; |
| 49 | } |
| 50 | |
| 51 | if (defined $option{d}) { |
| 52 | $mode='d'; |
| 53 | } |
| 54 | |
| 55 | if (defined $option{i}) { |
| 56 | $iv = $option{i}; |
| 57 | } else { |
| 58 | $iv = Crypt::CBC->random_bytes(8); |
| 59 | } |
| 60 | |
| 61 | my $text = shift; |
| 62 | |
| 63 | die "Error: No text given" if ! $text; |
| 64 | die "Error: IV needs to have length = 8 " if length($iv) != 8; |
| 65 | |
| 66 | |
| 67 | my $cipher = Crypt::CBC->new( -cipher => 'Blowfish', |
| 68 | -literal_key => 1, |
| 69 | -key => $key, |
| 70 | -iv => $iv, |
| 71 | -header => 'none', |
| 72 | -blocksize => 8, |
| 73 | -keysize => 56 |
| 74 | -padding => 'standard' |
| 75 | ); |
| 76 | |
| 77 | |
| 78 | if ($mode eq 'e') { |
| 79 | my $encr = encrypt($text); |
| 80 | print ">$encr<\n"; |
| 81 | #print "Control check: Decrypted: " . decrypt($encr) . "\n"; |
| 82 | } else { |
| 83 | print ">" . decrypt($text) . "<\n"; |
| 84 | } |
| 85 | |
| 86 | exit 0; |
| 87 | |
| 88 | # we prepend the iv to the encryption |
| 89 | sub encrypt { |
| 90 | my $plain = shift; |
| 91 | |
| 92 | my $encr = $iv . $cipher->encrypt($plain); |
| 93 | my $encr64 = encode_base64($encr); |
| 94 | |
| 95 | chomp($encr64); |
| 96 | return $encr64 |
| 97 | } |
| 98 | |
| 99 | sub decrypt { |
| 100 | my $encr64 = shift; |
| 101 | |
| 102 | my $encr = decode_base64($encr64); |
| 103 | my $iv = substr($encr,0,8,""); |
| 104 | $cipher->set_initialization_vector($iv); |
| 105 | my $decr = $cipher->decrypt($encr); |
| 106 | |
| 107 | return $decr; |
| 108 | } |