--- loncom/publisher/lonupload.pm 2003/06/23 21:56:31 1.16 +++ loncom/publisher/lonupload.pm 2012/04/16 19:32:04 1.60 @@ -1,8 +1,7 @@ - # The LearningOnline Network with CAPA # Handler to upload files into construction space # -# $Id: lonupload.pm,v 1.16 2003/06/23 21:56:31 albertel Exp $ +# $Id: lonupload.pm,v 1.60 2012/04/16 19:32:04 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,256 +25,8 @@ # # http://www.lon-capa.org/ # -# (Handler to retrieve an old version of a file -# -# (Publication Handler -# -# (TeX Content Handler -# -# YEAR=2000 -# 05/29/00,05/30,10/11 Gerd Kortemeyer) -# -# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer -# YEAR=2001 -# 03/23 Guy Albertelli -# 03/24,03/29 Gerd Kortemeyer) -# -# 03/31,04/03 Gerd Kortemeyer) -# -# 04/05,04/09,05/25,06/23,06/24,08/22 Gerd Kortemeyer -# 11/29 Matthew Hall -# ### -package Apache::lonupload; - -use strict; -use Apache::File; -use File::Copy; -use File::Basename; -use Apache::Constants qw(:common :http :methods); -use Apache::loncacc; -use Apache::loncommon(); -use Apache::Log(); -use Apache::lonnet; -use HTML::Entities(); - -my $DEBUG=0; - -sub Debug { - - # Marshall the parameters. - - my $r = shift; - my $log = $r->log; - my $message = shift; - - # Put out the indicated message butonly if DEBUG is false. - - if ($DEBUG) { - $log->debug($message); - } -} - -sub upfile_store { - my $r=shift; - - my $fname=$ENV{'form.upfile.filename'}; - $fname=~s/\W//g; - - chop($ENV{'form.upfile'}); - - my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}. - '_upload_'.$fname.'_'.time.'_'.$$; - { - my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons'). - '/tmp/'.$datatoken.'.tmp'); - print $fh $ENV{'form.upfile'}; - } - return $datatoken; -} - - -sub phaseone { - my ($r,$fn,$uname,$udom)=@_; - $ENV{'form.upfile.filename'}=~s/\\/\//g; - $ENV{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/; - if ($ENV{'form.upfile.filename'}) { - $fn=~s/\/[^\/]+$//; - $fn=~s/([^\/])$/$1\//; - $fn.=$ENV{'form.upfile.filename'}; - $fn=~s/^\///; - $fn=~s/(\/)+/\//g; - -# Fn is the full path to the destination filename. -# - - &Debug($r, "Filename for upload: $fn"); - if (($fn) && ($fn!~/\/$/)) { - $r->print( - '
'. - ''. - ''. - 'Store uploaded file as '. - '
'. - '
'); - # Check for bad extension and warn user - if ($fn=~/\.(\w+)$/ && - (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { - $r->print( - ''. - 'The extension on this file, "'.$1. - '", is reserved internally by LON-CAPA.
'. - 'Please change the extension.'. - ''); - } elsif($fn=~/\.(\w+)$/ && - !defined(&Apache::loncommon::fileembstyle($1))) { - $r->print( - ''. - 'The extension on this file, "'.$1. - '", is not recognized by LON-CAPA.
'. - 'Please change the extension.'. - ''); - } - } else { - $r->print('Illegal filename.'); - } - } else { - $r->print('No upload file specified.'); - } -} - -sub phasetwo { - my ($r,$fn,$uname,$udom)=@_; - &Debug($r, "Filename is ".$fn); - if ($fn=~/^\/priv\/$uname\//) { - &Debug($r, "Filename after priv substitution: ".$fn); - my $tfn=$fn; - $tfn=~s/^\/(\~|priv)\/(\w+)//; - &Debug($r, "Filename for tfn = ".$tfn); - my $target='/home/'.$uname.'/public_html'.$tfn; - &Debug($r, "target -> ".$target); -# target is the full filesystem path of the destination file. - my $base = &File::Basename::basename($fn); - my $path = &File::Basename::dirname($fn); - $base = &HTML::Entities::encode($base); - my $url = $path."/".$base; - &Debug($r, "URL is now ".$url); - my $datatoken=$ENV{'form.datatoken'}; - if (($fn) && ($datatoken)) { - if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) { - $r->print( - '
'. - 'File '.$fn.' exists. Overwrite? '. - ''. - ''. - ''. - '
'); - } else { - my $source=$r->dir_config('lonDaemons'). - '/tmp/'.$datatoken.'.tmp'; - # Check for bad extension and disallow upload - if ($fn=~/\.(\w+)$/ && - (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { - $r->print( - 'File '.$fn.' could not be copied.
'. - ''. - 'The extension on this file is reserved internally by LON-CAPA.'. - ''); - } elsif ($fn=~/\.(\w+)$/ && - !defined(&Apache::loncommon::fileembstyle($1))) { - $r->print( - 'File '.$fn.' could not be copied.
'. - ''. - 'The extension on this file is not recognized by LON-CAPA.'. - ''); - } elsif (copy($source,$target)) { - chmod(0660, $target); # Set permissions to rw-rw---. - $r->print('File copied.'); - $r->print('

