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::cust_svc;
   7 use FS::SSH qw(ssh);
   8 use FS::Conf;
   9
  10 @ISA = qw( FS::Record );
  11
  12 #ask FS::UID to run this stuff for us later
  13 $FS::UID::callback{'FS::svc_acct_sm'} = sub {
  14   $conf = new FS::Conf;
  15   $shellmachine = $conf->exists('qmailmachines')
  16                   ? $conf->config('shellmachine')
  17                   : '';
  18 };
  19
  20 =head1 NAME
  21
  22 FS::svc_acct_sm - Object methods for svc_acct_sm records
  23
  24 =head1 SYNOPSIS
  25
  26   use FS::svc_acct_sm;
  27
  28   $record = new FS::svc_acct_sm \%hash;
  29   $record = new FS::svc_acct_sm { 'column' => 'value' };
  30
  31   $error = $record->insert;
  32
  33   $error = $new_record->replace($old_record);
  34
  35   $error = $record->delete;
  36
  37   $error = $record->check;
  38
  39   $error = $record->suspend;
  40
  41   $error = $record->unsuspend;
  42
  43   $error = $record->cancel;
  44
  45 =head1 DESCRIPTION
  46
  47 An FS::svc_acct object represents a virtual mail alias.  FS::svc_acct inherits
  48 from FS::Record.  The following fields are currently supported:
  49
  50 =over 4
  51
  52 =item svcnum - primary key (assigned automatcially for new accounts)
  53
  54 =item domsvc - svcnum of the virtual domain (see L<FS::svc_domain>)
  55
  56 =item domuid - uid of the target account (see L<FS::svc_acct>)
  57
  58 =item domuser - virtual username
  59
  60 =back
  61
  62 =head1 METHODS
  63
  64 =over 4
  65
  66 =item new HASHREF
  67
  68 Creates a new virtual mail alias.  To add the virtual mail alias to the
  69 database, see L<"insert">.
  70
  71 =cut
  72
  73 sub table { 'svc_acct_sm'; }
  74
  75 =item insert
  76
  77 Adds this virtual mail alias to the database.  If there is an error, returns
  78 the error, otherwise returns false.
  79
  80 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
  81 defined.  An FS::cust_svc record will be created and inserted.
  82
  83 If the configuration values (see L<FS::Conf>) shellmachine and qmailmachines
  84 exist, and domuser is `*' (meaning a catch-all mailbox), the command:
  85
  86   [ -e $dir/.qmail-$qdomain-default ] || {
  87     touch $dir/.qmail-$qdomain-default;
  88     chown $uid:$gid $dir/.qmail-$qdomain-default;
  89   }
  90
  91 is executed on shellmachine via ssh (see L<dot-qmail/"EXTENSION ADDRESSES">).
  92 This behaviour can be surpressed by setting $FS::svc_acct_sm::nossh_hack true.
  93
  94 =cut
  95
  96 sub insert {
  97   my($self)=@_;
  98   my($error);
  99
 100   local $SIG{HUP} = 'IGNORE';
 101   local $SIG{INT} = 'IGNORE';
 102   local $SIG{QUIT} = 'IGNORE';
 103   local $SIG{TERM} = 'IGNORE';
 104   local $SIG{TSTP} = 'IGNORE';
 105
 106   $error=$self->check;
 107   return $error if $error;
 108
 109   return "Domain username (domuser) in use for this domain (domsvc)"
 110     if qsearchs('svc_acct_sm',{ 'domuser'=> $self->domuser,
 111                                 'domsvc' => $self->domsvc,
 112                               } );
 113
 114   return "First domain username (domuser) for domain (domsvc) must be " .
 115          qq='*' (catch-all)!=
 116     if $self->domuser ne '*' &&
 117        ! qsearch('svc_acct_sm',{ 'domsvc' => $self->domsvc } );
 118
 119   my($svcnum)=$self->getfield('svcnum');
 120   my($cust_svc);
 121   unless ( $svcnum ) {
 122     $cust_svc=create FS::cust_svc ( {
 123       'svcnum'  => $svcnum,
 124       'pkgnum'  => $self->getfield('pkgnum'),
 125       'svcpart' => $self->getfield('svcpart'),
 126     } );
 127     my($error) = $cust_svc->insert;
 128     return $error if $error;
 129     $svcnum = $self->setfield('svcnum',$cust_svc->getfield('svcnum'));
 130   }
 131
 132   $error = $self->add;
 133   if ($error) {
 134     $cust_svc->del if $cust_svc;
 135     return $error;
 136   }
 137
 138   my $svc_domain = qsearchs('svc_domain',{'svcnum'=> $self->domsvc } );
 139   my $svc_acct = qsearchs('svc_acct',{'uid'=> $self->domuid } );
 140   my($uid,$gid,$dir,$domain)=(
 141     $svc_acct->getfield('uid'),
 142     $svc_acct->getfield('gid'),
 143     $svc_acct->getfield('dir'),
 144     $svc_domain->getfield('domain')
 145   );
 146   my($qdomain)=$domain;
 147   $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES
 148   ssh("root\@$shellmachine","[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }")
 149     if ( ! $nossh_hack && $shellmachine && $dir && $self->domuser eq '*' );
 150
 151   ''; #no error
 152
 153 }
 154
 155 =item delete
 156
 157 Deletes this virtual mail alias from the database.  If there is an error,
 158 returns the error, otherwise returns false.
 159
 160 The corresponding FS::cust_svc record will be deleted as well.
 161
 162 =cut
 163
 164 sub delete {
 165   my($self)=@_;
 166   my($error);
 167
 168   my($svcnum)=$self->getfield('svcnum');
 169
 170   $error = $self->del;
 171   return $error if $error;
 172
 173   my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
 174   $error = $cust_svc->del;
 175   return $error if $error;
 176
 177   '';
 178
 179 }
 180
 181 =item replace OLD_RECORD
 182
 183 Replaces OLD_RECORD with this one in the database.  If there is an error,
 184 returns the error, otherwise returns false.
 185
 186 =cut
 187
 188 sub replace {
 189   my($new,$old)=@_;
 190   my($error);
 191
 192   return "(Old) Not a svc_acct_sm record!" unless $old->table eq "svc_acct_sm";
 193   return "Can't change svcnum!"
 194     unless $old->getfield('svcnum') eq $new->getfield('svcnum');
 195
 196   return "Domain username (domuser) in use for this domain (domsvc)"
 197     if ( $old->domuser ne $new->domuser
 198          || $old->domsvc  ne $new->domsvc
 199        )  && qsearchs('svc_acct_sm',{
 200          'domuser'=> $new->domuser,
 201          'domsvc' => $new->domsvc,
 202        } )
 203      ;
 204
 205   $error=$new->check;
 206   return $error if $error;
 207
 208   $error = $new->rep($old);
 209   return $error if $error;
 210
 211   ''; #no error
 212 }
 213
 214 =item suspend
 215
 216 Just returns false (no error) for now.
 217
 218 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 219
 220 =cut
 221
 222 sub suspend {
 223   ''; #no error (stub)
 224 }
 225
 226 =item unsuspend
 227
 228 Just returns false (no error) for now.
 229
 230 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 231
 232 =cut
 233
 234 sub unsuspend {
 235   ''; #no error (stub)
 236 }
 237
 238 =item cancel
 239
 240 Just returns false (no error) for now.
 241
 242 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 243
 244 =cut
 245
 246 sub cancel {
 247   ''; #no error (stub)
 248 }
 249
 250 =item check
 251
 252 Checks all fields to make sure this is a valid virtual mail alias.  If there is
 253 an error, returns the error, otherwise returns false.  Called by the insert and
 254 replace methods.
 255
 256 Sets any fixed values; see L<FS::part_svc>.
 257
 258 =cut
 259
 260 sub check {
 261   my($self)=@_;
 262   return "Not a svc_acct_sm record!" unless $self->table eq "svc_acct_sm";
 263   my($recref) = $self->hashref;
 264
 265   $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
 266   $recref->{svcnum} = $1;
 267
 268   #get part_svc
 269   my($svcpart);
 270   my($svcnum)=$self->getfield('svcnum');
 271   if ($svcnum) {
 272     my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
 273     return "Unknown svcnum" unless $cust_svc;
 274     $svcpart=$cust_svc->svcpart;
 275   } else {
 276     $svcpart=$self->getfield('svcpart');
 277   }
 278   my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
 279   return "Unkonwn svcpart" unless $part_svc;
 280
 281   #set fixed fields from part_svc
 282   my($field);
 283   foreach $field ( fields('svc_acct_sm') ) {
 284     if ( $part_svc->getfield('svc_acct_sm__'. $field. '_flag') eq 'F' ) {
 285       $self->setfield($field,$part_svc->getfield('svc_acct_sm__'. $field) );
 286     }
 287   }
 288
 289   $recref->{domuser} =~ /^(\*|[a-z0-9_\-]{2,32})$/
 290     or return "Illegal domain username (domuser)";
 291   $recref->{domuser} = $1;
 292
 293   $recref->{domsvc} =~ /^(\d+)$/ or return "Illegal domsvc";
 294   $recref->{domsvc} = $1;
 295   my($svc_domain);
 296   return "Unknown domsvc" unless
 297     $svc_domain=qsearchs('svc_domain',{'svcnum'=> $recref->{domsvc} } );
 298
 299   $recref->{domuid} =~ /^(\d+)$/ or return "Illegal uid";
 300   $recref->{domuid} = $1;
 301   my($svc_acct);
 302   return "Unknown uid" unless
 303     $svc_acct=qsearchs('svc_acct',{'uid'=> $recref->{domuid} } );
 304
 305   ''; #no error
 306 }
 307
 308 =back
 309
 310 =head1 VERSION
 311
 312 $Id: svc_acct_sm.pm,v 1.3 1998-12-29 11:59:54 ivan Exp $
 313
 314 =head1 BUGS
 315
 316 The remote commands should be configurable.
 317
 318 =head1 SEE ALSO
 319
 320 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 321 L<FS::svc_acct>, L<FS::svc_domain>, L<FS::SSH>, L<ssh>, L<dot-qmail>,
 322 schema.html from the base documentation.
 323
 324 =head1 HISTORY
 325
 326 ivan@voicenet.com 97-jul-16 - 21
 327
 328 rewrite ivan@sisd.com 98-mar-10
 329
 330 s/qsearchs/qsearch/ to eliminate warning ivan@sisd.com 98-apr-19
 331
 332 uses conf/shellmachine and has an nossh_hack ivan@sisd.com 98-jul-14
 333
 334 s/\./:/g in .qmail-domain:com ivan@sisd.com 98-aug-13
 335
 336 pod, FS::Conf, moved .qmail file from check to insert 98-sep-23
 337
 338 =cut
 339
 340 1;
 341