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