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