import Net::Whois::Raw into install/5.005 directory *sigh*
[freeside.git] / FS / FS / part_export / vpopmail.pm
1 package FS::part_export::vpopmail;
2
3 use vars qw(@ISA %info @saltset $exportdir);
4 use Fcntl qw(:flock);
5 use Tie::IxHash;
6 use File::Path;
7 use FS::UID qw( datasrc );
8 use FS::part_export;
9
10 @ISA = qw(FS::part_export);
11
12 tie my %options, 'Tie::IxHash',
13   #'machine' => { label=>'vpopmail machine', },
14   'dir'     => { label=>'directory', }, # ?more info? default?
15   'uid'     => { label=>'vpopmail uid' },
16   'gid'     => { label=>'vpopmail gid' },
17   'restart' => { label=> 'vpopmail restart command',
18                  default=> 'cd /home/vpopmail/domains; for domain in *; do /home/vpopmail/bin/vmkpasswd $domain; done; /var/qmail/bin/qmail-newu; killall -HUP qmail-send',
19                },
20 ;
21
22 %info = (
23   'svc'     => 'svc_acct',
24   'desc'    => 'Real-time export to vpopmail text files',
25   'options' => \%options,
26   'notes'   => <<'END'
27 Real time export to <a href="http://inter7.com/vpopmail/">vpopmail</a> text
28 files.  <a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a>
29 must be installed, and you will need to
30 <a href="../docs/ssh.html">setup SSH for unattended operation</a>
31 to <b>vpopmail</b>@<i>export.host</i>.  See shellcommands_withdomain for an
32 export that uses vpopmail commands instead.
33 END
34 );
35
36 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
37
38 sub rebless { shift; }
39
40 sub _export_insert {
41   my($self, $svc_acct) = (shift, shift);
42   $self->vpopmail_queue( $svc_acct->svcnum, 'insert',
43     $svc_acct->username,
44     crypt($svc_acct->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]),
45     $svc_acct->domain,
46     $svc_acct->quota,
47     $svc_acct->finger,
48   );
49 }
50
51 sub _export_replace {
52   my( $self, $new, $old ) = (shift, shift, shift);
53
54   my $cpassword = crypt(
55     $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))]
56   );
57
58   return "can't change username with vpopmail"
59     if $old->username ne $new->username;
60
61   #no.... if mail can't be preserved, better to disallow username changes
62   #if ($old->username ne $new->username || $old->domain ne $new->domain ) {
63   #  vpopmail_queue( $svc_acct->svcnum, 'delete', 
64   #    $old->username, $old->domain
65   #  );
66   #  vpopmail_queue( $svc_acct->svcnum, 'insert', 
67   #    $new->username,
68   #    $cpassword,
69   #    $new->domain,
70   #  );
71
72   return '' unless $old->_password ne $new->_password;
73
74   $self->vpopmail_queue( $new->svcnum, 'replace',
75     $new->username, $cpassword, $new->domain, $new->quota, $new->finger );
76 }
77
78 sub _export_delete {
79   my( $self, $svc_acct ) = (shift, shift);
80   $self->vpopmail_queue( $svc_acct->svcnum, 'delete',
81     $svc_acct->username, $svc_acct->domain );
82 }
83
84 #a good idea to queue anything that could fail or take any time
85 sub vpopmail_queue {
86   my( $self, $svcnum, $method ) = (shift, shift, shift);
87
88   my $exportdir = "/usr/local/etc/freeside/export." . datasrc;
89   mkdir $exportdir, 0700 or die $! unless -d $exportdir;
90   $exportdir .= "/vpopmail";
91   mkdir $exportdir, 0700 or die $! unless -d $exportdir;
92   $exportdir .= '/'. $self->machine;
93   mkdir $exportdir, 0700 or die $! unless -d $exportdir;
94   mkdir "$exportdir/domains", 0700 or die $! unless -d "$exportdir/domains";
95
96   my $queue = new FS::queue {
97     'svcnum' => $svcnum,
98     'job'    => "FS::part_export::vpopmail::vpopmail_$method",
99   };
100   $queue->insert(
101     $exportdir,
102     $self->machine,
103     $self->option('dir'),
104     $self->option('uid'),
105     $self->option('gid'),
106     $self->option('restart'),
107     @_
108   );
109 }
110
111 sub vpopmail_insert { #subroutine, not method
112   my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6;
113   my( $username, $password, $domain, $quota, $finger ) = @_;
114
115   mkdir "$exportdir/domains/$domain", 0700 or die $!
116     unless -d "$exportdir/domains/$domain";
117
118   (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd")
119     and flock(VPASSWD,LOCK_EX)
120   ) or die "can't open vpasswd file for $username\@$domain: ".
121            "$exportdir/domains/$domain/vpasswd: $!";
122   print VPASSWD join(":",
123     $username,
124     $password,
125     '1',
126     '0',
127     $finger,
128     "$dir/domains/$domain/$username",
129     $quota ? $quota.'S' : 'NOQUOTA',
130   ), "\n";
131
132   flock(VPASSWD,LOCK_UN);
133   close(VPASSWD);
134
135   for my $mkdir (
136     grep { ! -d $_ } map { "$exportdir/domains/$domain/$username$_" }
137         ( '', qw( /Maildir /Maildir/cur /Maildir/new /Maildir/tmp ) )
138   ) {
139     mkdir $mkdir, 0700 or die "can't mkdir $mkdir: $!";
140   }
141
142   vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid, $restart );
143
144 }
145
146 sub vpopmail_replace { #subroutine, not method
147   my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6;
148   my( $username, $password, $domain, $quota, $finger ) = @_;
149   
150   (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
151     and flock(VPASSWD,LOCK_EX)
152   ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
153
154   open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
155     or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!";
156
157   while (<VPASSWD>) {
158     my ($mailbox, $pw, $vuid, $vgid, $vfinger, $vdir, $vquota, @rest) =
159       split(':', $_);
160     if ( $username ne $mailbox ) {
161       print VPASSWDTMP $_;
162       next
163     }
164     print VPASSWDTMP join (':',
165       $mailbox,
166       $password,
167       '1',
168       '0',
169       $finger,
170       "$dir/domains/$domain/$username", #$vdir
171       $quota ? $quota.'S' : 'NOQUOTA',
172     ), "\n";
173   }
174
175   close(VPASSWDTMP);
176
177   rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd"
178     or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!";
179
180   flock(VPASSWD,LOCK_UN);
181   close(VPASSWD);
182
183   vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid, $restart );
184
185 }
186
187 sub vpopmail_delete { #subroutine, not method
188   my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6;
189   my( $username, $domain ) = @_;
190   
191   (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
192     and flock(VPASSWD,LOCK_EX)
193   ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
194
195   open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
196     or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!";
197
198   while (<VPASSWD>) {
199     my ($mailbox, $rest) = split(':', $_);
200     print VPASSWDTMP $_ unless $username eq $mailbox;
201   }
202
203   close(VPASSWDTMP);
204
205   rename "$exportdir/domains/$domain/vpasswd.tmp",
206          "$exportdir/domains/$domain/vpasswd"
207     or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!";
208
209   flock(VPASSWD,LOCK_UN);
210   close(VPASSWD);
211
212   rmtree "$exportdir/domains/$domain/$username"
213     or die "can't rmtree $exportdir/domains/$domain/$username: $!";
214
215   vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid, $restart );
216 }
217
218 sub vpopmail_sync {
219   my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6;
220   
221   chdir $exportdir;
222 #  my @args = ( $rsync, "-rlpt", "-e", $ssh, "domains/",
223 #               "vpopmail\@$machine:$dir/domains/"  );
224 #  system {$args[0]} @args;
225
226   eval "use File::Rsync;";
227   die $@ if $@;
228
229   my $rsync = File::Rsync->new({ rsh => 'ssh' });
230
231   $rsync->exec( {
232     recursive => 1,
233     perms     => 1,
234     times     => 1,
235     src       => "$exportdir/domains/",
236     dest      => "vpopmail\@$machine:$dir/domains/",
237   } ); # true/false return value from exec is not working, alas
238   if ( $rsync->err ) {
239     die "error uploading to vpopmail\@$machine:$dir/domains/ : ".
240         'exit status: '. $rsync->status. ', '.
241         'STDERR: '. join(" / ", $rsync->err). ', '.
242         'STDOUT: '. join(" / ", $rsync->out);
243   }
244
245   eval "use Net::SSH qw(ssh);";
246   die $@ if $@;
247
248   ssh("vpopmail\@$machine", $restart) if $restart;
249 }
250
251 1;
252