--- loncom/publisher/lonpublisher.pm 2001/08/11 18:06:25 1.34
+++ loncom/publisher/lonpublisher.pm 2001/08/17 16:49:04 1.40
@@ -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,8/17 Gerd Kortemeyer
package Apache::lonpublisher;
@@ -133,11 +133,23 @@ sub selectbox {
# -------------------------------------------------------- Publication Step One
-sub makeallowed {
-}
-
sub urlfixup {
- return shift;
+ my ($url,$target)=@_;
+ unless ($url) { return ''; }
+ my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
+ map {
+ if ($_ eq $host) {
+ $url=~s/^http\:\/\///;
+ $url=~s/^$host//;
+ }
+ } values %Apache::lonnet::hostname;
+ if ($url=~/^http\:\/\//) { return $url; }
+ $url=~s/\~$cuname/res\/$cudom\/$cuname/;
+ if ($target) {
+ $target=~s/\/[^\/]+$//;
+ $url=&Apache::lonnet::hreflocation($target,$url);
+ }
+ return $url;
}
sub publish {
@@ -147,6 +159,8 @@ sub publish {
my $scrout='';
my $allmeta='';
my $content='';
+ my %allow=();
+ undef %allow;
unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
return
@@ -236,15 +250,46 @@ sub publish {
map {
if (defined($parms{$_})) {
my $oldurl=$parms{$_};
- my $newurl=&urlfixup($oldurl);
+ my $newurl=&urlfixup($oldurl,$target);
if ($newurl ne $oldurl) {
$parms{$_}=$newurl;
print $logfile 'URL: '.$tag.':'.$oldurl.' - '.
$newurl."\n";
}
- &makeallowed($newurl);
+ $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='';
@@ -258,7 +303,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];
@@ -267,6 +314,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.=