--- loncom/lonnet/perl/lonnet.pm 2005/06/17 21:04:40 1.642 +++ loncom/lonnet/perl/lonnet.pm 2005/08/31 08:25:16 1.651 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.642 2005/06/17 21:04:40 albertel Exp $ +# $Id: lonnet.pm,v 1.651 2005/08/31 08:25:16 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1302,7 +1302,7 @@ sub userfileupload { if ($coursedoc) { my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; - if ($env{'form.folder'} =~ m/^default/) { + if ($env{'form.folder'} =~ m/^(default|supplemental)/) { return &finishuserfileupload($docuname,$docudom, $formname,$fname,$parser,$allfiles, $codebase); @@ -1368,7 +1368,7 @@ sub finishuserfileupload { } sub extract_embedded_items { - my ($filepath,$file,$allfiles,$codebase) = @_; + my ($filepath,$file,$allfiles,$codebase,$content) = @_; my @state = (); my %javafiles = ( codebase => '', @@ -1379,14 +1379,34 @@ sub extract_embedded_items { src => '', movie => '', ); - my $p = HTML::LCParser->new($filepath.'/'.$file); + my $p; + if ($content) { + $p = HTML::LCParser->new($content); + } else { + $p = HTML::LCParser->new($filepath.'/'.$file); + } while (my $t=$p->get_token()) { if ($t->[0] eq 'S') { my ($tagname, $attr) = ($t->[1],$t->[2]); push (@state, $tagname); + if (lc($tagname) eq 'allow') { + &add_filetype($allfiles,$attr->{'src'},'src'); + } if (lc($tagname) eq 'img') { &add_filetype($allfiles,$attr->{'src'},'src'); } + if (lc($tagname) eq 'script') { + if ($attr->{'archive'} =~ /\.jar$/i) { + &add_filetype($allfiles,$attr->{'archive'},'archive'); + } else { + &add_filetype($allfiles,$attr->{'src'},'src'); + } + } + 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)) { @@ -2881,7 +2901,7 @@ sub allowed { # Free bre access to user's own portfolio contents 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)) { return 'F'; } @@ -2968,9 +2988,12 @@ sub allowed { # 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 ($priv eq 'cca') { + 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 ''; } @@ -4051,28 +4074,25 @@ sub unmark_as_readonly { my ($tmp)=keys(%current_permissions); if ($tmp=~/^error:/) { undef(%current_permissions); } my @readonly_files = &get_marked_as_readonly($domain,$user,$what); - foreach my $file(@readonly_files){ - my $current_locks = $current_permissions{$file}; + foreach my $file (@readonly_files) { + if (defined($file_name) && ($file_name ne $file)) { next; } + my $current_locks = $current_permissions{$file}; my @new_locks; my @del_keys; if (ref($current_locks) eq "ARRAY"){ foreach my $locker (@{$current_locks}) { my $compare=$locker; if (ref($locker)) { $compare=join('',@{$locker}) }; - if ($compare eq $symb_crs) { - if (defined($file_name) && ($file_name ne $file)) { - push(@new_locks, $what); - } - } else { - push(@new_locks, $what); + if ($compare ne $symb_crs) { + push(@new_locks, $locker); } } - if (@new_locks > 0) { + if (scalar(@new_locks) > 0) { $current_permissions{$file} = \@new_locks; } else { push(@del_keys, $file); &del('file_permissions',\@del_keys, $domain, $user); - delete $current_permissions{$file}; + delete($current_permissions{$file}); } } } @@ -4400,8 +4420,10 @@ sub EXT { if ($realm eq 'user') { # --------------------------------------------------------------- user.resource if ($space eq 'resource') { - if (defined($Apache::lonhomework::parsing_a_problem) || - defined($Apache::lonhomework::parsing_a_task)) { + if ( (defined($Apache::lonhomework::parsing_a_problem) + || defined($Apache::lonhomework::parsing_a_task)) + && + ($symbparm eq &symbread()) ) { return $Apache::lonhomework::history{$qualifierrest}; } else { my %restored; @@ -4882,7 +4904,7 @@ sub metadata_generate_part0 { '.type'}; my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name. '.display'}; - my $expr='\\[Part: '.$allnames{$name}.'\\]'; + my $expr='[Part: '.$allnames{$name}.']'; $olddis=~s/\Q$expr\E/\[Part: 0\]/; $$metacache{"$key.display"}=$olddis; } @@ -4987,7 +5009,7 @@ sub symbverify { if ($ids) { # ------------------------------------------------------------------- Has ID(s) foreach (split(/\,/,$ids)) { - my ($mapid,$resid)=split(/\./,$_); + my ($mapid,$resid)=split(/\./,$_); if ( &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) eq $symb) { @@ -5621,6 +5643,9 @@ sub filelocation { if ($file=~m:^/~:) { # is a contruction space reference $location = $file; $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; + } elsif ($file=~m:^/home/[^/]*/public_html/:) { + # is a correct contruction space reference + $location = $file; } elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file my ($udom,$uname,$filename)= ($file=~m -^/+(?:uploaded|editupload)/+([^/]+)/+([^/]+)/+(.*)$-);