--- loncom/publisher/lonpublisher.pm 2010/01/06 04:19:20 1.265.2.1 +++ loncom/publisher/lonpublisher.pm 2013/12/01 21:50:30 1.288 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.265.2.1 2010/01/06 04:19:20 raeburn Exp $ +# $Id: lonpublisher.pm,v 1.288 2013/12/01 21:50:30 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -66,10 +66,10 @@ invocation by F: =head1 OVERVIEW -Authors can only write-access the C space. They can -copy resources into the resource area through the publication step, -and move them back through a recover step. Authors do not have direct -write-access to their resource space. +Authors can only write-access the C space. +They can copy resources into the resource area through the +publication step, and move them back through a recover step. +Authors do not have direct write-access to their resource space. During the publication step, several events will be triggered. Metadata is gathered, where a wizard manages default @@ -102,8 +102,6 @@ to publication space. Many of the undocumented subroutines implement various magical parsing shortcuts. -=over 4 - =cut ###################################################################### @@ -121,7 +119,6 @@ use HTML::LCParser; use HTML::Entities; use Encode::Encoder; use Apache::lonxml; -use Apache::loncacc; use DBI; use Apache::lonnet; use Apache::loncommon(); @@ -150,6 +147,8 @@ my $lock; =pod +=over 4 + =item B Evaluates a string that contains metadata. This subroutine @@ -266,9 +265,9 @@ sub metaread { my ($logfile,$fn,$prefix)=@_; unless (-e $fn) { print($logfile 'No file '.$fn."\n"); - return '
' - .&mt('No file: [_1]' - ,' '.&Apache::loncfile::display($fn).'
'); + return '

' + .&mt('No file: [_1]',&Apache::loncfile::display($fn)) + .'

'; } print($logfile 'Processing '.$fn."\n"); my $metastring; @@ -277,9 +276,9 @@ sub metaread { $metastring=join('',<$metafh>); } &metaeval($metastring,$prefix); - return '
' - .&mt('Processed file: [_1]' - ,' '.&Apache::loncfile::display($fn).'
'); + return '

' + .&mt('Processed file: [_1]',&Apache::loncfile::display($fn)) + .'

