Diff for /loncom/interface/loncreateuser.pm between versions 1.137 and 1.142

version 1.137, 2006/11/23 00:04:09 version 1.142, 2006/12/21 21:40:28
Line 66  use Apache::loncommon; Line 66  use Apache::loncommon;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::longroup;  use Apache::longroup;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA;  use LONCAPA qw(:DEFAULT :match);
   
 my $loginscript; # piece of javascript used in two separate instances  my $loginscript; # piece of javascript used in two separate instances
 my $generalrule;  my $generalrule;
Line 216  END Line 216  END
 # =================================================================== Phase two  # =================================================================== Phase two
 sub print_user_modification_page {  sub print_user_modification_page {
     my $r=shift;      my $r=shift;
     my $ccuname=$env{'form.ccuname'};      my $ccuname =&LONCAPA::clean_username($env{'form.ccuname'});
     my $ccdomain=$env{'form.ccdomain'};      my $ccdomain=&LONCAPA::clean_domain($env{'form.ccdomain'});
   
     $ccuname=~s/\W//g;  
     $ccdomain=~s/\W//g;  
   
     unless (($ccuname) && ($ccdomain)) {      unless (($ccuname) && ($ccdomain)) {
  &print_username_entry_form($r);   &print_username_entry_form($r);
Line 238  sub print_user_modification_page { Line 235  sub print_user_modification_page {
                   );                    );
     $loginscript  = &Apache::loncommon::authform_header(%param);      $loginscript  = &Apache::loncommon::authform_header(%param);
     $authformkrb  = &Apache::loncommon::authform_kerberos(%param);      $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
     
     $ccuname=~s/\W//g;      $ccuname =&LONCAPA::clean_username($ccuname);
     $ccdomain=~s/\W//g;      $ccdomain=&LONCAPA::clean_domain($ccdomain);
     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();      my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
     my $dc_setcourse_code = '';      my $dc_setcourse_code = '';
     my $nondc_setsection_code = '';                                              my $nondc_setsection_code = '';                                        
Line 254  sub print_user_modification_page { Line 251  sub print_user_modification_page {
         $groupslist = '"'.$groupslist.'"';             $groupslist = '"'.$groupslist.'"';   
     }      }
   
     if ($env{'request.role'} =~ m-^dc\./(\w+)/$-) {      if ($env{'request.role'} =~ m-^dc\./($match_domain)/$-) {
         my $dcdom = $1;          my $dcdom = $1;
         $loaditem{'onload'} = "document.cu.coursedesc.value='';";          $loaditem{'onload'} = "document.cu.coursedesc.value='';";
         my @rolevals = ('st','ta','ep','in','cc');          my @rolevals = ('st','ta','ep','in','cc');
Line 493  ENDFORMINFO Line 490  ENDFORMINFO
        $incdomains{$item}=1;         $incdomains{$item}=1;
     }      }
     foreach my $key (keys(%env)) {      foreach my $key (keys(%env)) {
  if ($key=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {   if ($key=~/^user\.priv\.cm\.\/($match_domain)\/($match_username)/) {
     $inccourses{$1.'_'.$2}=1;      $inccourses{$1.'_'.$2}=1;
         }          }
     }      }
Line 622  END Line 619  END
                    split(/_/,$role);                     split(/_/,$role);
 # Is this a custom role? Get role owner and title.  # Is this a custom role? Get role owner and title.
        my ($croleudom,$croleuname,$croletitle)=         my ($croleudom,$croleuname,$croletitle)=
            ($role_code=~/^cr\/(\w+)\/(\w+)\/(\w+)$/);             ($role_code=~m{^cr/($match_domain)/($match_username)/(\w+)$});
                my $allowed=0;                 my $allowed=0;
                my $delallowed=0;                 my $delallowed=0;
        my $sortkey=$role_code;         my $sortkey=$role_code;
        my $class='Unknown';         my $class='Unknown';
                if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {                 if ($area =~ m{^/($match_domain)/($match_courseid)} ) {
    $class='Course';     $class='Course';
                    my ($coursedom,$coursedir) = ($1,$2);                     my ($coursedom,$coursedir) = ($1,$2);
    $sortkey.="\0$coursedom";     $sortkey.="\0$coursedom";
Line 663  END Line 660  END
        }         }
    }     }
                    # Compute the background color based on $area                     # Compute the background color based on $area
                    if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {                     if ($area=~m{^/($match_domain)/($match_courseid)/(\w+)}) {
                        $carea.='<br />Section: '.$3;                         $carea.='<br />Section: '.$3;
        $sortkey.="\0$3";         $sortkey.="\0$3";
                    }                     }
Line 671  END Line 668  END
                } else {                 } else {
    $sortkey.="\0".$area;     $sortkey.="\0".$area;
                    # Determine if current user is able to revoke privileges                     # Determine if current user is able to revoke privileges
                    if ($area=~ /^\/(\w+)\//) {                     if ($area=~m{^/($match_domain)/}) {
                        if ((&Apache::lonnet::allowed('c'.$role_code,$1)) ||                         if ((&Apache::lonnet::allowed('c'.$role_code,$1)) ||
                        (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {                         (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
                            $allowed=1;                             $allowed=1;
Line 695  END Line 692  END
    }     }
                }                 }
                if (($role_code eq 'ca') || ($role_code eq 'aa')) {                 if (($role_code eq 'ca') || ($role_code eq 'aa')) {
                    $area=~/\/(\w+)\/(\w+)/;                     $area=~m{/($match_domain)/($match_username)};
    if (&authorpriv($2,$1)) {     if (&authorpriv($2,$1)) {
        $allowed=1;         $allowed=1;
                    } else {                     } else {
Line 997  ENDNOPRIV Line 994  ENDNOPRIV
 # Course and group levels  # Course and group levels
 #  #
   
     if ($env{'request.role'} =~ m-^dc\./(\w+)/$-) {      if ($env{'request.role'} =~ m{^dc\./($match_domain)/$}) {
         $r->print(&course_level_dc($1,'Course'));          $r->print(&course_level_dc($1,'Course'));
         $r->print('<hr /><input type="button" value="'.&mt('Modify User').'" onClick="setCourse()">'."\n");          $r->print('<hr /><input type="button" value="'.&mt('Modify User').'" onClick="setCourse()">'."\n");
     } else {      } else {
Line 1029  sub update_user_data { Line 1026  sub update_user_data {
  $r->print($error.&mt('No login name specified').'.'.$end);   $r->print($error.&mt('No login name specified').'.'.$end);
  return;   return;
     }      }
     if (  $env{'form.ccuname'}  =~/\W/) {      if (  $env{'form.ccuname'} ne 
     &LONCAPA::clean_username($env{'form.ccuname'}) ) {
  $r->print($error.&mt('Invalid login name').'.  '.   $r->print($error.&mt('Invalid login name').'.  '.
   &mt('Only letters, numbers, and underscores are valid').'.'.    &mt('Only letters, numbers, and underscores are valid').'.'.
   $end);    $end);
Line 1039  sub update_user_data { Line 1037  sub update_user_data {
  $r->print($error.&mt('No domain specified').'.'.$end);   $r->print($error.&mt('No domain specified').'.'.$end);
  return;   return;
     }      }
     if (  $env{'form.ccdomain'} =~/\W/) {      if (  $env{'form.ccdomain'} ne
     &LONCAPA::clean_domain($env{'form.ccdomain'}) ) {
  $r->print($error.&mt ('Invalid domain name').'.  '.   $r->print($error.&mt ('Invalid domain name').'.  '.
   &mt('Only letters, numbers, and underscores are valid').'.'.    &mt('Only letters, numbers, periods, dashes, and underscores are valid').'.'.
   $end);    $end);
  return;   return;
     }      }
Line 1175  ENDMODIFYUSERHEAD Line 1174  ENDMODIFYUSERHEAD
                 }                  }
             }              }
         } else {          } else {
             $oldportfolioquota = &default_quota($env{'form.ccdomain'});              $oldportfolioquota = 
                     &Apache::loncommon::default_quota($env{'form.ccdomain'});
         }          }
         if (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'}) &&           if (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'}) && 
             ($env{'form.cfirstname'}  ne $userenv{'firstname'}  ||              ($env{'form.cfirstname'}  ne $userenv{'firstname'}  ||
Line 1274  END Line 1274  END
                      &Apache::lonnet::revokerole($env{'form.ccdomain'},                       &Apache::lonnet::revokerole($env{'form.ccdomain'},
                      $env{'form.ccuname'},$1,$2).'</b><br />');                       $env{'form.ccuname'},$1,$2).'</b><br />');
  if ($2 eq 'st') {   if ($2 eq 'st') {
     $1=~/^\/(\w+)\/(\w+)/;      $1=~m{^/($match_domain)/($match_courseid)};
     my $cid=$1.'_'.$2;      my $cid=$1.'_'.$2;
     $r->print(&mt('Drop from classlist').': <b>'.      $r->print(&mt('Drop from classlist').': <b>'.
  &Apache::lonnet::critical('put:'.   &Apache::lonnet::critical('put:'.
Line 1286  END Line 1286  END
                      $env{'course.'.$cid.'.home'}).'</b><br />');                       $env{'course.'.$cid.'.home'}).'</b><br />');
  }   }
     }       } 
     if ($key=~/^form\.rev\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) {      if ($key=~m{^form\.rev\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) {
 # Revoke custom role  # Revoke custom role
  $r->print(&mt('Revoking custom role:').   $r->print(&mt('Revoking custom role:').
                       ' '.$4.' by '.$3.'@'.$2.' in '.$1.': <b>'.                        ' '.$4.' by '.$3.':'.$2.' in '.$1.': <b>'.
                       &Apache::lonnet::revokecustomrole($env{'form.ccdomain'},                        &Apache::lonnet::revokecustomrole($env{'form.ccdomain'},
   $env{'form.ccuname'},$1,$2,$3,$4).    $env{'form.ccuname'},$1,$2,$3,$4).
  '</b><br />');   '</b><br />');
Line 1301  END Line 1301  END
                      &Apache::lonnet::assignrole($env{'form.ccdomain'},                       &Apache::lonnet::assignrole($env{'form.ccdomain'},
                      $env{'form.ccuname'},$1,$2,$now,0,1).'<br />');                       $env{'form.ccuname'},$1,$2,$now,0,1).'<br />');
  if ($2 eq 'st') {   if ($2 eq 'st') {
     $1=~/^\/(\w+)\/(\w+)/;      $1=~m{^/($match_domain)/($match_courseid)};
     my $cid=$1.'_'.$2;      my $cid=$1.'_'.$2;
     $r->print(&mt('Drop from classlist').': <b>'.      $r->print(&mt('Drop from classlist').': <b>'.
  &Apache::lonnet::critical('put:'.   &Apache::lonnet::critical('put:'.
Line 1313  END Line 1313  END
                      $env{'course.'.$cid.'.home'}).'</b><br />');                       $env{'course.'.$cid.'.home'}).'</b><br />');
  }   }
             }              }
             if ($key=~/^form\.del\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) {      if ($key=~m{^form\.del\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) {
                 my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4);                  my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4);
 # Delete custom role  # Delete custom role
                 $r->print(&mt('Deleting custom role [_1] by [_2]@[_3] in [_4]',                  $r->print(&mt('Deleting custom role [_1] by [_2]@[_3] in [_4]',
Line 1332  END Line 1332  END
                 my $logmsg;                  my $logmsg;
                 my $output;                  my $output;
                 if ($role eq 'st') {                  if ($role eq 'st') {
                     if ($url =~ m-^/(\w+)/(\w+)/?(\w*)$-) {                      if ($url =~ m-^/($match_domain)/($match_courseid)/?(\w*)$-) {
                         my $result = &Apache::loncommon::commit_studentrole(\$logmsg,$udom,$uname,$url,$role,$now,0,$1,$2,$3);                          my $result = &Apache::loncommon::commit_studentrole(\$logmsg,$udom,$uname,$url,$role,$now,0,$1,$2,$3);
                         if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course')) {                          if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course')) {
                             $output = "Error: $result\n";                              $output = "Error: $result\n";
Line 1352  END Line 1352  END
                 $r->print($output);                  $r->print($output);
     }      }
 # Re-enable custom role  # Re-enable custom role
             if ($key=~/^form\.ren\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) {      if ($key=~m{^form\.ren\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}) {
                 my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4);                  my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4);
                 my $result = &Apache::lonnet::assigncustomrole(                  my $result = &Apache::lonnet::assigncustomrole(
                                $env{'form.ccdomain'}, $env{'form.ccuname'},                                 $env{'form.ccdomain'}, $env{'form.ccuname'},
Line 1363  END Line 1363  END
  } elsif ($key=~/^form\.act/) {   } elsif ($key=~/^form\.act/) {
             my $udom = $env{'form.ccdomain'};              my $udom = $env{'form.ccdomain'};
             my $uname = $env{'form.ccuname'};              my $uname = $env{'form.ccuname'};
     if ($key=~/^form\.act\_([^\_]+)\_([^\_]+)\_cr_cr_([^\_]+)_(\w+)_([^\_]+)$/) {      if ($key=~/^form\.act\_($match_domain)\_($match_courseid)\_cr_cr_($match_domain)_($match_username)_([^\_]+)$/) {
                 # Activate a custom role                  # Activate a custom role
  my ($one,$two,$three,$four,$five)=($1,$2,$3,$4,$5);   my ($one,$two,$three,$four,$five)=($1,$2,$3,$4,$5);
  my $url='/'.$one.'/'.$two;   my $url='/'.$one.'/'.$two;
Line 1394  END Line 1394  END
         $r->print(&Apache::loncommon::commit_customrole($udom,$uname,$securl,$three,$four,$five,$start,$end));          $r->print(&Apache::loncommon::commit_customrole($udom,$uname,$securl,$three,$four,$five,$start,$end));
                     }                      }
                 }                  }
     } elsif ($key=~/^form\.act\_([^\_]+)\_(\w+)\_([^\_]+)$/) {      } elsif ($key=~/^form\.act\_($match_domain)\_($match_name)\_([^\_]+)$/) {
  # Activate roles for sections with 3 id numbers   # Activate roles for sections with 3 id numbers
  # set start, end times, and the url for the class   # set start, end times, and the url for the class
  my ($one,$two,$three)=($1,$2,$3);   my ($one,$two,$three)=($1,$2,$3);

Removed from v.1.137  
changed lines
  Added in v.1.142


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>