--- loncom/publisher/lonpublisher.pm 2001/08/11 18:51:40 1.35
+++ loncom/publisher/lonpublisher.pm 2001/08/13 16:12:59 1.38
@@ -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 Gerd Kortemeyer
+# 06/23,08/07,08/11,8/13 Gerd Kortemeyer
package Apache::lonpublisher;
@@ -133,9 +133,6 @@ sub selectbox {
# -------------------------------------------------------- Publication Step One
-sub makeallowed {
-}
-
sub urlfixup {
my ($url,$target)=@_;
my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
@@ -160,6 +157,8 @@ sub publish {
my $scrout='';
my $allmeta='';
my $content='';
+ my %allow=();
+ undef %allow;
unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
return
@@ -255,9 +254,40 @@ sub publish {
print $logfile 'URL: '.$tag.':'.$oldurl.' - '.
$newurl."\n";
}
- &makeallowed($newurl);
+ $allow{$newurl}=1;
+ }
+ } ('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');
}
- } ('src','href','codebase');
+ }
my $newparmstring='';
my $endtag='';
@@ -271,7 +301,9 @@ sub publish {
} keys %parms;
$outstring.='<'.$tag.$newparmstring.$endtag.'>';
- }
+ } else {
+ $allow{$token->[2]->{'src'}}=1;
+ }
} elsif ($token->[0] eq 'E') {
unless ($token->[1] eq 'allow') {
$outstring.=$token->[2];
@@ -280,6 +312,16 @@ sub publish {
$outstring.=$token->[1];
}
}
+# ------------------------------------------------------------ Construct Allows
+ unless ($style eq 'rat') {
+ my $allowstr="\n";
+ map {
+ $allowstr.='
Obsolete parameters or stored values: '. $chparms; } - } + # ------------------------------------------------------- Now have all metadata $scrout.=