home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / EncryptedHash.pm < prev    next >
Encoding:
Perl POD Document  |  2002-05-28  |  15.3 KB  |  452 lines
  1. #!/usr/bin/perl -s
  2. ##
  3. ## Tie::EncryptedHash - A tied hash with encrypted fields.
  4. ##
  5. ## Copyright (c) 2000, Vipul Ved Prakash.  All rights reserved.
  6. ## This code is based on Damian Conway's Tie::SecureHash.
  7. ##
  8. ## $Id: EncryptedHash.pm,v 1.8 2000/09/02 19:23:00 vipul Exp vipul $
  9. ## vi:expandtab=1;ts=4;
  10.  
  11. package Tie::EncryptedHash;
  12.     
  13. use strict;
  14. use vars qw($VERSION $strict);
  15. use Digest::MD5 qw(md5_base64);
  16. use Crypt::CBC;
  17. use Data::Dumper;
  18. use Carp;
  19.  
  20. ( $VERSION )  = '$Revision: 1.8 $' =~ /\s(\d+\.\d+)\s/; 
  21.  
  22. my $DEBUG = 0;
  23.  
  24. sub debug {
  25.     return undef unless $DEBUG;
  26.     my ($caller, undef) = caller;
  27.     my (undef,undef,$line,$sub) = caller(1); $sub =~ s/.*://;
  28.     $sub = sprintf "%10s()%4d",$sub,$line;
  29.     print "$sub   " . (shift) . "\n";
  30. }
  31.  
  32. # sub new {
  33. #   my ($class,%args) = @_;
  34. #   my %self = (); tie %self, $class;
  35. #     my $self = bless \%self, $class;
  36. #   $self->{__password} = $args{__password} if $args{__password};
  37. #   $self->{__cipher} = $args{__cipher} || qq{Blowfish};
  38. #     return $self;
  39. # }
  40.  
  41. sub new {
  42.     my ($class,%args) = @_;
  43.     my $self = {}; tie %$self, $class;
  44.     bless $self, $class;
  45.     $self->{__password} = $args{__password} if $args{__password};
  46.     $self->{__cipher} = $args{__cipher} || qq{Blowfish};
  47.     return $self;
  48. }
  49.  
  50.  
  51. sub _access {
  52.  
  53.     my ($self, $key, $caller, $file, $value, $delete) = @_;
  54.     my $class = ref $self || $self;
  55.                                           # SPECIAL ATTRIBUTE
  56.     if ( $key =~ /(__password|__hide|__scaffolding|__cipher)$/ ) {
  57.         my $key = $1;
  58.         unless($value||$delete) {return undef unless $caller eq $class}
  59.         if ($delete && ($key =~ /__password/)) { 
  60.           for (keys %{$$self{__scaffolding}}) {
  61.             if ( ref $self->{$_} ) { 
  62.               $self->{$_} = encrypt($self->{$_}, $self->{__scaffolding}{$_}, $self->{__cipher});
  63.               delete $self->{__scaffolding}{$_};  
  64.             }
  65.           }
  66.         }
  67.         delete $$self{$key} if $delete;
  68.         return $self->{$key} = $value if $value;
  69.         return $self->{$key};
  70.                                           # SECRET FIELD
  71.     } elsif ( $key =~ m/^(_{1}[^_][^:]*)$/ ||$key =~ m/.*?::(_{1}[^_][^:]*)/ ) {
  72.         my $ctext = $self->{$1}; 
  73.         if ( ref $ctext && !($value)) {   # ENCRYPT REF AT FETCH
  74.           my $pass = $self->{__scaffolding}{$1} || $self->{__password};
  75.           return undef unless $pass;
  76.           $self->{$1} = encrypt($ctext, $pass, $self->{__cipher});
  77.           return $self->FETCH ($1);
  78.         }
  79.         my $ptext = qq{}; my $isnot = !( exists $self->{$1} );  
  80.         my $auth = verify($self,$1);  
  81.         return undef if !($auth) && ref $self->{$1};
  82.         return undef if !($auth) && $self->{__hide};
  83.         if ($auth && $auth ne "1") { $ptext = $auth }
  84.         if ($value && $auth) {            # STORE 
  85.             if ( ref $value ) { 
  86.                 $self->{__scaffolding}{$1} = $self->{__password}; $ctext = $value;
  87.             } else { 
  88.               my $key = $1;
  89.               unless ($self->{__password}) {
  90.                 if ($value =~ m:^\S+\s\S{22}\s:) { 
  91.                   return $self->{$key} = $value;
  92.                 } else { return undef }
  93.               }
  94.               $ctext = encrypt($value, $self->{__password}, $self->{__cipher});
  95.             }
  96.             $self->{$1} = $ctext;
  97.             return $value;
  98.         } elsif ($auth && $delete) {      # DELETE
  99.             delete $$self{$1}   
  100.         } elsif ($isnot && (!($value))) { # DOESN'T EXIST
  101.            return;
  102.         } elsif ((!($auth)) && $ctext) { 
  103.             return $ctext;                # FETCH return ciphertext
  104.         } elsif ($auth && !($isnot)) {    # FETCH return plaintext
  105.             if (ref $ptext) { 
  106.                 $self->{$1} = $ptext;
  107.                 $self->{__scaffolding}{$1} = $self->{__password};  # Ref counting mechanism
  108.                 return $self->{$1};
  109.             }
  110.         } 
  111.         return undef unless $auth;
  112.         return $ptext;
  113.                                           # PUBLIC FIELD
  114.     } elsif ( $key =~ m/([^:]*)$/ || $key =~ m/.*?::([^:]*)/ )  {
  115.         $self->{$1} = $value if $value;
  116.         delete $$self{$1} if $delete;
  117.         return $self->{$1} if $self->{$1};
  118.         return undef;
  119.     }
  120.  
  121. }
  122.  
  123. sub encrypt {  # ($plaintext, $password, $cipher)
  124.     $_[0] = qq{REF }. Data::Dumper->new([$_[0]])->Indent(0)->Terse(0)->Purity(1)->Dumpxs if ref $_[0];
  125.     return  qq{$_[2] } . md5_base64($_[0]) .qq{ } . 
  126.             Crypt::CBC->new($_[1],$_[2])->encrypt_hex($_[0]) 
  127. }
  128.  
  129. sub decrypt { # ($cipher $md5sum $ciphertext, $password)
  130.     return undef unless $_[1];
  131.     my ($m, $d, $c) = split /\s/,$_[0]; 
  132.     my $ptext = Crypt::CBC->new($_[1],$m)->decrypt_hex($c);
  133.     my $check = md5_base64($ptext);
  134.     if ( $d eq $check ) {
  135.       if ($ptext =~ /^REF (.*)/is) { 
  136.         my ($VAR1,$VAR2,$VAR3,$VAR4,$VAR5,$VAR6,$VAR7,$VAR8);
  137.         return eval qq{$1}; 
  138.       }
  139.       return $ptext;  
  140.     }
  141. }
  142.  
  143. sub verify { # ($self, $key)
  144.     my ($self, $key) = splice @_,0,2;
  145.     # debug ("$self->{__scaffolding}{$key}, $self->{__password}, $self->{$key}");
  146.     return 1 unless $key =~ m:^_:;
  147.     return 1 unless exists $self->{$key};
  148.     return undef if ref $self->{$key} && ($self->{__scaffolding}{$key} ne 
  149.                     $self->{__password});
  150.     my $ptext = decrypt($self->{$key}, $self->{__password}); 
  151.     return $ptext if $ptext;
  152. }
  153.    
  154. sub each    { CORE::each %{$_[0]} }
  155. sub keys    { CORE::keys %{$_[0]} }
  156. sub values    { CORE::values %{$_[0]} }
  157. sub exists    { CORE::exists $_[0]->{$_[1]} }
  158.  
  159. sub TIEHASH    # ($class, @args)
  160. {
  161.     my $class = ref($_[0]) || $_[0];
  162.     my $self = bless {}, $class;
  163.     $self->{__password} = $_[1] if $_[1];
  164.     $self->{__cipher} = $_[2] || qq{Blowfish};
  165.     return $self;
  166. }
  167.  
  168. sub FETCH    # ($self, $key)
  169. {
  170.     my ($self, $key) = @_;
  171.     my $entry = _access($self,$key,(caller)[0..1]);
  172.     return $entry if $entry;
  173. }
  174.  
  175. sub STORE    # ($self, $key, $value)
  176. {
  177.     my ($self, $key, $value) = @_;
  178.     my $entry = _access($self,$key,(caller)[0..1],$value);
  179.     return $entry if $entry;
  180. }
  181.  
  182. sub DELETE    # ($self, $key)
  183. {
  184.     my ($self, $key) = @_;
  185.     return _access($self,$key,(caller)[0..1],'',1);
  186. }
  187.  
  188. sub CLEAR    # ($self)
  189. {
  190.     my ($self) = @_;
  191.     return undef if grep { ! $self->verify($_) } 
  192.                     grep { ! /__/ } CORE::keys %{$self};
  193.     %{$self} = ();
  194. }
  195.  
  196. sub EXISTS    # ($self, $key)
  197. {
  198.     my ($self, $key) = @_;
  199.     my @context = (caller)[0..1];
  200.     return _access($self,$key,@context) ? 1 : '';
  201. }
  202.  
  203. sub FIRSTKEY    # ($self)
  204. {
  205.     my ($self) = @_;
  206.     CORE::keys %{$self};
  207.     goto &NEXTKEY;
  208. }
  209.  
  210. sub NEXTKEY    # ($self)
  211. {
  212.     my $self = $_[0]; my $key;
  213.     my @context = (caller)[0..1];
  214.     while (defined($key = CORE::each %{$self})) {
  215.         last if eval { _access($self,$key,@context) }
  216.     }
  217.     return $key;
  218. }
  219.  
  220. sub DESTROY    # ($self)
  221. {
  222. }
  223.  
  224. 1;
  225. __END__
  226.  
  227.  
  228. =head1 NAME
  229.  
  230. Tie::EncryptedHash - Hashes (and objects based on hashes) with encrypting fields.
  231.  
  232. =head1 SYNOPSIS
  233.  
  234.     use Tie::EncryptedHash;
  235.  
  236.     my %s = ();
  237.     tie %s, Tie::EncryptedHash, 'passwd';
  238.  
  239.     $s{foo}  = "plaintext";     # Normal field, stored in plaintext.
  240.     print $s{foo};              # (plaintext)
  241.                                 
  242.     $s{_bar} = "signature";     # Fieldnames that begin in single
  243.                                 # underscore are encrypted.
  244.     print $s{_bar};             # (signature)  Though, while the password 
  245.                                 # is set, they behave like normal fields.
  246.     delete $s{__password};      # Delete password to disable access 
  247.                                 # to encrypting fields.
  248.     print $s{_bar};             # (Blowfish NuRVFIr8UCAJu5AWY0w...)
  249.  
  250.     $s{__password} = 'passwd';  # Restore password to gain access.
  251.     print $s{_bar};             # (signature)
  252.                                 
  253.     $s{_baz}{a}{b} = 42;        # Refs are fine, we encrypt them too.
  254.  
  255.  
  256. =head1 DESCRIPTION
  257.  
  258. Tie::EncryptedHash augments Perl hash semantics to build secure, encrypting
  259. containers of data.  Tie::EncryptedHash introduces special hash fields that
  260. are coupled with encrypt/decrypt routines to encrypt assignments at STORE()
  261. and decrypt retrievals at FETCH().  By design, I<encrypting fields> are
  262. associated with keys that begin in single underscore.  The remaining
  263. keyspace is used for accessing normal hash fields, which are retained
  264. without modification.
  265.  
  266. While the password is set, a Tie::EncryptedHash behaves exactly like a
  267. standard Perl hash.  This is its I<transparent mode> of access.  Encrypting
  268. and normal fields are identical in this mode.  When password is deleted,
  269. encrypting fields are accessible only as ciphertext.  This is
  270. Tie::EncryptedHash's I<opaque mode> of access, optimized for serialization.
  271.  
  272. Encryption is done with Crypt::CBC(3) which encrypts in the cipher block
  273. chaining mode with Blowfish, DES or IDEA.  Tie::EncryptedHash uses Blowfish
  274. by default, but can be instructed to employ any cipher supported by
  275. Crypt::CBC(3).
  276.  
  277. =head1 MOTIVATION
  278.  
  279. Tie::EncryptedHash was designed for storage and communication of key
  280. material used in public key cryptography algorithms.  I abstracted out the
  281. mechanism for encrypting selected fields of a structured data record because
  282. of the sheer convenience of this data security method.
  283.  
  284. Quite often, applications that require data confidentiality eschew strong
  285. cryptography in favor of OS-based access control mechanisms because of the
  286. additional costs of cryptography integration.  Besides cipher
  287. implementations, which are available as ready-to-deploy perl modules, use of
  288. cryptography in an application requires code to aid conversion and
  289. representation of encrypted data.  This code is usually encapsulated in a
  290. data access layer that manages encryption, decryption, access control and
  291. re-structuring of flat plaintext according to a data model.
  292. Tie::EncryptedHash provides these functions under the disguise of a Perl
  293. hash so perl applications can use strong cryptography without the cost of
  294. implementing a complex data access layer.
  295.  
  296.  
  297. =head1 CONSTRUCTION
  298.  
  299. =head2 Tied Hash  
  300.  
  301. C<tie %h, Tie::EncryptedHash, 'Password', 'Cipher';>
  302.  
  303. Ties %h to Tie::EncryptedHash and sets the value of password and cipher to
  304. 'Password' and 'Cipher'.  Both arguments are optional.
  305.  
  306. =head2 Blessed Object
  307.  
  308. C<$h = new Tie::EncryptedHash __password => 'Password', 
  309.                          __cipher => 'Cipher';>
  310.  
  311. The new() constructor returns an object that is both tied and blessed into
  312. Tie::EncryptedHash.  Both arguments are optional.  When used in this manner,
  313. Tie::EncryptedHash behaves like a class with encrypting data members.
  314.  
  315. =head1 RESERVED ATTRIBUTES
  316.  
  317. The attributes __password, __cipher and __hide are reserved for
  318. communication with object methods.  They are "write-only" from everywhere
  319. except the class to which the hash is tied.  __scaffolding is inaccessible.
  320. Tie::EncryptedHash stores the current encryption password and some transient
  321. data structures in these fields and restricts access to them on need-to-know
  322. basis.
  323.  
  324. =head2 __password
  325.  
  326. C<$h{__password} = "new password";
  327. delete $h{__password};>
  328.  
  329. The password is stored under the attribute C<__password>.  In addition to
  330. specifying a password at construction, assigning to the __password attribute
  331. sets the current encryption password to the assigned value.  Deleting the
  332. __password unsets it and switches the hash into opaque mode.
  333.  
  334. =head2 __cipher
  335.  
  336. C<$h{__cipher} = 'DES'; $h{__cipher} = 'Blowfish';>
  337.  
  338. The cipher used for encryption/decryption is stored under the attribute
  339. __cipher.  The value defaults to 'Blowfish'.
  340.  
  341. =head2 __hide
  342.  
  343. C<$h{__hide} = 1;>
  344.  
  345. Setting this attribute I<hides> encrypting fields in opaque mode.  'undef'
  346. is returned at FETCH() and EXISTS().
  347.  
  348. =head1 BEHAVIOR
  349.  
  350. =head2 References
  351.  
  352. A reference stored in an encrypting field is serialized before encryption.
  353. The data structure represented by the reference is folded into a single line
  354. of ciphertext which is stored under the first level key.  In the opaque
  355. mode, therefore, only the first level of keys of the hash will be visible.
  356.  
  357. =head2 Opaque Mode
  358.  
  359. The opaque mode introduces several other constraints on access of encrypting
  360. fields.  Encrypting fields return ciphertext on FETCH() unless __hide
  361. attribute is set, which forces Tie::EncryptedHash to behave as if encrypting
  362. fields don't exist.  Irrespective of __hide, however, DELETE() and CLEAR()
  363. fail in opaque mode.  So does STORE() on an existing encrypting field.
  364. Plaintext assignments to encrypting fields are silently ignored, but
  365. ciphertext assignments are fine.  Ciphertext assignments can be used to move
  366. data between different EncryptedHashes.
  367.  
  368. =head2 Multiple Passwords and Ciphers
  369.  
  370. Modality of Tie::EncryptedHash's access system breaks down when more than
  371. one password is used to with different encrypting fields.  This is a
  372. feature.  Tie::EncryptedHash lets you mix passwords and ciphers in the same
  373. hash.  Assign new values to __password and __cipher and create a new
  374. encrypting field.  Transparent mode will be restricted to fields encrypted
  375. with the current password.
  376.  
  377. =head2 Error Handling
  378.  
  379. Tie::Encrypted silently ignores access errors.  It doesn't carp/croak when
  380. you perform an illegal operation (like assign plaintext to an encrypting
  381. field in opaque mode).  This is to prevent data lossage, the kind that
  382. results from abnormal termination of applications.
  383.  
  384. =head1 QUIRKS 
  385.  
  386. =head2 Autovivification 
  387.  
  388. Due to the nature of autovivified references (which spring into existence
  389. when an undefined reference is dereferenced), references are stored as
  390. plaintext in transparent mode.  Analogous ciphertext representations are
  391. maintained in parallel and restored to encrypting fields when password is
  392. deleted.  This process is completely transparent to the user, though it's
  393. advisable to delete the password after the final assignment to a
  394. Tie::EncryptedHash.  This ensures plaintext representations and scaffolding
  395. data structures are duly flushed.
  396.  
  397. =head2 Data::Dumper
  398.  
  399. Serialization of references is done with Data::Dumper, therefore the nature
  400. of data that can be assigned to encrypting fields is limited by what
  401. Data::Dumper can grok.  We set $Data::Dumper::Purity = 1, so
  402. self-referential and recursive structures should be OK.
  403.  
  404. =head2 Speed 
  405.  
  406. Tie::EncryptedHash'es keep their contents encrypted as much as possible, so
  407. there's a rather severe speed penalty.  With Blowfish, STORE() on
  408. EncryptedHash can be upto 70 times slower than a standard perl hash.
  409. Reference STORE()'es will be quicker, but speed gain will be adjusted at
  410. FETCH().  FETCH() is about 35 times slower than a standard perl hash.  DES
  411. affords speed improvements of upto 2x, but is not considered secure for
  412. long-term storage of data.  These values were computed on a DELL PIII-300
  413. Mhz notebook with 128 Mb RAM running perl 5.003 on Linux 2.2.16.  Variations
  414. in speed might be different on your machine.
  415.  
  416. =head1 STANDARD USAGE
  417.  
  418. The standard usage for this module would be something along the lines of:
  419. populate Tie::EncryptedHash with sensitive data, delete the password,
  420. serialize the encrypted hash with Data::Dumper, store the result on disk or
  421. send it over the wire to another machine.  Later, when the sensitive data is
  422. required, procure the EncryptedHash, set the password and accesses the
  423. encrypted data fields.
  424.  
  425. =head1 SEE ALSO
  426.  
  427. Data::Dumper(3),
  428. Crypt::CBC(3),
  429. Crypt::DES(3),
  430. Crypt::Blowfish(3),
  431. Tie::SecureHash(3)
  432.  
  433. =head1 ACKNOWLEDGEMENTS
  434.  
  435. The framework of Tie::EncryptedHash derives heavily from Damian Conway's
  436. Tie::SecureHash.  Objects that are blessed as well as tied are just one of
  437. the pleasant side-effects of stealing Damian's code.  Thanks to Damian for
  438. this brilliant module.
  439.  
  440. PacificNet (http://www.pacificnet.net) loaned me the aforementioned notebook
  441. to hack from the comfort of my bed.  Thanks folks!
  442.  
  443. =head1 AUTHOR
  444.  
  445. Vipul Ved Prakash <mail@vipul.net>
  446.  
  447. =head1 LICENSE 
  448.  
  449. Artistic.
  450.  
  451.  
  452.