--- loncom/publisher/lonupload.pm 2003/11/08 10:58:30 1.21 +++ loncom/publisher/lonupload.pm 2003/11/08 11:04:52 1.22 @@ -2,7 +2,7 @@ # The LearningOnline Network with CAPA # Handler to upload files into construction space # -# $Id: lonupload.pm,v 1.21 2003/11/08 10:58:30 albertel Exp $ +# $Id: lonupload.pm,v 1.22 2003/11/08 11:04:52 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -46,17 +46,17 @@ my $DEBUG=0; sub Debug { - # Marshall the parameters. + # Marshall the parameters. - my $r = shift; - my $log = $r->log; - my $message = shift; + my $r = shift; + my $log = $r->log; + my $message = shift; - # Put out the indicated message butonly if DEBUG is false. + # Put out the indicated message butonly if DEBUG is false. - if ($DEBUG) { - $log->debug($message); - } + if ($DEBUG) { + $log->debug($message); + } } sub upfile_store { @@ -79,197 +79,191 @@ sub upfile_store { 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; + 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( - '
'. - ''. - ''. - ''. - &mt('Store uploaded file as ')."/priv/$uname/". - '
'. - '
'); - # 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. - '"'.&mt(', is reserved internally by LON-CAPA.').'
'. - &mt('Please change the extension.'). - ''); - } elsif($fn=~/\.(\w+)$/ && - !defined(&Apache::loncommon::fileembstyle($1))) { - $r->print( - ''. - &mt('The extension on this file,').' "'.$1. - '"'.&mt(', is not recognized by LON-CAPA.').'
'. - &mt('Please change the extension.'). - ''); - } - } else { - $r->print(''.&mt('Illegal filename.').''); - } - } else { - $r->print(''.&mt('No upload file specified.').''); - } + &Debug($r, "Filename for upload: $fn"); + if (($fn) && ($fn!~/\/$/)) { + $r->print('
'. + ''. + ''. + ''. + &mt('Store uploaded file as ')."/priv/$uname/". + '
'. + '
'); + # 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.'"'.&mt(', is reserved internally by LON-CAPA.'). + '
'.&mt('Please change the extension.').''); + } elsif($fn=~/\.(\w+)$/ && + !defined(&Apache::loncommon::fileembstyle($1))) { + $r->print(''.&mt('The extension on this file,'). + ' "'.$1.'"'.&mt(', is not recognized by LON-CAPA.'). + '
'.&mt('Please change the extension.'). + ''); + } + } else { + $r->print(''.&mt('Illegal filename.').''); + } + } else { + $r->print(''.&mt('No upload file specified.').''); + } } sub phasetwo { - my ($r,$tfn,$uname,$udom)=@_; - my $fn='/priv/'.$uname.'/'.$tfn; - $fn=~s/\/+/\//g; - &Debug($r, "Filename is ".$tfn); - if ($tfn) { - &Debug($r, "Filename for tfn = ".$tfn); - my $target='/home/'.$uname.'/public_html'.$tfn; - &Debug($r, "target -> ".$target); + my ($r,$tfn,$uname,$udom)=@_; + my $fn='/priv/'.$uname.'/'.$tfn; + $fn=~s/\/+/\//g; + &Debug($r, "Filename is ".$tfn); + if ($tfn) { + &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( - '
'. - &mt('File').' '.$fn.' '.&mt('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( - &mt('File').' '.$fn.' '.&mt('could not be copied.').'
'. - ''. - &mt('The extension on this file is reserved internally by LON-CAPA.'). - ''); - $r->print('

'.&mt('Back to Directory').''); - } elsif ($fn=~/\.(\w+)$/ && - !defined(&Apache::loncommon::fileembstyle($1))) { - $r->print( - &mt('File').' '.$fn.' '.&mt('could not be copied.').'
'. - ''. - &mt('The extension on this file is not recognized by LON-CAPA.'). - ''); - $r->print('

'.&mt('Back to Directory').''); - } elsif (-d $target) { - $r->print( - 'File '.$fn.' could not be copied.
'. - ''. - &mt('The target is an existing directory.'). - ''); - $r->print('

'.&mt('Back to Directory').''); - } elsif (copy($source,$target)) { - chmod(0660, $target); # Set permissions to rw-rw---. - $r->print(&mt('File copied.')); - $r->print('

'.&mt('View file').''); - $r->print('

'.&mt('Back to Directory').''); - } else { - $r->print('Failed to copy: '.$!); - $r->print('

'.&mt('Back to Directory').''); - } - } + 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('

'. + &mt('File').' '.$fn.' '. + &mt('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(&mt('File').' '.$fn.' '. + &mt('could not be copied.').'
'. + ''. + &mt('The extension on this file is reserved internally by LON-CAPA.'). + ''); + $r->print('

'. + &mt('Back to Directory').''); + } elsif ($fn=~/\.(\w+)$/ && + !defined(&Apache::loncommon::fileembstyle($1))) { + $r->print(&mt('File').' '.$fn.' '. + &mt('could not be copied.').'
'. + ''. + &mt('The extension on this file is not recognized by LON-CAPA.'). + ''); + $r->print('

'. + &mt('Back to Directory').''); + } elsif (-d $target) { + $r->print('File '.$fn.' could not be copied.
'. + ''. + &mt('The target is an existing directory.'). + ''); + $r->print('

'. + &mt('Back to Directory').''); + } elsif (copy($source,$target)) { + chmod(0660, $target); # Set permissions to rw-rw---. + $r->print(&mt('File copied.')); + $r->print('

'. + &mt('View file').''); + $r->print('

'. + &mt('Back to Directory').''); + } else { + $r->print('Failed to copy: '.$!); + $r->print('

'. + &mt('Back to Directory').''); + } + } + } else { + $r->print(''. + &mt('Please use browser "Back" button and pick a filename'). + '

'); + } } else { - $r->print( - ''. -&mt('Please use browser "Back" button and pick a filename').'

'); + $r->print(''. + &mt('Please use browser "Back" button and pick a filename'). + '

'); } - } else { - $r->print( - ''.&mt('Please use browser "Back" button and pick a filename').'

'); - } } # ---------------------------------------------------------------- Main Handler sub handler { - my $r=shift; + my $r=shift; - my $uname; - my $udom; + my $uname; + my $udom; # # phase two: re-attach user # - if ($ENV{'form.uploaduname'}) { - $ENV{'form.filename'}='/priv/'.$ENV{'form.uploaduname'}.'/'. - $ENV{'form.filename'}; - } -# - - ($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\:\/\/[^\/]+\///; - $fn=~s/^\///; - $fn=~s/(\~|priv\/)(\w+)//; - $fn=~s/\/+/\//g; - } else { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. - ' unspecified filename for upload', $r->filename); - return HTTP_NOT_FOUND; - } + if ($ENV{'form.uploaduname'}) { + $ENV{'form.filename'}='/priv/'.$ENV{'form.uploaduname'}.'/'. + $ENV{'form.filename'}; + } +# + + ($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\:\/\/[^\/]+\///; + $fn=~s/^\///; + $fn=~s/(\~|priv\/)(\w+)//; + $fn=~s/\/+/\//g; + } else { + $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + ' unspecified filename for upload', $r->filename); + return HTTP_NOT_FOUND; + } # ----------------------------------------------------------- Start page output - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; - $r->print('LON-CAPA Construction Space'); + $r->print('LON-CAPA Construction Space'); - $r->print(&Apache::loncommon::bodytag('Upload file to Construction Space')); + $r->print(&Apache::loncommon::bodytag('Upload file to Construction Space')); - if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { - $r->print('

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

'); - } - - if ($ENV{'form.phase'} eq 'two') { - &phasetwo($r,$fn,$uname,$udom); - } else { - &phaseone($r,$fn,$uname,$udom); - } + if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { + $r->print('

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

'); + } + + if ($ENV{'form.phase'} eq 'two') { + &phasetwo($r,$fn,$uname,$udom); + } else { + &phaseone($r,$fn,$uname,$udom); + } - $r->print(''); - return OK; + $r->print(''); + return OK; } 1;