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

1.12      foxr        1: 
1.1       www         2: # The LearningOnline Network with CAPA
                      3: # Handler to upload files into construction space
                      4: #
1.15    ! harris41    5: # $Id: lonupload.pm,v 1.14 2002/09/10 02:31:26 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: #
                     48: ###
1.1       www        49: 
                     50: package Apache::lonupload;
                     51: 
                     52: use strict;
                     53: use Apache::File;
                     54: use File::Copy;
1.13      foxr       55: use File::Basename;
1.1       www        56: use Apache::Constants qw(:common :http :methods);
1.3       www        57: use Apache::loncacc;
1.10      harris41   58: use Apache::loncommon();
1.12      foxr       59: use Apache::Log();
1.13      foxr       60: use Apache::lonnet;
1.14      foxr       61: use HTML::Entities();
1.12      foxr       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: }
1.1       www        79: 
1.2       www        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'});
1.1       www        87:   
1.2       www        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'};
1.1       www        94:     }
1.2       www        95:     return $datatoken;
                     96: }
                     97: 
                     98: 
                     99: sub phaseone {
1.5       www       100:    my ($r,$fn,$uname,$udom)=@_;
1.6       www       101:    $ENV{'form.upfile.filename'}=~s/\\/\//g;
                    102:    $ENV{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
1.5       www       103:    if ($ENV{'form.upfile.filename'}) {
1.2       www       104:     $fn=~s/\/[^\/]+$//;
                    105:     $fn=~s/([^\/])$/$1\//;
                    106:     $fn.=$ENV{'form.upfile.filename'};
1.3       www       107:     $fn=~s/^\///;
                    108:     $fn=~s/(\/)+/\//g;
1.13      foxr      109: 
                    110: #    Fn is the full path to the destination filename.
                    111: #    
                    112: 
1.12      foxr      113:     &Debug($r, "Filename for upload: $fn");
1.3       www       114:     if (($fn) && ($fn!~/\/$/)) {
                    115:       $r->print(
1.2       www       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 '.
1.3       www       120:  '<input type=text size=50 name=filename value="/priv/'.
                    121:   $uname.'/'.$fn.'"><br>'.
1.2       www       122:  '<input type=submit value="Store"></form>');
1.9       matthew   123:       # Check for bad extension and warn user
1.8       matthew   124:       if ($fn=~/\.(\w+)$/ && 
1.10      harris41  125: 	  (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.8       matthew   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>');
1.9       matthew   132:       } elsif($fn=~/\.(\w+)$/ && 
1.10      harris41  133: 	      !defined(&Apache::loncommon::fileembstyle($1))) {
1.9       matthew   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:       }
1.3       www       141:   } else {
                    142:       $r->print('<font color=red>Illegal filename.</font>');
                    143:   }
1.5       www       144:  } else {
                    145:      $r->print('<font color=red>No upload file specified.</font>');
                    146:  }
1.1       www       147: }
                    148: 
                    149: sub phasetwo {
1.4       www       150:    my ($r,$fn,$uname,$udom)=@_;
1.13      foxr      151:    &Debug($r, "Filename is ".$fn);
                    152:    if ($fn=~/^\/priv\/$uname\//) {
                    153:     &Debug($r, "Filename after priv substitution: ".$fn);
1.3       www       154:     my $tfn=$fn;
                    155:     $tfn=~s/^\/(\~|priv)\/(\w+)//;
1.13      foxr      156:     &Debug($r, "Filename for tfn = ".$tfn);
1.3       www       157:     my $target='/home/'.$uname.'/public_html'.$tfn;
1.13      foxr      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);
1.14      foxr      162:     $base    = &HTML::Entities::encode($base);
1.13      foxr      163:     my $url  = $path."/".$base; 
                    164:     &Debug($r, "URL is now ".$url);
1.2       www       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>'.
1.13      foxr      172:  '<input type=hidden name=filename value="'."$url".'">'.
1.2       www       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';
1.9       matthew   178:            # Check for bad extension and disallow upload
1.8       matthew   179: 	   if ($fn=~/\.(\w+)$/ && 
1.10      harris41  180: 	       (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.8       matthew   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.'.
1.9       matthew   185:  '</font>');
                    186: 	   } elsif ($fn=~/\.(\w+)$/ && 
1.10      harris41  187: 		    !defined(&Apache::loncommon::fileembstyle($1))) {
1.9       matthew   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.'.
1.8       matthew   192:  '</font>');
                    193: 	   } elsif (copy($source,$target)) {
1.11      foxr      194: 	       chmod(0660, $target); # Set permissions to rw-rw---.
1.2       www       195: 	      $r->print('File copied.');
1.13      foxr      196:               $r->print('<p><font size=+2><a href="'.$url.
1.2       www       197:                         '">View file</a></font>');
                    198: 	   } else {
                    199:               $r->print('Failed to copy: '.$!);
                    200: 	   }
                    201:        }
1.1       www       202:     } else {
                    203:        $r->print(
1.2       www       204:    '<font size=+1 color=red>Please pick a filename</font><p>');
1.1       www       205:        &phaseone($r,$fn,$uname,$udom);
                    206:     }
1.4       www       207:   } else {
                    208:     $r->print(
                    209:    '<font size=+1 color=red>Please pick a filename</font><p>');
                    210:     &phaseone($r,$fn,$uname,$udom);
                    211:   }
1.1       www       212: }
                    213: 
1.10      harris41  214: # ---------------------------------------------------------------- Main Handler
1.1       www       215: sub handler {
                    216: 
                    217:   my $r=shift;
                    218: 
1.3       www       219:   my $uname;
                    220:   my $udom;
                    221: 
1.5       www       222:   ($uname,$udom)=
1.3       www       223:     &Apache::loncacc::constructaccess(
1.5       www       224: 			 $ENV{'form.filename'},$r->dir_config('lonDefDomain'));
                    225:   unless (($uname) && ($udom)) {
1.3       www       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: 
1.1       www       233:   my $fn;
                    234: 
                    235:   if ($ENV{'form.filename'}) {
                    236:       $fn=$ENV{'form.filename'};
1.3       www       237:       $fn=~s/^http\:\/\/[^\/]+\/(\~|priv\/)(\w+)//;
1.1       www       238:   } else {
                    239:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
1.2       www       240:          ' unspecified filename for upload', $r->filename); 
1.1       www       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:   
1.2       www       256:   $r->print('<h1>Upload file to Construction Space</h1>');
1.3       www       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: 
1.1       www       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: }
1.7       www       273: 
                    274: 1;
                    275: __END__
1.10      harris41  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

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