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

Diff for /loncom/interface/loncreateuser.pm between versions 1.47 and 1.66

version 1.47, 2003/02/03 18:03:52 version 1.66, 2003/07/25 01:18:04
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # (Create a course  
 # (My Desk  
 #  
 # (Internal Server Error Handler  
 #  
 # (Login Screen  
 # 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  
 # 3/1/1 Gerd Kortemeyer)  
 #  
 # 3/1 Gerd Kortemeyer)  
 #  
 # 2/14 Gerd Kortemeyer)  
 #  
 # 2/14,2/17,2/19,2/20,2/21,2/22,2/23,3/2,3/17,3/24,04/12 Gerd Kortemeyer  
 # April Guy Albertelli  
 # 05/10,10/16 Gerd Kortemeyer   
 # 02/11/02 Matthew Hall  
 #  
 # $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;
   
 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 70  BEGIN { Line 79  BEGIN {
     my %param = ( formname => 'document.cu',      my %param = ( formname => 'document.cu',
                   kerb_def_dom => $krbdefdom                     kerb_def_dom => $krbdefdom 
                   );                    );
     $loginscript  = &Apache::loncommon::authform_header(%param);  # no longer static due to configurable kerberos defaults
   #    $loginscript  = &Apache::loncommon::authform_header(%param);
     $generalrule  = &Apache::loncommon::authform_authorwarning(%param);      $generalrule  = &Apache::loncommon::authform_authorwarning(%param);
     $authformnop  = &Apache::loncommon::authform_nochange(%param);      $authformnop  = &Apache::loncommon::authform_nochange(%param);
     $authformkrb  = &Apache::loncommon::authform_kerberos(%param);  # no longer static due to configurable kerberos defaults
   #    $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
     $authformint  = &Apache::loncommon::authform_internal(%param);      $authformint  = &Apache::loncommon::authform_internal(%param);
     $authformfsys = &Apache::loncommon::authform_filesystem(%param);      $authformfsys = &Apache::loncommon::authform_filesystem(%param);
     $authformloc  = &Apache::loncommon::authform_local(%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  # ==================================================== Figure out author access
   
Line 104  sub print_username_entry_form { Line 127  sub print_username_entry_form {
     my $selscript=&Apache::loncommon::studentbrowser_javascript();      my $selscript=&Apache::loncommon::studentbrowser_javascript();
     my $sellink=&Apache::loncommon::selectstudent_link      my $sellink=&Apache::loncommon::selectstudent_link
                                         ('crtuser','ccuname','ccdomain');                                          ('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");      $r->print(<<"ENDDOCUMENT");
 <html>  <html>
 <head>  <head>
Line 113  $selscript Line 139  $selscript
 $bodytag  $bodytag
 <form action="/adm/createuser" method="post" name="crtuser">  <form action="/adm/createuser" method="post" name="crtuser">
 <input type="hidden" name="phase" value="get_user_info">  <input type="hidden" name="phase" value="get_user_info">
 <p>  <h2>Set Individual User Roles</h2>
 <table>  <table>
 <tr><td>Username:</td><td><input type="text" size="15" name="ccuname">  <tr><td>Username:</td><td><input type="text" size="15" name="ccuname">
 </td><td rowspan="2">$sellink</td></tr><tr><td>  </td><td rowspan="2">$sellink</td></tr><tr><td>
 Domain:</td><td>$domform</td></tr>  Domain:</td><td>$domform</td></tr>
 </table>   </table>
 </p>  <input name="userrole" type="submit" value="User Roles" />
 <input type="submit" value="Continue">  
 </form>  </form>
   <form action="/adm/createuser" method="post" name="docustom">
   <input type="hidden" name="phase" value="selected_custom_edit">
   <h2>Edit Custom Role Privileges</h2>
   Name of Role: $choice <input type="text" size="15" name="newrolename" /><br />
   <input name="customeditor" type="submit" value="Custom Role Editor" />
 </body>  </body>
 </html>  </html>
 ENDDOCUMENT  ENDDOCUMENT
Line 133  sub print_user_modification_page { Line 163  sub print_user_modification_page {
     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 %param = ( formname => 'document.cu',      my %param = ( formname => 'document.cu',
                   kerb_def_dom => $krbdefdom                     kerb_def_dom => $krbdefdom,
                     kerb_def_auth => $krbdef
                   );                    );
     $loginscript  = &Apache::loncommon::authform_header(%param);      $loginscript  = &Apache::loncommon::authform_header(%param);
       $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
     my $defdom=$ENV{'request.role.domain'};  
   
     $ccuname=~s/\W//g;      $ccuname=~s/\W//g;
     $ccdomain=~s/\W//g;      $ccdomain=~s/\W//g;
       my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
     my $dochead =<<"ENDDOCHEAD";      my $dochead =<<"ENDDOCHEAD";
 <html>  <html>
 <head>  <head>
Line 157  sub print_user_modification_page { Line 198  sub print_user_modification_page {
         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 189  ENDFORMINFO Line 223  ENDFORMINFO
     my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);      my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
     my %incdomains;       my %incdomains; 
     my %inccourses;      my %inccourses;
     foreach (%Apache::lonnet::hostdom) {      foreach (values(%Apache::lonnet::hostdom)) {
        $incdomains{$_}=1;         $incdomains{$_}=1;
     }      }
     foreach (keys(%ENV)) {      foreach (keys(%ENV)) {
Line 238  ENDNEWUSER Line 272  ENDNEWUSER
 $dochead  $dochead
 <h1>Change User Privileges</h1>  <h1>Change User Privileges</h1>
 $forminfo  $forminfo
 <h2>User "$ccuname" in domain $ccdomain </h2>  <h2>User "$ccuname" in domain "$ccdomain"</h2>
 ENDCHANGEUSER  ENDCHANGEUSER
         # Get the users information          # Get the users information
         my %userenv = &Apache::lonnet::get('environment',          my %userenv = &Apache::lonnet::get('environment',
Line 256  END Line 290  END
         foreach ('firstname','middlename','lastname','generation') {          foreach ('firstname','middlename','lastname','generation') {
            if (&Apache::lonnet::allowed('mau',$ccdomain)) {             if (&Apache::lonnet::allowed('mau',$ccdomain)) {
               $r->print(<<"END");                            $r->print(<<"END");            
 <td><input type="text" name="c$_" value="$userenv{$_}" size="15"/></td>  <td><input type="text" name="c$_" value="$userenv{$_}" size="15" /></td>
 END  END
            } else {             } else {
                $r->print('<td>'.$userenv{$_}.'</td>');                 $r->print('<td>'.$userenv{$_}.'</td>');
Line 274  END Line 308  END
 <hr />  <hr />
 <h3>Revoke Existing Roles</h3>  <h3>Revoke Existing Roles</h3>
 <table border=2>  <table border=2>
 <tr><th>Revoke</th><th>Role</th><th>Extent</th><th>Start</th><th>End</th>  <tr><th>Revoke</th><th>Delete</th><th>Role</th><th>Extent</th><th>Start</th><th>End</th>
 END  END
    foreach my $area (keys(%rolesdump)) {     foreach my $area (sort keys(%rolesdump)) {
                next if ($area =~ /^rolesdef/);                 next if ($area =~ /^rolesdef/);
                my $role = $rolesdump{$area};                 my $role = $rolesdump{$area};
                my $thisrole=$area;                 my $thisrole=$area;
                $area =~ s/\_\w\w$//;                 $area =~ s/\_\w\w$//;
                my ($role_code,$role_end_time,$role_start_time) =                  my ($role_code,$role_end_time,$role_start_time) = 
                    split(/_/,$role);                     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 $bgcol='ffffff';
                my $allowed=0;                 my $allowed=0;
                  my $delallowed=0;
                if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {                 if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {
                      my ($coursedom,$coursedir) = ($1,$2);
                      # $1.'_'.$2 is the course id (eg. 103_12345abcef103l3).
                    my %coursedata=                     my %coursedata=
                        &Apache::lonnet::coursedescription($1.'_'.$2);                         &Apache::lonnet::coursedescription($1.'_'.$2);
                    my $carea='Course: '.$coursedata{'description'};     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;                     $inccourses{$1.'_'.$2}=1;
                    if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) {                     if ((&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) ||
                          (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
                        $allowed=1;                         $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                     # Compute the background color based on $area
                    $bgcol=$1.'_'.$2;                     $bgcol=$1.'_'.$2;
                    $bgcol=~s/[^8-9b-e]//g;                     $bgcol=~s/[^7-9a-e]//g;
                    $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);                     $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
                    if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {                     if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
                        $carea.='<br>Section/Group: '.$3;                         $carea.='<br>Section/Group: '.$3;
                    }                     }
Line 304  END Line 363  END
                } else {                 } else {
                    # Determine if current user is able to revoke privileges                     # Determine if current user is able to revoke privileges
                    if ($area=~ /^\/(\w+)\//) {                     if ($area=~ /^\/(\w+)\//) {
                        if (&Apache::lonnet::allowed('c'.$role_code,$1)) {                         if ((&Apache::lonnet::allowed('c'.$role_code,$1)) ||
                          (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
                            $allowed=1;                             $allowed=1;
                        }                         }
                          if (((&Apache::lonnet::allowed('dro',$1))  ||
                               (&Apache::lonnet::allowed('dro',$ccdomain))) &&
                              ($role_code ne 'dc')) {
                              $delallowed=1;
                          }
                    } else {                     } else {
                        if (&Apache::lonnet::allowed('c'.$role_code,'/')) {                         if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
                            $allowed=1;                             $allowed=1;
Line 322  END Line 387  END
                    }                     }
                }                 }
                my $row = '';                 my $row = '';
                $row.='<tr bgcolor=#"'.$bgcol.'"><td>';                 $row.='<tr bgcolor="#'.$bgcol.'"><td>';
                my $active=1;                 my $active=1;
                $active=0 if (($role_end_time) && ($now>$role_end_time));                 $active=0 if (($role_end_time) && ($now>$role_end_time));
                if (($active) && ($allowed)) {                 if (($active) && ($allowed)) {
                    $row.= '<input type="checkbox" name="rev:'.$thisrole.'">';                     $row.= '<input type="checkbox" name="rev:'.$thisrole.'">';
                } else {                 } else {
                      if ($active) {
                         $row.='&nbsp;';
      } else {
                         $row.='expired or revoked';
      }
                  }
          $row.='</td><td>';
                  if ($delallowed) {
                      $row.= '<input type="checkbox" name="del:'.$thisrole.'">';
                  } else {
                    $row.='&nbsp;';                     $row.='&nbsp;';
                }                 }
                $row.= '</td><td>'.&Apache::lonnet::plaintext($role_code).         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>'.$area.
                       '</td><td>'.($role_start_time?localtime($role_start_time)                        '</td><td>'.($role_start_time?localtime($role_start_time)
                                                    : '&nbsp;' ).                                                     : '&nbsp;' ).
Line 409  ENDBADAUTH Line 491  ENDBADAUTH
  $authform_other="<p>$authformkrb</p>".   $authform_other="<p>$authformkrb</p>".
                     "<p>$authformint</p><p>$authformfsys</p>";                      "<p>$authformint</p><p>$authformfsys</p>";
     }      }
     $authformcurrent=<<ENDCURRENTAUTH;              $authformcurrent.=' <i>(will override current values)</i><br />';
 <table border='1'>  
 <tr>  
 <td><font color='#ff0000'>* * * WARNING * * *</font></td>  
 <td><font color='#ff0000'>* * * WARNING * * *</font></td>  
 </tr>  
 <tr><td bgcolor='#cbbcbb'>$authformcurrent</td>  
 <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr>  
 </table>  
 ENDCURRENTAUTH  
             if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {              if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
  # Current user has login modification privileges   # Current user has login modification privileges
  $r->print(<<ENDOTHERAUTHS);   $r->print(<<ENDOTHERAUTHS);
Line 709  END Line 782  END
  next if (! $ENV{$_});   next if (! $ENV{$_});
  # Revoke roles   # Revoke roles
  if ($_=~/^form\.rev/) {   if ($_=~/^form\.rev/) {
     if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) {      if ($_=~/^form\.rev\:([^\_]+)\_([^\_\.]+)$/) {
         $r->print('Revoking '.$2.' in '.$1.': '.  # 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'},                       &Apache::lonnet::assignrole($ENV{'form.ccdomain'},
                      $ENV{'form.ccuname'},$1,$2,$now).'<br>');                       $ENV{'form.ccuname'},$1,$2,$now,0,1).'<br>');
  if ($2 eq 'st') {   if ($2 eq 'st') {
     $1=~/^\/(\w+)\/(\w+)/;      $1=~/^\/(\w+)\/(\w+)/;
     my $cid=$1.'_'.$2;      my $cid=$1.'_'.$2;
     $r->print('Drop from classlist: '.      $r->print('Drop from classlist: <b>'.
  &Apache::lonnet::critical('put:'.   &Apache::lonnet::critical('put:'.
                              $ENV{'course.'.$cid.'.domain'}.':'.                               $ENV{'course.'.$cid.'.domain'}.':'.
                      $ENV{'course.'.$cid.'.num'}.':classlist:'.                       $ENV{'course.'.$cid.'.num'}.':classlist:'.
                          &Apache::lonnet::escape($ENV{'form.ccuname'}.':'.                           &Apache::lonnet::escape($ENV{'form.ccuname'}.':'.
                              $ENV{'form.ccdomain'}).'='.                               $ENV{'form.ccdomain'}).'='.
                          &Apache::lonnet::escape($now.':'),                           &Apache::lonnet::escape($now.':'),
                      $ENV{'course.'.$cid.'.home'}).'<br>');                       $ENV{'course.'.$cid.'.home'}).'</b><br>');
  }   }
     }       } 
  } elsif ($_=~/^form\.act/) {   } elsif ($_=~/^form\.act/) {
     if ($_=~/^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   # Activate roles for sections with 3 id numbers
  # set start, end times, and the url for the class   # set start, end times, and the url for the class
  my $start = ( $ENV{'form.start_'.$1.'_'.$2} ?   
       $ENV{'form.start_'.$1.'_'.$2} :    my $start = ( $ENV{'form.start_'.$1.'_'.$2.'_'.$3} ? 
         $ENV{'form.start_'.$1.'_'.$2.'_'.$3} : 
       $now );        $now );
  my $end   = ( $ENV{'form.end_'.$1.'_'.$2} ?    my $end   = ( $ENV{'form.end_'.$1.'_'.$2.'_'.$3} ? 
       $ENV{'form.end_'.$1.'_'.$2} :        $ENV{'form.end_'.$1.'_'.$2.'_'.$3} :
       0 );        0 );
  my $url='/'.$1.'/'.$2;   my $url='/'.$1.'/'.$2;
  if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {   if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {
     $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};      $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};
  }   }
  # Assign the role and report it   # Assign the role and report it
  $r->print('Assigning: '.$3.' in '.$url.': '.   $r->print('Assigning '.$3.' in '.$url.
                            ($start?', starting '.localtime($start):'').
                            ($end?', ending '.localtime($end):'').': <b>'.
                           &Apache::lonnet::assignrole(                            &Apache::lonnet::assignrole(
                               $ENV{'form.ccdomain'},$ENV{'form.ccuname'},                                $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
                               $url,$3,$end,$start).                                $url,$3,$end,$start).
   '<br>');    '</b><br>');
  # Handle students differently   # Handle students differently
  if ($3 eq 'st') {   if ($3 eq 'st') {
     $url=~/^\/(\w+)\/(\w+)/;      $url=~/^\/(\w+)\/(\w+)/;
     my $cid=$1.'_'.$2;      my $cid=$1.'_'.$2;
     $r->print('Add to classlist: '.      $r->print('Add to classlist: <b>'.
       &Apache::lonnet::critical(        &Apache::lonnet::critical(
   'put:'.$ENV{'course.'.$cid.'.domain'}.':'.    'put:'.$ENV{'course.'.$cid.'.domain'}.':'.
                            $ENV{'course.'.$cid.'.num'}.':classlist:'.                             $ENV{'course.'.$cid.'.num'}.':classlist:'.
Line 759  END Line 884  END
                                        $ENV{'form.ccdomain'} ).'='.                                         $ENV{'form.ccdomain'} ).'='.
                                    &Apache::lonnet::escape($end.':'.$start),                                     &Apache::lonnet::escape($end.':'.$start),
        $ENV{'course.'.$cid.'.home'})         $ENV{'course.'.$cid.'.home'})
       .'<br>');        .'</b><br>');
  }   }
     } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) {      } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) {
  # Activate roles for sections with two id numbers   # Activate roles for sections with two id numbers
Line 772  END Line 897  END
       0 );        0 );
  my $url='/'.$1.'/';   my $url='/'.$1.'/';
  # Assign the role and report it.   # Assign the role and report it.
  $r->print('Assigning: '.$2.' in '.$url.': '.   $r->print('Assigning '.$2.' in '.$url.': '.
                            ($start?', starting '.localtime($start):'').
                            ($end?', ending '.localtime($end):'').': <b>'.
                           &Apache::lonnet::assignrole(                            &Apache::lonnet::assignrole(
                               $ENV{'form.ccdomain'},$ENV{'form.ccuname'},                                $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
                               $url,$2,$end,$start)                                $url,$2,$end,$start)
   .'<br>');    .'</b><br>');
     }      } else {
    $r->print('<p>ERROR: Unknown command <tt>'.$_.'</tt></p><br>');
               }
  }    } 
     } # End of foreach (keys(%ENV))      } # End of foreach (keys(%ENV))
     $r->print('</body></html>');      $r->print('</body></html>');
 }  }
   
   # ========================================================== Custom Role Editor
   
   sub custom_role_editor {
       my $r=shift;
       my $rolename=$ENV{'form.rolename'};
   
       if ($rolename eq 'make new role') {
    $rolename=$ENV{'form.newrolename'};
       }
   
       $rolename=~s/[^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  # ================================================================ Main Handler
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
Line 808  sub handler { Line 1099  sub handler {
            &print_user_modification_page($r);             &print_user_modification_page($r);
        } elsif ($ENV{'form.phase'} eq 'update_user_data') {         } elsif ($ENV{'form.phase'} eq 'update_user_data') {
            &update_user_data($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 821  sub handler { Line 1116  sub handler {
 sub course_level_table {  sub course_level_table {
     my %inccourses = @_;      my %inccourses = @_;
     my $table = '';      my $table = '';
   # Custom Roles?
   
       my %customroles=&my_custom_roles();
   
     foreach (sort( keys(%inccourses))) {      foreach (sort( keys(%inccourses))) {
  my $thiscourse=$_;   my $thiscourse=$_;
  my $protectedcourse=$_;   my $protectedcourse=$_;
  $thiscourse=~s:_:/:g;   $thiscourse=~s:_:/:g;
  my %coursedata=&Apache::lonnet::coursedescription($thiscourse);   my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
  my $area=$coursedata{'description'};   my $area=$coursedata{'description'};
    if (!defined($area)) { $area='Unavailable course: '.$_; }
  my $bgcol=$thiscourse;   my $bgcol=$thiscourse;
  $bgcol=~s/[^8-9b-e]//g;   $bgcol=~s/[^7-9a-e]//g;
  $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);   $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
  foreach  ('st','ta','ep','ad','in','cc') {   foreach  ('st','ta','ep','ad','in','cc') {
     if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {      if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
  my $plrole=&Apache::lonnet::plaintext($_);   my $plrole=&Apache::lonnet::plaintext($_);
Line 859  ENDTIMEENTRY Line 1159  ENDTIMEENTRY
                 $table.= "</tr>\n";                  $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       return '' if ($table eq ''); # return nothing if there is nothing 
                                  # in the table                                   # in the table
Removed from v.1.47  
changed lines
  Added in v.1.66

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