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