[BACK]Return to loncreateuser.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncreateuser.pm between versions 1.26 and 1.60

version 1.26, 2002/02/11 21:25:07 version 1.60, 2003/07/18 13:45:14
Line 44 Line 44
 # 2/14,2/17,2/19,2/20,2/21,2/22,2/23,3/2,3/17,3/24,04/12 Gerd Kortemeyer  # 2/14,2/17,2/19,2/20,2/21,2/22,2/23,3/2,3/17,3/24,04/12 Gerd Kortemeyer
 # April Guy Albertelli  # April Guy Albertelli
 # 05/10,10/16 Gerd Kortemeyer   # 05/10,10/16 Gerd Kortemeyer 
 # 11/12,11/13,11/15 Scott Harrison  
 # 02/11/02 Matthew Hall  # 02/11/02 Matthew Hall
 #  #
 # $Id$  # $Id$
Line 55  package Apache::loncreateuser; Line 54  package Apache::loncreateuser;
 use strict;  use strict;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::loncommon;
   
 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 68  BEGIN { Line 68  BEGIN {
     $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;      $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
     my $krbdefdom=$1;      my $krbdefdom=$1;
     $krbdefdom=~tr/a-z/A-Z/;      $krbdefdom=~tr/a-z/A-Z/;
     $authformnop=(<<END);      my %param = ( formname => 'document.cu',
 <p>                    kerb_def_dom => $krbdefdom 
 <input type=radio name=login value=nop checked='checked'                    );
 onClick="clicknop(this.form);">  # no longer static due to configurable kerberos defaults
 Do not change login data  #    $loginscript  = &Apache::loncommon::authform_header(%param);
 </p>      $generalrule  = &Apache::loncommon::authform_authorwarning(%param);
 END      $authformnop  = &Apache::loncommon::authform_nochange(%param);
     $authformkrb=(<<END);  # no longer static due to configurable kerberos defaults
 <p>  #    $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
 <input type=radio name=login value=krb onClick="clickkrb(this.form);">      $authformint  = &Apache::loncommon::authform_internal(%param);
 Kerberos authenticated with domain      $authformfsys = &Apache::loncommon::authform_filesystem(%param);
 <input type=text size=10 name=krbdom onChange="setkrb(this.form);">      $authformloc  = &Apache::loncommon::authform_local(%param);
 </p>  
 END  
     $authformint=(<<END);  
 <p>  
 <input type=radio name=login value=int onClick="clickint(this.form);">   
 Internally authenticated (with initial password   
 <input type=text size=10 name=intpwd onChange="setint(this.form);">)  
 </p>  
 END  
     $authformfsys=(<<END);  
 <p>  
 <input type=radio name=login value=fsys onClick="clickfsys(this.form);">   
 Filesystem authenticated (with initial password   
 <input type=text size=10 name=fsyspwd onChange="setfsys(this.form);">)  
 </p>  
 END  
     $authformloc=(<<END);  
 <p>  
 <input type=radio name=login value=loc onClick="clickloc(this.form);" />  
 Local Authentication with argument  
 <input type=text size=10 name=locarg onChange="setloc(this.form);" />  
 </p>  
 END  
     $loginscript=(<<ENDLOGINSCRIPT);  
 <script>  
 function setkrb(vf) {  
     if (vf.krbdom.value!='') {  
        vf.login[0].checked=true;  
        vf.krbdom.value=vf.krbdom.value.toUpperCase();  
        vf.intpwd.value='';  
        vf.fsyspwd.value='';  
        vf.locarg.value='';  
    }  
 }  }
   
 function setint(vf) {  
     if (vf.intpwd.value!='') {  
        vf.login[1].checked=true;  
        vf.krbdom.value='';  
        vf.fsyspwd.value='';  
        vf.locarg.value='';  
    }  
 }  
   
 function setfsys(vf) {  # ======================================================= Existing Custom Roles
     if (vf.fsyspwd.value!='') {  
        vf.login[2].checked=true;  sub my_custom_roles {
        vf.krbdom.value='';      my %returnhash=();
        vf.intpwd.value='';      my %rolehash=&Apache::lonnet::dump('roles');
        vf.locarg.value='';      foreach (keys %rolehash) {
    }   if ($_=~/^rolesdef\_(\w+)$/) {
 }      $returnhash{$_}=$_;
    }
 function setloc(vf) {      }
     if (vf.locarg.value!='') {      return %returnhash;
        vf.login[3].checked=true;  
        vf.krbdom.value='';  
        vf.intpwd.value='';  
        vf.fsyspwd.value='';  
    }  
 }  
   
 function clicknop(vf) {  
     vf.krbdom.value='';  
     vf.intpwd.value='';  
     vf.fsyspwd.value='';  
     vf.locarg.value='';  
 }  
   
 function clickkrb(vf) {  
     vf.krbdom.value='$krbdefdom';  
     vf.intpwd.value='';  
     vf.fsyspwd.value='';  
     vf.locarg.value='';  
 }  
   
 function clickint(vf) {  
     vf.krbdom.value='';  
     vf.fsyspwd.value='';  
     vf.locarg.value='';  
 }  }
   
 function clickfsys(vf) {  # ==================================================== Figure out author access
     vf.krbdom.value='';  
     vf.intpwd.value='';  
     vf.locarg.value='';  
 }  
   
 function clickloc(vf) {  sub authorpriv {
     vf.krbdom.value='';      my ($auname,$audom)=@_;
     vf.intpwd.value='';      if (($auname ne $ENV{'user.name'}) ||
     vf.fsyspwd.value='';          (($audom ne $ENV{'user.domain'}) &&
 }           ($audom ne $ENV{'request.role.domain'}))) { return ''; }
 </script>      unless (&Apache::lonnet::allowed('cca',$audom)) { return ''; }
 ENDLOGINSCRIPT      return 1;
     $generalrule=<<END;  
 <p>  
 <i>As a general rule, only authors or co-authors should be filesystem  
 authenticated (which allows access to the server filesystem).</i>  
 </p>  
 END  
 }  }
   
 # =================================================================== Phase one  # =================================================================== Phase one
   
 sub phase_one {  sub print_username_entry_form {
     my $r=shift;      my $r=shift;
     my $defdom=$ENV{'user.domain'};      my $defdom=$ENV{'request.role.domain'};
     $r->print(<<ENDDOCUMENT);      my @domains = &Apache::loncommon::get_domains();
       my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
       my $bodytag =&Apache::loncommon::bodytag(
                                     'Create Users, Change User Privileges');
       my $selscript=&Apache::loncommon::studentbrowser_javascript();
       my $sellink=&Apache::loncommon::selectstudent_link
                                           ('crtuser','ccuname','ccdomain');
       my %existingroles=&my_custom_roles();
       my $choice=&Apache::loncommon::select_form('make new role','rolename',
    ('make new role' => 'Generate new role ...',%existingroles));
       $r->print(<<"ENDDOCUMENT");
 <html>  <html>
 <head>  <head>
 <title>The LearningOnline Network with CAPA</title>  <title>The LearningOnline Network with CAPA</title>
   $selscript
 </head>  </head>
 <body bgcolor="#FFFFFF">  $bodytag
 <h1>Create User, Change User Privileges</h1>  <form action="/adm/createuser" method="post" name="crtuser">
 <form action=/adm/createuser method=post>  <input type="hidden" name="phase" value="get_user_info">
 <input type=hidden name=phase value=two>  <h2>Set Individual User Roles</h2>
 Username: <input type=text size=15 name=ccuname><br>  <table>
 Domain: <input type=text size=15 name=ccdomain value=$defdom><p>  <tr><td>Username:</td><td><input type="text" size="15" name="ccuname">
 <input type=submit value="Continue">  </td><td rowspan="2">$sellink</td></tr><tr><td>
   Domain:</td><td>$domform</td></tr>
   </table>
   <input name="userrole" type="submit" value="User Roles" />
 </form>  </form>
   <form action="/adm/createuser" method="post" name="docustom">
   <input type="hidden" name="phase" value="selected_custom_edit">
   <h2>Edit Custom Role Privileges</h2>
   Name of Role: $choice <input type="text" size="15" name="newrolename" /><br />
   <input name="customeditor" type="submit" value="Custom Role Editor" />
 </body>  </body>
 </html>  </html>
 ENDDOCUMENT  ENDDOCUMENT
 }  }
   
 # =================================================================== Phase two  # =================================================================== Phase two
 sub phase_two {  sub print_user_modification_page {
     my $r=shift;      my $r=shift;
     my $ccuname=$ENV{'form.ccuname'};      my $ccuname=$ENV{'form.ccuname'};
     my $ccdomain=$ENV{'form.ccdomain'};      my $ccdomain=$ENV{'form.ccdomain'};
   
     $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;      $ccuname=~s/\W//gs;
     my $krbdefdom=$1;      $ccdomain=~s/\W//gs;
     $krbdefdom=~tr/a-z/A-Z/;  
       unless (($ccuname) && ($ccdomain)) {
    &print_username_entry_form($r);
           return;
       }
   
     my $defdom=$ENV{'user.domain'};      my $defdom=$ENV{'request.role.domain'};
   
       my ($krbdef,$krbdefdom) =
          &Apache::loncommon::get_kerberos_defaults($defdom);
   
       my %param = ( formname => 'document.cu',
                     kerb_def_dom => $krbdefdom,
                     kerb_def_auth => $krbdef
                     );
       $loginscript  = &Apache::loncommon::authform_header(%param);
       $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
   
     $ccuname=~s/\W//g;      $ccuname=~s/\W//g;
     $ccdomain=~s/\W//g;      $ccdomain=~s/\W//g;
       my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
     my $dochead =<<"ENDDOCHEAD";      my $dochead =<<"ENDDOCHEAD";
 <html>  <html>
 <head>  <head>
 <title>The LearningOnline Network with CAPA</title>  <title>The LearningOnline Network with CAPA</title>
 <script>  <script type="text/javascript" language="Javascript">
   
     function pclose() {      function pclose() {
         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",          parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
Line 232  sub phase_two { Line 190  sub phase_two {
         parmwin.close();          parmwin.close();
     }      }
   
     function pjump(type,dis,value,marker,ret,call) {      $pjump_def
         parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)  
                  +"&value="+escape(value)+"&marker="+escape(marker)  
                  +"&return="+escape(ret)  
                  +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",  
                  "height=350,width=350,scrollbars=no,menubar=no");  
   
     }  
   
     function dateset() {      function dateset() {
         eval("document.cu."+document.cu.pres_marker.value+          eval("document.cu."+document.cu.pres_marker.value+
Line 249  sub phase_two { Line 200  sub phase_two {
   
 </script>  </script>
 </head>  </head>
 <body bgcolor="#FFFFFF">  
 <img align="right" src="/adm/lonIcons/lonlogos.gif">  
 ENDDOCHEAD  ENDDOCHEAD
       $r->print(&Apache::loncommon::bodytag(
                                        'Create Users, Change User Privileges'));
     my $forminfo =<<"ENDFORMINFO";      my $forminfo =<<"ENDFORMINFO";
 <form action="/adm/createuser" method="post" name="cu">  <form action="/adm/createuser" method="post" name="cu">
 <input type="hidden" name="phase"       value="three">  <input type="hidden" name="phase"       value="update_user_data">
 <input type="hidden" name="ccuname"     value="$ccuname">  <input type="hidden" name="ccuname"     value="$ccuname">
 <input type="hidden" name="ccdomain"    value="$ccdomain">  <input type="hidden" name="ccdomain"    value="$ccdomain">
 <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;
     foreach (%Apache::lonnet::hostdom) {      foreach (values(%Apache::lonnet::hostdom)) {
        $incdomains{$_}=1;         $incdomains{$_}=1;
     }      }
     foreach (keys(%ENV)) {      foreach (keys(%ENV)) {
Line 275  ENDFORMINFO Line 224  ENDFORMINFO
         }          }
     }      }
     if ($uhome eq 'no_host') {      if ($uhome eq 'no_host') {
           my $home_server_list=
               '<option value="default" selected>default</option>'."\n".
                   &Apache::loncommon::home_server_option_list($ccdomain);
           
  $r->print(<<ENDNEWUSER);   $r->print(<<ENDNEWUSER);
 $dochead  $dochead
 <h1>Create New User</h1>  <h1>Create New User</h1>
 $forminfo  $forminfo
 <h2>New user "$ccuname" in domain $ccdomain</h2>  <h2>New user "$ccuname" in domain $ccdomain</h2>
   <script type="text/javascript" language="Javascript">
 $loginscript  $loginscript
   </script>
 <input type='hidden' name='makeuser' value='1' />  <input type='hidden' name='makeuser' value='1' />
 <h3>Personal Data</h3>  <h3>Personal Data</h3>
 <p>  <p>
Line 295  $loginscript Line 250  $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  <p>$generalrule </p>
 $authformkrb  <p>$authformkrb </p>
 $authformint  <p>$authformint </p>
 $authformfsys  <p>$authformfsys</p>
 $authformloc  <p>$authformloc </p>
 ENDNEWUSER  ENDNEWUSER
     } else { # user already exists      } else { # user already exists
  $r->print(<<ENDCHANGEUSER);   $r->print(<<ENDCHANGEUSER);
 $dochead  $dochead
 <h1>Change User Privileges</h1>  <h1>Change User Privileges</h1>
 $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(<<END);
              '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.  <hr />
      '<th>Start</th><th>End</th>');  <h3>Revoke Existing Roles</h3>
    foreach (split(/&/,$rolesdump)) {  <table border=2>
              if ($_!~/^rolesdef\&/) {  <tr><th>Revoke</th><th>Delete</th><th>Role</th><th>Extent</th><th>Start</th><th>End</th>
               my ($area,$role)=split(/=/,$_);  END
               my $thisrole=$area;     foreach my $area (keys(%rolesdump)) {
               $area=~s/\_\w\w$//;                 next if ($area =~ /^rolesdef/);
               my ($role_code,$role_end_time,$role_start_time)=split(/_/,$role);                 my $role = $rolesdump{$area};
               my $bgcol='ffffff';                 my $thisrole=$area;
               my $allows=0;                 $area =~ s/\_\w\w$//;
               if ($area=~/^\/(\w+)\/(\d\w+)/) {                 my ($role_code,$role_end_time,$role_start_time) = 
                  my %coursedata=&Apache::lonnet::coursedescription($1.'_'.$2);                     split(/_/,$role);
                  my $carea='Course: '.$coursedata{'description'};                 my $bgcol='ffffff';
                  $inccourses{$1.'_'.$2}=1;                 my $allowed=0;
                  if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) {                 my $delallowed=0;
      $allows=1;                 if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {
                  }                     my ($coursedom,$coursedir) = ($1,$2);
  # Compute the background color based on $area                     # $1.'_'.$2 is the course id (eg. 103_12345abcef103l3).
                  $bgcol=$1.'_'.$2;                     my %coursedata=
                  $bgcol=~s/[^8-9b-e]//g;                         &Apache::lonnet::coursedescription($1.'_'.$2);
                  $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);     my $carea;
                  if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {     if (defined($coursedata{'description'})) {
                      $carea.='<br>Section/Group: '.$3;         $carea='Course: '.$coursedata{'description'}.
  }                             '<br />Domain: '.$coursedom.('&nbsp;'x8).
                  $area=$carea;       &Apache::loncommon::syllabuswrapper('Syllabus',$coursedir,$coursedom);
       } else {     } else {
                  if ($area=~/^\/(\w+)\//) {         $carea='Unavailable course: '.$area;
                      if (&Apache::lonnet::allowed('c'.$role_code,$1)) {     }
  $allows=1;                     $inccourses{$1.'_'.$2}=1;
                      }                     if ((&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) ||
                  } else {                         (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
                      if (&Apache::lonnet::allowed('c'.$role_code,'/')) {                         $allowed=1;
  $allows=1;                     }
                      }                     if ((&Apache::lonnet::allowed('dro',$1)) ||
                  }                         (&Apache::lonnet::allowed('dro',$ccdomain))) {
       }                         $delallowed=1;
                      }
               $r->print('<tr bgcolor=#"'.$bgcol.'"><td>');                     # Compute the background color based on $area
               my $active=1;                     $bgcol=$1.'_'.$2;
               if (($role_end_time) && ($now>$role_end_time)) { $active=0; }                     $bgcol=~s/[^8-9b-e]//g;
               if (!($active) && ($allows)) {                     $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
   $r->print('<input type=checkbox name="rev:'.$thisrole.'">');                     if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
               } else {                         $carea.='<br>Section/Group: '.$3;
                   $r->print('&nbsp;');                     }
               }                     $area=$carea;
               $r->print('</td><td>'.&Apache::lonnet::plaintext($role_code).                 } else {
                         '</td><td>'.$area.'</td><td>'.                     # Determine if current user is able to revoke privileges
                         ($role_start_time ? localtime($role_start_time)                     if ($area=~ /^\/(\w+)\//) {
                                           : '&nbsp;' )                         if ((&Apache::lonnet::allowed('c'.$role_code,$1)) ||
  .'</td><td>'.                         (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
                         ($role_end_time   ? localtime($role_end_time)                             $allowed=1;
                                           : '&nbsp;' )                         }
  ."</td></tr>\n");                         if (((&Apache::lonnet::allowed('dro',$1))  ||
      }                              (&Apache::lonnet::allowed('dro',$ccdomain))) &&
    }                              ($role_code ne 'dc')) {
                              $delallowed=1;
                          }
                      } else {
                          if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
                              $allowed=1;
                          }
                      }
                  }
                  if ($role_code eq 'ca') {
                      $area=~/\/(\w+)\/(\w+)/;
      if (&authorpriv($2,$1)) {
          $allowed=1;
                      } else {
                          $allowed=0;
                      }
                  }
                  my $row = '';
                  $row.='<tr bgcolor=#"'.$bgcol.'"><td>';
                  my $active=1;
                  $active=0 if (($role_end_time) && ($now>$role_end_time));
                  if (($active) && ($allowed)) {
                      $row.= '<input type="checkbox" name="rev:'.$thisrole.'">';
                  } else {
                      if ($active) {
                         $row.='&nbsp;';
      } else {
                         $row.='expired or revoked';
      }
                  }
          $row.='</td><td>';
                  if ($delallowed) {
                      $row.= '<input type="checkbox" name="del:'.$thisrole.'">';
                  } else {
                      $row.='&nbsp;';
                  }
                  $row.= '</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($row);
              } # end of foreach        (table building loop)
    $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=~/^krb(4|5):/) {
     $currentauth=~/^krb4:(.*)/;      $currentauth=~/^krb(4|5):(.*)/;
     my $krbdefdom2=$1;      my $krbdefdom=$1;
     $loginscript=~s/vf\.krbdom\.value='.*?';/vf.krbdom.value='$krbdefdom2';/;              my %param = ( formname => 'document.cu',
                             kerb_def_dom => $krbdefdom 
                             );
               $loginscript  = &Apache::loncommon::authform_header(%param);
  }   }
  # Check for a bad authentication type   # Check for a bad authentication type
         unless ($currentauth=~/^krb4:/ or          unless ($currentauth=~/^krb(4|5):/ or
  $currentauth=~/^unix:/ or   $currentauth=~/^unix:/ or
  $currentauth=~/^internal:/ or   $currentauth=~/^internal:/ or
  $currentauth=~/^localauth:/   $currentauth=~/^localauth:/
  ) { # bad authentication scheme   ) { # bad authentication scheme
     if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {      if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
  $r->print(<<ENDBADAUTH);   $r->print(<<ENDBADAUTH);
 <hr />  <hr />
   <script type="text/javascript" language="Javascript">
 $loginscript  $loginscript
   </script>
 <font color='#ff0000'>ERROR:</font>  <font color='#ff0000'>ERROR:</font>
 This user has an unrecognized authentication scheme ($currentauth).  This user has an unrecognized authentication scheme ($currentauth).
 Please specify login data below.  Please specify login data below.
 <h3>Login Data</h3>  <h3>Login Data</h3>
 $generalrule  <p>$generalrule</p>
 $authformkrb  <p>$authformkrb</p>
 $authformint  <p>$authformint</p>
 $authformfsys  <p>$authformfsys</p>
 $authformloc  <p>$authformloc</p>
 ENDBADAUTH  ENDBADAUTH
             } else {               } else { 
                 # This user is not allowed to modify the users                   # This user is not allowed to modify the users 
                 # authentication scheme, so just notify them of the problem                  # authentication scheme, so just notify them of the problem
  $r->print(<<ENDBADAUTH);   $r->print(<<ENDBADAUTH);
 <hr />  <hr />
   <script type="text/javascript" language="Javascript">
 $loginscript  $loginscript
   </script>
 <font color="#ff0000"> ERROR: </font>  <font color="#ff0000"> ERROR: </font>
 This user has an unrecognized authentication scheme ($currentauth).  This user has an unrecognized authentication scheme ($currentauth).
 Please alert a domain coordinator of this situation.  Please alert a domain coordinator of this situation.
Line 416  ENDBADAUTH Line 446  ENDBADAUTH
         } else { # Authentication type is valid          } else { # Authentication type is valid
     my $authformcurrent='';      my $authformcurrent='';
     my $authform_other='';      my $authform_other='';
     if ($currentauth=~/^krb4:/) {      if ($currentauth=~/^krb(4|5):/) {
  $authformcurrent=$authformkrb;   $authformcurrent=$authformkrb;
  $authform_other=$authformint.$authformfsys.$authformloc;   $authform_other="<p>$authformint</p>\n".
  # embarrassing script hack here                      "<p>$authformfsys</p><p>$authformloc</p>";
  $loginscript=~s/login\[3\]/login\[4\]/; # loc  
  $loginscript=~s/login\[2\]/login\[3\]/; # fsys  
  $loginscript=~s/login\[1\]/login\[2\]/; # int  
  $loginscript=~s/login\[0\]/login\[1\]/; # krb4  
     }      }
     elsif ($currentauth=~/^internal:/) {      elsif ($currentauth=~/^internal:/) {
  $authformcurrent=$authformint;   $authformcurrent=$authformint;
  $authform_other=$authformkrb.$authformfsys.$authformloc;   $authform_other="<p>$authformkrb</p>".
  # embarrassing script hack here                      "<p>$authformfsys</p><p>$authformloc</p>";
  $loginscript=~s/login\[3\]/login\[4\]/; # loc  
  $loginscript=~s/login\[2\]/login\[3\]/; # fsys  
  $loginscript=~s/login\[1\]/login\[1\]/; # int  
  $loginscript=~s/login\[0\]/login\[2\]/; # krb4  
     }      }
     elsif ($currentauth=~/^unix:/) {      elsif ($currentauth=~/^unix:/) {
  $authformcurrent=$authformfsys;   $authformcurrent=$authformfsys;
  $authform_other=$authformkrb.$authformint.$authformloc;   $authform_other="<p>$authformkrb</p>".
  # embarrassing script hack here                      "<p>$authformint</p><p>$authformloc;</p>";
  $loginscript=~s/login\[3\]/login\[4\]/; # loc  
  $loginscript=~s/login\[1\]/login\[3\]/; # int  
  $loginscript=~s/login\[2\]/login\[1\]/; # fsys  
  $loginscript=~s/login\[0\]/login\[2\]/; # krb4  
     }      }
     elsif ($currentauth=~/^localauth:/) {      elsif ($currentauth=~/^localauth:/) {
  $authformcurrent=$authformloc;   $authformcurrent=$authformloc;
  $authform_other=$authformkrb.$authformint.$authformfsys;   $authform_other="<p>$authformkrb</p>".
  # embarrassing script hack here                      "<p>$authformint</p><p>$authformfsys</p>";
  $loginscript=~s/login\[3\]/login\[loc\]/; # loc  
  $loginscript=~s/login\[2\]/login\[4\]/; # fsys  
  $loginscript=~s/login\[1\]/login\[3\]/; # int  
  $loginscript=~s/login\[0\]/login\[2\]/; # krb4  
  $loginscript=~s/login\[loc\]/login\[1\]/; # loc  
     }      }
     $authformcurrent=<<ENDCURRENTAUTH;              $authformcurrent.=' <i>(will override current values)</i><br />';
 <table border='1'>              if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
 <tr>  
 <td><font color='#ff0000'>* * * WARNING * * *</font></td>  
 <td><font color='#ff0000'>* * * WARNING * * *</font></td>  
 </tr>  
 <tr><td bgcolor='#cbbcbb'>$authformcurrent</td>  
 <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr>  
 </table>  
 ENDCURRENTAUTH  
             if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {  
  # Current user has login modification privileges   # Current user has login modification privileges
  $r->print(<<ENDOTHERAUTHS);   $r->print(<<ENDOTHERAUTHS);
 <hr />  <hr />
   <script type="text/javascript" language="Javascript">
 $loginscript  $loginscript
   </script>
 <h3>Change Current Login Data</h3>  <h3>Change Current Login Data</h3>
 $generalrule  <p>$generalrule</p>
 $authformnop  <p>$authformnop</p>
 $authformcurrent  <p>$authformcurrent</p>
 <h3>Enter New Login Data</h3>  <h3>Enter New Login Data</h3>
 $authform_other  $authform_other
 ENDOTHERAUTHS  ENDOTHERAUTHS
Line 482  ENDOTHERAUTHS Line 488  ENDOTHERAUTHS
 #  #
 # Co-Author  # Co-Author
 #   # 
       if (&authorpriv($ENV{'user.name'},$ENV{'request.role.domain'}) &&
     if (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) {          ($ENV{'user.name'} ne $ccuname || $ENV{'user.domain'} ne $ccdomain)) {
           # No sense in assigning co-author role to yourself
  my $cuname=$ENV{'user.name'};   my $cuname=$ENV{'user.name'};
         my $cudom=$ENV{'user.domain'};          my $cudom=$ENV{'request.role.domain'};
        $r->print(<<ENDCOAUTH);         $r->print(<<ENDCOAUTH);
 <h4>Construction Space</h4>  <h4>Construction Space</h4>
 <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>  <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
Line 541  ENDDROW Line 548  ENDDROW
 }  }
   
 # ================================================================= Phase Three  # ================================================================= Phase Three
 sub phase_three {  sub update_user_data {
     my $r=shift;      my $r=shift;
       my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'},
                                             $ENV{'form.ccdomain'});
       # Error messages
       my $error     = '<font color="#ff0000">Error:</font>';
       my $end       = '</body></html>';
       # Print header
     $r->print(<<ENDTHREEHEAD);      $r->print(<<ENDTHREEHEAD);
 <html>  <html>
 <head>  <head>
 <title>The LearningOnline Network with CAPA</title>  <title>The LearningOnline Network with CAPA</title>
 </head>  </head>
 <body bgcolor="#FFFFFF">  
 <img align=right src=/adm/lonIcons/lonlogos.gif>  
 <h1>Create User, Change User Privileges</h1>  
 ENDTHREEHEAD  ENDTHREEHEAD
    $r->print('<h2>'.$ENV{'form.cuname'}.' at '.$ENV{'form.cdomain'}.'</h2>');      my $title;
    if ($ENV{'form.makeuser'}) {      if (exists($ENV{'form.makeuser'})) {
     $r->print('<h3>Creating User</h3>');   $title='Set Privileges for New User';
     if (($ENV{'form.cuname'})&&($ENV{'form.cuname'}!~/\W/)&&  
         ($ENV{'form.cdomain'})&&($ENV{'form.cdomain'}!~/\W/)) {  
  my $amode='';  
         my $genpwd='';  
         if ($ENV{'form.login'} eq 'krb') {  
            $amode='krb4';  
            $genpwd=$ENV{'form.krbdom'};  
         } elsif ($ENV{'form.login'} eq 'int') {  
            $amode='internal';  
            $genpwd=$ENV{'form.intpwd'};  
         } elsif ($ENV{'form.login'} eq 'fsys') {  
            $amode='unix';  
            $genpwd=$ENV{'form.fsyspwd'};  
         } elsif ($ENV{'form.login'} eq 'loc') {  
     $amode='localauth';  
     $genpwd=$ENV{'form.locarg'};  
     if (!$genpwd) { $genpwd=" "; }  
  }  
         if (($amode) && ($genpwd)) {  
           $r->print('Generating user: '.&Apache::lonnet::modifyuser(  
                       $ENV{'form.cdomain'},$ENV{'form.cuname'},  
                       $ENV{'form.cstid'},$amode,$genpwd,  
                $ENV{'form.cfirst'},$ENV{'form.cmiddle'},  
                       $ENV{'form.clast'},$ENV{'form.cgen'}));  
           $r->print('<br>Home server: '.&Apache::lonnet::homeserver  
                       ($ENV{'form.cuname'},$ENV{'form.cdomain'}));  
   
  } else {  
            $r->print('Invalid login mode or password');      
         }            
     } else {      } else {
         $r->print('Invalid username or domain');          $title='Modify User Privileges';
     }      }
    }      $r->print(&Apache::loncommon::bodytag($title));
    if (!$ENV{'form.makeuser'} and $ENV{'form.login'} ne 'nop') {      # Check Inputs
     $r->print('<h3>Changing User Login Data</h3>');      if (! $ENV{'form.ccuname'} ) {
     if (($ENV{'form.cuname'})&&($ENV{'form.cuname'}!~/\W/)&&   $r->print($error.'No login name specified.'.$end);
         ($ENV{'form.cdomain'})&&($ENV{'form.cdomain'}!~/\W/)) {   return;
  my $amode='';      }
         my $genpwd='';      if (  $ENV{'form.ccuname'}  =~/\W/) {
         if ($ENV{'form.login'} eq 'krb') {   $r->print($error.'Invalid login name.  '.
            $amode='krb4';    'Only letters, numbers, and underscores are valid.'.
            $genpwd=$ENV{'form.krbdom'};    $end);
         } elsif ($ENV{'form.login'} eq 'int') {   return;
            $amode='internal';      }
            $genpwd=$ENV{'form.intpwd'};      if (! $ENV{'form.ccdomain'}       ) {
         } elsif ($ENV{'form.login'} eq 'fsys') {   $r->print($error.'No domain specified.'.$end);
            $amode='unix';   return;
            $genpwd=$ENV{'form.fsyspwd'};      }
         } elsif ($ENV{'form.login'} eq 'loc') {      if (  $ENV{'form.ccdomain'} =~/\W/) {
     $amode='localauth';   $r->print($error.'Invalid domain name.  '.
     $genpwd=$ENV{'form.locarg'};    'Only letters, numbers, and underscores are valid.'.
     if (!$genpwd) { $genpwd=" "; }    $end);
    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
       my $amode='';
       my $genpwd='';
       if ($ENV{'form.login'} eq 'krb') {
    $amode='krb';
    $amode.=$ENV{'form.krbver'};
    $genpwd=$ENV{'form.krbarg'};
       } elsif ($ENV{'form.login'} eq 'int') {
    $amode='internal';
    $genpwd=$ENV{'form.intarg'};
       } elsif ($ENV{'form.login'} eq 'fsys') {
    $amode='unix';
    $genpwd=$ENV{'form.fsysarg'};
       } elsif ($ENV{'form.login'} eq 'loc') {
    $amode='localauth';
    $genpwd=$ENV{'form.locarg'};
    $genpwd=" " if (!$genpwd);
       } elsif (($ENV{'form.login'} eq 'nochange') ||
                ($ENV{'form.login'} eq ''        )) { 
           # There is no need to tell the user we did not change what they
           # did not ask us to change.
           # If they are creating a new user but have not specified login
           # information this will be caught below.
       } else {
       $r->print($error.'Invalid login mode or password'.$end);    
       return;
       }
       if ($ENV{'form.makeuser'}) {
           # Create a new user
    $r->print(<<ENDNEWUSERHEAD);
   <h3>Creating user "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
   ENDNEWUSERHEAD
           # Check for the authentication mode and password
           if (! $amode || ! $genpwd) {
       $r->print($error.'Invalid login mode or password'.$end);    
       return;
  }   }
         if (($amode) && ($genpwd)) {          # Determine desired host
           my $desiredhost = $ENV{'form.hserver'};
           if (lc($desiredhost) eq 'default') {
               $desiredhost = undef;
           } else {
               my %home_servers = &Apache::loncommon::get_library_servers
                   ($ENV{'form.ccdomain'});  
               if (! exists($home_servers{$desiredhost})) {
                   $r->print($error.'Invalid home server specified');
                   return;
               }
           }
    # Call modifyuser
    my $result = &Apache::lonnet::modifyuser
       ($ENV{'form.ccdomain'},$ENV{'form.ccuname'},$ENV{'form.cstid'},
                $amode,$genpwd,$ENV{'form.cfirst'},
                $ENV{'form.cmiddle'},$ENV{'form.clast'},$ENV{'form.cgen'},
                undef,$desiredhost
        );
    $r->print('Generating user: '.$result);
           my $home = &Apache::lonnet::homeserver($ENV{'form.ccuname'},
                                                  $ENV{'form.ccdomain'});
           $r->print('<br>Home server: '.$home.' '.
                     $Apache::lonnet::libserv{$home});
       } elsif (($ENV{'form.login'} ne 'nochange') &&
                ($ENV{'form.login'} ne ''        )) {
    # Modify user privileges
    $r->print(<<ENDMODIFYUSERHEAD);
   <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
   ENDMODIFYUSERHEAD
           if (! $amode || ! $genpwd) {
       $r->print($error.'Invalid login mode or password'.$end);    
       return;
    }
    # Only allow authentification modification if the person has authority
    if (&Apache::lonnet::allowed('mau',$ENV{'form.ccdomain'})) {
     $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 {
            $r->print('Invalid login mode or password');          # Okay, this is a non-fatal error.
         }                $r->print($error.'You do not have the authority to modify '.
     } else {        'this users authentification information.');    
         $r->print('Invalid username or domain');   }
     }      }
    }      ##
       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)) {
  if (($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {   next if (! $ENV{$_});
            $r->print('Revoking '.$2.' in '.$1.': '.   # Revoke roles
           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},   if ($_=~/^form\.rev/) {
                                       $1,$2,$now).'<br>');      if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) {
            if ($2 eq 'st') {          $r->print('Revoking '.$2.' in '.$1.': <b>'.
                $1=~/^\/(\w+)\/(\w+)/;                       &Apache::lonnet::assignrole($ENV{'form.ccdomain'},
                my $cid=$1.'_'.$2;                       $ENV{'form.ccuname'},$1,$2,$now).'</b><br>');
        $r->print('Drop from classlist: '.   if ($2 eq 'st') {
           &Apache::lonnet::critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.      $1=~/^\/(\w+)\/(\w+)/;
               $ENV{'course.'.$cid.'.num'}.':classlist:'.      my $cid=$1.'_'.$2;
                       &Apache::lonnet::escape($ENV{'form.cuname'}.':'.      $r->print('Drop from classlist: <b>'.
                                               $ENV{'form.cdomain'}).'='.   &Apache::lonnet::critical('put:'.
                       &Apache::lonnet::escape($now.':'),                               $ENV{'course.'.$cid.'.domain'}.':'.
               $ENV{'course.'.$cid.'.home'}).'<br>');                       $ENV{'course.'.$cid.'.num'}.':classlist:'.
            }                           &Apache::lonnet::escape($ENV{'form.ccuname'}.':'.
  }                               $ENV{'form.ccdomain'}).'='.
     }                            &Apache::lonnet::escape($now.':'),
     foreach (keys(%ENV)) {                       $ENV{'course.'.$cid.'.home'}).'</b><br>');
  if (($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {   }
             my $url='/'.$1.'/'.$2;      } 
             if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {   } elsif ($_=~/^form\.del/) {
  $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};      if ($_=~/^form\.del\:([^\_]+)\_([^\_]+)$/) {
             }          $r->print('Deleting '.$2.' in '.$1.': '.
             my $start=$now;                       &Apache::lonnet::assignrole($ENV{'form.ccdomain'},
             if ($ENV{'form.start_'.$1.'_'.$2.'_'.$3}) {                       $ENV{'form.ccuname'},$1,$2,$now,0,1).'<br>');
  $start=$ENV{'form.start_'.$1.'_'.$2.'_'.$3};   if ($2 eq 'st') {
             }      $1=~/^\/(\w+)\/(\w+)/;
             my $end=0;      my $cid=$1.'_'.$2;
             if ($ENV{'form.end_'.$1.'_'.$2.'_'.$3}) {      $r->print('Drop from classlist: <b>'.
  $end=$ENV{'form.end_'.$1.'_'.$2.'_'.$3};   &Apache::lonnet::critical('put:'.
             }                               $ENV{'course.'.$cid.'.domain'}.':'.
             $r->print('Assigning: '.$3.' in '.$url.': '.                       $ENV{'course.'.$cid.'.num'}.':classlist:'.
           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},                           &Apache::lonnet::escape($ENV{'form.ccuname'}.':'.
                                       $url,$3,$end,$start).'<br>');                               $ENV{'form.ccdomain'}).'='.
             if ($3 eq 'st') {                           &Apache::lonnet::escape($now.':'),
  $url=~/^\/(\w+)\/(\w+)/;                       $ENV{'course.'.$cid.'.home'}).'</b><br>');
                 my $cid=$1.'_'.$2;   }
                $r->print('Add to classlist: '.      } 
           &Apache::lonnet::critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.   } elsif ($_=~/^form\.act/) {
               $ENV{'course.'.$cid.'.num'}.':classlist:'.      if ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) {
                       &Apache::lonnet::escape($ENV{'form.cuname'}.':'.   # Activate roles for sections with 3 id numbers
                                               $ENV{'form.cdomain'}).'='.   # set start, end times, and the url for the class
                       &Apache::lonnet::escape($end.':'.$start),  
               $ENV{'course.'.$cid.'.home'}).'<br>');   my $start = ( $ENV{'form.start_'.$1.'_'.$2.'_'.$3} ? 
         $ENV{'form.start_'.$1.'_'.$2.'_'.$3} : 
         $now );
    my $end   = ( $ENV{'form.end_'.$1.'_'.$2.'_'.$3} ? 
         $ENV{'form.end_'.$1.'_'.$2.'_'.$3} :
         0 );
    my $url='/'.$1.'/'.$2;
    if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {
       $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};
    }
    # Assign the role and report it
    $r->print('Assigning: '.$3.' in '.$url.
                            ($start?', starting '.localtime($start):'').
                            ($end?', ending '.localtime($end):'').': <b>'.
                             &Apache::lonnet::assignrole(
                                 $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
                                 $url,$3,$end,$start).
     '</b><br>');
    # Handle students differently
    if ($3 eq 'st') {
       $url=~/^\/(\w+)\/(\w+)/;
       my $cid=$1.'_'.$2;
       $r->print('Add to classlist: <b>'.
         &Apache::lonnet::critical(
     'put:'.$ENV{'course.'.$cid.'.domain'}.':'.
                              $ENV{'course.'.$cid.'.num'}.':classlist:'.
                                      &Apache::lonnet::escape(
                                          $ENV{'form.ccuname'}.':'.
                                          $ENV{'form.ccdomain'} ).'='.
                                      &Apache::lonnet::escape($end.':'.$start),
          $ENV{'course.'.$cid.'.home'})
         .'</b><br>');
    }
       } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) {
    # Activate roles for sections with two id numbers
    # set start, end times, and the url for the class
    my $start = ( $ENV{'form.start_'.$1.'_'.$2} ? 
         $ENV{'form.start_'.$1.'_'.$2} : 
         $now );
    my $end   = ( $ENV{'form.end_'.$1.'_'.$2} ? 
         $ENV{'form.end_'.$1.'_'.$2} :
         0 );
    my $url='/'.$1.'/';
    # Assign the role and report it.
    $r->print('Assigning: '.$2.' in '.$url.': '.
                            ($start?', starting '.localtime($start):'').
                            ($end?', ending '.localtime($end):'').': <b>'.
                             &Apache::lonnet::assignrole(
                                 $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
                                 $url,$2,$end,$start)
     .'</b><br>');
     }      }
  } elsif (($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {   } 
             my $url='/'.$1.'/';      } # End of foreach (keys(%ENV))
             my $start=$now;  
             if ($ENV{'form.start_'.$1.'_'.$2}) {  
  $start=$ENV{'form.start_'.$1.'_'.$2};  
             }  
             my $end=0;  
             if ($ENV{'form.end_'.$1.'_'.$2}) {  
  $end=$ENV{'form.end_'.$1.'_'.$2};  
             }  
             $r->print('Assigning: '.$2.' in '.$url.': '.  
           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},  
                                       $url,$2,$end,$start).'<br>');  
         }  
     }  
     $r->print('</body></html>');      $r->print('</body></html>');
 }  }
   
   # ========================================================== Custom Role Editor
   
   sub custom_role_editor {
       my $r=shift;
       my $rolename=$ENV{'form.rolename'};
   
       if ($rolename eq 'make new role') {
    $rolename=$ENV{'form.newrolename'};
       }
   
       $rolename=~s/\W//gs;
   
       unless ($rolename) {
    &print_username_entry_form($r);
           return;
       }
   
       $r->print(&Apache::loncommon::bodytag(
                        'Create Users, Change User Privileges').'<h2>');
       my ($rdummy,$roledef)=
    &Apache::lonnet::get('roles',["rolesdef_$rolename"]);
   # ------------------------------------------------------- Does this role exist?
       if (($rdummy ne 'con_lost') && ($roledef ne '')) {
    $r->print('Existing Role "');
       } else {
    $r->print('New Role "');
    $roledef='';
       }
       $r->print($rolename.'"</h2>');
   # ------------------------------------------------------- What can be assigned?
       my %full=();
       my %courselevel=();
       foreach (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
    my ($priv,$restrict)=split(/\&/,$_);
           unless ($restrict) { $restrict='F'; }
           $courselevel{$priv}=$restrict;
    $full{$priv}=1;
       }
       my %domainlevel=();
       foreach (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
    my ($priv,$restrict)=split(/\&/,$_);
           unless ($restrict) { $restrict='F'; }
           $domainlevel{$priv}=$restrict;
    $full{$priv}=1;
       }
       $r->print('<table border="2"><tr><th>Privilege</th><th>Course Level</th><th>Domain Level</th></tr>');
       foreach (sort keys %full) {
    $r->print('<tr><td>'.&Apache::lonnet::plaintext($_).'</td><td>'.
     $courselevel{$_}.'</td><td>'.$domainlevel{$_}.'</td></tr>');
       }
       $r->print('</table>');
       $r->print('Not yet implemented.');
   }
   
 # ================================================================ Main Handler  # ================================================================ Main Handler
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
Line 704  sub handler { Line 922  sub handler {
         (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) ||           (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) || 
         (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) ||           (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) || 
         (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||          (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||
         (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) ||          (&Apache::lonnet::allowed('cca',$ENV{'request.role.domain'})) ||
         (&Apache::lonnet::allowed('mau',$ENV{'user.domain'}))) {          (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'}))) {
        $r->content_type('text/html');         $r->content_type('text/html');
        $r->send_http_header;         $r->send_http_header;
        unless ($ENV{'form.phase'}) {         unless ($ENV{'form.phase'}) {
    &phase_one($r);     &print_username_entry_form($r);
        }         }
        if ($ENV{'form.phase'} eq 'two') {         if ($ENV{'form.phase'} eq 'get_user_info') {
            &phase_two($r);             &print_user_modification_page($r);
        } elsif ($ENV{'form.phase'} eq 'three') {         } elsif ($ENV{'form.phase'} eq 'update_user_data') {
            &phase_three($r);             &update_user_data($r);
          } elsif ($ENV{'form.phase'} eq 'selected_custom_edit') {
              &custom_role_editor($r);
        }         }
    } else {     } else {
       $ENV{'user.error.msg'}=        $ENV{'user.error.msg'}=
Line 724  sub handler { Line 944  sub handler {
    return OK;     return OK;
 }   } 
   
   #-------------------------------------------------- functions for &phase_two
 sub course_level_table {  sub course_level_table {
     my %inccourses = @_;      my %inccourses = @_;
     my $table = '';      my $table = '';
Line 734  sub course_level_table { Line 954  sub course_level_table {
  $thiscourse=~s:_:/:g;   $thiscourse=~s:_:/:g;
  my %coursedata=&Apache::lonnet::coursedescription($thiscourse);   my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
  my $area=$coursedata{'description'};   my $area=$coursedata{'description'};
    if (!defined($area)) { $area='Unavailable course: '.$_; }
  my $bgcol=$thiscourse;   my $bgcol=$thiscourse;
  $bgcol=~s/[^8-9b-e]//g;   $bgcol=~s/[^8-9b-e]//g;
  $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);   $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
Line 778  $table Line 999  $table
 ENDTABLE  ENDTABLE
     return $result;      return $result;
 }  }
   #---------------------------------------------- end functions for &phase_two
   
   #--------------------------------- functions for &phase_two and &phase_three
   
   #--------------------------end of functions for &phase_two and &phase_three
   
 1;  1;
 __END__  __END__
Removed from v.1.26  
changed lines
  Added in v.1.60

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