--- loncom/lonnet/perl/lonnet.pm 2005/06/29 11:57:17 1.644 +++ loncom/lonnet/perl/lonnet.pm 2005/07/26 13:30:34 1.648 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.644 2005/06/29 11:57:17 www Exp $ +# $Id: lonnet.pm,v 1.648 2005/07/26 13:30:34 raeburn 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'; }