re-write RADIUS groups, RT13274
[freeside.git] / FS / FS / svc_acct.pm
index 94a839b..e8c797a 100644 (file)
@@ -9,7 +9,7 @@ use vars qw( $DEBUG $me $conf $skip_fuzzyfiles
              $username_ampersand $username_letter $username_letterfirst
              $username_noperiod $username_nounderscore $username_nodash
              $username_uppercase $username_percent $username_colon
-             $username_slash $username_equals
+             $username_slash $username_equals $username_pound
              $password_noampersand $password_noexclamation
              $warning_template $warning_from $warning_subject $warning_mimetype
              $warning_cc
@@ -43,6 +43,7 @@ use FS::svc_pbx;
 use FS::raddb;
 use FS::queue;
 use FS::radius_usergroup;
+use FS::radius_group;
 use FS::export_svc;
 use FS::part_export;
 use FS::svc_forward;
@@ -77,6 +78,7 @@ FS::UID->install_callback( sub {
   $username_colon = $conf->exists('username-colon');
   $username_slash = $conf->exists('username-slash');
   $username_equals = $conf->exists('username-equals');
+  $username_pound = $conf->exists('username-pound');
   $password_noampersand = $conf->exists('password-noexclamation');
   $password_noexclamation = $conf->exists('password-noexclamation');
   $dirhash = $conf->config('dirhash') || 0;
@@ -334,7 +336,7 @@ sub table_info {
                        },
         'usergroup' => {
                          label => 'RADIUS groups',
-                         type  => 'radius_usergroup_selector',
+                         type  => 'select-radius_group.html',
                          disable_inventory => 1,
                          disable_select => 1,
                        },
@@ -708,10 +710,10 @@ sub insert {
   }
 
   if ( $self->usergroup ) {
-    foreach my $groupname ( @{$self->usergroup} ) {
+    foreach my $groupnum ( @{$self->usergroup} ) {
       my $radius_usergroup = new FS::radius_usergroup ( {
         svcnum    => $self->svcnum,
-        groupname => $groupname,
+        groupnum  => $groupnum,
       } );
       my $error = $radius_usergroup->insert;
       if ( $error ) {
@@ -745,88 +747,92 @@ sub insert {
     }
 
     #welcome email
-    my $error = '';
-    my $msgnum = $conf->config('welcome_msgnum', $agentnum);
-    if ( $msgnum ) {
-      my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
-      $error = $msg_template->send('cust_main' => $cust_main);
-    }
-    else { #!$msgnum
-      my ($to,$welcome_template,$welcome_from,$welcome_subject,$welcome_subject_template,$welcome_mimetype)
-        = ('','','','','','');
-
-      if ( $conf->exists('welcome_email', $agentnum) ) {
-        $welcome_template = new Text::Template (
-          TYPE   => 'ARRAY',
-          SOURCE => [ map "$_\n", $conf->config('welcome_email', $agentnum) ]
-        ) or warn "can't create welcome email template: $Text::Template::ERROR";
-        $welcome_from = $conf->config('welcome_email-from', $agentnum);
-          # || 'your-isp-is-dum'
-        $welcome_subject = $conf->config('welcome_email-subject', $agentnum)
-          || 'Welcome';
-        $welcome_subject_template = new Text::Template (
-          TYPE   => 'STRING',
-          SOURCE => $welcome_subject,
-        ) or warn "can't create welcome email subject template: $Text::Template::ERROR";
-        $welcome_mimetype = $conf->config('welcome_email-mimetype', $agentnum)
-          || 'text/plain';
-      }
-      if ( $welcome_template ) {
-        my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list );
-        if ( $to ) {
-
-          my %hash = (
-                       'custnum'  => $self->custnum,
-                       'username' => $self->username,
-                       'password' => $self->_password,
-                       'first'    => $cust_main->first,
-                       'last'     => $cust_main->getfield('last'),
-                       'pkg'      => $cust_pkg->part_pkg->pkg,
-                     );
-          my $wqueue = new FS::queue {
-            'svcnum' => $self->svcnum,
-            'job'    => 'FS::svc_acct::send_email'
-          };
-          my $error = $wqueue->insert(
-            'to'       => $to,
-            'from'     => $welcome_from,
-            'subject'  => $welcome_subject_template->fill_in( HASH => \%hash, ),
-            'mimetype' => $welcome_mimetype,
-            'body'     => $welcome_template->fill_in( HASH => \%hash, ),
-          );
-          if ( $error ) {
-            $dbh->rollback if $oldAutoCommit;
-            return "error queuing welcome email: $error";
-          }
-
-          if ( $options{'depend_jobnum'} ) {
-            warn "$me depend_jobnum found; adding to welcome email dependancies"
-              if $DEBUG;
-            if ( ref($options{'depend_jobnum'}) ) {
-              warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ).
-                   "to welcome email dependancies"
-                if $DEBUG;
-              push @jobnums, @{ $options{'depend_jobnum'} };
-            } else {
-              warn "$me adding job $options{'depend_jobnum'} ".
-                   "to welcome email dependancies"
-                if $DEBUG;
-              push @jobnums, $options{'depend_jobnum'};
-            }
+    my @welcome_exclude_svcparts = $conf->config('svc_acct_welcome_exclude');
+    unless ( grep { $_ eq $self->svcpart } @welcome_exclude_svcparts ) {
+        my $error = '';
+        my $msgnum = $conf->config('welcome_msgnum', $agentnum);
+        if ( $msgnum ) {
+          my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
+          $error = $msg_template->send('cust_main' => $cust_main,
+                                       'object'    => $self);
+        }
+        else { #!$msgnum
+          my ($to,$welcome_template,$welcome_from,$welcome_subject,$welcome_subject_template,$welcome_mimetype)
+            = ('','','','','','');
+
+          if ( $conf->exists('welcome_email', $agentnum) ) {
+            $welcome_template = new Text::Template (
+              TYPE   => 'ARRAY',
+              SOURCE => [ map "$_\n", $conf->config('welcome_email', $agentnum) ]
+            ) or warn "can't create welcome email template: $Text::Template::ERROR";
+            $welcome_from = $conf->config('welcome_email-from', $agentnum);
+              # || 'your-isp-is-dum'
+            $welcome_subject = $conf->config('welcome_email-subject', $agentnum)
+              || 'Welcome';
+            $welcome_subject_template = new Text::Template (
+              TYPE   => 'STRING',
+              SOURCE => $welcome_subject,
+            ) or warn "can't create welcome email subject template: $Text::Template::ERROR";
+            $welcome_mimetype = $conf->config('welcome_email-mimetype', $agentnum)
+              || 'text/plain';
           }
+          if ( $welcome_template ) {
+            my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list );
+            if ( $to ) {
+
+              my %hash = (
+                           'custnum'  => $self->custnum,
+                           'username' => $self->username,
+                           'password' => $self->_password,
+                           'first'    => $cust_main->first,
+                           'last'     => $cust_main->getfield('last'),
+                           'pkg'      => $cust_pkg->part_pkg->pkg,
+                         );
+              my $wqueue = new FS::queue {
+                'svcnum' => $self->svcnum,
+                'job'    => 'FS::svc_acct::send_email'
+              };
+              my $error = $wqueue->insert(
+                'to'       => $to,
+                'from'     => $welcome_from,
+                'subject'  => $welcome_subject_template->fill_in( HASH => \%hash, ),
+                'mimetype' => $welcome_mimetype,
+                'body'     => $welcome_template->fill_in( HASH => \%hash, ),
+              );
+              if ( $error ) {
+                $dbh->rollback if $oldAutoCommit;
+                return "error queuing welcome email: $error";
+              }
+
+              if ( $options{'depend_jobnum'} ) {
+                warn "$me depend_jobnum found; adding to welcome email dependancies"
+                  if $DEBUG;
+                if ( ref($options{'depend_jobnum'}) ) {
+                  warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ).
+                       "to welcome email dependancies"
+                    if $DEBUG;
+                  push @jobnums, @{ $options{'depend_jobnum'} };
+                } else {
+                  warn "$me adding job $options{'depend_jobnum'} ".
+                       "to welcome email dependancies"
+                    if $DEBUG;
+                  push @jobnums, $options{'depend_jobnum'};
+                }
+              }
+
+              foreach my $jobnum ( @jobnums ) {
+                my $error = $wqueue->depend_insert($jobnum);
+                if ( $error ) {
+                  $dbh->rollback if $oldAutoCommit;
+                  return "error queuing welcome email job dependancy: $error";
+                }
+              }
 
-          foreach my $jobnum ( @jobnums ) {
-            my $error = $wqueue->depend_insert($jobnum);
-            if ( $error ) {
-              $dbh->rollback if $oldAutoCommit;
-              return "error queuing welcome email job dependancy: $error";
             }
-          }
 
-        }
-
-      } # if $welcome_template
-    } # if !$msgnum
+          } # if $welcome_template
+        } # if !$msgnum
+    }
   } # if $cust_pkg
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -987,6 +993,10 @@ sub replace {
 
   }
 
+  return "can't change username"
+    if $old->username ne $new->username
+    && $conf->exists('svc_acct-no_edit_username');
+
   #change homdir when we change username
   $new->setfield('dir', '') if $old->username ne $new->username;
 
@@ -1005,10 +1015,10 @@ sub replace {
   $error = $new->check;
   return $error if $error;
 
-  $old->usergroup( [ $old->radius_groups ] );
+  $old->usergroup( [ $old->radius_groups('NUMBERS') ] );
   if ( $DEBUG ) {
     warn $old->email. " old groups: ". join(' ',@{$old->usergroup}). "\n";
-    warn $new->email. "new groups: ". join(' ',@{$new->usergroup}). "\n";
+    warn $new->email. " new groups: ". join(' ',@{$new->usergroup}). "\n";
   }
   if ( $new->usergroup ) {
     #(sorta) false laziness with FS::part_export::sqlradius::_export_replace
@@ -1020,7 +1030,7 @@ sub replace {
       }
       my $radius_usergroup = qsearchs('radius_usergroup', {
         svcnum    => $old->svcnum,
-        groupname => $oldgroup,
+        groupnum  => $oldgroup,
       } );
       my $error = $radius_usergroup->delete;
       if ( $error ) {
@@ -1032,7 +1042,7 @@ sub replace {
     foreach my $newgroup ( @newgroups ) {
       my $radius_usergroup = new FS::radius_usergroup ( {
         svcnum    => $new->svcnum,
-        groupname => $newgroup,
+        groupnum => $newgroup,
       } );
       my $error = $radius_usergroup->insert;
       if ( $error ) {
@@ -1206,16 +1216,19 @@ sub check {
               || $self->ut_enum('_password_encoding', ['',qw(plain crypt ldap)])
               || $self->ut_enum('password_selfchange', [ '', 'Y' ])
               || $self->ut_enum('password_recover',    [ '', 'Y' ])
+              #cardfortress
+              || $self->ut_anything('cf_privatekey')
+              #communigate
               || $self->ut_textn('cgp_accessmodes')
               || $self->ut_alphan('cgp_type')
               || $self->ut_textn('cgp_aliases' ) #well
-              #settings
+              # settings
               || $self->ut_alphasn('cgp_rulesallowed')
               || $self->ut_enum('cgp_rpopallowed', [ '', 'Y' ])
               || $self->ut_enum('cgp_mailtoall', [ '', 'Y' ])
               || $self->ut_enum('cgp_addmailtrailer', [ '', 'Y' ])
               || $self->ut_snumbern('cgp_archiveafter')
-              #preferences
+              # preferences
               || $self->ut_alphasn('cgp_deletemode')
               || $self->ut_enum('cgp_emptytrash', $self->cgp_emptytrash_values)
               || $self->ut_alphan('cgp_language')
@@ -1223,7 +1236,6 @@ sub check {
               || $self->ut_textn('cgp_skinname')
               || $self->ut_textn('cgp_prontoskinname')
               || $self->ut_alphan('cgp_sendmdnmode')
-              #XXX RPOP settings
   ;
   return $error if $error;
 
@@ -1244,7 +1256,7 @@ sub check {
 
   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
 
-  $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:\/\=]{$usernamemin,$ulen})$/i
+  $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:\/\=\#]{$usernamemin,$ulen})$/i
     or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
   $recref->{username} = $1;
 
@@ -1280,6 +1292,10 @@ sub check {
   unless ( $username_equals ) {
     $recref->{username} =~ /\=/ and return gettext('illegal_username');
   }
+  unless ( $username_pound ) {
+    $recref->{username} =~ /\#/ and return gettext('illegal_username');
+  }
+
 
   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
   $recref->{popnum} = $1;
@@ -1323,7 +1339,7 @@ sub check {
 
   unless ( $part_svc->part_svc_column('dir')->columnflag eq 'F' ) {
 
-    $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
+    $recref->{dir} =~ /^([\/\w\-\.\&\:\#]*)$/
       or return "Illegal directory: ". $recref->{dir};
     $recref->{dir} = $1;
     return "Illegal directory"
@@ -1358,8 +1374,7 @@ sub check {
       $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') );
     }
   }
-  $self->getfield('finger') =~
-    /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/
+  $self->getfield('finger') =~ /^([\w \,\.\-\'\&\t\!\@\#\$\%\(\)\+\;\"\?\/\*\<\>]+)$/
       or return "Illegal finger: ". $self->getfield('finger');
   $self->setfield('finger', $1);
 
@@ -1579,6 +1594,8 @@ sub set_password {
       $pass = crypt($pass, $saltset[int(rand(64))].$saltset[int(rand(64))]);
     }
     # else $encryption eq 'plain', do nothing
+    $pass .= '=' x (4 - length($pass) % 4) #properly padded base64
+      if $encryption eq 'md5' || $encryption eq 'sha1';
     $pass = '{'.uc($encryption).'}'.$pass;
   }
   # else encoding eq 'plain'
@@ -2546,10 +2563,26 @@ sub radius_groups {
       unless ref($self->usergroup) eq 'ARRAY';
     #when provisioning records, export callback runs in svc_Common.pm before
     #radius_usergroup records can be inserted...
-    @{$self->usergroup};
+    my $groups = join(',',@{$self->usergroup});
+    my @groups;
+    return @groups unless length($groups);
+    @groups = qsearch({ 'table'         => 'radius_group',
+                           'extra_sql'     => "where groupnum in ($groups)",
+                        });
+    map { $_->groupname } @groups;
   } else {
-    map { $_->groupname }
-      qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
+     my $format = shift || '';
+     my @groups = qsearch({ 'table'         => 'radius_usergroup',
+                            'addl_from'     => 'left join radius_group using (groupnum)',
+                            'select'        => 'radius_group.*',
+                            'hashref'       => { 'svcnum' => $self->svcnum },
+                        });
+
+     # this is to preserve various legacy behaviour / avoid re-writing other code
+     return map { $_->groupnum } @groups if $format eq 'NUMBERS';
+     return map { $_->description . " (" . $_->groupname . ")" } @groups
+        if $format eq 'COMBINED';
+     map { $_->groupname } @groups;
   }
 }
 
@@ -2663,12 +2696,12 @@ sub crypt_password {
 
       my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
       if ( $encryption eq 'crypt' ) {
-        crypt(
+        return crypt(
           $self->_password,
           $saltset[int(rand(64))].$saltset[int(rand(64))]
         );
       } elsif ( $encryption eq 'md5' ) {
-        unix_md5_crypt( $self->_password );
+        return unix_md5_crypt( $self->_password );
       } elsif ( $encryption eq 'blowfish' ) {
         croak "unknown encryption method $encryption";
       } else {
@@ -2676,7 +2709,7 @@ sub crypt_password {
       }
 
     } elsif ( $self->_password =~ /^\{CRYPT\}(.+)$/ ) {
-      $1;
+      return $1;
     }
 
   } elsif ( $self->_password_encoding eq 'crypt' ) {
@@ -2689,12 +2722,16 @@ sub crypt_password {
 
     my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
     if ( $encryption eq 'crypt' ) {
-      crypt(
+      return crypt(
         $self->_password,
         $saltset[int(rand(64))].$saltset[int(rand(64))]
       );
     } elsif ( $encryption eq 'md5' ) {
-      unix_md5_crypt( $self->_password );
+      return unix_md5_crypt( $self->_password );
+    } elsif ( $encryption eq 'sha1_base64' ) { #for acct_sql
+      my $pass = sha1_base64( $self->_password );
+      $pass .= '=' x (4 - length($pass) % 4); #properly padded base64
+      return $pass;
     } elsif ( $encryption eq 'blowfish' ) {
       croak "unknown encryption method $encryption";
     } else {
@@ -2715,12 +2752,12 @@ sub crypt_password {
 
       my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
       if ( $encryption eq 'crypt' ) {
-        crypt(
+        return crypt(
           $self->_password,
           $saltset[int(rand(64))].$saltset[int(rand(64))]
         );
       } elsif ( $encryption eq 'md5' ) {
-        unix_md5_crypt( $self->_password );
+        return unix_md5_crypt( $self->_password );
       } elsif ( $encryption eq 'blowfish' ) {
         croak "unknown encryption method $encryption";
       } else {
@@ -3086,56 +3123,6 @@ sub append_fuzzyfiles {
 }
 
 
-
-=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 .= qq(<OPTION VALUE="$group");
-    if ( $sel_groups{$group} ) {
-      $html .= ' SELECTED';
-      $sel_groups{$group} = 0;
-    }
-    $html .= ">$group</OPTION>\n";
-  }
-  foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
-    $html .= qq(<OPTION VALUE="$group" 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;
-}
-
 =item reached_threshold
 
 Performs some activities when svc_acct thresholds (such as number of seconds
@@ -3225,9 +3212,6 @@ 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...
-
 insertion of RADIUS group stuff in insert could be done with child_objects now
 (would probably clean up export of them too)