'; } ######################################### @@ -791,10 +790,55 @@ sub fix_ids_and_indices { } if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; } $outstring.='<'.$tag.$newparmstring.$endtag.'>'; - if ($lctag eq 'm' || $lctag eq 'script' || $lctag eq 'answer' - || $lctag eq 'display' || $lctag eq 'tex') { + if ($lctag eq 'm' || $lctag eq 'answer' || $lctag eq 'display' || + $lctag eq 'tex') { $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser); - } + } elsif ($lctag eq 'script') { + if ($parms{'type'} eq 'loncapa/perl') { + $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser); + } else { + my $script = &get_all_text_unbalanced('/'.$lctag,\@parser); + if ($script =~ m{\.set\w+(Src|Swf)\(["']}i) { + my @srcs = split(/\.set/i,$script); + if (scalar(@srcs) > 1) { + foreach my $item (@srcs) { + if ($item =~ m{^(FlashPlayerSwf|MediaSrc|XMPSrc|ConfigurationSrc|PosterImageSrc)\((['"])(?:(?!\2).)+\2\)}is) { + my $srctype = $1; + my $quote = $2; + my ($url) = ($item =~ m{^\Q$srctype($quote\E([^$quote]+)\Q$quote)\E}); + $url = &urlfixup($url); + unless ($url=~m{^(?:http|https|ftp)://}) { + $allow{&absoluteurl($url,$target)}=1; + if ($srctype eq 'ConfigurationSrc') { + if ($url =~ m{^(.+/)configuration_express\.xml$}) { +# +# Camtasia 8.1: express_show/spritesheet.png needed, and included in zip archive. +# Not referenced directly in
.html or
_player.html files, +# so add this file to %allow (where
is name user gave to file/archive). +# + my $spritesheet = $1.'express_show/spritesheet.png'; + $allow{&absoluteurl($spritesheet,$target)}=1; + } + } elsif ($srctype eq 'PosterImageSrc') { + if ($url =~ m{^(.+)_First_Frame\.png$}) { + my $prefix = $1; +# +# Camtasia 8.1:
_Thumbnails.png needed, and included in zip archive. +# Not referenced directly in
.html or
_player.html files, +# so add this file to %allow (where
is name user gave to file/archive). +# + my $thumbnail = $prefix.'_Thumbnails.png'; + $allow{&absoluteurl($thumbnail,$target)}=1; + } + } + } + } + } + } + } + $outstring .= $script + } + } } elsif ($token->[0] eq 'E') { if ($token->[2]) { unless ($token->[1] eq 'allow') { @@ -1017,6 +1061,11 @@ sub publish { $outdep.= ' - '.&mt('Currently not available'). ''; } else { +# +# Store the fact that the dependency has been used by the target file +# Unfortunately, usage is erroneously named sequsage in lonmeta.pm +# The translation happens in lonmetadata.pm +# my %temphash=(&Apache::lonnet::declutter($target).'___'. &Apache::lonnet::declutter($thisdep).'___usage' => time); @@ -1080,16 +1129,16 @@ sub publish { # ------------------------------------------------ Check out directory hierachy my $thisdisfn=$source; - $thisdisfn=~s/^\/home\/\Q$cuname\E\///; - my @urlparts=split(/\//,$thisdisfn); + $thisdisfn=~s/^\Q$docroot\E\/priv\/\Q$cudom\E\/\Q$cuname\E\///; + my @urlparts=('.',split(/\//,$thisdisfn)); $#urlparts--; - my $currentpath='/home/'.$cuname.'/'; + my $currentpath=$docroot.'/priv/'.$cudom.'/'.$cuname.'/'; my $prefix='../'x($#urlparts); - foreach (@urlparts) { - $currentpath.=$_.'/'; + foreach my $subdir (@urlparts) { + $currentpath.=$subdir.'/'; $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix); $prefix=~s|^\.\./||; } @@ -1121,7 +1170,7 @@ sub publish { # ------------------------------------------------------------- Save some stuff my %savemeta=(); foreach ('title') { - $savemeta{$_}=$metadatafields{$_}; + if ($metadatafields{$_}) { $savemeta{$_}=$metadatafields{$_}; } } # ------------------------------------------ See if anything new in file itself @@ -1228,7 +1277,7 @@ sub publish { .'

' .'

'; + .'" /> '.&mt('Cancel').'

'; } $intr_scrout.=&Apache::lonhtmlcommon::start_pick_box(); $intr_scrout.= @@ -1480,6 +1529,8 @@ Returns: 0: fail 1: success +=back + =cut #'stupid emacs @@ -1729,8 +1780,6 @@ sub phasetwo { # ---------------------------------------------- Delete local tmp-preview files unlink($copyfile.'.tmp'); -# ---------------------------- Delete local GCI Test Assembly tn-preview files - unlink($copyfile.'.tn'); # --------------------------------------------------------------- Copy Metadata $copyfile=$copyfile.'.meta'; @@ -1767,27 +1816,22 @@ sub phasetwo { # ------------------------------------------------ Provide link to new resource unless ($batch) { - my $thissrc=$source; - $thissrc=~s{^/home/($match_username)/public_html}{/priv/$1}; + my $thissrc=&Apache::loncfile::url($source); my $thissrcdir=$thissrc; $thissrcdir=~s/\/[^\/]+$/\//; - $r->print(&Apache::loncommon::head_subbox( - &Apache::lonhtmlcommon::start_funclist(). - &Apache::lonhtmlcommon::add_item_funclist( + $r->print( + &Apache::lonhtmlcommon::actionbox([ ''. &mt('View Published Version'). - ''). - &Apache::lonhtmlcommon::add_item_funclist( + '', ''. &mt('Back to Source'). - ''). - &Apache::lonhtmlcommon::add_item_funclist( + '', ''. &mt('Back to Source Directory'). - ''). - &Apache::lonhtmlcommon::end_funclist()) + '']) ); } return 1; @@ -1839,8 +1883,6 @@ sub batchpublish { my %oldenv=%env; $srcfile=~s/\/+/\//g; $targetfile=~s/\/+/\//g; - my $thisdisfn=$srcfile; - $thisdisfn=~s/\/home\/korte\/public_html\///; $srcfile=~s/\/+/\//g; my $docroot=$r->dir_config('lonDocRoot'); @@ -1857,8 +1899,7 @@ sub batchpublish { my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); $r->print('

' - .&mt('Publishing [_1]' - ,''.$thisdisfn.'') + .&mt('Publishing [_1]',&Apache::loncfile::display($srcfile)) .'

' ); @@ -1884,15 +1925,15 @@ sub publishdirectory { my ($r,$fn,$thisdisfn)=@_; $fn=~s/\/+/\//g; $thisdisfn=~s/\/+/\//g; - my $resdir= - $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'. - $thisdisfn; + my $thisdisresdir=$thisdisfn; + $thisdisresdir=~s/^\/priv\//\/res\//; + my $resdir = $r->dir_config('lonDocRoot').$thisdisresdir; $r->print(&Apache::lonhtmlcommon::start_pick_box() .&Apache::lonhtmlcommon::row_title(&mt('Directory')) .''.$thisdisfn.'' .&Apache::lonhtmlcommon::row_closure() .&Apache::lonhtmlcommon::row_title(&mt('Target')) - .''.$resdir.'' + .''.$thisdisresdir.'' ); my $dirptr=16384; # Mask indicating a directory in stat.cmode. @@ -1901,7 +1942,7 @@ sub publishdirectory { $r->print(&Apache::lonhtmlcommon::row_closure() .&Apache::lonhtmlcommon::row_title(&mt('Options')) ); - $r->print('
'. + $r->print(''. &hiddenfield('phase','two'). &hiddenfield('filename',$env{'form.filename'}). &checkbox('pubrec','include subdirectories'). @@ -1973,12 +2014,11 @@ sub publishdirectory { sub defaultmetapublish { my ($r,$fn,$cuname,$cudom)=@_; - $fn=~s/^\/\~$cuname\//\/home\/$cuname\/public_html\//; unless (-e $fn) { return HTTP_NOT_FOUND; } my $target=$fn; - $target=~s/^\/home\/$cuname\/public_html\//$Apache::lonnet::perlvar{'lonDocRoot'}\/res\/$cudom\/$cuname\//; + $target=~s/^\Q$Apache::lonnet::perlvar{'lonDocRoot'}\E\/priv\//\Q$Apache::lonnet::perlvar{'lonDocRoot'}\E\/res\//; &Apache::loncommon::content_type($r,'text/html'); @@ -2021,9 +2061,7 @@ sub defaultmetapublish { $r->print($reply.'


');$r->rflush; } # ------------------------------------------------------------------- Link back - my $link=$fn; - $link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//; - $r->print("".&mt('Back to Metadata').''); + $r->print("".&mt('Back to Metadata').''); $r->print(&Apache::loncommon::end_page()); return OK; } @@ -2087,59 +2125,34 @@ sub handler { # -------------------------------------------------------------- Check filename my $fn=&unescape($env{'form.filename'}); + ($cuname,$cudom)=&Apache::lonnet::constructaccess($fn); +# ----------------------------------------------------- Do we have permissions? + unless (($cuname) && ($cudom)) { + $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. + ' trying to publish file '.$env{'form.filename'}. + ' - not authorized', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } +# ----------------------------------------------------------------- Get docroot + $docroot=$r->dir_config('lonDocRoot'); - ($cuname,$cudom)= - &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); # special publication: default.meta file if ($fn=~/\/default.meta$/) { return &defaultmetapublish($r,$fn,$cuname,$cudom); } $fn=~s/\.meta$//; - + +# sanity test on the filename + unless ($fn) { $r->log_reason($cuname.' at '.$cudom. ' trying to publish empty filename', $r->filename); return HTTP_NOT_FOUND; } - unless (($cuname) && ($cudom)) { - $r->log_reason($cuname.' at '.$cudom. - ' trying to publish file '.$env{'form.filename'}. - ' ('.$fn.') - not authorized', - $r->filename); - return HTTP_NOT_ACCEPTABLE; - } - - my $home=&Apache::lonnet::homeserver($cuname,$cudom); - my $allowed=0; - my @ids=&Apache::lonnet::current_machine_ids(); - foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; } } - unless ($allowed) { - $r->log_reason($cuname.' at '.$cudom. - ' trying to publish file '.$env{'form.filename'}. - ' ('.$fn.') - not homeserver ('.$home.')', - $r->filename); - return HTTP_NOT_ACCEPTABLE; - } - - $fn=~s{^http://[^/]+}{}; - $fn=~s{^/~($match_username)}{/home/$1/public_html}; - - my $targetdir=''; - $docroot=$r->dir_config('lonDocRoot'); - if ($1 ne $cuname) { - $r->log_reason($cuname.' at '.$cudom. - ' trying to publish unowned file '. - $env{'form.filename'}.' ('.$fn.')', - $r->filename); - return HTTP_NOT_ACCEPTABLE; - } else { - $targetdir=$docroot.'/res/'.$cudom; - } - - - unless (-e $fn) { + unless (-e $docroot.$fn) { $r->log_reason($cuname.' at '.$cudom. ' trying to publish non-existing file '. $env{'form.filename'}.' ('.$fn.')', @@ -2177,8 +2190,8 @@ sub handler { # Breadcrumbs &Apache::lonhtmlcommon::clear_breadcrumbs(); &Apache::lonhtmlcommon::add_breadcrumb({ - 'text' => 'Construction Space', - 'href' => &Apache::loncommon::authorspace(), + 'text' => 'Authoring Space', + 'href' => &Apache::loncommon::authorspace($fn), }); &Apache::lonhtmlcommon::add_breadcrumb({ 'text' => 'Resource Publication', @@ -2191,34 +2204,21 @@ sub handler { $r->print(&Apache::loncommon::start_page('Resource Publication',$js) .&Apache::lonhtmlcommon::breadcrumbs() .&Apache::loncommon::head_subbox( - &Apache::loncommon::CSTR_pageheader()) # FIXME crumbs broken? + &Apache::loncommon::CSTR_pageheader($docroot.$fn)) ); - - my $thisfn=$fn; - - my $thistarget=$thisfn; - - $thistarget=~s/^\/home/$targetdir/; - $thistarget=~s/\/public\_html//; - - my $thisdistarget=$thistarget; - $thisdistarget=~s/^\Q$docroot\E//; - - my $thisdisfn=$thisfn; - $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///; + my $thisdisfn=&HTML::Entities::encode($fn,'<>&"'); + my $thistarget=$fn; + $thistarget=~s/^\/priv\//\/res\//; + my $thisdistarget=&HTML::Entities::encode($thistarget,'<>&"'); if ($fn=~/\/$/) { # -------------------------------------------------------- This is a directory - &publishdirectory($r,$fn,$thisdisfn); - $r->print('
'.&mt('Return to Directory').''); - - + &publishdirectory($r,$docroot.$fn,$thisdisfn); + $r->print('
'.&mt('Return to Directory').''); } else { # ---------------------- Evaluate individual file, and then output information. - $thisfn=~/\.(\w+)$/; + $fn=~/\.(\w+)$/; my $thistype=$1; my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); if ($thistype eq 'page') { $thisembstyle = 'rat'; } @@ -2242,7 +2242,7 @@ sub handler { .'' ); $r->print(< + $thisdisfn ENDCAPTION $r->print('' @@ -2265,7 +2265,7 @@ ENDCAPTION $r->print(&Apache::lonhtmlcommon::row_closure() .&Apache::lonhtmlcommon::row_title(&mt('Diffs'))); $r->print(< + ENDDIFF $r->print(&mt('Diffs with Current Version').''); } @@ -2274,17 +2274,17 @@ ENDDIFF .&Apache::lonhtmlcommon::end_pick_box() ); -# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. +# ---------------------- Publishing from $fn to $thistarget with $thisembstyle. unless ($env{'form.phase'} eq 'two') { # ---------------------------------------------------------- Parse for problems my ($warningcount,$errorcount); if ($thisembstyle eq 'ssi') { - ($warningcount,$errorcount)=&checkonthis($r,$thisfn); + ($warningcount,$errorcount)=&checkonthis($r,$fn); } unless ($errorcount) { my ($outstring,$error)= - &publish($thisfn,$thistarget,$thisembstyle); + &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle); $r->print($outstring); } else { $r->print('

'. @@ -2292,7 +2292,7 @@ ENDDIFF '

'); } } else { - &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); + &phasetwo($r,$docroot.$fn,$docroot.$thistarget,$thisembstyle,$thisdistarget); } } $r->print(&Apache::loncommon::end_page()); @@ -2307,7 +2307,5 @@ __END__ =back -=back - =cut 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.