View file'); - $r->print('

Back to Directory'); - } else { - $r->print('Failed to copy: '.$!); - } - } - } else { - $r->print( - 'Please pick a filename

'); - &phaseone($r,$fn,$uname,$udom); - } - } else { - $r->print( - 'Please pick a filename

'); - &phaseone($r,$fn,$uname,$udom); - } -} - -# ---------------------------------------------------------------- Main Handler -sub handler { - - my $r=shift; - - my $uname; - my $udom; - - ($uname,$udom)= - &Apache::loncacc::constructaccess( - $ENV{'form.filename'},$r->dir_config('lonDefDomain')); - unless (($uname) && ($udom)) { - $r->log_reason($uname.' at '.$udom. - ' trying to publish file '.$ENV{'form.filename'}. - ' - not authorized', - $r->filename); - return HTTP_NOT_ACCEPTABLE; - } - - my $fn; - - if ($ENV{'form.filename'}) { - $fn=$ENV{'form.filename'}; - $fn=~s/^http\:\/\/[^\/]+\/(\~|priv\/)(\w+)//; - } else { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. - ' unspecified filename for upload', $r->filename); - return HTTP_NOT_FOUND; - } - -# ----------------------------------------------------------- Start page output - - - $r->content_type('text/html'); - $r->send_http_header; - - $r->print('LON-CAPA Construction Space'); - - $r->print( - ''); - - - $r->print('

Upload file to Construction Space

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

Co-Author: '.$uname.' at '.$udom. - '

