1 package FS::part_export::sqlmail;
3 use vars qw(@ISA %info);
5 use Digest::MD5 qw(md5_hex);
6 use FS::Record qw(qsearchs);
11 @ISA = qw(FS::part_export);
13 tie my %options, 'Tie::IxHash',
14 'datasrc' => { label => 'DBI data source' },
15 'username' => { label => 'Database username' },
16 'password' => { label => 'Database password' },
18 label => 'Server type',
20 options => [qw(dovecot_plain dovecot_crypt dovecot_digest_md5 courier_plain
22 default => ['dovecot_plain'], },
23 'svc_acct_table' => { label => 'User Table', default => 'user_acct' },
24 'svc_forward_table' => { label => 'Forward Table', default => 'forward' },
25 'svc_domain_table' => { label => 'Domain Table', default => 'domain' },
26 'svc_acct_fields' => { label => 'svc_acct Export Fields',
27 default => 'username _password domsvc svcnum' },
28 'svc_forward_fields' => { label => 'svc_forward Export Fields',
29 default => 'srcsvc dstsvc dst' },
30 'svc_domain_fields' => { label => 'svc_domain Export Fields',
31 default => 'domain svcnum catchall' },
32 '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.)},
37 'svc' => [qw( svc_acct svc_domain svc_forward )],
38 'desc' => 'Real-time export to SQL-backed mail server',
39 'options' => \%options,
41 'default_svc_class' => 'Email',
43 Database schema can be made to work with Courier IMAP, Exim and Dovecot.
44 Others could work but are untested. (more detailed description from
45 Kristian / fire2wire? )
49 sub rebless { shift; }
52 my($self, $svc) = (shift, shift);
53 # this is a svc_something.
55 my $svcdb = $svc->cust_svc->part_svc->svcdb;
56 my $export_table = $self->option($svcdb . '_table')
57 or die('Export table not defined for svcdb: ' . $svcdb);
58 my @export_fields = split(/\s+/, $self->option($svcdb . '_fields'));
59 my $svchash = update_values($self, $svc, $svcdb);
61 foreach my $key (keys(%$svchash)) {
62 unless (grep { $key eq $_ } @export_fields) {
63 delete $svchash->{$key};
67 my $error = $self->sqlmail_queue( $svc->svcnum, 'insert',
68 $self->option('server_type'), $export_table,
69 (map { ($_, $svchash->{$_}); } keys(%$svchash)));
70 return $error if $error;
76 my( $self, $new, $old ) = (shift, shift, shift);
78 my $svcdb = $new->cust_svc->part_svc->svcdb;
79 my $export_table = $self->option($svcdb . '_table')
80 or die('Export table not defined for svcdb: ' . $svcdb);
81 my @export_fields = split(/\s+/, $self->option($svcdb . '_fields'));
82 my $svchash = update_values($self, $new, $svcdb);
84 foreach my $key (keys(%$svchash)) {
85 unless (grep { $key eq $_ } @export_fields) {
86 delete $svchash->{$key};
90 my $error = $self->sqlmail_queue( $new->svcnum, 'replace',
91 $old->svcnum, $self->option('server_type'), $export_table,
92 (map { ($_, $svchash->{$_}); } keys(%$svchash)));
93 return $error if $error;
99 my( $self, $svc ) = (shift, shift);
101 my $svcdb = $svc->cust_svc->part_svc->svcdb;
102 my $table = $self->option($svcdb . '_table')
103 or die('Export table not defined for svcdb: ' . $svcdb);
105 $self->sqlmail_queue( $svc->svcnum, 'delete', $table,
110 my( $self, $svcnum, $method ) = (shift, shift, shift);
111 my $queue = new FS::queue {
113 'job' => "FS::part_export::sqlmail::sqlmail_$method",
116 $self->option('datasrc'),
117 $self->option('username'),
118 $self->option('password'),
123 sub sqlmail_insert { #subroutine, not method
124 my $dbh = sqlmail_connect(shift, shift, shift);
125 my( $server_type, $table ) = (shift, shift);
129 map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs);
130 my $query = sprintf("INSERT INTO %s (%s) values (%s)",
131 $table, join(",", keys(%attrs)),
132 join(',', values(%attrs)));
134 $dbh->do($query) or die $dbh->errstr;
140 sub sqlmail_delete { #subroutine, not method
141 my $dbh = sqlmail_connect(shift, shift, shift);
142 my( $table, $svcnum ) = @_;
144 $dbh->do("DELETE FROM $table WHERE svcnum = $svcnum") or die $dbh->errstr;
150 sub sqlmail_replace {
151 my $dbh = sqlmail_connect(shift, shift, shift);
152 my($oldsvcnum, $server_type, $table) = (shift, shift, shift);
155 map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs);
157 my $query = "SELECT COUNT(*) FROM $table WHERE svcnum = $oldsvcnum";
158 my $result = $dbh->selectrow_arrayref($query) or die $dbh->errstr;
160 if (@$result[0] == 0) {
161 $query = sprintf("INSERT INTO %s (%s) values (%s)",
162 $table, join(",", keys(%attrs)),
163 join(',', values(%attrs)));
164 $dbh->do($query) or die $dbh->errstr;
166 $query = sprintf('UPDATE %s SET %s WHERE svcnum = %s',
167 $table, join(', ', map {"$_ = $attrs{$_}"} keys(%attrs)),
169 $dbh->do($query) or die $dbh->errstr;
177 sub sqlmail_connect {
178 FS::DBI->connect(@_) or die $FS::DBI::errstr;
183 # Update records to conform to a particular server_type.
185 my ($self, $svc, $svcdb) = (shift,shift,shift);
186 my $svchash = { %{$svc->hashref} } or return ''; # We need a copy.
188 if ($svcdb eq 'svc_acct') {
189 if ($self->option('server_type') eq 'courier_crypt') {
190 my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
191 $svchash->{_password} = crypt($svchash->{_password}, $salt);
193 } elsif ($self->option('server_type') eq 'dovecot_plain') {
194 $svchash->{_password} = '{PLAIN}' . $svchash->{_password};
196 } elsif ($self->option('server_type') eq 'dovecot_crypt') {
197 my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
198 $svchash->{_password} = '{CRYPT}' . crypt($svchash->{_password}, $salt);
200 } elsif ($self->option('server_type') eq 'dovecot_digest_md5') {
201 my $svc_domain = qsearchs('svc_domain', { svcnum => $svc->domsvc });
202 die('Unable to lookup svc_domain with domsvc: ' . $svc->domsvc)
203 unless ($svc_domain);
205 my $domain = $svc_domain->domain;
206 my $md5hash = '{DIGEST-MD5}' . md5_hex(join(':', $svchash->{username},
207 $domain, $svchash->{_password}));
208 $svchash->{_password} = $md5hash;
210 } elsif ($svcdb eq 'svc_forward') {
211 if ($self->option('resolve_dstsvc') && $svc->dstsvc_acct) {
212 $svchash->{dst} = $svc->dstsvc_acct->username . '@' .
213 $svc->dstsvc_acct->svc_domain->domain;