--- loncom/publisher/lonpublisher.pm 2001/12/25 21:58:54 1.67 +++ loncom/publisher/lonpublisher.pm 2002/04/14 16:25:39 1.77 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.67 2001/12/25 21:58:54 www Exp $ +# $Id: lonpublisher.pm,v 1.77 2002/04/14 16:25:39 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -43,6 +43,9 @@ # 12/06,12/07 Gerd Kortemeyer # 12/15,12/16 Scott Harrison # 12/25 Gerd Kortemeyer +# YEAR=2002 +# 1/16,1/17 Scott Harrison +# 1/17 Gerd Kortemeyer # ### @@ -65,7 +68,7 @@ use strict; use Apache::File; use File::Copy; use Apache::Constants qw(:common :http :methods); -use HTML::TokeParser; +use HTML::LCParser; use Apache::lonxml; use Apache::lonhomework; use Apache::loncacc; @@ -88,7 +91,7 @@ my $cudom; sub metaeval { my $metastring=shift; - my $parser=HTML::TokeParser->new(\$metastring); + my $parser=HTML::LCParser->new(\$metastring); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { @@ -146,8 +149,9 @@ sub metaread { # ---------------------------- convert 'time' format into a datetime sql format sub sqltime { + my $timef=shift @_; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = - localtime(@_[0]); + localtime($timef); $mon++; $year+=1900; return "$year-$mon-$mday $hour:$min:$sec"; } @@ -185,6 +189,11 @@ sub selectbox { sub urlfixup { my ($url,$target)=@_; unless ($url) { return ''; } + #javascript code needs no fixing + if ($url =~ /^javascript:/i) { return $url; } + if ($url =~ /^mailto:/i) { return $url; } + #internal document links need no fixing + if ($url =~ /^\#/) { return $url; } my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/); foreach (values %Apache::lonnet::hostname) { if ($_ eq $host) { @@ -194,6 +203,13 @@ sub urlfixup { } if ($url=~/^http\:\/\//) { return $url; } $url=~s/\~$cuname/res\/$cudom\/$cuname/; + return $url; +} + + +sub absoluteurl { + my ($url,$target)=@_; + unless ($url) { return ''; } if ($target) { $target=~s/\/[^\/]+$//; $url=&Apache::lonnet::hreflocation($target,$url); @@ -241,7 +257,7 @@ sub publish { $content=join('',<$org>); } { - my $parser=HTML::TokeParser->new(\$content); + my $parser=HTML::LCParser->new(\$content); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { @@ -272,7 +288,7 @@ sub publish { "Max Index: $maxindex (min 10)\n"; } my $outstring=''; - my $parser=HTML::TokeParser->new(\$content); + my $parser=HTML::LCParser->new(\$content); $parser->xml_mode(1); my $token; while ($token=$parser->get_token) { @@ -298,19 +314,27 @@ sub publish { print $logfile 'Index: '.$tag.':'.$maxindex."\n"; } } - } - - foreach ('src','href','background') { - if (defined($parms{$_})) { - my $oldurl=$parms{$_}; - my $newurl=&urlfixup($oldurl,$target); - if ($newurl ne $oldurl) { - $parms{$_}=$newurl; - print $logfile 'URL: '.$tag.':'.$oldurl.' - '. - $newurl."\n"; + } + + foreach my $type ('src','href','background','bgimg') { + foreach my $key (keys(%parms)) { + if ($key =~ /^$type$/i) { + my $oldurl=$parms{$key}; + my $newurl=&urlfixup($oldurl,$target); + if ($newurl ne $oldurl) { + $parms{$key}=$newurl; + print $logfile 'URL: '.$tag.':'.$oldurl.' - '. + $newurl."\n"; + } + if (($newurl !~ /^javascript:/i) && + ($newurl !~ /^mailto:/i) && + ($newurl !~ /^http:/i) && + ($newurl !~ /^\#/)) { + $allow{&absoluteurl($newurl,$target)}=1; + } } - $allow{$newurl}=1; - } + last; + } } if ($lctag eq 'applet') { @@ -328,7 +352,7 @@ sub publish { $oldcodebase.' - '. $codebase."\n"; } - $allow{$codebase.'/*'}=1; + $allow{&absoluteurl($codebase,$target).'/*'}=1; } else { foreach ('archive','code','object') { if (defined($parms{$_})) { @@ -338,7 +362,7 @@ sub publish { print $logfile 'Allow: applet '.$_.':'. $oldurl.' allows '. $newurl."\n"; - $allow{$newurl}=1; + $allow{&absoluteurl($newurl,$target)}=1; } } } @@ -373,8 +397,9 @@ sub publish { $scrout.='