FS/FS/svc_forward.pm

   1 package FS::svc_forward;
   2
   3 use strict;
   4 use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines @vpopmailmachines);
   5 use FS::Record qw( fields qsearch qsearchs );
   6 use FS::svc_Common;
   7 use FS::cust_svc;
   8 use Net::SSH qw(ssh);
   9 use FS::Conf;
  10 use FS::svc_acct;
  11 use FS::svc_domain;
  12
  13 @ISA = qw( FS::svc_Common );
  14
  15 #ask FS::UID to run this stuff for us later
  16 $FS::UID::callback{'FS::svc_forward'} = sub {
  17   $conf = new FS::Conf;
  18   $shellmachine = $conf->exists('qmailmachines')
  19                   ? $conf->config('shellmachine')
  20                   : '';
  21   if ( $conf->exists('vpopmailmachines') ) {
  22     @vpopmailmachines = $conf->config('vpopmailmachines');
  23   }
  24 };
  25
  26 =head1 NAME
  27
  28 FS::svc_forward - Object methods for svc_forward records
  29
  30 =head1 SYNOPSIS
  31
  32   use FS::svc_forward;
  33
  34   $record = new FS::svc_forward \%hash;
  35   $record = new FS::svc_forward { 'column' => 'value' };
  36
  37   $error = $record->insert;
  38
  39   $error = $new_record->replace($old_record);
  40
  41   $error = $record->delete;
  42
  43   $error = $record->check;
  44
  45   $error = $record->suspend;
  46
  47   $error = $record->unsuspend;
  48
  49   $error = $record->cancel;
  50
  51 =head1 DESCRIPTION
  52
  53 An FS::svc_forward object represents a mail forwarding alias.  FS::svc_forward
  54 inherits from FS::Record.  The following fields are currently supported:
  55
  56 =over 4
  57
  58 =item svcnum - primary key (assigned automatcially for new accounts)
  59
  60 =item srcsvc - svcnum of the source of the forward (see L<FS::svc_acct>)
  61
  62 =item dstsvc - svcnum of the destination of the forward (see L<FS::svc_acct>)
  63
  64 =item dst - foreign destination (email address) - forward not local to freeside
  65
  66 =back
  67
  68 =head1 METHODS
  69
  70 =over 4
  71
  72 =item new HASHREF
  73
  74 Creates a new mail forwarding alias.  To add the mail forwarding alias to the
  75 database, see L<"insert">.
  76
  77 =cut
  78
  79 sub table { 'svc_forward'; }
  80
  81 =item insert
  82
  83 Adds this mail forwarding alias to the database.  If there is an error, returns
  84 the error, otherwise returns false.
  85
  86 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
  87 defined.  An FS::cust_svc record will be created and inserted.
  88
  89 If the configuration values (see L<FS::Conf>) vpopmailmachines exist, then
  90 the command:
  91
  92   [ -d /home/vpopmail/$vdomain/$source ] || {
  93     echo "$destination" >> /home/vpopmail/$vdomain/$source/.$qmail
  94     chown $vpopuid:$vpopgid /home/vpopmail/$vdomain/$source/.$qmail
  95   }
  96
  97 is executed on each vpopmailmachine via ssh (see L<dot-qmail/"EXTENSION ADDRESSES">).
  98 This behaviour can be surpressed by setting $FS::svc_forward::nossh_hack true.
  99
 100 =cut
 101
 102 sub insert {
 103   my $self = shift;
 104   my $error;
 105
 106   local $SIG{HUP} = 'IGNORE';
 107   local $SIG{INT} = 'IGNORE';
 108   local $SIG{QUIT} = 'IGNORE';
 109   local $SIG{TERM} = 'IGNORE';
 110   local $SIG{TSTP} = 'IGNORE';
 111   local $SIG{PIPE} = 'IGNORE';
 112
 113   $error=$self->check;
 114   return $error if $error;
 115
 116   $error = $self->SUPER::insert;
 117   return $error if $error;
 118
 119   my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->srcsvc } );
 120   my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $svc_acct->domsvc } );
 121   my $source = $svc_acct->username . $svc_domain->domain;
 122   my $destination;
 123   if ($self->dstdvc) {
 124     my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->dstsvc } );
 125     my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $svc_acct->domsvc } );
 126     $destination = $svc_acct->username . $svc_domain->domain;
 127   } else {
 128     $destination = $self->dst;
 129   }
 130
 131   my $vdomain = $svc_acct->domain;
 132
 133   foreach my $vpopmailmachine ( @vpopmailmachines ) {
 134     my ($machine, $vpopdir, $vpopuid, $vpopgid) = split (/\s+/, $vpopmailmachine);
 135
 136     ssh("root\@$machine","[ -d $vpopdir/$vdomain/$source ] || { echo $destination >> $vpopdir/$vdomain/$source/.qmail; chown $vpopuid:$vpopgid $vpopdir/$vdomain/$source/.qmail; }")
 137       if ( ! $nossh_hack && $machine);
 138   }
 139
 140   ''; #no error
 141
 142 }
 143
 144 =item delete
 145
 146 Deletes this mail forwarding alias from the database.  If there is an error,
 147 returns the error, otherwise returns false.
 148
 149 The corresponding FS::cust_svc record will be deleted as well.
 150
 151 =item replace OLD_RECORD
 152
 153 Replaces OLD_RECORD with this one in the database.  If there is an error,
 154 returns the error, otherwise returns false.
 155
 156 =cut
 157
 158 sub replace {
 159   my ( $new, $old ) = ( shift, shift );
 160   my $error;
 161
 162  $new->SUPER::replace($old);
 163
 164 }
 165
 166 =item suspend
 167
 168 Just returns false (no error) for now.
 169
 170 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 171
 172 =item unsuspend
 173
 174 Just returns false (no error) for now.
 175
 176 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 177
 178 =item cancel
 179
 180 Just returns false (no error) for now.
 181
 182 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 183
 184 =item check
 185
 186 Checks all fields to make sure this is a valid mail forwarding alias.  If there
 187 is an error, returns the error, otherwise returns false.  Called by the insert
 188 and replace methods.
 189
 190 Sets any fixed values; see L<FS::part_svc>.
 191
 192 =cut
 193
 194 sub check {
 195   my $self = shift;
 196   my $error;
 197
 198   my $x = $self->setfixed;
 199   return $x unless ref($x);
 200   my $part_svc = $x;
 201
 202   my($recref) = $self->hashref;
 203
 204   $recref->{srcsvc} =~ /^(\d+)$/ or return "Illegal srcsvc";
 205   $recref->{srcsvc} = $1;
 206   my($svc_acct);
 207   return "Unknown srcsvc" unless
 208     $svc_acct=qsearchs('svc_acct',{'svcnum'=> $recref->{srcsvc} } );
 209
 210   return "Illegal use of dstsvc and dst" if
 211     ($recref->{dstsvc} && $recref->{dst});
 212
 213   return "Illegal use of dstsvc and dst" if
 214     (! $recref->{dstsvc} && ! $recref->{dst});
 215
 216   $recref->{dstsvc} =~ /^(\d+)$/ or return "Illegal dstsvc";
 217   $recref->{dstsvc} = $1;
 218
 219   if ($recref->{dstsvc}) {
 220     my($svc_acct);
 221     return "Unknown dstsvc" unless
 222       my $svc_domain=qsearchs('svc_acct',{'svcnum'=> $recref->{dstsvc} } );
 223   }
 224
 225   if ($recref->{dst}) {
 226     $recref->{dst} =~ /^([\w\.\-]+)\@(([\w\.\-]+\.)+\w+)$/
 227        or return "Illegal dst";
 228   }
 229
 230   ''; #no error
 231 }
 232
 233 =back
 234
 235 =head1 VERSION
 236
 237 $Id: svc_forward.pm,v 1.3 2001-08-19 15:53:35 jeff Exp $
 238
 239 =head1 BUGS
 240
 241 The remote commands should be configurable.
 242
 243 The $recref stuff in sub check should be cleaned up.
 244
 245 =head1 SEE ALSO
 246
 247 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 248 L<FS::svc_acct>, L<FS::svc_domain>, L<Net::SSH>, L<ssh>, L<dot-qmail>,
 249 schema.html from the base documentation.
 250
 251 =cut
 252
 253 1;
 254