Annotation of loncom/publisher/lonupload.pm, revision 1.14

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>