FS/FS/svc_forward.pm

   1 package FS::svc_forward;
   2
   3 use strict;
   4 use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines
   5              @vpopmailmachines );
   6 use Net::SSH qw(ssh);
   7 use FS::Conf;
   8 use FS::Record qw( fields qsearch qsearchs );
   9 use FS::svc_Common;
  10 use FS::cust_svc;
  11 use FS::svc_acct;
  12 use FS::svc_domain;
  13
  14 @ISA = qw( FS::svc_Common );
  15
  16 #ask FS::UID to run this stuff for us later
  17 $FS::UID::callback{'FS::svc_forward'} = sub {
  18   $conf = new FS::Conf;
  19   if ( $conf->exists('qmailmachines') ) {
  20     $shellmachine = $conf->config('shellmachine')
  21   } else {
  22     $shellmachine = '';
  23   }
  24   if ( $conf->exists('vpopmailmachines') ) {
  25     @vpopmailmachines = $conf->config('vpopmailmachines');
  26   } else {
  27     @vpopmailmachines = ();
  28   }
  29 };
  30
  31 =head1 NAME
  32
  33 FS::svc_forward - Object methods for svc_forward records
  34
  35 =head1 SYNOPSIS
  36
  37   use FS::svc_forward;
  38
  39   $record = new FS::svc_forward \%hash;
  40   $record = new FS::svc_forward { 'column' => 'value' };
  41
  42   $error = $record->insert;
  43
  44   $error = $new_record->replace($old_record);
  45
  46   $error = $record->delete;
  47
  48   $error = $record->check;
  49
  50   $error = $record->suspend;
  51
  52   $error = $record->unsuspend;
  53
  54   $error = $record->cancel;
  55
  56 =head1 DESCRIPTION
  57
  58 An FS::svc_forward object represents a mail forwarding alias.  FS::svc_forward
  59 inherits from FS::Record.  The following fields are currently supported:
  60
  61 =over 4
  62
  63 =item svcnum - primary key (assigned automatcially for new accounts)
  64
  65 =item srcsvc - svcnum of the source of the forward (see L<FS::svc_acct>)
  66
  67 =item dstsvc - svcnum of the destination of the forward (see L<FS::svc_acct>)
  68
  69 =item dst - foreign destination (email address) - forward not local to freeside
  70
  71 =back
  72
  73 =head1 METHODS
  74
  75 =over 4
  76
  77 =item new HASHREF
  78
  79 Creates a new mail forwarding alias.  To add the mail forwarding alias to the
  80 database, see L<"insert">.
  81
  82 =cut
  83
  84 sub table { 'svc_forward'; }
  85
  86 =item insert
  87
  88 Adds this mail forwarding alias to the database.  If there is an error, returns
  89 the error, otherwise returns false.
  90
  91 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
  92 defined.  An FS::cust_svc record will be created and inserted.
  93
  94 If the configuration value (see L<FS::Conf>) vpopmailmachines exists, then
  95 the command:
  96
  97   [ -d $vpopdir/$domain/$source ] || {
  98     echo "$destination" >> $vpopdir/$domain/$username/.$qmail
  99     chown $vpopuid:$vpopgid $vpopdir/$domain/$username/.$qmail
 100   }
 101
 102 is executed on each vpopmailmachine via ssh (see the vpopmail documentation).
 103 This behaviour can be supressed by setting $FS::svc_forward::nossh_hack true.
 104
 105 =cut
 106
 107 sub insert {
 108   my $self = shift;
 109   my $error;
 110
 111   local $SIG{HUP} = 'IGNORE';
 112   local $SIG{INT} = 'IGNORE';
 113   local $SIG{QUIT} = 'IGNORE';
 114   local $SIG{TERM} = 'IGNORE';
 115   local $SIG{TSTP} = 'IGNORE';
 116   local $SIG{PIPE} = 'IGNORE';
 117
 118   $error = $self->check;
 119   return $error if $error;
 120
 121   $error = $self->SUPER::insert;
 122   return $error if $error;
 123
 124   my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } );
 125   my $username = $svc_acct->username;
 126   my $domain = $svc_acct->domain;
 127   my $destination;
 128   if ($self->dstsvc) {
 129     my $dst_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->dstsvc } );
 130     $destination = $dst_svc_acct->email;
 131   } else {
 132     $destination = $self->dst;
 133   }
 134
 135   foreach my $vpopmailmachine ( @vpopmailmachines ) {
 136     my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine);
 137     ssh("root\@$machine","[ -d $vpopdir/$domain/$username ] || { echo \"$destination\" >> $vpopdir/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/$domain/$username/.qmail; }")
 138       unless $nossh_hack;
 139   }
 140
 141   ''; #no error
 142
 143 }
 144
 145 =item delete
 146
 147 Deletes this mail forwarding alias from the database.  If there is an error,
 148 returns the error, otherwise returns false.
 149
 150 The corresponding FS::cust_svc record will be deleted as well.
 151
 152 =item replace OLD_RECORD
 153
 154 Replaces OLD_RECORD with this one in the database.  If there is an error,
 155 returns the error, otherwise returns false.
 156
 157 If srcsvc changes, and the configuration value vpopmailmachines exists, then
 158 the command:
 159
 160   rm $vpopdir/$domain/$username/.qmail
 161
 162 is executed on each vpopmailmachine via ssh.  This behaviour can be supressed
 163 by setting $FS::svc_forward_nossh_hack true.
 164
 165 If dstsvc changes (or dstsvc is 0 and dst changes), and the configuration value
 166 vpopmailmachines exists, then the command:
 167
 168   [ -d $vpopdir/$domain/$source ] || {
 169     echo "$destination" >> $vpopdir/$domain/$username/.$qmail
 170     chown $vpopuid:$vpopgid $vpopdir/$domain/$username/.$qmail
 171   }
 172
 173 is executed on each vpopmailmachine via ssh.  This behaviour can be supressed
 174 by setting $FS::svc_forward_nossh_hack true.
 175
 176 =cut
 177
 178 sub replace {
 179   my ( $new, $old ) = ( shift, shift );
 180
 181   if ( $new->srcsvc != $old->srcsvc
 182        && ( $new->dstsvc != $old->dstsvc
 183             || ! $new->dstsvc && $new->dst ne $old->dst
 184           )
 185       ) {
 186     return "Can't change both source and destination of a mail forward!"
 187   }
 188
 189   local $SIG{HUP} = 'IGNORE';
 190   local $SIG{INT} = 'IGNORE';
 191   local $SIG{QUIT} = 'IGNORE';
 192   local $SIG{TERM} = 'IGNORE';
 193   local $SIG{TSTP} = 'IGNORE';
 194   local $SIG{PIPE} = 'IGNORE';
 195
 196   my $error = $new->SUPER::replace($old);
 197   return $error if $error;
 198
 199   if ( $new->srcsvc != $old->srcsvc ) {
 200     my $old_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $old->srcsvc } );
 201     my $old_username = $old_svc_acct->username;
 202     my $old_domain = $old_svc_acct->domain;
 203     foreach my $vpopmailmachine ( @vpopmailmachines ) {
 204       my($machine, $vpopdir, $vpopuid, $vpopgid) =
 205         split(/\s+/, $vpopmailmachine);
 206       ssh("root\@$machine","rm $vpopdir/$old_domain/$old_username/.qmail")
 207         unless $nossh_hack;
 208     }
 209   }
 210
 211   #false laziness with stuff in insert, should subroutine
 212   my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $new->srcsvc } );
 213   my $username = $svc_acct->username;
 214   my $domain = $svc_acct->domain;
 215   my $destination;
 216   if ($new->dstsvc) {
 217     my $dst_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $new->dstsvc } );
 218     $destination = $dst_svc_acct->email;
 219   } else {
 220     $destination = $new->dst;
 221   }
 222
 223   foreach my $vpopmailmachine ( @vpopmailmachines ) {
 224     my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine);
 225     ssh("root\@$machine","[ -d $vpopdir/$domain/$username ] || { echo \"$destination\" >> $vpopdir/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/$domain/$username/.qmail; }")
 226       unless $nossh_hack;
 227   }
 228   #end subroutinable bits
 229
 230   '';
 231 }
 232
 233 =item suspend
 234
 235 Just returns false (no error) for now.
 236
 237 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 238
 239 =item unsuspend
 240
 241 Just returns false (no error) for now.
 242
 243 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 244
 245 =item cancel
 246
 247 Just returns false (no error) for now.
 248
 249 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 250
 251 =item check
 252
 253 Checks all fields to make sure this is a valid mail forwarding alias.  If there
 254 is an error, returns the error, otherwise returns false.  Called by the insert
 255 and replace methods.
 256
 257 Sets any fixed values; see L<FS::part_svc>.
 258
 259 =cut
 260
 261 sub check {
 262   my $self = shift;
 263
 264   my $x = $self->setfixed;
 265   return $x unless ref($x);
 266   #my $part_svc = $x;
 267
 268   my $error = $self->ut_numbern('svcnum')
 269               || $self->ut_number('srcsvc')
 270               || $self->ut_numbern('dstsvc')
 271   ;
 272   return $error if $error;
 273
 274   return "Unknown srcsvc" unless $self->srcsvc_acct;
 275
 276   return "Both dstsvc and dst were defined; one one can be specified"
 277     if $self->dstsvc && $self->dst;
 278
 279   return "one of dstsvc or dst is required"
 280     unless $self->dstsvc || $self->dst;
 281
 282   return "Unknown dstsvc" unless $self->dstsvc_acct || ! $self->dstsvc;
 283
 284   if ( $self->dst ) {
 285     $self->dst =~ /^([\w\.\-]+)\@(([\w\-]+\.)+\w+)$/
 286        or return "Illegal dst: ". $self->dst;
 287     $self->dst("$1\@$2");
 288   } else {
 289     $self->dst('');
 290   }
 291
 292   ''; #no error
 293 }
 294
 295 =item srcsvc_acct
 296
 297 Returns the FS::svc_acct object referenced by the srcsvc column.
 298
 299 =cut
 300
 301 sub srcsvc_acct {
 302   my $self = shift;
 303   qsearchs('svc_acct', { 'svcnum' => $self->srcsvc } );
 304 }
 305
 306 =item dstsvc_acct
 307
 308 Returns the FS::svc_acct object referenced by the srcsvc column, or false for
 309 forwards not local to freeside.
 310
 311 =cut
 312
 313 sub dstsvc_acct {
 314   my $self = shift;
 315   qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } );
 316 }
 317
 318 =back
 319
 320 =head1 VERSION
 321
 322 $Id: svc_forward.pm,v 1.9 2002-02-11 23:01:01 ivan Exp $
 323
 324 =head1 BUGS
 325
 326 The remote commands should be configurable.
 327
 328 =head1 SEE ALSO
 329
 330 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 331 L<FS::svc_acct>, L<FS::svc_domain>, L<Net::SSH>, L<ssh>, L<dot-qmail>,
 332 schema.html from the base documentation.
 333
 334 =cut
 335
 336 1;
 337