--- loncom/publisher/loncfile.pm 2008/03/12 02:46:38 1.88 +++ loncom/publisher/loncfile.pm 2012/06/04 19:23:41 1.115 @@ -9,7 +9,7 @@ # and displays a page showing the results of the action. # # -# $Id: loncfile.pm,v 1.88 2008/03/12 02:46:38 raeburn Exp $ +# $Id: loncfile.pm,v 1.115 2012/06/04 19:23:41 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -109,6 +109,17 @@ sub Debug { } } +sub done { + my ($url)=@_; + my $done=&mt("Done"); + return(<$done + +ENDDONE +} + =pod =item URLToPath($url) @@ -147,24 +158,28 @@ Global References sub URLToPath { my $Url = shift; &Debug($r, "UrlToPath got: $Url"); - $Url=~ s/\/+/\//g; - $Url=~ s/^http\:\/\/[^\/]+//; - $Url=~ s/^\///; - $Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//; + $Url=~ s{^https?\://[^/]+}{}; + $Url=~ s{//+}{/}g; + $Url=~ s{^/}{}; + $Url=$Apache::lonnet::perlvar{'lonDocRoot'}."/$Url"; &Debug($r, "Returning $Url \n"); return $Url; } sub url { my $fn=shift; - $fn=~s/^\/home\/($match_username)\/public\_html/\/priv\/$1/; + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + $fn=~ s/^\Q$londocroot\E//; + $fn=~s{/\./}{/}g; $fn=&HTML::Entities::encode($fn,'<>"&'); return $fn; } sub display { my $fn=shift; - $fn=~s-^/home/($match_username)/public_html-/priv/$1-; + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + $fn=~s/^\Q$londocroot\E//; + $fn=~s{/\./}{/}g; return ''.$fn.''; } @@ -175,9 +190,9 @@ sub display { sub obsolete_unpub { my ($user,$domain,$construct)=@_; + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; my $published=$construct; - $published=~ - s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//; + $published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/}; if (-e $published) { if (&Apache::lonnet::metadata($published,'obsolete')) { return 1; @@ -191,12 +206,13 @@ sub obsolete_unpub { # see if directory is empty # ignores any .meta, .save, .bak, and .log files created for a previously # published file, which has since been marked obsolete and deleted. +# ignores a .DS_Store file put there when viewing directory via webDAV on MacOS. sub empty_directory { my ($dirname,$phase) = @_; if (opendir DIR, $dirname) { my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and .. if (@files) { - my @orphans = grep(/\.(meta|save|log|bak)$/,@files); + my @orphans = grep(/\.(meta|save|log|bak|DS_Store)$/,@files); if (scalar(@files) - scalar(@orphans) > 0) { return 0; } else { @@ -258,9 +274,9 @@ sub exists { my ($user, $domain, $construct, $creating) = @_; $creating ||= 'file'; + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; my $published=$construct; - $published=~ - s{^/home/$user/public_html/}{/home/httpd/html/res/$domain/$user/}; + $published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/}; my ($type,$result); if ( -d $construct ) { return ('error','

'.&mt('Error: destination for operation is an existing directory.').'

'); @@ -334,9 +350,10 @@ sub checksuffix { } sub cleanDest { - my ($request,$dest,$subdir,$fn,$uname)=@_; + my ($request,$dest,$subdir,$fn,$uname,$udom)=@_; #remove bad characters my $foundbad=0; + my $error=''; if ($subdir && $dest =~/\./) { $foundbad=1; $dest=~s/\.//g; @@ -348,39 +365,56 @@ sub cleanDest { } if ($dest=~m|/|) { my ($newpath)=($dest=~m|(.*)/|); - $newpath=&relativeDest($fn,$newpath,$uname); + ($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom); if (! -d "$newpath") { - $request->print("

".&mt('You have requested to create file in directory [_1] which doesn\'t exist. The requested directory path has been removed from the requested file name.','"'.&display($newpath).'"')."

"); + $request->print('

' + .&mt("You have requested to create file in directory [_1] which doesn't exist. The requested directory path has been removed from the requested file name." + ,&display($newpath)) + .'

'); $dest=~s|.*/||; } } if ($dest =~ /\.(\d+)\.(\w+)$/){ - $request->print('' - .&mt('Bad filename [_1].
(name).(number).(extension) not allowed.
Removing the .number. from requested filename.',&display($dest)) - .''); + $request->print('

' + .&mt('Bad filename [_1]',&display($dest)) + .'
' + .&mt('[_1](name).(number).(extension)[_2] not allowed.','','') + .'
' + .&mt('Removing the [_1].number.[_2] from requested filename.','','') + .'

'); $dest =~ s/\.(\d+)(\.\w+)$/$2/; } if ($foundbad) { - $request->print("

