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

Diff for /loncom/interface/loncreateuser.pm between versions 1.33 and 1.39.4.2

version 1.33, 2002/04/23 21:05:45 version 1.39.4.2, 2002/09/03 20:46:04
Line 82  BEGIN { Line 82  BEGIN {
   
 # =================================================================== 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'};
     my @domains = &Apache::loncommon::get_domains();      my @domains = &Apache::loncommon::get_domains();
     my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');      my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
     $r->print(<<"ENDDOCUMENT");      $r->print(<<"ENDDOCUMENT");
Line 94  sub phase_one { Line 94  sub phase_one {
 </head>  </head>
 <body bgcolor="#FFFFFF">  <body bgcolor="#FFFFFF">
 <h1>Create User, Change User Privileges</h1>  <h1>Create User, Change User Privileges</h1>
 <form action=/adm/createuser method=post>  <form action="/adm/createuser" method="post">
 <input type=hidden name=phase value=two>  <input type="hidden" name="phase" value="get_user_info">
 <p>  <p>
 Username: <input type=text size=15 name=ccuname><br>  Username: <input type="text" size="15" name="ccuname"><br>
 Domain: $domform   Domain: $domform 
 </p>  </p>
 <input type=submit value="Continue">  <input type="submit" value="Continue">
 </form>  </form>
 </body>  </body>
 </html>  </html>
Line 108  ENDDOCUMENT Line 108  ENDDOCUMENT
 }  }
   
 # =================================================================== Phase two  # =================================================================== Phase two
 sub phase_two {  sub print_user_modification_page {
     my $r=shift;      my $r=shift;
     my $ccuname=$ENV{'form.ccuname'};      my $ccuname=$ENV{'form.ccuname'};
     my $ccdomain=$ENV{'form.ccdomain'};      my $ccdomain=$ENV{'form.ccdomain'};
Line 121  sub phase_two { Line 121  sub phase_two {
                   );                    );
     $loginscript  = &Apache::loncommon::authform_header(%param);      $loginscript  = &Apache::loncommon::authform_header(%param);
   
     my $defdom=$ENV{'user.domain'};      my $defdom=$ENV{'request.role.domain'};
   
     $ccuname=~s/\W//g;      $ccuname=~s/\W//g;
     $ccdomain=~s/\W//g;      $ccdomain=~s/\W//g;
Line 159  sub phase_two { Line 159  sub phase_two {
 ENDDOCHEAD  ENDDOCHEAD
     my $forminfo =<<"ENDFORMINFO";      my $forminfo =<<"ENDFORMINFO";
 <form action="/adm/createuser" method="post" name="cu">  <form action="/adm/createuser" method="post" name="cu">
 <input type="hidden" name="phase"       value="three">  <input type="hidden" name="phase"       value="update_user_data">
 <input type="hidden" name="ccuname"     value="$ccuname">  <input type="hidden" name="ccuname"     value="$ccuname">
 <input type="hidden" name="ccdomain"    value="$ccdomain">  <input type="hidden" name="ccdomain"    value="$ccdomain">
 <input type="hidden" name="pres_value"  value="" >  <input type="hidden" name="pres_value"  value="" >
Line 250  END Line 250  END
         my ($tmp) = keys(%rolesdump);          my ($tmp) = keys(%rolesdump);
         unless ($tmp =~ /^(con_lost|error)/i) {          unless ($tmp =~ /^(con_lost|error)/i) {
            my $now=time;             my $now=time;
            $r->print('<hr /><h3>Revoke Existing Roles</h3>'.             $r->print(<<END);
              '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.  <hr />
      '<th>Start</th><th>End</th>');  <h3>Revoke Existing Roles</h3>
   <table border=2>
   <tr><th>Revoke</th><th>Role</th><th>Extent</th><th>Start</th><th>End</th>
   END
    foreach my $area (keys(%rolesdump)) {     foreach my $area (keys(%rolesdump)) {
               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);
                  my $bgcol='ffffff';                 my $bgcol='ffffff';
                  my $allows=0;                 my $allowed=0;
                  if ($area=~/^\/(\w+)\/(\d\w+)/) {                 if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {
                     my %coursedata=                     my %coursedata=
                         &Apache::lonnet::coursedescription($1.'_'.$2);                         &Apache::lonnet::coursedescription($1.'_'.$2);
                     my $carea='Course: '.$coursedata{'description'};                     my $carea='Course: '.$coursedata{'description'};
                     $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)) {
                         $allows=1;                         $allowed=1;
                     }                     }
                     # 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/[^8-9b-e]//g;
                     $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);                     $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
                     if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {                     if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
                        $carea.='<br>Section/Group: '.$3;                         $carea.='<br>Section/Group: '.$3;
                     }                     }
                     $area=$carea;                     $area=$carea;
                  } 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)) {
                            $allows=1;                             $allowed=1;
                         }                         }
                      } else {                     } else {
                         if (&Apache::lonnet::allowed('c'.$role_code,'/')) {                         if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
                            $allows=1;                             $allowed=1;
                         }                         }
                      }                     }
                  }                 }
                  $r->print('<tr bgcolor=#"'.$bgcol.'"><td>');                 # I have no idea what the hell the above code does
                  my $active=1;                 # So the following is a check:
                  $active=0 if (($role_end_time) && ($now>$role_end_time));                 if ($allowed) {
                  if (($active) && ($allows)) {                     # If we are looking at a co-author role, make sure it is 
                     $r->print('<input type="checkbox" name="rev:'                     # for the current users construction space before we let 
                               .$thisrole.'">');                     # them revoke it.
                  } else {                     if (($role_code eq 'ca') && 
                     $r->print('&nbsp;');                         ($ENV{'request.role'} !~ /^dc/)) {
                  }                         if ($area !~ 
                  $r->print('</td><td>'.                             /^\/$ENV{'request.role.domain'}\/$ENV{'user.name'}/) {
                            &Apache::lonnet::plaintext($role_code).                             $allowed = 0;
                            '</td><td>'.$area.'</td><td>'.                         }
                            ($role_start_time ? localtime($role_start_time)                     }
                                              : '&nbsp;' )                 }
                            .'</td><td>'.                 my $row = '';
                            ($role_end_time   ? localtime($role_end_time)                 $row.='<tr bgcolor=#"'.$bgcol.'"><td>';
                                              : '&nbsp;' )                 my $active=1;
                            ."</td></tr>\n");                 $active=0 if (($role_end_time) && ($now>$role_end_time));
               }                 if (($active) && ($allowed)) {
                      $row.= '<input type="checkbox" name="rev:'.$thisrole.'">';
                  } else {
                      $row.='&nbsp;';
                  }
                  $row.= '</td><td>'.&Apache::lonnet::plaintext($role_code).
                         '</td><td>'.$area.
                         '</td><td>'.($role_start_time?localtime($role_start_time)
                                                      : '&nbsp;' ).
                         '</td><td>'.($role_end_time  ?localtime($role_end_time)
                                                      : '&nbsp;' )
                         ."</td></tr>\n";
                  $r->print($row);
            } # end of foreach        (table building loop)             } # end of foreach        (table building loop)
    $r->print('</table>');     $r->print('</table>');
         }  # End of unless          }  # End of unless
