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
$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;
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');
$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' , '.' , '/' );
=item radius_I<Radius_Attribute> - I<Radius-Attribute>
-=item domsvc - service number of svc_domain with which to associate
-
=back
=head1 METHODS
The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
defined. An FS::cust_svc record will be created and inserted.
+The additional field I<usergroup> can optionally be defined; if so it should
+contain an arrayref of group names. See L<FS::radius_usergroup>. (used in
+sqlradius export only)
+
If the configuration value (see L<FS::Conf>) 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
(TODOC: cyrus config file, L<FS::queue> and L<freeside-queued>)
+(TODOC: new exports! $noexport_hack)
+
=cut
sub insert {
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $amount = 0;
-
$error = $self->check;
return $error if $error;
'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"
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,
}
}
- 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;
}
+ #end of old-style exports
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no error
}
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
(TODOC: cyrus config file)
+(TODOC: new exports! $noexport_hack)
+
=cut
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';
}
}
+ 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,
}
}
- 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";
}
+ #end of old-style exports
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
}
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 (<VPASSWD>) {
+ 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;
}
Replaces OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
+The additional field I<usergroup> can optionally be defined; if so it should
+contain an arrayref of group names. See L<FS::radius_usergroup>. (used in
+sqlradius export only)
+
If the configuration value (see L<FS::Conf>) 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<FS::queue> and
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'),
}
}
- 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 ) = @_;
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',
);
}
}
+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 (<VPASSWD>) {
+ 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
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;
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
$self->cust_svc->seconds_since(@_);
}
+=item radius_groups
+
+Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
+
+=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 = <<END;
+ <SCRIPT>
+ 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 = "";
+ }
+ </SCRIPT>
+ <SELECT MULTIPLE NAME="$selectname">
+END
+
+ foreach my $group ( @all_groups ) {
+ $html .= '<OPTION';
+ if ( $sel_groups{$group} ) {
+ $html .= ' SELECTED';
+ $sel_groups{$group} = 0;
+ }
+ $html .= ">$group</OPTION>\n";
+ }
+ foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
+ $html .= "<OPTION SELECTED>$group</OPTION>\n";
+ };
+ $html .= '</SELECT>';
+
+ $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
+ qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
+
+ $html;
+}
+
=head1 BUGS
The $recref stuff in sub check should be cleaned up.
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<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
projects / freeside.git / blobdiff