FS/FS/svc_acct.pm

   1 package FS::svc_acct;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG $me $conf
   5              $dir_prefix @shells $usernamemin
   6              $usernamemax $passwordmin $passwordmax
   7              $username_ampersand $username_letter $username_letterfirst
   8              $username_noperiod $username_nounderscore $username_nodash
   9              $username_uppercase
  10              $mydomain
  11              $welcome_template $welcome_from $welcome_subject $welcome_mimetype
  12              $smtpmachine
  13              $radius_password $radius_ip
  14              $dirhash
  15              @saltset @pw_set );
  16 use Carp;
  17 use Fcntl qw(:flock);
  18 use Crypt::PasswdMD5;
  19 use FS::UID qw( datasrc );
  20 use FS::Conf;
  21 use FS::Record qw( qsearch qsearchs fields dbh dbdef );
  22 use FS::svc_Common;
  23 use Net::SSH;
  24 use FS::cust_svc;
  25 use FS::part_svc;
  26 use FS::svc_acct_pop;
  27 use FS::svc_acct_sm;
  28 use FS::cust_main_invoice;
  29 use FS::svc_domain;
  30 use FS::raddb;
  31 use FS::queue;
  32 use FS::radius_usergroup;
  33 use FS::export_svc;
  34 use FS::part_export;
  35 use FS::Msgcat qw(gettext);
  36
  37 @ISA = qw( FS::svc_Common );
  38
  39 $DEBUG = 0;
  40 #$DEBUG = 1;
  41 $me = '[FS::svc_acct]';
  42
  43 #ask FS::UID to run this stuff for us later
  44 $FS::UID::callback{'FS::svc_acct'} = sub {
  45   $conf = new FS::Conf;
  46   $dir_prefix = $conf->config('home');
  47   @shells = $conf->config('shells');
  48   $usernamemin = $conf->config('usernamemin') || 2;
  49   $usernamemax = $conf->config('usernamemax');
  50   $passwordmin = $conf->config('passwordmin') || 6;
  51   $passwordmax = $conf->config('passwordmax') || 8;
  52   $username_letter = $conf->exists('username-letter');
  53   $username_letterfirst = $conf->exists('username-letterfirst');
  54   $username_noperiod = $conf->exists('username-noperiod');
  55   $username_nounderscore = $conf->exists('username-nounderscore');
  56   $username_nodash = $conf->exists('username-nodash');
  57   $username_uppercase = $conf->exists('username-uppercase');
  58   $username_ampersand = $conf->exists('username-ampersand');
  59   $mydomain = $conf->config('domain');
  60   $dirhash = $conf->config('dirhash') || 0;
  61   if ( $conf->exists('welcome_email') ) {
  62     $welcome_template = new Text::Template (
  63       TYPE   => 'ARRAY',
  64       SOURCE => [ map "$_\n", $conf->config('welcome_email') ]
  65     ) or warn "can't create welcome email template: $Text::Template::ERROR";
  66     $welcome_from = $conf->config('welcome_email-from'); # || 'your-isp-is-dum'
  67     $welcome_subject = $conf->config('welcome_email-subject') || 'Welcome';
  68     $welcome_mimetype = $conf->config('welcome_email-mimetype') || 'text/plain';
  69   } else {
  70     $welcome_template = '';
  71     $welcome_from = '';
  72     $welcome_subject = '';
  73     $welcome_mimetype = '';
  74   }
  75   $smtpmachine = $conf->config('smtpmachine');
  76   $radius_password = $conf->config('radius-password') || 'Password';
  77   $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address';
  78 };
  79
  80 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
  81 @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
  82
  83 sub _cache {
  84   my $self = shift;
  85   my ( $hashref, $cache ) = @_;
  86   if ( $hashref->{'svc_acct_svcnum'} ) {
  87     $self->{'_domsvc'} = FS::svc_domain->new( {
  88       'svcnum'   => $hashref->{'domsvc'},
  89       'domain'   => $hashref->{'svc_acct_domain'},
  90       'catchall' => $hashref->{'svc_acct_catchall'},
  91     } );
  92   }
  93 }
  94
  95 =head1 NAME
  96
  97 FS::svc_acct - Object methods for svc_acct records
  98
  99 =head1 SYNOPSIS
 100
 101   use FS::svc_acct;
 102
 103   $record = new FS::svc_acct \%hash;
 104   $record = new FS::svc_acct { 'column' => 'value' };
 105
 106   $error = $record->insert;
 107
 108   $error = $new_record->replace($old_record);
 109
 110   $error = $record->delete;
 111
 112   $error = $record->check;
 113
 114   $error = $record->suspend;
 115
 116   $error = $record->unsuspend;
 117
 118   $error = $record->cancel;
 119
 120   %hash = $record->radius;
 121
 122   %hash = $record->radius_reply;
 123
 124   %hash = $record->radius_check;
 125
 126   $domain = $record->domain;
 127
 128   $svc_domain = $record->svc_domain;
 129
 130   $email = $record->email;
 131
 132   $seconds_since = $record->seconds_since($timestamp);
 133
 134 =head1 DESCRIPTION
 135
 136 An FS::svc_acct object represents an account.  FS::svc_acct inherits from
 137 FS::svc_Common.  The following fields are currently supported:
 138
 139 =over 4
 140
 141 =item svcnum - primary key (assigned automatcially for new accounts)
 142
 143 =item username
 144
 145 =item _password - generated if blank
 146
 147 =item sec_phrase - security phrase
 148
 149 =item popnum - Point of presence (see L<FS::svc_acct_pop>)
 150
 151 =item uid
 152
 153 =item gid
 154
 155 =item finger - GECOS
 156
 157 =item dir - set automatically if blank (and uid is not)
 158
 159 =item shell
 160
 161 =item quota - (unimplementd)
 162
 163 =item slipip - IP address
 164
 165 =item seconds -
 166
 167 =item domsvc - svcnum from svc_domain
 168
 169 =item radius_I<Radius_Attribute> - I<Radius-Attribute>
 170
 171 =back
 172
 173 =head1 METHODS
 174
 175 =over 4
 176
 177 =item new HASHREF
 178
 179 Creates a new account.  To add the account to the database, see L<"insert">.
 180
 181 =cut
 182
 183 sub table { 'svc_acct'; }
 184
 185 =item insert [ , OPTION => VALUE ... ]
 186
 187 Adds this account to the database.  If there is an error, returns the error,
 188 otherwise returns false.
 189
 190 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
 191 defined.  An FS::cust_svc record will be created and inserted.
 192
 193 The additional field I<usergroup> can optionally be defined; if so it should
 194 contain an arrayref of group names.  See L<FS::radius_usergroup>.
 195
 196 The additional field I<child_objects> can optionally be defined; if so it
 197 should contain an arrayref of FS::tablename objects.  They will have their
 198 svcnum fields set and will be inserted after this record, but before any
 199 exports are run.
 200
 201 Currently available options are: I<depend_jobnum>
 202
 203 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
 204 jobnums), all provisioning jobs will have a dependancy on the supplied
 205 jobnum(s) (they will not run until the specific job(s) complete(s)).
 206
 207 (TODOC: L<FS::queue> and L<freeside-queued>)
 208
 209 (TODOC: new exports!)
 210
 211 =cut
 212
 213 sub insert {
 214   my $self = shift;
 215   my %options = @_;
 216   my $error;
 217
 218   local $SIG{HUP} = 'IGNORE';
 219   local $SIG{INT} = 'IGNORE';
 220   local $SIG{QUIT} = 'IGNORE';
 221   local $SIG{TERM} = 'IGNORE';
 222   local $SIG{TSTP} = 'IGNORE';
 223   local $SIG{PIPE} = 'IGNORE';
 224
 225   my $oldAutoCommit = $FS::UID::AutoCommit;
 226   local $FS::UID::AutoCommit = 0;
 227   my $dbh = dbh;
 228
 229   $error = $self->check;
 230   return $error if $error;
 231
 232   #no, duplicate checking just got a whole lot more complicated
 233   #(perhaps keep this check with a config option to turn on?)
 234
 235   #return gettext('username_in_use'). ": ". $self->username
 236   #  if qsearchs( 'svc_acct', { 'username' => $self->username,
 237   #                             'domsvc'   => $self->domsvc,
 238   #                           } );
 239
 240   if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) ) {
 241     my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
 242     unless ( $cust_svc ) {
 243       $dbh->rollback if $oldAutoCommit;
 244       return "no cust_svc record found for svcnum ". $self->svcnum;
 245     }
 246     $self->pkgnum($cust_svc->pkgnum);
 247     $self->svcpart($cust_svc->svcpart);
 248   }
 249
 250   #new duplicate username checking
 251
 252   my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
 253   unless ( $part_svc ) {
 254     $dbh->rollback if $oldAutoCommit;
 255     return 'unknown svcpart '. $self->svcpart;
 256   }
 257
 258   my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } );
 259   my @dup_userdomain = qsearch( 'svc_acct', { 'username' => $self->username,
 260                                               'domsvc'   => $self->domsvc } );
 261   my @dup_uid;
 262   if ( $part_svc->part_svc_column('uid')->columnflag ne 'F'
 263        && $self->username !~ /^(toor|(hyla)?fax)$/          ) {
 264     @dup_uid = qsearch( 'svc_acct', { 'uid' => $self->uid } );
 265   } else {
 266     @dup_uid = ();
 267   }
 268
 269   if ( @dup_user || @dup_userdomain || @dup_uid ) {
 270     my $exports = FS::part_export::export_info('svc_acct');
 271     my %conflict_user_svcpart;
 272     my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', );
 273
 274     foreach my $part_export ( $part_svc->part_export ) {
 275
 276       #this will catch to the same exact export
 277       my @svcparts = map { $_->svcpart }
 278         qsearch('export_svc', { 'exportnum' => $part_export->exportnum });
 279
 280       #this will catch to exports w/same exporthost+type ???
 281       #my @other_part_export = qsearch('part_export', {
 282       #  'machine'    => $part_export->machine,
 283       #  'exporttype' => $part_export->exporttype,
 284       #} );
 285       #foreach my $other_part_export ( @other_part_export ) {
 286       #  push @svcparts, map { $_->svcpart }
 287       #    qsearch('export_svc', { 'exportnum' => $part_export->exportnum });
 288       #}
 289
 290       #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'};
 291       #silly kludge to avoid uninitialized value errors
 292       my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} )
 293                      ? $exports->{$part_export->exporttype}{'nodomain'}
 294                      : '';
 295       if ( $nodomain =~ /^Y/i ) {
 296         $conflict_user_svcpart{$_} = $part_export->exportnum
 297           foreach @svcparts;
 298       } else {
 299         $conflict_userdomain_svcpart{$_} = $part_export->exportnum
 300           foreach @svcparts;
 301       }
 302     }
 303
 304     foreach my $dup_user ( @dup_user ) {
 305       my $dup_svcpart = $dup_user->cust_svc->svcpart;
 306       if ( exists($conflict_user_svcpart{$dup_svcpart}) ) {
 307         $dbh->rollback if $oldAutoCommit;
 308         return "duplicate username: conflicts with svcnum ". $dup_user->svcnum.
 309                " via exportnum ". $conflict_user_svcpart{$dup_svcpart};
 310       }
 311     }
 312
 313     foreach my $dup_userdomain ( @dup_userdomain ) {
 314       my $dup_svcpart = $dup_userdomain->cust_svc->svcpart;
 315       if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
 316         $dbh->rollback if $oldAutoCommit;
 317         return "duplicate username\@domain: conflicts with svcnum ".
 318                $dup_userdomain->svcnum. " via exportnum ".
 319                $conflict_userdomain_svcpart{$dup_svcpart};
 320       }
 321     }
 322
 323     foreach my $dup_uid ( @dup_uid ) {
 324       my $dup_svcpart = $dup_uid->cust_svc->svcpart;
 325       if ( exists($conflict_user_svcpart{$dup_svcpart})
 326            || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
 327         $dbh->rollback if $oldAutoCommit;
 328         return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum.
 329                " via exportnum ". $conflict_user_svcpart{$dup_svcpart}
 330                                  || $conflict_userdomain_svcpart{$dup_svcpart};
 331       }
 332     }
 333
 334   }
 335
 336   #see?  i told you it was more complicated
 337
 338   my @jobnums;
 339   $error = $self->SUPER::insert(
 340     'jobnums'       => \@jobnums,
 341     'child_objects' => $self->child_objects,
 342     %options,
 343   );
 344   if ( $error ) {
 345     $dbh->rollback if $oldAutoCommit;
 346     return $error;
 347   }
 348
 349   if ( $self->usergroup ) {
 350     foreach my $groupname ( @{$self->usergroup} ) {
 351       my $radius_usergroup = new FS::radius_usergroup ( {
 352         svcnum    => $self->svcnum,
 353         groupname => $groupname,
 354       } );
 355       my $error = $radius_usergroup->insert;
 356       if ( $error ) {
 357         $dbh->rollback if $oldAutoCommit;
 358         return $error;
 359       }
 360     }
 361   }
 362
 363   #false laziness with sub replace (and cust_main)
 364   my $queue = new FS::queue {
 365     'svcnum' => $self->svcnum,
 366     'job'    => 'FS::svc_acct::append_fuzzyfiles'
 367   };
 368   $error = $queue->insert($self->username);
 369   if ( $error ) {
 370     $dbh->rollback if $oldAutoCommit;
 371     return "queueing job (transaction rolled back): $error";
 372   }
 373
 374   my $cust_pkg = $self->cust_svc->cust_pkg;
 375
 376   if ( $cust_pkg ) {
 377     my $cust_main = $cust_pkg->cust_main;
 378
 379     if ( $conf->exists('emailinvoiceauto') ) {
 380       my @invoicing_list = $cust_main->invoicing_list;
 381       push @invoicing_list, $self->email;
 382       $cust_main->invoicing_list(\@invoicing_list);
 383     }
 384
 385     #welcome email
 386     my $to = '';
 387     if ( $welcome_template && $cust_pkg ) {
 388       my $to = join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list );
 389       if ( $to ) {
 390         my $wqueue = new FS::queue {
 391           'svcnum' => $self->svcnum,
 392           'job'    => 'FS::svc_acct::send_email'
 393         };
 394         my $error = $wqueue->insert(
 395           'to'       => $to,
 396           'from'     => $welcome_from,
 397           'subject'  => $welcome_subject,
 398           'mimetype' => $welcome_mimetype,
 399           'body'     => $welcome_template->fill_in( HASH => {
 400                           'custnum'  => $self->custnum,
 401                           'username' => $self->username,
 402                           'password' => $self->_password,
 403                           'first'    => $cust_main->first,
 404                           'last'     => $cust_main->getfield('last'),
 405                           'pkg'      => $cust_pkg->part_pkg->pkg,
 406                         } ),
 407         );
 408         if ( $error ) {
 409           $dbh->rollback if $oldAutoCommit;
 410           return "error queuing welcome email: $error";
 411         }
 412
 413         if ( $options{'depend_jobnum'} ) {
 414           warn "$me depend_jobnum found; adding to welcome email dependancies"
 415             if $DEBUG;
 416           if ( ref($options{'depend_jobnum'}) ) {
 417             warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ).
 418                  "to welcome email dependancies"
 419               if $DEBUG;
 420             push @jobnums, @{ $options{'depend_jobnum'} };
 421           } else {
 422             warn "$me adding job $options{'depend_jobnum'} ".
 423                  "to welcome email dependancies"
 424               if $DEBUG;
 425             push @jobnums, $options{'depend_jobnum'};
 426           }
 427         }
 428
 429         foreach my $jobnum ( @jobnums ) {
 430           my $error = $wqueue->depend_insert($jobnum);
 431           if ( $error ) {
 432             $dbh->rollback if $oldAutoCommit;
 433             return "error queuing welcome email job dependancy: $error";
 434           }
 435         }
 436
 437       }
 438
 439     }
 440
 441   } # if ( $cust_pkg )
 442
 443   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 444   ''; #no error
 445 }
 446
 447 =item delete
 448
 449 Deletes this account from the database.  If there is an error, returns the
 450 error, otherwise returns false.
 451
 452 The corresponding FS::cust_svc record will be deleted as well.
 453
 454 (TODOC: new exports!)
 455
 456 =cut
 457
 458 sub delete {
 459   my $self = shift;
 460
 461   if ( defined( $FS::Record::dbdef->table('svc_acct_sm') ) ) {
 462     return "Can't delete an account which has (svc_acct_sm) mail aliases!"
 463       if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
 464   }
 465
 466   return "can't delete system account" if $self->_check_system;
 467
 468   return "Can't delete an account which is a (svc_forward) source!"
 469     if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
 470
 471   return "Can't delete an account which is a (svc_forward) destination!"
 472     if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
 473
 474   return "Can't delete an account with (svc_www) web service!"
 475     if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
 476
 477   # what about records in session ? (they should refer to history table)
 478
 479   local $SIG{HUP} = 'IGNORE';
 480   local $SIG{INT} = 'IGNORE';
 481   local $SIG{QUIT} = 'IGNORE';
 482   local $SIG{TERM} = 'IGNORE';
 483   local $SIG{TSTP} = 'IGNORE';
 484   local $SIG{PIPE} = 'IGNORE';
 485
 486   my $oldAutoCommit = $FS::UID::AutoCommit;
 487   local $FS::UID::AutoCommit = 0;
 488   my $dbh = dbh;
 489
 490   foreach my $cust_main_invoice (
 491     qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
 492   ) {
 493     unless ( defined($cust_main_invoice) ) {
 494       warn "WARNING: something's wrong with qsearch";
 495       next;
 496     }
 497     my %hash = $cust_main_invoice->hash;
 498     $hash{'dest'} = $self->email;
 499     my $new = new FS::cust_main_invoice \%hash;
 500     my $error = $new->replace($cust_main_invoice);
 501     if ( $error ) {
 502       $dbh->rollback if $oldAutoCommit;
 503       return $error;
 504     }
 505   }
 506
 507   foreach my $svc_domain (
 508     qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
 509   ) {
 510     my %hash = new FS::svc_domain->hash;
 511     $hash{'catchall'} = '';
 512     my $new = new FS::svc_domain \%hash;
 513     my $error = $new->replace($svc_domain);
 514     if ( $error ) {
 515       $dbh->rollback if $oldAutoCommit;
 516       return $error;
 517     }
 518   }
 519
 520   foreach my $radius_usergroup (
 521     qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } )
 522   ) {
 523     my $error = $radius_usergroup->delete;
 524     if ( $error ) {
 525       $dbh->rollback if $oldAutoCommit;
 526       return $error;
 527     }
 528   }
 529
 530   my $error = $self->SUPER::delete;
 531   if ( $error ) {
 532     $dbh->rollback if $oldAutoCommit;
 533     return $error;
 534   }
 535
 536   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 537   '';
 538 }
 539
 540 =item replace OLD_RECORD
 541
 542 Replaces OLD_RECORD with this one in the database.  If there is an error,
 543 returns the error, otherwise returns false.
 544
 545 The additional field I<usergroup> can optionally be defined; if so it should
 546 contain an arrayref of group names.  See L<FS::radius_usergroup>.
 547
 548
 549 =cut
 550
 551 sub replace {
 552   my ( $new, $old ) = ( shift, shift );
 553   my $error;
 554   warn "$me replacing $old with $new\n" if $DEBUG;
 555
 556   return "can't modify system account" if $old->_check_system;
 557
 558   return "Username in use"
 559     if $old->username ne $new->username &&
 560       qsearchs( 'svc_acct', { 'username' => $new->username,
 561                                'domsvc'   => $new->domsvc,
 562                              } );
 563   {
 564     #no warnings 'numeric';  #alas, a 5.006-ism
 565     local($^W) = 0;
 566     return "Can't change uid!" if $old->uid != $new->uid;
 567   }
 568
 569   #change homdir when we change username
 570   $new->setfield('dir', '') if $old->username ne $new->username;
 571
 572   local $SIG{HUP} = 'IGNORE';
 573   local $SIG{INT} = 'IGNORE';
 574   local $SIG{QUIT} = 'IGNORE';
 575   local $SIG{TERM} = 'IGNORE';
 576   local $SIG{TSTP} = 'IGNORE';
 577   local $SIG{PIPE} = 'IGNORE';
 578
 579   my $oldAutoCommit = $FS::UID::AutoCommit;
 580   local $FS::UID::AutoCommit = 0;
 581   my $dbh = dbh;
 582
 583   # redundant, but so $new->usergroup gets set
 584   $error = $new->check;
 585   return $error if $error;
 586
 587   $old->usergroup( [ $old->radius_groups ] );
 588   warn "old groups: ". join(' ',@{$old->usergroup}). "\n" if $DEBUG;
 589   warn "new groups: ". join(' ',@{$new->usergroup}). "\n" if $DEBUG;
 590   if ( $new->usergroup ) {
 591     #(sorta) false laziness with FS::part_export::sqlradius::_export_replace
 592     my @newgroups = @{$new->usergroup};
 593     foreach my $oldgroup ( @{$old->usergroup} ) {
 594       if ( grep { $oldgroup eq $_ } @newgroups ) {
 595         @newgroups = grep { $oldgroup ne $_ } @newgroups;
 596         next;
 597       }
 598       my $radius_usergroup = qsearchs('radius_usergroup', {
 599         svcnum    => $old->svcnum,
 600         groupname => $oldgroup,
 601       } );
 602       my $error = $radius_usergroup->delete;
 603       if ( $error ) {
 604         $dbh->rollback if $oldAutoCommit;
 605         return "error deleting radius_usergroup $oldgroup: $error";
 606       }
 607     }
 608
 609     foreach my $newgroup ( @newgroups ) {
 610       my $radius_usergroup = new FS::radius_usergroup ( {
 611         svcnum    => $new->svcnum,
 612         groupname => $newgroup,
 613       } );
 614       my $error = $radius_usergroup->insert;
 615       if ( $error ) {
 616         $dbh->rollback if $oldAutoCommit;
 617         return "error adding radius_usergroup $newgroup: $error";
 618       }
 619     }
 620
 621   }
 622
 623   $error = $new->SUPER::replace($old);
 624   if ( $error ) {
 625     $dbh->rollback if $oldAutoCommit;
 626     return $error if $error;
 627   }
 628
 629   if ( $new->username ne $old->username ) {
 630     #false laziness with sub insert (and cust_main)
 631     my $queue = new FS::queue {
 632       'svcnum' => $new->svcnum,
 633       'job'    => 'FS::svc_acct::append_fuzzyfiles'
 634     };
 635     $error = $queue->insert($new->username);
 636     if ( $error ) {
 637       $dbh->rollback if $oldAutoCommit;
 638       return "queueing job (transaction rolled back): $error";
 639     }
 640   }
 641
 642   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 643   ''; #no error
 644 }
 645
 646 =item suspend
 647
 648 Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
 649 error, returns the error, otherwise returns false.
 650
 651 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 652
 653 Calls any export-specific suspend hooks.
 654
 655 =cut
 656
 657 sub suspend {
 658   my $self = shift;
 659   return "can't suspend system account" if $self->_check_system;
 660   $self->SUPER::suspend;
 661 }
 662
 663 =item unsuspend
 664
 665 Unsuspends this account by removing *SUSPENDED* from the password.  If there is
 666 an error, returns the error, otherwise returns false.
 667
 668 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 669
 670 Calls any export-specific unsuspend hooks.
 671
 672 =cut
 673
 674 sub unsuspend {
 675   my $self = shift;
 676   my %hash = $self->hash;
 677   if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
 678     $hash{_password} = $1;
 679     my $new = new FS::svc_acct ( \%hash );
 680     my $error = $new->replace($self);
 681     return $error if $error;
 682   }
 683
 684   $self->SUPER::unsuspend;
 685 }
 686
 687 =item cancel
 688
 689 Just returns false (no error) for now.
 690
 691 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 692
 693 =item check
 694
 695 Checks all fields to make sure this is a valid service.  If there is an error,
 696 returns the error, otherwise returns false.  Called by the insert and replace
 697 methods.
 698
 699 Sets any fixed values; see L<FS::part_svc>.
 700
 701 =cut
 702
 703 sub check {
 704   my $self = shift;
 705
 706   my($recref) = $self->hashref;
 707
 708   my $x = $self->setfixed;
 709   return $x unless ref($x);
 710   my $part_svc = $x;
 711
 712   if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) {
 713     $self->usergroup(
 714       [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] );
 715   }
 716
 717   my $error = $self->ut_numbern('svcnum')
 718               #|| $self->ut_number('domsvc')
 719               || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum' )
 720               || $self->ut_textn('sec_phrase')
 721   ;
 722   return $error if $error;
 723
 724   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
 725   if ( $username_uppercase ) {
 726     $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i
 727       or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
 728     $recref->{username} = $1;
 729   } else {
 730     $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/
 731       or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
 732     $recref->{username} = $1;
 733   }
 734
 735   if ( $username_letterfirst ) {
 736     $recref->{username} =~ /^[a-z]/ or return gettext('illegal_username');
 737   } elsif ( $username_letter ) {
 738     $recref->{username} =~ /[a-z]/ or return gettext('illegal_username');
 739   }
 740   if ( $username_noperiod ) {
 741     $recref->{username} =~ /\./ and return gettext('illegal_username');
 742   }
 743   if ( $username_nounderscore ) {
 744     $recref->{username} =~ /_/ and return gettext('illegal_username');
 745   }
 746   if ( $username_nodash ) {
 747     $recref->{username} =~ /\-/ and return gettext('illegal_username');
 748   }
 749   unless ( $username_ampersand ) {
 750     $recref->{username} =~ /\&/ and return gettext('illegal_username');
 751   }
 752
 753   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
 754   $recref->{popnum} = $1;
 755   return "Unknown popnum" unless
 756     ! $recref->{popnum} ||
 757     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
 758
 759   unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
 760
 761     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
 762     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
 763
 764     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
 765     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
 766     #not all systems use gid=uid
 767     #you can set a fixed gid in part_svc
 768
 769     return "Only root can have uid 0"
 770       if $recref->{uid} == 0
 771          && $recref->{username} ne 'root'
 772          && $recref->{username} ne 'toor';
 773
 774
 775     $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
 776       or return "Illegal directory: ". $recref->{dir};
 777     $recref->{dir} = $1;
 778     return "Illegal directory"
 779       if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component
 780     return "Illegal directory"
 781       if $recref->{dir} =~ /\&/ && ! $username_ampersand;
 782     unless ( $recref->{dir} ) {
 783       $recref->{dir} = $dir_prefix . '/';
 784       if ( $dirhash > 0 ) {
 785         for my $h ( 1 .. $dirhash ) {
 786           $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
 787         }
 788       } elsif ( $dirhash < 0 ) {
 789         for my $h ( reverse $dirhash .. -1 ) {
 790           $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
 791         }
 792       }
 793       $recref->{dir} .= $recref->{username};
 794     ;
 795     }
 796
 797     unless ( $recref->{username} eq 'sync' ) {
 798       if ( grep $_ eq $recref->{shell}, @shells ) {
 799         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
 800       } else {
 801         return "Illegal shell \`". $self->shell. "\'; ".
 802                $conf->dir. "/shells contains: @shells";
 803       }
 804     } else {
 805       $recref->{shell} = '/bin/sync';
 806     }
 807
 808   } else {
 809     $recref->{gid} ne '' ?
 810       return "Can't have gid without uid" : ( $recref->{gid}='' );
 811     $recref->{dir} ne '' ?
 812       return "Can't have directory without uid" : ( $recref->{dir}='' );
 813     $recref->{shell} ne '' ?
 814       return "Can't have shell without uid" : ( $recref->{shell}='' );
 815   }
 816
 817   #  $error = $self->ut_textn('finger');
 818   #  return $error if $error;
 819   $self->getfield('finger') =~
 820     /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/
 821       or return "Illegal finger: ". $self->getfield('finger');
 822   $self->setfield('finger', $1);
 823
 824   $recref->{quota} =~ /^(\w*)$/ or return "Illegal quota";
 825   $recref->{quota} = $1;
 826
 827   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
 828     if ( $recref->{slipip} eq '' ) {
 829       $recref->{slipip} = '';
 830     } elsif ( $recref->{slipip} eq '0e0' ) {
 831       $recref->{slipip} = '0e0';
 832     } else {
 833       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
 834         or return "Illegal slipip". $self->slipip;
 835       $recref->{slipip} = $1;
 836     }
 837
 838   }
 839
 840   #arbitrary RADIUS stuff; allow ut_textn for now
 841   foreach ( grep /^radius_/, fields('svc_acct') ) {
 842     $self->ut_textn($_);
 843   }
 844
 845   #generate a password if it is blank
 846   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
 847     unless ( $recref->{_password} );
 848
 849   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
 850   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
 851     $recref->{_password} = $1.$3;
 852     #uncomment this to encrypt password immediately upon entry, or run
 853     #bin/crypt_pw in cron to give new users a window during which their
 854     #password is available to techs, for faxing, etc.  (also be aware of
 855     #radius issues!)
 856     #$recref->{password} = $1.
 857     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
 858     #;
 859   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$\;\+]{13,60})$/ ) {
 860     $recref->{_password} = $1.$3;
 861   } elsif ( $recref->{_password} eq '*' ) {
 862     $recref->{_password} = '*';
 863   } elsif ( $recref->{_password} eq '!' ) {
 864     $recref->{_password} = '!';
 865   } elsif ( $recref->{_password} eq '!!' ) {
 866     $recref->{_password} = '!!';
 867   } else {
 868     #return "Illegal password";
 869     return gettext('illegal_password'). " $passwordmin-$passwordmax ".
 870            FS::Msgcat::_gettext('illegal_password_characters').
 871            ": ". $recref->{_password};
 872   }
 873
 874   ''; #no error
 875 }
 876
 877 =item _check_system
 878
 879 =cut
 880
 881 sub _check_system {
 882   my $self = shift;
 883   scalar( grep { $self->username eq $_ || $self->email eq $_ }
 884                $conf->config('system_usernames')
 885         );
 886 }
 887
 888
 889 =item radius
 890
 891 Depriciated, use radius_reply instead.
 892
 893 =cut
 894
 895 sub radius {
 896   carp "FS::svc_acct::radius depriciated, use radius_reply";
 897   $_[0]->radius_reply;
 898 }
 899
 900 =item radius_reply
 901
 902 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 903 reply attributes of this record.
 904
 905 Note that this is now the preferred method for reading RADIUS attributes -
 906 accessing the columns directly is discouraged, as the column names are
 907 expected to change in the future.
 908
 909 =cut
 910
 911 sub radius_reply {
 912   my $self = shift;
 913   my %reply =
 914     map {
 915       /^(radius_(.*))$/;
 916       my($column, $attrib) = ($1, $2);
 917       #$attrib =~ s/_/\-/g;
 918       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
 919     } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
 920   if ( $self->slipip && $self->slipip ne '0e0' ) {
 921     $reply{$radius_ip} = $self->slipip;
 922   }
 923   %reply;
 924 }
 925
 926 =item radius_check
 927
 928 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 929 check attributes of this record.
 930
 931 Note that this is now the preferred method for reading RADIUS attributes -
 932 accessing the columns directly is discouraged, as the column names are
 933 expected to change in the future.
 934
 935 =cut
 936
 937 sub radius_check {
 938   my $self = shift;
 939   my $password = $self->_password;
 940   my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password';
 941   ( $pw_attrib => $self->_password,
 942     map {
 943       /^(rc_(.*))$/;
 944       my($column, $attrib) = ($1, $2);
 945       #$attrib =~ s/_/\-/g;
 946       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
 947     } grep { /^rc_/ && $self->getfield($_) } fields( $self->table )
 948   );
 949 }
 950
 951 =item domain
 952
 953 Returns the domain associated with this account.
 954
 955 =cut
 956
 957 sub domain {
 958   my $self = shift;
 959   if ( $self->domsvc ) {
 960     #$self->svc_domain->domain;
 961     my $svc_domain = $self->svc_domain
 962       or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
 963     $svc_domain->domain;
 964   } else {
 965     $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
 966   }
 967 }
 968
 969 =item svc_domain
 970
 971 Returns the FS::svc_domain record for this account's domain (see
 972 L<FS::svc_domain>).
 973
 974 =cut
 975
 976 sub svc_domain {
 977   my $self = shift;
 978   $self->{'_domsvc'}
 979     ? $self->{'_domsvc'}
 980     : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
 981 }
 982
 983 =item cust_svc
 984
 985 Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
 986
 987 =cut
 988
 989 sub cust_svc {
 990   my $self = shift;
 991   qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
 992 }
 993
 994 =item email
 995
 996 Returns an email address associated with the account.
 997
 998 =cut
 999
