FS/FS/svc_acct_sm.pm

   1 package FS::svc_acct_sm;
   2
   3 use strict;
   4 use vars qw( @ISA $nossh_hack $conf $shellmachine @qmailmachines );
   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_acct_sm'} = sub {
  17 #  $conf = new FS::Conf;
  18 #  $shellmachine = $conf->exists('qmailmachines')
  19 #                  ? $conf->config('shellmachine')
  20 #                  : '';
  21 #};
  22
  23 =head1 NAME
  24
  25 FS::svc_acct_sm - Object methods for svc_acct_sm records
  26
  27 =head1 SYNOPSIS
  28
  29   use FS::svc_acct_sm;
  30
  31   $record = new FS::svc_acct_sm \%hash;
  32   $record = new FS::svc_acct_sm { 'column' => 'value' };
  33
  34   $error = $record->insert;
  35
  36   $error = $new_record->replace($old_record);
  37
  38   $error = $record->delete;
  39
  40   $error = $record->check;
  41
  42   $error = $record->suspend;
  43
  44   $error = $record->unsuspend;
  45
  46   $error = $record->cancel;
  47
  48 =head1 WARNING
  49
  50 FS::svc_acct_sm is B<depreciated>.  This class is only included for migration
  51 purposes.  See L<FS::svc_forward>.
  52
  53 =head1 DESCRIPTION
  54
  55 An FS::svc_acct_sm object represents a virtual mail alias.  FS::svc_acct_sm
  56 inherits from FS::Record.  The following fields are currently supported:
  57
  58 =over 4
  59
  60 =item svcnum - primary key (assigned automatcially for new accounts)
  61
  62 =item domsvc - svcnum of the virtual domain (see L<FS::svc_domain>)
  63
  64 =item domuid - uid of the target account (see L<FS::svc_acct>)
  65
  66 =item domuser - virtual username
  67
  68 =back
  69
  70 =head1 METHODS
  71
  72 =over 4
  73
  74 =item new HASHREF
  75
  76 Creates a new virtual mail alias.  To add the virtual mail alias to the
  77 database, see L<"insert">.
  78
  79 =cut
  80
  81 sub table { 'svc_acct_sm'; }
  82
  83 =item insert
  84
  85 Adds this virtual mail alias to the database.  If there is an error, returns
  86 the error, otherwise returns false.
  87
  88 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
  89 defined.  An FS::cust_svc record will be created and inserted.
  90
  91  #If the configuration values (see L<FS::Conf>) shellmachine and qmailmachines
  92  #exist, and domuser is `*' (meaning a catch-all mailbox), the command:
  93  #
  94  #  [ -e $dir/.qmail-$qdomain-default ] || {
  95  #    touch $dir/.qmail-$qdomain-default;
  96  #    chown $uid:$gid $dir/.qmail-$qdomain-default;
  97  #  }
  98  #
  99  #is executed on shellmachine via ssh (see L<dot-qmail/"EXTENSION ADDRESSES">).
 100  #This behaviour can be surpressed by setting $FS::svc_acct_sm::nossh_hack true.
 101
 102 =cut
 103
 104 sub insert {
 105   my $self = shift;
 106   my $error;
 107
 108   local $SIG{HUP} = 'IGNORE';
 109   local $SIG{INT} = 'IGNORE';
 110   local $SIG{QUIT} = 'IGNORE';
 111   local $SIG{TERM} = 'IGNORE';
 112   local $SIG{TSTP} = 'IGNORE';
 113   local $SIG{PIPE} = 'IGNORE';
 114
 115   $error=$self->check;
 116   return $error if $error;
 117
 118   return "Domain username (domuser) in use for this domain (domsvc)"
 119     if qsearchs('svc_acct_sm',{ 'domuser'=> $self->domuser,
 120                                 'domsvc' => $self->domsvc,
 121                               } );
 122
 123   return "First domain username (domuser) for domain (domsvc) must be " .
 124          qq='*' (catch-all)!=
 125     if $self->domuser ne '*'
 126        && ! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } )
 127        && ! $conf->exists('maildisablecatchall');
 128
 129   $error = $self->SUPER::insert;
 130   return $error if $error;
 131
 132   #my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
 133   #my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $self->domuid } );
 134   #my ( $uid, $gid, $dir, $domain ) = (
 135   #  $svc_acct->uid,
 136   #  $svc_acct->gid,
 137   #  $svc_acct->dir,
 138   #  $svc_domain->domain,
 139   #);
 140   #my $qdomain = $domain;
 141   #$qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES
 142   #ssh("root\@$shellmachine","[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }")
 143   #  if ( ! $nossh_hack && $shellmachine && $dir && $self->domuser eq '*' );
 144
 145   ''; #no error
 146
 147 }
 148
 149 =item delete
 150
 151 Deletes this virtual mail 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   return "Domain username (domuser) in use for this domain (domsvc)"
 168     if ( $old->domuser ne $new->domuser
 169          || $old->domsvc != $new->domsvc
 170        )  && qsearchs('svc_acct_sm',{
 171          'domuser'=> $new->domuser,
 172          'domsvc' => $new->domsvc,
 173        } )
 174      ;
 175
 176  $new->SUPER::replace($old);
 177
 178 }
 179
 180 =item suspend
 181
 182 Just returns false (no error) for now.
 183
 184 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 185
 186 =item unsuspend
 187
 188 Just returns false (no error) for now.
 189
 190 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 191
 192 =item cancel
 193
 194 Just returns false (no error) for now.
 195
 196 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 197
 198 =item check
 199
 200 Checks all fields to make sure this is a valid virtual mail alias.  If there is
 201 an error, returns the error, otherwise returns false.  Called by the insert and
 202 replace methods.
 203
 204 Sets any fixed values; see L<FS::part_svc>.
 205
 206 =cut
 207
 208 sub check {
 209   my $self = shift;
 210   my $error;
 211
 212   my $x = $self->setfixed;
 213   return $x unless ref($x);
 214   #my $part_svc = $x;
 215
 216   my($recref) = $self->hashref;
 217
 218   $recref->{domuser} =~ /^(\*|[a-z0-9_\-]{2,32})$/
 219     or return "Illegal domain username (domuser)";
 220   $recref->{domuser} = $1;
 221
 222   $recref->{domsvc} =~ /^(\d+)$/ or return "Illegal domsvc";
 223   $recref->{domsvc} = $1;
 224   my($svc_domain);
 225   return "Unknown domsvc" unless
 226     $svc_domain=qsearchs('svc_domain',{'svcnum'=> $recref->{domsvc} } );
 227
 228   $recref->{domuid} =~ /^(\d+)$/ or return "Illegal uid";
 229   $recref->{domuid} = $1;
 230   my($svc_acct);
 231   return "Unknown uid" unless
 232     $svc_acct=qsearchs('svc_acct',{'uid'=> $recref->{domuid} } );
 233
 234   ''; #no error
 235 }
 236
 237 =back
 238
 239 =head1 VERSION
 240
 241 $Id: svc_acct_sm.pm,v 1.5 2001-09-06 20:41:59 ivan Exp $
 242
 243 =head1 BUGS
 244
 245 The remote commands should be configurable.
 246
 247 The $recref stuff in sub check should be cleaned up.
 248
 249 =head1 SEE ALSO
 250
 251 L<FS::svc_forward>
 252
 253 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 254 L<FS::svc_acct>, L<FS::svc_domain>, L<Net::SSH>, L<ssh>, L<dot-qmail>,
 255 schema.html from the base documentation.
 256
 257 =cut
 258
 259 1;
 260