# The LearningOnline Network with CAPA
# Create a user
#
# $Id: loncreateuser.pm,v 1.67 2003/09/17 17:30:10 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# 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.
#
# 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.
#
# 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
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###

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 Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncommon;

my $loginscript; # piece of javascript used in two separate instances
my $generalrule;
my $authformnop;
my $authformkrb;
my $authformint;
my $authformfsys;
my $authformloc;

BEGIN {
    $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
    my $krbdefdom=$1;
    $krbdefdom=~tr/a-z/A-Z/;
    my %param = ( formname => 'document.cu',
                  kerb_def_dom => $krbdefdom 
                  );
# no longer static due to configurable kerberos defaults
#    $loginscript  = &Apache::loncommon::authform_header(%param);
    $generalrule  = &Apache::loncommon::authform_authorwarning(%param);
    $authformnop  = &Apache::loncommon::authform_nochange(%param);
# no longer static due to configurable kerberos defaults
#    $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
    $authformint  = &Apache::loncommon::authform_internal(%param);
    $authformfsys = &Apache::loncommon::authform_filesystem(%param);
    $authformloc  = &Apache::loncommon::authform_local(%param);
}


# ======================================================= Existing Custom Roles

sub my_custom_roles {
    my %returnhash=();
    my %rolehash=&Apache::lonnet::dump('roles');
    foreach (keys %rolehash) {
	if ($_=~/^rolesdef\_(\w+)$/) {
	    $returnhash{$1}=$1;
	}
    }
    return %returnhash;
}

# ==================================================== Figure out author access

sub authorpriv {
    my ($auname,$audom)=@_;
    if (($auname ne $ENV{'user.name'}) ||
        (($audom ne $ENV{'user.domain'}) &&
         ($audom ne $ENV{'request.role.domain'}))) { return ''; }
    unless (&Apache::lonnet::allowed('cca',$audom)) { return ''; }
    return 1;
}

# =================================================================== Phase one

sub print_username_entry_form {
    my $r=shift;
    my $defdom=$ENV{'request.role.domain'};
    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>
<head>
<title>The LearningOnline Network with CAPA</title>
$selscript
</head>
$bodytag
<form action="/adm/createuser" method="post" name="crtuser">
<input type="hidden" name="phase" value="get_user_info">
<h2>Set Individual User Roles</h2>
<table>
<tr><td>Username:</td><td><input type="text" size="15" name="ccuname">
</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 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>
</html>
ENDDOCUMENT
}

# =================================================================== Phase two
sub print_user_modification_page {
    my $r=shift;
    my $ccuname=$ENV{'form.ccuname'};
    my $ccdomain=$ENV{'form.ccdomain'};

    $ccuname=~s/\W//gs;
    $ccdomain=~s/\W//gs;

    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 %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;
    $ccdomain=~s/\W//g;
    my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
    my $dochead =<<"ENDDOCHEAD";
<html>
<head>
<title>The LearningOnline Network with CAPA</title>
<script type="text/javascript" language="Javascript">

    function pclose() {
        parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                 "height=350,width=350,scrollbars=no,menubar=no");
        parmwin.close();
    }

    $pjump_def

    function dateset() {
        eval("document.cu."+document.cu.pres_marker.value+
            ".value=document.cu.pres_value.value");
        pclose();
    }

</script>
</head>
ENDDOCHEAD
    $r->print(&Apache::loncommon::bodytag(
                                     'Create Users, Change User Privileges'));
    my $forminfo =<<"ENDFORMINFO";
<form action="/adm/createuser" method="post" name="cu">
<input type="hidden" name="phase"       value="update_user_data">
<input type="hidden" name="ccuname"     value="$ccuname">
<input type="hidden" name="ccdomain"    value="$ccdomain">
<input type="hidden" name="pres_value"  value="" >
<input type="hidden" name="pres_type"   value="" >
<input type="hidden" name="pres_marker" value="" >
ENDFORMINFO
    my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
    my %incdomains; 
    my %inccourses;
    foreach (values(%Apache::lonnet::hostdom)) {
       $incdomains{$_}=1;
    }
    foreach (keys(%ENV)) {
	if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {
	    $inccourses{$1.'_'.$2}=1;
        }
    }
    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);
