FS/FS/part_export/vpopmail.pm

   1 package FS::part_export::vpopmail;
   2
   3 use vars qw(@ISA @saltset $exportdir $rsync $ssh);
   4 use File::Path;
   5 use FS::UID qw( datasrc );
   6 use FS::part_export;
   7
   8 @ISA = qw(FS::part_export);
   9
  10 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
  11
  12 $rsync = "rsync";
  13 $ssh = "ssh";
  14
  15 sub rebless { shift; }
  16
  17 sub _export_insert {
  18   my($self, $svc_acct) = (shift, shift);
  19   $self->vpopmail_queue( $svc_acct->svcnum, 'insert',
  20     $svc_acct->username,
  21     crypt($svc_acct->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]),
  22     $svc_acct->domain,
  23     $svc_acct->quota,
  24   );
  25 }
  26
  27 sub _export_replace {
  28   my( $self, $new, $old ) = (shift, shift, shift);
  29
  30   my $cpassword = crypt(
  31     $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))]
  32   );
  33
  34   return "can't change username with vpopmail"
  35     if $old->username ne $new->username;
  36
  37   #no.... if mail can't be preserved, better to disallow username changes
  38   #if ($old->username ne $new->username || $old->domain ne $new->domain ) {
  39   #  vpopmail_queue( $svc_acct->svcnum, 'delete',
  40   #    $old->username, $old->domain
  41   #  );
  42   #  vpopmail_queue( $svc_acct->svcnum, 'insert',
  43   #    $new->username,
  44   #    $cpassword,
  45   #    $new->domain,
  46   #  );
  47
  48   return '' unless $old->_password ne $new->_password;
  49
  50   $self->vpopmail_queue( $new->svcnum, 'replace',
  51     $new->username, $cpassword, $new->domain, $new->quota );
  52 }
  53
  54 sub _export_delete {
  55   my( $self, $svc_acct ) = (shift, shift);
  56   $self->vpopmail_queue( $svc_acct->svcnum, 'delete',
  57     $svc_acct->username, $svc_acct->domain );
  58 }
  59
  60 #a good idea to queue anything that could fail or take any time
  61 sub vpopmail_queue {
  62   my( $self, $svcnum, $method ) = (shift, shift, shift);
  63   my $exportdir = "/usr/local/etc/freeside/export." . datasrc;
  64   my $queue = new FS::queue {
  65     'svcnum' => $svcnum,
  66     'job'    => "FS::part_export::vpopmail::vpopmail_$method",
  67   };
  68   $queue->insert(
  69     $exportdir,
  70     $self->machine,
  71     $self->option('dir'),
  72     $self->option('uid'),
  73     $self->option('gid'),
  74     @_
  75   );
  76 }
  77
  78 sub vpopmail_insert { #subroutine, not method
  79   my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5;
  80   my( $username, $password, $domain, $quota ) = @_;
  81
  82   (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd")
  83     and flock(VPASSWD,LOCK_EX)
  84   ) or die "can't open vpasswd file for $username\@$domain: ".
  85            "$exportdir/domains/$domain/vpasswd: $!";
  86   print VPASSWD join(":",
  87     $username,
  88     $password,
  89     '1',
  90     '0',
  91     $finger,
  92     "$dir/domains/$domain/$username",
  93     $quota ? $quota.'S' : 'NOQUOTA',
  94   ), "\n";
  95
  96   flock(VPASSWD,LOCK_UN);
  97   close(VPASSWD);
  98
  99   for my $mkdir (
 100     map { "$exportdir/domains/$domain/$username$_" }
 101       ( '', qw( /Maildir /Maildir/cur /Maildir/new /Maildir/tmp ) )
 102   ) {
 103     mkdir $mkdir, 0700 or die "can't mkdir $mkdir: $!";
 104   }
 105
 106   vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid );
 107
 108 }
 109
 110 sub vpopmail_replace { #subroutine, not method
 111   my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5;
 112   my( $username, $password, $domain ) = @_;
 113
 114   (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
 115     and flock(VPASSWD,LOCK_EX)
 116   ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
 117
 118   open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
 119     or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!";
 120
 121   while (<VPASSWD>) {
 122     my ($mailbox, $pw, $vuid, $vgid, $vfinger, $vdir, $vquota, @rest) =
 123       split(':', $_);
 124     if ( $username ne $mailbox ) {
 125       print VPASSWDTMP $_;
 126       next
 127     }
 128     print VPASSWDTMP join (':',
 129       $mailbox,
 130       $password,
 131       '1',
 132       '0',
 133       $finger,
 134       $dir,
 135       $quota ? $quota.'S' : 'NOQUOTA',
 136     ), "\n";
 137   }
 138
 139   close(VPASSWDTMP);
 140
 141   rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd"
 142     or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!";
 143
 144   flock(VPASSWD,LOCK_UN);
 145   close(VPASSWD);
 146
 147   vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid );
 148
 149 }
 150
 151 sub vpopmail_delete { #subroutine, not method
 152   my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5;
 153   my( $username, $domain ) = @_;
 154
 155   (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
 156     and flock(VPASSWD,LOCK_EX)
 157   ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
 158
 159   open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
 160     or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!";
 161
 162   while (<VPASSWD>) {
 163     my ($mailbox, $rest) = split(':', $_);
 164     print VPASSWDTMP $_ unless $username eq $mailbox;
 165   }
 166
 167   close(VPASSWDTMP);
 168
 169   rename "$exportdir/domains/$domain/vpasswd.tmp",
 170          "$exportdir/domains/$domain/vpasswd"
 171     or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!";
 172
 173   flock(VPASSWD,LOCK_UN);
 174   close(VPASSWD);
 175
 176   rmtree "$exportdir/domains/$domain/$username"
 177     or die "can't rmtree $exportdir/domains/$domain/$username: $!";
 178
 179   vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid );
 180 }
 181
 182 sub vpopmail_sync {
 183   my( $exportdir, $machine, $dir, $uid, $gid ) = splice @_,0,5;
 184
 185   chdir $exportdir;
 186 #  my @args = ( $rsync, "-rlpt", "-e", $ssh, "domains/",
 187 #               "vpopmail\@$machine:$dir/domains/"  );
 188 #  system {$args[0]} @args;
 189
 190   eval "use File::Rsync;";
 191   die $@ if $@;
 192
 193   my $rsync = File::Rsync->new({ rsh => 'ssh' });
 194
 195   $rsync->exec( {
 196     recursive => 1,
 197     perms     => 1,
 198     times     => 1,
 199     src       => "$exportdir/domains/",
 200     dest      => "vpopmail\@$machine:$dir/domains/",
 201   } ); # true/false return value from exec is not working, alas
 202   if ( $rsync->err ) {
 203     die "error uploading to vpopmail\@$machine:$dir/domains/ : ".
 204         'exit status: '. $rsync->status. ', '.
 205         'STDERR: '. join(" / ", $rsync->err). ', '.
 206         'STDOUT: '. join(" / ", $rsync->out);
 207   }
 208 }
 209
 210