".&mt('Invalid characters in requested name have been removed.')."

"); + $request->print('

' + .&mt('Invalid characters in requested name have been removed.') + .'

' + ); } - return $dest; + return ($dest,$error); } sub relativeDest { - my ($fn,$newfilename,$uname)=@_; + my ($fn,$newfilename,$uname,$udom)=@_; + my $error = ''; if ($newfilename=~/^\//) { # absolute, simply add path - $newfilename='/home/'.$uname.'/public_html/'; + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + $newfilename="$londocroot/res/$udom/$uname/"; } else { my $dir=$fn; - $dir=~s/\/[^\/]+$//; + $dir=~s{/[^/]+$}{}; $newfilename=$dir.'/'.$newfilename; } - $newfilename=~s://+:/:g; # remove duplicate / - while ($newfilename=~m:/\.\./:) { - $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. + $newfilename=~s{//+}{/}g; # remove duplicate / + while ($newfilename=~m{/\.\./}) { + $newfilename=~ s{/[^/]+/\.\./}{/}g; #remove dir/.. + } + my ($authorname,$authordom)=&Apache::loncacc::constructaccess($newfilename); + unless (($authorname) && ($authordom)) { + my $otherdir = &display($newfilename); + $error = &mt('Access denied to [_1]',$otherdir); } - return $newfilename; + return ($newfilename,$error); } =pod @@ -405,7 +439,7 @@ sub CloseForm1 { my ($request, $fn) = @_; $request->print('

'); $request->print('

'); + '" method="post">

'); } @@ -435,7 +469,7 @@ Parameters: sub CloseForm2 { my ($request, $user, $fn) = @_; - $request->print('

'.&mt('Done').'

'); + $request->print(&done(&url($fn))); } =pod @@ -496,10 +530,10 @@ sub Rename1 { if (-d $fn) { $newfilename=~/\.(\w+)$/; if (&Apache::loncommon::fileembstyle($1) eq 'ssi') { - $request->print('
'. - &mt('Cannot change MIME type of a directory'). + $request->print('

'. + &mt('Cannot change MIME type of a directory.'). ''. - '
'.&mt('Cancel').''); + '
'.&mt('Cancel').'

'); return; } $newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/; @@ -515,27 +549,38 @@ sub Rename1 { return; } unless (&obsolete_unpub($user,$domain,$fn)) { - $request->print('

'.&mt('Cannot rename or move non-obsolete published file').'

'. - '
'.&mt('Cancel').''); + $request->print('

' + .&mt('Cannot rename or move non-obsolete published file.') + .'
' + .''.&mt('Cancel').'

' + ); return; } my $action; if ($style eq 'rename') { - $action=&mt('Rename'); + $action='Rename'; } else { - $action=&mt('Move'); + $action='Move'; } - $request->print('

'.$action.' '.&display($fn). - '


to '.&display($newfilename).'?

'); + $request->print('' + .'

' + .&mt($action.' [_1] to [_2]?', + &display($fn), + &display($newfilename)) + .'

' + ); &CloseForm1($request, $fn); } else { - $request->print('

'.&mt('No new filename specified.').'

'); + $request->print('

'.&mt('No new filename specified.').'

'); return; } } else { - $request->print('

'.&mt('No such file').': '.&display($fn).'

'); + $request->print('

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

' + ); return; } @@ -570,25 +615,41 @@ sub Delete1 { if( -e $fn) { $request->print(''); + $fn.'" />'); if (-d $fn) { unless (&empty_directory($fn,'Delete1')) { - $request->print('

'.&mt('Only empty directories may be deleted.').'

'. - 'You must delete the contents of the directory first.
'. - '
'.&mt('Cancel').''); + $request->print('

' + .'' + .&mt('Only empty directories may be deleted.') + .'
' + .&mt('You must delete the contents of the directory first.') + .'

' + .'

'.&mt('Cancel').'

' + ); return; } } else { unless (&obsolete_unpub($user,$domain,$fn)) { - $request->print('

'.&mt('Cannot delete non-obsolete published file').'

'. - '
'.&mt('Cancel').''); + $request->print('

' + .&mt('Cannot delete non-obsolete published file.') + .'
' + .''.&mt('Cancel').'

' + ); return; } } - $request->print('

'.&mt('Delete').' '.&display($fn).'?

'); + $request->print('

' + .&mt('Delete [_1]?', + &display($fn)) + .'

' + ); &CloseForm1($request, $fn); } else { - $request->print('

'.&mt('No such file').': '.&display($fn).'

'); + $request->print('

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

' + ); } } @@ -642,13 +703,22 @@ sub Copy1 { $request->print('
'.&mt('Cancel').''); return; } - $request->print('

