Bivio::Type::Secret
# Copyright (c) 1999-2007 bivio Software, Inc. All rights reserved. # $Id$ package Bivio::Type::Secret; use strict; use Bivio::Base 'Bivio::Type::String'; use Bivio::Die; use Bivio::IO::Config; use Bivio::IO::TTY; use Bivio::IO::Trace; use Bivio::MIME::Base64; use Bivio::TypeError; use Crypt::CBC; # C<Bivio::Type::Secret> encrypts its values before storing in the DB. The key # is prompted if the configuration param I<prompt> is set to true. Prompting at # program startup if $ENV{MOD_PERL} is set or at first use if not. # # Database fields must be VARCHAR(4000) to allow for encryption expansion. # # Subclasses should define L<get_width|"get_width"> to be the value # that the user enters. our($_TRACE); my($_CFG); my($_DEFAULT_VALUES) = { magic => 'X', algorithm => 'DES', }; Bivio::IO::Config->register({ prompt => 0, cipher => [], }); sub decrypt_hex { my(undef, $encoded_hex) = @_; # Decrypts I<encoded_hex> and returns plain text. If there is an # error decrypting, returns C<undef>. If I<encoded_hex> is C<undef>, # returns C<undef>. return _decrypt($encoded_hex, 1); } sub decrypt_http_base64 { my($proto, $encoded_http_base64) = @_; # Same as L<decrypt_hex|"decrypt_hex"> but encodes with # L<Bivio::MIME::Base64|Bivio::MIME::Base64>. return _decrypt($encoded_http_base64, 0); } sub encrypt_hex { my($proto, $clear_text) = @_; # Encrypts I<clear_text> and returns encoded data in hex string. # If I<clear_text> is C<undef>, returns C<undef>. return _encrypt($clear_text, 1); } sub encrypt_http_base64 { my($proto, $clear_text) = @_; # Same as L<encrypt_hex|"encrypt_hex"> but encodes with # L<Bivio::MIME::Base64|Bivio::MIME::Base64>. return _encrypt($clear_text, 0); } sub from_sql_column { my($proto, $value) = @_; # Returns the string for this value. Dies if there is an error parsing # the column from the database. return undef unless $value; my($s) = $proto->decrypt_hex($value); return $s if defined($s); # There is a configuration error if we can't decrypt values from DB Bivio::Die->throw('CONFIG_ERROR', { entity => 'key', class => __PACKAGE__, message => 'unable to decrypt value', }); # DOES NOT RETURN } sub handle_config { my(undef, $cfg) = @_; # key : string (required) # # The way we encrypt the data. # # prompt : boolean [0] # # Do we need to prompt for a passphrase to decrypt I<key>? # # magic : string ['X'] # # Should be short and non-numeric. Placed on both ends of string # to "ensure" decryption worked. # # algorithm : string ['DES'] # # Encryption algorithm. # # cipher : array_ref [] # # A list of (key, magic, algorithm) keyed hashes. When decrypting, # the ciphers are applied in order until a match is found. # When encrypting the first value is used. $_CFG = $cfg; # if no ciphers defined, use the root config values if (defined($_CFG->{key}) && int(@{$_CFG->{cipher}}) == 0) { $_CFG->{cipher} = [{ map({ $_ => $_CFG->{$_}, } (qw(key magic algorithm))), }]; } foreach my $cipher (@{$_CFG->{cipher}}) { Bivio::Die->die('missing key, ', $cipher) unless defined($cipher->{key}); foreach my $field (qw(magic algorithm)) { next if defined($cipher->{$field}); $cipher->{$field} = $_DEFAULT_VALUES->{$field}; } } _init_cipher() if $ENV{MOD_PERL}; return; } sub is_secure_data { # All secrets must be displayed/managed in a secure context. return 1; } sub to_sql_param { my($proto, $value) = @_; # Return the string of I<value>. return $proto->encrypt_hex($value); } sub _assert_cipher { # If cypher doesn't exist, blows up. return if ref(_default_cipher()->{key}) || _init_cipher(); Bivio::Die->throw('CONFIG_ERROR', { entity => 'key', class => __PACKAGE__, message => 'no cipher configured', }); # DOES NOT RETURN } sub _call { my($cipher, $method, @args) = @_; return Bivio::Die->eval(sub {$cipher->{key}->$method(@args)}); } sub _cbc_new { my($key) = shift; my($algorithm) = shift->{algorithm}; return Crypt::CBC->new( Crypt::CBC->can('header_mode') ? ( -key => $key, -cipher => $algorithm, -header => 'randomiv', ) : ( $key, $algorithm, ) ); } sub _decrypt { my($encoded, $is_hex) = @_; # Decrypts $encoded based on $is_hex. return undef unless defined($encoded); _assert_cipher(); # Decrypt and make sure surrounded by magic and a time not before now foreach my $cipher (@{$_CFG->{cipher}}) { next unless ref($cipher->{key}); my($s) = ($is_hex ? _call($cipher, decrypt_hex => $encoded) : _call($cipher, decrypt => Bivio::MIME::Base64->http_decode($encoded) || '')) || ''; my($magic) = $cipher->{magic}; unless ($s =~ s/^\Q$magic\E//o && $s =~ s/\Q$magic\E(\d+)$//o && time >= $1) { _trace('cipher failed, trying next one') if $_TRACE; next; } _trace('cipher sucessful') if $_TRACE; return $s; } return undef; } sub _decrypt_key { my($cipher, $phrase, $key_in) = @_; # Returns the key or undef. $cipher->{key} = undef; # Use this module to decrypt the key. Protect against die, so # cipher can be reset. my($key_out) = Bivio::Die->eval( sub { $cipher->{key} = _cbc_new($phrase, $cipher); return __PACKAGE__->from_sql_column($key_in); }); $cipher->{key} = undef; Bivio::IO::Alert->warn('unable to decrypt key in config: ', $@) if $@; return $key_out; } sub _default_cipher { # Returns the default cipher. return $_CFG->{cipher}->[0]; } sub _encrypt { my($clear_text, $is_hex) = @_; # Encrypts $clear_text based on $is_hex. return undef unless defined($clear_text); _assert_cipher(); # Surround with magic and trailing time and encrypt my($cipher) = _default_cipher(); my($v) = $cipher->{magic} . $clear_text . $cipher->{magic} . time; return $is_hex ? $cipher->{key}->encrypt_hex($v) : Bivio::MIME::Base64->http_encode($cipher->{key}->encrypt($v)); } sub _init_cipher { # Initializes the cipher. return 0 unless defined(_default_cipher()->{key}); my($phrase); foreach my $cipher (@{$_CFG->{cipher}}) { my($key) = $cipher->{key}; $cipher->{key} = undef; if ($_CFG->{prompt}) { $phrase ||= Bivio::IO::TTY->read_password( __PACKAGE__ . ' passphrase: '); unless (defined($phrase)) { Bivio::IO::Alert->warn('unable to open /dev/tty for key'); return 0; } $key = _decrypt_key($cipher, $phrase, $key); } return 0 unless $key; $cipher->{key} = _cbc_new($key, $cipher); } return 1; } 1;