Line 327  END Line 342  END
  $currentauth=~/^internal:/ or   $currentauth=~/^internal:/ or
  $currentauth=~/^localauth:/   $currentauth=~/^localauth:/
  ) { # bad authentication scheme   ) { # bad authentication scheme
     if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {      if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
  $r->print(<<ENDBADAUTH);   $r->print(<<ENDBADAUTH);
 <hr />  <hr />
 <script type="text/javascript" language="Javascript">  <script type="text/javascript" language="Javascript">
Line 390  ENDBADAUTH Line 405  ENDBADAUTH
 <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr>  <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr>
 </table>  </table>
 ENDCURRENTAUTH  ENDCURRENTAUTH
             if (&Apache::lonnet::allowed('mau',$ENV{'user.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);
 <hr />  <hr />
Line 411  ENDOTHERAUTHS Line 426  ENDOTHERAUTHS
 #  #
 # Co-Author  # Co-Author
 #   # 
       if (&Apache::lonnet::allowed('cca',$ENV{'request.role.domain'})) {
     if (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) {  
  my $cuname=$ENV{'user.name'};   my $cuname=$ENV{'user.name'};
         my $cudom=$ENV{'user.domain'};          my $cudom=$ENV{'request.role.domain'};
        $r->print(<<ENDCOAUTH);         $r->print(<<ENDCOAUTH);
 <h4>Construction Space</h4>  <h4>Construction Space</h4>
 <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>  <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
Line 470  ENDDROW Line 484  ENDDROW
 }  }
   
 # ================================================================= Phase Three  # ================================================================= Phase Three
 sub phase_three {  sub update_user_data {
     my $r=shift;      my $r=shift;
     my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'},      my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'},
                                           $ENV{'form.ccdomain'});                                            $ENV{'form.ccdomain'});
Line 532  ENDTHREEHEAD Line 546  ENDTHREEHEAD
  $amode='localauth';   $amode='localauth';
  $genpwd=$ENV{'form.locarg'};   $genpwd=$ENV{'form.locarg'};
  $genpwd=" " if (!$genpwd);   $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 {      } else {
     $r->print($error.'Invalid login mode or password'.$end);          $r->print($error.'Invalid login mode or password'.$end);    
     return;      return;
Line 552  ENDNEWUSERHEAD Line 572  ENDNEWUSERHEAD
         if (lc($desiredhost) eq 'default') {          if (lc($desiredhost) eq 'default') {
             $desiredhost = undef;              $desiredhost = undef;
         } else {          } else {
             my %home_servers = &Apache::loncommon::get_home_servers              my %home_servers = &Apache::loncommon::get_library_servers
                 ($ENV{'form.ccdomain'});                    ($ENV{'form.ccdomain'});  
             if (! exists($home_servers{$desiredhost})) {              if (! exists($home_servers{$desiredhost})) {
                 $r->print($error.'Invalid home server specified');                  $r->print($error.'Invalid home server specified');
Line 571  ENDNEWUSERHEAD Line 591  ENDNEWUSERHEAD
                                                $ENV{'form.ccdomain'});                                                 $ENV{'form.ccdomain'});
         $r->print('<br>Home server: '.$home.' '.          $r->print('<br>Home server: '.$home.' '.
                   $Apache::lonnet::libserv{$home});                    $Apache::lonnet::libserv{$home});
     } elsif ($ENV{'form.login'} ne '') {      } elsif (($ENV{'form.login'} ne 'nochange') &&
                ($ENV{'form.login'} ne ''        )) {
  # Modify user privileges   # Modify user privileges
  $r->print(<<ENDMODIFYUSERHEAD);   $r->print(<<ENDMODIFYUSERHEAD);
 <h1>Change User Privileges</h1>  <h1>Change User Privileges</h1>
Line 582  ENDMODIFYUSERHEAD Line 603  ENDMODIFYUSERHEAD
     return;      return;
  }   }
  # Only allow authentification modification if the person has authority   # Only allow authentification modification if the person has authority
  if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {   if (&Apache::lonnet::allowed('mau',$ENV{'form.ccdomain'})) {
     $r->print('Modifying authentication: '.      $r->print('Modifying authentication: '.
                       &Apache::lonnet::modifyuserauth(                        &Apache::lonnet::modifyuserauth(
        $ENV{'form.ccdomain'},$ENV{'form.ccuname'},         $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
Line 756  sub handler { Line 777  sub handler {
         (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) ||           (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) || 
         (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) ||           (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) || 
         (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||          (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||
         (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) ||          (&Apache::lonnet::allowed('cca',$ENV{'request.role.domain'})) ||
         (&Apache::lonnet::allowed('mau',$ENV{'user.domain'}))) {          (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'}))) {
        $r->content_type('text/html');         $r->content_type('text/html');
        $r->send_http_header;         $r->send_http_header;
        unless ($ENV{'form.phase'}) {         unless ($ENV{'form.phase'}) {
    &phase_one($r);     &print_username_entry_form($r);
        }         }
        if ($ENV{'form.phase'} eq 'two') {         if ($ENV{'form.phase'} eq 'get_user_info') {
            &phase_two($r);             &print_user_modification_page($r);
        } elsif ($ENV{'form.phase'} eq 'three') {         } elsif ($ENV{'form.phase'} eq 'update_user_data') {
            &phase_three($r);             &update_user_data($r);
        }         }
    } else {     } else {
       $ENV{'user.error.msg'}=        $ENV{'user.error.msg'}=
Removed from v.1.33  
changed lines
  Added in v.1.39.4.2

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