X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=8d22c21e00f8330f54ae1f50711343c9e12a05ba;hp=314a7527bea8634a0c06c04e8e3d21705c8207ac;hb=87af741da0dd5f6a76bbb566b4d6c54cd5b15315;hpb=1cd0fc70e60e5ecccb10e2bd4dae112a53dde330 diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 314a7527b..8d22c21e0 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,7 +1,8 @@ package FS::svc_acct; use strict; -use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin +use vars qw( @ISA $nossh_hack $noexport_hack $conf + $dir_prefix @shells $usernamemin $usernamemax $passwordmin $passwordmax $username_ampersand $username_letter $username_letterfirst $username_noperiod $username_uppercase @@ -9,9 +10,12 @@ use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin $cyrus_server $cyrus_admin_user $cyrus_admin_pass $cp_server $cp_user $cp_pass $cp_workgroup $dirhash - $icradius_dbh - @saltset @pw_set); + @saltset @pw_set + $rsync $ssh $exportdir $vpopdir); use Carp; +use File::Path; +use Fcntl qw(:flock); +use FS::UID qw( datasrc ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh ); use FS::svc_Common; @@ -23,11 +27,14 @@ use FS::cust_main_invoice; use FS::svc_domain; use FS::raddb; use FS::queue; +use FS::radius_usergroup; @ISA = qw( FS::svc_Common ); #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_acct'} = sub { + $rsync = "rsync"; + $ssh = "ssh"; $conf = new FS::Conf; $dir_prefix = $conf->config('home'); @shells = $conf->config('shells'); @@ -82,19 +89,16 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $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; - } + + $dirhash = $conf->config('dirhash') || 0; + $exportdir = "/usr/local/etc/freeside/export." . datasrc; + if ( $conf->exists('vpopmailmachines') ) { + my (@vpopmailmachines) = $conf->config('vpopmailmachines'); + my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]); + $vpopdir = $dir; } else { - $icradius_dbh = ''; + $vpopdir = ''; } - $dirhash = $conf->config('dirhash') || 0; }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -188,8 +192,6 @@ FS::svc_Common. The following fields are currently supported: =item radius_I - I -=item domsvc - service number of svc_domain with which to associate - =back =head1 METHODS @@ -212,6 +214,10 @@ otherwise returns false. The additional fields pkgnum and svcpart (see L) should be defined. An FS::cust_svc record will be created and inserted. +The additional field I can optionally be defined; if so it should +contain an arrayref of group names. See L. (used in +sqlradius export only) + 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 added to the job queue (see @@ -232,6 +238,8 @@ $username, $uid, $gid, $dir, and $shell. (TODOC: cyrus config file, L and L) +(TODOC: new exports! $noexport_hack) + =cut sub insert { @@ -249,8 +257,6 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $amount = 0; - $error = $self->check; return $error if $error; @@ -259,6 +265,16 @@ sub insert { 'domsvc' => $self->domsvc, } ); + if ( $self->svcnum ) { + my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); + unless ( $cust_svc ) { + $dbh->rollback if $oldAutoCommit; + return "no cust_svc record found for svcnum ". $self->svcnum; + } + $self->pkgnum($cust_svc->pkgnum); + $self->svcpart($cust_svc->svcpart); + } + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); return "Unknown svcpart" unless $part_svc; return "uid in use" @@ -273,6 +289,34 @@ sub insert { return $error; } + if ( $self->usergroup ) { + foreach my $groupname ( @{$self->usergroup} ) { + my $radius_usergroup = new FS::radius_usergroup ( { + svcnum => $self->svcnum, + groupname => $groupname, + } ); + my $error = $radius_usergroup->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_insert($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + #old-style exports + my( $username, $uid, $gid, $dir, $shell ) = ( $self->username, $self->uid, @@ -316,30 +360,17 @@ sub insert { } } - 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"; - } + if ( $vpopdir ) { - my $radreply_queue = + my $vpopmail_queue = new FS::queue { 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::icradius_rr_insert' + 'job' => 'FS::svc_acct::vpopmail_insert' }; - $error = $radreply_queue->insert( $self->username, - $self->_password, - $self->radius_reply + $error = $vpopmail_queue->insert( $self->username, + crypt($self->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]), + $self->domain, + $vpopdir, ); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -348,6 +379,8 @@ sub insert { } + #end of old-style exports + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -408,53 +441,47 @@ sub cp_insert { die $app->message."\n" unless $app->ok; } -sub icradius_rc_insert { - my( $username, $password, %radcheck ) = @_; +sub vpopmail_insert { + my( $username, $password, $domain, $vpopdir ) = @_; - 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; - } + (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd") + and flock(VPASSWD,LOCK_EX) + ) or die "can't open vpasswd file for $username\@$domain: $exportdir/domains/$domain/vpasswd"; + print VPASSWD join(":", + $username, + $password, + '1', + '0', + $username, + "$vpopdir/domains/$domain/$username", + 'NOQUOTA', + ), "\n"; + + flock(VPASSWD,LOCK_UN); + close(VPASSWD); + + mkdir "$exportdir/domains/$domain/$username", 0700 or die "can't create Maildir"; + mkdir "$exportdir/domains/$domain/$username/Maildir", 0700 or die "can't create Maildir"; + mkdir "$exportdir/domains/$domain/$username/Maildir/cur", 0700 or die "can't create Maildir"; + mkdir "$exportdir/domains/$domain/$username/Maildir/new", 0700 or die "can't create Maildir"; + mkdir "$exportdir/domains/$domain/$username/Maildir/tmp", 0700 or die "can't create Maildir"; + + my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' }; + my $error = $queue->insert; + die $error if $error; 1; } -sub icradius_rr_insert { - my( $username, $password, %radreply ) = @_; +sub vpopmail_sync { + + my (@vpopmailmachines) = $conf->config('vpopmailmachines'); + my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]); - 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; - } + chdir $exportdir; + my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$vpopdir/domains/"); + system {$args[0]} @args; - 1; } =item delete @@ -484,6 +511,8 @@ $username and $dir. (TODOC: cyrus config file) +(TODOC: new exports! $noexport_hack) + =cut sub delete { @@ -503,7 +532,7 @@ sub delete { return "Can't delete an account with (svc_www) web service!" if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } ); - # what about records in session ? + # what about records in session ? (they should refer to history table) local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -546,12 +575,38 @@ sub delete { } } + foreach my $radius_usergroup ( + qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ) + ) { + my $error = $radius_usergroup->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $part_svc = $self->cust_svc->part_svc; + my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $part_svc->part_export ) { + my $error = $part_export->export_delete($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + #old-style exports + my( $username, $dir ) = ( $self->username, $self->dir, @@ -584,19 +639,9 @@ sub delete { } } - 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 ( $vpopdir ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' }; + $error = $queue->insert( $self->username, $self->domain ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -604,6 +649,8 @@ sub delete { } + #end of old-style exports + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -647,27 +694,30 @@ sub cp_delete { die $app->message."\n" unless $app->ok; } -sub icradius_rc_delete { - my $username = shift; +sub vpopmail_delete { + my( $username, $domain ) = @_; - my $sth = $icradius_dbh->prepare( - 'DELETE FROM radcheck WHERE UserName = ?' - ); - $sth->execute($username) - or die "can't delete from radcheck table: ". $sth->errstr; + (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") + and flock(VPASSWD,LOCK_EX) + ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; - 1; -} + open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") + or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; -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; + while () { + my ($mailbox, $rest) = split(':', $_); + print VPASSWDTMP $_ unless $username eq $mailbox; + } + close(VPASSWDTMP); + + rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd" + or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; + + flock(VPASSWD,LOCK_UN); + close(VPASSWD); + + rmtree "$exportdir/domains/$domain/$username" or die "can't destroy Maildir";+ 1; } @@ -676,6 +726,10 @@ sub icradius_rr_delete { Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. +The additional field I can optionally be defined; if so it should +contain an arrayref of group names. See L. (used in +sqlradius export only) + 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 added to the job queue (see L and @@ -736,6 +790,54 @@ sub replace { return $error if $error; } + $old->usergroup( [ $old->radius_groups ] ); + if ( $new->usergroup ) { + #(sorta) false laziness with FS::part_export::sqlradius::_export_replace + my @newgroups = @{$new->usergroup}; + foreach my $oldgroup ( @{$old->usergroup} ) { + if ( grep { $oldgroup eq $_ } @newgroups ) { + @newgroups = grep { $oldgroup ne $_ } @newgroups; + next; + } + my $radius_usergroup = qsearchs('radius_usergroup', { + svcnum => $old->svcnum, + groupname => $oldgroup, + } ); + my $error = $radius_usergroup->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error deleting radius_usergroup $oldgroup: $error"; + } + } + + foreach my $newgroup ( @newgroups ) { + my $radius_usergroup = new FS::radius_usergroup ( { + svcnum => $new->svcnum, + groupname => $newgroup, + } ); + my $error = $radius_usergroup->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error adding radius_usergroup $newgroup: $error"; + } + } + + } + + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $new->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_replace($new,$old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + #old-style exports + my ( $old_dir, $new_dir, $uid, $gid ) = ( $old->getfield('dir'), $new->getfield('dir'), @@ -778,36 +880,37 @@ sub replace { } } - 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 ( $vpopdir ) { + my $cpassword = crypt( + $new->_password,$saltset[int(rand(64))].$saltset[int(rand(64))] + ); + + if ($old->username ne $new->username || $old->domain ne $new->domain ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' }; + $error = $queue->insert( $old->username, $old->domain ); + my $queue2 = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_insert' }; + $error = $queue2->insert( $new->username, + $cpassword, + $new->domain, + $vpopdir, + ) + unless $error; + } elsif ($old->_password ne $new->_password) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_replace_password' }; + $error = $queue->insert( $new->username, $cpassword, $new->domain ); + } if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } } + #end of old-style exports + $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 ) = @_; @@ -843,12 +946,16 @@ sub cp_change { if ( $password =~ /^\*SUSPENDED\* (.*)$/ ) { $password = $1; $app->set_mailbox_status( - Other => 'T', + Domain => $mydomain, + Mailbox => $username, + Other => 'T', Other_Bounce => 'T', ); } else { $app->set_mailbox_status( - Other => 'F', + Domain => $mydomain, + Mailbox => $username, + Other => 'F', Other_Bounce => 'F', ); } @@ -863,6 +970,39 @@ sub cp_change { } +sub vpopmail_replace_password { + my( $username, $password, $domain ) = @_; + + (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") + and flock(VPASSWD,LOCK_EX) + ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; + + open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") + or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; + + while () { + my ($mailbox, $pw, @rest) = split(':', $_); + print VPASSWDTMP $_ unless $username eq $mailbox; + print VPASSWDTMP join (':', ($mailbox, $password, @rest)) + if $username eq $mailbox; + } + + close(VPASSWDTMP); + + rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd" + or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; + + flock(VPASSWD,LOCK_UN); + close(VPASSWD); + + my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' }; + my $error = $queue->insert; + die $error if $error; + + 1; +} + + =item suspend Suspends this account by prefixing *SUSPENDED* to the password. If there is an @@ -932,8 +1072,14 @@ sub check { return $x unless ref($x); my $part_svc = $x; + if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) { + $self->usergroup( + [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] ); + } + my $error = $self->ut_numbern('svcnum') || $self->ut_number('domsvc') + || $self->ut_textn('sec_phrase') ; return $error if $error; @@ -1121,19 +1267,22 @@ sub radius_reply { 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. +Note that this is now the preferred method for reading RADIUS attributes - +accessing the columns directly is discouraged, as the column names are +expected to change in the future. =cut sub radius_check { my $self = shift; - map { - /^(rc_(.*))$/; - my($column, $attrib) = ($1, $2); - #$attrib =~ s/_/\-/g; - ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); - } grep { /^rc_/ && $self->getfield($_) } fields( $self->table ); + ( 'Password' => $self->_password, + map { + /^(rc_(.*))$/; + my($column, $attrib) = ($1, $2); + #$attrib =~ s/_/\-/g; + ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); + } grep { /^rc_/ && $self->getfield($_) } fields( $self->table ) + ); } =item domain @@ -1204,8 +1353,71 @@ sub seconds_since { $self->cust_svc->seconds_since(@_); } +=item radius_groups + +Returns all RADIUS groups for this account (see L). + +=cut + +sub radius_groups { + my $self = shift; + map { $_->groupname } + qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); +} + =back +=head1 SUBROUTINES + +=item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ] + +=cut + +sub radius_usergroup_selector { + my $sel_groups = shift; + my %sel_groups = map { $_=>1 } @$sel_groups; + + my $selectname = shift || 'radius_usergroup'; + + my $dbh = dbh; + my $sth = $dbh->prepare( + 'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname' + ) or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref}; + + my $html = < + function ${selectname}_doadd(object) { + var myvalue = object.${selectname}_add.value; + var optionName = new Option(myvalue,myvalue,false,true); + var length = object.$selectname.length; + object.$selectname.options[length] = optionName; + object.${selectname}_add.value = ""; + } + + !. + qq!!; + + $html; +} + =head1 BUGS The $recref stuff in sub check should be cleaned up. @@ -1214,6 +1426,9 @@ 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. +radius_usergroup_selector? putting web ui components in here? they should +probably live somewhere else... + =head1 SEE ALSO L, edit/part_svc.cgi from an installed web interface,