--- 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.'
'; + ''.$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/^\///;