File:  [LON-CAPA] / loncom / publisher / lonupload.pm
Revision 1.4: download - view: text, annotated - select for diffs
Fri May 25 17:03:58 2001 UTC (23 years ago) by www
Branches: MAIN
CVS tags: HEAD
Bug fix, illegal filenames

    1: # The LearningOnline Network with CAPA
    2: # Handler to upload files into construction space
    3: #
    4: # (Handler to retrieve an old version of a file
    5: #
    6: # (Publication Handler
    7: # 
    8: # (TeX Content Handler
    9: #
   10: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
   11: #
   12: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
   13: # 03/23 Guy Albertelli
   14: # 03/24,03/29 Gerd Kortemeyer)
   15: #
   16: # 03/31,04/03 Gerd Kortemeyer)
   17: #
   18: # 04/05,04/09,05/25 Gerd Kortemeyer
   19: 
   20: package Apache::lonupload;
   21: 
   22: use strict;
   23: use Apache::File;
   24: use File::Copy;
   25: use Apache::Constants qw(:common :http :methods);
   26: use Apache::loncacc;
   27: 
   28: sub upfile_store {
   29:     my $r=shift;
   30: 	
   31:     my $fname=$ENV{'form.upfile.filename'};
   32:     $fname=~s/\W//g;
   33:     
   34:     chop($ENV{'form.upfile'});
   35:   
   36:     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
   37: 		  '_upload_'.$fname.'_'.time.'_'.$$;
   38:     {
   39:        my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
   40:                                    '/tmp/'.$datatoken.'.tmp');
   41:        print $fh $ENV{'form.upfile'};
   42:     }
   43:     return $datatoken;
   44: }
   45: 
   46: 
   47: sub phaseone {
   48:     my ($r,$fn,$uname,$udom)=@_;
   49:     $fn=~s/\/[^\/]+$//;
   50:     $fn=~s/([^\/])$/$1\//;
   51:     $fn.=$ENV{'form.upfile.filename'};
   52:     $fn=~s/^\///;
   53:     $fn=~s/(\/)+/\//g;
   54: 
   55:     if (($fn) && ($fn!~/\/$/)) {
   56:       $r->print(
   57:  '<form action=/adm/upload method=post>'.
   58:  '<input type=hidden name=phase value=two>'.
   59:  '<input type=hidden name=datatoken value="'.&upfile_store.'">'.
   60:  'Store uploaded file as '.
   61:  '<input type=text size=50 name=filename value="/priv/'.
   62:   $uname.'/'.$fn.'"><br>'.
   63:  '<input type=submit value="Store"></form>');
   64:   } else {
   65:       $r->print('<font color=red>Illegal filename.</font>');
   66:   }
   67: }
   68: 
   69: sub phasetwo {
   70:    my ($r,$fn,$uname,$udom)=@_;
   71:    if ($fn=~/^\/priv\/$uname\//) { 
   72:     my $tfn=$fn;
   73:     $tfn=~s/^\/(\~|priv)\/(\w+)//;
   74:     my $target='/home/'.$uname.'/public_html'.$tfn;
   75:     my $datatoken=$ENV{'form.datatoken'};
   76:     if (($fn) && ($datatoken)) {
   77: 	if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) {
   78:            $r->print(
   79:  '<form action=/adm/upload method=post>'.
   80:  'File <tt>'.$fn.'</tt> exists. Overwrite? '.
   81:  '<input type=hidden name=phase value=two>'.
   82:  '<input type=hidden name=filename value="'.$fn.'">'.
   83:  '<input type=hidden name=datatoken value="'.$datatoken.'">'.
   84:  '<input type=submit name=override value="Yes"></form>');
   85:        } else {
   86:            my $source=$r->dir_config('lonDaemons').
   87: 	                             '/tmp/'.$datatoken.'.tmp';
   88:            if (copy($source,$target)) {
   89: 	      $r->print('File copied.');
   90:               $r->print('<p><font size=+2><a href="'.$fn.
   91:                         '">View file</a></font>');
   92: 	   } else {
   93:               $r->print('Failed to copy: '.$!);
   94: 	   }
   95:        }
   96:     } else {
   97:        $r->print(
   98:    '<font size=+1 color=red>Please pick a filename</font><p>');
   99:        &phaseone($r,$fn,$uname,$udom);
  100:     }
  101:   } else {
  102:     $r->print(
  103:    '<font size=+1 color=red>Please pick a filename</font><p>');
  104:     &phaseone($r,$fn,$uname,$udom);
  105:   }
  106: }
  107: 
  108: sub handler {
  109: 
  110:   my $r=shift;
  111: 
  112:   my $uname;
  113:   my $udom;
  114: 
  115:   unless (($uname,$udom)=
  116:     &Apache::loncacc::constructaccess(
  117:              $ENV{'form.filename'},$r->dir_config('lonDefDomain'))) {
  118:      $r->log_reason($uname.' at '.$udom.
  119:          ' trying to publish file '.$ENV{'form.filename'}.
  120:          ' - not authorized', 
  121:          $r->filename); 
  122:      return HTTP_NOT_ACCEPTABLE;
  123:   }
  124: 
  125:   my $fn;
  126: 
  127:   if ($ENV{'form.filename'}) {
  128:       $fn=$ENV{'form.filename'};
  129:       $fn=~s/^http\:\/\/[^\/]+\/(\~|priv\/)(\w+)//;
  130:   } else {
  131:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
  132:          ' unspecified filename for upload', $r->filename); 
  133:      return HTTP_NOT_FOUND;
  134:   }
  135: 
  136: # ----------------------------------------------------------- Start page output
  137: 
  138: 
  139:   $r->content_type('text/html');
  140:   $r->send_http_header;
  141: 
  142:   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
  143: 
  144:   $r->print(
  145:    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
  146: 
  147:   
  148:   $r->print('<h1>Upload file to Construction Space</h1>');
  149:   
  150:   if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
  151:           $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom.
  152:                '</font></h3>');
  153:   }
  154: 
  155: 
  156:   if ($ENV{'form.phase'} eq 'two') {
  157:       &phasetwo($r,$fn,$uname,$udom);
  158:   } else {
  159:       &phaseone($r,$fn,$uname,$udom);
  160:   }
  161: 
  162:   $r->print('</body></html>');
  163:   return OK;  
  164: }

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