'.&mt('Copy').' '.&display($fn).'
to '. - &display($newfilename).'?

'); + $request->print( + '' + .'

' + .&mt('Copy [_1] to [_2]?', + &display($fn), + &display($newfilename)) + .'

' + ); &CloseForm1($request, $fn); } else { - $request->print('

'.&mt('No such file').': '.&display($fn).'

'); + $request->print('

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

' + ); } } @@ -699,14 +769,17 @@ sub NewDir1 { if ($type eq 'error') { $request->print(''); } else { - if ($mode eq 'testbank') { - $request->print(''); - } elsif ($mode eq 'imsimport') { - $request->print(''); - } - $request->print('

'.&mt('Make new directory').' '. - &display($newfilename).'?

'); + if (($mode eq 'testbank') || ($mode eq 'imsimport')) { + $request->print(''."\n". + ''); + } + $request->print('' + .'

' + .&mt('Make new directory [_1]?', + &display($newfilename)) + .'

' + ); &CloseForm1($request, $fn); } } @@ -715,11 +788,19 @@ sub NewDir1 { sub Decompress1 { my ($request, $user, $domain, $fn) = @_; if( -e $fn) { - $request->print(''); - $request->print('

'.&mt('Decompress').' '.&display($fn).'?

'); + $request->print(''); + $request->print('

' + .&mt('Decompress [_1]?', + &display($fn)) + .'

' + ); &CloseForm1($request, $fn); } else { - $request->print('

'.&mt('No such file').': '.&display($fn).'

'); + $request->print('

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

' + ); } } @@ -765,23 +846,10 @@ button which returns you to the driector sub NewFile1 { my ($request, $user, $domain, $fn, $newfilename) = @_; + return if (&filename_check($newfilename) ne 'ok'); if ($env{'form.action'} =~ /new(.+)file/) { my $extension=$1; - - ##Informs User (name).(number).(extension) not allowed - if($newfilename =~ /\.(\d+)\.(\w+)$/){ - $r->print(''.$newfilename. - ' - '.&mt('Bad Filename').'
('.&mt('name').').('.&mt('number').').('.&mt('extension').') '. - ' '.&mt('Not Allowed').''); - return; - } - if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){ - $r->print(''.$newfilename. - ' - '.&mt('Bad Filename').'
('.&mt('Must not include').' '.$1.') '. - ' '.&mt('Not Allowed').''); - return; - } if ($newfilename !~ /\Q.$extension\E$/) { if ($newfilename =~ m|/[^/.]*\.(?:[^/.]+)$|) { #already has an extension strip it and add in expected one @@ -795,14 +863,57 @@ sub NewFile1 { if ($type eq 'error') { $request->print(''); } else { - + my $extension; + + if ($newfilename =~ m{[^/.]+\.([^/.]+)$}) { + $extension = $1; + } + + my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty task library js css txt); + if (($extension eq '') || (!grep(/^\Q$extension\E/,@okexts))) { + my $validexts = '.'.join(', .',@okexts); + $request->print('

'. + &mt('Invalid filename: ').&display($newfilename).'

'. + &mt('The name of the new file needs to end with an appropriate file extension to indicate the type of file to create.').'
'. + &mt('The following are valid extensions: [_1].',$validexts). + '

'. + '

'. + ''. + ''. + ''.&mt('Enter a file name: ').' '. + '

'. + '

'); + return; + } + $request->print('

'.&mt('Make new file').' '.&display($newfilename).'?

'); $request->print(''); + $request->print('

'); + '" method="post">

'); $request->print('

'); + '" method="post">

'); } + return; +} + +sub filename_check { + my ($newfilename) = @_; + ##Informs User (name).(number).(extension) not allowed + if($newfilename =~ /\.(\d+)\.(\w+)$/){ + $r->print(''.$newfilename. + ' - '.&mt('Bad Filename').'
('.&mt('name').').('.&mt('number').').('.&mt('extension').') '. + ' '.&mt('Not Allowed').''); + return; + } + if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){ + $r->print(''.$newfilename. + ' - '.&mt('Bad Filename').'
('.&mt('Must not include').' '.$1.') '. + ' '.&mt('Not Allowed').''); + return; + } + return 'ok'; } =pod @@ -838,8 +949,23 @@ sub phaseone { my $doingdir=0; if ($env{'form.action'} eq 'newdir') { $doingdir=1; } - my $newfilename=&cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname); - $newfilename=&relativeDest($fn,$newfilename,$uname); + my ($newfilename,$error) = + &cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname,$udom); + unless ($error) { + ($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom); + } + if ($error) { + my $dirlist; + if ($fn=~m{^(.*/)[^/]+$}) { + $dirlist=$1; + } else { + $dirlist=$fn; + } + $r->print('
'.$error.'
'. + '

