--- loncom/lonnet/perl/lonnet.pm 2005/03/01 00:22:59 1.601
+++ loncom/lonnet/perl/lonnet.pm 2005/03/03 23:21:54 1.605
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.601 2005/03/01 00:22:59 albertel Exp $
+# $Id: lonnet.pm,v 1.605 2005/03/03 23:21:54 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -911,8 +911,8 @@ sub make_room {
}
sub purge_remembered {
- &logthis("Tossing ".scalar(keys(%remembered)));
- &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered))));
+ #&logthis("Tossing ".scalar(keys(%remembered)));
+ #&logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered))));
undef(%remembered);
undef(%accessed);
}
@@ -994,27 +994,27 @@ sub subscribe {
sub repcopy {
my $filename=shift;
$filename=~s/\/+/\//g;
- if ($filename=~m|^/home/httpd/html/adm/|) { return OK; }
- if ($filename=~m|^/home/httpd/html/lonUsers/|) { 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;
my $transname="$filename.in.transfer";
- if ((-e $filename) || (-e $transname)) { return OK; }
+ if ((-e $filename) || (-e $transname)) { return 'OK'; }
my $remoteurl=subscribe($filename);
if ($remoteurl =~ /^con_lost by/) {
&logthis("Subscribe returned $remoteurl: $filename");
- return HTTP_SERVICE_UNAVAILABLE;
+ return 'HTTP_SERVICE_UNAVAILABLE';
} elsif ($remoteurl eq 'not_found') {
#&logthis("Subscribe returned not_found: $filename");
- return HTTP_NOT_FOUND;
+ return 'HTTP_NOT_FOUND';
} elsif ($remoteurl =~ /^rejected by/) {
&logthis("Subscribe returned $remoteurl: $filename");
- return FORBIDDEN;
+ return 'FORBIDDEN';
} elsif ($remoteurl eq 'directory') {
- return OK;
+ return 'OK';
} else {
my $author=$filename;
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
@@ -1025,7 +1025,7 @@ sub repcopy {
my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
if ($path ne "$perlvar{'lonDocRoot'}/res") {
&logthis("Malconfiguration for replication: $filename");
- return HTTP_BAD_REQUEST;
+ return 'HTTP_BAD_REQUEST';
}
my $count;
for ($count=5;$count<$#parts;$count++) {
@@ -1042,7 +1042,7 @@ sub repcopy {
my $message=$response->status_line;
&logthis("<font color=blue>WARNING:"
." LWP get: $message: $filename</font>");
- return HTTP_SERVICE_UNAVAILABLE;
+ return 'HTTP_SERVICE_UNAVAILABLE';
} else {
if ($remoteurl!~/\.meta$/) {
my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
@@ -1054,7 +1054,7 @@ sub repcopy {
}
}
rename($transname,$filename);
- return OK;
+ return 'OK';
}
}
}
@@ -3895,19 +3895,37 @@ sub dirlist {
if($udom) {
if($uname) {
- my $listing=reply('ls:'.$dirRoot.'/'.$uri,
+ my $listing=reply('ls2:'.$dirRoot.'/'.$uri,
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)) {
my $tryserver;
my %allusers=();
foreach $tryserver (keys %libserv) {
if($hostdom{$tryserver} eq $udom) {
- my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
+ my $listing=reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
$udom, $tryserver);
- if (($listing ne 'no_such_dir') && ($listing ne 'empty')
- && ($listing ne 'con_lost')) {
- foreach (split(/:/,$listing)) {
+ my @listing_results;
+ if ($listing eq 'unknown_cmd') {
+ $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(/&/,$_);
$allusers{$entry}=1;
}
@@ -5237,10 +5255,8 @@ sub getfile {
sub repcopy_userfile {
my ($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) =
($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+([^/]+)/+([^/]+)/+(.*)|);
my ($info,$rtncode);
@@ -5263,7 +5279,7 @@ sub repcopy_userfile {
return -1;
}
if ($info < $fileinfo[9]) {
- return OK;
+ return 'OK';
}
$info = '';
$lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode);
@@ -5297,7 +5313,7 @@ sub repcopy_userfile {
open(FILE,">$file");
print FILE $info;
close(FILE);
- return OK;
+ return 'OK';
}
sub tokenwrapper {
@@ -5368,9 +5384,6 @@ sub filelocation {
$location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
$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 {
$file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
$file=~s:^/res/:/:;
@@ -6117,8 +6130,8 @@ subscribe($fname) : subscribe to a resou
repcopy($filename) : subscribes to the requested file, and attempts to
replicate from the owning library server, Might return
-HTTP_SERVICE_UNAVAILABLE, HTTP_NOT_FOUND, FORBIDDEN, OK, or
-HTTP_BAD_REQUEST, also attempts to grab the metadata for the
+'HTTP_SERVICE_UNAVAILABLE', 'HTTP_NOT_FOUND', 'FORBIDDEN', 'OK', or
+'HTTP_BAD_REQUEST', also attempts to grab the metadata for the
resource. Expects the local filesystem pathname
(/home/httpd/html/res/....)