[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.534 and 1.539

version 1.534, 2004/08/27 21:09:22 version 1.539, 2004/09/02 21:23:13
Line 50  use Fcntl qw(:flock); Line 50  use Fcntl qw(:flock);
 use Apache::loncoursedata;  use Apache::loncoursedata;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw);  use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw);
 use Time::HiRes();  use Time::HiRes qw( gettimeofday tv_interval );
 my $readit;  my $readit;
   
 =pod  =pod
Line 1067  sub subscribe { Line 1067  sub subscribe {
 sub repcopy {  sub repcopy {
     my $filename=shift;      my $filename=shift;
     $filename=~s/\/+/\//g;      $filename=~s/\/+/\//g;
     if ($filename=~/^\/home\/httpd\/html\/adm\//) { return OK; }      if ($filename=~m|^/home/httpd/html/adm/|) { return OK; }
       if ($filename=~m|^/home/httpd/html/lonUsers/|) { return OK; }
       if ($filename=~m|^/home/httpd/html/userfiles/| or
    $filename=~m|^/*uploaded/|) { 
    return &repcopy_userfile($filename);
       }
     $filename=~s/[\n\r]//g;      $filename=~s/[\n\r]//g;
     my $transname="$filename.in.transfer";      my $transname="$filename.in.transfer";
     if ((-e $filename) || (-e $transname)) { return OK; }      if ((-e $filename) || (-e $transname)) { return OK; }
Line 3680  sub revokecustomrole { Line 3685  sub revokecustomrole {
 }  }
   
 # ------------------------------------------------------------ Disk usage  # ------------------------------------------------------------ Disk usage
 sub diskusage{  sub diskusage {
     my ($udom,$uname,$directoryRoot)=@_;      my ($udom,$uname,$directoryRoot)=@_;
     $directoryRoot =~ s/\/$//;      $directoryRoot =~ s/\/$//;
     my $listing=reply('du:'.$directoryRoot,homeserver($uname,$udom))      my $listing=&reply('du:'.$directoryRoot,homeserver($uname,$udom));
     return $listing;      return $listing;
 }  }
   
Line 4021  sub EXT { Line 4026  sub EXT {
   
  my $section;   my $section;
  if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) {   if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) {
       if (!$symbparm) { $symbparm=&symbread(); }
    }
    if ($symbparm && defined($courseid) && 
       $courseid eq $ENV{'request.course.id'}) {
   
     #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;      #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
   
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
     if (!$symbparm) { $symbparm=&symbread(); }  
     my $symbp=$symbparm;      my $symbp=$symbparm;
     my $mapp=(&decode_symb($symbp))[0];      my $mapp=(&decode_symb($symbp))[0];
   
Line 4036  sub EXT { Line 4044  sub EXT {
  ($ENV{'user.domain'} eq $udom)) {   ($ENV{'user.domain'} eq $udom)) {
  $section=$ENV{'request.course.sec'};   $section=$ENV{'request.course.sec'};
     } else {      } else {
                 if (! defined($usection)) {   if (! defined($usection)) {
                     $section=&usection($udom,$uname,$courseid);      $section=&usection($udom,$uname,$courseid);
                 } else {   } else {
                     $section = $usection;      $section = $usection;
                 }   }
     }      }
   
     my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;      my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
Line 4078  sub EXT { Line 4086  sub EXT {
  $uname." at ".$udom.": ".   $uname." at ".$udom.": ".
  $tmp."</font>");   $tmp."</font>");
     } elsif ($tmp=~/error: 2 /) {      } elsif ($tmp=~/error: 2 /) {
                         &EXT_cache_set($udom,$uname);   &EXT_cache_set($udom,$uname);
     } elsif ($tmp =~ /^(con_lost|no_such_host)/) {      } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
  return $tmp;   return $tmp;
     }      }
Line 4088  sub EXT { Line 4096  sub EXT {
 # -------------------------------------------------------- second, check course  # -------------------------------------------------------- second, check course
   
     my $coursereply=&courseresdata($ENV{'course.'.$courseid.'.num'},      my $coursereply=&courseresdata($ENV{'course.'.$courseid.'.num'},
   $ENV{'course.'.$courseid.'.domain'},     $ENV{'course.'.$courseid.'.domain'},
   ($seclevelr,$seclevelm,$seclevel,     ($seclevelr,$seclevelm,$seclevel,
    $courselevelr,$courselevelm,      $courselevelr,$courselevelm,
    $courselevel));      $courselevel));
     if (defined($coursereply)) { return $coursereply; }      if (defined($coursereply)) { return $coursereply; }
   
 # ------------------------------------------------------ third, check map parms  # ------------------------------------------------------ third, check map parms
Line 4591  sub deversion { Line 4599  sub deversion {
   
 sub symbread {  sub symbread {
     my ($thisfn,$donotrecurse)=@_;      my ($thisfn,$donotrecurse)=@_;
       if (defined($ENV{'request.symbread.cached'})) {
    return $ENV{'request.symbread.cached'};
       }
 # no filename provided? try from environment  # no filename provided? try from environment
     unless ($thisfn) {      unless ($thisfn) {
         if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); }          if ($ENV{'request.symb'}) {
       $ENV{'request.symbread.cached'}=&symbclean($ENV{'request.symb'});
       return $ENV{'request.symbread.cached'};
    }
  $thisfn=$ENV{'request.filename'};   $thisfn=$ENV{'request.filename'};
     }      }
 # is that filename actually a symb? Verify, clean, and return  # is that filename actually a symb? Verify, clean, and return
     if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) {      if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) {
  if (&symbverify($thisfn,$1)) { return &symbclean($thisfn); }   if (&symbverify($thisfn,$1)) {
       $ENV{'request.symbread.cached'}=&symbclean($thisfn);
       return $ENV{'request.symbread.cached'};
    }
     }      }
     $thisfn=declutter($thisfn);      $thisfn=declutter($thisfn);
     my %hash;      my %hash;
Line 4619  sub symbread { Line 4636  sub symbread {
            unless ($syval=~/\_\d+$/) {             unless ($syval=~/\_\d+$/) {
        unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) {         unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) {
                   &appenv('request.ambiguous' => $thisfn);                    &appenv('request.ambiguous' => $thisfn);
     $ENV{'request.symbread.cached'}='';
                   return '';                    return '';
                }                     }    
                $syval.=$1;                 $syval.=$1;
Line 4666  sub symbread { Line 4684  sub symbread {
            }             }
         }          }
         if ($syval) {          if ($syval) {
            return &symbclean($syval.'___'.$thisfn);       $ENV{'request.symbread.cached'}=&symbclean($syval.'___'.$thisfn);
       return $ENV{'request.symbread.cached'};
         }          }
     }      }
     &appenv('request.ambiguous' => $thisfn);      &appenv('request.ambiguous' => $thisfn);
       $ENV{'request.symbread.cached'}='';
     return '';      return '';
 }  }
   
Line 4931  sub receipt { Line 4951  sub receipt {
 # the local server.     # the local server.   
   
 sub getfile {  sub getfile {
     my ($file,$caller) = @_;      my ($file) = @_;
   
     if ($file !~ m|^/*uploaded/(\w+)/(\w+)/(.+)$|) {      if ($file =~ m|^/*uploaded/|) { $file=&filelocation("",$file); }
  # normal file from res space      &repcopy($file);
  &repcopy($file);      return &readfile($file);
         return &readfile($file);  }
     }  
   sub repcopy_userfile {
     my $info;      my ($file)=@_;
     my $cdom = $1;  
     my $cnum = $2;      if ($file =~ m|^/*uploaded/|) { $file=&filelocation("",$file); }
     my $filename = $3;      if ($file =~ m|^/home/httpd/html/lonUsers/|) { return OK; }
     my $path = $Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles';  
     my ($lwpresp,$rtncode);      my ($cdom,$cnum,$filename) = 
     my $localfile = $path.'/'.$cdom.'/'.$cnum.'/'.$filename;   ($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+([^/]+)/+([^/]+)/+(.*)|);
     if (-e "$localfile") {      my ($info,$rtncode);
  my @fileinfo = stat($localfile);      my $uri="/uploaded/$cdom/$cnum/$filename";
  $lwpresp = &getuploaded('HEAD',$file,$cdom,$cnum,\$info,\$rtncode);      if (-e "$file") {
    my @fileinfo = stat($file);
    my $lwpresp = &getuploaded('HEAD',$uri,$cdom,$cnum,\$info,\$rtncode);
  if ($lwpresp ne 'ok') {   if ($lwpresp ne 'ok') {
     if ($rtncode eq '404') {      if ($rtncode eq '404') {
  unlink($localfile);   unlink($file);
     }      }
     #my $ua=new LWP::UserAgent;      #my $ua=new LWP::UserAgent;
     #my $request=new HTTP::Request('GET',&tokenwrapper($file));      #my $request=new HTTP::Request('GET',&tokenwrapper($uri));
     #my $response=$ua->request($request);      #my $response=$ua->request($request);
     #if ($response->is_success()) {      #if ($response->is_success()) {
  # return $response->content;   # return $response->content;
Line 4964  sub getfile { Line 4986  sub getfile {
     return -1;      return -1;
  }   }
  if ($info < $fileinfo[9]) {   if ($info < $fileinfo[9]) {
     return &readfile($localfile);      return OK;
  }   }
  $info = '';   $info = '';
  $lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode);   $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode);
  if ($lwpresp ne 'ok') {   if ($lwpresp ne 'ok') {
     return -1;      return -1;
  }   }
     } else {      } else {
  $lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode);   my $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode);
  if ($lwpresp ne 'ok') {   if ($lwpresp ne 'ok') {
     my $ua=new LWP::UserAgent;      my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request('GET',&tokenwrapper($file));      my $request=new HTTP::Request('GET',&tokenwrapper($uri));
     my $response=$ua->request($request);      my $response=$ua->request($request);
     if ($response->is_success()) {      if ($response->is_success()) {
  return $response->content;   $info=$response->content;
     } else {      } else {
  return -1;   return -1;
     }      }
Line 4987  sub getfile { Line 5009  sub getfile {
  if ($filename =~ m|^(.+)/[^/]+$|) {   if ($filename =~ m|^(.+)/[^/]+$|) {
     push @parts, split(/\//,$1);      push @parts, split(/\//,$1);
  }   }
    my $path = $perlvar{'lonDocRoot'}.'/userfiles';
  foreach my $part (@parts) {   foreach my $part (@parts) {
     $path .= '/'.$part;      $path .= '/'.$part;
     if (!-e $path) {      if (!-e $path) {
Line 4994  sub getfile { Line 5017  sub getfile {
     }      }
  }   }
     }      }
     open (FILE,">$localfile");      open(FILE,">$file");
     print FILE $info;      print FILE $info;
     close(FILE);      close(FILE);
     if ($caller eq 'uploadrep') {      return OK;
  return 'ok';  
     }  
     return $info;  
 }  }
   
 sub tokenwrapper {  sub tokenwrapper {
Line 5056  sub filelocation { Line 5076  sub filelocation {
     $location = $file;      $location = $file;
     $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;      $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
   } elsif ($file=~/^\/*uploaded/) { # is an uploaded file    } elsif ($file=~/^\/*uploaded/) { # is an uploaded file
       if ($file=~/^\/uploaded\/([^\/]+)\/([^\/]+)\/(\/)?simplepage\/([^\/]+)$/) {        my ($udom,$uname,$filename)=
   $location=&Apache::loncommon::propath($1,$2).'/userfiles/simplepage/'.$4;    ($file=~m|^/+uploaded/+([^/]+)/+([^/]+)/+(.*)$|);
   if (not -e $location) {        my $home=&homeserver($uname,$udom);
       $file=~/^\/uploaded\/(.*)$/;        my $is_me=0;
       $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.$1;        my @ids=&current_machine_ids();
   }        foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } }
       } elsif ($file=~/^\/uploaded\/([^\/]+)\/([^\/]+)\/aboutme\/([^\/]+)$/) {        if ($is_me) {
   $location=&Apache::loncommon::propath($1,$2).'/userfiles/aboutme/'.$3;    $location=&Apache::loncommon::propath($udom,$uname).
          if (not -e $location) {        '/userfiles/'.$filename;
      $file=~/^\/uploaded\/(.*)$/;  
      $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.$1;  
          }  
       } else {        } else {
   $location=$file;    $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
         $udom.'/'.$uname.'/'.$filename;
       }        }
   } else {    } else {
     $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;      $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
Line 5266  BEGIN { Line 5284  BEGIN {
  $hostip{$id}=$ip;   $hostip{$id}=$ip;
  $iphost{$ip}=$id;   $iphost{$ip}=$id;
  if ($role eq 'library') { $libserv{$id}=$name; }   if ($role eq 'library') { $libserv{$id}=$name; }
        } else {  
  if ($configline) {  
    &logthis("Skipping hosts.tab line -$configline-");  
  }  
        }         }
     }      }
     close($config);      close($config);
Removed from v.1.534  
changed lines
  Added in v.1.539

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