#line 1 "Crypt/CBC.pm"
package Crypt::CBC;

use Digest::MD5 'md5';
use Carp;
use strict;
use bytes;
use vars qw($VERSION);
$VERSION = '2.33';

use constant RANDOM_DEVICE => '/dev/urandom';

sub new {
    my $class = shift;

    my $options = {};

    # hashref arguments
    if (ref $_[0] eq 'HASH') {
      $options = shift;
    }

    # CGI style arguments
    elsif ($_[0] =~ /^-[a-zA-Z_]{1,20}$/) {
      my %tmp = @_;
      while ( my($key,$value) = each %tmp) {
	$key =~ s/^-//;
	$options->{lc $key} = $value;
      }
    }

    else {
	$options->{key}    = shift;
	$options->{cipher} = shift;
    }

    my $cipher_object_provided = $options->{cipher} && ref $options->{cipher};

    # "key" is a misnomer here, because it is actually usually a passphrase that is used
    # to derive the true key
    my $pass = $options->{key};

    if ($cipher_object_provided) {
      carp "Both a key and a pre-initialized Crypt::* object were passed. The key will be ignored"
	if defined $pass;
      $pass ||= '';
    }
    elsif (!defined $pass) {
      croak "Please provide an encryption/decryption passphrase or key using -key"
    }

    # header mode
    my %valid_modes = map {$_=>1} qw(none salt randomiv);
    my $header_mode     = $options->{header};
    $header_mode      ||= 'none'     if exists $options->{prepend_iv} && !$options->{prepend_iv};
    $header_mode      ||= 'none'     if exists $options->{add_header} && !$options->{add_header};
    $header_mode      ||= 'salt';    # default
    croak "Invalid -header mode '$header_mode'" unless $valid_modes{$header_mode};

    croak "The -salt argument is incompatible with a -header mode of $header_mode"
      if exists $options->{salt} && $header_mode ne 'salt';

    my $cipher = $options->{cipher};
    $cipher = 'Crypt::DES' unless $cipher;
    my $cipherclass = ref $cipher || $cipher;

    unless (ref $cipher) {  # munge the class name if no object passed
      $cipher = $cipher=~/^Crypt::/ ? $cipher : "Crypt::$cipher";
      $cipher->can('encrypt') or eval "require $cipher; 1" or croak "Couldn't load $cipher: $@";
      # some crypt modules use the class Crypt::, and others don't
      $cipher =~ s/^Crypt::// unless $cipher->can('keysize');
    }

    # allow user to override these values
    my $ks        = $options->{keysize};
    my $bs        = $options->{blocksize};

    # otherwise we get the values from the cipher
    $ks ||= eval {$cipher->keysize};
    $bs ||= eval {$cipher->blocksize};

    # Some of the cipher modules are busted and don't report the
    # keysize (well, Crypt::Blowfish in any case).  If we detect
    # this, and find the blowfish module in use, then assume 56.
    # Otherwise assume the least common denominator of 8.
    $ks ||= $cipherclass =~ /blowfish/i ? 56 : 8;
    $bs ||= $ks;

    my $pcbc = $options->{'pcbc'};

    # Default behavior is to treat -key as a passphrase.
    # But if the literal_key option is true, then use key as is
    croak "The options -literal_key and -regenerate_key are incompatible with each other" 
      if exists $options->{literal_key} && exists $options->{regenerate_key};
    my $key;
    $key     = $pass if $options->{literal_key};
    $key     = $pass if exists $options->{regenerate_key} && !$options->{regenerate_key};

    # Get the salt.
    my $salt        = $options->{salt};
    my $random_salt = 1 unless defined $salt && $salt ne '1';
    croak "Argument to -salt must be exactly 8 bytes long" if defined $salt && length $salt != 8 && $salt ne '1';

    # note: iv will be autogenerated by start() if not specified in options
    my $iv = $options->{iv};
    my $random_iv = 1 unless defined $iv;
    croak "Initialization vector must be exactly $bs bytes long when using the $cipherclass cipher" if defined $iv and length($iv) != $bs;

    my $literal_key = $options->{literal_key} || (exists $options->{regenerate_key} && !$options->{regenerate_key});
    my $legacy_hack = $options->{insecure_legacy_decrypt};
    my $padding     = $options->{padding} || 'standard';

    if ($padding && ref($padding) eq 'CODE') {
      # check to see that this code does its padding correctly
      for my $i (1..$bs-1) {
	my $rbs = length($padding->(" "x$i,$bs,'e'));
	croak "padding method callback does not behave properly: expected $bs bytes back, got $rbs bytes back." 
	  unless ($rbs == $bs);
      }
    } else {
      $padding = $padding eq 'none'           ? \&_no_padding
	        :$padding eq 'null'           ? \&_null_padding
	        :$padding eq 'space'          ? \&_space_padding
		:$padding eq 'oneandzeroes'   ? \&_oneandzeroes_padding
		:$padding eq 'rijndael_compat'? \&_rijndael_compat
                :$padding eq 'standard'       ? \&_standard_padding
	        :croak "'$padding' padding not supported.  See perldoc Crypt::CBC for instructions on creating your own.";
    }

    # CONSISTENCY CHECKS
    # HEADER consistency
    if ($header_mode eq 'salt') {
      croak "Cannot use salt-based key generation if literal key is specified"
	if $options->{literal_key};
      croak "Cannot use salt-based IV generation if literal IV is specified"
	if exists $options->{iv};
    }
    elsif ($header_mode eq 'randomiv') {
      croak "Cannot encrypt using a non-8 byte blocksize cipher when using randomiv header mode"
	unless $bs == 8 || $legacy_hack;
    }
    elsif ($header_mode eq 'none') {
      croak "You must provide an initialization vector using -iv when using -header=>'none'"
	unless exists $options->{iv};
    }

    # KEYSIZE consistency
    if (defined $key && length($key) != $ks) {
      croak "If specified by -literal_key, then the key length must be equal to the chosen cipher's key length of $ks bytes";
    }

    # IV consistency
    if (defined $iv && length($iv) != $bs) {
      croak "If specified by -iv, then the initialization vector length must be equal to the chosen cipher's blocksize of $bs bytes";
    }


    return bless {'cipher'      => $cipher,
		  'passphrase'  => $pass,
		  'key'         => $key,
		  'iv'          => $iv,
		  'salt'        => $salt,
		  'padding'     => $padding,
		  'blocksize'   => $bs,
		  'keysize'     => $ks,
                  'header_mode' => $header_mode,
		  'legacy_hack' => $legacy_hack,
                  'literal_key' => $literal_key,
                  'pcbc'        => $pcbc,
		  'make_random_salt' => $random_salt,
		  'make_random_iv'   => $random_iv,
		  },$class;
}

