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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to upload files into construction space
                      3: #
1.8     ! matthew     4: # $Id: gplheader.pl,v 1.1 2001/11/29 18:19:27 www Exp $
        !             5: #
        !             6: # Copyright Michigan State University Board of Trustees
        !             7: #
        !             8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
        !             9: #
        !            10: # LON-CAPA is free software; you can redistribute it and/or modify
        !            11: # it under the terms of the GNU General Public License as published by
        !            12: # the Free Software Foundation; either version 2 of the License, or
        !            13: # (at your option) any later version.
        !            14: #
        !            15: # LON-CAPA is distributed in the hope that it will be useful,
        !            16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            18: # GNU General Public License for more details.
        !            19: #
        !            20: # You should have received a copy of the GNU General Public License
        !            21: # along with LON-CAPA; if not, write to the Free Software
        !            22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
        !            23: #
        !            24: # /home/httpd/html/adm/gpl.txt
        !            25: #
        !            26: # http://www.lon-capa.org/
        !            27: #
1.1       www        28: # (Handler to retrieve an old version of a file
                     29: #
                     30: # (Publication Handler
                     31: # 
                     32: # (TeX Content Handler
                     33: #
                     34: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
                     35: #
                     36: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
                     37: # 03/23 Guy Albertelli
                     38: # 03/24,03/29 Gerd Kortemeyer)
                     39: #
                     40: # 03/31,04/03 Gerd Kortemeyer)
                     41: #
1.7       www        42: # 04/05,04/09,05/25,06/23,06/24,08/22 Gerd Kortemeyer
1.8     ! matthew    43: # 11/29 Matthew Hall
1.1       www        44: 
                     45: package Apache::lonupload;
                     46: 
                     47: use strict;
                     48: use Apache::File;
                     49: use File::Copy;
                     50: use Apache::Constants qw(:common :http :methods);
