use strict;
use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG
- $me %dbdef_cache %virtual_fields_cache );
+ $me %dbdef_cache %virtual_fields_cache $nowarn_identical );
use subs qw(reload_dbdef);
use Exporter;
use Carp qw(carp cluck croak confess);
use File::CounterFile;
use Locale::Country;
use DBI qw(:sql_types);
-use DBIx::DBSchema 0.23;
+use DBIx::DBSchema 0.25;
use FS::UID qw(dbh getotaker datasrc driver_name);
use FS::SearchCache;
use FS::Msgcat qw(gettext);
+use FS::Conf;
use FS::part_virtual_field;
$DEBUG = 0;
$me = '[FS::Record]';
+$nowarn_identical = 0;
+
+my $conf;
+my $rsa_module;
+my $rsa_loaded;
+my $rsa_encrypt;
+my $rsa_decrypt;
+
#ask FS::UID to run this stuff for us later
$FS::UID::callback{'FS::Record'} = sub {
+ $conf = new FS::Conf;
$File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc;
$dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc;
&reload_dbdef unless $setup_hack; #$setup_hack needed now?
}
}
-=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, AS
+=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
Searches the database for all records matching (at least) the key/value pairs
in HASHREF. Returns all the records found as `FS::TABLE' objects if that
=cut
sub qsearch {
- my($stable, $record, $select, $extra_sql, $cache, $as ) = @_;
+ my($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_;
#$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table";
#for jsearch
$stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable";
}
my $statement = "SELECT $select FROM $stable";
- $statement .= " AS $as" if $as;
+ $statement .= " $addl_from" if $addl_from;
if ( @real_fields or @virtual_fields ) {
$statement .= ' WHERE '. join(' AND ',
( map {
}
}
}
-
+ my @return;
if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
#derivied class didn't override new method, so this optimization is safe
if ( $cache ) {
- map {
+ @return = map {
new_or_cached( "FS::$table", { %{$_} }, $cache )
} values(%result);
} else {
- map {
+ @return = map {
new( "FS::$table", { %{$_} } )
} values(%result);
}
} else {
warn "untested code (class FS::$table uses custom new method)";
- map {
+ @return = map {
eval 'FS::'. $table. '->new( { %{$_} } )';
} values(%result);
}
+
+ # Check for encrypted fields and decrypt them.
+ if ($conf->exists('encryption') && eval 'defined(@FS::'. $table . '::encrypted_fields)') {
+ foreach my $record (@return) {
+ foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
+ # Set it directly... This may cause a problem in the future...
+ $record->setfield($field, $record->decrypt($record->getfield($field)));
+ }
+ }
+ }
} else {
cluck "warning: FS::$table not loaded; returning FS::Record objects";
- map {
+ @return = map {
FS::Record->new( $table, { %{$_} } );
} values(%result);
}
-
+ return @return;
}
=item jsearch TABLE, HASHREF, SELECT, EXTRA_SQL, PRIMARY_TABLE, PRIMARY_KEY
);
}
-=item qsearchs TABLE, HASHREF
+=item qsearchs TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM
Same as qsearch, except that if more than one record matches, it B<carp>s but
returns the first. If this happens, you either made a logic error in asking
sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
my $table = $_[0];
my(@result) = qsearch(@_);
- carp "warning: Multiple records in scalar search ($table)"
+ cluck "warning: Multiple records in scalar search ($table)"
if scalar(@result) > 1;
#should warn more vehemently if the search was on a primary key?
scalar(@result) ? ($result[0]) : ();
sub insert {
my $self = shift;
+ my $saved = {};
my $error = $self->check;
return $error if $error;
}
my $table = $self->table;
+
+
+ # Encrypt before the database
+ if ($conf->exists('encryption') && defined(eval '@FS::'. $table . 'encrypted_fields')) {
+ foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
+ $self->{'saved'} = $self->getfield($field);
+ $self->setfield($field, $self->enrypt($self->getfield($field)));
+ }
+ }
+
+
#false laziness w/delete
my @real_fields =
grep defined($self->getfield($_)) && $self->getfield($_) ne "",
dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
+ # Now that it has been saved, reset the encrypted fields so that $new
+ # can still be used.
+ foreach my $field (keys %{$saved}) {
+ $self->setfield($field, $saved->{$field});
+ }
+
'';
}
sub replace {
my $new = shift;
+ my $old = shift;
- my $old;
- if ( @_ ) {
- $old = shift;
- } else {
+ if (!defined($old)) {
warn "[debug]$me replace called with no arguments; autoloading old record\n"
if $DEBUG;
my $primary_key = $new->dbdef_table->primary_key;
return "Records not in same table!" unless $new->table eq $old->table;
my $primary_key = $old->dbdef_table->primary_key;
- return "Can't change $primary_key"
+ return "Can't change primary key $primary_key ".
+ 'from '. $old->getfield($primary_key).
+ ' to ' . $new->getfield($primary_key)
if $primary_key
&& ( $old->getfield($primary_key) ne $new->getfield($primary_key) );
my $error = $new->check;
return $error if $error;
+
+ # Encrypt for replace
+ my $saved = {};
+ if ($conf->exists('encryption') && defined(eval '@FS::'. $new->table . 'encrypted_fields')) {
+ foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') {
+ $saved->{$field} = $new->getfield($field);
+ $new->setfield($field, $new->encrypt($new->getfield($field)));
+ }
+ }
#my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
my %diff = map { ($new->getfield($_) ne $old->getfield($_))
? ($_, $new->getfield($_)) : () } $old->fields;
unless ( keys(%diff) ) {
- carp "[warning]$me $new -> replace $old: records identical";
+ carp "[warning]$me $new -> replace $old: records identical"
+ unless $nowarn_identical;
return '';
}
dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
+ # Now that it has been saved, reset the encrypted fields so that $new
+ # can still be used.
+ foreach my $field (keys %{$saved}) {
+ $new->setfield($field, $saved->{$field});
+ }
+
'';
}
}
sub _h_statement {
- my( $self, $action ) = @_;
+ my( $self, $action, $time ) = @_;
+
+ $time ||= time;
my @fields =
grep defined($self->getfield($_)) && $self->getfield($_) ne "",
"INSERT INTO h_". $self->table. " ( ".
join(', ', qw(history_date history_user history_action), @fields ).
") VALUES (".
- join(', ', time, dbh->quote(getotaker()), dbh->quote($action), @values).
+ join(', ', $time, dbh->quote(getotaker()), dbh->quote($action), @values).
")"
;
}
} (fields($self->table)) );
}
+sub encrypt {
+ my ($self, $value) = @_;
+ my $encrypted;
+
+ if ($conf->exists('encryption')) {
+ if ($self->is_encrypted($value)) {
+ # Return the original value if it isn't plaintext.
+ $encrypted = $value;
+ } else {
+ $self->loadRSA;
+ if (ref($rsa_encrypt) =~ /::RSA/) { # We Can Encrypt
+ # RSA doesn't like the empty string so let's pack it up
+ # The database doesn't like the RSA data so uuencode it
+ my $length = length($value)+1;
+ $encrypted = pack("u*",$rsa_encrypt->encrypt(pack("Z$length",$value)));
+ } else {
+ die ("You can't encrypt w/o a valid RSA engine - Check your installation or disable encryption");
+ }
+ }
+ }
+ return $encrypted;
+}
+
+sub is_encrypted {
+ my ($self, $value) = @_;
+ # Possible Bug - Some work may be required here....
+
+ if (length($value) > 80) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+sub decrypt {
+ my ($self,$value) = @_;
+ my $decrypted = $value; # Will return the original value if it isn't encrypted or can't be decrypted.
+ if ($conf->exists('encryption') && $self->is_encrypted($value)) {
+ $self->loadRSA;
+ if (ref($rsa_decrypt) =~ /::RSA/) {
+ my $encrypted = unpack ("u*", $value);
+ $decrypted = unpack("Z*", $rsa_decrypt->decrypt($encrypted));
+ }
+ }
+ return $decrypted;
+}
+
+sub loadRSA {
+ my $self = shift;
+ #Initialize the Module
+ $rsa_module = 'Crypt::OpenSSL::RSA'; # The Default
+
+ if ($conf->exists('encryptionmodule') && $conf->config('encryptionmodule') ne '') {
+ $rsa_module = $conf->config('encryptionmodule');
+ }
+
+ if (!$rsa_loaded) {
+ eval ("require $rsa_module"); # No need to import the namespace
+ $rsa_loaded++;
+ }
+ # Initialize Encryption
+ if ($conf->exists('encryptionpublickey') && $conf->config('encryptionpublickey') ne '') {
+ my $public_key = join("\n",$conf->config('encryptionpublickey'));
+ $rsa_encrypt = $rsa_module->new_public_key($public_key);
+ }
+
+ # Intitalize Decryption
+ if ($conf->exists('encryptionprivatekey') && $conf->config('encryptionprivatekey') ne '') {
+ my $private_key = join("\n",$conf->config('encryptionprivatekey'));
+ $rsa_decrypt = $rsa_module->new_private_key($private_key);
+ }
+}
+
sub DESTROY { return; }
#sub DESTROY {