Return to lonupload.pm CVS log

Up to [LON-CAPA] / loncom / publisher

Bug 442: Two issues with special chars. solved here:
1. spaces in names - escape works fine on this issue.
2. apostrophe's in uploaded file names:

Apostrophe solution not so easy as spaces:  The problem was in the
Frame src tag for the lower frame of construction space.. it's of the form:
<frame> src='$lowerframe' ...Thanks to matt for finding this.
The embedded ' closes the src from the point of view of the html.  Amazingly the
 extra characters don't cause browsers to complain.  The problem: demonstrably,
escaping via lonnet::escape does nothing worth while.  Using my handy dandy
html pocket guide, I determined that lonnet::escape is too simple minded
and may in fact be not quite right.  did a:
1. made the quotations " rather than '
2. Substituted for " in $lowerframe by:
   $lowerframe=~s/\"/&quot\;/g;

Turning " -> &quot; as per the entity chart on pg 82 of HTML Pocket ref.
This works fine.

    1: 
    2: # The LearningOnline Network with CAPA
    3: # Handler to upload files into construction space
    4: #
    5: # $Id: lonupload.pm,v 1.13 2002/08/24 03:56:58 foxr Exp $
    6: #
    7: # Copyright Michigan State University Board of Trustees
    8: #
    9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   10: #
   11: # LON-CAPA is free software; you can redistribute it and/or modify
   12: # it under the terms of the GNU General Public License as published by
   13: # the Free Software Foundation; either version 2 of the License, or
   14: # (at your option) any later version.
   15: #
   16: # LON-CAPA is distributed in the hope that it will be useful,
   17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19: # GNU General Public License for more details.
   20: #
   21: # You should have received a copy of the GNU General Public License
   22: # along with LON-CAPA; if not, write to the Free Software
   23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   24: #
   25: # /home/httpd/html/adm/gpl.txt
   26: #
   27: # http://www.lon-capa.org/
   28: #
   29: # (Handler to retrieve an old version of a file
   30: #
   31: # (Publication Handler
   32: # 
   33: # (TeX Content Handler
   34: #
   35: # YEAR=2000
   36: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
   37: #
   38: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
   39: # YEAR=2001
   40: # 03/23 Guy Albertelli
   41: # 03/24,03/29 Gerd Kortemeyer)
   42: #
   43: # 03/31,04/03 Gerd Kortemeyer)
   44: #
   45: # 04/05,04/09,05/25,06/23,06/24,08/22 Gerd Kortemeyer
   46: # 11/29 Matthew Hall
   47: # 12/16 Scott Harrison
   48: #
   49: ###
   50: 
   51: package Apache::lonupload;
   52: 
   53: use strict;
   54: use Apache::File;
   55: use File::Copy;
   56: use File::Basename;
   57: use Apache::Constants qw(:common :http :methods);
   58: use Apache::loncacc;
   59: use Apache::loncommon();
   60: use Apache::Log();
   61: use Apache::lonnet;
   62: 
   63: my $DEBUG=0;
   64: 
   65: sub Debug {
   66:   
   67:   # Marshall the parameters.
   68:   
   69:   my $r       = shift;
   70:   my $log     = $r->log;
   71:   my $message = shift;
   72:   
   73:   # Put out the indicated message butonly if DEBUG is false.
   74:   
   75:   if ($DEBUG) {
   76:     $log->debug($message);
   77:   }
   78: }
   79: 
   80: sub upfile_store {
   81:     my $r=shift;
   82: 	
   83:     my $fname=$ENV{'form.upfile.filename'};
   84:     $fname=~s/\W//g;
   85:     
   86:     chop($ENV{'form.upfile'});
   87:   
   88:     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
   89: 		  '_upload_'.$fname.'_'.time.'_'.$$;
   90:     {
   91:        my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
   92:                                    '/tmp/'.$datatoken.'.tmp');
   93:        print $fh $ENV{'form.upfile'};
   94:     }
   95:     return $datatoken;
   96: }
   97: 
   98: 
   99: sub phaseone {
  100:    my ($r,$fn,$uname,$udom)=@_;
  101:    $ENV{'form.upfile.filename'}=~s/\\/\//g;
  102:    $ENV{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
  103:    if ($ENV{'form.upfile.filename'}) {
  104:     $fn=~s/\/[^\/]+$//;
  105:     $fn=~s/([^\/])$/$1\//;
  106:     $fn.=$ENV{'form.upfile.filename'};
  107:     $fn=~s/^\///;
  108:     $fn=~s/(\/)+/\//g;
  109: 
  110: #    Fn is the full path to the destination filename.
  111: #    
  112: 
  113:     &Debug($r, "Filename for upload: $fn");
  114:     if (($fn) && ($fn!~/\/$/)) {
  115:       $r->print(
  116:  '<form action=/adm/upload method=post>'.
  117:  '<input type=hidden name=phase value=two>'.
  118:  '<input type=hidden name=datatoken value="'.&upfile_store.'">'.
  119:  'Store uploaded file as '.
  120:  '<input type=text size=50 name=filename value="/priv/'.
  121:   $uname.'/'.$fn.'"><br>'.
  122:  '<input type=submit value="Store"></form>');
  123:       # Check for bad extension and warn user
  124:       if ($fn=~/\.(\w+)$/ && 
  125: 	  (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
  126: 	  $r->print(
  127:  '<font color=red>'.
  128:  'The extension on this file, "'.$1.
  129:  '", is reserved internally by LON-CAPA. <br \>'.
  130:  'Please change the extension.'.
  131:  '</font>');
  132:       } elsif($fn=~/\.(\w+)$/ && 
  133: 	      !defined(&Apache::loncommon::fileembstyle($1))) {
  134: 	  $r->print(
  135:  '<font color=red>'.
  136:  'The extension on this file, "'.$1.
  137:  '", is not recognized by LON-CAPA. <br \>'.
  138:  'Please change the extension.'.
  139:  '</font>');
  140:       }
  141:   } else {
  142:       $r->print('<font color=red>Illegal filename.</font>');
  143:   }
  144:  } else {
  145:      $r->print('<font color=red>No upload file specified.</font>');
  146:  }
  147: }
  148: 
  149: sub phasetwo {
  150:    my ($r,$fn,$uname,$udom)=@_;
  151:    &Debug($r, "Filename is ".$fn);
  152:    if ($fn=~/^\/priv\/$uname\//) {
  153:     &Debug($r, "Filename after priv substitution: ".$fn);
  154:     my $tfn=$fn;
  155:     $tfn=~s/^\/(\~|priv)\/(\w+)//;
  156:     &Debug($r, "Filename for tfn = ".$tfn);
  157:     my $target='/home/'.$uname.'/public_html'.$tfn;
  158:     &Debug($r, "target -> ".$target);
  159: #     target is the full filesystem path of the destination file.
  160:     my $base = &File::Basename::basename($fn);
  161:     my $path = &File::Basename::dirname($fn);
  162:     $base    = Apache::lonnet::escape($base);
  163:     my $url  = $path."/".$base; 
  164:     &Debug($r, "URL is now ".$url);
  165:     my $datatoken=$ENV{'form.datatoken'};
  166:     if (($fn) && ($datatoken)) {
  167: 	if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) {
  168:            $r->print(
  169:  '<form action=/adm/upload method=post>'.
  170:  'File <tt>'.$fn.'</tt> exists. Overwrite? '.
  171:  '<input type=hidden name=phase value=two>'.
  172:  '<input type=hidden name=filename value="'."$url".'">'.
  173:  '<input type=hidden name=datatoken value="'.$datatoken.'">'.
  174:  '<input type=submit name=override value="Yes"></form>');
  175:        } else {
  176:            my $source=$r->dir_config('lonDaemons').
  177: 	                             '/tmp/'.$datatoken.'.tmp';
  178:            # Check for bad extension and disallow upload
  179: 	   if ($fn=~/\.(\w+)$/ && 
  180: 	       (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
  181: 	       $r->print(
  182:  'File <tt>'.$fn.'</tt> could not be copied.<br />'.
  183:  '<font color=red>'.
  184:  'The extension on this file is reserved internally by LON-CAPA.'.
  185:  '</font>');
  186: 	   } elsif ($fn=~/\.(\w+)$/ && 
  187: 		    !defined(&Apache::loncommon::fileembstyle($1))) {
  188: 	       $r->print(
  189:  'File <tt>'.$fn.'</tt> could not be copied.<br />'.
  190:  '<font color=red>'.
  191:  'The extension on this file is not recognized by LON-CAPA.'.
  192:  '</font>');
  193: 	   } elsif (copy($source,$target)) {
  194: 	       chmod(0660, $target); # Set permissions to rw-rw---.
  195: 	      $r->print('File copied.');
  196:               $r->print('<p><font size=+2><a href="'.$url.
  197:                         '">View file</a></font>');
  198: 	   } else {
  199:               $r->print('Failed to copy: '.$!);
  200: 	   }
  201:        }
  202:     } else {
  203:        $r->print(
  204:    '<font size=+1 color=red>Please pick a filename</font><p>');
  205:        &phaseone($r,$fn,$uname,$udom);
  206:     }
  207:   } else {
  208:     $r->print(
  209:    '<font size=+1 color=red>Please pick a filename</font><p>');
  210:     &phaseone($r,$fn,$uname,$udom);
  211:   }
  212: }
  213: 
  214: # ---------------------------------------------------------------- Main Handler
  215: sub handler {
  216: 
  217:   my $r=shift;
  218: 
  219:   my $uname;
  220:   my $udom;
  221: 
  222:   ($uname,$udom)=
  223:     &Apache::loncacc::constructaccess(
  224: 			 $ENV{'form.filename'},$r->dir_config('lonDefDomain'));
  225:   unless (($uname) && ($udom)) {
  226:      $r->log_reason($uname.' at '.$udom.
  227:          ' trying to publish file '.$ENV{'form.filename'}.
  228:          ' - not authorized', 
  229:          $r->filename); 
  230:      return HTTP_NOT_ACCEPTABLE;
  231:   }
  232: 
  233:   my $fn;
  234: 
  235:   if ($ENV{'form.filename'}) {
  236:       $fn=$ENV{'form.filename'};
  237:       $fn=~s/^http\:\/\/[^\/]+\/(\~|priv\/)(\w+)//;
  238:   } else {
  239:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
  240:          ' unspecified filename for upload', $r->filename); 
  241:      return HTTP_NOT_FOUND;
  242:   }
  243: 
  244: # ----------------------------------------------------------- Start page output
  245: 
  246: 
  247:   $r->content_type('text/html');
  248:   $r->send_http_header;
  249: 
  250:   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
  251: 
  252:   $r->print(
  253:    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
  254: 
  255:   
  256:   $r->print('<h1>Upload file to Construction Space</h1>');
  257:   
  258:   if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
  259:           $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom.
  260:                '</font></h3>');
  261:   }
  262: 
  263: 
  264:   if ($ENV{'form.phase'} eq 'two') {
  265:       &phasetwo($r,$fn,$uname,$udom);
  266:   } else {
  267:       &phaseone($r,$fn,$uname,$udom);
  268:   }
  269: 
  270:   $r->print('</body></html>');
  271:   return OK;  
  272: }
  273: 
  274: 1;
  275: __END__
  276: 
  277: =head1 NAME
  278: 
  279: Apache::lonupload - upload files into construction space
  280: 
  281: =head1 SYNOPSIS
  282: 
  283: Invoked by /etc/httpd/conf/srm.conf:
  284: 
  285:  <Location /adm/upload>
  286:  PerlAccessHandler       Apache::lonacc
  287:  SetHandler perl-script
  288:  PerlHandler Apache::lonupload
  289:  ErrorDocument     403 /adm/login
  290:  ErrorDocument     404 /adm/notfound.html
  291:  ErrorDocument     406 /adm/unauthorized.html
  292:  ErrorDocument	  500 /adm/errorhandler
  293:  </Location>
  294: 
  295: =head1 INTRODUCTION
  296: 
  297: This module uploads a file sitting on a client computer into 
  298: library server construction space.
  299: 
  300: This is part of the LearningOnline Network with CAPA project
  301: described at http://www.lon-capa.org.
  302: 
  303: =head1 HANDLER SUBROUTINE
  304: 
  305: This routine is called by Apache and mod_perl.
  306: 
  307: =over 4
  308: 
  309: =item *
  310: 
  311: Initialize variables
  312: 
  313: =item *
  314: 
  315: Start page output
  316: 
  317: =item *
  318: 
  319: output relevant interface phase (phaseone or phasetwo)
  320: 
  321: =item *
  322: 
  323: (phase one is to specify upload file; phase two is to handle conditions
  324: subsequent to specification--like overwriting an existing file)
  325: 
  326: =back
  327: 
  328: =head1 OTHER SUBROUTINES
  329: 
  330: =over 4
  331: 
  332: =item *
  333: 
  334: phaseone() : Interface for specifying file to upload.
  335: 
  336: =item *
  337: 
  338: phasetwo() : Interface for handling post-conditions about uploading (such
  339: as overwriting an existing file).
  340: 
  341: =item *
  342: 
  343: upfile_store() : Store contents of uploaded file into temporary space.  Invoked
  344: by phaseone subroutine.
  345: 
  346: =back
  347: 
  348: =cut