1.3       www        51: use Apache::loncacc;
1.8     ! matthew    52: use Apache::lonnet;
1.1       www        53: 
1.2       www        54: sub upfile_store {
                     55:     my $r=shift;
                     56: 	
                     57:     my $fname=$ENV{'form.upfile.filename'};
                     58:     $fname=~s/\W//g;
                     59:     
                     60:     chop($ENV{'form.upfile'});
1.1       www        61:   
1.2       www        62:     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
                     63: 		  '_upload_'.$fname.'_'.time.'_'.$$;
                     64:     {
                     65:        my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
                     66:                                    '/tmp/'.$datatoken.'.tmp');
                     67:        print $fh $ENV{'form.upfile'};
1.1       www        68:     }
1.2       www        69:     return $datatoken;
                     70: }
                     71: 
                     72: 
                     73: sub phaseone {
1.5       www        74:    my ($r,$fn,$uname,$udom)=@_;
1.6       www        75:    $ENV{'form.upfile.filename'}=~s/\\/\//g;
                     76:    $ENV{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
1.5       www        77:    if ($ENV{'form.upfile.filename'}) {
1.2       www        78:     $fn=~s/\/[^\/]+$//;
                     79:     $fn=~s/([^\/])$/$1\//;
                     80:     $fn.=$ENV{'form.upfile.filename'};
1.3       www        81:     $fn=~s/^\///;
                     82:     $fn=~s/(\/)+/\//g;
1.8     ! matthew    83: 
1.3       www        84:     if (($fn) && ($fn!~/\/$/)) {
                     85:       $r->print(
1.2       www        86:  '<form action=/adm/upload method=post>'.
                     87:  '<input type=hidden name=phase value=two>'.
                     88:  '<input type=hidden name=datatoken value="'.&upfile_store.'">'.
                     89:  'Store uploaded file as '.
1.3       www        90:  '<input type=text size=50 name=filename value="/priv/'.
                     91:   $uname.'/'.$fn.'"><br>'.
1.2       www        92:  '<input type=submit value="Store"></form>');
1.8     ! matthew    93:       # Check for bad extension
        !            94:       if ($fn=~/\.(\w+)$/ && 
        !            95: 	  (&Apache::lonnet::fileembstyle($1) eq 'hdn')) {
        !            96: 	  $r->print(
        !            97:  '<font color=red>'.
        !            98:  'The extension on this file, "'.$1.
        !            99:  '", is reserved internally by LON-CAPA. <br \>'.
        !           100:  'Please change the extension.'.
        !           101:  '</font>');
        !           102:       }  
1.3       www       103:   } else {
                    104:       $r->print('<font color=red>Illegal filename.</font>');
                    105:   }
1.5       www       106:  } else {
                    107:      $r->print('<font color=red>No upload file specified.</font>');
                    108:  }
1.1       www       109: }
                    110: 
                    111: sub phasetwo {
1.4       www       112:    my ($r,$fn,$uname,$udom)=@_;
                    113:    if ($fn=~/^\/priv\/$uname\//) { 
1.3       www       114:     my $tfn=$fn;
                    115:     $tfn=~s/^\/(\~|priv)\/(\w+)//;
                    116:     my $target='/home/'.$uname.'/public_html'.$tfn;
1.2       www       117:     my $datatoken=$ENV{'form.datatoken'};
                    118:     if (($fn) && ($datatoken)) {
                    119: 	if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) {
                    120:            $r->print(
                    121:  '<form action=/adm/upload method=post>'.
                    122:  'File <tt>'.$fn.'</tt> exists. Overwrite? '.
                    123:  '<input type=hidden name=phase value=two>'.
                    124:  '<input type=hidden name=filename value="'.$fn.'">'.
                    125:  '<input type=hidden name=datatoken value="'.$datatoken.'">'.
                    126:  '<input type=submit name=override value="Yes"></form>');
                    127:        } else {
                    128:            my $source=$r->dir_config('lonDaemons').
                    129: 	                             '/tmp/'.$datatoken.'.tmp';
1.8     ! matthew   130:            # Check for bad extension
        !           131: 	   if ($fn=~/\.(\w+)$/ && 
        !           132: 	       (&Apache::lonnet::fileembstyle($1) eq 'hdn')) {
        !           133: 	       $r->print(
        !           134:  'File <tt>'.$fn.'</tt> could not be copied.<br />'.
        !           135:  '<font color=red>'.
        !           136:  'The extension on this file is reserved internally by LON-CAPA.'.
        !           137:  '</font>');
        !           138: 	   } elsif (copy($source,$target)) {
1.2       www       139: 	      $r->print('File copied.');
1.3       www       140:               $r->print('<p><font size=+2><a href="'.$fn.
1.2       www       141:                         '">View file</a></font>');
                    142: 	   } else {
                    143:               $r->print('Failed to copy: '.$!);
                    144: 	   }
                    145:        }
1.1       www       146:     } else {
                    147:        $r->print(
1.2       www       148:    '<font size=+1 color=red>Please pick a filename</font><p>');
1.1       www       149:        &phaseone($r,$fn,$uname,$udom);
                    150:     }
1.4       www       151:   } else {
                    152:     $r->print(
                    153:    '<font size=+1 color=red>Please pick a filename</font><p>');
                    154:     &phaseone($r,$fn,$uname,$udom);
                    155:   }
1.1       www       156: }
                    157: 
                    158: sub handler {
                    159: 
                    160:   my $r=shift;
                    161: 
1.3       www       162:   my $uname;
                    163:   my $udom;
                    164: 
1.5       www       165:   ($uname,$udom)=
1.3       www       166:     &Apache::loncacc::constructaccess(
1.5       www       167: 			 $ENV{'form.filename'},$r->dir_config('lonDefDomain'));
                    168:   unless (($uname) && ($udom)) {
1.3       www       169:      $r->log_reason($uname.' at '.$udom.
                    170:          ' trying to publish file '.$ENV{'form.filename'}.
                    171:          ' - not authorized', 
                    172:          $r->filename); 
                    173:      return HTTP_NOT_ACCEPTABLE;
                    174:   }
                    175: 
1.1       www       176:   my $fn;
                    177: 
                    178:   if ($ENV{'form.filename'}) {
                    179:       $fn=$ENV{'form.filename'};
1.3       www       180:       $fn=~s/^http\:\/\/[^\/]+\/(\~|priv\/)(\w+)//;
1.1       www       181:   } else {
                    182:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
1.2       www       183:          ' unspecified filename for upload', $r->filename); 
1.1       www       184:      return HTTP_NOT_FOUND;
                    185:   }
                    186: 
                    187: # ----------------------------------------------------------- Start page output
                    188: 
                    189: 
                    190:   $r->content_type('text/html');
                    191:   $r->send_http_header;
                    192: 
                    193:   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
                    194: 
                    195:   $r->print(
                    196:    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
                    197: 
                    198:   
1.2       www       199:   $r->print('<h1>Upload file to Construction Space</h1>');
1.3       www       200:   
                    201:   if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
                    202:           $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom.
                    203:                '</font></h3>');
                    204:   }
                    205: 
1.1       www       206: 
                    207:   if ($ENV{'form.phase'} eq 'two') {
                    208:       &phasetwo($r,$fn,$uname,$udom);
                    209:   } else {
                    210:       &phaseone($r,$fn,$uname,$udom);
                    211:   }
                    212: 
                    213:   $r->print('</body></html>');
                    214:   return OK;  
                    215: }
1.7       www       216: 
                    217: 1;
                    218: __END__

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