X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=0be6e5b8d1d1d390be76076a9c2b166a57ddc8fa;hp=03230dd0629a1b307b8fb38029d06b13453d70f4;hb=ef6202c5eded27360d058c84cb8cb2b5cf69478f;hpb=b475b428df20541c8f2dec5c9ef101ebb9f1cf94 diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 03230dd06..0be6e5b8d 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -8,6 +8,8 @@ use vars qw( @ISA $noexport_hack $conf $username_noperiod $username_nounderscore $username_nodash $username_uppercase $mydomain + $welcome_template $welcome_from $welcome_subject $welcome_mimetype + $smtpmachine $dirhash @saltset @pw_set ); use Carp; @@ -48,8 +50,19 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $username_uppercase = $conf->exists('username-uppercase'); $username_ampersand = $conf->exists('username-ampersand'); $mydomain = $conf->config('domain'); - $dirhash = $conf->config('dirhash') || 0; + if ( $conf->exists('welcome_email') ) { + $welcome_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", $conf->config('welcome_email') ] + ) or warn "can't create welcome email template: $Text::Template::ERROR"; + $welcome_from = $conf->config('welcome_email-from'); # || 'your-isp-is-dum' + $welcome_subject = $conf->config('welcome_email-subject') || 'Welcome'; + $welcome_mimetype = $conf->config('welcome_email-mimetype') || 'text/plain'; + } else { + $welcome_template = ''; + } + $smtpmachine = $conf->config('smtpmachine'); }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -194,12 +207,25 @@ sub insert { return $error if $error; #no, duplicate checking just got a whole lot more complicated + #(perhaps keep this check with a config option to turn on?) #return gettext('username_in_use'). ": ". $self->username # if qsearchs( 'svc_acct', { 'username' => $self->username, # '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); + } + + #new duplicate username checking + my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } ); my @dup_userdomain = qsearchs( 'svc_acct', { 'username' => $self->username, 'domsvc' => $self->domsvc } ); @@ -208,13 +234,19 @@ sub insert { my $exports = FS::part_export::export_info('svc_acct'); my( %conflict_user_svcpart, %conflict_userdomain_svcpart ); - foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); + unless ( $part_svc ) { + $dbh->rollback if $oldAutoCommit; + return 'unknown svcpart '. $self->svcpart; + } + + foreach my $part_export ( $part_svc->part_export ) { #this will catch to the same exact export my @svcparts = map { $_->svcpart } qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); - #this will catch exports w/same exporthost+type ??? + #this will catch to exports w/same exporthost+type ??? #my @other_part_export = qsearch('part_export', { # 'machine' => $part_export->machine, # 'exporttype' => $part_export->exporttype, @@ -255,16 +287,6 @@ sub insert { #see? i told you it was more complicated - 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" @@ -274,7 +296,8 @@ sub insert { && $self->username !~ /^toor$/ #FreeBSD ; - $error = $self->SUPER::insert; + my @jobnums; + $error = $self->SUPER::insert(\@jobnums); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -294,6 +317,59 @@ sub insert { } } + #false laziness with sub replace (and cust_main) + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::append_fuzzyfiles' + }; + $error = $queue->insert($self->username); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + #welcome email + my $cust_pkg = $self->cust_svc->cust_pkg; + my( $cust_main, $to ) = ( '', '' ); + if ( $welcome_template && $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; + my $to = join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ); + if ( $to ) { + my $wqueue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::send_email' + }; + warn "attempting to queue email to $to"; + my $error = $wqueue->insert( + 'to' => $to, + 'from' => $welcome_from, + 'subject' => $welcome_subject, + 'mimetype' => $welcome_mimetype, + 'body' => $welcome_template->fill_in( HASH => { + 'username' => $self->username, + 'password' => $self->_password, + 'first' => $cust_main->first, + 'last' => $cust_main->getfield('last'), + 'pkg' => $cust_pkg->part_pkg->pkg, + } ), + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queuing welcome email: $error"; + } + + foreach my $jobnum ( @jobnums ) { + my $error = $wqueue->depend_insert($jobnum); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queuing welcome email job dependancy: $error"; + } + } + + } + + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -379,8 +455,6 @@ sub delete { } } - my $part_svc = $self->cust_svc->part_svc; - my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -471,6 +545,18 @@ sub replace { } + #false laziness with sub insert (and cust_main) + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'FS::svc_acct::append_fuzzyfiles' + }; + $error = $queue->insert($new->username); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -845,14 +931,137 @@ Returns all RADIUS groups for this account (see L). sub radius_groups { my $self = shift; - map { $_->groupname } - qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); + if ( $self->usergroup ) { + #when provisioning records, export callback runs in svc_Common.pm before + #radius_usergroup records can be inserted... + @{$self->usergroup}; + } else { + map { $_->groupname } + qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); + } } =back =head1 SUBROUTINES +=over 4 + +=item send_email + +=cut + +sub send_email { + my %opt = @_; + + use Date::Format; + use Mail::Internet 1.44; + use Mail::Header; + + $opt{mimetype} ||= 'text/plain'; + $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/; + + $ENV{MAILADDRESS} = $opt{from}; + my $header = new Mail::Header ( [ + "From: $opt{from}", + "To: $opt{to}", + "Sender: $opt{from}", + "Reply-To: $opt{from}", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: $opt{subject}", + "Content-Type: $opt{mimetype}", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ map "$_\n", split("\n", $opt{body}) ], + ); + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or die "can't send email to $opt{to} via $smtpmachine with SMTP: $!"; +} + +=item check_and_rebuild_fuzzyfiles + +=cut + +sub check_and_rebuild_fuzzyfiles { + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + -e "$dir/svc_acct.username" + or &rebuild_fuzzyfiles; +} + +=item rebuild_fuzzyfiles + +=cut + +sub rebuild_fuzzyfiles { + + use Fcntl qw(:flock); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + + #username + + open(USERNAMELOCK,">>$dir/svc_acct.username") + or die "can't open $dir/svc_acct.username: $!"; + flock(USERNAMELOCK,LOCK_EX) + or die "can't lock $dir/svc_acct.username: $!"; + + my @all_username = map $_->getfield('username'), qsearch('svc_acct', {}); + + open (USERNAMECACHE,">$dir/svc_acct.username.tmp") + or die "can't open $dir/svc_acct.username.tmp: $!"; + print USERNAMECACHE join("\n", @all_username), "\n"; + close USERNAMECACHE or die "can't close $dir/svc_acct.username.tmp: $!"; + + rename "$dir/svc_acct.username.tmp", "$dir/svc_acct.username"; + close USERNAMELOCK; + +} + +=item all_username + +=cut + +sub all_username { + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + open(USERNAMECACHE,"<$dir/svc_acct.username") + or die "can't open $dir/svc_acct.username: $!"; + my @array = map { chomp; $_; } ; + close USERNAMECACHE; + \@array; +} + +=item append_fuzzyfiles USERNAME + +=cut + +sub append_fuzzyfiles { + my $username = shift; + + &check_and_rebuild_fuzzyfiles; + + use Fcntl qw(:flock); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + + open(USERNAME,">>$dir/svc_acct.username") + or die "can't open $dir/svc_acct.username: $!"; + flock(USERNAME,LOCK_EX) + or die "can't lock $dir/svc_acct.username: $!"; + + print USERNAME "$username\n"; + + flock(USERNAME,LOCK_UN) + or die "can't unlock $dir/svc_acct.username: $!"; + close USERNAME; + + 1; +} + + + =item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ] =cut @@ -902,6 +1111,8 @@ END $html; } +=back + =head1 BUGS The $recref stuff in sub check should be cleaned up.