--- loncom/publisher/lonpublisher.pm 2009/11/19 05:18:08 1.263 +++ loncom/publisher/lonpublisher.pm 2014/08/03 13:52:59 1.292 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.263 2009/11/19 05:18:08 raeburn Exp $ +# $Id: lonpublisher.pm,v 1.292 2014/08/03 13:52:59 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)) + .'

'; } ######################################### @@ -469,7 +468,7 @@ Currently undocumented ######################################### ######################################### sub set_allow { - my ($allow,$logfile,$target,$tag,$oldurl)=@_; + my ($allow,$logfile,$target,$tag,$oldurl,$type)=@_; my $newurl=&urlfixup($oldurl,$target); my $return_url=$oldurl; print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n"; @@ -481,6 +480,11 @@ sub set_allow { ($newurl !~ /^mailto:/i) && ($newurl !~ /^(?:http|https|ftp):/i) && ($newurl !~ /^\#/)) { + if (($type eq 'src') || ($type eq 'href')) { + if ($newurl =~ /^([^?]+)\?[^?]*$/) { + $newurl = $1; + } + } $$allow{&absoluteurl($newurl,$target)}=1; } return $return_url; @@ -722,9 +726,11 @@ sub fix_ids_and_indices { foreach my $type ('src','href','background','bgimg') { foreach my $key (keys(%parms)) { if ($key =~ /^$type$/i) { + next if (($lctag eq 'img') && ($type eq 'src') && + ($parms{$key} =~ m{^data\:image/gif;base64,})); $parms{$key}=&set_allow(\%allow,$logfile, $target,$tag, - $parms{$key}); + $parms{$key},$type); } } } @@ -791,10 +797,69 @@ 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; + } + } + } + } + } + } + } + if ($script =~ /\(document,\s*(['"])script\1,\s*\[([^\]]+)\]\);/s) { + my $scriptslist = $2; + my @srcs = split(/\s*,\s*/,$scriptslist); + foreach my $src (@srcs) { + if ($src =~ /(["'])(?:(?!\1).)+\.js\1/) { + my $quote = $1; + my ($url) = ($src =~ m/\Q$quote\E([^$quote]+)\Q$quote\E/); + $url = &urlfixup($url); + unless ($url=~m{^(?:http|https|ftp)://}) { + $allow{&absoluteurl($url,$target)}=1; + } + } + } + } + $outstring .= $script; + } + } } elsif ($token->[0] eq 'E') { if ($token->[2]) { unless ($token->[1] eq 'allow') { @@ -1017,6 +1082,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 +1150,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 +1191,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 +1298,7 @@ sub publish { .'

' .'

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

'; } $intr_scrout.=&Apache::lonhtmlcommon::start_pick_box(); $intr_scrout.= @@ -1480,6 +1550,8 @@ Returns: 0: fail 1: success +=back + =cut #'stupid emacs @@ -1668,11 +1740,10 @@ sub phasetwo { if (copy($target,$copyfile)) { print $logfile "Copied old target to ".$copyfile."\n"; - $r->print('

'.&mt('Copied old target file').'

'); + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file'))); } else { print $logfile "Unable to write ".$copyfile.':'.$!."\n"; - $r->print("".&mt('Failed to copy old target'). - ", $!, ".&mt('FAIL').""); + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1)); return 0; } @@ -1682,13 +1753,12 @@ sub phasetwo { if (copy($target.'.meta',$copyfile)) { print $logfile "Copied old target metadata to ".$copyfile."\n"; - $r->print('

'.&mt('Copied old metadata').'

') + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata'))); } else { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; if (-e $target.'.meta') { - $r->print( - "". -&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL').""); + $r->print(&Apache::lonhtmlcommon::confirm_success( + &mt('Failed to write old metadata copy').", $!",1)); return 0; } } @@ -1721,25 +1791,27 @@ sub phasetwo { if (copy($source,$copyfile)) { print $logfile "\nCopied original source to ".$copyfile."\n"; - $r->print('

'.&mt('Copied source file').'

'); + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied source file'))); } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; - $r->print("". - &mt('Failed to copy source').", $!, ".&mt('FAIL').""); + $r->print(&Apache::lonhtmlcommon::confirm_success( + &mt('Failed to copy source').", $!",1)); return 0; } +# ---------------------------------------------- Delete local tmp-preview files + unlink($copyfile.'.tmp'); # --------------------------------------------------------------- Copy Metadata $copyfile=$copyfile.'.meta'; if (copy($source.'.meta',$copyfile)) { print $logfile "\nCopied original metadata to ".$copyfile."\n"; - $r->print('

