--- loncom/lonnet/perl/lonnet.pm 2004/06/29 14:56:32 1.516
+++ loncom/lonnet/perl/lonnet.pm 2004/07/02 21:34:55 1.519
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.516 2004/06/29 14:56:32 raeburn Exp $
+# $Id: lonnet.pm,v 1.519 2004/07/02 21:34:55 banghart Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1600,7 +1600,7 @@ sub getannounce {
if ($announcement=~/\w/) {
return
'
';
+ ''.$announcement.' |
';
} else {
return '';
}
@@ -3585,17 +3585,20 @@ sub revokecustomrole {
# ------------------------------------------------------------ Portfolio Director Lister
+# returns listing of contents of user's /userfiles/portfolio/ directory
+#
+
sub portfoliolist {
-#FIXME us the ls: command instead please
-#FIXME uhome should never be an argument to any lonnet functions
- # returns listing of contents of user's /userfiles/portfolio/ directory
- #
- my ($udom,$uname,$uhome);
- $uname=$ENV{'user.name'};
+ my ($currentPath, $currentFile) = @_;
+ my ($udom, $uname, $portfolioRoot);
+ $uname=$ENV{'user.name'};
$udom=$ENV{'user.domain'};
- $uhome=$ENV{'user.home'};
- my $listing = &reply('portls:'.$uname.':'.$udom, $uhome);
- return $listing;
+ # really should interrogate the system for home directory information, but . . .
+ $portfolioRoot = '/home/httpd/lonUsers/'.$udom.'/';
+ $uname =~ /^(.?)(.?)(.?)/;
+ $portfolioRoot = $portfolioRoot.$1.'/'.$2.'/'.$3.'/'.$uname.'/userfiles/portfolio';
+ my $listing = &reply('ls:'.$portfolioRoot.$currentPath, homeserver($uname,$udom));
+ return $listing;
}
sub portfoliomanage {
@@ -4879,6 +4882,14 @@ sub getfile {
if ($rtncode eq '404') {
unlink($localfile);
}
+ #my $ua=new LWP::UserAgent;
+ #my $request=new HTTP::Request('GET',&tokenwrapper($file));
+ #my $response=$ua->request($request);
+ #if ($response->is_success()) {
+ # return $response->content;
+ # } else {
+ # return -1;
+ # }
return -1;
}
if ($info < $fileinfo[9]) {
@@ -4891,13 +4902,21 @@ sub getfile {
}
} else {
$lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode);
+ &logthis("return is $lwpresp");
if ($lwpresp ne 'ok') {
- return -1;
+ my $ua=new LWP::UserAgent;
+ my $request=new HTTP::Request('GET',&tokenwrapper($file));
+ my $response=$ua->request($request);
+ if ($response->is_success()) {
+ return $response->content;
+ } else {
+ return -1;
+ }
}
my @parts = ($cdom,$cnum);
if ($filename =~ m|^(.+)/[^/]+$|) {
push @parts, split(/\//,$1);
- }
+ }
foreach my $part (@parts) {
$path .= '/'.$part;
if (!-e $path) {
@@ -4914,6 +4933,22 @@ sub getfile {
return $info;
}
+sub tokenwrapper {
+ my $uri=shift;
+ $uri=~s/^http\:\/\/([^\/]+)//;
+ $uri=~s/^\///;
+ $ENV{'user.environment'}=~/\/([^\/]+)\.id/;
+ my $token=$1;
+ if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {
+ &appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'});
+ return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri.
+ (($uri=~/\?/)?'&':'?').'token='.$token.
+ '&tokenissued='.$perlvar{'lonHostID'};
+ } else {
+ return '/adm/notfound.html';
+ }
+}
+
sub getuploaded {
my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
$uri=~s/^\///;