[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.342 and 1.346

version 1.342, 2003/03/19 16:50:14 version 1.346, 2003/03/23 01:46:51
Line 588  sub idput { Line 588  sub idput {
     }      }
 }  }
   
   # --------------------------------------------------- Assign a key to a student
   
   sub assign_access_key {
       my ($ckey,$cdom,$cnum,$udom,$uname)=@_;
       $cdom=
      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
       $cnum=
      $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum));
       $udom=$ENV{'user.name'} unless (defined($udom));
       $uname=$ENV{'user.domain'} unless (defined($uname));
       my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
       if (($existing{$ckey}=~/^\d+$/) || # has time - new key
           ($existing{$ckey} eq $udom.':'.$uname)) { # this should not happen,
                                                     # unless something went wrong
                                                     # the first time around
   # ready to assign
       } elsif (!$existing{$ckey}) {
           if (&put('accesskey',{$ckey=>$udom.':'.$uname},$cdom,$cnum) eq 'ok') {
   # key now belongs to user
       my $envkey='key.'.$cdom.'_'.$cnum;
               if (&put('environment',{$envkey => $ckey}) eq 'ok') {
                   &appenv('environment.'.$envkey => $ckey);
                   return 'ok';
               } else {
                   return 
     'error: Count not permanently assign key, will need to be re-entered later.';
       }
           } else {
               return 'error: Could not assign key, try again later.';
           }
   # the key does not exist
    return 'error: The key does not exist';
       } else {
   # the key is somebody else's
    return 'error: The key is already in use';
       }
   }
   
   # ------------------------------------------------------ Generate a set of keys
   
   sub generate_access_keys {
       my ($number,$cdom,$cnum)=@_;
       $cdom=
      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
       $cnum=
      $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum));
       unless (&allowed('ccc',$cdom)) { return 0; }
       unless (($cdom) && ($cnum)) { return 0; }
       if ($number>10000) { return 0; }
       sleep(2); # make sure don't get same seed twice
       srand(time()^($$+($$<<15))); # from "Programming Perl"
       my $total=0;
       for (my $i=1;$i<=$number;$i++) {
          my $newkey=sprintf("%lx",int(100000*rand)).'-'.
                     sprintf("%lx",int(100000*rand)).'-'.
                     sprintf("%lx",int(100000*rand));
          $newkey=~s/1/g/g; # folks mix up 1 and l
          $newkey=~s/0/h/g; # and also 0 and O
          my %existing=&get('accesskeys',[$newkey],$cdom,$cnum);
          if ($existing{$newkey}) {
              $i--;
          } else {
     if (&put('accesskeys',{ $newkey => time() },$cdom,$cnum) eq 'ok') {
                 $total++;
     }
          }
       }
       &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.home'},
            'Generated '.$total.' keys for '.$cnum.' at '.$cdom);
       return $total;
   }
   
   # ------------------------------------------------------- Validate an accesskey
   
   sub validate_access_key {
       my ($ckey,$cdom,$cnum,$udom,$uname)=@_;
       $cdom=
      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
       $cnum=
      $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum));
       $udom=$ENV{'user.name'} unless (defined($udom));
       $uname=$ENV{'user.domain'} unless (defined($uname));
       my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
       return ($existing{$ckey} eq $udom.':'.$uname);
   }
   
 # ------------------------------------- Find the section of student in a course  # ------------------------------------- Find the section of student in a course
   
 sub getsection {  sub getsection {
Line 1875  sub eget { Line 1961  sub eget {
 sub customaccess {  sub customaccess {
     my ($priv,$uri)=@_;      my ($priv,$uri)=@_;
     my ($urole,$urealm)=split(/\./,$ENV{'request.role'});      my ($urole,$urealm)=split(/\./,$ENV{'request.role'});
     my ($udm,$ucid,$usec)=split(/\//,$urealm);      $urealm=~s/^\W//;
       my ($udom,$ucrs,$usec)=split(/\//,$urealm);
     my $access=0;      my $access=0;
     foreach (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {      foreach (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {
  my ($effect,$realm,$role)=split(/\:/,$_);   my ($effect,$realm,$role)=split(/\:/,$_);
         foreach my $thisrealm (split(/\s*\,\s*/,$realm)) {          if ($role) {
             &logthis('testing '.$effect.' '.$thisrealm.' '.$role);     if ($role ne $urole) { next; }
           }
           foreach (split(/\s*\,\s*/,$realm)) {
               my ($tdom,$tcrs,$tsec)=split(/\_/,$_);
               if ($tdom) {
    if ($tdom ne $udom) { next; }
               }
               if ($tcrs) {
    if ($tcrs ne $ucrs) { next; }
               }
               if ($tsec) {
    if ($tsec ne $usec) { next; }
               }
               $access=($effect eq 'allow');
               last;
         }          }
     }      }
     return $access;      return $access;
Removed from v.1.342  
changed lines
  Added in v.1.346

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