'.&mt('Copied metadata').'

'); + $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata'))); } else { print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; - $r->print( - "".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL').""); + $r->print(&Apache::lonhtmlcommon::confirm_success( + &mt('Failed to write metadata copy').", $!",1)); return 0; } $r->rflush; @@ -1765,31 +1837,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::lonhtmlcommon::start_funclist()); - unless ($env{'request.role'}=~/^(aa)/) { - $r->print( - &Apache::lonhtmlcommon::add_item_funclist( - '' - .&mt('View Published Version') - .'') - ); - } $r->print( - &Apache::lonhtmlcommon::add_item_funclist( - '' - .&mt('Back to Source') - .'') - .&Apache::lonhtmlcommon::add_item_funclist( - '' - .&mt('Back to Source Directory') - .'') - .&Apache::lonhtmlcommon::end_funclist() + &Apache::lonhtmlcommon::actionbox([ + ''. + &mt('View Published Version'). + '', + ''. + &mt('Back to Source'). + '', + ''. + &mt('Back to Source Directory'). + '']) ); } return 1; @@ -1841,8 +1904,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'); @@ -1859,8 +1920,7 @@ sub batchpublish { my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); $r->print('

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

' ); @@ -1886,15 +1946,16 @@ sub publishdirectory { my ($r,$fn,$thisdisfn)=@_; $fn=~s/\/+/\//g; $thisdisfn=~s/\/+/\//g; - my $resdir= - $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'. - $thisdisfn; - $r->print(&Apache::lonhtmlcommon::start_pick_box() + 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. @@ -1903,16 +1964,16 @@ sub publishdirectory { $r->print(&Apache::lonhtmlcommon::row_closure() .&Apache::lonhtmlcommon::row_title(&mt('Options')) ); - $r->print(''. - &hiddenfield('phase','two'). + $r->print(&hiddenfield('phase','two'). &hiddenfield('filename',$env{'form.filename'}). &checkbox('pubrec','include subdirectories'). &checkbox('forcerepub','force republication of previously published files'). &checkbox('obsolete','make file(s) obsolete'). - &checkbox('forceoverride','force directory level metadata over existing'). - '
'); + &checkbox('forceoverride','force directory level metadata over existing') + ); $r->print(&Apache::lonhtmlcommon::row_closure(1) .&Apache::lonhtmlcommon::end_pick_box() + .'
' ); $lock=0; } else { @@ -1975,12 +2036,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'); @@ -2023,9 +2083,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; } @@ -2089,59 +2147,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.')', @@ -2179,8 +2212,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', @@ -2193,34 +2226,24 @@ 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( + '

'. + &Apache::lonhtmlcommon::actionbox([ + ''.&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'; } @@ -2244,7 +2267,7 @@ sub handler { .'' ); $r->print(< + $thisdisfn ENDCAPTION $r->print('' @@ -2267,7 +2290,7 @@ ENDCAPTION $r->print(&Apache::lonhtmlcommon::row_closure() .&Apache::lonhtmlcommon::row_title(&mt('Diffs'))); $r->print(< + ENDDIFF $r->print(&mt('Diffs with Current Version').''); } @@ -2276,17 +2299,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('

'. @@ -2294,7 +2317,7 @@ ENDDIFF '

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