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

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.80 and 1.81

version 1.80, 2000/12/13 22:45:22 version 1.81, 2000/12/14 21:44:06
Line 81 Line 81
 # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29,   # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29, 
 # 10/30,10/31,  # 10/30,10/31,
 # 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,  # 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,
 # 12/02,12/12,12/13 Gerd Kortemeyer  # 12/02,12/12,12/13,12/14 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 901  sub allowed { Line 901  sub allowed {
 # Course: uri itself is a course  # Course: uri itself is a course
     my $courseuri=$uri;      my $courseuri=$uri;
     $courseuri=~s/\_(\d)/\/$1/;      $courseuri=~s/\_(\d)/\/$1/;
   
     if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseuri}      if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseuri}
        =~/$priv\&([^\:]*)/) {         =~/$priv\&([^\:]*)/) {
        $thisallowed.=$1;         $thisallowed.=$1;
Line 1166  sub assignrole { Line 1167  sub assignrole {
     my $mrole;      my $mrole;
     $url=declutter($url);      $url=declutter($url);
     if ($role =~ /^cr\//) {      if ($role =~ /^cr\//) {
         unless ($url=~/\.course$/) { return 'invalid'; }   unless (&allowed('ccr',$url)) { return 'refused'; }
  unless (allowed('ccr',$url)) { return 'refused'; }  
         $mrole='cr';          $mrole='cr';
     } else {      } else {
         unless (($url=~/\.course$/) || ($url=~/\/$/)) { return 'invalid'; }          unless (&allowed('c'.$role,$url)) { return 'refused'; }
         unless (allowed('c'+$role)) { return 'refused'; }  
         $mrole=$role;          $mrole=$role;
     }      }
     my $command="encrypt:rolesput:$ENV{'user.domain'}:$ENV{'user.name'}:".      my $command="encrypt:rolesput:$ENV{'user.domain'}:$ENV{'user.name'}:".
                 "$udom:$uname:$url".'_'."$mrole=$role";                  "$udom:$uname:$url".'_'."$mrole=$role";
     if ($end) { $command.='_$end'; }      if ($end) { $command.='_'.$end; }
     if ($start) {      if ($start) {
  if ($end) {    if ($end) { 
            $command.='_$start';              $command.='_'.$start; 
         } else {          } else {
            $command.='_0_$start';             $command.='_0_'.$start;
         }          }
     }      }
     return &reply($command,&homeserver($uname,$udom));      return &reply($command,&homeserver($uname,$udom));
 }  }
   
 # ----------------------------------------------------------------- Make a user  # --------------------------------------------------------------- Modify a user
   
   
 sub makeuser {  sub modifyuser {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene)=@_;      my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene)=@_;
     &logthis('Call to make user '.$udom.', '.$uname.', '.$uid.', '.      &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.               $umode.', '.$first.', '.$middle.', '.
      $last.', '.$gene.' by '.       $last.', '.$gene.' by '.
              $ENV{'user.name'}.' at '.$ENV{'user.domain'});                 $ENV{'user.name'}.' at '.$ENV{'user.domain'});  
     my $uhome=&homeserver($uname,$udom);      my $uhome=&homeserver($uname,$udom);
 # ----------------------------------------------------------------- Create User  # ----------------------------------------------------------------- Create User
     if ($uhome eq 'no_host') {      if (($uhome eq 'no_host') && ($umode) && ($upass)) {
         my $unhome='';          my $unhome='';
  if ($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $udom) {   if ($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $udom) {
     $unhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};      $unhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
  } elsif ($ENV{'user.domain'} eq $udom) {  
             $unhome=$ENV{'user.home'};  
         } else {          } else {
             my $tryserver;              my $tryserver;
             my $loadm=999999;              my $loadm=10000000;
             foreach $tryserver (keys %libserv) {              foreach $tryserver (keys %libserv) {
        if ($hostdom{$tryserver} eq $udom) {         if ($hostdom{$tryserver} eq $udom) {
                   my $answer=reply('load',$tryserver);                    my $answer=reply('load',$tryserver);
Line 1247  sub makeuser { Line 1244  sub makeuser {
                      ':environment:firstname&middlename&lastname&generation',                       ':environment:firstname&middlename&lastname&generation',
                      $uhome);                       $uhome);
     my ($efirst,$emiddle,$elast,$egene)=split(/\&/,$names);      my ($efirst,$emiddle,$elast,$egene)=split(/\&/,$names);
     unless ($efirst)  { $efirst  = &escape($first); }      if ($first)  { $efirst  = &escape($first); }
     unless ($emiddle) { $emiddle = &escape($middle); }      if ($middle) { $emiddle = &escape($middle); }
     unless ($elast)   { $elast   = &escape($last); }      if ($last)   { $elast   = &escape($last); }
     unless ($egene)   { $egene   = &escape($gene); }      if ($gene)   { $egene   = &escape($gene); }
     my $reply=&reply('put:'.$udom.':'.$uname.      my $reply=&reply('put:'.$udom.':'.$uname.
            ':environment:firstname='.$efirst.             ':environment:firstname='.$efirst.
                       '&middlename='.$emiddle.                        '&middlename='.$emiddle.
Line 1259  sub makeuser { Line 1256  sub makeuser {
     if ($reply ne 'ok') {      if ($reply ne 'ok') {
  return 'error: '.$reply;   return 'error: '.$reply;
     }      }
     &logthis('Success making user '.$udom.', '.$uname.', '.$uid.', '.      &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.               $umode.', '.$first.', '.$middle.', '.
      $last.', '.$gene.' by '.       $last.', '.$gene.' by '.
              $ENV{'user.name'}.' at '.$ENV{'user.domain'});               $ENV{'user.name'}.' at '.$ENV{'user.domain'});
     return 'ok';       return 'ok'; 
 }  }
   
 # -------------------------------------------------------------- Make a student  # -------------------------------------------------------------- Modify student
   
 sub makestudent {  sub modifystudent {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec)=@_;      my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
     unless ($ENV{'request.course.id'}) {          $end,$start)=@_;
       my $cid='';
       unless ($cid=$ENV{'request.course.id'}) {
  return 'not_in_class';   return 'not_in_class';
     }      }
 # --------------------------------------------------------------- Make the user  # --------------------------------------------------------------- Make the user
     my $reply=&makeuser      my $reply=&modifyuser
  ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene);   ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene);
     unless ($reply eq 'ok') { return $reply; }      unless ($reply eq 'ok') { return $reply; }
       my $uhome=&homeserver($uname,$udom);
       if (($uhome eq '') || ($uhome eq 'no_host')) { 
    return 'error: no such user';
       }
 # -------------------------------------------------- Add student to course list  # -------------------------------------------------- Add student to course list
       my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
                 $ENV{'course.'.$cid.'.num'}.':classlist:'.
                         &escape($uname.':'.$udom).'='.
                         &escape($end.':'.$start),
                 $ENV{'course.'.$cid.'.home'});
       unless (($reply eq 'ok') || ($reply eq 'delayed')) {
    return 'error: '.$reply;
       }
 # ---------------------------------------------------- Add student role to user  # ---------------------------------------------------- Add student role to user
       my $uurl=$cid;
       $uurl=~s/\_/\//g;
       if ($usec) {
    $uurl.='/'.$usec;
       }
       return &assignrole($udom,$uname,$uurl,'st',$end,$start);
 }  }
   
 # ---------------------------------------------------------- Assign Custom Role  # ---------------------------------------------------------- Assign Custom Role
Removed from v.1.80  
changed lines
  Added in v.1.81

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