FS/FS/part_export/sqlmail.pm

   1 package FS::part_export::sqlmail;
   2
   3 use vars qw(@ISA);
   4 use Digest::MD5 qw(md5_hex);
   5 use FS::Record qw(qsearchs);
   6 use FS::part_export;
   7 use FS::svc_domain;
   8
   9 @ISA = qw(FS::part_export);
  10
  11 sub rebless { shift; }
  12
  13 sub _export_insert {
  14   my($self, $svc) = (shift, shift);
  15   # this is a svc_something.
  16
  17   my $svcdb = $svc->cust_svc->part_svc->svcdb;
  18   my $export_table = $self->option($svcdb . '_table')
  19     or die('Export table not defined for svcdb: ' . $svcdb);
  20   my @export_fields = split(/\s+/, $self->option($svcdb . '_fields'));
  21   my $svchash = update_values($self, $svc, $svcdb);
  22
  23   foreach my $key (keys(%$svchash)) {
  24     unless (grep { $key eq $_ } @export_fields) {
  25       delete $svchash->{$key};
  26     }
  27   }
  28
  29   my $error = $self->sqlmail_queue( $svc->svcnum, 'insert',
  30     $self->option('server_type'), $export_table,
  31     (map { ($_, $svchash->{$_}); } keys(%$svchash)));
  32   return $error if $error;
  33   '';
  34
  35 }
  36
  37 sub _export_replace {
  38   my( $self, $new, $old ) = (shift, shift, shift);
  39
  40   my $svcdb = $new->cust_svc->part_svc->svcdb;
  41   my $export_table = $self->option($svcdb . '_table')
  42     or die('Export table not defined for svcdb: ' . $svcdb);
  43   my @export_fields = split(/\s+/, $self->option($svcdb . '_fields'));
  44   my $svchash = update_values($self, $new, $svcdb);
  45
  46   foreach my $key (keys(%$svchash)) {
  47     unless (grep { $key eq $_ } @export_fields) {
  48       delete $svchash->{$key};
  49     }
  50   }
  51
  52   my $error = $self->sqlmail_queue( $new->svcnum, 'replace',
  53     $old->svcnum, $self->option('server_type'), $export_table,
  54     (map { ($_, $svchash->{$_}); } keys(%$svchash)));
  55   return $error if $error;
  56   '';
  57
  58 }
  59
  60 sub _export_delete {
  61   my( $self, $svc ) = (shift, shift);
  62
  63   my $svcdb = $svc->cust_svc->part_svc->svcdb;
  64   my $table = $self->option($svcdb . '_table')
  65     or die('Export table not defined for svcdb: ' . $svcdb);
  66
  67   $self->sqlmail_queue( $svc->svcnum, 'delete', $table,
  68     $svc->svcnum );
  69 }
  70
  71 sub sqlmail_queue {
  72   my( $self, $svcnum, $method ) = (shift, shift, shift);
  73   my $queue = new FS::queue {
  74     'svcnum' => $svcnum,
  75     'job'    => "FS::part_export::sqlmail::sqlmail_$method",
  76   };
  77   $queue->insert(
  78     $self->option('datasrc'),
  79     $self->option('username'),
  80     $self->option('password'),
  81     @_,
  82   );
  83 }
  84
  85 sub sqlmail_insert { #subroutine, not method
  86   my $dbh = sqlmail_connect(shift, shift, shift);
  87   my( $server_type, $table ) = (shift, shift);
  88
  89   my %attrs = @_;
  90
  91   map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs);
  92   my $query = sprintf("INSERT INTO %s (%s) values (%s)",
  93                       $table, join(",", keys(%attrs)),
  94                       join(',', values(%attrs)));
  95
  96   $dbh->do($query) or die $dbh->errstr;
  97   $dbh->disconnect;
  98
  99   '';
 100 }
 101
 102 sub sqlmail_delete { #subroutine, not method
 103   my $dbh = sqlmail_connect(shift, shift, shift);
 104   my( $table, $svcnum ) = @_;
 105
 106   $dbh->do("DELETE FROM $table WHERE svcnum = $svcnum") or die $dbh->errstr;
 107   $dbh->disconnect;
 108
 109   '';
 110 }
 111
 112 sub sqlmail_replace {
 113   my $dbh = sqlmail_connect(shift, shift, shift);
 114   my($oldsvcnum, $server_type, $table) = (shift, shift, shift);
 115
 116   my %attrs = @_;
 117   map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs);
 118
 119   my $query = "SELECT COUNT(*) FROM $table WHERE svcnum = $oldsvcnum";
 120   my $result = $dbh->selectrow_arrayref($query) or die $dbh->errstr;
 121
 122   if (@$result[0] == 0) {
 123     $query = sprintf("INSERT INTO %s (%s) values (%s)",
 124                      $table, join(",", keys(%attrs)),
 125                      join(',', values(%attrs)));
 126     $dbh->do($query) or die $dbh->errstr;
 127   } else {
 128     $query = sprintf('UPDATE %s SET %s WHERE svcnum = %s',
 129                      $table, join(', ', map {"$_ = $attrs{$_}"} keys(%attrs)),
 130                      $oldsvcnum);
 131     $dbh->do($query) or die $dbh->errstr;
 132   }
 133
 134   $dbh->disconnect;
 135
 136   '';
 137 }
 138
 139 sub sqlmail_connect {
 140   DBI->connect(@_) or die $DBI::errstr;
 141 }
 142
 143 sub update_values {
 144
 145   # Update records to conform to a particular server_type.
 146
 147   my ($self, $svc, $svcdb) = (shift,shift,shift);
 148   my $svchash = { %{$svc->hashref} } or return ''; # We need a copy.
 149
 150   if ($svcdb eq 'svc_acct') {
 151     if ($self->option('server_type') eq 'courier_crypt') {
 152       my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
 153       $svchash->{_password} = crypt($svchash->{_password}, $salt);
 154
 155     } elsif ($self->option('server_type') eq 'dovecot_plain') {
 156       $svchash->{_password} = '{PLAIN}' . $svchash->{_password};
 157
 158     } elsif ($self->option('server_type') eq 'dovecot_crypt') {
 159       my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
 160       $svchash->{_password} = '{CRYPT}' . crypt($svchash->{_password}, $salt);
 161
 162     } elsif ($self->option('server_type') eq 'dovecot_digest_md5') {
 163       my $svc_domain = qsearchs('svc_domain', { svcnum => $svc->domsvc });
 164       die('Unable to lookup svc_domain with domsvc: ' . $svc->domsvc)
 165         unless ($svc_domain);
 166
 167       my $domain = $svc_domain->domain;
 168       my $md5hash = '{DIGEST-MD5}' . md5_hex(join(':', $svchash->{username},
 169                                              $domain, $svchash->{_password}));
 170       $svchash->{_password} = $md5hash;
 171     }
 172   } elsif ($svcdb eq 'svc_forward') {
 173     if ($self->option('resolve_dstsvc') && $svc->dstsvc_acct) {
 174       $svchash->{dst} = $svc->dstsvc_acct->username . '@' .
 175                         $svc->dstsvc_acct->svc_domain->domain;
 176     }
 177   }
 178
 179   return($svchash);
 180
 181 }
 182