;
tie my %sqlmail_options, 'Tie::IxHash',
- 'datasrc' => { label=>'DBI data source' },
- 'username' => { label=>'Database username' },
- 'password' => { label=>'Database password' },
+ 'datasrc' => { label => 'DBI data source' },
+ 'username' => { label => 'Database username' },
+ 'password' => { label => 'Database password' },
+ 'server_type' => {
+ label => 'Server type',
+ type => 'select',
+ options => [qw(dovecot_plain dovecot_crypt dovecot_digest_md5 courier_plain
+ courier_crypt)],
+ default => ['dovecot_plain'], },
+ 'svc_acct_table' => { label => 'User Table', default => 'user_acct' },
+ 'svc_forward_table' => { label => 'Forward Table', default => 'forward' },
+ 'svc_domain_table' => { label => 'Domain Table', default => 'domain' },
+ 'svc_acct_fields' => { label => 'svc_acct Export Fields',
+ default => 'username _password domsvc svcnum' },
+ 'svc_forward_fields' => { label => 'svc_forward Export Fields',
+ default => 'domain svcnum catchall' },
+ 'svc_domain_fields' => { label => 'svc_domain Export Fields',
+ default => 'srcsvc dstsvc dst' },
+ 'resolve_dstsvc' => { label => q{Resolve svc_forward.dstsvc to an email address and store it in dst. (Doesn't require that you also export dstsvc.)},
+ type => 'checkbox' },
+
;
tie my %ldap_options, 'Tie::IxHash',
'sqlmail' => {
'desc' => 'Real-time export to SQL-backed mail server',
'options' => \%sqlmail_options,
- 'nodomain' => 'Y',
+ 'nodomain' => 'N',
'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)',
},
package FS::part_export::sqlmail;
-use vars qw(@ISA %fs_mail_table %fields);
+use vars qw(@ISA);
+use FS::Record qw(qsearchs);
use FS::part_export;
+use Digest::MD5 qw(md5_hex);
@ISA = qw(FS::part_export);
-%fs_mail_table = ( svc_acct => 'user',
- svc_domain => 'domain' );
-
-# fields that need to be copied into the fs_mail tables
-$fields{user} = [qw(username _password finger domsvc svcnum )];
-$fields{domain} = [qw(domain svcnum catchall )];
-
sub rebless { shift; }
sub _export_insert {
my($self, $svc) = (shift, shift);
# this is a svc_something.
- my $table = $fs_mail_table{$svc->cust_svc->part_svc->svcdb};
- my @attrib = map {$svc->$_} @{$fields{$table}};
+ my $svcdb = $svc->cust_svc->part_svc->svcdb;
+ my $export_table = $self->option($svcdb . '_table')
+ or die('Export table not defined for svcdb: ' . $svcdb);
+ my @export_fields = split(/\s+/, $self->option($svcdb . '_fields'));
+ my $svchash = update_values($self, $svc, $svcdb);
+
+ foreach my $key (keys(%$svchash)) {
+ unless (grep { $key eq $_ } @export_fields) {
+ delete $svchash->{$key};
+ }
+ }
+
my $error = $self->sqlmail_queue( $svc->svcnum, 'insert',
- $table, @attrib );
+ $self->option('server_type'), $export_table,
+ (map { ($_, $svchash->{$_}); } keys(%$svchash)));
return $error if $error;
'';
+
}
sub _export_replace {
my( $self, $new, $old ) = (shift, shift, shift);
- my $table = $fs_mail_table{$new->cust_svc->part_svc->svcdb};
-
- my @old = ($old->svcnum, 'delete', $table, $old->svcnum);
- my @narf = map {$new->$_} @{$fields{$table}};
- $self->sqlmail_queue($new->svcnum, 'replace', $table,
- $new->svcnum, @narf);
-
+ my $svcdb = $new->cust_svc->part_svc->svcdb;
+ my $export_table = $self->option($svcdb . '_table')
+ or die('Export table not defined for svcdb: ' . $svcdb);
+ my @export_fields = split(/\s+/, $self->option($svcdb . '_fields'));
+ my $svchash = update_values($self, $new, $svcdb);
+
+ foreach my $key (keys(%$svchash)) {
+ unless (grep { $key eq $_ } @export_fields) {
+ delete $svchash->{$key};
+ }
+ }
+
+ my $error = $self->sqlmail_queue( $new->svcnum, 'replace',
+ $old->svcnum, $self->option('server_type'), $export_table,
+ (map { ($_, $svchash->{$_}); } keys(%$svchash)));
return $error if $error;
'';
+
}
sub _export_delete {
my( $self, $svc ) = (shift, shift);
- my $table = $fs_mail_table{$new->cust_svc->part_svc->svcdb};
+
+ my $svcdb = $svc->cust_svc->part_svc->svcdb;
+ my $table = $self->option($svcdb . '_table')
+ or die('Export table not defined for svcdb: ' . $svcdb);
+
$self->sqlmail_queue( $svc->svcnum, 'delete', $table,
$svc->svcnum );
}
sub sqlmail_queue {
- my( $self, $svcnum, $method, $table ) = (shift, shift, shift);
+ my( $self, $svcnum, $method ) = (shift, shift, shift);
my $queue = new FS::queue {
'svcnum' => $svcnum,
'job' => "FS::part_export::sqlmail::sqlmail_$method",
sub sqlmail_insert { #subroutine, not method
my $dbh = sqlmail_connect(shift, shift, shift);
- my( $table, @attrib ) = @_;
+ my( $server_type, $table ) = (shift, shift);
- my $sth = $dbh->prepare(
- "INSERT INTO $table (" . join (',', @{$fields{$table}}) .
- ") VALUES ('" . join ("','", @attrib) . "')"
- ) or die $dbh->errstr;
- $sth->execute() or die $sth->errstr;
+ my %attrs = @_;
+ map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs);
+ my $query = sprintf("INSERT INTO %s (%s) values (%s)",
+ $table, join(",", keys(%attrs)),
+ join(',', values(%attrs)));
+
+ $dbh->do($query) or die $dbh->errstr;
$dbh->disconnect;
+
+ '';
}
sub sqlmail_delete { #subroutine, not method
my $dbh = sqlmail_connect(shift, shift, shift);
my( $table, $svcnum ) = @_;
- my $sth = $dbh->prepare(
- "DELETE FROM $table WHERE svcnum = $svcnum"
- ) or die $dbh->errstr;
- $sth->execute() or die $sth->errstr;
-
+ $dbh->do("DELETE FROM $table WHERE svcnum = $svcnum") or die $dbh->errstr;
$dbh->disconnect;
+
+ '';
}
sub sqlmail_replace {
my $dbh = sqlmail_connect(shift, shift, shift);
- my( $table, $svcnum, @attrib ) = @_;
+ my($oldsvcnum, $server_type, $table) = (shift, shift, shift);
+
+ my %attrs = @_;
+ map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs);
- my %data;
- @data{@{$fields{$table}}} = @attrib;
+ my $query = sprintf('UPDATE %s SET %s WHERE svcnum = %s',
+ $table, join(', ', map {"$_ = $attrs{$_}"} keys(%attrs)),
+ $oldsvcnum);
- my $sth = $dbh->prepare(
- "UPDATE $table SET " .
- ( join ',', map {$_ . "='" . $data{$_} . "'"} keys(%data) ) .
- " WHERE svcnum = $svcnum"
- ) or die $dbh->errstr;
- $sth->execute() or die $sth->errstr;
+ my $rv = $dbh->do($query) or die $dbh->errstr;
+
+ if ($rv == 0) {
+ $query = sprintf("INSERT INTO %s (%s) values (%s)",
+ $table, join(",", keys(%attrs)),
+ join(',', values(%attrs)));
+ $dbh->do($query) or die $dbh->errstr;
+ }
$dbh->disconnect;
+
+ '';
}
sub sqlmail_connect {
- #my($datasrc, $username, $password) = @_;
- #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
DBI->connect(@_) or die $DBI::errstr;
}
+sub update_values {
+
+ # Update records to conform to a particular server_type.
+
+ my ($self, $svc, $svcdb) = (shift,shift,shift);
+ my $svchash = $svc->hashref or return '';
+
+ if ($svcdb eq 'svc_acct') {
+ if ($self->option('server_type') eq 'courier_crypt') {
+ my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
+ $svchash->{_password} = crypt($svchash->{_password}, $salt);
+
+ } elsif ($self->option('server_type') eq 'dovecot_plain') {
+ $svchash->{_password} = '{PLAIN}' . $svchash->{_password};
+
+ } elsif ($self->option('server_type') eq 'dovecot_crypt') {
+ my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
+ $svchash->{_password} = '{CRYPT}' . crypt($svchash->{_password}, $salt);
+
+ } elsif ($self->option('server_type') eq 'dovecot_digest_md5') {
+ my $svc_domain = qsearchs('svc_domain', { svcnum => $svc->domsvc });
+ die('Unable to lookup svc_domain with domsvc: ' . $svc->domsvc)
+ unless ($svc_domain);
+
+ my $domain = $svc_domain->domain;
+ my $md5hash = '{DIGEST-MD5}' . md5_hex(join(':', $svchash->{username},
+ $domain, $svchash->{_password}));
+ $svchash->{_password} = $md5hash;
+ }
+ } elsif ($svcdb eq 'svc_forward') {
+ if ($self->option('resolve_dstsvc') && $svc->dstsvc_acct) {
+ $svchash->{dst} = $svc->dstsvc_acct->username . '@' .
+ $svc->dstsvc_acct->svc_domain->domain;
+ }
+ }
+
+ return($svchash);
+
+}
+
projects / freeside.git / commitdiff