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