sub encrypt (\$$) {
    my ($self,$data) = @_;
    $self->start('encrypting');
    my $result = $self->crypt($data);
    $result .= $self->finish;
    $result;
}

sub decrypt (\$$){
    my ($self,$data) = @_;
    $self->start('decrypting');
    my $result = $self->crypt($data);
    $result .= $self->finish;
    $result;
}

sub encrypt_hex (\$$) {
    my ($self,$data) = @_;
    return join('',unpack 'H*',$self->encrypt($data));
}

sub decrypt_hex (\$$) {
    my ($self,$data) = @_;
    return $self->decrypt(pack'H*',$data);
}

# call to start a series of encryption/decryption operations
sub start (\$$) {
    my $self = shift;
    my $operation = shift;
    croak "Specify <e>ncryption or <d>ecryption" unless $operation=~/^[ed]/i;

    $self->{'buffer'} = '';
    $self->{'decrypt'} = $operation=~/^d/i;
}

# call to encrypt/decrypt a bit of data
sub crypt (\$$){
    my $self = shift;
    my $data = shift;

    my $result;

    croak "crypt() called without a preceding start()"
      unless exists $self->{'buffer'};

    my $d = $self->{'decrypt'};

    unless ($self->{civ}) { # block cipher has not yet been initialized
      $result = $self->_generate_iv_and_cipher_from_datastream(\$data)      if $d;
      $result = $self->_generate_iv_and_cipher_from_options()           unless $d;
    }

    my $iv = $self->{'civ'};
    $self->{'buffer'} .= $data;

    my $bs = $self->{'blocksize'};

    croak "When using no padding, plaintext size must be a multiple of $bs"
      if $self->{'padding'} eq \&_no_padding
	and length($data) % $bs;

    croak "When using rijndael_compat padding, plaintext size must be a multiple of $bs"
      if $self->{'padding'} eq \&_rijndael_compat
	and length($data) % $bs;

    return $result unless (length($self->{'buffer'}) >= $bs);

    my @blocks = unpack("a$bs "x(int(length($self->{'buffer'})/$bs)) . "a*", $self->{'buffer'});
    $self->{'buffer'} = '';

    if ($d) {  # when decrypting, always leave a free block at the end
      $self->{'buffer'} = length($blocks[-1]) < $bs ? join '',splice(@blocks,-2) : pop(@blocks);
    } else {
      $self->{'buffer'} = pop @blocks if length($blocks[-1]) < $bs;  # what's left over
    }

    foreach my $block (@blocks) {
      if ($d) { # decrypting
	$result .= $iv = $iv ^ $self->{'crypt'}->decrypt($block);
	$iv = $block unless $self->{pcbc};
      } else { # encrypting
	$result .= $iv = $self->{'crypt'}->encrypt($iv ^ $block);
      }
      $iv = $iv ^ $block if $self->{pcbc};
    }
    $self->{'civ'} = $iv;	        # remember the iv
    return $result;
}

