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