FS/FS/svc_acct.pm

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