# this is called at the end to flush whatever's left
sub finish (\$) {
    my $self = shift;
    my $bs    = $self->{'blocksize'};
    my $block = defined $self->{'buffer'} ? $self->{'buffer'} : '';

    $self->{civ} ||= '';

    my $result;
    if ($self->{'decrypt'}) { #decrypting
	$block = length $block ? pack("a$bs",$block) : ''; # pad and truncate to block size
	
	if (length($block)) {
	  $result = $self->{'civ'} ^ $self->{'crypt'}->decrypt($block);
	  $result = $self->{'padding'}->($result, $bs, 'd');
	} else {
	  $result = '';
	}

    } else { # encrypting
      $block  = $self->{'padding'}->($block,$bs,'e') || '';
      $result = length $block ? $self->{'crypt'}->encrypt($self->{'civ'} ^ $block) : '';
    }
    delete $self->{'civ'};
    delete $self->{'buffer'};
    return $result;
}

# this subroutine will generate the actual {en,de}cryption key, the iv
# and the block cipher object.  This is called when reading from a datastream
# and so it uses previous values of salt or iv if they are encoded in datastream
# header
sub _generate_iv_and_cipher_from_datastream {
  my $self         = shift;
  my $input_stream = shift;
  my $bs           = $self->blocksize;

  # use our header mode to figure out what to do with the data stream
  my $header_mode = $self->header_mode;

  if ($header_mode eq 'none') {
    croak "You must specify a $bs byte initialization vector by passing the -iv option to new() when using -header_mode=>'none'"
      unless exists $self->{iv};
    $self->{civ}   = $self->{iv};   # current IV equals saved IV
    $self->{key} ||= $self->_key_from_key($self->{passphrase});
  }

  elsif ($header_mode eq 'salt') {
    my ($salt) = $$input_stream =~ /^Salted__(.{8})/s;
    croak "Ciphertext does not begin with a valid header for 'salt' header mode" unless defined $salt;
    $self->{salt} = $salt;          # new salt
    substr($$input_stream,0,16) = '';
    my ($key,$iv) = $self->_salted_key_and_iv($self->{passphrase},$salt);
    $self->{iv} = $self->{civ}  = $iv;
    $self->{key}  = $key;
  }

  elsif ($header_mode eq 'randomiv') {
    my ($iv) = $$input_stream =~ /^RandomIV(.{8})/s;
    croak "Ciphertext does not begin with a valid header for 'randomiv' header mode" unless defined $iv;
    croak "randomiv header mode cannot be used securely when decrypting with a >8 byte block cipher.\nUse the -insecure_legacy_decrypt flag if you are sure you want to do this" unless $self->blocksize == 8 || $self->legacy_hack;
    $self->{iv} = $self->{civ} = $iv;
    $self->{key} = $self->_key_from_key($self->{passphrase});
    undef $self->{salt};  # paranoia
    substr($$input_stream,0,16) = ''; # truncate
  }

  else {
    croak "Invalid header mode '$header_mode'";
  }

  # we should have the key and iv now, or we are dead in the water
  croak "Cipher stream did not contain IV or salt, and you did not specify these values in new()"
    unless $self->{key} && $self->{civ};

  # now we can generate the crypt object itself
  $self->{crypt} = ref $self->{cipher} ? $self->{cipher}
                                       : $self->{cipher}->new($self->{key})
					 or croak "Could not create $self->{cipher} object: $@";
  return '';
}

