Return to lonupload.pm CVS log

Up to [LON-CAPA] / loncom / publisher

More actions in construction space

    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,06/23 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:    if ($ENV{'form.upfile.filename'}) {
   50:     $fn=~s/\/[^\/]+$//;
   51:     $fn=~s/([^\/])$/$1\//;
   52:     $fn.=$ENV{'form.upfile.filename'};
   53:     $fn=~s/^\///;
   54:     $fn=~s/(\/)+/\//g;
   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:  } else {
   68:      $r->print('<font color=red>No upload file specified.</font>');
   69:  }
   70: }
   71: 
   72: sub phasetwo {
   73:    my ($r,$fn,$uname,$udom)=@_;
   74:    if ($fn=~/^\/priv\/$uname\//) { 
   75:     my $tfn=$fn;
   76:     $tfn=~s/^\/(\~|priv)\/(\w+)//;
   77:     my $target='/home/'.$uname.'/public_html'.$tfn;
   78:     my $datatoken=$ENV{'form.datatoken'};
   79:     if (($fn) && ($datatoken)) {
   80: 	if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) {
   81:            $r->print(
   82:  '<form action=/adm/upload method=post>'.
   83:  'File <tt>'.$fn.'</tt> exists. Overwrite? '.
   84:  '<input type=hidden name=phase value=two>'.
   85:  '<input type=hidden name=filename value="'.$fn.'">'.
   86:  '<input type=hidden name=datatoken value="'.$datatoken.'">'.
   87:  '<input type=submit name=override value="Yes"></form>');
   88:        } else {
   89:            my $source=$r->dir_config('lonDaemons').
   90: 	                             '/tmp/'.$datatoken.'.tmp';
   91:            if (copy($source,$target)) {
   92: 	      $r->print('File copied.');
   93:               $r->print('<p><font size=+2><a href="'.$fn.
   94:                         '">View file</a></font>');
   95: 	   } else {
   96:               $r->print('Failed to copy: '.$!);
   97: 	   }
   98:        }
   99:     } else {
  100:        $r->print(
  101:    '<font size=+1 color=red>Please pick a filename</font><p>');
  102:        &phaseone($r,$fn,$uname,$udom);
  103:     }
  104:   } else {
  105:     $r->print(
  106:    '<font size=+1 color=red>Please pick a filename</font><p>');
  107:     &phaseone($r,$fn,$uname,$udom);
  108:   }
  109: }
  110: 
  111: sub handler {
  112: 
  113:   my $r=shift;
  114: 
  115:   my $uname;
  116:   my $udom;
  117: 
  118:   ($uname,$udom)=
  119:     &Apache::loncacc::constructaccess(
  120: 			 $ENV{'form.filename'},$r->dir_config('lonDefDomain'));
  121:   unless (($uname) && ($udom)) {
  122:      $r->log_reason($uname.' at '.$udom.
  123:          ' trying to publish file '.$ENV{'form.filename'}.
  124:          ' - not authorized', 
  125:          $r->filename); 
  126:      return HTTP_NOT_ACCEPTABLE;
  127:   }
  128: 
  129:   my $fn;
  130: 
  131:   if ($ENV{'form.filename'}) {
  132:       $fn=$ENV{'form.filename'};
  133:       $fn=~s/^http\:\/\/[^\/]+\/(\~|priv\/)(\w+)//;
  134:   } else {
  135:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
  136:          ' unspecified filename for upload', $r->filename); 
  137:      return HTTP_NOT_FOUND;
  138:   }
  139: 
  140: # ----------------------------------------------------------- Start page output
  141: 
  142: 
  143:   $r->content_type('text/html');
  144:   $r->send_http_header;
  145: 
  146:   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
  147: 
  148:   $r->print(
  149:    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
  150: 
  151:   
  152:   $r->print('<h1>Upload file to Construction Space</h1>');
  153:   
  154:   if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
  155:           $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom.
  156:                '</font></h3>');
  157:   }
  158: 
  159: 
  160:   if ($ENV{'form.phase'} eq 'two') {
  161:       &phasetwo($r,$fn,$uname,$udom);
  162:   } else {
  163:       &phaseone($r,$fn,$uname,$udom);
  164:   }
  165: 
  166:   $r->print('</body></html>');
  167:   return OK;  
  168: }