FS/FS/part_export/sqlmail.pm

   1 package FS::part_export::sqlmail;
   2
   3 use vars qw(@ISA %info);
   4 use Tie::IxHash;
   5 use Digest::MD5 qw(md5_hex);
   6 use FS::Record qw(qsearchs);
   7 use FS::part_export;
   8 use FS::svc_domain;
   9
  10 @ISA = qw(FS::part_export);
  11
  12 tie my %options, 'Tie::IxHash',
  13   'datasrc'            => { label => 'DBI data source' },
  14   'username'           => { label => 'Database username' },
  15   'password'           => { label => 'Database password' },
  16   'server_type'        => {
  17     label   => 'Server type',
  18     type    => 'select',
  19     options => [qw(dovecot_plain dovecot_crypt dovecot_digest_md5 courier_plain
  20                    courier_crypt)],
  21     default => ['dovecot_plain'], },
  22   'svc_acct_table'     => { label => 'User Table', default => 'user_acct' },
  23   'svc_forward_table'  => { label => 'Forward Table', default => 'forward' },
  24   'svc_domain_table'   => { label => 'Domain Table', default => 'domain' },
  25   'svc_acct_fields'    => { label => 'svc_acct Export Fields',
  26                             default => 'username _password domsvc svcnum' },
  27   'svc_forward_fields' => { label => 'svc_forward Export Fields',
  28                             default => 'srcsvc dstsvc dst' },
  29   'svc_domain_fields'  => { label => 'svc_domain Export Fields',
  30                             default => 'domain svcnum catchall' },
  31   '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.)},
  32                             type => 'checkbox' },
  33 ;
  34
  35 %info = (
  36   'svc'      => [qw( svc_acct svc_domain svc_forward )],
  37   'desc'     => 'Real-time export to SQL-backed mail server',
  38   'options'  => \%options,
  39   'nodomain' => '',
  40   'notes'    => <<'END'
  41 Database schema can be made to work with Courier IMAP, Exim and Dovecot.
  42 Others could work but are untested.  (more detailed description from
  43 Kristian / fire2wire? )
  44 END
  45 );
  46
  47 sub rebless { shift; }
  48
  49 sub _export_insert {
  50   my($self, $svc) = (shift, shift);
  51   # this is a svc_something.
  52
  53   my $svcdb = $svc->cust_svc->part_svc->svcdb;
  54   my $export_table = $self->option($svcdb . '_table')
  55     or die('Export table not defined for svcdb: ' . $svcdb);
  56   my @export_fields = split(/\s+/, $self->option($svcdb . '_fields'));
  57   my $svchash = update_values($self, $svc, $svcdb);
  58
  59   foreach my $key (keys(%$svchash)) {
  60     unless (grep { $key eq $_ } @export_fields) {
  61       delete $svchash->{$key};
  62     }
  63   }
  64
  65   my $error = $self->sqlmail_queue( $svc->svcnum, 'insert',
  66     $self->option('server_type'), $export_table,
  67     (map { ($_, $svchash->{$_}); } keys(%$svchash)));
  68   return $error if $error;
  69   '';
  70
  71 }
  72
  73 sub _export_replace {
  74   my( $self, $new, $old ) = (shift, shift, shift);
  75
  76   my $svcdb = $new->cust_svc->part_svc->svcdb;
  77   my $export_table = $self->option($svcdb . '_table')
  78     or die('Export table not defined for svcdb: ' . $svcdb);
  79   my @export_fields = split(/\s+/, $self->option($svcdb . '_fields'));
  80   my $svchash = update_values($self, $new, $svcdb);
  81
  82   foreach my $key (keys(%$svchash)) {
  83     unless (grep { $key eq $_ } @export_fields) {
  84       delete $svchash->{$key};
  85     }
  86   }
  87
  88   my $error = $self->sqlmail_queue( $new->svcnum, 'replace',
  89     $old->svcnum, $self->option('server_type'), $export_table,
  90     (map { ($_, $svchash->{$_}); } keys(%$svchash)));
  91   return $error if $error;
  92   '';
  93
  94 }
  95
  96 sub _export_delete {
  97   my( $self, $svc ) = (shift, shift);
  98
  99   my $svcdb = $svc->cust_svc->part_svc->svcdb;
 100   my $table = $self->option($svcdb . '_table')
 101     or die('Export table not defined for svcdb: ' . $svcdb);
 102
 103   $self->sqlmail_queue( $svc->svcnum, 'delete', $table,
 104     $svc->svcnum );
 105 }
 106
 107 sub sqlmail_queue {
 108   my( $self, $svcnum, $method ) = (shift, shift, shift);
 109   my $queue = new FS::queue {
 110     'svcnum' => $svcnum,
 111     'job'    => "FS::part_export::sqlmail::sqlmail_$method",
 112   };
 113   $queue->insert(
 114     $self->option('datasrc'),
 115     $self->option('username'),
 116     $self->option('password'),
 117     @_,
 118   );
 119 }
 120
 121 sub sqlmail_insert { #subroutine, not method
 122   my $dbh = sqlmail_connect(shift, shift, shift);
 123   my( $server_type, $table ) = (shift, shift);
 124
 125   my %attrs = @_;
 126
 127   map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs);
 128   my $query = sprintf("INSERT INTO %s (%s) values (%s)",
 129                       $table, join(",", keys(%attrs)),
 130                       join(',', values(%attrs)));
 131
 132   $dbh->do($query) or die $dbh->errstr;
 133   $dbh->disconnect;
 134
 135   '';
 136 }
 137
 138 sub sqlmail_delete { #subroutine, not method
 139   my $dbh = sqlmail_connect(shift, shift, shift);
 140   my( $table, $svcnum ) = @_;
 141
 142   $dbh->do("DELETE FROM $table WHERE svcnum = $svcnum") or die $dbh->errstr;
 143   $dbh->disconnect;
 144
 145   '';
 146 }
 147
 148 sub sqlmail_replace {
 149   my $dbh = sqlmail_connect(shift, shift, shift);
 150   my($oldsvcnum, $server_type, $table) = (shift, shift, shift);
 151
 152   my %attrs = @_;
 153   map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs);
 154
 155   my $query = "SELECT COUNT(*) FROM $table WHERE svcnum = $oldsvcnum";
 156   my $result = $dbh->selectrow_arrayref($query) or die $dbh->errstr;
 157
 158   if (@$result[0] == 0) {
 159     $query = sprintf("INSERT INTO %s (%s) values (%s)",
 160                      $table, join(",", keys(%attrs)),
 161                      join(',', values(%attrs)));
 162     $dbh->do($query) or die $dbh->errstr;
 163   } else {
 164     $query = sprintf('UPDATE %s SET %s WHERE svcnum = %s',
 165                      $table, join(', ', map {"$_ = $attrs{$_}"} keys(%attrs)),
 166                      $oldsvcnum);
 167     $dbh->do($query) or die $dbh->errstr;
 168   }
 169
 170   $dbh->disconnect;
 171
 172   '';
 173 }
 174
 175 sub sqlmail_connect {
 176   DBI->connect(@_) or die $DBI::errstr;
 177 }
 178
 179 sub update_values {
 180
 181   # Update records to conform to a particular server_type.
 182
 183   my ($self, $svc, $svcdb) = (shift,shift,shift);
 184   my $svchash = { %{$svc->hashref} } or return ''; # We need a copy.
 185
 186   if ($svcdb eq 'svc_acct') {
 187     if ($self->option('server_type') eq 'courier_crypt') {
 188       my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
 189       $svchash->{_password} = crypt($svchash->{_password}, $salt);
 190
 191     } elsif ($self->option('server_type') eq 'dovecot_plain') {
 192       $svchash->{_password} = '{PLAIN}' . $svchash->{_password};
 193
 194     } elsif ($self->option('server_type') eq 'dovecot_crypt') {
 195       my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
 196       $svchash->{_password} = '{CRYPT}' . crypt($svchash->{_password}, $salt);
 197
 198     } elsif ($self->option('server_type') eq 'dovecot_digest_md5') {
 199       my $svc_domain = qsearchs('svc_domain', { svcnum => $svc->domsvc });
 200       die('Unable to lookup svc_domain with domsvc: ' . $svc->domsvc)
 201         unless ($svc_domain);
 202
 203       my $domain = $svc_domain->domain;
 204       my $md5hash = '{DIGEST-MD5}' . md5_hex(join(':', $svchash->{username},
 205                                              $domain, $svchash->{_password}));
 206       $svchash->{_password} = $md5hash;
 207     }
 208   } elsif ($svcdb eq 'svc_forward') {
 209     if ($self->option('resolve_dstsvc') && $svc->dstsvc_acct) {
 210       $svchash->{dst} = $svc->dstsvc_acct->username . '@' .
 211                         $svc->dstsvc_acct->svc_domain->domain;
 212     }
 213   }
 214
 215   return($svchash);
 216
 217 }
 218
 219 1;
 220