$dochead
<h1>Create New User</h1>
$forminfo
<h2>New user "$ccuname" in domain $ccdomain</h2>
<script type="text/javascript" language="Javascript">
$loginscript
</script>
<input type='hidden' name='makeuser' value='1' />
<h3>Personal Data</h3>
<p>
<table>
<tr><td>First Name  </td>
    <td><input type='text' name='cfirst'  size='15' /></td></tr>
<tr><td>Middle Name </td> 
    <td><input type='text' name='cmiddle' size='15' /></td></tr>
<tr><td>Last Name   </td>
    <td><input type='text' name='clast'   size='15' /></td></tr>
<tr><td>Generation  </td>
    <td><input type='text' name='cgen'    size='5'  /></td></tr>
</table>
ID/Student Number <input type='text' name='cstid'   size='15' /></p>
Home Server: <select name="hserver" size="1"> $home_server_list </select>
<hr />
<h3>Login Data</h3>
<p>$generalrule </p>
<p>$authformkrb </p>
<p>$authformint </p>
<p>$authformfsys</p>
<p>$authformloc </p>
ENDNEWUSER
    } else { # user already exists
	$r->print(<<ENDCHANGEUSER);
$dochead
<h1>Change User Privileges</h1>
$forminfo
<h2>User "$ccuname" in domain "$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>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.
        my ($tmp) = keys(%rolesdump);
        unless ($tmp =~ /^(con_lost|error)/i) {
           my $now=time;
           $r->print(<<END);
<hr />
<h3>Revoke Existing Roles</h3>
<table border=2>
<tr><th>Revoke</th><th>Delete</th><th>Role</th><th>Extent</th><th>Start</th><th>End</th>
END
	   foreach my $area (sort { my $a1=join('_',(split('_',$a))[1,0]);
				    my $b1=join('_',(split('_',$b))[1,0]);
				    return $a1 cmp $b1;
				} keys(%rolesdump)) {
               next if ($area =~ /^rolesdef/);
               my $role = $rolesdump{$area};
               my $thisrole=$area;
               $area =~ s/\_\w\w$//;
               my ($role_code,$role_end_time,$role_start_time) = 
                   split(/_/,$role);
# Is this a custom role? Get role owner and title.
	       my ($croleudom,$croleuname,$croletitle)=
	           ($role_code=~/^cr\/(\w+)\/(\w+)\/(\w+)$/);
               my $bgcol='ffffff';
               my $allowed=0;
               my $delallowed=0;
               if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {
                   my ($coursedom,$coursedir) = ($1,$2);
                   # $1.'_'.$2 is the course id (eg. 103_12345abcef103l3).
                   my %coursedata=
                       &Apache::lonnet::coursedescription($1.'_'.$2);
		   my $carea;
		   if (defined($coursedata{'description'})) {
		       $carea='Course: '.$coursedata{'description'}.
                           '<br />Domain: '.$coursedom.('&nbsp;'x8).
     &Apache::loncommon::syllabuswrapper('Syllabus',$coursedir,$coursedom);
		   } else {
		       $carea='Unavailable course: '.$area;
		   }
                   $inccourses{$1.'_'.$2}=1;
                   if ((&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) ||
                       (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
                       $allowed=1;
                   }
                   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 {
                   # 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') {
                   $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;';
               }
	       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";
               $r->print($row);
           } # end of foreach        (table building loop)
	   $r->print('</table>');
        }  # End of unless
	my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
	if ($currentauth=~/^krb(4|5):/) {
	    $currentauth=~/^krb(4|5):(.*)/;
	    my $krbdefdom=$1;
            my %param = ( formname => 'document.cu',
                          kerb_def_dom => $krbdefdom 
                          );
            $loginscript  = &Apache::loncommon::authform_header(%param);
	}
	# Check for a bad authentication type
        unless ($currentauth=~/^krb(4|5):/ or
		$currentauth=~/^unix:/ or
		$currentauth=~/^internal:/ or
		$currentauth=~/^localauth:/
		) { # bad authentication scheme
	    if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
		$r->print(<<ENDBADAUTH);
<hr />
<script type="text/javascript" language="Javascript">
$loginscript
</script>
<font color='#ff0000'>ERROR:</font>
This user has an unrecognized authentication scheme ($currentauth).
Please specify login data below.
<h3>Login Data</h3>
<p>$generalrule</p>
<p>$authformkrb</p>
<p>$authformint</p>
<p>$authformfsys</p>
<p>$authformloc</p>
ENDBADAUTH
            } else { 
                # This user is not allowed to modify the users 
                # authentication scheme, so just notify them of the problem
		$r->print(<<ENDBADAUTH);
<hr />
<script type="text/javascript" language="Javascript">
$loginscript
</script>
<font color="#ff0000"> ERROR: </font>
This user has an unrecognized authentication scheme ($currentauth).
Please alert a domain coordinator of this situation.
<hr />
ENDBADAUTH
            }
        } else { # Authentication type is valid
	    my $authformcurrent='';
	    my $authform_other='';
	    if ($currentauth=~/^krb(4|5):/) {
		$authformcurrent=$authformkrb;
		$authform_other="<p>$authformint</p>\n".
                    "<p>$authformfsys</p><p>$authformloc</p>";
	    }
	    elsif ($currentauth=~/^internal:/) {
		$authformcurrent=$authformint;
		$authform_other="<p>$authformkrb</p>".
                    "<p>$authformfsys</p><p>$authformloc</p>";
	    }
	    elsif ($currentauth=~/^unix:/) {
		$authformcurrent=$authformfsys;
		$authform_other="<p>$authformkrb</p>".
                    "<p>$authformint</p><p>$authformloc;</p>";
	    }
	    elsif ($currentauth=~/^localauth:/) {
		$authformcurrent=$authformloc;
		$authform_other="<p>$authformkrb</p>".
                    "<p>$authformint</p><p>$authformfsys</p>";
	    }
            $authformcurrent.=' <i>(will override current values)</i><br />';
            if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
		# Current user has login modification privileges
		$r->print(<<ENDOTHERAUTHS);
<hr />
<script type="text/javascript" language="Javascript">
$loginscript
</script>
<h3>Change Current Login Data</h3>
<p>$generalrule</p>
<p>$authformnop</p>
<p>$authformcurrent</p>
<h3>Enter New Login Data</h3>
$authform_other
ENDOTHERAUTHS
            }
        }  ## End of "check for bad authentication type" logic
    } ## End of new user/old user logic
    $r->print('<hr /><h3>Add Roles</h3>');
