--- loncom/publisher/lonpublisher.pm 2001/12/15 18:15:27 1.65 +++ loncom/publisher/lonpublisher.pm 2002/05/07 18:07:46 1.80 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.65 2001/12/15 18:15:27 harris41 Exp $ +# $Id: lonpublisher.pm,v 1.80 2002/05/07 18:07:46 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -41,7 +41,11 @@ # 12/05 Gerd Kortemeyer # 12/05 Guy Albertelli # 12/06,12/07 Gerd Kortemeyer -# 12/15 Scott Harrison +# 12/15,12/16 Scott Harrison +# 12/25 Gerd Kortemeyer +# YEAR=2002 +# 1/16,1/17 Scott Harrison +# 1/17 Gerd Kortemeyer # ### @@ -64,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; @@ -87,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') { @@ -145,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"; } @@ -184,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) { @@ -193,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); @@ -240,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') { @@ -271,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) { @@ -297,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') { @@ -327,7 +352,7 @@ sub publish { $oldcodebase.' - '. $codebase."\n"; } - $allow{$codebase.'/*'}=1; + $allow{&absoluteurl($codebase,$target).'/*'}=1; } else { foreach ('archive','code','object') { if (defined($parms{$_})) { @@ -337,7 +362,7 @@ sub publish { print $logfile 'Allow: applet '.$_.':'. $oldurl.' allows '. $newurl."\n"; - $allow{$newurl}=1; + $allow{&absoluteurl($newurl,$target)}=1; } } } @@ -372,8 +397,9 @@ sub publish { $scrout.='