[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.603 and 1.607

version 1.603, 2005/03/03 05:45:50 version 1.607, 2005/03/16 21:35:17
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 3895  sub dirlist { Line 3898  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 5259  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 5282  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 5316  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 6112  subscribe($fname) : subscribe to a resou Line 6133  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/....)
   
Removed from v.1.603  
changed lines
  Added in v.1.607

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