#
# Co-Author
# 
    if (&authorpriv($ENV{'user.name'},$ENV{'request.role.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 $cudom=$ENV{'request.role.domain'};
       $r->print(<<ENDCOAUTH);
<h4>Construction Space</h4>
<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
<th>Start</th><th>End</th></tr>
<tr>
<td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td>
<td>Co-Author</td>
<td>$cudom\_$cuname</td>
<td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''>
<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>
<td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''>
<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>
</tr>
</table>
ENDCOAUTH
    }
#
# Domain level
#
    $r->print('<h4>Domain Level</h4>'.
    '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.
    '<th>Start</th><th>End</th></tr>');
    foreach ( sort( keys(%incdomains))) {
	my $thisdomain=$_;
        foreach ('dc','li','dg','au') {
            if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {
               my $plrole=&Apache::lonnet::plaintext($_);
               $r->print(<<ENDDROW);
<tr>
<td><input type=checkbox name="act_$thisdomain\_$_"></td>
<td>$plrole</td>
<td>$thisdomain</td>
<td><input type=hidden name="start_$thisdomain\_$_" value=''>
<a href=
"javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td>
<td><input type=hidden name="end_$thisdomain\_$_" value=''>
<a href=
"javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td>
</tr>
ENDDROW
            }
        } 
    }
    $r->print('</table>');
#
# Course level
#
    $r->print(&course_level_table(%inccourses));
    $r->print("<hr /><input type=submit value=\"Modify User\">\n");
    $r->print("</form></body></html>");
}

# ================================================================= Phase Three
sub update_user_data {
    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);
<html>
<head>
<title>The LearningOnline Network with CAPA</title>
</head>
ENDTHREEHEAD
    my $title;
    if (exists($ENV{'form.makeuser'})) {
	$title='Set Privileges for New User';
    } else {
        $title='Modify User Privileges';
    }
    $r->print(&Apache::loncommon::bodytag($title));
    # Check Inputs
    if (! $ENV{'form.ccuname'} ) {
	$r->print($error.'No login name specified.'.$end);
	return;
    }
    if (  $ENV{'form.ccuname'}  =~/\W/) {
	$r->print($error.'Invalid login name.  '.
		  'Only letters, numbers, and underscores are valid.'.
		  $end);
	return;
    }
    if (! $ENV{'form.ccdomain'}       ) {
	$r->print($error.'No domain specified.'.$end);
	return;
    }
    if (  $ENV{'form.ccdomain'} =~/\W/) {
	$r->print($error.'Invalid domain name.  '.
		  'Only letters, numbers, and underscores are valid.'.
		  $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;
	}
        # 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: '.
                      &Apache::lonnet::modifyuserauth(
		       $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
                       $amode,$genpwd));
            $r->print('<br>Home server: '.&Apache::lonnet::homeserver
		  ($ENV{'form.ccuname'},$ENV{'form.ccdomain'}));
	} else {
	    # Okay, this is a non-fatal error.
	    $r->print($error.'You do not have the authority to modify '.
		      'this users authentification information.');    
	}
    }
    ##
    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;
    $r->print('<h3>Modifying Roles</h3>');
    foreach (keys (%ENV)) {
	next if (! $ENV{$_});
	# Revoke roles
	if ($_=~/^form\.rev/) {
	    if ($_=~/^form\.rev\:([^\_]+)\_([^\_\.]+)$/) {
# Revoke standard role
	        $r->print('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('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(
                '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\.del/) {
	    if ($_=~/^form\.del\:([^\_]+)\_([^\_]+)$/) {
	        $r->print('Deleting '.$2.' in '.$1.': '.
                     &Apache::lonnet::assignrole($ENV{'form.ccdomain'},
                     $ENV{'form.ccuname'},$1,$2,$now,0,1).'<br>');
		if ($2 eq 'st') {
		    $1=~/^\/(\w+)\/(\w+)/;
		    my $cid=$1.'_'.$2;
		    $r->print('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\.act/) {
	    if 
($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_cr_cr_([^\_]+)_(\w+)_([^\_]+)$/) {
                # Activate a custom role
		my $url='/'.$1.'/'.$2;
		my $full=$1.'_'.$2.'_cr_cr_'.$3.'_'.$4.'_'.$5;
		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('Assigning custom role "'.$5.'" by '.$4.'@'.$3.' in '.$url.
                         ($start?', starting '.localtime($start):'').
                         ($end?', ending '.localtime($end):'').': <b>'.
	      &Apache::lonnet::assigncustomrole(
	$ENV{'form.ccdomain'},$ENV{'form.ccuname'},$url,$3,$4,$5,$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 $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>');
	    } else {
		$r->print('<p>ERROR: Unknown command <tt>'.$_.'</tt></p><br>');
            }
	} 
    } # End of foreach (keys(%ENV))
    $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/[^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('Existing Role "');
# ------------------------------------------------- Get current role privileges
	($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
    } else {
	$r->print('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;
    }
    $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>Privilege</th><th>Course Level</th><th>Domain Level</th>
<th>System Level</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="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('Existing Role "');
    } else {
	$r->print('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 />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>');
}

# ================================================================ Main Handler
sub handler {
    my $r = shift;

    if ($r->header_only) {
       $r->content_type('text/html');
       $r->send_http_header;
       return OK;
    }

    if ((&Apache::lonnet::allowed('cta',$ENV{'request.course.id'})) ||
        (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) || 
        (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) || 
        (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||
        (&Apache::lonnet::allowed('cca',$ENV{'request.role.domain'})) ||
        (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'}))) {
       $r->content_type('text/html');
       $r->send_http_header;
       unless ($ENV{'form.phase'}) {
	   &print_username_entry_form($r);
       }
       if ($ENV{'form.phase'} eq 'get_user_info') {
           &print_user_modification_page($r);
       } elsif ($ENV{'form.phase'} eq 'update_user_data') {
           &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 {
      $ENV{'user.error.msg'}=
        "/adm/createuser:mau:0:0:Cannot modify user data";
      return HTTP_NOT_ACCEPTABLE; 
   }
   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='Unavailable course: '.$_; }
	my $bgcol=$thiscourse;
	$bgcol=~s/[^7-9a-e]//g;
	$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
	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</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
                }
		$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')">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>
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;
		$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')">Set Start Date</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')">Set End Date</a></td></tr>
ENDENTRY
           }
	}
    }
    return '' if ($table eq ''); # return nothing if there is nothing 
                                 # in the table
    my $result = <<ENDTABLE;
<h4>Course Level</h4>
<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
<th>Group/Section</th><th>Start</th><th>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;
__END__