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 values (see L<FS::Conf>) vpopmailmachines exist, then
  95 the command:
  96
  97   [ -d /home/vpopmail/$vdomain/$source ] || {
  98     echo "$destination" >> /home/vpopmail/$vdomain/$source/.$qmail
  99     chown $vpopuid:$vpopgid /home/vpopmail/$vdomain/$source/.$qmail
 100   }
 101
 102 is executed on each vpopmailmachine via ssh (see L<dot-qmail/"EXTENSION ADDRESSES">).
 103 This behaviour can be surpressed 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 $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $svc_acct->domsvc } );
 126   my $source = $svc_acct->username . $svc_domain->domain;
 127   my $destination;
 128   if ($self->dstdvc) {
 129     my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->dstsvc } );
 130     my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $svc_acct->domsvc } );
 131     $destination = $svc_acct->username . $svc_domain->domain;
 132   } else {
 133     $destination = $self->dst;
 134   }
 135
 136   my $vdomain = $svc_acct->domain;
 137
 138   foreach my $vpopmailmachine ( @vpopmailmachines ) {
 139     my ($machine, $vpopdir, $vpopuid, $vpopgid) = split (/\s+/, $vpopmailmachine);
 140
 141     ssh("root\@$machine","[ -d $vpopdir/$vdomain/$source ] || { echo $destination >> $vpopdir/$vdomain/$source/.qmail; chown $vpopuid:$vpopgid $vpopdir/$vdomain/$source/.qmail; }")
 142       if ( ! $nossh_hack && $machine);
 143   }
 144
 145   ''; #no error
 146
 147 }
 148
 149 =item delete
 150
 151 Deletes this mail forwarding alias from the database.  If there is an error,
 152 returns the error, otherwise returns false.
 153
 154 The corresponding FS::cust_svc record will be deleted as well.
 155
 156 =item replace OLD_RECORD
 157
 158 Replaces OLD_RECORD with this one in the database.  If there is an error,
 159 returns the error, otherwise returns false.
 160
 161 =cut
 162
 163 sub replace {
 164   my ( $new, $old ) = ( shift, shift );
 165   my $error;
 166
 167  $new->SUPER::replace($old);
 168
 169 }
 170
 171 =item suspend
 172
 173 Just returns false (no error) for now.
 174
 175 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 176
 177 =item unsuspend
 178
 179 Just returns false (no error) for now.
 180
 181 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 182
 183 =item cancel
 184
 185 Just returns false (no error) for now.
 186
 187 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 188
 189 =item check
 190
 191 Checks all fields to make sure this is a valid mail forwarding alias.  If there
 192 is an error, returns the error, otherwise returns false.  Called by the insert
 193 and replace methods.
 194
 195 Sets any fixed values; see L<FS::part_svc>.
 196
 197 =cut
 198
 199 sub check {
 200   my $self = shift;
 201   my $error;
 202
 203   my $x = $self->setfixed;
 204   return $x unless ref($x);
 205   my $part_svc = $x;
 206
 207   my($recref) = $self->hashref;
 208
 209   $recref->{srcsvc} =~ /^(\d+)$/ or return "Illegal srcsvc";
 210   $recref->{srcsvc} = $1;
 211   my($svc_acct);
 212   return "Unknown srcsvc" unless
 213     $svc_acct=qsearchs('svc_acct',{'svcnum'=> $recref->{srcsvc} } );
 214
 215   return "Illegal use of dstsvc and dst" if
 216     ($recref->{dstsvc} && $recref->{dst});
 217
 218   return "Illegal use of dstsvc and dst" if
 219     (! $recref->{dstsvc} && ! $recref->{dst});
 220
 221   $recref->{dstsvc} =~ /^(\d+)$/ or return "Illegal dstsvc";
 222   $recref->{dstsvc} = $1;
 223
 224   if ($recref->{dstsvc}) {
 225     my($svc_acct);
 226     return "Unknown dstsvc" unless
 227       my $svc_domain=qsearchs('svc_acct',{'svcnum'=> $recref->{dstsvc} } );
 228   }
 229
 230   if ($recref->{dst}) {
 231     $recref->{dst} =~ /^([\w\.\-]+)\@(([\w\.\-]+\.)+\w+)$/
 232        or return "Illegal dst";
 233   }
 234
 235   ''; #no error
 236 }
 237
 238 =back
 239
 240 =head1 VERSION
 241
 242 $Id: svc_forward.pm,v 1.4 2001-08-20 09:41:52 ivan Exp $
 243
 244 =head1 BUGS
 245
 246 The remote commands should be configurable.
 247
 248 The $recref stuff in sub check should be cleaned up.
 249
 250 =head1 SEE ALSO
 251
 252 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 253 L<FS::svc_acct>, L<FS::svc_domain>, L<Net::SSH>, L<ssh>, L<dot-qmail>,
 254 schema.html from the base documentation.
 255
 256 =cut
 257
 258 1;
 259