--- loncom/publisher/lonpublisher.pm 2001/08/13 12:53:06 1.37 +++ loncom/publisher/lonpublisher.pm 2001/08/17 16:27:08 1.39 @@ -11,7 +11,7 @@ # 04/16/2001 Scott Harrison # 05/03,05/05,05/07 Gerd Kortemeyer # 05/28/2001 Scott Harrison -# 06/23,08/07,08/11,8/13 Gerd Kortemeyer +# 06/23,08/07,08/11,8/13,8/17 Gerd Kortemeyer package Apache::lonpublisher; @@ -135,6 +135,7 @@ sub selectbox { sub urlfixup { my ($url,$target)=@_; + unless ($url) { return ''; } my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/); map { if ($_ eq $host) { @@ -256,7 +257,38 @@ sub publish { } $allow{$newurl}=1; } - } ('src','href','codebase'); + } ('src','href'); + + if ($tag eq 'applet') { + my $codebase=''; + if (defined($parms{'codebase'})) { + my $oldcodebase=$parms{'codebase'}; + unless ($oldcodebase=~/\/$/) { + $oldcodebase.='/'; + } + $codebase=&urlfixup($oldcodebase,$target); + $codebase=~s/\/$//; + if ($codebase ne $oldcodebase) { + $parms{'codebase'}=$codebase; + print $logfile 'URL codebase: '.$tag.':'. + $oldcodebase.' - '. + $codebase."\n"; + } + $allow{$codebase.'/*'}=1; + } else { + map { + if (defined($parms{$_})) { + my $oldurl=$parms{$_}; + my $newurl=&urlfixup($oldurl,$target); + $newurl=~s/\/[^\/]+$/\/\*/; + print $logfile 'Allow: applet '.$_.':'. + $oldurl.' allows '. + $newurl."\n"; + $allow{$newurl}=1; + } + } ('archive','code','object'); + } + } my $newparmstring=''; my $endtag='';