site_perl/svc_acct_sm.pm

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