[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.954 and 1.960

version 1.954, 2008/04/04 16:56:11 version 1.960, 2008/06/06 04:53:51
Line 39  use vars qw(%perlvar %spareid %pr %prp $ Line 39  use vars qw(%perlvar %spareid %pr %prp $
 my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,  my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
     %userrolehash, $processmarker, $dumpcount, %coursedombuf,      %userrolehash, $processmarker, $dumpcount, %coursedombuf,
     %coursenumbuf, %coursehombuf, %coursedescrbuf, %courseinstcodebuf,      %coursenumbuf, %coursehombuf, %coursedescrbuf, %courseinstcodebuf,
     %courseownerbuf, %coursetypebuf);      %courseownerbuf, %coursetypebuf,$locknum);
   
 use IO::Socket;  use IO::Socket;
 use GDBM_File;  use GDBM_File;
Line 88  delayed. Line 88  delayed.
 {  {
     my $logid;      my $logid;
     sub instructor_log {      sub instructor_log {
  my ($hash_name,$storehash,$delflag,$uname,$udom)=@_;   my ($hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_;
           if (($cnum eq '') || ($cdom eq '')) {
               $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
               $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
           }
  $logid++;   $logid++;
  my $id=time().'00000'.$$.'00000'.$logid;          my $now = time();
    my $id=$now.'00000'.$$.'00000'.$logid;
  return &Apache::lonnet::put('nohist_'.$hash_name,   return &Apache::lonnet::put('nohist_'.$hash_name,
     { $id => {      { $id => {
  'exe_uname' => $env{'user.name'},   'exe_uname' => $env{'user.name'},
  'exe_udom'  => $env{'user.domain'},   'exe_udom'  => $env{'user.domain'},
  'exe_time'  => time(),   'exe_time'  => $now,
  'exe_ip'    => $ENV{'REMOTE_ADDR'},   'exe_ip'    => $ENV{'REMOTE_ADDR'},
  'delflag'   => $delflag,   'delflag'   => $delflag,
  'logentry'  => $storehash,   'logentry'  => $storehash,
  'uname'     => $uname,   'uname'     => $uname,
  'udom'      => $udom,   'udom'      => $udom,
     }      }
   },    },$cdom,$cnum);
     $env{'course.'.$env{'request.course.id'}.'.domain'},  
     $env{'course.'.$env{'request.course.id'}.'.num'}  
     );  
     }      }
 }  }
   
Line 524  sub get_env_multiple { Line 526  sub get_env_multiple {
     return(@values);      return(@values);
 }  }
   
   # ------------------------------------------------------------------- Locking
   
   sub set_lock {
       my ($text)=@_;
       $locknum++;
       my $id=$$.'-'.$locknum;
       &appenv({'session.locks' => $env{'session.locks'}.','.$id,
                'session.lock.'.$id => $text});
       return $id;
   }
   
   sub get_locks {
       my $num=0;
       my %texts=();
       foreach my $lock (split(/\,/,$env{'session.locks'})) {
          if ($lock=~/\w/) {
             $num++;
             $texts{$lock}=$env{'session.lock.'.$lock};
          }
      }
      return ($num,%texts);
   }
   
   sub remove_lock {
       my ($id)=@_;
       my $newlocks='';
       foreach my $lock (split(/\,/,$env{'session.locks'})) {
          if (($lock=~/\w/) && ($lock ne $id)) {
             $newlocks.=','.$lock;
          }
       }
       &appenv({'session.locks' => $newlocks});
       &delenv('session.lock.'.$id);
   }
   
   sub remove_all_locks {
       my $activelocks=$env{'session.locks'};
       foreach my $lock (split(/\,/,$env{'session.locks'})) {
          if ($lock=~/\w/) {
             &remove_lock($lock);
          }
       }
   }
   
   
 # ------------------------------------------ Find out current server userload  # ------------------------------------------ Find out current server userload
 sub userload {  sub userload {
     my $numusers=0;      my $numusers=0;
Line 911  sub retrieve_inst_usertypes { Line 958  sub retrieve_inst_usertypes {
     if (defined(&domain($udom,'primary'))) {      if (defined(&domain($udom,'primary'))) {
         my $uhome=&domain($udom,'primary');          my $uhome=&domain($udom,'primary');
         my $rep=&reply("inst_usertypes:$udom",$uhome);          my $rep=&reply("inst_usertypes:$udom",$uhome);
           if ($rep =~ /^(con_lost|error|no_such_host|refused)/) {
               &logthis("get_dom failed - $rep returned from $uhome in domain: $udom");
               return (\%returnhash,\@order);
           }
         my ($hashitems,$orderitems) = split(/:/,$rep);           my ($hashitems,$orderitems) = split(/:/,$rep); 
         my @pairs=split(/\&/,$hashitems);          my @pairs=split(/\&/,$hashitems);
         foreach my $item (@pairs) {          foreach my $item (@pairs) {
Line 2480  sub userrolelog { Line 2531  sub userrolelog {
     }      }
 }  }
   
   sub courserolelog {
       my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,$context)=@_;
       if (($trole eq 'cc') || ($trole eq 'in') ||
           ($trole eq 'ep') || ($trole eq 'ad') ||
           ($trole eq 'ta') || ($trole eq 'st') ||
           ($trole=~/^cr/) || ($trole eq 'gr')) {
           if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) {
               my $cdom = $1;
               my $cnum = $2;
               my $sec = $3;
               my $namespace = 'rolelog';
               my %storehash = (
                                  role    => $trole,
                                  start   => $tstart,
                                  end     => $tend,
                                  selfenroll => $selfenroll,
                                  context    => $context,
                               );
               if ($trole eq 'gr') {
                   $namespace = 'groupslog';
                   $storehash{'group'} = $sec;
               } else {
                   $storehash{'section'} = $sec;
               }
               &instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom);
           }
       }
       return;
   }
   
 sub get_course_adv_roles {  sub get_course_adv_roles {
     my ($cid,$codes) = @_;      my ($cid,$codes) = @_;
     $cid=$env{'request.course.id'} unless (defined($cid));      $cid=$env{'request.course.id'} unless (defined($cid));
Line 2685  sub courseidput { Line 2766  sub courseidput {
 sub courseiddump {  sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,      my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
         $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,          $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
         $selfenrollonly)=@_;          $selfenrollonly,$catfilter)=@_;
     my $as_hash = 1;      my $as_hash = 1;
     my %returnhash;      my %returnhash;
     if (!$domfilter) { $domfilter=''; }      if (!$domfilter) { $domfilter=''; }
Line 2703  sub courseiddump { Line 2784  sub courseiddump {
                          &escape($instcodefilter).':'.&escape($ownerfilter).                           &escape($instcodefilter).':'.&escape($ownerfilter).
                          ':'.&escape($coursefilter).':'.&escape($typefilter).                           ':'.&escape($coursefilter).':'.&escape($typefilter).
                          ':'.&escape($regexp_ok).':'.$as_hash.':'.                           ':'.&escape($regexp_ok).':'.$as_hash.':'.
                          &escape($selfenrollonly),$tryserver);                           &escape($selfenrollonly).':'.&escape($catfilter),$tryserver);
                 my @pairs=split(/\&/,$rep);                  my @pairs=split(/\&/,$rep);
                 foreach my $item (@pairs) {                  foreach my $item (@pairs) {
                     my ($key,$value)=split(/\=/,$item,2);                      my ($key,$value)=split(/\=/,$item,2);
Line 4457  sub allowed { Line 4538  sub allowed {
     }      }
           
 # Full access at system, domain or course-wide level? Exit.  # Full access at system, domain or course-wide level? Exit.
   
     if ($thisallowed=~/F/) {      if ($thisallowed=~/F/) {
  return 'F';   return 'F';
     }      }
Line 5236  sub toggle_coursegroup_status { Line 5316  sub toggle_coursegroup_status {
 }  }
   
 sub modify_group_roles {  sub modify_group_roles {
     my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs) = @_;      my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs,$selfenroll,$context) = @_;
     my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id;      my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id;
     my $role = 'gr/'.&escape($userprivs);      my $role = 'gr/'.&escape($userprivs);
     my ($uname,$udom) = split(/:/,$user);      my ($uname,$udom) = split(/:/,$user);
     my $result = &assignrole($udom,$uname,$url,$role,$end,$start);      my $result = &assignrole($udom,$uname,$url,$role,$end,$start,'',$selfenroll,$context);
     if ($result eq 'ok') {      if ($result eq 'ok') {
         &devalidate_getgroups_cache($udom,$uname,$cdom,$cnum);          &devalidate_getgroups_cache($udom,$uname,$cdom,$cnum);
     }      }
Line 5356  sub plaintext { Line 5436  sub plaintext {
 # ----------------------------------------------------------------- Assign Role  # ----------------------------------------------------------------- Assign Role
   
 sub assignrole {  sub assignrole {
     my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll)=@_;      my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll,
           $context)=@_;
     my $mrole;      my $mrole;
     if ($role =~ /^cr\//) {      if ($role =~ /^cr\//) {
         my $cwosec=$url;          my $cwosec=$url;
Line 5415  sub assignrole { Line 5496  sub assignrole {
     }      }
     my $origstart = $start;      my $origstart = $start;
     my $origend = $end;      my $origend = $end;
       my $delflag;
 # actually delete  # actually delete
     if ($deleteflag) {      if ($deleteflag) {
  if ((&allowed('dro',$udom)) || (&allowed('dro',$url))) {   if ((&allowed('dro',$udom)) || (&allowed('dro',$url))) {
Line 5425  sub assignrole { Line 5507  sub assignrole {
 # set start and finish to negative values for userrolelog  # set start and finish to negative values for userrolelog
            $start=-1;             $start=-1;
            $end=-1;             $end=-1;
              $delflag = 1;
         }          }
     }      }
 # send command  # send command
Line 5433  sub assignrole { Line 5516  sub assignrole {
     if ($answer eq 'ok') {      if ($answer eq 'ok') {
  &userrolelog($role,$uname,$udom,$url,$start,$end);   &userrolelog($role,$uname,$udom,$url,$start,$end);
 # for course roles, perform group memberships changes triggered by role change.  # for course roles, perform group memberships changes triggered by role change.
           &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,$selfenroll,$context);
         unless ($role =~ /^gr/) {          unless ($role =~ /^gr/) {
             &Apache::longroup::group_changes($udom,$uname,$url,$role,$origend,              &Apache::longroup::group_changes($udom,$uname,$url,$role,$origend,
                                              $origstart);                                               $origstart,$selfenroll,$context);
         }          }
     }      }
     return $answer;      return $answer;
Line 5572  sub modifyuser { Line 5656  sub modifyuser {
   
 sub modifystudent {  sub modifystudent {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,      my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
         $end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid)=@_;          $end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid,
           $selfenroll,$context)=@_;
     if (!$cid) {      if (!$cid) {
  unless ($cid=$env{'request.course.id'}) {   unless ($cid=$env{'request.course.id'}) {
     return 'not_in_class';      return 'not_in_class';
Line 5587  sub modifystudent { Line 5672  sub modifystudent {
     # students environment      # students environment
     $uid = undef if (!$forceid);      $uid = undef if (!$forceid);
     $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,      $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,
  $gene,$usec,$end,$start,$type,$locktype,$cid);   $gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll,$context);
     return $reply;      return $reply;
 }  }
   
 sub modify_student_enrollment {  sub modify_student_enrollment {
     my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll) = @_;      my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll,$context) = @_;
     my ($cdom,$cnum,$chome);      my ($cdom,$cnum,$chome);
     if (!$cid) {      if (!$cid) {
  unless ($cid=$env{'request.course.id'}) {   unless ($cid=$env{'request.course.id'}) {
Line 5650  sub modify_student_enrollment { Line 5735  sub modify_student_enrollment {
     if ($usec) {      if ($usec) {
  $uurl.='/'.$usec;   $uurl.='/'.$usec;
     }      }
     return &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,$selfenroll);      return &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,$selfenroll,$context);
 }  }
   
 sub format_name {  sub format_name {
Line 5779  sub is_course { Line 5864  sub is_course {
 # ---------------------------------------------------------- Assign Custom Role  # ---------------------------------------------------------- Assign Custom Role
   
 sub assigncustomrole {  sub assigncustomrole {
     my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start,$deleteflag)=@_;      my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start,$deleteflag,$selfenroll,$context)=@_;
     return &assignrole($udom,$uname,$url,'cr/'.$rdom.'/'.$rnam.'/'.$rolename,      return &assignrole($udom,$uname,$url,'cr/'.$rdom.'/'.$rnam.'/'.$rolename,
                        $end,$start,$deleteflag);                         $end,$start,$deleteflag,$selfenroll,$context);
 }  }
   
 # ----------------------------------------------------------------- Revoke Role  # ----------------------------------------------------------------- Revoke Role
   
 sub revokerole {  sub revokerole {
     my ($udom,$uname,$url,$role,$deleteflag)=@_;      my ($udom,$uname,$url,$role,$deleteflag,$selfenroll,$context)=@_;
     my $now=time;      my $now=time;
     return &assignrole($udom,$uname,$url,$role,$now,$deleteflag);      return &assignrole($udom,$uname,$url,$role,$now,$deleteflag,$selfenroll,$context);
 }  }
   
 # ---------------------------------------------------------- Revoke Custom Role  # ---------------------------------------------------------- Revoke Custom Role
   
 sub revokecustomrole {  sub revokecustomrole {
     my ($udom,$uname,$url,$rdom,$rnam,$rolename,$deleteflag)=@_;      my ($udom,$uname,$url,$rdom,$rnam,$rolename,$deleteflag,$selfenroll,$context)=@_;
     my $now=time;      my $now=time;
     return &assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$now,      return &assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$now,
            $deleteflag);             $deleteflag,$selfenroll,$context);
 }  }
   
 # ------------------------------------------------------------ Disk usage  # ------------------------------------------------------------ Disk usage
 sub diskusage {  sub diskusage {
     my ($udom,$uname,$directoryRoot)=@_;      my ($udom,$uname,$directorypath,$getpropath)=@_;
     $directoryRoot =~ s/\/$//;      $directorypath =~ s/\/$//;
     my $listing=&reply('du:'.$directoryRoot,homeserver($uname,$udom));      my $listing=&reply('du2:'.&escape($directorypath).':'
                          .&escape($getpropath).':'.&escape($uname).':'
                          .&escape($udom),homeserver($uname,$udom));
       if ($listing eq 'unknown_cmd') {
           if ($getpropath) {
               $directorypath = &propath($udom,$uname).'/'.$directorypath; 
           }
           $listing = &reply('du:'.$directorypath,homeserver($uname,$udom));
       }
     return $listing;      return $listing;
 }  }
   
Line 6222  sub unmark_as_readonly { Line 6315  sub unmark_as_readonly {
 # ------------------------------------------------------------ Directory lister  # ------------------------------------------------------------ Directory lister
   
 sub dirlist {  sub dirlist {
     my ($uri,$userdomain,$username,$alternateDirectoryRoot)=@_;      my ($uri,$userdomain,$username,$getpropath,$getuserdir,$alternateRoot)=@_;
   
     $uri=~s/^\///;      $uri=~s/^\///;
     $uri=~s/\/$//;      $uri=~s/\/$//;
     my ($udom, $uname);      my ($udom, $uname);
     (undef,$udom,$uname)=split(/\//,$uri);      if ($getuserdir) {
     if(defined($userdomain)) {  
         $udom = $userdomain;          $udom = $userdomain;
     }  
     if(defined($username)) {  
         $uname = $username;          $uname = $username;
       } else {
           (undef,$udom,$uname)=split(/\//,$uri);
           if(defined($userdomain)) {
               $udom = $userdomain;
           }
           if(defined($username)) {
               $uname = $username;
           }
     }      }
       my ($dirRoot,$listing,@listing_results);
   
     my $dirRoot = $perlvar{'lonDocRoot'};      $dirRoot = $perlvar{'lonDocRoot'};
     if(defined($alternateDirectoryRoot)) {      if (defined($getpropath)) {
         $dirRoot = $alternateDirectoryRoot;          $dirRoot = &propath($udom,$uname);
         $dirRoot =~ s/\/$//;          $dirRoot =~ s/\/$//;
       } elsif (defined($getuserdir)) {
           my $subdir=$uname.'__';
           $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
           $dirRoot = $Apache::lonnet::perlvar{'lonUsersDir'}
                      ."/$udom/$subdir/$uname";
       } elsif (defined($alternateRoot)) {
           $dirRoot = $alternateRoot;
     }      }
   
     if($udom) {      if($udom) {
         if($uname) {          if($uname) {
             my $listing = &reply('ls2:'.$dirRoot.'/'.$uri,              $listing = &reply('ls3:'.&escape('/'.$uri).':'.$getpropath.':'
  &homeserver($uname,$udom));                                .$getuserdir.':'.&escape($dirRoot)
             my @listing_results;                                .':'.&escape($uname).':'.&escape($udom),
                                 &homeserver($uname,$udom));
               if ($listing eq 'unknown_cmd') {
                   $listing = &reply('ls2:'.$dirRoot.'/'.$uri,
                                     &homeserver($uname,$udom));
               } else {
                   @listing_results = map { &unescape($_); } split(/:/,$listing);
               }
             if ($listing eq 'unknown_cmd') {              if ($listing eq 'unknown_cmd') {
                 $listing = &reply('ls:'.$dirRoot.'/'.$uri,                  $listing = &reply('ls:'.$dirRoot.'/'.$uri,
   &homeserver($uname,$udom));    &homeserver($uname,$udom));
Line 6254  sub dirlist { Line 6366  sub dirlist {
                 @listing_results = map { &unescape($_); } split(/:/,$listing);                  @listing_results = map { &unescape($_); } split(/:/,$listing);
             }              }
             return @listing_results;              return @listing_results;
         } elsif(!defined($alternateDirectoryRoot)) {          } elsif(!$alternateRoot) {
             my %allusers;              my %allusers;
     my %servers = &get_servers($udom,'library');      my %servers = &get_servers($udom,'library');
     foreach my $tryserver (keys(%servers)) {       foreach my $tryserver (keys(%servers)) {
  my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.                  $listing = &reply('ls3:'.&escape("/res/$udom").':::::'.
      $udom, $tryserver);                                    &escape($udom),$tryserver);
  my @listing_results;                  if ($listing eq 'unknown_cmd') {
       $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
         $udom, $tryserver);
                   } else {
                       @listing_results = map { &unescape($_); } split(/:/,$listing);
                   }
  if ($listing eq 'unknown_cmd') {   if ($listing eq 'unknown_cmd') {
     $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.      $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
       $udom, $tryserver);        $udom, $tryserver);
Line 6287  sub dirlist { Line 6404  sub dirlist {
         } else {          } else {
             return ('missing user name');              return ('missing user name');
         }          }
     } elsif(!defined($alternateDirectoryRoot)) {      } elsif(!defined($getpropath)) {
         my @all_domains = sort(&all_domains());          my @all_domains = sort(&all_domains());
          foreach my $domain (@all_domains) {          foreach my $domain (@all_domains) {
              $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain';              $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain';
          }          }
          return @all_domains;          return @all_domains;
      } else {      } else {
         return ('missing domain');          return ('missing domain');
     }      }
 }  }
Line 6303  sub dirlist { Line 6420  sub dirlist {
 # when it was last modified.  It will also return an error of -1  # when it was last modified.  It will also return an error of -1
 # if an error occurs  # if an error occurs
   
 ##  
 ## FIXME: This subroutine assumes its caller knows something about the  
 ## directory structure of the home server for the student ($root).  
 ## Not a good assumption to make.  Since this is for looking up files  
 ## in user directories, the full path should be constructed by lond, not  
 ## whatever machine we request data from.  
 ##  
 sub GetFileTimestamp {  sub GetFileTimestamp {
     my ($studentDomain,$studentName,$filename,$root)=@_;      my ($studentDomain,$studentName,$filename,$getuserdir)=@_;
     $studentDomain = &LONCAPA::clean_domain($studentDomain);      $studentDomain = &LONCAPA::clean_domain($studentDomain);
     $studentName   = &LONCAPA::clean_username($studentName);      $studentName   = &LONCAPA::clean_username($studentName);
     my $subdir=$studentName.'__';      my ($fileStat) = 
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;          &Apache::lonnet::dirlist($filename,$studentDomain,$studentName, 
     my $proname="$studentDomain/$subdir/$studentName";                                   undef,$getuserdir);
     $proname .= '/'.$filename;  
     my ($fileStat) = &Apache::lonnet::dirlist($proname, $studentDomain,   
                                               $studentName, $root);  
     my @stats = split('&', $fileStat);      my @stats = split('&', $fileStat);
     if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {      if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
         # @stats contains first the filename, then the stat output          # @stats contains first the filename, then the stat output
Line 6333  sub stat_file { Line 6440  sub stat_file {
     my ($uri) = @_;      my ($uri) = @_;
     $uri = &clutter_with_no_wrapper($uri);      $uri = &clutter_with_no_wrapper($uri);
   
     my ($udom,$uname,$file,$dir);      my ($udom,$uname,$file);
     if ($uri =~ m-^/(uploaded|editupload)/-) {      if ($uri =~ m-^/(uploaded|editupload)/-) {
  ($udom,$uname,$file) =   ($udom,$uname,$file) =
     ($uri =~ m-/(?:uploaded|editupload)/?($match_domain)/?($match_name)/?(.*)-);      ($uri =~ m-/(?:uploaded|editupload)/?($match_domain)/?($match_name)/?(.*)-);
  $file = 'userfiles/'.$file;   $file = 'userfiles/'.$file;
  $dir = &propath($udom,$uname);  
     }      }
     if ($uri =~ m-^/res/-) {      if ($uri =~ m-^/res/-) {
  ($udom,$uname) =    ($udom,$uname) = 
Line 6350  sub stat_file { Line 6456  sub stat_file {
  # unable to handle the uri   # unable to handle the uri
  return ();   return ();
     }      }
       my $getpropath;
     my ($result) = &dirlist($file,$udom,$uname,$dir);      if ($file =~ /^userfiles\//) {
           $getpropath = 1;
       }
       my ($result) = &dirlist($file,$udom,$uname,$getpropath);
     my @stats = split('&', $result);      my @stats = split('&', $result);
           
     if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {      if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
Line 8096  sub filelocation { Line 8205  sub filelocation {
     } elsif ($file=~m{^/home/$match_username/public_html/}) {      } elsif ($file=~m{^/home/$match_username/public_html/}) {
  # is a correct contruction space reference   # is a correct contruction space reference
         $location = $file;          $location = $file;
       } elsif ($file =~ m-^\Q$Apache::lonnet::perlvar{'lonTabDir'}\E/-) {
           $location = $file;
     } elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file      } elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file
         my ($udom,$uname,$filename)=          my ($udom,$uname,$filename)=
      ($file=~m -^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$-);       ($file=~m -^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$-);
Line 8104  sub filelocation { Line 8215  sub filelocation {
         my @ids=&current_machine_ids();          my @ids=&current_machine_ids();
         foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } }          foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } }
         if ($is_me) {          if ($is_me) {
      $location=&propath($udom,$uname).       $location=&propath($udom,$uname).'/userfiles/'.$filename;
        '/userfiles/'.$filename;  
         } else {          } else {
    $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.     $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
        $udom.'/'.$uname.'/'.$filename;         $udom.'/'.$uname.'/'.$filename;
Line 8701  $memcache=new Cache::Memcached({'servers Line 8811  $memcache=new Cache::Memcached({'servers
   
 $processmarker='_'.time.'_'.$perlvar{'lonHostID'};  $processmarker='_'.time.'_'.$perlvar{'lonHostID'};
 $dumpcount=0;  $dumpcount=0;
   $locknum=0;
   
 &logtouch();  &logtouch();
 &logthis('<font color="yellow">INFO: Read configuration</font>');  &logthis('<font color="yellow">INFO: Read configuration</font>');
Line 9018  provided for types, will default to retu Line 9129  provided for types, will default to retu
   
 =item *  =item *
   
 assignrole($udom,$uname,$url,$role,$end,$start) : assign role; give a role to a  assignrole($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll,$context) : assign role; give a role to a
 user for the level given by URL.  Optional start and end dates (leave empty  user for the level given by URL.  Optional start and end dates (leave empty
 string or zero for "no date")  string or zero for "no date")
   
Line 9042  modify user Line 9153  modify user
   
 modifystudent  modifystudent
   
 modify a students enrollment and identification information.  modify a student's enrollment and identification information.
 The course id is resolved based on the current users environment.    The course id is resolved based on the current users environment.  
 This means the envoking user must be a course coordinator or otherwise  This means the envoking user must be a course coordinator or otherwise
 associated with a course.  associated with a course.
Line 9054  Inputs: Line 9165  Inputs:
   
 =over 4  =over 4
   
 =item B<$udom> Students loncapa domain  =item B<$udom> Student's loncapa domain
   
 =item B<$uname> Students loncapa login name  =item B<$uname> Student's loncapa login name
   
 =item B<$uid> Students id/student number  =item B<$uid> Student's id/student number
   
 =item B<$umode> Students authentication mode  =item B<$umode> Student's authentication mode
   
 =item B<$upass> Students password  =item B<$upass> Student's password
   
 =item B<$first> Students first name  =item B<$first> Student's first name
   
 =item B<$middle> Students middle name  =item B<$middle> Student's middle name
   
 =item B<$last> Students last name  =item B<$last> Student's last name
   
 =item B<$gene> Students generation  =item B<$gene> Student's generation
   
 =item B<$usec> Students section in course  =item B<$usec> Student's section in course
   
 =item B<$end> Unix time of the roles expiration  =item B<$end> Unix time of the roles expiration
   
Line 9082  Inputs: Line 9193  Inputs:
   
 =item B<$desiredhome> server to use as home server for student  =item B<$desiredhome> server to use as home server for student
   
   =item B<$email> Student's permanent e-mail address
   
   =item B<$type> Type of enrollment (auto or manual)
   
   =item B<$locktype>
   
   =item B<$cid>
   
   =item B<$selfenroll>
   
   =item B<$context>
   
 =back  =back
   
 =item *  =item *
Line 9115  Inputs: Line 9238  Inputs:
   
 =item $start  =item $start
   
   =item $type
   
   =item $locktype
   
   =item $cid
   
   =item $selfenroll
   
   =item $context
   
 =back  =back
   
   
Removed from v.1.954  
changed lines
  Added in v.1.960

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