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