Diff for /loncom/interface/loncreateuser.pm between versions 1.27 and 1.29

version 1.27, 2002/02/12 21:42:18 version 1.29, 2002/04/04 21:46:44
Line 260  ENDDOCHEAD Line 260  ENDDOCHEAD
 <input type="hidden" name="pres_value"  value="" >  <input type="hidden" name="pres_value"  value="" >
 <input type="hidden" name="pres_type"   value="" >  <input type="hidden" name="pres_type"   value="" >
 <input type="hidden" name="pres_marker" value="" >  <input type="hidden" name="pres_marker" value="" >
 <input type="hidden" name="cuname"      value="$ccuname">  
 <input type="hidden" name="cdomain"     value="$ccdomain">  
 ENDFORMINFO  ENDFORMINFO
     my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);      my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
     my %incdomains;       my %incdomains; 
     my %inccourses;      my %inccourses;
       my %home_servers = &get_home_servers($ccdomain);  
     foreach (%Apache::lonnet::hostdom) {      foreach (%Apache::lonnet::hostdom) {
        $incdomains{$_}=1;         $incdomains{$_}=1;
     }      }
Line 275  ENDFORMINFO Line 274  ENDFORMINFO
         }          }
     }      }
     if ($uhome eq 'no_host') {      if ($uhome eq 'no_host') {
           my $home_server_list=
               '<option value="default" selected>default</option>'."\n";
           foreach (sort keys(%home_servers)) {
               $home_server_list.=
                   '<option value="'.$_.'">'.$_.' '.
                       $home_servers{$_}."</option>\n";
           }
  $r->print(<<ENDNEWUSER);   $r->print(<<ENDNEWUSER);
 $dochead  $dochead
 <h1>Create New User</h1>  <h1>Create New User</h1>
Line 295  $loginscript Line 301  $loginscript
     <td><input type='text' name='cgen'    size='5'  /></td></tr>      <td><input type='text' name='cgen'    size='5'  /></td></tr>
 </table>  </table>
 ID/Student Number <input type='text' name='cstid'   size='15' /></p>  ID/Student Number <input type='text' name='cstid'   size='15' /></p>
   Home Server: <select name="hserver" size="1"> $home_server_list </select>
 <hr />  <hr />
   
 <h3>Login Data</h3>  <h3>Login Data</h3>
 $generalrule  $generalrule
 $authformkrb  $authformkrb
Line 312  $dochead Line 317  $dochead
 $forminfo  $forminfo
 <h2>User "$ccuname" in domain $ccdomain </h2>  <h2>User "$ccuname" in domain $ccdomain </h2>
 ENDCHANGEUSER  ENDCHANGEUSER
         my $rolesdump=&Apache::lonnet::reply(          # Get the users information
                                   "dump:$ccdomain:$ccuname:roles",$uhome);          my %userenv = &Apache::lonnet::get('environment',
                             ['firstname','middlename','lastname','generation'],
                             $ccdomain,$ccuname);
           my %rolesdump=&Apache::lonnet::dump('roles',$ccdomain,$ccuname);
           $r->print(<<END);
   <hr />
   <table border="2">
   <tr>
   <th>first name</th><th>middle name</th><th>last name</th><th>generation</th>
   </tr>
   <tr>
   END
           foreach ('firstname','middlename','lastname','generation') {
              if (&Apache::lonnet::allowed('mau',$ccdomain)) {
                 $r->print(<<"END");            
   <td><input type="text" name="c$_" value="$userenv{$_}" size="15"/></td>
   END
              } else {
                  $r->print('<td>'.$userenv{$_}.'</td>');
              }
           }
           $r->print(<<END);
   </tr>
   </table>
   END
         # Build up table of user roles to allow revocation of a role.          # Build up table of user roles to allow revocation of a role.
         unless ($rolesdump eq 'con_lost' || $rolesdump =~ m/^error/i) {           my ($tmp) = keys(%rolesdump);
           unless ($tmp =~ /^(con_lost|error)/i) {
            my $now=time;             my $now=time;
            $r->print('<hr /><h3>Revoke Existing Roles</h3>'.             $r->print('<hr /><h3>Revoke Existing Roles</h3>'.
              '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.               '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.
      '<th>Start</th><th>End</th>');       '<th>Start</th><th>End</th>');
    foreach (split(/&/,$rolesdump)) {     foreach my $area (keys(%rolesdump)) {
              if ($_!~/^rolesdef\&/) {                if ($area!~/^rolesdef/) {
               my ($area,$role)=split(/=/,$_);                   my $role = $rolesdump{$area};
               my $thisrole=$area;                   my $thisrole=$area;
               $area=~s/\_\w\w$//;                   $area=~s/\_\w\w$//;
               my ($role_code,$role_end_time,$role_start_time)=split(/_/,$role);                   my ($role_code,$role_end_time,$role_start_time) =
               my $bgcol='ffffff';                       split(/_/,$role);
               my $allows=0;                   my $bgcol='ffffff';
               if ($area=~/^\/(\w+)\/(\d\w+)/) {                   my $allows=0;
                  my %coursedata=&Apache::lonnet::coursedescription($1.'_'.$2);                   if ($area=~/^\/(\w+)\/(\d\w+)/) {
                  my $carea='Course: '.$coursedata{'description'};                      my %coursedata=
                  $inccourses{$1.'_'.$2}=1;                          &Apache::lonnet::coursedescription($1.'_'.$2);
                  if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) {                      my $carea='Course: '.$coursedata{'description'};
      $allows=1;                      $inccourses{$1.'_'.$2}=1;
                  }                      if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) {
  # Compute the background color based on $area                          $allows=1;
                  $bgcol=$1.'_'.$2;                      }
                  $bgcol=~s/[^8-9b-e]//g;                      # Compute the background color based on $area
                  $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);                      $bgcol=$1.'_'.$2;
                  if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {                      $bgcol=~s/[^8-9b-e]//g;
                      $carea.='<br>Section/Group: '.$3;                      $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
  }                      if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
                  $area=$carea;                         $carea.='<br>Section/Group: '.$3;
       } else {                      }
  # Determine if current user is able to revoke privileges                      $area=$carea;
                  if ($area=~/^\/(\w+)\//) {  
                      if (&Apache::lonnet::allowed('c'.$role_code,$1)) {  
  $allows=1;  
                      }  
                  } else {                   } else {
                      if (&Apache::lonnet::allowed('c'.$role_code,'/')) {                       # Determine if current user is able to revoke privileges
  $allows=1;                       if ($area=~/^\/(\w+)\//) {
                           if (&Apache::lonnet::allowed('c'.$role_code,$1)) {
                              $allows=1;
                           }
                        } else {
                           if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
                              $allows=1;
                           }
                      }                       }
                  }                   }
       }                   $r->print('<tr bgcolor=#"'.$bgcol.'"><td>');
                    my $active=1;
               $r->print('<tr bgcolor=#"'.$bgcol.'"><td>');                   $active=0 if (($role_end_time) && ($now>$role_end_time));
               my $active=1;                   if (($active) && ($allows)) {
               if (($role_end_time) && ($now>$role_end_time)) { $active=0; }                      $r->print('<input type="checkbox" name="rev:'
               if (($active) && ($allows)) {                                .$thisrole.'">');
   $r->print('<input type="checkbox" name="rev:'                   } else {
     .$thisrole.'">');                      $r->print('&nbsp;');
               } else {                   }
                   $r->print('&nbsp;');                   $r->print('</td><td>'.
                              &Apache::lonnet::plaintext($role_code).
                              '</td><td>'.$area.'</td><td>'.
                              ($role_start_time ? localtime($role_start_time)
                                                : '&nbsp;' )
                              .'</td><td>'.
                              ($role_end_time   ? localtime($role_end_time)
                                                : '&nbsp;' )
                              ."</td></tr>\n");
               }                }
               $r->print('</td><td>'.&Apache::lonnet::plaintext($role_code).             } # end of foreach        (table building loop)
                         '</td><td>'.$area.'</td><td>'.  
                         ($role_start_time ? localtime($role_start_time)  
                                           : '&nbsp;' )  
  .'</td><td>'.  
                         ($role_end_time   ? localtime($role_end_time)  
                                           : '&nbsp;' )  
  ."</td></tr>\n");  
      }  
    }   
    $r->print('</table>');     $r->print('</table>');
          }             }  # End of unless
  my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);   my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
  if ($currentauth=~/^krb4:/) {   if ($currentauth=~/^krb4:/) {
     $currentauth=~/^krb4:(.*)/;      $currentauth=~/^krb4:(.*)/;
Line 545  ENDDROW Line 577  ENDDROW
 # ================================================================= Phase Three  # ================================================================= Phase Three
 sub phase_three {  sub phase_three {
     my $r=shift;      my $r=shift;
       my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'},
                                             $ENV{'form.ccdomain'});
     # Error messages      # Error messages
     my $error     = '<font color="#ff0000">Error:</font>';      my $error     = '<font color="#ff0000">Error:</font>';
     my $end       = '</body></html>';      my $end       = '</body></html>';
Line 558  sub phase_three { Line 592  sub phase_three {
 <img align="right" src="/adm/lonIcons/lonlogos.gif">  <img align="right" src="/adm/lonIcons/lonlogos.gif">
 ENDTHREEHEAD  ENDTHREEHEAD
     # Check Inputs      # Check Inputs
     if (! $ENV{'form.cuname'} ) {      if (! $ENV{'form.ccuname'} ) {
  $r->print($error.'No login name specified.'.$end);   $r->print($error.'No login name specified.'.$end);
  return;   return;
     }      }
     if (  $ENV{'form.cuname'}  =~/\W/) {      if (  $ENV{'form.ccuname'}  =~/\W/) {
  $r->print($error.'Invalid login name.  '.   $r->print($error.'Invalid login name.  '.
   'Only letters, numbers, and underscores are valid.'.    'Only letters, numbers, and underscores are valid.'.
   $end);    $end);
  return;   return;
     }      }
     if (! $ENV{'form.cdomain'}       ) {      if (! $ENV{'form.ccdomain'}       ) {
  $r->print($error.'No domain specified.'.$end);   $r->print($error.'No domain specified.'.$end);
  return;   return;
     }      }
     if (  $ENV{'form.cdomain'} =~/\W/) {      if (  $ENV{'form.ccdomain'} =~/\W/) {
  $r->print($error.'Invalid domain name.  '.   $r->print($error.'Invalid domain name.  '.
   'Only letters, numbers, and underscores are valid.'.    'Only letters, numbers, and underscores are valid.'.
   $end);    $end);
  return;   return;
     }      }
       if (! exists($ENV{'form.makeuser'})) {
           # Modifying an existing user, so check the validity of the name
           if ($uhome eq 'no_host') {
               $r->print($error.'Unable to determine home server for '.
                         $ENV{'form.ccuname'}.' in domain '.
                         $ENV{'form.ccdomain'}.'.');
               return;
           }
       }
     # Determine authentication method and password for the user being modified      # Determine authentication method and password for the user being modified
     my $amode='';      my $amode='';
     my $genpwd='';      my $genpwd='';
Line 599  ENDTHREEHEAD Line 642  ENDTHREEHEAD
         # Create a new user          # Create a new user
  $r->print(<<ENDNEWUSERHEAD);   $r->print(<<ENDNEWUSERHEAD);
 <h1>Create User</h1>  <h1>Create User</h1>
 <h3>Creating user "$ENV{'form.cuname'}" in domain "$ENV{'form.cdomain'}"</h2>  <h3>Creating user "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
 ENDNEWUSERHEAD  ENDNEWUSERHEAD
         # Check for the authentication mode and password          # Check for the authentication mode and password
         if (! $amode || ! $genpwd) {          if (! $amode || ! $genpwd) {
     $r->print($error.'Invalid login mode or password'.$end);          $r->print($error.'Invalid login mode or password'.$end);    
     return;      return;
  }   }
           # Determine desired host
           my $desiredhost = $ENV{'form.hserver'};
           if (lc($desiredhost) eq 'default') {
               $desiredhost = undef;
           } else {
               my %home_servers = &get_home_servers($ENV{'form.ccdomain'});  
               if (! exists($home_servers{$desiredhost})) {
                   $r->print($error.'Invalid home server specified');
                   return;
               }
           }
  # Call modifyuser   # Call modifyuser
  my $result = &Apache::lonnet::modifyuser   my $result = &Apache::lonnet::modifyuser
     ($ENV{'form.cdomain'},$ENV{'form.cuname'},      ($ENV{'form.ccdomain'},$ENV{'form.ccuname'},$ENV{'form.cstid'},
      $ENV{'form.cstid'},$amode,$genpwd,               $amode,$genpwd,$ENV{'form.cfirst'},
      $ENV{'form.cfirst'},$ENV{'form.cmiddle'},               $ENV{'form.cmiddle'},$ENV{'form.clast'},$ENV{'form.cgen'},
      $ENV{'form.clast'},$ENV{'form.cgen'}               undef,$desiredhost
      );       );
  $r->print('Generating user: '.$result);   $r->print('Generating user: '.$result);
  $r->print('<br>Home server: '.&Apache::lonnet::homeserver          my $home = &Apache::lonnet::homeserver($ENV{'form.ccuname'},
   ($ENV{'form.cuname'},$ENV{'form.cdomain'}));                                                 $ENV{'form.ccdomain'});
           $r->print('<br>Home server: '.$home.' '.
                     $Apache::lonnet::libserv{$home});
     } elsif ($ENV{'form.login'} ne '') {      } elsif ($ENV{'form.login'} ne '') {
  # Modify user privileges   # Modify user privileges
  $r->print(<<ENDMODIFYUSERHEAD);   $r->print(<<ENDMODIFYUSERHEAD);
 <h1>Change User Privileges</h1>  <h1>Change User Privileges</h1>
 <h2>User "$ENV{'form.cuname'}" in domain "$ENV{'form.cdomain'}"</h2>  <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
 ENDMODIFYUSERHEAD  ENDMODIFYUSERHEAD
         if (! $amode || ! $genpwd) {          if (! $amode || ! $genpwd) {
     $r->print($error.'Invalid login mode or password'.$end);          $r->print($error.'Invalid login mode or password'.$end);    
Line 630  ENDMODIFYUSERHEAD Line 686  ENDMODIFYUSERHEAD
  if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {   if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {
     $r->print('Modifying authentication: '.      $r->print('Modifying authentication: '.
   &Apache::lonnet::modifyuserauth(    &Apache::lonnet::modifyuserauth(
        $ENV{'form.cdomain'},$ENV{'form.cuname'},         $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
                        $amode,$genpwd));                         $amode,$genpwd));
             $r->print('<br>Home server: '.&Apache::lonnet::homeserver              $r->print('<br>Home server: '.&Apache::lonnet::homeserver
   ($ENV{'form.cuname'},$ENV{'form.cdomain'}));    ($ENV{'form.ccuname'},$ENV{'form.ccdomain'}));
  } else {   } else {
     # Okay, this is a non-fatal error.      # Okay, this is a non-fatal error.
     $r->print($error.'You do not have the authority to modify '.      $r->print($error.'You do not have the authority to modify '.
Line 641  ENDMODIFYUSERHEAD Line 697  ENDMODIFYUSERHEAD
  }   }
     }      }
     ##      ##
       if (! $ENV{'form.makeuser'} ) {
           # Check for need to change
           my %userenv = &Apache::lonnet::get
               ('environment',['firstname','middlename','lastname','generation'],
                $ENV{'form.ccdomain'},$ENV{'form.ccuname'});
           my ($tmp) = keys(%userenv);
           if ($tmp =~ /^(con_lost|error)/i) { 
               %userenv = ();
           }
           # Check to see if we need to change user information
           foreach ('firstname','middlename','lastname','generation') {
               # Strip leading and trailing whitespace
               $ENV{'form.c'.$_} =~ s/(\s+$|^\s+)//g; 
           }
           if (&Apache::lonnet::allowed('mau',$ENV{'form.ccdomain'}) && 
               ($ENV{'form.cfirstname'}  ne $userenv{'firstname'}  ||
                $ENV{'form.cmiddlename'} ne $userenv{'middlename'} ||
                $ENV{'form.clastname'}   ne $userenv{'lastname'}   ||
                $ENV{'form.cgeneration'} ne $userenv{'generation'} )) {
               # Make the change
               my %changeHash;
               $changeHash{'firstname'}  = $ENV{'form.cfirstname'};
               $changeHash{'middlename'} = $ENV{'form.cmiddlename'};
               $changeHash{'lastname'}   = $ENV{'form.clastname'};
               $changeHash{'generation'} = $ENV{'form.cgeneration'};
               my $putresult = &Apache::lonnet::put
                   ('environment',\%changeHash,
                    $ENV{'form.ccdomain'},$ENV{'form.ccuname'});
               if ($putresult eq 'ok') {
               # Tell the user we changed the name
                   $r->print(<<"END");
   <table border="2">
   <caption>User Information Changed</caption>
   <tr><th>&nbsp;</th>
       <th>first</th>
       <th>middle</th>
       <th>last</th>
       <th>generation</th></tr>
   <tr><td>Previous</td>
       <td>$userenv{'firstname'}  </td>
       <td>$userenv{'middlename'} </td>
       <td>$userenv{'lastname'}   </td>
       <td>$userenv{'generation'} </td></tr>
   <tr><td>Changed To</td>
       <td>$ENV{'form.cfirstname'}  </td>
       <td>$ENV{'form.cmiddlename'} </td>
       <td>$ENV{'form.clastname'}   </td>
       <td>$ENV{'form.cgeneration'} </td></tr>
   </table>
   END
               } else { # error occurred
                   $r->print("<h2>Unable to successfully change environment for ".
                         $ENV{'form.ccuname'}." in domain ".
                         $ENV{'form.ccdomain'}."</h2>");
               }
           }  else { # End of if ($ENV ... ) logic
               # They did not want to change the users name but we can
               # still tell them what the name is
                   $r->print(<<"END");
   <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
   <h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4>
   <h4>Generation: $userenv{'generation'}</h4>
   END
           }
       }
       ##
     my $now=time;      my $now=time;
     $r->print('<h3>Modifying Roles</h3>');      $r->print('<h3>Modifying Roles</h3>');
     foreach (keys (%ENV)) {      foreach (keys (%ENV)) {
Line 649  ENDMODIFYUSERHEAD Line 771  ENDMODIFYUSERHEAD
  if ($_=~/^form\.rev/) {   if ($_=~/^form\.rev/) {
     if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) {      if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) {
         $r->print('Revoking '.$2.' in '.$1.': '.          $r->print('Revoking '.$2.' in '.$1.': '.
                      &Apache::lonnet::assignrole($ENV{'form.cdomain'},                       &Apache::lonnet::assignrole($ENV{'form.ccdomain'},
                      $ENV{'form.cuname'},$1,$2,$now).'<br>');                       $ENV{'form.ccuname'},$1,$2,$now).'<br>');
  if ($2 eq 'st') {   if ($2 eq 'st') {
     $1=~/^\/(\w+)\/(\w+)/;      $1=~/^\/(\w+)\/(\w+)/;
     my $cid=$1.'_'.$2;      my $cid=$1.'_'.$2;
Line 658  ENDMODIFYUSERHEAD Line 780  ENDMODIFYUSERHEAD
  &Apache::lonnet::critical('put:'.   &Apache::lonnet::critical('put:'.
                              $ENV{'course.'.$cid.'.domain'}.':'.                               $ENV{'course.'.$cid.'.domain'}.':'.
                      $ENV{'course.'.$cid.'.num'}.':classlist:'.                       $ENV{'course.'.$cid.'.num'}.':classlist:'.
                          &Apache::lonnet::escape($ENV{'form.cuname'}.':'.                           &Apache::lonnet::escape($ENV{'form.ccuname'}.':'.
                              $ENV{'form.cdomain'}).'='.                               $ENV{'form.ccdomain'}).'='.
                          &Apache::lonnet::escape($now.':'),                           &Apache::lonnet::escape($now.':'),
                      $ENV{'course.'.$cid.'.home'}).'<br>');                       $ENV{'course.'.$cid.'.home'}).'<br>');
  }   }
Line 681  ENDMODIFYUSERHEAD Line 803  ENDMODIFYUSERHEAD
  # Assign the role and report it   # Assign the role and report it
  $r->print('Assigning: '.$3.' in '.$url.': '.   $r->print('Assigning: '.$3.' in '.$url.': '.
                           &Apache::lonnet::assignrole(                            &Apache::lonnet::assignrole(
                               $ENV{'form.cdomain'},$ENV{'form.cuname'},                                $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
                               $url,$3,$end,$start).                                $url,$3,$end,$start).
   '<br>');    '<br>');
  # Handle students differently   # Handle students differently
Line 693  ENDMODIFYUSERHEAD Line 815  ENDMODIFYUSERHEAD
   'put:'.$ENV{'course.'.$cid.'.domain'}.':'.    'put:'.$ENV{'course.'.$cid.'.domain'}.':'.
                            $ENV{'course.'.$cid.'.num'}.':classlist:'.                             $ENV{'course.'.$cid.'.num'}.':classlist:'.
                                    &Apache::lonnet::escape(                                     &Apache::lonnet::escape(
                                        $ENV{'form.cuname'}.':'.                                         $ENV{'form.ccuname'}.':'.
                                        $ENV{'form.cdomain'} ).'='.                                         $ENV{'form.ccdomain'} ).'='.
                                    &Apache::lonnet::escape($end.':'.$start),                                     &Apache::lonnet::escape($end.':'.$start),
        $ENV{'course.'.$cid.'.home'})         $ENV{'course.'.$cid.'.home'})
       .'<br>');        .'<br>');
Line 712  ENDMODIFYUSERHEAD Line 834  ENDMODIFYUSERHEAD
  # Assign the role and report it.   # Assign the role and report it.
  $r->print('Assigning: '.$2.' in '.$url.': '.   $r->print('Assigning: '.$2.' in '.$url.': '.
                           &Apache::lonnet::assignrole(                            &Apache::lonnet::assignrole(
                               $ENV{'form.cdomain'},$ENV{'form.cuname'},                                $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
                               $url,$2,$end,$start)                                $url,$2,$end,$start)
   .'<br>');    .'<br>');
     }      }
Line 811  ENDTABLE Line 933  ENDTABLE
 }  }
 #---------------------------------------------- end functions for &phase_two  #---------------------------------------------- end functions for &phase_two
   
   #--------------------------------- functions for &phase_two and &phase_three
   sub get_home_servers {
       my $domain = shift;
       my %home_servers;
       foreach (keys(%Apache::lonnet::libserv)) {
           if ($Apache::lonnet::hostdom{$_} eq $domain) {
               $home_servers{$_} = $Apache::lonnet::hostname{$_};
           }
       }
       return %home_servers;
   }
   
   #--------------------------end of functions for &phase_two and &phase_three
   
 1;  1;
 __END__  __END__
   

Removed from v.1.27  
changed lines
  Added in v.1.29


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