[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.602 and 1.608

version 1.602, 2005/03/02 22:26:36 version 1.608, 2005/03/16 23:04:16
Line 911  sub make_room { Line 911  sub make_room {
 }  }
   
 sub purge_remembered {  sub purge_remembered {
     &logthis("Tossing ".scalar(keys(%remembered)));      #&logthis("Tossing ".scalar(keys(%remembered)));
     &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered))));      #&logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered))));
     undef(%remembered);      undef(%remembered);
     undef(%accessed);      undef(%accessed);
 }  }
Line 994  sub subscribe { Line 994  sub subscribe {
 sub repcopy {  sub repcopy {
     my $filename=shift;      my $filename=shift;
     $filename=~s/\/+/\//g;      $filename=~s/\/+/\//g;
     if ($filename=~m|^/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/lonUsers/|) { return 'ok'; }
     if ($filename=~m|^/home/httpd/html/userfiles/| or      if ($filename=~m|^/home/httpd/html/userfiles/| or
  $filename=~m|^/*uploaded/|) {    $filename=~m|^/*uploaded/|) { 
  return &repcopy_userfile($filename);   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'; }
     my $remoteurl=subscribe($filename);      my $remoteurl=subscribe($filename);
     if ($remoteurl =~ /^con_lost by/) {      if ($remoteurl =~ /^con_lost by/) {
    &logthis("Subscribe returned $remoteurl: $filename");     &logthis("Subscribe returned $remoteurl: $filename");
            return 'HTTP_SERVICE_UNAVAILABLE';             return 'unavailable';
     } elsif ($remoteurl eq 'not_found') {      } elsif ($remoteurl eq 'not_found') {
    #&logthis("Subscribe returned not_found: $filename");     #&logthis("Subscribe returned not_found: $filename");
    return 'HTTP_NOT_FOUND';     return 'not_found';
     } elsif ($remoteurl =~ /^rejected by/) {      } elsif ($remoteurl =~ /^rejected by/) {
    &logthis("Subscribe returned $remoteurl: $filename");     &logthis("Subscribe returned $remoteurl: $filename");
            return 'FORBIDDEN';             return 'forbidden';
     } elsif ($remoteurl eq 'directory') {      } elsif ($remoteurl eq 'directory') {
            return 'OK';             return 'ok';
     } else {      } else {
         my $author=$filename;          my $author=$filename;
         $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;          $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
Line 1025  sub repcopy { Line 1025  sub repcopy {
            my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";             my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
            if ($path ne "$perlvar{'lonDocRoot'}/res") {             if ($path ne "$perlvar{'lonDocRoot'}/res") {
                &logthis("Malconfiguration for replication: $filename");                 &logthis("Malconfiguration for replication: $filename");
        return 'HTTP_BAD_REQUEST';         return 'bad_request';
            }             }
            my $count;             my $count;
            for ($count=5;$count<$#parts;$count++) {             for ($count=5;$count<$#parts;$count++) {
Line 1042  sub repcopy { Line 1042  sub repcopy {
                my $message=$response->status_line;                 my $message=$response->status_line;
                &logthis("<font color=blue>WARNING:"                 &logthis("<font color=blue>WARNING:"
                        ." LWP get: $message: $filename</font>");                         ." LWP get: $message: $filename</font>");
                return 'HTTP_SERVICE_UNAVAILABLE';                 return 'unavailable';
            } else {             } else {
        if ($remoteurl!~/\.meta$/) {         if ($remoteurl!~/\.meta$/) {
                   my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');                    my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
Line 1054  sub repcopy { Line 1054  sub repcopy {
                   }                    }
        }         }
                rename($transname,$filename);                 rename($transname,$filename);
                return 'OK';                 return 'ok';
            }             }
        }         }
     }      }
Line 1063  sub repcopy { Line 1063  sub repcopy {
 # ------------------------------------------------ Get server side include body  # ------------------------------------------------ Get server side include body
 sub ssi_body {  sub ssi_body {
     my ($filelink,%form)=@_;      my ($filelink,%form)=@_;
       if (! exists($form{'LONCAPA_INTERNAL_no_discussion'})) {
           $form{'LONCAPA_INTERNAL_no_discussion'}='true';
       }
     my $output=($filelink=~/^http\:/?&externalssi($filelink):      my $output=($filelink=~/^http\:/?&externalssi($filelink):
                                      &ssi($filelink,%form));                                       &ssi($filelink,%form));
     $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+// END LON-CAPA Internal\s*(-->)?\s||gs;      $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+// END LON-CAPA Internal\s*(-->)?\s||gs;
Line 1196  sub process_coursefile { Line 1199  sub process_coursefile {
     return $fetchresult;      return $fetchresult;
 }  }
   
 # --------------- Take an uploaded file and put it into the userfiles directory  
 # input: name of form element, coursedoc=1 means this is for the course  
 # output: url of file in userspace  
   
 sub clean_filename {  sub clean_filename {
     my ($fname)=@_;      my ($fname)=@_;
 # Replace Windows backslashes by forward slashes  # Replace Windows backslashes by forward slashes
Line 1216  sub clean_filename { Line 1215  sub clean_filename {
     return $fname;      return $fname;
 }  }
   
   # --------------- Take an uploaded file and put it into the userfiles directory
   # input: name of form element, coursedoc=1 means this is for the course
   # output: url of file in userspace
   
   
 sub userfileupload {  sub userfileupload {
     my ($formname,$coursedoc,$subdir)=@_;      my ($formname,$coursedoc,$subdir)=@_;
     if (!defined($subdir)) { $subdir='unknown'; }      if (!defined($subdir)) { $subdir='unknown'; }
Line 3895  sub dirlist { Line 3899  sub dirlist {
   
     if($udom) {      if($udom) {
         if($uname) {          if($uname) {
             my $listing=reply('ls:'.$dirRoot.'/'.$uri,              my $listing=reply('ls2:'.$dirRoot.'/'.$uri,
                               homeserver($uname,$udom));                                homeserver($uname,$udom));
             return split(/:/,$listing);              my @listing_results;
               if ($listing eq 'unknown_cmd') {
                   $listing=reply('ls:'.$dirRoot.'/'.$uri,
                                  homeserver($uname,$udom));
                   @listing_results = split(/:/,$listing);
               } else {
                   @listing_results = map { &unescape($_); } split(/:/,$listing);
               }
               return @listing_results;
         } elsif(!defined($alternateDirectoryRoot)) {          } elsif(!defined($alternateDirectoryRoot)) {
             my $tryserver;              my $tryserver;
             my %allusers=();              my %allusers=();
             foreach $tryserver (keys %libserv) {              foreach $tryserver (keys %libserv) {
                 if($hostdom{$tryserver} eq $udom) {                  if($hostdom{$tryserver} eq $udom) {
                     my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.                      my $listing=reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
                                       $udom, $tryserver);                                        $udom, $tryserver);
                     if (($listing ne 'no_such_dir') && ($listing ne 'empty')                      my @listing_results;
                         && ($listing ne 'con_lost')) {                      if ($listing eq 'unknown_cmd') {
                         foreach (split(/:/,$listing)) {                          $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
                                          $udom, $tryserver);
                           @listing_results = split(/:/,$listing);
                       } else {
                           @listing_results =
                               map { &unescape($_); } split(/:/,$listing);
                       }
                       if ($listing_results[0] ne 'no_such_dir' && 
                           $listing_results[0] ne 'empty'       &&
                           $listing_results[0] ne 'con_lost') {
                           foreach (@listing_results) {
                             my ($entry,@stat)=split(/&/,$_);                              my ($entry,@stat)=split(/&/,$_);
                             $allusers{$entry}=1;                              $allusers{$entry}=1;
                         }                          }
Line 5238  sub getfile { Line 5260  sub getfile {
 sub repcopy_userfile {  sub repcopy_userfile {
     my ($file)=@_;      my ($file)=@_;
     if ($file =~ m|^/*uploaded/|) { $file=&filelocation("",$file); }      if ($file =~ m|^/*uploaded/|) { $file=&filelocation("",$file); }
     if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'OK'; }      if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'ok'; }
     my ($cdom,$cnum,$filename) =       my ($cdom,$cnum,$filename) = 
  ($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+([^/]+)/+([^/]+)/+(.*)|);   ($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+([^/]+)/+([^/]+)/+(.*)|);
     my ($info,$rtncode);      my ($info,$rtncode);
Line 5261  sub repcopy_userfile { Line 5283  sub repcopy_userfile {
     return -1;      return -1;
  }   }
  if ($info < $fileinfo[9]) {   if ($info < $fileinfo[9]) {
     return 'OK';      return 'ok';
  }   }
  $info = '';   $info = '';
  $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode);   $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode);
Line 5295  sub repcopy_userfile { Line 5317  sub repcopy_userfile {
     open(FILE,">$file");      open(FILE,">$file");
     print FILE $info;      print FILE $info;
     close(FILE);      close(FILE);
     return 'OK';      return 'ok';
 }  }
   
 sub tokenwrapper {  sub tokenwrapper {
Line 5366  sub filelocation { Line 5388  sub filelocation {
    $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.     $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
        $udom.'/'.$uname.'/'.$filename;         $udom.'/'.$uname.'/'.$filename;
         }          }
     } elsif ($file =~ /^\/adm\/portfolio\//) {  
         $file =~ s:^/adm/portfolio/::;  
         $location = $location=&Apache::loncommon::propath($ENV{'user.domain'},$ENV{'user.name'}).'/userfiles/portfolio/'.$file;  
     } else {      } else {
         $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;          $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
         $file=~s:^/res/:/:;          $file=~s:^/res/:/:;
Line 6115  subscribe($fname) : subscribe to a resou Line 6134  subscribe($fname) : subscribe to a resou
   
 repcopy($filename) : subscribes to the requested file, and attempts to  repcopy($filename) : subscribes to the requested file, and attempts to
 replicate from the owning library server, Might return  replicate from the owning library server, Might return
 'HTTP_SERVICE_UNAVAILABLE', 'HTTP_NOT_FOUND', 'FORBIDDEN', 'OK', or  'unavailable', 'not_found', 'forbidden', 'ok', or
 'HTTP_BAD_REQUEST', also attempts to grab the metadata for the  'bad_request', also attempts to grab the metadata for the
 resource. Expects the local filesystem pathname  resource. Expects the local filesystem pathname
 (/home/httpd/html/res/....)  (/home/httpd/html/res/....)
   
Line 6458  declutter() : declutters URLs (remove do Line 6477  declutter() : declutters URLs (remove do
   
 =back  =back
   
   =head2 Usererfile file routines (/uploaded*)
   
   =over 4
   
   =item *
   
   userfileupload(): main rotine for putting a file in a user or course's
                     filespace, arguments are,
   
    formname - required - this is the name of the element in $ENV where the
              filename, and the contents of the file to create/modifed exist
              the filename is in $ENV{'form.'.$formname.'.filename'} and the
              contents of the file is located in $ENV{'form.'.$formname}
    coursedoc - if true, store the file in the course of the active role
                of the current user
    subdir - required - subdirectory to put the file in under ../userfiles/
            if undefined, it will be placed in "unknown"
   
    (This routine calls clean_filename() to remove any dangerous
    characters from the filename, and then calls finuserfileupload() to
    complete the transaction)
   
    returns either the url of the uploaded file (/uploaded/....) if successful
    and /adm/notfound.html if unsuccessful
   
   =item *
   
   clean_filename(): routine for cleaing a filename up for storage in
                    userfile space, argument is:
   
    filename - proposed filename
   
   returns: the new clean filename
   
   =item *
   
   finishuserfileupload(): routine that creaes and sends the file to
   userspace, probably shouldn't be called directly
   
     docuname: username or courseid of destination for the file
     docudom: domain of user/course of destination for the file
     docuhome: loncapa id of the library server that is getting the file
     formname: same as for userfileupload()
     fname: filename (inculding subdirectories) for the file
   
    returns either the url of the uploaded file (/uploaded/....) if successful
    and /adm/notfound.html if unsuccessful
   
   =item *
   
   renameuserfile(): renames an existing userfile to a new name
   
     Args:
      docuname: username or courseid of destination for the file
      docudom: domain of user/course of destination for the file
      old: current file name (including any subdirs under userfiles)
      new: desired file name (including any subdirs under userfiles)
   
   =item *
   
   mkdiruserfile(): creates a directory is a userfiles dir
   
     Args:
      docuname: username or courseid of destination for the file
      docudom: domain of user/course of destination for the file
      dir: dir to create (including any subdirs under userfiles)
   
   =item *
   
   removeuserfile(): removes a file that exists in userfiles
   
     Args:
      docuname: username or courseid of destination for the file
      docudom: domain of user/course of destination for the file
      fname: filname to delete (including any subdirs under userfiles)
   
   =item *
   
   removeuploadedurl(): convience function for removeuserfile()
   
     Args:
      url:  a full /uploaded/... url to delete
   
   =back
   
 =head2 HTTP Helper Routines  =head2 HTTP Helper Routines
   
 =over 4  =over 4
Removed from v.1.602  
changed lines
  Added in v.1.608

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