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