site_perl/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
 123   $error = $self->SUPER::insert;
 124   return $error if $error;
 125
 126   my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
 127   my $svc_acct = qsearchs( 'svc_acct', { 'uid' => $self->domuid } );
 128   my ( $uid, $gid, $dir, $domain ) = (
 129     $svc_acct->uid,
 130     $svc_acct->gid,
 131     $svc_acct->dir,
 132     $svc_domain->domain,
 133   );
 134   my $qdomain = $domain;
 135   $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES
 136   ssh("root\@$shellmachine","[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }")
 137     if ( ! $nossh_hack && $shellmachine && $dir && $self->domuser eq '*' );
 138
 139   ''; #no error
 140
 141 }
 142
 143 =item delete
 144
 145 Deletes this virtual mail alias from the database.  If there is an error,
 146 returns the error, otherwise returns false.
 147
 148 The corresponding FS::cust_svc record will be deleted as well.
 149
 150 =item replace OLD_RECORD
 151
 152 Replaces OLD_RECORD with this one in the database.  If there is an error,
 153 returns the error, otherwise returns false.
 154
 155 =cut
 156
 157 sub replace {
 158   my ( $new, $old ) = ( shift, shift );
 159   my $error;
 160
 161   return "Domain username (domuser) in use for this domain (domsvc)"
 162     if ( $old->domuser ne $new->domuser
 163          || $old->domsvc != $new->domsvc
 164        )  && qsearchs('svc_acct_sm',{
 165          'domuser'=> $new->domuser,
 166          'domsvc' => $new->domsvc,
 167        } )
 168      ;
 169
 170  $new->SUPER::replace($old);
 171
 172 }
 173
 174 =item suspend
 175
 176 Just returns false (no error) for now.
 177
 178 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 179
 180 =item unsuspend
 181
 182 Just returns false (no error) for now.
 183
 184 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 185
 186 =item cancel
 187
 188 Just returns false (no error) for now.
 189
 190 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 191
 192 =item check
 193
 194 Checks all fields to make sure this is a valid virtual mail alias.  If there is
 195 an error, returns the error, otherwise returns false.  Called by the insert and
 196 replace methods.
 197
 198 Sets any fixed values; see L<FS::part_svc>.
 199
 200 =cut
 201
 202 sub check {
 203   my $self = shift;
 204   my $error;
 205
 206   my $x = $self->setfixed;
 207   return $x unless ref($x);
 208   my $part_svc = $x;
 209
 210   my($recref) = $self->hashref;
 211
 212   $recref->{domuser} =~ /^(\*|[a-z0-9_\-]{2,32})$/
 213     or return "Illegal domain username (domuser)";
 214   $recref->{domuser} = $1;
 215
 216   $recref->{domsvc} =~ /^(\d+)$/ or return "Illegal domsvc";
 217   $recref->{domsvc} = $1;
 218   my($svc_domain);
 219   return "Unknown domsvc" unless
 220     $svc_domain=qsearchs('svc_domain',{'svcnum'=> $recref->{domsvc} } );
 221
 222   $recref->{domuid} =~ /^(\d+)$/ or return "Illegal uid";
 223   $recref->{domuid} = $1;
 224   my($svc_acct);
 225   return "Unknown uid" unless
 226     $svc_acct=qsearchs('svc_acct',{'uid'=> $recref->{domuid} } );
 227
 228   ''; #no error
 229 }
 230
 231 =back
 232
 233 =head1 VERSION
 234
 235 $Id: svc_acct_sm.pm,v 1.7 1999-04-07 14:40:15 ivan Exp $
 236
 237 =head1 BUGS
 238
 239 The remote commands should be configurable.
 240
 241 The $recref stuff in sub check should be cleaned up.
 242
 243 =head1 SEE ALSO
 244
 245 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 246 L<FS::svc_acct>, L<FS::svc_domain>, L<FS::SSH>, L<ssh>, L<dot-qmail>,
 247 schema.html from the base documentation.
 248
 249 =head1 HISTORY
 250
 251 ivan@voicenet.com 97-jul-16 - 21
 252
 253 rewrite ivan@sisd.com 98-mar-10
 254
 255 s/qsearchs/qsearch/ to eliminate warning ivan@sisd.com 98-apr-19
 256
 257 uses conf/shellmachine and has an nossh_hack ivan@sisd.com 98-jul-14
 258
 259 s/\./:/g in .qmail-domain:com ivan@sisd.com 98-aug-13
 260
 261 pod, FS::Conf, moved .qmail file from check to insert 98-sep-23
 262
 263 =cut
 264
 265 1;
 266