1000 sub email {
1001   my $self = shift;
1002   $self->username. '@'. $self->domain;
1003 }
1004
1005 =item acct_snarf
1006
1007 Returns an array of FS::acct_snarf records associated with the account.
1008 If the acct_snarf table does not exist or there are no associated records,
1009 an empty list is returned
1010
1011 =cut
1012
1013 sub acct_snarf {
1014   my $self = shift;
1015   return () unless dbdef->table('acct_snarf');
1016   eval "use FS::acct_snarf;";
1017   die $@ if $@;
1018   qsearch('acct_snarf', { 'svcnum' => $self->svcnum } );
1019 }
1020
1021 =item seconds_since TIMESTAMP
1022
1023 Returns the number of seconds this account has been online since TIMESTAMP,
1024 according to the session monitor (see L<FS::Session>).
1025
1026 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
1027 L<Time::Local> and L<Date::Parse> for conversion functions.
1028
1029 =cut
1030
1031 #note: POD here, implementation in FS::cust_svc
1032 sub seconds_since {
1033   my $self = shift;
1034   $self->cust_svc->seconds_since(@_);
1035 }
1036
1037 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1038
1039 Returns the numbers of seconds this account has been online between
1040 TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an
1041 external SQL radacct table, specified via sqlradius export.  Sessions which
1042 started in the specified range but are still open are counted from session
1043 start to the end of the range (unless they are over 1 day old, in which case
1044 they are presumed missing their stop record and not counted).  Also, sessions
1045 which end in the range but started earlier are counted from the start of the
1046 range to session end.  Finally, sessions which start before the range but end
1047 after are counted for the entire range.
1048
1049 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1050 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
1051 functions.
1052
1053 =cut
1054
1055 #note: POD here, implementation in FS::cust_svc
1056 sub seconds_since_sqlradacct {
1057   my $self = shift;
1058   $self->cust_svc->seconds_since_sqlradacct(@_);
1059 }
1060
1061 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1062
1063 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1064 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1065 TIMESTAMP_END (exclusive).
1066
1067 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1068 L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
1069 functions.
1070
1071 =cut
1072
1073 #note: POD here, implementation in FS::cust_svc
1074 sub attribute_since_sqlradacct {
1075   my $self = shift;
1076   $self->cust_svc->attribute_since_sqlradacct(@_);
1077 }
1078
1079
1080 =item get_session_history_sqlradacct TIMESTAMP_START TIMESTAMP_END
1081
1082 Returns an array of hash references of this customers login history for the
1083 given time range.  (document this better)
1084
1085 =cut
1086
1087 sub get_session_history_sqlradacct {
1088   my $self = shift;
1089   $self->cust_svc->get_session_history_sqlradacct(@_);
1090 }
1091
1092 =item radius_groups
1093
1094 Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
1095
1096 =cut
1097
1098 sub radius_groups {
1099   my $self = shift;
1100   if ( $self->usergroup ) {
1101     #when provisioning records, export callback runs in svc_Common.pm before
1102     #radius_usergroup records can be inserted...
1103     @{$self->usergroup};
1104   } else {
1105     map { $_->groupname }
1106       qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
1107   }
1108 }
1109
1110 =item clone_suspended
1111
1112 Constructor used by FS::part_export::_export_suspend fallback.  Document
1113 better.
1114
1115 =cut
1116
1117 sub clone_suspended {
1118   my $self = shift;
1119   my %hash = $self->hash;
1120   $hash{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
1121   new FS::svc_acct \%hash;
1122 }
1123
1124 =item clone_kludge_unsuspend
1125
1126 Constructor used by FS::part_export::_export_unsuspend fallback.  Document
1127 better.
1128
1129 =cut
1130
1131 sub clone_kludge_unsuspend {
1132   my $self = shift;
1133   my %hash = $self->hash;
1134   $hash{_password} = '';
1135   new FS::svc_acct \%hash;
1136 }
1137
1138 =item check_password
1139
1140 Checks the supplied password against the (possibly encrypted) password in the
1141 database.  Returns true for a sucessful authentication, false for no match.
1142
1143 Currently supported encryptions are: classic DES crypt() and MD5
1144
1145 =cut
1146
1147 sub check_password {
1148   my($self, $check_password) = @_;
1149
1150   #remove old-style SUSPENDED kludge, they should be allowed to login to
1151   #self-service and pay up
1152   ( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //;
1153
1154   #eventually should check a "password-encoding" field
1155   if ( $password =~ /^(\*|!!?)$/ ) { #no self-service login
1156     return 0;
1157   } elsif ( length($password) < 13 ) { #plaintext
1158     $check_password eq $password;
1159   } elsif ( length($password) == 13 ) { #traditional DES crypt
1160     crypt($check_password, $password) eq $password;
1161   } elsif ( $password =~ /^\$1\$/ ) { #MD5 crypt
1162     unix_md5_crypt($check_password, $password) eq $password;
1163   } elsif ( $password =~ /^\$2a?\$/ ) { #Blowfish
1164     warn "Can't check password: Blowfish encryption not yet supported, svcnum".
1165          $self->svcnum. "\n";
1166     0;
1167   } else {
1168     warn "Can't check password: Unrecognized encryption for svcnum ".
1169          $self->svcnum. "\n";
1170     0;
1171   }
1172
1173 }
1174
1175 =back
1176
1177 =head1 SUBROUTINES
1178
1179 =over 4
1180
1181 =item send_email
1182
1183 =cut
1184
1185 sub send_email {
1186   my %opt = @_;
1187
1188   use Date::Format;
1189   use Mail::Internet 1.44;
1190   use Mail::Header;
1191
1192   $opt{mimetype} ||= 'text/plain';
1193   $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/;
1194
1195   $ENV{MAILADDRESS} = $opt{from};
1196   my $header = new Mail::Header ( [
1197     "From: $opt{from}",
1198     "To: $opt{to}",
1199     "Sender: $opt{from}",
1200     "Reply-To: $opt{from}",
1201     "Date: ". time2str("%a, %d %b %Y %X %z", time),
1202     "Subject: $opt{subject}",
1203     "Content-Type: $opt{mimetype}",
1204   ] );
1205   my $message = new Mail::Internet (
1206     'Header' => $header,
1207     'Body' => [ map "$_\n", split("\n", $opt{body}) ],
1208   );
1209   $!=0;
1210   $message->smtpsend( Host => $smtpmachine )
1211     or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
1212       or die "can't send email to $opt{to} via $smtpmachine with SMTP: $!";
1213 }
1214
1215 =item check_and_rebuild_fuzzyfiles
1216
1217 =cut
1218
1219 sub check_and_rebuild_fuzzyfiles {
1220   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1221   -e "$dir/svc_acct.username"
1222     or &rebuild_fuzzyfiles;
1223 }
1224
1225 =item rebuild_fuzzyfiles
1226
1227 =cut
1228
1229 sub rebuild_fuzzyfiles {
1230
1231   use Fcntl qw(:flock);
1232
1233   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1234
1235   #username
1236
1237   open(USERNAMELOCK,">>$dir/svc_acct.username")
1238     or die "can't open $dir/svc_acct.username: $!";
1239   flock(USERNAMELOCK,LOCK_EX)
1240     or die "can't lock $dir/svc_acct.username: $!";
1241
1242   my @all_username = map $_->getfield('username'), qsearch('svc_acct', {});
1243
1244   open (USERNAMECACHE,">$dir/svc_acct.username.tmp")
1245     or die "can't open $dir/svc_acct.username.tmp: $!";
1246   print USERNAMECACHE join("\n", @all_username), "\n";
1247   close USERNAMECACHE or die "can't close $dir/svc_acct.username.tmp: $!";
1248
1249   rename "$dir/svc_acct.username.tmp", "$dir/svc_acct.username";
1250   close USERNAMELOCK;
1251
1252 }
1253
1254 =item all_username
1255
1256 =cut
1257
1258 sub all_username {
1259   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1260   open(USERNAMECACHE,"<$dir/svc_acct.username")
1261     or die "can't open $dir/svc_acct.username: $!";
1262   my @array = map { chomp; $_; } <USERNAMECACHE>;
1263   close USERNAMECACHE;
1264   \@array;
1265 }
1266
1267 =item append_fuzzyfiles USERNAME
1268
1269 =cut
1270
1271 sub append_fuzzyfiles {
1272   my $username = shift;
1273
1274   &check_and_rebuild_fuzzyfiles;
1275
1276   use Fcntl qw(:flock);
1277
1278   my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1279
1280   open(USERNAME,">>$dir/svc_acct.username")
1281     or die "can't open $dir/svc_acct.username: $!";
1282   flock(USERNAME,LOCK_EX)
1283     or die "can't lock $dir/svc_acct.username: $!";
1284
1285   print USERNAME "$username\n";
1286
1287   flock(USERNAME,LOCK_UN)
1288     or die "can't unlock $dir/svc_acct.username: $!";
1289   close USERNAME;
1290
1291   1;
1292 }
1293
1294
1295
1296 =item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ]
1297
1298 =cut
1299
1300 sub radius_usergroup_selector {
1301   my $sel_groups = shift;
1302   my %sel_groups = map { $_=>1 } @$sel_groups;
1303
1304   my $selectname = shift || 'radius_usergroup';
1305
1306   my $dbh = dbh;
1307   my $sth = $dbh->prepare(
1308     'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
1309   ) or die $dbh->errstr;
1310   $sth->execute() or die $sth->errstr;
1311   my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
1312
1313   my $html = <<END;
1314     <SCRIPT>
1315     function ${selectname}_doadd(object) {
1316       var myvalue = object.${selectname}_add.value;
1317       var optionName = new Option(myvalue,myvalue,false,true);
1318       var length = object.$selectname.length;
1319       object.$selectname.options[length] = optionName;
1320       object.${selectname}_add.value = "";
1321     }
1322     </SCRIPT>
1323     <SELECT MULTIPLE NAME="$selectname">
1324 END
1325
1326   foreach my $group ( @all_groups ) {
1327     $html .= '<OPTION';
1328     if ( $sel_groups{$group} ) {
1329       $html .= ' SELECTED';
1330       $sel_groups{$group} = 0;
1331     }
1332     $html .= ">$group</OPTION>\n";
1333   }
1334   foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
1335     $html .= "<OPTION SELECTED>$group</OPTION>\n";
1336   };
1337   $html .= '</SELECT>';
1338
1339   $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
1340            qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
1341
1342   $html;
1343 }
1344
1345 =back
1346
1347 =head1 BUGS
1348
1349 The $recref stuff in sub check should be cleaned up.
1350
1351 The suspend, unsuspend and cancel methods update the database, but not the
1352 current object.  This is probably a bug as it's unexpected and
1353 counterintuitive.
1354
1355 radius_usergroup_selector?  putting web ui components in here?  they should
1356 probably live somewhere else...
1357
1358 insertion of RADIUS group stuff in insert could be done with child_objects now
1359 (would probably clean up export of them too)
1360
1361 =head1 SEE ALSO
1362
1363 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
1364 export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
1365 L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
1366 L<freeside-queued>), L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
1367 schema.html from the base documentation.
1368
1369 =cut
1370
1371 1;
1372