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 dbh );
   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/domains/$domain/$source ] && {
  98     echo "$destination" >> $vpopdir/domains/$domain/$username/.$qmail
  99     chown $vpopuid:$vpopgid $vpopdir/domains/$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   my $oldAutoCommit = $FS::UID::AutoCommit;
 119   local $FS::UID::AutoCommit = 0;
 120   my $dbh = dbh;
 121
 122   $error = $self->check;
 123   return $error if $error;
 124
 125   $error = $self->SUPER::insert;
 126   if ($error) {
 127     $dbh->rollback if $oldAutoCommit;
 128     return $error;
 129   }
 130
 131   my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } );
 132   my $username = $svc_acct->username;
 133   my $domain = $svc_acct->domain;
 134   my $destination;
 135   if ($self->dstsvc) {
 136     $destination = $self->dstsvc_acct->email;
 137   } else {
 138     $destination = $self->dst;
 139   }
 140
 141   foreach my $vpopmailmachine ( @vpopmailmachines ) {
 142     my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine);
 143     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' };  # should be neater
 144     my $error = $queue->insert("root\@$machine","[ -d $vpopdir/domains/$domain/$username ] && { echo \"$destination\" >> $vpopdir/domains/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.qmail; }")
 145       unless $nossh_hack;
 146     if ( $error ) {
 147       $dbh->rollback if $oldAutoCommit;
 148       return "queueing job (transaction rolled back): $error";
 149     }
 150
 151   }
 152
 153   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 154   ''; #no error
 155
 156 }
 157
 158 =item delete
 159
 160 Deletes this mail forwarding alias from the database.  If there is an error,
 161 returns the error, otherwise returns false.
 162
 163 The corresponding FS::cust_svc record will be deleted as well.
 164
 165 If the configuration value vpopmailmachines exists, then the command:
 166
 167   { sed -e '/^$destination/d' <
 168       $vpopdir/domains/$srcdomain/$srcusername/.qmail >
 169       $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp;
 170     mv $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp
 171       $vpopdir/domains/$srcdomain/$srcusername/.qmail;
 172     chown $vpopuid.$vpopgid $vpopdir/domains/$srcdomain/$srcusername/.qmail; }
 173
 174
 175 is executed on each vpopmailmachine via ssh.  This behaviour can be supressed
 176 by setting $FS::svc_forward_nossh_hack true.
 177
 178 =cut
 179
 180 sub delete {
 181   my $self = shift;
 182
 183   local $SIG{HUP} = 'IGNORE';
 184   local $SIG{INT} = 'IGNORE';
 185   local $SIG{QUIT} = 'IGNORE';
 186   local $SIG{TERM} = 'IGNORE';
 187   local $SIG{TSTP} = 'IGNORE';
 188   local $SIG{PIPE} = 'IGNORE';
 189
 190   my $oldAutoCommit = $FS::UID::AutoCommit;
 191   local $FS::UID::Autocommit = 0;
 192   my $dbh = dbh;
 193
 194   my $error = $self->SUPER::delete;
 195   if ( $error ) {
 196     $dbh->rollback if $oldAutoCommit;
 197     return $error;
 198   }
 199
 200   my $svc_acct = $self->srcsvc_acct;
 201   my $username = $svc_acct->username;
 202   my $domain = $svc_acct->domain;
 203   my $destination;
 204   if ($self->dstsvc) {
 205     $destination = $self->dstsvc_acct->email;
 206   } else {
 207     $destination = $self->dst;
 208   }
 209   foreach my $vpopmailmachine ( @vpopmailmachines ) {
 210     my($machine, $vpopdir, $vpopuid, $vpopgid) =
 211       split(/\s+/, $vpopmailmachine);
 212     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' };  # should be neater
 213     my $error = $queue->insert("root\@$machine",
 214       "sed -e '/^$destination/d' " .
 215         "< $vpopdir/domains/$domain/$username/.qmail" .
 216         "> $vpopdir/domains/$domain/$username/.qmail.temp; " .
 217       "mv $vpopdir/domains/$domain/$username/.qmail.temp " .
 218         "$vpopdir/domains/$domain/$username/.qmail; " .
 219       "chown $vpopuid.$vpopgid $vpopdir/domains/$domain/$username/.qmail;"
 220     )
 221       unless $nossh_hack;
 222
 223     if ($error ) {
 224       $dbh->rollback if $oldAutoCommit;
 225       return "queueing job (transaction rolled back): $error";
 226     }
 227
 228   }
 229
 230   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 231   '';
 232 }
 233
 234
 235 =item replace OLD_RECORD
 236
 237 Replaces OLD_RECORD with this one in the database.  If there is an error,
 238 returns the error, otherwise returns false.
 239
 240 If the configuration value vpopmailmachines exists, then the command:
 241
 242   { sed -e '/^$destination/d' <
 243       $vpopdir/domains/$srcdomain/$srcusername/.qmail >
 244       $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp;
 245     mv $vpopdir/domains/$srcdomain/$srcusername/.qmail.temp
 246       $vpopdir/domains/$srcdomain/$srcusername/.qmail;
 247     chown $vpopuid.$vpopgid $vpopdir/domains/$srcdomain/$srcusername/.qmail; }
 248
 249
 250 is executed on each vpopmailmachine via ssh.  This behaviour can be supressed
 251 by setting $FS::svc_forward_nossh_hack true.
 252
 253 Also, if the configuration value vpopmailmachines exists, then the command:
 254
 255   [ -d $vpopdir/domains/$domain/$source ] && {
 256     echo "$destination" >> $vpopdir/domains/$domain/$username/.$qmail
 257     chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.$qmail
 258   }
 259
 260 is executed on each vpopmailmachine via ssh.  This behaviour can be supressed
 261 by setting $FS::svc_forward_nossh_hack true.
 262
 263 =cut
 264
 265 sub replace {
 266   my ( $new, $old ) = ( shift, shift );
 267
 268   if ( $new->srcsvc != $old->srcsvc
 269        && ( $new->dstsvc != $old->dstsvc
 270             || ! $new->dstsvc && $new->dst ne $old->dst
 271           )
 272       ) {
 273     return "Can't change both source and destination of a mail forward!"
 274   }
 275
 276   local $SIG{HUP} = 'IGNORE';
 277   local $SIG{INT} = 'IGNORE';
 278   local $SIG{QUIT} = 'IGNORE';
 279   local $SIG{TERM} = 'IGNORE';
 280   local $SIG{TSTP} = 'IGNORE';
 281   local $SIG{PIPE} = 'IGNORE';
 282
 283   my $oldAutoCommit = $FS::UID::AutoCommit;
 284   local $FS::UID::AutoCommit = 0;
 285   my $dbh = dbh;
 286
 287   my $error = $new->SUPER::replace($old);
 288   if ($error) {
 289     $dbh->rollback if $oldAutoCommit;
 290     return $error;
 291   }
 292
 293   my $old_svc_acct = $old->srcsvc_acct;
 294   my $old_username = $old_svc_acct->username;
 295   my $old_domain = $old_svc_acct->domain;
 296   my $destination;
 297   if ($old->dstsvc) {
 298     $destination = $old->dstsvc_acct->email;
 299   } else {
 300     $destination = $old->dst;
 301   }
 302   foreach my $vpopmailmachine ( @vpopmailmachines ) {
 303     my($machine, $vpopdir, $vpopuid, $vpopgid) =
 304       split(/\s+/, $vpopmailmachine);
 305     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' };  # should be neater
 306     my $error = $queue->insert("root\@$machine",
 307       "sed -e '/^$destination/d' " .
 308         "< $vpopdir/domains/$old_domain/$old_username/.qmail" .
 309         "> $vpopdir/domains/$old_domain/$old_username/.qmail.temp; " .
 310       "mv $vpopdir/domains/$old_domain/$old_username/.qmail.temp " .
 311         "$vpopdir/domains/$old_domain/$old_username/.qmail; " .
 312       "chown $vpopuid.$vpopgid " .
 313         "$vpopdir/domains/$old_domain/$old_username/.qmail;"
 314     )
 315       unless $nossh_hack;
 316
 317     if ( $error ) {
 318        $dbh->rollback if $oldAutoCommit;
 319        return "queueing job (transaction rolled back): $error";
 320     }
 321   }
 322
 323   #false laziness with stuff in insert, should subroutine
 324   my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $new->srcsvc } );
 325   my $username = $svc_acct->username;
 326   my $domain = $svc_acct->domain;
 327   if ($new->dstsvc) {
 328     $destination = $new->dstsvc_acct->email;
 329   } else {
 330     $destination = $new->dst;
 331   }
 332
 333   foreach my $vpopmailmachine ( @vpopmailmachines ) {
 334     my($machine, $vpopdir, $vpopuid, $vpopgid) = split(/\s+/, $vpopmailmachine);
 335     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' };  # should be neater
 336     my $error = $queue->insert("root\@$machine","[ -d $vpopdir/domains/$domain/$username ] && { echo \"$destination\" >> $vpopdir/domains/$domain/$username/.qmail; chown $vpopuid:$vpopgid $vpopdir/domains/$domain/$username/.qmail; }")
 337       unless $nossh_hack;
 338     if ( $error ) {
 339        $dbh->rollback if $oldAutoCommit;
 340        return "queueing job (transaction rolled back): $error";
 341     }
 342   }
 343   #end subroutinable bits
 344
 345   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 346   '';
 347 }
 348
 349 =item suspend
 350
 351 Just returns false (no error) for now.
 352
 353 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 354
 355 =item unsuspend
 356
 357 Just returns false (no error) for now.
 358
 359 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 360
 361 =item cancel
 362
 363 Just returns false (no error) for now.
 364
 365 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 366
 367 =item check
 368
 369 Checks all fields to make sure this is a valid mail forwarding alias.  If there
 370 is an error, returns the error, otherwise returns false.  Called by the insert
 371 and replace methods.
 372
 373 Sets any fixed values; see L<FS::part_svc>.
 374
 375 =cut
 376
 377 sub check {
 378   my $self = shift;
 379
 380   my $x = $self->setfixed;
 381   return $x unless ref($x);
 382   #my $part_svc = $x;
 383
 384   my $error = $self->ut_numbern('svcnum')
 385               || $self->ut_number('srcsvc')
 386               || $self->ut_numbern('dstsvc')
 387   ;
 388   return $error if $error;
 389
 390   return "Unknown srcsvc" unless $self->srcsvc_acct;
 391
 392   return "Both dstsvc and dst were defined; one one can be specified"
 393     if $self->dstsvc && $self->dst;
 394
 395   return "one of dstsvc or dst is required"
 396     unless $self->dstsvc || $self->dst;
 397
 398   #return "Unknown dstsvc: $dstsvc" unless $self->dstsvc_acct || ! $self->dstsvc;
 399   return "Unknown dstsvc"
 400     unless qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } )
 401            || ! $self->dstsvc;
 402
 403
 404   if ( $self->dst ) {
 405     $self->dst =~ /^([\w\.\-]+)\@(([\w\-]+\.)+\w+)$/
 406        or return "Illegal dst: ". $self->dst;
 407     $self->dst("$1\@$2");
 408   } else {
 409     $self->dst('');
 410   }
 411
 412   ''; #no error
 413 }
 414
 415 =item srcsvc_acct
 416
 417 Returns the FS::svc_acct object referenced by the srcsvc column.
 418
 419 =cut
 420
 421 sub srcsvc_acct {
 422   my $self = shift;
 423   qsearchs('svc_acct', { 'svcnum' => $self->srcsvc } );
 424 }
 425
 426 =item dstsvc_acct
 427
 428 Returns the FS::svc_acct object referenced by the srcsvc column, or false for
 429 forwards not local to freeside.
 430
 431 =cut
 432
 433 sub dstsvc_acct {
 434   my $self = shift;
 435   qsearchs('svc_acct', { 'svcnum' => $self->dstsvc } );
 436 }
 437
 438 =back
 439
 440 =head1 VERSION
 441
 442 $Id: svc_forward.pm,v 1.10 2002-02-17 19:07:32 jeff Exp $
 443
 444 =head1 BUGS
 445
 446 The remote commands should be configurable.
 447
 448 =head1 SEE ALSO
 449
 450 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 451 L<FS::svc_acct>, L<FS::svc_domain>, L<Net::SSH>, L<ssh>, L<dot-qmail>,
 452 schema.html from the base documentation.
 453
 454 =cut
 455
 456 1;
 457