[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.480 and 1.481

version 1.480, 2004/03/30 20:46:24 version 1.481, 2004/03/31 19:25:08
Line 32  package Apache::lonnet; Line 32  package Apache::lonnet;
 use strict;  use strict;
 use LWP::UserAgent();  use LWP::UserAgent();
 use HTTP::Headers;  use HTTP::Headers;
   use Date::Parse;
 use vars   use vars 
 qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom   qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom 
    %libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache     %libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache
Line 1200  sub tokenwrapper { Line 1201  sub tokenwrapper {
 #         and will then be copied to  #         and will then be copied to
 #          /home/httpd/lonUsers/$domain/1/2/3/$course/userfiles/$file in  #          /home/httpd/lonUsers/$domain/1/2/3/$course/userfiles/$file in
 #         course's home server.  #         course's home server.
   # action = uploaddoc - /home/httpd/html/userfiles/$domain/1/2/3/$course/$file
   #         will be retrived from $ENV{form.$source} via DOCS interface to
   #         /home/httpd/html/userfiles/$domain/1/2/3/$course/$file
   #         and will then be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles/$file
   #         in course's home server.
   
   
 sub process_coursefile {  sub process_coursefile {
     my ($action,$docuname,$docudom,$docuhome,$file,$source)=@_;      my ($action,$docuname,$docudom,$docuhome,$file,$source)=@_;
Line 1207  sub process_coursefile { Line 1214  sub process_coursefile {
     if ($action eq 'propagate') {      if ($action eq 'propagate') {
         $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file          $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file
                             ,$docuhome);                              ,$docuhome);
     } elsif ($action eq 'copy') {      } else {
         my $fetchresult = '';          my $fetchresult = '';
         my $fpath = '';          my $fpath = '';
         my $fname = $file;          my $fname = $file;
Line 1223  sub process_coursefile { Line 1230  sub process_coursefile {
                 }                  }
             }              }
         }          }
         if ($source eq '') {          if ($action eq 'copy') {
             $fetchresult = 'no source file';              if ($source eq '') {
         } else {                  $fetchresult = 'no source file';
             my $destination = $filepath.'/'.$fname;                  return $fetchresult;
             print STDERR "Getting ready to rename $source to $destination\n";              } else {
             rename($source,$destination);                  my $destination = $filepath.'/'.$fname;
                   rename($source,$destination);
                   $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                                    $docuhome);
               }
           } elsif ($action eq 'uploaddoc') {
               open(my $fh,'>'.$filepath.'/'.$fname);
               print $fh $ENV{'form.'.$source};
               close($fh);
             $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,              $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                                  $docuhome);                                   $docuhome);
               if ($fetchresult eq 'ok') {
                   return '/uploaded/'.$fpath.'/'.$fname;
               } else {
                   &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
                           ' to host '.$docuhome.': '.$fetchresult);
                   return '/adm/notfound.html';
               }
         }          }
     }      }
     unless ( ($fetchresult eq 'ok') || ($fetchresult eq 'no source file') ) {      unless ( ($fetchresult eq 'ok') || ($fetchresult eq 'no source file') ) {
Line 1258  sub userfileupload { Line 1280  sub userfileupload {
 # See if there is anything left  # See if there is anything left
     unless ($fname) { return 'error: no uploaded file'; }      unless ($fname) { return 'error: no uploaded file'; }
     chop($ENV{'form.'.$formname});      chop($ENV{'form.'.$formname});
       my $url = '';
 # Create the directory if not present  # Create the directory if not present
     my $docuname='';      my $docuname='';
     my $docudom='';      my $docudom='';
Line 1266  sub userfileupload { Line 1289  sub userfileupload {
  $docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};   $docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
  $docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};   $docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
  $docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};   $docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
           if ($ENV{'form.folder'} =~ m/^default/) {
               $url = &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);
           } else {
               $fname=$ENV{'form.folder'}.'/'.$fname;
               $url = &process_coursefile('uploaddoc',$docuname,$docudom,$docuhome,$fname,$formname);
           }
     } else {      } else {
         $docuname=$ENV{'user.name'};          $docuname=$ENV{'user.name'};
         $docudom=$ENV{'user.domain'};          $docudom=$ENV{'user.domain'};
Line 4267  sub symbread { Line 4296  sub symbread {
     my %bighash;      my %bighash;
     my $syval='';      my $syval='';
     if (($ENV{'request.course.fn'}) && ($thisfn)) {      if (($ENV{'request.course.fn'}) && ($thisfn)) {
           my $targetfn = $thisfn;
           if ( ($thisfn =~ m/^uploaded\//) && ($thisfn !~ m/\.(page|sequence)$/) ) {
               $targetfn = 'adm/wrapper/'.$thisfn;
           }
         if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',          if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
                       &GDBM_READER(),0640)) {                        &GDBM_READER(),0640)) {
     $syval=$hash{$thisfn};      $syval=$hash{$targetfn};
             untie(%hash);              untie(%hash);
         }          }
 # ---------------------------------------------------------- There was an entry  # ---------------------------------------------------------- There was an entry
Line 4321  sub symbread { Line 4354  sub symbread {
                  }                   }
       }        }
               untie(%bighash)                untie(%bighash)
            }              }
         }          }
         if ($syval) {          if ($syval) {
            return &symbclean($syval.'___'.$thisfn);              return &symbclean($syval.'___'.$thisfn); 
Line 4524  sub receipt { Line 4557  sub receipt {
 # ------------------------------------------------------------ Serves up a file  # ------------------------------------------------------------ Serves up a file
 # returns either the contents of the file or   # returns either the contents of the file or 
 # -1 if the file doesn't exist  # -1 if the file doesn't exist
 # -2 if an error occured when trying to aqcuire the file  #
   # if the target is a file that was uploaded via DOCS, 
   # a check will be made to see if a current copy exists on the local server,
   # if it does this will be served, otherwise a copy will be retrieved from
   # the home server for the course and stored in /home/httpd/html/userfiles on
   # the local server.   
   
 sub getfile {  sub getfile {
     my $file=shift;      my ($file,$caller) = @_;
     if ($file=~/^\/*uploaded\//) { # user file      if ($file=~ m|^/*uploaded/(\w+)/(\w+)/(.+)$|) { # user file
  my $ua=new LWP::UserAgent;          my $info;
  my $request=new HTTP::Request('GET',&tokenwrapper($file));          my $cdom = $1;
  my $response=$ua->request($request);          my $cnum = $2;
  if ($response->is_success()) {          my $filename = $3;
     return $response->content;          my $path = $Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles';
  } else {           my ($lwpresp,$rtncode);
     #&logthis("Return Code is ".$response->code." for $file ".          my $localfile = $path.'/'.$cdom.'/'.$cnum.'/'.$filename;
     #         &tokenwrapper($file));          if (-e "$localfile") {
     # 500 for ISE when tokenwrapper can't figure out what server to              my @fileinfo = stat($localfile);
             #  contact              $lwpresp = &getuploaded('HEAD',$file,$cdom,$cnum,\$info,\$rtncode);
             # 503 when lonuploadacc can't contact the requested server              if ($lwpresp eq 'ok') {
     if ($response->code eq 503 || $response->code eq 500) {                  if ($info > $fileinfo[9]) {
  return -2;                      $info = '';
     } else {                      $lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode);
  return -1;                      if ($lwpresp eq 'ok') {
     }                          open (FILE,">$localfile");
  }                          print FILE $info;
                           close(FILE);
                           if ($caller eq 'uploadrep') {
                               return 'ok';
                           } else {
                               return $info;
                           }
                       } else {
                           return -1;
                       }
           } else {
                       return &readfile($localfile);
                   }
               } else {
                   if ($rtncode eq '404') {
                       unlink($localfile);
                   }
                   return -1;
               }
    } else {
               $lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode);
               if ($lwpresp eq 'ok') {
                   my @parts = ($cdom,$cnum); 
                   if ($filename =~ m|^(.+)/[^/]+$|) {
                       push @parts, split(/\//,$1);
                   }
                   foreach my $part (@parts) {
                       $path .= '/'.$part;
                       if (!-e $path) {
                           mkdir($path,0770);
                       }
                   }
                   open (FILE,">$localfile");
                   print FILE $info;
                   close(FILE);
                   if ($caller eq 'uploadrep') {
                       return 'ok';
                   } else {
                       return $info;
                   }
               } else {
                   return -1;
               }
           }
     } else { # normal file from res space      } else { # normal file from res space
  &repcopy($file);   &repcopy($file);
  if (! -e $file ) { return -1; };          return &readfile($file);
  my $fh;  
  open($fh,"<$file");  
  my $a='';  
  while (<$fh>) { $a .=$_; }  
  return $a;  
     }      }
 }  }
   
   sub getuploaded {
       my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
       $uri=~s/^\///;
       $uri = 'http://'.$hostname{ &homeserver($cnum,$cdom)}.'/raw/'.$uri;
       my $ua=new LWP::UserAgent;
       my $request=new HTTP::Request($reqtype,$uri);
       my $response=$ua->request($request);
       $$rtncode = $response->code;
       if ($response->is_success()) {
           if ($reqtype eq 'HEAD') {
               $$info = &Date::Parse::str2time( $response->header('Last-modified') );
           } elsif ($reqtype eq 'GET') {
               $$info = $response->content;
           }
           return 'ok';
       } else {
           return 'failed';
       }
   }
   
   sub readfile {
       my $file = shift;
       if ( (! -e $file ) || ($file eq '') ) { return -1; };
       my $fh;
       open($fh,"<$file");
       my $a='';
       while (<$fh>) { $a .=$_; }
       return $a;
   }
   
 sub filelocation {  sub filelocation {
   my ($dir,$file) = @_;    my ($dir,$file) = @_;
   my $location;    my $location;
Line 5560  messages of critical importance should g Line 5666  messages of critical importance should g
   
 =item *  =item *
   
 getfile($file) : returns the entire contents of a file or -1; it  getfile($file,$caller) : two cases - requests for files in /res or in /uploaded.
 properly subscribes to and replicates the file if neccessary.  (a) files in /uploaded
     (i) If a local copy of the file exists - 
         compares modification date of local copy with last-modified date for 
         definitive version stored on home server for course. If local copy is 
         stale, requests a new version from the home server and stores it. 
         If the original has been removed from the home server, then local copy 
         is unlinked.
     (ii) If local copy does not exist -
         requests the file from the home server and stores it. 
     
     If $caller is 'uploadrep':  
       This indicates a call from lonuploadrep.pm (PerlHeaderParserHandler phase)
       for request for files originally uploaded via DOCS. 
        - returns 'ok' if fresh local copy now available, -1 otherwise.
     
     Otherwise:
        This indicates a call from the content generation phase of the request.
        -  returns the entire contents of the file or -1.
        
   (b) files in /res
      - returns the entire contents of a file or -1; 
      it properly subscribes to and replicates the file if neccessary.
   
 =item *  =item *
   
Removed from v.1.480  
changed lines
  Added in v.1.481

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