version 1.516, 2004/06/29 14:56:32
|
version 1.522, 2004/07/16 17:56:01
|
Line 1600 sub getannounce {
|
Line 1600 sub getannounce {
|
if ($announcement=~/\w/) { |
if ($announcement=~/\w/) { |
return |
return |
'<table bgcolor="#FF5555" cellpadding="5" cellspacing="3">'. |
'<table bgcolor="#FF5555" cellpadding="5" cellspacing="3">'. |
'<tr><td bgcolor="#FFFFFF"><pre>'.$announcement.'</pre></td></tr></table>'; |
'<tr><td bgcolor="#FFFFFF"><tt>'.$announcement.'</tt></td></tr></table>'; |
} else { |
} else { |
return ''; |
return ''; |
} |
} |
Line 3203 sub auto_create_password {
|
Line 3203 sub auto_create_password {
|
return ($authparam,$create_passwd,$authchk); |
return ($authparam,$create_passwd,$authchk); |
} |
} |
|
|
|
sub auto_instcode_format { |
|
my ($caller,$codedom,$instcodes,$codes,$codetitles,$cat_titles,$cat_order) = @_; |
|
my $courses = ''; |
|
my $homeserver; |
|
if ($caller eq 'global') { |
|
$homeserver = $perlvar{'lonHostID'}; |
|
} else { |
|
$homeserver = &homeserver($caller,$codedom); |
|
} |
|
my $host=$hostname{$homeserver}; |
|
foreach (keys %{$instcodes}) { |
|
$courses .= &escape($_).'='.&escape($$instcodes{$_}).'&'; |
|
} |
|
chop($courses); |
|
my $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$homeserver); |
|
unless ($response =~ /(con_lost|error|no_such_host|refused)/) { |
|
my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) = split/:/,$response; |
|
%{$codes} = &str2hash($codes_str); |
|
@{$codetitles} = &str2array($codetitles_str); |
|
%{$cat_titles} = &str2hash($cat_titles_str); |
|
%{$cat_order} = &str2hash($cat_order_str); |
|
return 'ok'; |
|
} |
|
return $response; |
|
} |
|
|
# ------------------------------------------------------------------ Plain Text |
# ------------------------------------------------------------------ Plain Text |
|
|
sub plaintext { |
sub plaintext { |
Line 3585 sub revokecustomrole {
|
Line 3611 sub revokecustomrole {
|
|
|
|
|
# ------------------------------------------------------------ Portfolio Director Lister |
# ------------------------------------------------------------ Portfolio Director Lister |
|
# returns listing of contents of user's /userfiles/portfolio/ directory |
|
# |
|
|
sub portfoliolist { |
sub portfoliolist { |
#FIXME us the ls: command instead please |
my ($currentPath, $currentFile) = @_; |
#FIXME uhome should never be an argument to any lonnet functions |
my ($udom, $uname, $portfolioRoot); |
# returns listing of contents of user's /userfiles/portfolio/ directory |
|
# |
|
my ($udom,$uname,$uhome); |
|
$uname=$ENV{'user.name'}; |
$uname=$ENV{'user.name'}; |
$udom=$ENV{'user.domain'}; |
$udom=$ENV{'user.domain'}; |
$uhome=$ENV{'user.home'}; |
# really should interrogate the system for home directory information, but . . . |
my $listing = &reply('portls:'.$uname.':'.$udom, $uhome); |
$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; |
return $listing; |
} |
} |
|
|
Line 4879 sub getfile {
|
Line 4908 sub getfile {
|
if ($rtncode eq '404') { |
if ($rtncode eq '404') { |
unlink($localfile); |
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; |
return -1; |
} |
} |
if ($info < $fileinfo[9]) { |
if ($info < $fileinfo[9]) { |
Line 4892 sub getfile {
|
Line 4929 sub getfile {
|
} else { |
} else { |
$lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode); |
$lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode); |
if ($lwpresp ne 'ok') { |
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); |
my @parts = ($cdom,$cnum); |
if ($filename =~ m|^(.+)/[^/]+$|) { |
if ($filename =~ m|^(.+)/[^/]+$|) { |
push @parts, split(/\//,$1); |
push @parts, split(/\//,$1); |
} |
} |
foreach my $part (@parts) { |
foreach my $part (@parts) { |
$path .= '/'.$part; |
$path .= '/'.$part; |
if (!-e $path) { |
if (!-e $path) { |
Line 4914 sub getfile {
|
Line 4958 sub getfile {
|
return $info; |
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 { |
sub getuploaded { |
my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_; |
my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_; |
$uri=~s/^\///; |
$uri=~s/^\///; |