--- loncom/publisher/lonpublisher.pm	2001/08/11 18:51:40	1.35
+++ 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,9 @@ sub selectbox {
 
 # -------------------------------------------------------- Publication Step One
 
-sub makeallowed {
-}
-
 sub urlfixup {
     my ($url,$target)=@_;
+    unless ($url) { return ''; }
     my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
     map {
 	if ($_ eq $host) {
@@ -145,6 +143,7 @@ sub urlfixup {
             $url=~s/^$host//;
         }
     } values %Apache::lonnet::hostname;
+    if ($url=~/^http\:\/\//) { return $url; }
     $url=~s/\~$cuname/res\/$cudom\/$cuname/;
     if ($target) {
 	$target=~s/\/[^\/]+$//;
@@ -160,6 +159,8 @@ sub publish {
     my $scrout='';
     my $allmeta='';
     my $content='';
+    my %allow=();
+    undef %allow;
 
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
 	return 
@@ -255,9 +256,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 +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];
@@ -280,6 +314,16 @@ sub publish {
                   $outstring.=$token->[1];
               }
           }
+# ------------------------------------------------------------ Construct Allows
+     unless ($style eq 'rat') {
+	my $allowstr="\n";
+        map {
+           $allowstr.='<allow src="'.$_.'" />'."\n";
+        } keys %allow;
+        $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;
+    }
+# ------------------------------------------------------------- Write modified
+
         {
           my $org;
           unless ($org=Apache::File->new('>'.$source)) {
@@ -298,7 +342,7 @@ sub publish {
       } else {
 	  print $logfile "Does not need ID and/or index fixup\n";
       }
-
+    }
 # --------------------------------------------- Initial step done, now metadata
 
 # ---------------------------------------- Storage for metadata keys and fields
@@ -356,11 +400,11 @@ sub publish {
     }
 
 # -------------------------------------------------- Parse content for metadata
-
+    if ($style eq 'ssi') {
         $allmeta=Apache::lonxml::xmlparse('meta',$content);
 
         &metaeval($allmeta);
-
+    }
 # ---------------- Find and document discrepancies in the parameters and stores
 
         my $chparms='';
@@ -393,7 +437,7 @@ sub publish {
 	    $scrout.='<p><b>Obsolete parameters or stored values:</b> '.
                      $chparms;
         }
-    }
+
 # ------------------------------------------------------- Now have all metadata
 
         $scrout.=