Bug fixes for sqlmail. Added support for courier and dovecot authentication.

2 files changed, 132 insertions, 46 deletions

diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm
index 789e8450d..4471d6e00 100644
--- a/FS/FS/part_export.pm
+++ b/FS/FS/part_export.pm
@@ -764,9 +764,27 @@ tie my %http_options, 'Tie::IxHash',
 ;
 
 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',
@@ -855,7 +873,7 @@ 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?...)',
     },
 
diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm
index 4194daf0c..0c0cb367b 100644
--- a/FS/FS/part_export/sqlmail.pm
+++ b/FS/FS/part_export/sqlmail.pm
@@ -1,54 +1,74 @@
 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",
@@ -63,49 +83,97 @@ sub sqlmail_queue {
 
 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);
+
+}
+