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