'.&mt('Return to Directory'). + '

'); + return; + } $r->print('
'. ''. ''. @@ -857,7 +983,10 @@ sub phaseone { if($newfilename) { &Copy1($r, $uname, $udom, $fn, $newfilename); } else { - $r->print('

'.&mt('No new filename specified.').'

'); + $r->print('

' + .&mt('No new filename specified.') + .'

' + ); } } elsif ($env{'form.action'} eq 'newdir') { my $mode = ''; @@ -879,7 +1008,10 @@ sub phaseone { if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) { &NewFile1($r, $uname, $udom, $fn, $newfilename); } else { - $r->print('

'.&mt('No new filename specified.').'

'); + $r->print('

' + .&mt('No new filename specified.') + .'

' + ); } } } @@ -966,7 +1098,12 @@ sub Rename2 { unlink $tmp2; } } else { - $request->print("

".&mt('No such file').": ".&display($oldfile).'

'); + $request->print( + '

' + .&mt('No such file: [_1]', + &display($oldfile)) + .'

' + ); return 0; } return 1; @@ -1014,7 +1151,7 @@ sub Delete2 { return 0; } } else { - $request->print('

'.&mt('No such file').'.

'); + $request->print('

'.&mt('No such file').'

'); return 0; } } @@ -1025,7 +1162,7 @@ sub Delete2 { return 0; } } else { - $request->print('

'.&mt('No such file').'.

'); + $request->print('

'.&mt('No such file').'

'); return 0; } } @@ -1084,7 +1221,7 @@ sub Copy2 { return 1; } } else { - $request->print('

'.&mt('No such file').'

'); + $request->print('

'.&mt('No such file').'

'); return 0; } return 1; @@ -1238,7 +1375,7 @@ sub phasetwo { } $dest = $env{'form.newfilename'}; } else { - $r->print('

'.&mt('No New filename specified').'

'); + $r->print('

'.&mt('No New filename specified').'

'); return; } @@ -1256,7 +1393,7 @@ sub phasetwo { $r->print('

'.&mt('Return to Directory').'

'); $r->print('

'.$disp_newname.'

'); } else { - $r->print('

'.&mt('Done').'

'); + $r->print(&done(&url($dest))); } } } @@ -1304,14 +1441,11 @@ sub handler { } # ----------------------------------------------------------- Start page output - my $uname; - my $udom; - ($uname,$udom)= - &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); + my ($uname,$udom) = &Apache::loncacc::constructaccess($fn); &Debug($r, "loncfile::handler constructaccess uname = $uname domain = $udom"); - unless (($uname) && ($udom)) { + if (($uname eq '') || ($udom eq '')) { $r->log_reason($uname.' at '.$udom. ' trying to manipulate file '.$env{'form.filename'}. ' ('.$fn.') - not authorized', @@ -1330,25 +1464,46 @@ sub handler { $js = qq| |; $loaditem{'onload'} = "writeDone()"; } + + my $londocroot = $r->dir_config('lonDocRoot'); + my $trailfile = $fn; + $trailfile =~ s{^/(priv/)}{$londocroot/$1}; + # Breadcrumbs + &Apache::lonhtmlcommon::clear_breadcrumbs(); + &Apache::lonhtmlcommon::add_breadcrumb({ + 'text' => 'Construction Space', + 'href' => &Apache::loncommon::authorspace($fn), + }); + &Apache::lonhtmlcommon::add_breadcrumb({ + 'text' => 'File Operation', + 'title' => 'Construction Space File Operation', + 'href' => '', + }); + $r->print(&Apache::loncommon::start_page('Construction Space File Operation', $js, - {'add_entries' => \%loaditem,})); + {'add_entries' => \%loaditem,}) + .&Apache::lonhtmlcommon::breadcrumbs() + .&Apache::loncommon::head_subbox( + &Apache::loncommon::CSTR_pageheader($trailfile)) + ); $r->print('

'.&mt('Location').': '.&display($fn).'

'); if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { - $r->print('

'.&mt('Co-Author').': '.$uname.' at '.$udom. - '

'); + $r->print('

' + .&mt('Co-Author [_1]',$uname.':'.$udom) + .'

' + ); } @@ -1377,8 +1532,11 @@ function writeDone() { $env{'form.action'} eq 'Select Action' ) { $r->print('

'.&mt('New Resource').'

'); } else { - $r->print('

'.&mt('Unknown Action').' '.$env{'form.action'}.'

'. - &Apache::loncommon::end_page()); + $r->print('

' + .&mt('Unknown Action').' '.$env{'form.action'} + .'

' + .&Apache::loncommon::end_page() + ); return OK; } if ($env{'form.phase'} eq 'two') {