X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=e52cebf15b6b8c98b4e9c7aaa79c3c14c7461bff;hb=5477d23b51bd3135893c4d79091a9e272a17f4f8;hp=42eb7d9eef7b6d5d2063b976333bf81f5e8eabea;hpb=8a8c9386cbd3383b0134aae8e32b5995f8886fb2;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 42eb7d9ee..e52cebf15 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -3,16 +3,23 @@ package FS::svc_acct; use strict; use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin $usernamemax $passwordmin $username_letter $username_letterfirst - $shellmachine $useradd $usermod $userdel + $username_noperiod + $shellmachine $useradd $usermod $userdel $mydomain + $cyrus_server $cyrus_admin_user $cyrus_admin_pass + $icradius_dbh @saltset @pw_set); use Carp; use FS::Conf; -use FS::Record qw( qsearch qsearchs fields ); +use FS::Record qw( qsearch qsearchs fields dbh ); use FS::svc_Common; use Net::SSH qw(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 ); @@ -48,6 +55,23 @@ $FS::UID::callback{'FS::svc_acct'} = sub { } $username_letter = $conf->exists('username-letter'); $username_letterfirst = $conf->exists('username-letterfirst'); + $username_noperiod = $conf->exists('username-noperiod'); + $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('icradius_secrets') ) { + $icradius_dbh = DBI->connect($conf->config('icradius_secrets')) + or die $DBI::errstr; + } else { + $icradius_dbh = ''; + } }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -115,6 +139,10 @@ 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 @@ -143,7 +171,8 @@ 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(s) specified in -the shellmachine-useradd configuration are exectued on shellmachine via ssh. +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, @@ -158,6 +187,8 @@ 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 sub insert { @@ -171,6 +202,12 @@ 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; @@ -182,13 +219,16 @@ sub insert { my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); 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, $gid, $dir, $shell ) = ( $self->username, @@ -198,12 +238,103 @@ sub insert { $self->shell, ); if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) { - ssh("root\@$shellmachine", eval qq("$useradd") ); + my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' }; + $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 { '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 ( $icradius_dbh ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_insert' }; + $error = $queue->insert( $self->username, + $self->_password, + $self->radius_check + ); + 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 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; +} + =item delete Deletes this account from the database. If there is an error, returns the @@ -213,7 +344,8 @@ The corresponding FS::cust_svc record will be deleted as well. If the configuration value (see L) shellmachine exists, the command(s) specified in the shellmachine-userdel configuration file are -executed on shellmachine via ssh. This behavior can be surpressed by setting +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, @@ -228,14 +360,28 @@ 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; - return "Can't delete an account which has mail aliases pointed to it!" - if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } ); + 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'; @@ -244,20 +390,110 @@ 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; + + foreach my $cust_main_invoice ( + qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } ) + ) { + 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", eval qq("$userdel") ); + my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' }; + $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 ( $icradius_dbh ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' }; + $error = $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 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; +} + =item replace OLD_RECORD Replaces OLD_RECORD with this one in the database. If there is an error, @@ -265,9 +501,10 @@ returns the error, otherwise returns false. If the configuration value (see L) shellmachine exists, and the dir field has changed, the command(s) specified in the shellmachine-usermod -configuraiton file are executed on shellmachine via ssh. This behavior can +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, : +shellmachine-userdel configuration file does not exist or is empty, [ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; @@ -279,8 +516,8 @@ shellmachine-userdel configuration file does not exist or is empty, : 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 @@ -294,6 +531,9 @@ sub replace { 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; @@ -304,8 +544,15 @@ 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, $uid, $gid ) = ( $old->getfield('dir'), @@ -314,9 +561,15 @@ sub replace { $new->getfield('gid'), ); if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) { - ssh("root\@$shellmachine", eval qq("$usermod") ); + my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' }; + $error = $queue->insert("root\@$shellmachine", eval qq("$usermod") ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -387,7 +640,9 @@ sub check { return $x unless ref($x); my $part_svc = $x; - my $error = $self->ut_number('domsvc'); + my $error = $self->ut_numbern('svcnum') + || $self->ut_number('domsvc') + ; return $error if $error; my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; @@ -399,6 +654,9 @@ sub check { } elsif ( $username_letter ) { $recref->{username} =~ /[a-z]/ or return "Illegal username"; } + if ( $username_noperiod ) { + $recref->{username} =~ /\./ and return "Illegal username"; + } $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; $recref->{popnum} = $1; @@ -406,7 +664,7 @@ sub check { ! $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; @@ -456,7 +714,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; @@ -526,8 +784,8 @@ sub radius_reply { map { /^(radius_(.*))$/; my($column, $attrib) = ($1, $2); - $attrib =~ s/_/\-/g; - ( $attrib, $self->getfield($column) ); + #$attrib =~ s/_/\-/g; + ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); } @@ -546,11 +804,28 @@ sub radius_check { map { /^(rc_(.*))$/; my($column, $attrib) = ($1, $2); - $attrib =~ s/_/\-/g; - ( $attrib, $self->getfield($column) ); + #$attrib =~ s/_/\-/g; + ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); } grep { /^rc_/ && $self->getfield($_) } fields( $self->table ); } +=item domain + +Returns the domain associated with this account. + +=cut + +sub domain { + my $self = shift; + if ( $self->domsvc ) { + my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ) + 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 email Returns an email address associated with the account. @@ -559,22 +834,14 @@ Returns an email address associated with the account. sub email { my $self = shift; - my $domain; - my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); - if ($svc_domain) { - $domain=$svc_domain->domain; - }else{ - warn "couldn't find svc_acct.domsvc " . $self->domsvc . "!"; - $domain="unknown"; - } - return $self->username . "@" . $domain; + $self->username. '@'. $self->domain; } =back =head1 VERSION -$Id: svc_acct.pm,v 1.24 2001-08-19 15:53:34 jeff Exp $ +$Id: svc_acct.pm,v 1.39 2001-09-14 19:54:22 ivan Exp $ =head1 BUGS @@ -590,7 +857,8 @@ counterintuitive. =head1 SEE ALSO L, L, L, L, -L, L, L, L, L, +L, L, L, L), +L, L, L, schema.html from the base documentation. =cut