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

Diff for /loncom/interface/loncreateuser.pm between versions 1.21 and 1.84

version 1.21, 2001/11/16 07:00:53 version 1.84, 2004/07/03 20:45:23
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # Create a user  # Create a user
 #  #
 # (Create a course  # $Id$
 # (My Desk  
 #  #
 # (Internal Server Error Handler  # Copyright Michigan State University Board of Trustees
 #  #
 # (Login Screen  # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
 # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,  
 # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)  
 #  #
 # YEAR=2001  # LON-CAPA is free software; you can redistribute it and/or modify
 # 3/1/1 Gerd Kortemeyer)  # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
 #  #
 # 3/1 Gerd Kortemeyer)  # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
 #  #
 # 2/14 Gerd Kortemeyer)  # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 #  #
 # 2/14,2/17,2/19,2/20,2/21,2/22,2/23,3/2,3/17,3/24,04/12 Gerd Kortemeyer  # /home/httpd/html/adm/gpl.txt
 # April Guy Albertelli  #
 # 05/10,10/16 Gerd Kortemeyer   # http://www.lon-capa.org/
 # 11/12,11/13,11/15 Scott Harrison  
 #  #
 # $Id$  
 ###  ###
   
 package Apache::loncreateuser;  package Apache::loncreateuser;
   
   =pod
   
   =head1 NAME
   
   Apache::loncreateuser - handler to create users and custom roles
   
   =head1 SYNOPSIS
   
   Apache::loncreateuser provides an Apache handler for creating users,
       editing their login parameters, roles, and removing roles, and
       also creating and assigning custom roles.
   
   =head1 OVERVIEW
   
   =head2 Custom Roles
   
   In LON-CAPA, roles are actually collections of privileges. "Teaching
   Assistant", "Course Coordinator", and other such roles are really just
   collection of privileges that are useful in many circumstances.
   
   Creating custom roles can be done by the Domain Coordinator through
   the Create User functionality. That screen will show all privileges
   that can be assigned to users. For a complete list of privileges,
   please see C</home/httpd/lonTabs/rolesplain.tab>.
   
   Custom role definitions are stored in the C<roles.db> file of the role
   author.
   
   =cut
   
 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;
   use Apache::lonlocal;
   
 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 39  my $authformint; Line 73  my $authformint;
 my $authformfsys;  my $authformfsys;
 my $authformloc;  my $authformloc;
   
 sub BEGIN {  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) {  
     if (vf.fsyspwd.value!='') {  
        vf.login[2].checked=true;  
        vf.krbdom.value='';  
        vf.intpwd.value='';  
        vf.locarg.value='';  
    }  
 }  
   
 function setloc(vf) {  # ======================================================= Existing Custom Roles
     if (vf.locarg.value!='') {  
        vf.login[3].checked=true;  
        vf.krbdom.value='';  
        vf.intpwd.value='';  
        vf.fsyspwd.value='';  
    }  
 }  
   
 function clicknop(vf) {  sub my_custom_roles {
     vf.krbdom.value='';      my %returnhash=();
     vf.intpwd.value='';      my %rolehash=&Apache::lonnet::dump('roles');
     vf.fsyspwd.value='';      foreach (keys %rolehash) {
     vf.locarg.value='';   if ($_=~/^rolesdef\_(\w+)$/) {
 }      $returnhash{$1}=$1;
    }
 function clickkrb(vf) {      }
     vf.krbdom.value='$krbdefdom';      return %returnhash;
     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').&Apache::loncommon::help_open_menu('',undef,undef,'',282,'Instructor Interface');
       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));
       my %lt=&Apache::lonlocal::texthash(
       'siur'   => "Set Individual User Roles",
       'usr'  => "Username",
                       'dom'  => "Domain",
                       'usrr' => "User Roles",
                       'ecrp' => "Edit Custom Role Privileges",
                       'nr'   => "Name of Role",
                       'cre'  => "Custom Role Editor"
          );
       my $helpsiur=&Apache::loncommon::help_open_topic('Course_Change_Privileges');
       my $helpecpr=&Apache::loncommon::help_open_topic('Course_Editing_Custom_Roles');
       $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>$lt{siur}$helpsiur</h2>
 Username: <input type=text size=15 name=ccuname><br>  <table>
 Domain: <input type=text size=15 name=ccdomain value=$defdom><p>  <tr><td>$lt{usr}:</td><td><input type="text" size="15" name="ccuname">
 <input type=submit value="Continue">  </td><td rowspan="2">$sellink</td></tr><tr><td>
   $lt{'dom'}:</td><td>$domform</td></tr>
   </table>
   <input name="userrole" type="submit" value="$lt{usrr}" />
 </form>  </form>
   <form action="/adm/createuser" method="post" name="docustom">
   <input type="hidden" name="phase" value="selected_custom_edit">
   <h2>$lt{'ecrp'}$helpecpr</h2>
   $lt{'nr'}: $choice <input type="text" size="15" name="newrolename" /><br />
   <input name="customeditor" type="submit" value="$lt{'cre'}" />
 </body>  </body>
 </html>  </html>
 ENDDOCUMENT  ENDDOCUMENT
 }  }
   
 # =================================================================== Phase two  # =================================================================== Phase two
   sub print_user_modification_page {
 sub phase_two {  
     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{'request.role.domain'};
   
       my ($krbdef,$krbdefdom) =
          &Apache::loncommon::get_kerberos_defaults($defdom);
   
     my $defdom=$ENV{'user.domain'};      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;
     $r->print(<<ENDENHEAD);      my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
       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 208  sub phase_two { Line 209  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 225  sub phase_two { Line 219  sub phase_two {
   
 </script>  </script>
 </head>  </head>
 <body bgcolor="#FFFFFF">  ENDDOCHEAD
 <img align=right src=/adm/lonIcons/lonlogos.gif>      $r->print(&Apache::loncommon::bodytag(
 <h1>Create User, Change User Privileges</h1>                                       'Create Users, Change User Privileges'));
 <form action=/adm/createuser method=post name=cu>      my $forminfo =<<"ENDFORMINFO";
 <input type=hidden name=phase value=three>  <form action="/adm/createuser" method="post" name="cu">
 <input type=hidden name=ccuname value=$ccuname>  <input type="hidden" name="phase"       value="update_user_data">
 <input type=hidden name=ccdomain value=$ccdomain>  <input type="hidden" name="ccuname"     value="$ccuname">
 <input type="hidden" value='' name="pres_value">  <input type="hidden" name="ccdomain"    value="$ccdomain">
 <input type="hidden" value='' name="pres_type">  <input type="hidden" name="pres_value"  value="" >
 <input type="hidden" value='' name="pres_marker">  <input type="hidden" name="pres_type"   value="" >
 <input type=hidden name=cuname value="$ccuname">  <input type="hidden" name="pres_marker" value="" >
 <input type=hidden name=cdomain value="$ccdomain">  ENDFORMINFO
   
 ENDENHEAD  
     my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);      my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
     my %incdomains;       my %incdomains; 
     my %inccourses;      my %inccourses;
     map {      foreach (values(%Apache::lonnet::hostdom)) {
        $incdomains{$_}=1;         $incdomains{$_}=1;
     } values %Apache::lonnet::hostdom;      }
     map {      foreach (keys(%ENV)) {
  if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {   if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {
     $inccourses{$1.'_'.$2}=1;      $inccourses{$1.'_'.$2}=1;
         }          }
     } %ENV;      }
     if ($uhome eq 'no_host') {      if ($uhome eq 'no_host') {
  $r->print(<<ENDNUSER);          my $home_server_list=
 <h2>New user $ccuname at $ccdomain</h2>              '<option value="default" selected>default</option>'."\n".
 ENDNUSER                  &Apache::loncommon::home_server_option_list($ccdomain);
  $r->print(<<ENDNUSER);          
    my %lt=&Apache::lonlocal::texthash(
                       'cnu'  => "Create New User",
                       'nu'   => "New User",
                       'id'   => "in domain",
                       'pd'   => "Personal Data",
                       'fn'   => "First Name",
                       'mn'   => "Middle Name",
                       'ln'   => "Last Name",
                       'gen'  => "Generation",
                       'idsn' => "ID/Student Number",
                       'hs'   => "Home Server",
                       'lg'   => "Login Data"
          );
    my $genhelp=&Apache::loncommon::help_open_topic('Generation');
    $r->print(<<ENDNEWUSER);
   $dochead
   <h1>$lt{'cnu'}</h1>
   $forminfo
   <h2>$lt{'nu'} "$ccuname" $lt{'id'} $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>$lt{'pd'}</h3>
 First Name: <input type='text' name='cfirst' size='15' /><br />  <p>
 Middle Name: <input type='text' name='cmiddle' size='15' /><br />  <table>
 Last Name: <input type='text' name='clast' size='15' /><br />  <tr><td>$lt{'fn'}  </td>
 Generation: <input type='text' name='cgen' size='5' /><p>      <td><input type='text' name='cfirst'  size='15' /></td></tr>
   <tr><td>$lt{'mn'} </td> 
 ID/Student Number: <input type='text' name='cstid' size='10' /></p>      <td><input type='text' name='cmiddle' size='15' /></td></tr>
   <tr><td>$lt{'ln'}   </td>
 <h3>Login Data</h3>      <td><input type='text' name='clast'   size='15' /></td></tr>
 $generalrule  <tr><td>$lt{'gen'}$genhelp</td>
 $authformkrb      <td><input type='text' name='cgen'    size='5'  /></td></tr>
 $authformint  </table>
 $authformfsys  $lt{'idsn'} <input type='text' name='cstid'   size='15' /></p>
 $authformloc  $lt{'hs'}: <select name="hserver" size="1"> $home_server_list </select>
 ENDNUSER  <hr />
     } else {  <h3>$lt{'lg'}</h3>
  $r->print('<h2>Existing user '.$ccuname.' at '.$ccdomain.'</h2>');  <p>$generalrule </p>
   <p>$authformkrb </p>
         my $rolesdump=&Apache::lonnet::reply(  <p>$authformint </p>
                                   "dump:$ccdomain:$ccuname:roles",$uhome);  <p>$authformfsys</p>
         unless ($rolesdump eq 'con_lost') {   <p>$authformloc </p>
   ENDNEWUSER
       } else { # user already exists
    my %lt=&Apache::lonlocal::texthash(
                       'cup'  => "Change User Privileges",
                       'usr'  => "User",                    
                       'id'   => "in domain",
                       'fn'   => "first name",
                       'mn'   => "middle name",
                       'ln'   => "last name",
                       'gen'  => "generation"
          );
    $r->print(<<ENDCHANGEUSER);
   $dochead
   <h1>$lt{'cup'}</h1>
   $forminfo
   <h2>$lt{'usr'} "$ccuname" $lt{'id'} "$ccdomain"</h2>
   ENDCHANGEUSER
           # Get the users information
           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>$lt{'fn'}</th><th>$lt{'mn'}</th><th>$lt{'ln'}</th><th>$lt{'gen'}</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.
           my ($tmp) = keys(%rolesdump);
           unless ($tmp =~ /^(con_lost|error)/i) {
            my $now=time;             my $now=time;
            $r->print('<h4>Revoke Existing Roles</h4>'.     my %lt=&Apache::lonlocal::texthash(
              '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.      'rer'  => "Revoke Existing Roles",
      '<th>Start</th><th>End</th>');                      'rev'  => "Revoke",                    
            map {                      'del'  => "Delete",
              if ($_!~/^rolesdef\&/) {      'ren'  => "Re-Enable",
                       'rol'  => "Role",
               my ($area,$role)=split(/=/,$_);                      'ext'  => "Extent",
               my $thisrole=$area;                      'sta'  => "Start",
               $area=~s/\_\w\w$//;                      'end'  => "End"
               my ($trole,$tend,$tstart)=split(/_/,$role);         );
               my $bgcol='ffffff';             $r->print(<<END);
               my $allows=0;  <hr />
               if ($area=~/^\/(\w+)\/(\d\w+)/) {  <h3>$lt{'rer'}</h3>
                  my %coursedata=&Apache::lonnet::coursedescription($1.'_'.$2);  <table>
                  my $carea='Course: '.$coursedata{'description'};  <tr><th>$lt{'rev'}</th><th>$lt{'ren'}</th><th>$lt{'del'}</th><th>$lt{'rol'}</th><th>$lt{'ext'}</th><th>$lt{'sta'}</th><th>$lt{'end'}</th>
                  $inccourses{$1.'_'.$2}=1;  END
                  if (&Apache::lonnet::allowed('c'.$trole,$1.'/'.$2)) {             my (%roletext,%sortrole,%roleclass);
      $allows=1;     foreach my $area (sort { my $a1=join('_',(split('_',$a))[1,0]);
                  }      my $b1=join('_',(split('_',$b))[1,0]);
                  $bgcol=$1.'_'.$2;      return $a1 cmp $b1;
                  $bgcol=~s/[^8-9b-e]//g;   } keys(%rolesdump)) {
                  $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);                 next if ($area =~ /^rolesdef/);
                  if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {         my $envkey=$area;
                      $carea.='<br>Section/Group: '.$3;                 my $role = $rolesdump{$area};
  }                 my $thisrole=$area;
                  $area=$carea;                 $area =~ s/\_\w\w$//;
       } else {                 my ($role_code,$role_end_time,$role_start_time) = 
                  if ($area=~/^\/(\w+)\//) {                     split(/_/,$role);
                      if (&Apache::lonnet::allowed('c'.$trole,$1)) {  # Is this a custom role? Get role owner and title.
  $allows=1;         my ($croleudom,$croleuname,$croletitle)=
                      }             ($role_code=~/^cr\/(\w+)\/(\w+)\/(\w+)$/);
                  } else {                 my $bgcol='ffffff';
                      if (&Apache::lonnet::allowed('c'.$trole,'/')) {                 my $allowed=0;
  $allows=1;                 my $delallowed=0;
                      }         my $sortkey=$role_code;
                  }         my $class='Unknown';
       }                 if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {
      $class='Course';
               my $active=1;                     my ($coursedom,$coursedir) = ($1,$2);
               if (($tend) && ($now>$tend)) { $active=0; }     $sortkey.="\0$1";
                      # $1.'_'.$2 is the course id (eg. 103_12345abcef103l3).
               $r->print('<tr bgcolor=#'.$bgcol.'><td>');                     my %coursedata=
               if ($active) {                         &Apache::lonnet::coursedescription($1.'_'.$2);
                   if ($allows) {     my $carea;
      $r->print(     if (defined($coursedata{'description'})) {
                              '<input type=checkbox name="rev:'.$thisrole.'">');         $carea=$coursedata{'description'}.
  } else {                             '<br />'.&mt('Domain').': '.$coursedom.('&nbsp;'x8).
                      $r->print('&nbsp;');       &Apache::loncommon::syllabuswrapper('Syllabus',$coursedir,$coursedom);
                  }         $sortkey.="\0".$coursedata{'description'};
               } else {     } else {
                   $r->print('&nbsp;');         $carea=&mt('Unavailable course').': '.$area;
               }         $sortkey.="\0".&mt('Unavailable course');
               $r->print('</td><td>'.&Apache::lonnet::plaintext($trole).     }
                         '</td><td>'.$area.'</td><td>'.                     $inccourses{$1.'_'.$2}=1;
                         ($tstart?localtime($tstart):'&nbsp;').'</td><td>'.                     if ((&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) ||
                         ($tend?localtime($tend):'&nbsp;')."</td></tr>\n");                         (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
      }                         $allowed=1;
    } split(/&/,$rolesdump);                     }
                      if ((&Apache::lonnet::allowed('dro',$1)) ||
                          (&Apache::lonnet::allowed('dro',$ccdomain))) {
                          $delallowed=1;
                      }
   # - custom role. Needs more info, too
      if ($croletitle) {
          if (&Apache::lonnet::allowed('ccr',$1.'/'.$2)) {
      $allowed=1;
      $thisrole.='.'.$role_code;
          }
      }
                      # Compute the background color based on $area
                      $bgcol=$1.'_'.$2;
                      $bgcol=~s/[^7-9a-e]//g;
                      $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
                      if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
                          $carea.='<br>Section/Group: '.$3;
                      }
                      $area=$carea;
                  } else {
      $sortkey.="\0".$area;
                      # Determine if current user is able to revoke privileges
                      if ($area=~ /^\/(\w+)\//) {
                          if ((&Apache::lonnet::allowed('c'.$role_code,$1)) ||
                          (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
                              $allowed=1;
                          }
                          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' || $role_code eq 'au') {
          $class='Construction Space';
      } elsif ($role_code eq 'su') {
          $class='System';
      } else {
          $class='Domain';
      }
                  }
                  if ($role_code eq 'ca') {
                      $area=~/\/(\w+)\/(\w+)/;
      if (&authorpriv($2,$1)) {
          $allowed=1;
                      } else {
                          $allowed=0;
                      }
                  }
          $bgcol='77FF77';
                  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.=&mt('expired or revoked');
      }
                  }
          $row.='</td><td>';
                  if ($allowed && !$active) {
                      $row.= '<input type="checkbox" name="ren:'.$thisrole.'">';
                  } else {
                      $row.='&nbsp;';
                  }
          $row.='</td><td>';
                  if ($delallowed) {
                      $row.= '<input type="checkbox" name="del:'.$thisrole.'">';
                  } else {
                      $row.='&nbsp;';
                  }
          my $plaintext='';
          unless ($croletitle) {
      $plaintext=&Apache::lonnet::plaintext($role_code);
          } else {
              $plaintext=
    "Customrole '$croletitle' defined by $croleuname\@$croleudom";
          }
                  $row.= '</td><td>'.$plaintext.
                         '</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";
          $sortrole{$sortkey}=$envkey;
          $roletext{$envkey}=$row;
          $roleclass{$envkey}=$class;
                  #$r->print($row);
              } # end of foreach        (table building loop)
      foreach my $type ('Construction Space','Course','Domain','System','Unknown') {
          my $output;
          foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) {
      if ($roleclass{$sortrole{$which}} =~ /^\Q$type\E/) { 
          $output.=$roletext{$sortrole{$which}};
      }
          }
          if (defined($output)) {
      $r->print("<tr bgcolor='#BBffBB'>".
        "<td align='center' colspan='7'>".&mt($type)."</td>");
          }
          $r->print($output);
      }
    $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 
  # minor script hack here                            );
 # $loginscript=~s/login\[3\]/login\[4\]/; # loc              $loginscript  = &Apache::loncommon::authform_header(%param);
 # $loginscript=~s/login\[2\]/login\[3\]/; # fsys   }
 # $loginscript=~s/login\[1\]/login\[2\]/; # int   # Check for a bad authentication type
 # $loginscript=~s/login\[0\]/login\[1\]/; # krb4          unless ($currentauth=~/^krb(4|5):/ or
   
         unless ($currentauth=~/^krb4:/ or  
  $currentauth=~/^unix:/ or   $currentauth=~/^unix:/ or
  $currentauth=~/^internal:/ or   $currentauth=~/^internal:/ or
  $currentauth=~/^localauth:/   $currentauth=~/^localauth:/
  ) {   ) { # bad authentication scheme
     $r->print(<<END);      if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
    my %lt=&Apache::lonlocal::texthash(
                                  'err'   => "ERROR",
          'uuas'  => "This user has an unrecognized authentication scheme",
                                  'sldb'  => "Please specify login data below",
                                  'ld'    => "Login Data"
      );
    $r->print(<<ENDBADAUTH);
 <hr />  <hr />
   <script type="text/javascript" language="Javascript">
 $loginscript  $loginscript
 <font color='#ff0000'>ERROR:</font>  </script>
 This user has an unrecognized authentication scheme ($currentauth).  <font color='#ff0000'>$lt{'err'}:</font>
 Please specify login data below.  $lt{'uuas'} ($currentauth). $lt{'sldb'}.
 <h3>Login Data</h3>  <h3>$lt{'ld'}</h3>
 $generalrule  <p>$generalrule</p>
 $authformkrb  <p>$authformkrb</p>
 $authformint  <p>$authformint</p>
 $authformfsys  <p>$authformfsys</p>
 $authformloc  <p>$authformloc</p>
 END  ENDBADAUTH
         }              } else { 
  else {                  # This user is not allowed to modify the users 
                   # authentication scheme, so just notify them of the problem
    my %lt=&Apache::lonlocal::texthash(
                                  'err'   => "ERROR",
          'uuas'  => "This user has an unrecognized authentication scheme",
                                  'adcs'  => "Please alert a domain coordinator of this situation"
      );
    $r->print(<<ENDBADAUTH);
   <hr />
   <script type="text/javascript" language="Javascript">
   $loginscript
   </script>
   <font color="#ff0000"> $lt{'err'}: </font>
   $lt{'uuas'} ($currentauth). $lt{'adcs'}.
   <hr />
   ENDBADAUTH
               }
           } else { # Authentication type is valid
     my $authformcurrent='';      my $authformcurrent='';
     my $authformother='';      my $authform_other='';
     if ($currentauth=~/^krb4:/) {      if ($currentauth=~/^krb(4|5):/) {
  $authformcurrent=$authformkrb;   $authformcurrent=$authformkrb;
  $authformother=$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;
  $authformother=$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;
  $authformother=$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;
  $authformother=$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=<<END;              $authformcurrent.=' <i>(will override current values)</i><br />';
 <table border='1'>              if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
 <tr>   # Current user has login modification privileges
 <td><font color='#ff0000'>* * * WARNING * * *</font></td>   my %lt=&Apache::lonlocal::texthash(
 <td><font color='#ff0000'>* * * WARNING * * *</font></td>                                 'ccld'  => "Change Current Login Data",
 </tr>         'enld'  => "Enter New Login Data"
 <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>   $r->print(<<ENDOTHERAUTHS);
 </table>  
 END  
  $r->print(<<END);  
 <hr />  <hr />
   <script type="text/javascript" language="Javascript">
 $loginscript  $loginscript
 <h3>Change Current Login Data</h3>  </script>
 $generalrule  <h3>$lt{'ccld'}</h3>
 $authformnop  <p>$generalrule</p>
 $authformcurrent  <p>$authformnop</p>
 <h3>Enter New Login Data</h3>  <p>$authformcurrent</p>
 $authformother  <h3>$lt{'enld'}</h3>
 END  $authform_other
        }  ENDOTHERAUTHS
     }              }
     $r->print('<hr /><h3>Add Roles</h3>');          }  ## End of "check for bad authentication type" logic
       } ## End of new user/old user logic
       $r->print('<hr /><h3>'.&mt('Add Roles').'</h3>');
 #  #
 # 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'};
      my %lt=&Apache::lonlocal::texthash(
       'cs'   => "Construction Space",
                       'act'  => "Activate",                    
                       'rol'  => "Role",
                       'ext'  => "Extent",
                       'sta'  => "Start",
                       'end'  => "End",
                       'cau'  => "Co-Author",
                       'ssd'  => "Set Start Date",
                       'sed'  => "Set End Date"
          );
        $r->print(<<ENDCOAUTH);         $r->print(<<ENDCOAUTH);
 <h4>Construction Space</h4>  <h4>$lt{'cs'}</h4>
 <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>  <table border=2><tr><th>$lt{'act'}</th><th>$lt{'rol'}</th><th>$lt{'ext'}</th>
 <th>Start</th><th>End</th></tr>  <th>$lt{'sta'}</th><th>$lt{'end'}</th></tr>
 <tr>  <tr>
 <td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td>  <td><input type=checkbox name="act_$cudom\_$cuname\_ca" /></td>
 <td>Co-Author</td>  <td>$lt{'cau'}</td>
 <td>$cudom\_$cuname</td>  <td>$cudom\_$cuname</td>
 <td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''>  <td><input type=hidden name="start_$cudom\_$cuname\_ca" value='' />
 <a href=  <a href=
 "javascript:pjump('date_start','Start Date Co-Author',document.cu.start_$cudom\_$cuname\_ca.value,'start_$cudom\_$cuname\_ca','cu.pres','dateset')">Set Start Date</a></td>  "javascript:pjump('date_start','Start Date Co-Author',document.cu.start_$cudom\_$cuname\_ca.value,'start_$cudom\_$cuname\_ca','cu.pres','dateset')">$lt{'ssd'}</a></td>
 <td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''>  <td><input type=hidden name="end_$cudom\_$cuname\_ca" value='' />
 <a href=  <a href=
 "javascript:pjump('date_end','End Date Co-Author',document.cu.end_$cudom\_$cuname\_ca.value,'end_$cudom\_$cuname\_ca','cu.pres','dateset')">Set End Date</a></td>  "javascript:pjump('date_end','End Date Co-Author',document.cu.end_$cudom\_$cuname\_ca.value,'end_$cudom\_$cuname\_ca','cu.pres','dateset')">$lt{'sed'}</a></td>
 </tr>  </tr>
 </table>  </table>
 ENDCOAUTH  ENDCOAUTH
Line 461  ENDCOAUTH Line 649  ENDCOAUTH
 #  #
 # Domain level  # Domain level
 #  #
     $r->print('<h4>Domain Level</h4>'.      $r->print('<h4>'.&mt('Domain Level').'</h4>'.
     '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.      '<table border=2><tr><th>'.&mt('Activate').'</th><th>'.&mt('Role').'</th><th>'.&mt('Extent').'</th>'.
     '<th>Start</th><th>End</th></tr>');      '<th>'.&mt('Start').'</th><th>'.&mt('End').'</th></tr>');
     map {      foreach ( sort( keys(%incdomains))) {
  my $thisdomain=$_;   my $thisdomain=$_;
         map {          foreach ('dc','li','dg','au','sc') {
             if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {              if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {
                my $plrole=&Apache::lonnet::plaintext($_);                 my $plrole=&Apache::lonnet::plaintext($_);
          my %lt=&Apache::lonlocal::texthash(
                       'ssd'  => "Set Start Date",
                       'sed'  => "Set End Date"
          );
                $r->print(<<ENDDROW);                 $r->print(<<ENDDROW);
 <tr>  <tr>
 <td><input type=checkbox name="act_$thisdomain\_$_"></td>  <td><input type=checkbox name="act_$thisdomain\_$_"></td>
Line 476  ENDCOAUTH Line 668  ENDCOAUTH
 <td>$thisdomain</td>  <td>$thisdomain</td>
 <td><input type=hidden name="start_$thisdomain\_$_" value=''>  <td><input type=hidden name="start_$thisdomain\_$_" value=''>
 <a href=  <a href=
 "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td>  "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">$lt{'ssd'}</a></td>
 <td><input type=hidden name="end_$thisdomain\_$_" value=''>  <td><input type=hidden name="end_$thisdomain\_$_" value=''>
 <a href=  <a href=
 "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td>  "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">$lt{'sed'}</a></td>
 </tr>  </tr>
 ENDDROW  ENDDROW
             }              }
         } ('dc','li','dg','au');          } 
     } sort keys %incdomains;      }
     $r->print('</table>');      $r->print('</table>');
 #  #
 # Course level  # Course level
 #  #
     $r->print('<h4>Course Level</h4>'.      $r->print(&course_level_table(%inccourses));
     '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.      $r->print("<hr /><input type=submit value=\"".&mt('Modify User')."\">\n");
     '<th>Group/Section</th><th>Start</th><th>End</th></tr>');      $r->print("</form></body></html>");
     map {  
  my $thiscourse=$_;  
  my $protectedcourse=$_;  
         $thiscourse=~s:_:/:g;  
         my %coursedata=&Apache::lonnet::coursedescription($thiscourse);  
         my $area=$coursedata{'description'};  
         my $bgcol=$thiscourse;  
         $bgcol=~s/[^8-9b-e]//g;  
         $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);  
         map {  
             if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {  
                my $plrole=&Apache::lonnet::plaintext($_);  
                $r->print("  
 <tr bgcolor=#$bgcol>  
 <td><input type=checkbox name=\"act_$protectedcourse\_$_\"></td>  
 <td>$plrole</td>  
 <td>$area</td>  
 <td>");  
        if ($_ ne 'cc') {  
  $r->print("<input type=text size=5 name=\"sec_$protectedcourse\_$_\">");  
        } else { $r->print("&nbsp"); }  
        $r->print(<<ENDROW);  
 <td><input type=hidden name="start_$protectedcourse\_$_" value=''>  
 <a href=  
 "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td>  
 <td><input type=hidden name="end_$protectedcourse\_$_" value=''>  
 <a href=  
 "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td>  
 </tr>  
 ENDROW  
             }  
         } ('st','ta','ep','ad','in','cc');  
     } sort keys %inccourses;  
     $r->print('</table>');  
     $r->print('<input type=submit value="Modify User">');  
     $r->print('</form></body></html>');  
 }  }
   
 # ================================================================= Phase Three  # ================================================================= Phase Three
   sub update_user_data {
 sub phase_three {  
     my $r=shift;      my $r=shift;
       my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'},
                                             $ENV{'form.ccdomain'});
       # Error messages
       my $error     = '<font color="#ff0000">'.&mt('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.&mt('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.&mt('Invalid login name').'.  '.
            $amode='krb4';    &mt('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.&mt('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.&mt ('Invalid domain name').'.  '.
     $genpwd=$ENV{'form.locarg'};    &mt('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.&mt('Unable to determine home server for ').
                         $ENV{'form.ccuname'}.&mt(' 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.&mt('Invalid login mode or password').$end);    
       return;
       }
       if ($ENV{'form.makeuser'}) {
           # Create a new user
    my %lt=&Apache::lonlocal::texthash(
                       'cru'  => "Creating user",                    
                       'id'   => "in domain"
      );
    $r->print(<<ENDNEWUSERHEAD);
   <h3>$lt{'cru'} "$ENV{'form.ccuname'}" $lt{'id'} "$ENV{'form.ccdomain'}"</h3>
   ENDNEWUSERHEAD
           # Check for the authentication mode and password
           if (! $amode || ! $genpwd) {
       $r->print($error.&mt('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.&mt('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(&mt('Generating user').': '.$result);
           my $home = &Apache::lonnet::homeserver($ENV{'form.ccuname'},
                                                  $ENV{'form.ccdomain'});
           $r->print('<br />'.&mt('Home server').': '.$home.' '.
                     $Apache::lonnet::libserv{$home});
       } elsif (($ENV{'form.login'} ne 'nochange') &&
                ($ENV{'form.login'} ne ''        )) {
    # Modify user privileges
       my %lt=&Apache::lonlocal::texthash(
                       'usr'  => "User",                    
                       'id'   => "in domain"
          );
    $r->print(<<ENDMODIFYUSERHEAD);
   <h2>$lt{'usr'} "$ENV{'form.ccuname'}" $lt{'id'} "$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>'.&mt('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.&mt('You do not have the authority to modify this users authentification information').'.');    
     } else {  
         $r->print('Invalid username or domain');  
     }  
    }  
     my $now=time;  
     $r->print('<h3>Modifying Roles</h3>');  
     map {  
  if (($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {  
            $r->print('Revoking '.$2.' in '.$1.': '.  
           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},  
                                       $1,$2,$now).'<br>');  
            if ($2 eq 'st') {  
                $1=~/^\/(\w+)\/(\w+)/;  
                my $cid=$1.'_'.$2;  
        $r->print('Drop from classlist: '.  
           &Apache::lonnet::critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.  
               $ENV{'course.'.$cid.'.num'}.':classlist:'.  
                       &Apache::lonnet::escape($ENV{'form.cuname'}.':'.  
                                               $ENV{'form.cdomain'}).'='.  
                       &Apache::lonnet::escape($now.':'),  
               $ENV{'course.'.$cid.'.home'}).'<br>');  
            }  
  }   }
     } keys %ENV;      }
     map {      ##
  if (($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {      if (! $ENV{'form.makeuser'} ) {
             my $url='/'.$1.'/'.$2;          # Check for need to change
             if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {          my %userenv = &Apache::lonnet::get
  $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};              ('environment',['firstname','middlename','lastname','generation'],
             }               $ENV{'form.ccdomain'},$ENV{'form.ccuname'});
             my $start=$now;          my ($tmp) = keys(%userenv);
             if ($ENV{'form.start_'.$1.'_'.$2.'_'.$3}) {          if ($tmp =~ /^(con_lost|error)/i) { 
  $start=$ENV{'form.start_'.$1.'_'.$2.'_'.$3};              %userenv = ();
             }          }
             my $end=0;          # Check to see if we need to change user information
             if ($ENV{'form.end_'.$1.'_'.$2.'_'.$3}) {          foreach ('firstname','middlename','lastname','generation') {
  $end=$ENV{'form.end_'.$1.'_'.$2.'_'.$3};              # 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
    my %lt=&Apache::lonlocal::texthash(
                                'uic'  => "User Information Changed",             
                                'frst' => "first",
                                'mddl' => "middle",
                                'lst'  => "last",
        'gen'  => "generation",
                                'prvs' => "Previous",
                                'chto' => "Changed To"
      );
                   $r->print(<<"END");
   <table border="2">
   <caption>$lt{'uic'}</caption>
   <tr><th>&nbsp;</th>
       <th>$lt{'frst'}</th>
       <th>$lt{'mddl'}</th>
       <th>$lt{'lst'}</th>
       <th>$lt{'gen'}</th></tr>
   <tr><td>$lt{'prvs'}</td>
       <td>$userenv{'firstname'}  </td>
       <td>$userenv{'middlename'} </td>
       <td>$userenv{'lastname'}   </td>
       <td>$userenv{'generation'} </td></tr>
   <tr><td>$lt{'chto'}</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>".&mt('Unable to successfully change environment for')." ".
                         $ENV{'form.ccuname'}." ".&mt('in domain')." ".
                         $ENV{'form.ccdomain'}."</h2>");
             }              }
             $r->print('Assigning: '.$3.' in '.$url.': '.          }  else { # End of if ($ENV ... ) logic
           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},              # They did not want to change the users name but we can
                                       $url,$3,$end,$start).'<br>');              # still tell them what the name is
             if ($3 eq 'st') {      my %lt=&Apache::lonlocal::texthash(
  $url=~/^\/(\w+)\/(\w+)/;                             'usr'  => "User",                    
                 my $cid=$1.'_'.$2;                             'id'   => "in domain",
                $r->print('Add to classlist: '.                             'gen'  => "Generation"
           &Apache::lonnet::critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.         );
               $ENV{'course.'.$cid.'.num'}.':classlist:'.                  $r->print(<<"END");
                       &Apache::lonnet::escape($ENV{'form.cuname'}.':'.  <h2>$lt{'usr'} "$ENV{'form.ccuname'}" $lt{'id'} "$ENV{'form.ccdomain'}"</h2>
                                               $ENV{'form.cdomain'}).'='.  <h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4>
                       &Apache::lonnet::escape($end.':'.$start),  <h4>$lt{'gen'}: $userenv{'generation'}</h4>
               $ENV{'course.'.$cid.'.home'}).'<br>');  END
           }
       }
       ##
       my $now=time;
       $r->print('<h3>'.&mt('Modifying Roles').'</h3>');
       foreach (keys (%ENV)) {
    next if (! $ENV{$_});
    # Revoke roles
    if ($_=~/^form\.rev/) {
       if ($_=~/^form\.rev\:([^\_]+)\_([^\_\.]+)$/) {
   # Revoke standard role
           $r->print(&mt('Revoking').' '.$2.' in '.$1.': <b>'.
                        &Apache::lonnet::revokerole($ENV{'form.ccdomain'},
                        $ENV{'form.ccuname'},$1,$2).'</b><br>');
    if ($2 eq 'st') {
       $1=~/^\/(\w+)\/(\w+)/;
       my $cid=$1.'_'.$2;
       $r->print(&mt('Drop from 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($now.':'),
                        $ENV{'course.'.$cid.'.home'}).'</b><br>');
    }
       } 
       if ($_=~/^form\.rev\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) {
   # Revoke custom role
    $r->print(&mt('Revoking custom role').
                         ' '.$4.' by '.$3.'@'.$2.' in '.$1.': <b>'.
                         &Apache::lonnet::revokecustomrole($ENV{'form.ccdomain'},
     $ENV{'form.ccuname'},$1,$2,$3,$4).
    '</b><br>');
     }      }
  } elsif (($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {   } elsif ($_=~/^form\.del/) {
             my $url='/'.$1.'/';      if ($_=~/^form\.del\:([^\_]+)\_([^\_]+)$/) {
             my $start=$now;          $r->print(&mt('Deleting').' '.$2.' in '.$1.': '.
             if ($ENV{'form.start_'.$1.'_'.$2}) {                       &Apache::lonnet::assignrole($ENV{'form.ccdomain'},
  $start=$ENV{'form.start_'.$1.'_'.$2};                       $ENV{'form.ccuname'},$1,$2,$now,0,1).'<br>');
    if ($2 eq 'st') {
       $1=~/^\/(\w+)\/(\w+)/;
       my $cid=$1.'_'.$2;
       $r->print(&mt('Drop from 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($now.':'),
                        $ENV{'course.'.$cid.'.home'}).'</b><br>');
    }
       } 
    } elsif ($_=~/^form\.ren/) {
       if ($_=~/^form\.ren\:([^\_]+)\_([^\_]+)$/) {
    my $result=&Apache::lonnet::assignrole($ENV{'form.ccdomain'},
    $ENV{'form.ccuname'},$1,$2,0,$now);
    $r->print(&mt('Re-Enabling [_1] in [_2]: [_3]',
         $2,$1,$result).'<br />');
    if ($2 eq 'st') {
       $1=~/^\/(\w+)\/(\w+)/;
       my $cid=$1.'_'.$2;
       $r->print(&mt('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(':'.$now),
          $ENV{'course.'.$cid.'.home'})
         .'</b><br>');
    }
       } 
    } elsif ($_=~/^form\.act/) {
       if ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_cr_cr_([^\_]+)_(\w+)_([^\_]+)$/) {
                   # Activate a custom role
    my ($one,$two,$three,$four,$five)=($1,$2,$3,$4,$5);
    my $url='/'.$one.'/'.$two;
    my $full=$one.'_'.$two.'_cr_cr_'.$three.'_'.$four.'_'.$five;
    $ENV{'form.sec_'.$full}=~s/\W//g;
    if ($ENV{'form.sec_'.$full}) {
       $url.='/'.$ENV{'form.sec_'.$full};
    }
   
    my $start = ( $ENV{'form.start_'.$full} ? 
         $ENV{'form.start_'.$full} : 
         $now );
    my $end   = ( $ENV{'form.end_'.$full} ? 
         $ENV{'form.end_'.$full} :
         0 );
   
       $r->print(&mt('Assigning custom role').' "'.$five.'" by '.$four.'@'.$three.' in '.$url.
                            ($start?', '.&mt('starting').' '.localtime($start):'').
                            ($end?', ending '.localtime($end):'').': <b>'.
         &Apache::lonnet::assigncustomrole(
    $ENV{'form.ccdomain'},$ENV{'form.ccuname'},$url,$three,$four,$five,$end,$start).
         '</b><br>');
       } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) {
    # Activate roles for sections with 3 id numbers
    # set start, end times, and the url for the class
    my ($one,$two,$three)=($1,$2,$3);
    my $start = ( $ENV{'form.start_'.$one.'_'.$two.'_'.$three} ? 
         $ENV{'form.start_'.$one.'_'.$two.'_'.$three} : 
         $now );
    my $end   = ( $ENV{'form.end_'.$one.'_'.$two.'_'.$three} ? 
         $ENV{'form.end_'.$one.'_'.$two.'_'.$three} :
         0 );
    my $url='/'.$one.'/'.$two;
    $ENV{'form.sec_'.$one.'_'.$two.'_'.$three}=~s/\W//g;
    if ($ENV{'form.sec_'.$one.'_'.$two.'_'.$three}) {
       $url.='/'.$ENV{'form.sec_'.$one.'_'.$two.'_'.$three};
    }
    # Assign the role and report it
    $r->print(&mt('Assigning').' '.$three.' in '.$url.
                            ($start?', '.&mt('starting').' '.localtime($start):'').
                            ($end?', '.&mt('ending').' '.localtime($end):'').': <b>'.
                             &Apache::lonnet::assignrole(
                                 $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
                                 $url,$three,$end,$start).
     '</b><br>');
    # Handle students differently
    if ($three eq 'st') {
       $url=~/^\/(\w+)\/(\w+)/;
       my $cid=$one.'_'.$two;
       $r->print(&mt('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(&mt('Assigning').' '.$2.' in '.$url.': '.
                            ($start?', '.&mt('starting').' '.localtime($start):'').
                            ($end?', '.&mt('ending').' '.localtime($end):'').': <b>'.
                             &Apache::lonnet::assignrole(
                                 $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
                                 $url,$2,$end,$start)
     .'</b><br>');
       } else {
    $r->print('<p>'.&mt('ERROR').': '.&mt('Unknown command').' <tt>'.$_.'</tt></p><br>');
             }              }
             my $end=0;   } 
             if ($ENV{'form.end_'.$1.'_'.$2}) {      } # End of foreach (keys(%ENV))
  $end=$ENV{'form.end_'.$1.'_'.$2};  # Flush the course logs so reverse user roles immediately updated
             }      &Apache::lonnet::flushcourselogs();
             $r->print('Assigning: '.$2.' in '.$url.': '.      $r->print('</body></html>');
           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},  }
                                       $url,$2,$end,$start).'<br>');  
         }  # ========================================================== Custom Role Editor
     } keys %ENV;  
   sub custom_role_editor {
       my $r=shift;
       my $rolename=$ENV{'form.rolename'};
   
       if ($rolename eq 'make new role') {
    $rolename=$ENV{'form.newrolename'};
       }
   
       $rolename=~s/[^A-Za-z0-9]//gs;
   
       unless ($rolename) {
    &print_username_entry_form($r);
           return;
       }
   
       $r->print(&Apache::loncommon::bodytag(
                        'Create Users, Change User Privileges').'<h2>');
       my $syspriv='';
       my $dompriv='';
       my $coursepriv='';
       my ($rdummy,$roledef)=
    &Apache::lonnet::get('roles',["rolesdef_$rolename"]);
   # ------------------------------------------------------- Does this role exist?
       if (($rdummy ne 'con_lost') && ($roledef ne '')) {
    $r->print(&mt('Existing Role').' "');
   # ------------------------------------------------- Get current role privileges
    ($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
       } else {
    $r->print(&mt('New Role').' "');
    $roledef='';
       }
       $r->print($rolename.'"</h2>');
   # ------------------------------------------------------- What can be assigned?
       my %full=();
       my %courselevel=();
       my %courselevelcurrent=();
       foreach (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
    my ($priv,$restrict)=split(/\&/,$_);
           unless ($restrict) { $restrict='F'; }
           $courselevel{$priv}=$restrict;
           if ($coursepriv=~/\:$priv/) {
       $courselevelcurrent{$priv}=1;
    }
    $full{$priv}=1;
       }
       my %domainlevel=();
       my %domainlevelcurrent=();
       foreach (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
    my ($priv,$restrict)=split(/\&/,$_);
           unless ($restrict) { $restrict='F'; }
           $domainlevel{$priv}=$restrict;
           if ($dompriv=~/\:$priv/) {
       $domainlevelcurrent{$priv}=1;
    }
    $full{$priv}=1;
       }
       my %systemlevel=();
       my %systemlevelcurrent=();
       foreach (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
    my ($priv,$restrict)=split(/\&/,$_);
           unless ($restrict) { $restrict='F'; }
           $systemlevel{$priv}=$restrict;
           if ($syspriv=~/\:$priv/) {
       $systemlevelcurrent{$priv}=1;
    }
    $full{$priv}=1;
       }
       my %lt=&Apache::lonlocal::texthash(
       'prv'  => "Privilege",
       'crl'  => "Course Level",
                       'dml'  => "Domain Level",
                       'ssl'  => "System Level"
          );
       $r->print(<<ENDCCF);
   <form method="post">
   <input type="hidden" name="phase" value="set_custom_roles" />
   <input type="hidden" name="rolename" value="$rolename" />
   <table border="2">
   <tr><th>$lt{'prv'}</th><th>$lt{'crl'}</th><th>$lt{'dml'}</th>
   <th>$lt{'ssl'}</th></tr>
   ENDCCF
       foreach (sort keys %full) {
    $r->print('<tr><td>'.&Apache::lonnet::plaintext($_).'</td><td>'.
       ($courselevel{$_}?'<input type="checkbox" name="'.$_.':c" '.
       ($courselevelcurrent{$_}?'checked="1"':'').' />':'&nbsp;').
       '</td><td>'.
       ($domainlevel{$_}?'<input type="checkbox" name="'.$_.':d" '.
       ($domainlevelcurrent{$_}?'checked="1"':'').' />':'&nbsp;').
       '</td><td>'.
       ($systemlevel{$_}?'<input type="checkbox" name="'.$_.':s" '.
       ($systemlevelcurrent{$_}?'checked="1"':'').' />':'&nbsp;').
       '</td></tr>');
       }
       $r->print(
      '<table><input type="submit" value="'.&mt('Define Role').'" /></form></body></html>');
   }
   
   # ---------------------------------------------------------- Call to definerole
   sub set_custom_role {
       my $r=shift;
   
       my $rolename=$ENV{'form.rolename'};
   
       $rolename=~s/[^A-Za-z0-9]//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(&mt('Existing Role').' "');
       } else {
    $r->print(&mt('New Role').' "');
    $roledef='';
       }
       $r->print($rolename.'"</h2>');
   # ------------------------------------------------------- What can be assigned?
       my $sysrole='';
       my $domrole='';
       my $courole='';
   
       foreach (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
    my ($priv,$restrict)=split(/\&/,$_);
           unless ($restrict) { $restrict=''; }
           if ($ENV{'form.'.$priv.':c'}) {
       $courole.=':'.$_;
    }
       }
   
       foreach (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
    my ($priv,$restrict)=split(/\&/,$_);
           unless ($restrict) { $restrict=''; }
           if ($ENV{'form.'.$priv.':d'}) {
       $domrole.=':'.$_;
    }
       }
   
       foreach (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
    my ($priv,$restrict)=split(/\&/,$_);
           unless ($restrict) { $restrict=''; }
           if ($ENV{'form.'.$priv.':s'}) {
       $sysrole.=':'.$_;
    }
       }
       $r->print('<br />Defining Role: '.
      &Apache::lonnet::definerole($rolename,$sysrole,$domrole,$courole));
       if ($ENV{'request.course.id'}) {
           my $url='/'.$ENV{'request.course.id'};
           $url=~s/\_/\//g;
    $r->print('<br />'.&mt('Assigning Role to Self').': '.
         &Apache::lonnet::assigncustomrole($ENV{'user.domain'},
    $ENV{'user.name'},
    $url,
    $ENV{'user.domain'},
    $ENV{'user.name'},
    $rolename));
       }
     $r->print('</body></html>');      $r->print('</body></html>');
 }  }
   
