version 1.637, 2005/06/11 13:38:47
|
version 1.648, 2005/07/26 13:30:34
|
Line 1132 sub allowuploaded {
|
Line 1132 sub allowuploaded {
|
} |
} |
|
|
# --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course |
# --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course |
# input: action, courseID, current domain, home server for course, intended |
# input: action, courseID, current domain, intended |
# path to file, source of file, instruction to parse file for objects, |
# path to file, source of file, instruction to parse file for objects, |
# ref to hash for embedded objects, |
# ref to hash for embedded objects, |
# ref to hash for codebase of java objects. |
# ref to hash for codebase of java objects. |
Line 1162 sub allowuploaded {
|
Line 1162 sub allowuploaded {
|
# |
# |
|
|
sub process_coursefile { |
sub process_coursefile { |
my ($action,$docuname,$docudom,$docuhome,$file,$source,$parser,$allfiles,$codebase)=@_; |
my ($action,$docuname,$docudom,$file,$source,$parser,$allfiles,$codebase)=@_; |
my $fetchresult; |
my $fetchresult; |
|
my $home=&homeserver($docuname,$docudom); |
if ($action eq 'propagate') { |
if ($action eq 'propagate') { |
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file |
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, |
,$docuhome); |
$home); |
} else { |
} else { |
my $fetchresult = ''; |
my $fetchresult = ''; |
my $fpath = ''; |
my $fpath = ''; |
Line 1182 sub process_coursefile {
|
Line 1183 sub process_coursefile {
|
my $destination = $filepath.'/'.$fname; |
my $destination = $filepath.'/'.$fname; |
rename($source,$destination); |
rename($source,$destination); |
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, |
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, |
$docuhome); |
$home); |
} |
} |
} elsif ($action eq 'uploaddoc') { |
} elsif ($action eq 'uploaddoc') { |
open(my $fh,'>'.$filepath.'/'.$fname); |
open(my $fh,'>'.$filepath.'/'.$fname); |
Line 1195 sub process_coursefile {
|
Line 1196 sub process_coursefile {
|
} |
} |
} |
} |
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, |
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, |
$docuhome); |
$home); |
if ($fetchresult eq 'ok') { |
if ($fetchresult eq 'ok') { |
return '/uploaded/'.$fpath.'/'.$fname; |
return '/uploaded/'.$fpath.'/'.$fname; |
} else { |
} else { |
&logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file. |
&logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file. |
' to host '.$docuhome.': '.$fetchresult); |
' to host '.$home.': '.$fetchresult); |
return '/adm/notfound.html'; |
return '/adm/notfound.html'; |
} |
} |
} |
} |
} |
} |
unless ( $fetchresult eq 'ok') { |
unless ( $fetchresult eq 'ok') { |
&logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file. |
&logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file. |
' to host '.$docuhome.': '.$fetchresult); |
' to host '.$home.': '.$fetchresult); |
} |
} |
return $fetchresult; |
return $fetchresult; |
} |
} |
Line 1228 sub build_filepath {
|
Line 1229 sub build_filepath {
|
} |
} |
|
|
sub store_edited_file { |
sub store_edited_file { |
my ($primary_url,$content,$docudom,$docuname,$docuhome,$fetchresult) = @_; |
my ($primary_url,$content,$docudom,$docuname,$fetchresult) = @_; |
my $file = $primary_url; |
my $file = $primary_url; |
$file =~ s#^/uploaded/$docudom/$docuname/##; |
$file =~ s#^/uploaded/$docudom/$docuname/##; |
my $fpath = ''; |
my $fpath = ''; |
Line 1239 sub store_edited_file {
|
Line 1240 sub store_edited_file {
|
open(my $fh,'>'.$filepath.'/'.$fname); |
open(my $fh,'>'.$filepath.'/'.$fname); |
print $fh $content; |
print $fh $content; |
close($fh); |
close($fh); |
|
my $home=&homeserver($docuname,$docudom); |
$$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, |
$$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, |
$docuhome); |
$home); |
if ($$fetchresult eq 'ok') { |
if ($$fetchresult eq 'ok') { |
return '/uploaded/'.$fpath.'/'.$fname; |
return '/uploaded/'.$fpath.'/'.$fname; |
} else { |
} else { |
&logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file. ' to host '.$docuhome.': '.$$fetchresult); |
&logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file. |
|
' to host '.$home.': '.$$fetchresult); |
return '/adm/notfound.html'; |
return '/adm/notfound.html'; |
} |
} |
} |
} |
Line 1295 sub userfileupload {
|
Line 1298 sub userfileupload {
|
return $fullpath.'/'.$fname; |
return $fullpath.'/'.$fname; |
} |
} |
# Create the directory if not present |
# Create the directory if not present |
my $docuname=''; |
|
my $docudom=''; |
|
my $docuhome=''; |
|
$fname="$subdir/$fname"; |
$fname="$subdir/$fname"; |
if ($coursedoc) { |
if ($coursedoc) { |
$docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; |
my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; |
$docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; |
$docuhome=$env{'course.'.$env{'request.course.id'}.'.home'}; |
if ($env{'form.folder'} =~ m/^(default|supplemental)/) { |
if ($env{'form.folder'} =~ m/^default/) { |
return &finishuserfileupload($docuname,$docudom, |
return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname,$parser,$allfiles,$codebase); |
$formname,$fname,$parser,$allfiles, |
|
$codebase); |
} else { |
} else { |
$fname=$env{'form.folder'}.'/'.$fname; |
$fname=$env{'form.folder'}.'/'.$fname; |
return &process_coursefile('uploaddoc',$docuname,$docudom,$docuhome,$fname,$formname,$parser,$allfiles,$codebase); |
return &process_coursefile('uploaddoc',$docuname,$docudom, |
|
$fname,$formname,$parser, |
|
$allfiles,$codebase); |
} |
} |
} else { |
} else { |
$docuname=$env{'user.name'}; |
my $docuname=$env{'user.name'}; |
$docudom=$env{'user.domain'}; |
my $docudom=$env{'user.domain'}; |
$docuhome=$env{'user.home'}; |
return &finishuserfileupload($docuname,$docudom,$formname, |
return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname,$parser,$allfiles,$codebase); |
$fname,$parser,$allfiles,$codebase); |
} |
} |
} |
} |
|
|
sub finishuserfileupload { |
sub finishuserfileupload { |
my ($docuname,$docudom,$docuhome,$formname,$fname,$parser,$allfiles,$codebase) = @_; |
my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase) = @_; |
my $path=$docudom.'/'.$docuname.'/'; |
my $path=$docudom.'/'.$docuname.'/'; |
my $filepath=$perlvar{'lonDocRoot'}; |
my $filepath=$perlvar{'lonDocRoot'}; |
my ($fnamepath,$file); |
my ($fnamepath,$file); |
Line 1342 sub finishuserfileupload {
|
Line 1345 sub finishuserfileupload {
|
close(FH); |
close(FH); |
} |
} |
if ($parser eq 'parse') { |
if ($parser eq 'parse') { |
my $parse_result = &extract_embedded_items($filepath,$file,$allfiles,$codebase); |
my $parse_result = &extract_embedded_items($filepath,$file,$allfiles, |
|
$codebase); |
unless ($parse_result eq 'ok') { |
unless ($parse_result eq 'ok') { |
&logthis('Failed to parse '.$filepath.$file.' for embedded media: '.$parse_result); |
&logthis('Failed to parse '.$filepath.$file. |
|
' for embedded media: '.$parse_result); |
} |
} |
} |
} |
# Notify homeserver to grep it |
# Notify homeserver to grep it |
# |
# |
|
my $docuhome=&homeserver($docuname,$docudom); |
my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome); |
my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome); |
if ($fetchresult eq 'ok') { |
if ($fetchresult eq 'ok') { |
# |
# |
Line 1362 sub finishuserfileupload {
|
Line 1368 sub finishuserfileupload {
|
} |
} |
|
|
sub extract_embedded_items { |
sub extract_embedded_items { |
my ($filepath,$file,$allfiles,$codebase) = @_; |
my ($filepath,$file,$allfiles,$codebase,$content) = @_; |
my @state = (); |
my @state = (); |
my %javafiles = ( |
my %javafiles = ( |
codebase => '', |
codebase => '', |
Line 1373 sub extract_embedded_items {
|
Line 1379 sub extract_embedded_items {
|
src => '', |
src => '', |
movie => '', |
movie => '', |
); |
); |
my $p = HTML::Parser->new |
my $p; |
( |
if ($content) { |
xml_mode => 1, |
$p = HTML::LCParser->new($content); |
start_h => |
} else { |
[sub { |
$p = HTML::LCParser->new($filepath.'/'.$file); |
my ($tagname, $attr) = @_; |
} |
push (@state, $tagname); |
while (my $t=$p->get_token()) { |
if (lc($tagname) eq 'img') { |
if ($t->[0] eq 'S') { |
if (exists($$allfiles{$attr->{'src'}})) { |
my ($tagname, $attr) = ($t->[1],$t->[2]); |
unless (grep/^src$/,@{$$allfiles{$attr->{'src'}}}) { |
push (@state, $tagname); |
push (@{$$allfiles{$attr->{'src'}}},&escape('src')); |
if (lc($tagname) eq 'allow') { |
} |
&add_filetype($allfiles,$attr->{'src'},'src'); |
} else { |
} |
@{$$allfiles{$attr->{'src'}}} = (&escape('src')); |
if (lc($tagname) eq 'img') { |
} |
&add_filetype($allfiles,$attr->{'src'},'src'); |
} |
} |
if (lc($tagname) eq 'object') { |
if (lc($tagname) eq 'script') { |
foreach my $item (keys (%javafiles)) { |
if ($attr->{'archive'} =~ /\.jar$/i) { |
$javafiles{$item} = ''; |
&add_filetype($allfiles,$attr->{'archive'},'archive'); |
} |
|
} |
|
if (lc($state[-2]) eq 'object') { |
|
if (lc($tagname) eq 'param') { |
|
my $name = lc($attr->{'name'}); |
|
foreach my $item (keys (%mediafiles)) { |
|
if ($name eq $item) { |
|
if (exists($$allfiles{$attr->{'value'}})) { |
|
unless(grep/^value$/,@{$$allfiles{$attr->{'value'}}}) { |
|
push(@{$$allfiles{$attr->{'value'}}},&escape('value')); |
|
} |
|
} else { |
|
@{$$allfiles{$attr->{'value'}}} = (&escape('value')); |
|
} |
|
last; |
|
} |
|
} |
|
foreach my $item (keys (%javafiles)) { |
|
if ($name eq $item) { |
|
$javafiles{$item} = $attr->{'value'}; |
|
last; |
|
} |
|
} |
|
} |
|
} |
|
if (lc($tagname) eq 'embed') { |
|
unless (lc($state[-2]) eq 'object') { |
|
foreach my $item (keys (%javafiles)) { |
|
$javafiles{$item} = ''; |
|
} |
|
} |
|
foreach my $item (keys (%javafiles)) { |
|
if ($attr->{$item}) { |
|
$javafiles{$item} = $attr->{$item}; |
|
last; |
|
} |
|
} |
|
foreach my $item (keys (%mediafiles)) { |
|
if ($attr->{$item}) { |
|
if (exists($$allfiles{$attr->{$item}})) { |
|
unless (grep/^$item$/,@{$$allfiles{$item}}) { |
|
push(@{$$allfiles{$attr->{$item}}},&escape($item)); |
|
} |
|
} else { |
|
@{$$allfiles{$attr->{$item}}} = (&escape($item)); |
|
} |
|
last; |
|
} |
|
} |
|
} |
|
}, "tagname, attr"], |
|
text_h => |
|
[sub { |
|
my ($text) = @_; |
|
}, "dtext"], |
|
end_h => |
|
[sub { |
|
my ($tagname) = @_; |
|
unless ($javafiles{'codebase'} eq '') { |
|
$javafiles{'codebase'} .= '/'; |
|
} |
|
if (lc($tagname) eq 'object') { |
|
&extract_java_items(\%javafiles,$allfiles,$codebase); |
|
} |
|
if (lc($tagname) eq 'embed') { |
|
unless (lc($state[-2]) eq 'object') { |
|
&extract_java_items(\%javafiles,$allfiles,$codebase); |
|
} |
|
} |
|
pop @state; |
|
}, "tagname"], |
|
); |
|
$p->parse_file($filepath.'/'.$file); |
|
$p->eof; |
|
return 'ok'; |
|
} |
|
|
|
sub extract_java_items { |
|
my ($javafiles,$allfiles,$codebase) = @_; |
|
foreach my $item (keys (%{$javafiles})) { |
|
unless ($item eq 'codebase') { |
|
if ($$javafiles{$item} ne '') { |
|
if (exists($$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}})) { |
|
unless (grep/^$item$/,@{$$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}}}) { |
|
push(@{$$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}}},&escape($item)); |
|
} |
|
} else { |
} else { |
@{$$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}}} = (&escape($item)); |
&add_filetype($allfiles,$attr->{'src'},'src'); |
$$codebase{$$javafiles{'codebase'}.$$javafiles{$item}} = $$javafiles{'codebase'}; |
|
|
|
} |
} |
} |
} |
} |
if (lc($tagname) eq 'link') { |
|
if (lc($attr->{'rel'}) eq 'stylesheet') { |
|
&add_filetype($allfiles,$attr->{'href'},'href'); |
|
} |
|
} |
|
if (lc($tagname) eq 'object' || |
|
(lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')) { |
|
foreach my $item (keys(%javafiles)) { |
|
$javafiles{$item} = ''; |
|
} |
|
} |
|
if (lc($state[-2]) eq 'object' && lc($tagname) eq 'param') { |
|
my $name = lc($attr->{'name'}); |
|
foreach my $item (keys(%javafiles)) { |
|
if ($name eq $item) { |
|
$javafiles{$item} = $attr->{'value'}; |
|
last; |
|
} |
|
} |
|
foreach my $item (keys(%mediafiles)) { |
|
if ($name eq $item) { |
|
&add_filetype($allfiles, $attr->{'value'}, 'value'); |
|
last; |
|
} |
|
} |
|
} |
|
if (lc($tagname) eq 'embed' || lc($tagname) eq 'applet') { |
|
foreach my $item (keys(%javafiles)) { |
|
if ($attr->{$item}) { |
|
$javafiles{$item} = $attr->{$item}; |
|
last; |
|
} |
|
} |
|
foreach my $item (keys(%mediafiles)) { |
|
if ($attr->{$item}) { |
|
&add_filetype($allfiles,$attr->{$item},$item); |
|
last; |
|
} |
|
} |
|
} |
|
} elsif ($t->[0] eq 'E') { |
|
my ($tagname) = ($t->[1]); |
|
if ($javafiles{'codebase'} ne '') { |
|
$javafiles{'codebase'} .= '/'; |
|
} |
|
if (lc($tagname) eq 'applet' || |
|
lc($tagname) eq 'object' || |
|
(lc($tagname) eq 'embed' && lc($state[-2]) ne 'object') |
|
) { |
|
foreach my $item (keys(%javafiles)) { |
|
if ($item ne 'codebase' && $javafiles{$item} ne '') { |
|
my $file=$javafiles{'codebase'}.$javafiles{$item}; |
|
&add_filetype($allfiles,$file,$item); |
|
} |
|
} |
|
} |
|
pop @state; |
|
} |
|
} |
|
return 'ok'; |
|
} |
|
|
|
sub add_filetype { |
|
my ($allfiles,$file,$type)=@_; |
|
if (exists($allfiles->{$file})) { |
|
unless (grep/^\Q$type\E$/, @{$allfiles->{$file}}) { |
|
push(@{$allfiles->{$file}}, &escape($type)); |
|
} |
|
} else { |
|
@{$allfiles->{$file}} = (&escape($type)); |
} |
} |
} |
} |
|
|
Line 2914 sub allowed {
|
Line 2901 sub allowed {
|
|
|
# Free bre access to user's own portfolio contents |
# Free bre access to user's own portfolio contents |
my ($space,$domain,$name,$dir)=split('/',$uri); |
my ($space,$domain,$name,$dir)=split('/',$uri); |
if (($space=~/^(uploaded|ediupload)$/) && ($env{'user.name'} eq $name) && |
if (($space=~/^(uploaded|editupload)$/) && ($env{'user.name'} eq $name) && |
($env{'user.domain'} eq $domain) && ('portfolio' eq $dir)) { |
($env{'user.domain'} eq $domain) && ('portfolio' eq $dir)) { |
return 'F'; |
return 'F'; |
} |
} |
Line 3001 sub allowed {
|
Line 2988 sub allowed {
|
|
|
# If this is generating or modifying users, exit with special codes |
# If this is generating or modifying users, exit with special codes |
|
|
if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:'=~/\:\Q$priv\E\:/) { |
if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:caa:'=~/\:\Q$priv\E\:/) { |
|
if (($priv eq 'cca') || ($priv eq 'caa')) { |
|
my ($audom,$auname)=split('/',$uri); |
|
# no author name given, so this just checks on the general right to make a co-author in this domain |
|
unless ($auname) { return $thisallowed; } |
|
# an author name is given, so we are about to actually make a co-author for a certain account |
|
if (($auname ne $env{'user.name'} && $env{'request.role'} !~ /^dc\./) || |
|
(($audom ne $env{'user.domain'} && $env{'request.role'} !~ /^dc\./) && |
|
($audom ne $env{'request.role.domain'}))) { return ''; } |
|
} |
return $thisallowed; |
return $thisallowed; |
} |
} |
# |
# |
Line 3875 sub createcourse {
|
Line 3871 sub createcourse {
|
</map> |
</map> |
ENDINITMAP |
ENDINITMAP |
$topurl=&declutter( |
$topurl=&declutter( |
&finishuserfileupload($uname,$udom,$uhome,'initmap','default.sequence') |
&finishuserfileupload($uname,$udom,'initmap','default.sequence') |
); |
); |
} |
} |
# ----------------------------------------------------------- Write preferences |
# ----------------------------------------------------------- Write preferences |
Line 4909 sub metadata_generate_part0 {
|
Line 4905 sub metadata_generate_part0 {
|
'.type'}; |
'.type'}; |
my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name. |
my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name. |
'.display'}; |
'.display'}; |
my $expr='\\[Part: '.$allnames{$name}.'\\]'; |
my $expr='[Part: '.$allnames{$name}.']'; |
$olddis=~s/\Q$expr\E/\[Part: 0\]/; |
$olddis=~s/\Q$expr\E/\[Part: 0\]/; |
$$metacache{"$key.display"}=$olddis; |
$$metacache{"$key.display"}=$olddis; |
} |
} |
Line 5014 sub symbverify {
|
Line 5010 sub symbverify {
|
if ($ids) { |
if ($ids) { |
# ------------------------------------------------------------------- Has ID(s) |
# ------------------------------------------------------------------- Has ID(s) |
foreach (split(/\,/,$ids)) { |
foreach (split(/\,/,$ids)) { |
my ($mapid,$resid)=split(/\./,$_); |
my ($mapid,$resid)=split(/\./,$_); |
if ( |
if ( |
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) |
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) |
eq $symb) { |
eq $symb) { |
Line 6798 userspace, probably shouldn't be called
|
Line 6794 userspace, probably shouldn't be called
|
|
|
docuname: username or courseid of destination for the file |
docuname: username or courseid of destination for the file |
docudom: domain of user/course of destination for the file |
docudom: domain of user/course of destination for the file |
docuhome: loncapa id of the library server that is getting the file |
|
formname: same as for userfileupload() |
formname: same as for userfileupload() |
fname: filename (inculding subdirectories) for the file |
fname: filename (inculding subdirectories) for the file |
|
|