[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.82 and 1.84

version 1.82, 2000/12/28 19:57:30 version 1.84, 2000/12/29 21:52:19
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,12/14,12/28 Gerd Kortemeyer  # 12/02,12/12,12/13,12/14,12/28,12/29 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/;
       $courseuri=~s/^([^\/])/\/$1/;
   
     if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseuri}      if ($ENV{'user.priv.'.$ENV{'request.role'}.'.'.$courseuri}
        =~/$priv\&([^\:]*)/) {         =~/$priv\&([^\:]*)/) {
        $thisallowed.=$1;         $thisallowed.=$1;
     }      }
Line 944  sub allowed { Line 945  sub allowed {
                $checkreferer=0;                 $checkreferer=0;
            }             }
        }         }
          
        if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {         if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {
   my $refuri=$ENV{'HTTP_REFERER'};    my $refuri=$ENV{'HTTP_REFERER'};
           $refuri=~s/^http\:\/\/$ENV{'request.host'}//i;            $refuri=~s/^http\:\/\/$ENV{'request.host'}//i;
Line 1165  sub filedescription { Line 1166  sub filedescription {
 sub assignrole {  sub assignrole {
     my ($udom,$uname,$url,$role,$end,$start)=@_;      my ($udom,$uname,$url,$role,$end,$start)=@_;
     my $mrole;      my $mrole;
     $url=declutter($url);  
     if ($role =~ /^cr\//) {      if ($role =~ /^cr\//) {
  unless (&allowed('ccr',$url)) { return 'refused'; }   unless (&allowed('ccr',$url)) { return 'refused'; }
         $mrole='cr';          $mrole='cr';
     } else {      } else {
         my $cwosec=$url;          my $cwosec=$url;
         $cwosec=~s/^(\w+)\/(\w+)\/.*/$1\/$2/;          $cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
         unless (&allowed('c'.$role,$cwosec)) { return 'refused'; }          unless (&allowed('c'.$role,$cwosec)) { return 'refused'; }
         $mrole=$role;          $mrole=$role;
     }      }
Line 1292  sub modifystudent { Line 1292  sub modifystudent {
  return 'error: '.$reply;   return 'error: '.$reply;
     }      }
 # ---------------------------------------------------- Add student role to user  # ---------------------------------------------------- Add student role to user
     my $uurl=$cid;      my $uurl='/'.$cid;
     $uurl=~s/\_/\//g;      $uurl=~s/\_/\//g;
     if ($usec) {      if ($usec) {
  $uurl.='/'.$usec;   $uurl.='/'.$usec;
Line 1300  sub modifystudent { Line 1300  sub modifystudent {
     return &assignrole($udom,$uname,$uurl,'st',$end,$start);      return &assignrole($udom,$uname,$uurl,'st',$end,$start);
 }  }
   
   # ------------------------------------------------- Write to course preferences
   
   sub writecoursepref {
       my ($courseid,%prefs)=@_;
       $courseid=~s/^\///;
       $courseid=~s/\_/\//g;
       my ($cdomain,$cnum)=split(/\//,$courseid);
       my $chome=homeserver($cnum,$cdomain);
       if (($chome eq '') || ($chome eq 'no_host')) { 
    return 'error: no such course';
       }
       my $cstring='';
       map {
    $cstring.=escape($_).'='.escape($prefs{$_}).'&';
       } keys %prefs;
       $cstring=~s/\&$//;
       return reply('put:'.$cdomain.':'.$cnum.':environment:'.$cstring,$chome);
   }
   
   # ---------------------------------------------------------- Make/modify course
   
   sub createcourse {
       my ($udom,$description,$url)=@_;
       $url=&declutter($url);
       my $cid='';
       unless ($cid=$ENV{'request.course.id'}) {
    return 'not_in_class';
       }
       unless (&allowed('ccc',$ENV{'user.domain'})) {
           return 'refused';
       }
       unless ($udom eq $ENV{'user.domain'}) {
           return 'refused';
       }
   # ------------------------------------------------------------------- Create ID
      my $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
          unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
   # ----------------------------------------------- Make sure that does not exist
      my $uhome=&homeserver($uname,$udom);
      unless (($uhome eq '') || ($uhome eq 'no_host')) {
          $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
           unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
          $uhome=&homeserver($uname,$udom);       
          unless (($uhome eq '') || ($uhome eq 'no_host')) {
              return 'error: unable to generate unique course-ID';
          } 
      }
   # ------------------------------------------------------------- Make the course
       my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',
                         $ENV{'user.home'});
       unless ($reply eq 'ok') { return 'error: '.$reply; }
       my $uhome=&homeserver($uname,$udom);
       if (($uhome eq '') || ($uhome eq 'no_host')) { 
    return 'error: no such course';
       }
       &writecoursepref($udom.'_'.$uname,
                        ('description' => $description,
                         'url'         => $url));
       return '/'.$udom.'/'.$uname;
   }
   
 # ---------------------------------------------------------- Assign Custom Role  # ---------------------------------------------------------- Assign Custom Role
   
 sub assigncustomrole {  sub assigncustomrole {
Removed from v.1.82  
changed lines
  Added in v.1.84

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