sub _generate_iv_and_cipher_from_options {
  my $self   = shift;
  my $blocksize = $self->blocksize;

  my $result = '';

  my $header_mode = $self->header_mode;
  if ($header_mode eq 'none') {
    croak "You must specify a $blocksize byte initialization vector by passing the -iv option to new() when using -header_mode=>'none'"
      unless exists $self->{iv};
    $self->{civ}   = $self->{iv};
    $self->{key} ||= $self->_key_from_key($self->{passphrase});
  }

  elsif ($header_mode eq 'salt') {
    $self->{salt} = $self->_get_random_bytes(8) if $self->{make_random_salt};
    defined (my $salt = $self->{salt}) or croak "No header_mode of 'salt' specified, but no salt value provided"; # shouldn't happen
    length($salt) == 8 or croak "Salt must be exactly 8 bytes long";
    my ($key,$iv) = $self->_salted_key_and_iv($self->{passphrase},$salt);
    $self->{key}  = $key;
    $self->{civ}  = $self->{iv} = $iv;
    $result  = "Salted__${salt}";
  }

  elsif ($header_mode eq 'randomiv') {
    croak "randomiv header mode cannot be used when encrypting with a >8 byte block cipher. There is no option to allow this"
      unless $blocksize == 8;
    $self->{key} ||= $self->_key_from_key($self->{passphrase});
    $self->{iv}    = $self->_get_random_bytes(8) if $self->{make_random_iv};
    length($self->{iv}) == 8 or croak "IV must be exactly 8 bytes long when used with header mode of 'randomiv'";
    $self->{civ}   = $self->{iv};
    $result = "RandomIV$self->{iv}";
  }

  croak "key and/or iv are missing" unless defined $self->{key} && defined $self->{civ};

  $self->_taintcheck($self->{key});
  $self->{crypt} = ref $self->{cipher} ? $self->{cipher}
                                       : $self->{cipher}->new($self->{key})
					 or croak "Could not create $self->{cipher} object: $@";
  return $result;
}

sub _taintcheck {
    my $self = shift;
    my $key  = shift;
    return unless ${^TAINT};

    my $has_scalar_util = eval "require Scalar::Util; 1";
    my $tainted;


    if ($has_scalar_util) {
	$tainted = Scalar::Util::tainted($key);
    } else {
	local($@, $SIG{__DIE__}, $SIG{__WARN__});
	local $^W = 0;
	eval { kill 0 * $key };
	$tainted = $@ =~ /^Insecure/;
    }

    croak "Taint checks are turned on and your key is tainted. Please untaint the key and try again"
	if $tainted;
}

sub _key_from_key {
  my $self  = shift;
  my $pass  = shift;
  my $ks    = $self->{keysize};

  return $pass if $self->{literal_key};

  my $material = md5($pass);
  while (length($material) < $ks)  {
    $material .= md5($material);
  }
  return substr($material,0,$ks);
}

sub _salted_key_and_iv {
  my $self = shift;
  my ($pass,$salt)  = @_;

  croak "Salt must be 8 bytes long" unless length $salt == 8;

  my $key_len = $self->{keysize};
  my $iv_len  = $self->{blocksize};

  my $desired_len = $key_len+$iv_len;

  my $data  = '';
  my $d = '';

  while (length $data < $desired_len) {
    $d = md5($d . $pass . $salt);
    $data .= $d;
  }
  return (substr($data,0,$key_len),substr($data,$key_len,$iv_len));
}