Line 686  sub handler { Line 1245  sub handler {
     my $r = shift;      my $r = shift;
   
     if ($r->header_only) {      if ($r->header_only) {
        $r->content_type('text/html');         &Apache::loncommon::content_type($r,'text/html');
        $r->send_http_header;         $r->send_http_header;
        return OK;         return OK;
     }      }
Line 695  sub handler { Line 1254  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');         &Apache::loncommon::content_type($r,'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);
          } elsif ($ENV{'form.phase'} eq 'set_custom_roles') {
      &set_custom_role($r);
        }         }
    } else {     } else {
       $ENV{'user.error.msg'}=        $ENV{'user.error.msg'}=
Line 715  sub handler { Line 1278  sub handler {
    return OK;     return OK;
 }   } 
   
   #-------------------------------------------------- functions for &phase_two
   sub course_level_table {
       my %inccourses = @_;
       my $table = '';
   # Custom Roles?
   
       my %customroles=&my_custom_roles();
   
       foreach (sort( keys(%inccourses))) {
    my $thiscourse=$_;
    my $protectedcourse=$_;
    $thiscourse=~s:_:/:g;
    my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
    my $area=$coursedata{'description'};
    if (!defined($area)) { $area=&mt('Unavailable course').': '.$_; }
    my $bgcol=$thiscourse;
    $bgcol=~s/[^7-9a-e]//g;
    $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
    my ($domain)=split(/\//,$thiscourse);
    foreach  ('st','ta','ep','ad','in','cc') {
       if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
    my $plrole=&Apache::lonnet::plaintext($_);
    $table .= <<ENDEXTENT;
   <tr bgcolor="#$bgcol">
   <td><input type="checkbox" name="act_$protectedcourse\_$_"></td>
   <td>$plrole</td>
   <td>$area<br />Domain: $domain</td>
   ENDEXTENT
           if ($_ ne 'cc') {
       $table .= <<ENDSECTION;
   <td><input type="text" size="5" name="sec_$protectedcourse\_$_"></td>
   ENDSECTION
                   } else { 
       $table .= <<ENDSECTION;
   <td>&nbsp</td> 
   ENDSECTION
                   }
    my %lt=&Apache::lonlocal::texthash(
                                  'ssd'  => "Set Start Date",
                                  'sed'  => "Set End Date"
      );
    $table .= <<ENDTIMEENTRY;
   <td><input type=hidden name="start_$protectedcourse\_$_" value=''>
   <a href=
   "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">$lt{'ssd'}</a></td>
   <td><input type=hidden name="end_$protectedcourse\_$_" value=''>
   <a href=
   "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">$lt{'sed'}</a></td>
   ENDTIMEENTRY
                   $table.= "</tr>\n";
               }
           }
           foreach (sort keys %customroles) {
       if (&Apache::lonnet::allowed('ccr',$thiscourse)) {
    my $plrole=$_;
                   my $customrole=$protectedcourse.'_cr_cr_'.$ENV{'user.domain'}.
       '_'.$ENV{'user.name'}.'_'.$plrole;
    my %lt=&Apache::lonlocal::texthash(
                                  'ssd'  => "Set Start Date",
                                  'sed'  => "Set End Date"
      );
    $table .= <<ENDENTRY;
   <tr bgcolor="#$bgcol">
   <td><input type="checkbox" name="act_$customrole"></td>
   <td>$plrole</td>
   <td>$area</td>
   <td><input type="text" size="5" name="sec_$customrole"></td>
   <td><input type=hidden name="start_$customrole" value=''>
   <a href=
   "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$customrole.value,'start_$customrole','cu.pres','dateset')">$lt{'ssd'}</a></td>
   <td><input type=hidden name="end_$customrole" value=''>
   <a href=
   "javascript:pjump('date_end','End Date $plrole',document.cu.end_$customrole.value,'end_$customrole','cu.pres','dateset')">$lt{'sed'}</a></td></tr>
   ENDENTRY
              }
    }
       }
       return '' if ($table eq ''); # return nothing if there is nothing 
                                    # in the table
       my %lt=&Apache::lonlocal::texthash(
       'crl'  => "Course Level",
                       'act'  => "Activate",
                       'rol'  => "Role",
                       'ext'  => "Extent",
                       'grs'  => "Group/Section",
                       'sta'  => "Start",
                       'end'  => "End"
          );
       my $result = <<ENDTABLE;
   <h4>$lt{'crl'}</h4>
   <table border=2><tr><th>$lt{'act'}</th><th>$lt{'rol'}</th><th>$lt{'ext'}</th>
   <th>$lt{'grs'}</th><th>$lt{'sta'}</th><th>$lt{'end'}</th></tr>
   $table
   </table>
   ENDTABLE
       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.21  
changed lines
  Added in v.1.84

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