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