sub random_bytes {
  my $self  = shift;
  my $bytes = shift or croak "usage: random_bytes(\$byte_length)";
  $self->_get_random_bytes($bytes);
}

sub _get_random_bytes {
  my $self   = shift;
  my $length = shift;
  my $result;

  if (-r RANDOM_DEVICE && open(F,RANDOM_DEVICE)) {
    read(F,$result,$length);
    close F;
  } else {
    $result = pack("C*",map {rand(256)} 1..$length);
  }
  # Clear taint and check length
  $result =~ /^(.+)$/s;
  length($1) == $length or croak "Invalid length while gathering $length random bytes";
  return $1;
}

sub _standard_padding ($$$) {
  my ($b,$bs,$decrypt) = @_;
  $b = length $b ? $b : '';
  if ($decrypt eq 'd') {
    my $pad_length = unpack("C",substr($b,-1));

    # sanity check for implementations that don't pad correctly
    return $b unless $pad_length >= 0 && $pad_length <= $bs;
    my @pad_chars = unpack("C*",substr($b,-$pad_length));
    return $b if grep {$pad_length != $_} @pad_chars;

    return substr($b,0,$bs-$pad_length);
  }
  my $pad = $bs - length($b) % $bs;
  return $b . pack("C*",($pad)x$pad);
}

sub _space_padding ($$$) {
  my ($b,$bs,$decrypt) = @_;
  return unless length $b;
  $b = length $b ? $b : '';
  if ($decrypt eq 'd') {
     $b=~ s/ *\z//s;
     return $b;
  }
  return $b . pack("C*", (32) x ($bs - length($b) % $bs));
}

sub _no_padding ($$$) {
  my ($b,$bs,$decrypt) = @_;
  return $b;
}

sub _null_padding ($$$) {
  my ($b,$bs,$decrypt) = @_;
  return unless length $b;
  $b = length $b ? $b : '';
  if ($decrypt eq 'd') {
     $b=~ s/\0*\z//s;
     return $b;
  }
  return $b . pack("C*", (0) x ($bs - length($b) % $bs));
}

sub _oneandzeroes_padding ($$$) {
  my ($b,$bs,$decrypt) = @_;
  $b = length $b ? $b : '';
  if ($decrypt eq 'd') {
     $b=~ s/\x80\0*\z//s;
     return $b;
  }
  return $b . pack("C*", 128, (0) x ($bs - length($b) % $bs - 1) );
}

sub _rijndael_compat ($$$) {
  my ($b,$bs,$decrypt) = @_;
  return unless length $b;
  if ($decrypt eq 'd') {
     $b=~ s/\x80\0*\z//s;
     return $b;
  }
  return $b . pack("C*", 128, (0) x ($bs - length($b) % $bs - 1) );
}

sub get_initialization_vector (\$) {
  my $self = shift;
  $self->iv();
}

sub set_initialization_vector (\$$) {
  my $self = shift;
  my $iv   = shift;
  my $bs   = $self->blocksize;
  croak "Initialization vector must be $bs bytes in length" unless length($iv) == $bs;
  $self->iv($iv);
}

sub salt {
  my $self = shift;
  my $d    = $self->{salt};
  $self->{salt} = shift if @_;
  $d;
}

sub iv {
  my $self = shift;
  my $d    = $self->{iv};
  $self->{iv} = shift if @_;
  $d;
}

sub key {
  my $self = shift;
  my $d    = $self->{key};
  $self->{key} = shift if @_;
  $d;
}

sub passphrase {
  my $self = shift;
  my $d    = $self->{passphrase};
  if (@_) {
    undef $self->{key};
    undef $self->{iv};
    $self->{passphrase} = shift;
  }
  $d;
}

sub cipher    { shift->{cipher}    }
sub padding   { shift->{padding}   }
sub keysize   { shift->{keysize}   }
sub blocksize { shift->{blocksize} }
sub pcbc      { shift->{pcbc}      }
sub header_mode {shift->{header_mode} }
sub legacy_hack { shift->{legacy_hack} }

1;
__END__

#line 1065