X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=2f327a3d3907383cf35d2614fcd8ca1de0133d8e;hp=26c634be3bb42137223250cda823e9b204e93644;hb=8f42b751aebda2e7dce2c363bed6f1e15b411b1d;hpb=5072965ec7e8d55ef82769fc322240abc7fb7e00 diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 26c634be3..2f327a3d3 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -2,14 +2,27 @@ package FS::svc_acct; use strict; use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin - $usernamemax $passwordmin - $shellmachine @saltset @pw_set); + $usernamemax $passwordmin $passwordmax + $username_ampersand $username_letter $username_letterfirst + $username_noperiod $username_uppercase + $shellmachine $useradd $usermod $userdel $mydomain + $cyrus_server $cyrus_admin_user $cyrus_admin_pass + $cp_server $cp_user $cp_pass $cp_workgroup + $dirhash + $icradius_dbh + @saltset @pw_set); +use Carp; use FS::Conf; -use FS::Record qw( qsearchs fields ); +use FS::Record qw( qsearch qsearchs fields dbh ); use FS::svc_Common; -use FS::SSH qw(ssh); +use Net::SSH; use FS::part_svc; use FS::svc_acct_pop; +use FS::svc_acct_sm; +use FS::cust_main_invoice; +use FS::svc_domain; +use FS::raddb; +use FS::queue; @ISA = qw( FS::svc_Common ); @@ -22,6 +35,66 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $usernamemin = $conf->config('usernamemin') || 2; $usernamemax = $conf->config('usernamemax'); $passwordmin = $conf->config('passwordmin') || 6; + $passwordmax = $conf->config('passwordmax') || 8; + if ( $shellmachine ) { + if ( $conf->exists('shellmachine-useradd') ) { + $useradd = join("\n", $conf->config('shellmachine-useradd') ) + || 'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir'; + } else { + $useradd = 'useradd -d $dir -m -s $shell -u $uid $username'; + } + if ( $conf->exists('shellmachine-userdel') ) { + $userdel = join("\n", $conf->config('shellmachine-userdel') ) + || 'rm -rf $dir'; + } else { + $userdel = 'userdel $username'; + } + $usermod = join("\n", $conf->config('shellmachine-usermod') ) + || '[ -d $old_dir ] && mv $old_dir $new_dir || ( '. + 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. + 'find . -depth -print | cpio -pdm $new_dir; '. + 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. + 'rm -rf $old_dir'. + ')'; + } + $username_letter = $conf->exists('username-letter'); + $username_letterfirst = $conf->exists('username-letterfirst'); + $username_noperiod = $conf->exists('username-noperiod'); + $username_uppercase = $conf->exists('username-uppercase'); + $username_ampersand = $conf->exists('username-ampersand'); + $mydomain = $conf->config('domain'); + if ( $conf->exists('cyrus') ) { + ($cyrus_server, $cyrus_admin_user, $cyrus_admin_pass) = + $conf->config('cyrus'); + eval "use Cyrus::IMAP::Admin;" + } else { + $cyrus_server = ''; + $cyrus_admin_user = ''; + $cyrus_admin_pass = ''; + } + if ( $conf->exists('cp_app') ) { + ($cp_server, $cp_user, $cp_pass, $cp_workgroup) = + $conf->config('cp_app'); + eval "use Net::APP;" + } else { + $cp_server = ''; + $cp_user = ''; + $cp_pass = ''; + $cp_workgroup = ''; + } + if ( $conf->exists('icradiusmachines') ) { + if ( $conf->exists('icradius_secrets') ) { + #need some sort of late binding so it's only connected to when + # actually used, hmm + $icradius_dbh = DBI->connect($conf->config('icradius_secrets')) + or die $DBI::errstr; + } else { + $icradius_dbh = dbh; + } + } else { + $icradius_dbh = ''; + } + $dirhash = $conf->config('dirhash') || 0; }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -29,6 +102,18 @@ $FS::UID::callback{'FS::svc_acct'} = sub { #not needed in 5.004 #srand($$|time); +sub _cache { + my $self = shift; + my ( $hashref, $cache ) = @_; + if ( $hashref->{'svc_acct_svcnum'} ) { + $self->{'_domsvc'} = FS::svc_domain->new( { + 'svcnum' => $hashref->{'domsvc'}, + 'domain' => $hashref->{'svc_acct_domain'}, + 'catchall' => $hashref->{'svc_acct_catchall'}, + } ); + } +} + =head1 NAME FS::svc_acct - Object methods for svc_acct records @@ -56,6 +141,18 @@ FS::svc_acct - Object methods for svc_acct records %hash = $record->radius; + %hash = $record->radius_reply; + + %hash = $record->radius_check; + + $domain = $record->domain; + + $svc_domain = $record->svc_domain; + + $email = $record->email; + + $seconds_since = $record->seconds_since($timestamp); + =head1 DESCRIPTION An FS::svc_acct object represents an account. FS::svc_acct inherits from @@ -85,8 +182,14 @@ FS::svc_Common. The following fields are currently supported: =item slipip - IP address +=item seconds - + +=item domsvc - svcnum from svc_domain + =item radius_I - I +=item domsvc - service number of svc_domain with which to associate + =back =head1 METHODS @@ -110,12 +213,24 @@ The additional fields pkgnum and svcpart (see L) should be defined. An FS::cust_svc record will be created and inserted. If the configuration value (see L) shellmachine exists, and the -username, uid, and dir fields are defined, the command +username, uid, and dir fields are defined, the command(s) specified in +the shellmachine-useradd configuration are added to the job queue (see +L and L) to be exectued on shellmachine via ssh. +This behaviour can be surpressed by setting $FS::svc_acct::nossh_hack true. +If the shellmachine-useradd configuration file does not exist, useradd -d $dir -m -s $shell -u $uid $username -is executed on shellmachine via ssh. This behaviour can be surpressed by -setting $FS::svc_acct::nossh_hack true. +is the default. If the shellmachine-useradd configuration file exists but +it empty, + + cp -pr /etc/skel $dir; chown -R $uid.$gid $dir + +is the default instead. Otherwise the contents of the file are treated as +a double-quoted perl string, with the following variables available: +$username, $uid, $gid, $dir, and $shell. + +(TODOC: cyrus config file, L and L) =cut @@ -130,48 +245,218 @@ sub insert { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $amount = 0; + $error = $self->check; return $error if $error; return "Username ". $self->username. " in use" - if qsearchs( 'svc_acct', { 'username' => $self->username } ); + if qsearchs( 'svc_acct', { 'username' => $self->username, + 'domsvc' => $self->domsvc, + } ); my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); - return "Unkonwn svcpart" unless $part_svc; + return "Unknown svcpart" unless $part_svc; return "uid in use" - if $part_svc->svc_acct__uid_flag ne 'F' + if $part_svc->part_svc_column('uid')->columnflag ne 'F' && qsearchs( 'svc_acct', { 'uid' => $self->uid } ) && $self->username !~ /^(hyla)?fax$/ ; $error = $self->SUPER::insert; - return $error if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } - my ( $username, $uid, $dir, $shell ) = ( + my( $username, $uid, $gid, $dir, $shell ) = ( $self->username, $self->uid, + $self->gid, $self->dir, $self->shell, ); - if ( $username - && $uid - && $dir - && $shellmachine - && ! $nossh_hack ) { - #one way - ssh("root\@$shellmachine", - "useradd -d $dir -m -s $shell -u $uid $username" - ); - #another way - #ssh("root\@$shellmachine","/bin/mkdir $dir; /bin/chmod 711 $dir; ". - # "/bin/cp -p /etc/skel/.* $dir 2>/dev/null; ". - # "/bin/cp -pR /etc/skel/Maildir $dir 2>/dev/null; ". - # "/bin/chown -R $uid $dir") unless $nossh_hack; + if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) { + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'Net::SSH::ssh_cmd', + }; + $error = $queue->insert("root\@$shellmachine", eval qq("$useradd") ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } } + if ( $cyrus_server ) { + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::cyrus_insert', + }; + $error = $queue->insert($self->username, $self->quota); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + + if ( $cp_server ) { + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::cp_insert' + }; + $error = $queue->insert($self->username, $self->_password); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + + if ( $icradius_dbh ) { + + my $radcheck_queue = + new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::icradius_rc_insert' + }; + $error = $radcheck_queue->insert( $self->username, + $self->_password, + $self->radius_check + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + my $radreply_queue = + new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::icradius_rr_insert' + }; + $error = $radreply_queue->insert( $self->username, + $self->_password, + $self->radius_reply + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } +sub cyrus_insert { + my( $username, $quota ) = @_; + + warn "cyrus_insert: starting for user $username, quota $quota\n"; + + warn "cyrus_insert: connecting to $cyrus_server\n"; + my $client = Cyrus::IMAP::Admin->new($cyrus_server); + + warn "cyrus_insert: authentication as $cyrus_admin_user\n"; + $client->authenticate( + -user => $cyrus_admin_user, + -mechanism => "login", + -password => $cyrus_admin_pass + ); + + warn "cyrus_insert: creating user.$username\n"; + my $rc = $client->create("user.$username"); + my $error = $client->error; + die "cyrus_insert: error creating user.$username: $error" if $error; + + warn "cyrus_insert: setacl user.$username, $username => all\n"; + $rc = $client->setacl("user.$username", $username => 'all' ); + $error = $client->error; + die "cyrus_insert: error setacl user.$username: $error" if $error; + + if ( $quota ) { + warn "cyrus_insert: setquota user.$username, STORAGE => $quota\n"; + $rc = $client->setquota("user.$username", 'STORAGE' => $quota ); + $error = $client->error; + die "cyrus_insert: error setquota user.$username: $error" if $error; + } + + 1; +} + +sub cp_insert { + my( $username, $password ) = @_; + + my $app = new Net::APP ( $cp_server, + User => $cp_user, + Password => $cp_pass, + Domain => $mydomain, + Timeout => 60, + #Debug => 1, + ) or die $@; + + $app->create_mailbox( + Mailbox => $username, + Password => $password, + Workgroup => $cp_workgroup, + Domain => $mydomain, + ); + + die $app->message unless $app->ok; +} + +sub icradius_rc_insert { + my( $username, $password, %radcheck ) = @_; + + my $sth = $icradius_dbh->prepare( + "INSERT INTO radcheck ( id, UserName, Attribute, Value ) VALUES ( ". + join(", ", map { $icradius_dbh->quote($_) } ( + '', + $username, + "Password", + $password, + ) ). " )" + ); + $sth->execute or die "can't insert into radcheck table: ". $sth->errstr; + + foreach my $attribute ( keys %radcheck ) { + my $sth = $icradius_dbh->prepare( + "INSERT INTO radcheck ( id, UserName, Attribute, Value ) VALUES ( ". + join(", ", map { $icradius_dbh->quote($_) } ( + '', + $username, + $attribute, + $radcheck{$attribute}, + ) ). " )" + ); + $sth->execute or die "can't insert into radcheck table: ". $sth->errstr; + } + + 1; +} + +sub icradius_rr_insert { + my( $username, $password, %radreply ) = @_; + + foreach my $attribute ( keys %radreply ) { + my $sth = $icradius_dbh->prepare( + "INSERT INTO radreply ( id, UserName, Attribute, Value ) VALUES ( ". + join(", ", map { $icradius_dbh->quote($_) } ( + '', + $username, + $attribute, + $radreply{$attribute}, + ) ). " )" + ); + $sth->execute or die "can't insert into radreply table: ". $sth->errstr; + } + + 1; +} + =item delete Deletes this account from the database. If there is an error, returns the @@ -179,18 +464,46 @@ error, otherwise returns false. The corresponding FS::cust_svc record will be deleted as well. -If the configuration value (see L) shellmachine exists, the command: +If the configuration value (see L) shellmachine exists, the +command(s) specified in the shellmachine-userdel configuration file are +added to the job queue (see L and L) to be executed +on shellmachine via ssh. This behavior can be surpressed by setting +$FS::svc_acct::nossh_hack true. If the shellmachine-userdel configuration +file does not exist, userdel $username -is executed on shellmachine via ssh. This behaviour can be surpressed by -setting $FS::svc_acct::nossh_hack true. +is the default. If the shellmachine-userdel configuration file exists but +is empty, + + rm -rf $dir + +is the default instead. Otherwise the contents of the file are treated as a +double-quoted perl string, with the following variables available: +$username and $dir. + +(TODOC: cyrus config file) =cut sub delete { my $self = shift; - my $error; + + if ( defined( $FS::Record::dbdef->table('svc_acct_sm') ) ) { + return "Can't delete an account which has (svc_acct_sm) mail aliases!" + if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } ); + } + + return "Can't delete an account which is a (svc_forward) source!" + if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } ); + + return "Can't delete an account which is a (svc_forward) destination!" + if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } ); + + return "Can't delete an account with (svc_www) web service!" + if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } ); + + # what about records in session ? local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -199,28 +512,179 @@ sub delete { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - $error = $self->SUPER::delete; - return $error if $error; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; - my $username = $self->username; + foreach my $cust_main_invoice ( + qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } ) + ) { + unless ( defined($cust_main_invoice) ) { + warn "WARNING: something's wrong with qsearch"; + next; + } + my %hash = $cust_main_invoice->hash; + $hash{'dest'} = $self->email; + my $new = new FS::cust_main_invoice \%hash; + my $error = $new->replace($cust_main_invoice); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + foreach my $svc_domain ( + qsearch( 'svc_domain', { 'catchall' => $self->svcnum } ) + ) { + my %hash = new FS::svc_domain->hash; + $hash{'catchall'} = ''; + my $new = new FS::svc_domain \%hash; + my $error = $new->replace($svc_domain); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my( $username, $dir ) = ( + $self->username, + $self->dir, + ); if ( $username && $shellmachine && ! $nossh_hack ) { - ssh("root\@$shellmachine","userdel $username"); + my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; + $error = $queue->insert("root\@$shellmachine", eval qq("$userdel") ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + if ( $cyrus_server ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_delete' }; + $error = $queue->insert($self->username); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + + if ( $cp_server ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_delete' }; + $error = $queue->insert($self->username); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + + if ( $icradius_dbh ) { + + my $radcheck_queue = + new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' }; + $error = $radcheck_queue->insert( $self->username ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + my $radreply_queue = + new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_delete' }; + $error = $radreply_queue->insert( $self->username ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } +sub cyrus_delete { + my $username = shift; + + my $client = Cyrus::IMAP::Admin->new($cyrus_server); + $client->authenticate( + -user => $cyrus_admin_user, + -mechanism => "login", + -password => $cyrus_admin_pass + ); + + my $rc = $client->setacl("user.$username", $cyrus_admin_user => 'all' ); + my $error = $client->error; + die $error if $error; + + $rc = $client->delete("user.$username"); + $error = $client->error; + die $error if $error; + + 1; +} + +sub cp_delete { + my( $username ) = @_; + my $app = new Net::APP ( $cp_server, + User => $cp_user, + Password => $cp_pass, + Domain => $mydomain, + Timeout => 60, + #Debug => 1, + ) or die $@; + + $app->delete_mailbox( + Mailbox => $username, + Domain => $mydomain, + ); + + die $app->message unless $app->ok; +} + +sub icradius_rc_delete { + my $username = shift; + + my $sth = $icradius_dbh->prepare( + 'DELETE FROM radcheck WHERE UserName = ?' + ); + $sth->execute($username) + or die "can't delete from radcheck table: ". $sth->errstr; + + 1; +} + +sub icradius_rr_delete { + my $username = shift; + + my $sth = $icradius_dbh->prepare( + 'DELETE FROM radreply WHERE UserName = ?' + ); + $sth->execute($username) + or die "can't delete from radreply table: ". $sth->errstr; + + 1; +} + =item replace OLD_RECORD Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. If the configuration value (see L) shellmachine exists, and the -dir field has changed, the command: +dir field has changed, the command(s) specified in the shellmachine-usermod +configuraiton file are added to the job queue (see L and +L) to be executed on shellmachine via ssh. This behavior can +be surpressed by setting $FS::svc-acct::nossh_hack true. If the +shellmachine-userdel configuration file does not exist or is empty, - [ -d $old_dir ] && ( + [ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; - umask 022; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; @@ -229,8 +693,8 @@ dir field has changed, the command: rm -rf $old_dir ) -is executed on shellmachine via ssh. This behaviour can be surpressed by -setting $FS::svc_acct::nossh_hack true. +is the default. This behaviour can be surpressed by setting +$FS::svc_acct::nossh_hack true. =cut @@ -240,9 +704,17 @@ sub replace { return "Username in use" if $old->username ne $new->username && - qsearchs( 'svc_acct', { 'username' => $new->username } ); + qsearchs( 'svc_acct', { 'username' => $new->username, + 'domsvc' => $new->domsvc, + } ); + { + #no warnings 'numeric'; #alas, a 5.006-ism + local($^W) = 0; + return "Can't change uid!" if $old->uid != $new->uid; + } - return "Can't change uid!" if $old->uid != $new->uid; + return "can't change username using Cyrus" + if $cyrus_server && $old->username ne $new->username; #change homdir when we change username $new->setfield('dir', '') if $old->username ne $new->username; @@ -254,29 +726,130 @@ sub replace { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + $error = $new->SUPER::replace($old); - return $error if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; + } - my ( $old_dir, $new_dir ) = ( $old->getfield('dir'), $new->getfield('dir') ); - my ( $uid, $gid) = ( $new->getfield('uid'), $new->getfield('gid') ); - if ( $old_dir - && $new_dir - && $old_dir ne $new_dir - && ! $nossh_hack - ) { - ssh("root\@$shellmachine","[ -d $old_dir ] && ". - "( chmod u+t $old_dir; ". #turn off qmail delivery - "umask 022; mkdir $new_dir; cd $old_dir; ". - "find . -depth -print | cpio -pdm $new_dir; ". - "chmod u-t $new_dir; chown -R $uid.$gid $new_dir; ". - "rm -rf $old_dir". - ")" - ); + my ( $old_dir, $new_dir, $uid, $gid ) = ( + $old->getfield('dir'), + $new->getfield('dir'), + $new->getfield('uid'), + $new->getfield('gid'), + ); + if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) { + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'Net::SSH::ssh_cmd' + }; + $error = $queue->insert("root\@$shellmachine", eval qq("$usermod") ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + + if ( $cp_server && $old->username ne $new->username ) { + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'FS::svc_acct::cp_rename' + }; + $error = $queue->insert( $old->username, $new->username ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + + if ( $cp_server && $old->_password ne $new->_password ) { + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'FS::svc_acct::cp_change' + }; + $error = $queue->insert( $new->username, $new->_password ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } } + if ( $icradius_dbh ) { + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'FS::svc_acct::icradius_rc_replace' + }; + $error = $queue->insert( $new->username, + $new->_password, + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } +sub icradius_rc_replace { + my( $username, $new_password ) = @_; + + my $sth = $icradius_dbh->prepare( + "UPDATE radcheck SET Value = ? WHERE UserName = ? and Attribute = ?" + ); + $sth->execute($new_password, $username, 'Password' ) + or die "can't update radcheck table: ". $sth->errstr; + + 1; +} + +sub cp_rename { + my ( $old_username, $new_username ); + + my $app = new Net::APP ( $cp_server, + User => $cp_user, + Password => $cp_pass, + Domain => $mydomain, + Timeout => 60, + #Debug => 1, + ) or die $@; + + $app->rename_mailbox( + Domain => $mydomain, + Old_Mailbox => $old_username, + New_Mailbox => $new_username, + ); + + die $app->message unless $app->ok; + +} + +sub cp_change { + my ( $username, $password ); + + my $app = new Net::APP ( $cp_server, + User => $cp_user, + Password => $cp_pass, + Domain => $mydomain, + Timeout => 60, + #Debug => 1, + ) or die $@; + + $app->change_mailbox( + Domain => $mydomain, + Mailbox => $username, + Password => $password, + ); + + die $app->message unless $app->ok; + +} + =item suspend Suspends this account by prefixing *SUSPENDED* to the password. If there is an @@ -289,7 +862,9 @@ Called by the suspend method of FS::cust_pkg (see L). sub suspend { my $self = shift; my %hash = $self->hash; - unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) { + unless ( $hash{_password} =~ /^\*SUSPENDED\* / + || $hash{_password} eq '*' + ) { $hash{_password} = '*SUSPENDED* '.$hash{_password}; my $new = new FS::svc_acct ( \%hash ); $new->replace($self); @@ -344,19 +919,41 @@ sub check { return $x unless ref($x); my $part_svc = $x; + my $error = $self->ut_numbern('svcnum') + || $self->ut_number('domsvc') + ; + return $error if $error; + my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; - $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/ - or return "Illegal username"; - $recref->{username} = $1; - $recref->{username} =~ /[a-z]/ or return "Illegal username"; + if ( $username_uppercase ) { + $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i + or return "Illegal username: ". $recref->{username}; + $recref->{username} = $1; + } else { + $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/ + or return "Illegal username: ". $recref->{username}; + $recref->{username} = $1; + } + + if ( $username_letterfirst ) { + $recref->{username} =~ /^[a-z]/ or return "Illegal username"; + } elsif ( $username_letter ) { + $recref->{username} =~ /[a-z]/ or return "Illegal username"; + } + if ( $username_noperiod ) { + $recref->{username} =~ /\./ and return "Illegal username"; + } + unless ( $username_ampersand ) { + $recref->{username} =~ /\&/ and return "Illegal username"; + } $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; $recref->{popnum} = $1; - return "Unkonwn popnum" unless + return "Unknown popnum" unless ! $recref->{popnum} || qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } ); - unless ( $part_svc->getfield('svc_acct__uid_flag') eq 'F' ) { + unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) { $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid"; $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1; @@ -369,15 +966,34 @@ sub check { return "Only root can have uid 0" if $recref->{uid} == 0 && $recref->{username} ne 'root'; - my($error); - return $error if $error=$self->ut_textn('finger'); +# $error = $self->ut_textn('finger'); +# return $error if $error; + $self->getfield('finger') =~ + /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/ + or return "Illegal finger: ". $self->getfield('finger'); + $self->setfield('finger', $1); - $recref->{dir} =~ /^([\/\w\-]*)$/ + $recref->{dir} =~ /^([\/\w\-\.\&]*)$/ or return "Illegal directory"; - $recref->{dir} = $1 || - $dir_prefix . '/' . $recref->{username} - #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username} + $recref->{dir} = $1; + return "Illegal directory" + if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component + return "Illegal directory" + if $recref->{dir} =~ /\&/ && ! $username_ampersand; + unless ( $recref->{dir} ) { + $recref->{dir} = $dir_prefix . '/'; + if ( $dirhash > 0 ) { + for my $h ( 1 .. $dirhash ) { + $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/'; + } + } elsif ( $dirhash < 0 ) { + for my $h ( reverse $dirhash .. -1 ) { + $recref->{dir} .= substr($recref->{username}, $h, 1). '/'; + } + } + $recref->{dir} .= $recref->{username}; ; + } unless ( $recref->{username} eq 'sync' ) { if ( grep $_ eq $recref->{shell}, @shells ) { @@ -406,7 +1022,7 @@ sub check { return "Can't have quota without uid" : ( $recref->{quota}='' ); } - unless ( $part_svc->getfield('svc_acct__slipip_flag') eq 'F' ) { + unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { unless ( $recref->{slipip} eq '0e0' ) { $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ or return "Illegal slipip". $self->slipip; @@ -427,7 +1043,7 @@ sub check { unless ( $recref->{_password} ); #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) { - if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) { + if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) { $recref->{_password} = $1.$3; #uncomment this to encrypt password immediately upon entry, or run #bin/crypt_pw in cron to give new users a window during which their @@ -440,8 +1056,11 @@ sub check { $recref->{_password} = $1.$3; } elsif ( $recref->{_password} eq '*' ) { $recref->{_password} = '*'; + } elsif ( $recref->{_password} eq '!!' ) { + $recref->{_password} = '!!'; } else { - return "Illegal password"; + #return "Illegal password"; + return "Illegal password: ". $recref->{_password}; } ''; #no error @@ -449,8 +1068,19 @@ sub check { =item radius +Depriciated, use radius_reply instead. + +=cut + +sub radius { + carp "FS::svc_acct::radius depriciated, use radius_reply"; + $_[0]->radius_reply; +} + +=item radius_reply + Returns key/value pairs, suitable for assigning to a hash, for any RADIUS -attributes of this record. +reply attributes of this record. Note that this is now the preferred method for reading RADIUS attributes - accessing the columns directly is discouraged, as the column names are @@ -458,34 +1088,125 @@ expected to change in the future. =cut -sub radius { +sub radius_reply { + my $self = shift; + my %reply = + map { + /^(radius_(.*))$/; + my($column, $attrib) = ($1, $2); + #$attrib =~ s/_/\-/g; + ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); + } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); + if ( $self->ip && $self->ip ne '0e0' ) { + $reply{'Framed-IP-Address'} = $self->ip; + } + %reply; +} + +=item radius_check + +Returns key/value pairs, suitable for assigning to a hash, for any RADIUS +check attributes of this record. + +Accessing RADIUS attributes directly is not supported and will break in the +future. + +=cut + +sub radius_check { my $self = shift; map { - /^(radius_(.*))$/; + /^(rc_(.*))$/; my($column, $attrib) = ($1, $2); - $attrib =~ s/_/\-/g; - ( $attrib, $self->getfield($column) ); - } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); + #$attrib =~ s/_/\-/g; + ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); + } grep { /^rc_/ && $self->getfield($_) } fields( $self->table ); } -=back +=item domain -=head1 VERSION +Returns the domain associated with this account. -$Id: svc_acct.pm,v 1.7 2000-06-29 11:56:52 ivan Exp $ +=cut -=head1 BUGS +sub domain { + my $self = shift; + if ( $self->domsvc ) { + #$self->svc_domain->domain; + my $svc_domain = $self->svc_domain + or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc; + $svc_domain->domain; + } else { + $mydomain or die "svc_acct.domsvc is null and no legacy domain config file"; + } +} + +=item svc_domain + +Returns the FS::svc_domain record for this account's domain (see +L. + +=cut + +sub svc_domain { + my $self = shift; + $self->{'_domsvc'} + ? $self->{'_domsvc'} + : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); +} + +=item cust_svc + +Returns the FS::cust_svc record for this account (see L). + +sub cust_svc { + my $self = shift; + qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); +} -The remote commands should be configurable. +=item email -The bits which ssh should fork before doing so. +Returns an email address associated with the account. + +=cut + +sub email { + my $self = shift; + $self->username. '@'. $self->domain; +} + +=item seconds_since TIMESTAMP + +Returns the number of seconds this account has been online since TIMESTAMP. +See L + +TIMESTAMP is specified as a UNIX timestamp; see L. Also see +L and L for conversion functions. + +=cut + +#note: POD here, implementation in FS::cust_svc +sub seconds_since { + my $self = shift; + $self->cust_svc->seconds_since(@_); +} + +=back + +=head1 BUGS The $recref stuff in sub check should be cleaned up. +The suspend, unsuspend and cancel methods update the database, but not the +current object. This is probably a bug as it's unexpected and +counterintuitive. + =head1 SEE ALSO -L, L, L, L, -L, L, L, L, L, +L, edit/part_svc.cgi from an installed web interface, +export.html from the base documentation, L, L, +L, L, L, L, +L), L, L, L, schema.html from the base documentation. =cut