'); - } - - - if ($ENV{'form.phase'} eq 'two') { - &phasetwo($r,$fn,$uname,$udom); - } else { - &phaseone($r,$fn,$uname,$udom); - } - - $r->print(''); - return OK; -} - -1; -__END__ - =head1 NAME Apache::lonupload - upload files into construction space @@ -318,33 +69,490 @@ Start page output =item * -output relevant interface phase (phaseone or phasetwo) +output relevant interface phase (phaseone, phasetwo, phasethree or phasefour) =item * (phase one is to specify upload file; phase two is to handle conditions -subsequent to specification--like overwriting an existing file) +subsequent to specification--like overwriting an existing file; phase three +is to handle processing of secondary uploads - of embedded objects in an +html file). =back =head1 OTHER SUBROUTINES -=over 4 +=over -=item * +=item phaseone() -phaseone() : Interface for specifying file to upload. +Interface for specifying file to upload. -=item * +=item phasetwo() -phasetwo() : Interface for handling post-conditions about uploading (such +Interface for handling post-conditions about uploading (such as overwriting an existing file). -=item * +=item phasethree() + +Interface for handling secondary uploads of embedded objects +in an html file. + +=item phasefour() + +Interface for handling optional renaming of links to embedded +objects. -upfile_store() : Store contents of uploaded file into temporary space. Invoked +=item upfile_store() + +Store contents of uploaded file into temporary space. Invoked by phaseone subroutine. +=item check_extension() + +Checks if filename extension is permitted and checks type + of file - if html file, calls parser to check for embedded objects. + Invoked by phasetwo subroutine. + =back =cut + +package Apache::lonupload; + +use strict; +use Apache::File; +use File::Copy; +use File::Basename; +use Apache::Constants qw(:common :http :methods); +use Apache::loncacc; +use Apache::loncommon(); +use Apache::lonnet; +use HTML::Entities(); +use Apache::lonlocal; +use Apache::lonnet; +use LONCAPA(); + +my $DEBUG=0; + +sub Debug { + # Put out the indicated message but only if DEBUG is true. + if ($DEBUG) { + my ($r,$message) = @_; + $r->log_reason($message); + } +} + +sub upfile_store { + my $r=shift; + + my $fname=$env{'form.upfile.filename'}; + $fname=~s/\W//g; + + chomp($env{'form.upfile'}); + + my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}. + '_upload_'.$fname.'_'.time.'_'.$$; + { + my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons'). + '/tmp/'.$datatoken.'.tmp'); + print $fh $env{'form.upfile'}; + } + return $datatoken; +} + +sub phaseone { + my ($r,$fn,$mode)=@_; + my $action = '/adm/upload'; + if ($mode eq 'testbank') { + $action = '/adm/testbank'; + } elsif ($mode eq 'imsimport') { + $action = '/adm/imsimport'; + } + + # Check for file to be uploaded + $env{'form.upfile.filename'}=~s/\\/\//g; + $env{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/; + if (!$env{'form.upfile.filename'}) { + $r->print('

'.&mt('No upload file specified.').'

'); + return; + } + + # Append the name of the uploaded file + $fn.=$env{'form.upfile.filename'}; + $fn=~s/(\/)+/\//g; + + # Check for illegal filename + &Debug($r, "Filename for upload: $fn"); + if (!(($fn) && ($fn!~/\/$/))) { + $r->print('

'.&mt('Illegal filename.').'

'); + return; + } +# Split part that I can change from the part that I cannot change + my ($fn1,$fn2)=($fn=~/^(\/priv\/[^\/]+\/[^\/]+\/)(.*)$/); + # Display additional options for upload + # and upload button + $r->print( + '
' + .'' + .'' + ); + $r->print( + &Apache::lonhtmlcommon::start_pick_box() + .&Apache::lonhtmlcommon::row_title(&mt('Save uploaded file as')) + .''.$fn1.'' + .'' + .'' + .&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('File Type')) + .''.&Apache::loncommon::help_open_topic("Uploading_File_Options") + .&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box() + ); + $r->print( + '

' + .'' + .'

' + .'
' + ); + + # Check for bad extension and warn user + if ($fn=~/\.(\w+)$/ && + (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { + $r->print('

' + .&mt('The extension on this file, [_1], is reserved internally by LON-CAPA.', + ''.$1.'') + .'
'.&mt('Please change the extension.') + .'

'); + } elsif($fn=~/\.(\w+)$/ && + !defined(&Apache::loncommon::fileembstyle($1))) { + $r->print('

' + .&mt('The extension on this file, [_1], is not recognized by LON-CAPA.', + ''.$1.'') + .'
'.&mt('Please change the extension.') + .'

'); + } +} + +sub phasetwo { + my ($r,$fn,$mode)=@_; + + my $output; + my $action = '/adm/upload'; + my $returnflag = ''; + if ($mode eq 'testbank') { + $action = '/adm/testbank'; + } elsif ($mode eq 'imsimport') { + $action = '/adm/imsimport'; + } + $fn=~s/\/+/\//g; + if ($fn) { + my $target= $r->dir_config('lonDocRoot').'/'.$fn; + &Debug($r, "target -> ".$target); +# target is the full filesystem path of the destination file. + my $base = &File::Basename::basename($fn); + my $path = &File::Basename::dirname($fn); + $base = &HTML::Entities::encode($base,'<>&"'); + my $url = $path."/".$base; + &Debug($r, "URL is now ".$url); + my $datatoken=$env{'form.datatoken'}; + if (($fn) && ($datatoken)) { + if ($env{'form.cancel'}) { + my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp'; + my $dirpath=$path.'/'; + $dirpath=~s/\/+/\//g; + $output .= '

'.&mt('Upload cancelled.').'

' + .'

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

'; + } elsif ((-e $target) && (!$env{'form.override'})) { + $output .= '
' + .'

' + .&mt('File [_1] already exists.', + ''.$fn.'') + .'' + .'' + .'' + .'

' + .'' + .' ' + .'

' + .'
'; + } else { + my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp'; + my $dirpath=$path.'/'; + $dirpath=~s/\/+/\//g; + # Check for bad extension and disallow upload + my $result; + ($result,$returnflag) = &check_extension($fn,$mode,$source,$target,$action,$dirpath,$url); + $output .= $result; + } + } else { + $output .= ''. + &mt('Please use browser "Back" button and pick a filename'). + '
'; + } + } else { + $output .= ''. + &mt('Please use browser "Back" button and pick a filename'). + '
'; + } + return ($output,$returnflag); +} + +sub check_extension { + my ($fn,$mode,$source,$target,$action,$dirpath,$url) = @_; + my ($result,$returnflag); + # Check for bad extension and disallow upload + if ($fn=~/\.(\w+)$/ && + (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { + $result .= '

'. + &mt('File [_1] could not be copied.', + ''.$fn.' '). + '
'. + &mt('The extension on this file is reserved internally by LON-CAPA.'). + '

'; + } elsif ($fn=~/\.(\w+)$/ && + !defined(&Apache::loncommon::fileembstyle($1))) { + $result .= '

'. + &mt('File [_1] could not be copied.', + ''.$fn.' '). + '
'. + &mt('The extension on this file is not recognized by LON-CAPA.'). + '

'; + } elsif (-d $target) { + $result .= '

'. + &mt('File [_1] could not be copied.', + ''.$fn.''). + '
'. + &mt('The target is an existing directory.'). + '

'; + } elsif (copy($source,$target)) { + chmod(0660, $target); # Set permissions to rw-rw---. + if ($mode eq 'testbank' || $mode eq 'imsimport') { + $returnflag = 'ok'; + $result .= '

' + .&mt('Your file - [_1] - was uploaded successfully.', + ''.$fn.'') + .'

'; + } else { + $result .= '

' + .&mt('File copied.') + .'

'; + } + # Check for embedded objects. + my (%allfiles,%codebase); + my ($text,$header,$css,$js); + if (($mode ne 'imsimport') && ($target =~ /\.(htm|html|shtml)$/i)) { + my (%allfiles,%codebase); + &Apache::lonnet::extract_embedded_items($target,\%allfiles,\%codebase); + if (keys(%allfiles) > 0) { + my ($currentpath) = ($url =~ m{^(.+)/[^/]+$}); + my $state = &embedded_form_elems('upload_embedded',$url,$mode); + my ($embedded,$num,$pathchg) = + &Apache::loncommon::ask_for_embedded_content($action,$state,\%allfiles, + \%codebase, + {'error_on_invalid_names' => 1, + 'ignore_remote_references' => 1, + 'current_path' => $currentpath}); + if ($embedded) { + $result .= '

'.&mt('Reference Warning').'

'; + if ($num) { + $result .= '

'.&mt('Completed upload of the file.').' '.&mt('This file contained references to other files.').'

'. + '

'.&mt('Please select the locations from which the referenced files are to be uploaded.').'

'. + $embedded; + if ($mode eq 'testbank') { + $returnflag = 'embedded'; + $result .= '

'.&mt('Or [_1]continue[_2] the testbank import without these files.','','').'

'; + } + } else { + $result .= '

'.&mt('Completed upload of the file.').'

'.$embedded; + if ($pathchg) { + if ($mode eq 'testbank') { + $returnflag = 'embedded'; + $result .= '

'.&mt('Or [_1]continue[_2] the testbank import without modifying the references(s).','','').'

'; + } + } + } + } + } + } + if (($mode ne 'imsimport') && ($mode ne 'testbank')) { + $result .= '
'. + &mt('View file').''; + } + } else { + $result .= &mt('Failed to copy: [_1].',$!); + } + if ($mode ne 'imsimport' && $mode ne 'testbank') { + $result .= '
'. + &mt('Back to Directory').'
'; + } + return ($result,$returnflag); +} + +sub phasethree { + my ($r,$fn,$uname,$udom,$mode) = @_; + + my $action = '/adm/upload'; + if ($mode eq 'testbank') { + $action = '/adm/testbank'; + } elsif ($mode eq 'imsimport') { + $action = '/adm/imsimport'; + } + my $url_root = "/priv/$udom/$uname"; + my $dir_root = $r->dir_config('lonDocRoot').$url_root; + my $path = &File::Basename::dirname($fn); + $path =~ s{^\Q$url_root\E}{}; + my $filename = &HTML::Entities::encode($env{'form.filename'},'<>&"'); + my $state = &embedded_form_elems('modify_orightml',$filename,$mode). + ''; + my ($result,$returnflag) = + &Apache::loncommon::upload_embedded($mode,$path,$uname,$udom, + $dir_root,$url_root,undef, + undef,undef,$state,$action); + if ($mode ne 'imsimport' && $mode ne 'testbank') { + $result .= '

'. + &mt('View main file').'

'. + '

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


'; + } + return ($result,$returnflag); +} + +sub embedded_form_elems { + my ($action,$filename,$mode) = @_; + return < + + +STATE +} + +sub phasefour { + my ($r,$fn,$uname,$udom,$mode) = @_; + + my $action = '/adm/upload'; + if ($mode eq 'testbank') { + $action = '/adm/testbank'; + } elsif ($mode eq 'imsimport') { + $action = '/adm/imsimport'; + } + my $result; + my $url_root = "/priv/$udom/$uname"; + my $dir_root = $r->dir_config('lonDocRoot').$url_root; + my $path = &File::Basename::dirname($fn); + $path =~ s{^\Q$url_root\E}{}; + my $outcome = + &Apache::loncommon::modify_html_refs($mode,$path,$uname,$udom,$dir_root); + $result .= $outcome; + if ($mode ne 'imsimport' && $mode ne 'testbank') { + $result .= '

'. + &mt('View main file').'

'. + '

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


'; + } + return $result; +} + +# ---------------------------------------------------------------- Main Handler +sub handler { + + my $r=shift; + my $javascript = ''; + my $fn=$env{'form.filename'}; + + if ($env{'form.filename1'}) { + $fn=$env{'form.filename1'}.$env{'form.filename2'}; + } + $fn=~s/\/+/\//g; + + unless ($fn) { + $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. + ' unspecified filename for upload', $r->filename); + return HTTP_NOT_FOUND; + } + + my ($uname,$udom)=&Apache::loncacc::constructaccess($fn); + + unless (($uname) && ($udom)) { + $r->log_reason($uname.' at '.$udom. + ' trying to publish file '.$env{'form.filename'}. + ' - not authorized', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } + +# ----------------------------------------------------------- Start page output + + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + + unless ($env{'form.phase'} eq 'two') { + $javascript = <<"ENDJS"; + +ENDJS + } + + my $londocroot = $r->dir_config('lonDocRoot'); + my $trailfile = $fn; + $trailfile =~ s{^/(priv/)}{$londocroot/$1}; + + # Breadcrumbs + my $brcrum = [{'href' => &Apache::loncommon::authorspace($fn), + 'text' => 'Construction Space'}, + {'href' => '/adm/upload', + 'text' => 'Upload file to Construction Space'}]; + $r->print(&Apache::loncommon::start_page('Upload file to Construction Space', + $javascript, + {'bread_crumbs' => $brcrum,}) + .&Apache::loncommon::head_subbox( + &Apache::loncommon::CSTR_pageheader($trailfile)) + ); + + if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { + $r->print('

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

' + ); + } + if ($env{'form.phase'} eq 'four') { + my $output = &phasefour($r,$fn,$uname,$udom,'author'); + $r->print($output); + } elsif ($env{'form.phase'} eq 'three') { + my ($output,$rtnflag) = &phasethree($r,$fn,$uname,$udom,'author'); + $r->print($output); + } elsif ($env{'form.phase'} eq 'two') { + my ($output,$returnflag) = &phasetwo($r,$fn); + $r->print($output); + } else { + &phaseone($r,$fn); + } + + $r->print(&Apache::loncommon::end_page()); + return OK; +} + +1; +__END__ + + 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.