Return to loncfile.pm CVS log

Up to [LON-CAPA] / loncom / publisher

 - GPL headers added

    1: # The LearningOnline Network with CAPA
    2: # Handler to rename files, etc, in construction space
    3: #
    4: # $Id: loncfile.pm,v 1.7 2001/12/04 15:34:57 albertel 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: #
   28: #
   29: # (Handler to retrieve an old version of a file
   30: #
   31: # (Publication Handler
   32: # 
   33: # (TeX Content Handler
   34: #
   35: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
   36: #
   37: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
   38: # 03/23 Guy Albertelli
   39: # 03/24,03/29 Gerd Kortemeyer)
   40: #
   41: # 03/31,04/03,05/02,05/09,06/23,06/24 Gerd Kortemeyer)
   42: #
   43: # 06/23 Gerd Kortemeyer
   44: 
   45: package Apache::loncfile;
   46: 
   47: use strict;
   48: use Apache::File;
   49: use File::Copy;
   50: use Apache::Constants qw(:common :http :methods);
   51: use Apache::loncacc;
   52: 
   53: sub phaseone {
   54:     my ($r,$fn,$uname,$udom)=@_;
   55: 
   56:     $fn=~/(.*)\/([^\/]+)\.(\w+)$/;
   57:     my $dir=$1;
   58:     my $main=$2;
   59:     my $suffix=$3;
   60: 
   61:     my $conspace='/home/'.$uname.'/public_html'.$fn;
   62: 
   63:     $r->print('<form action=/adm/cfile method=post>'.
   64: 	      '<input type=hidden name=filename value="/~'.$uname.$fn.'">'.
   65:               '<input type=hidden name=phase value=two>'.
   66:               '<input type=hidden name=action value='.$ENV{'form.action'}.'>');
   67:     if ($ENV{'form.action'} eq 'rename') {
   68: 	if (-e $conspace) {
   69: 	    if ($ENV{'form.newfilename'}) {
   70:                $ENV{'form.newfilename'}=~/(.*)\/([^\/]+)\.(\w+)$/;
   71:                if ($3 ne $suffix) {
   72: 		   $r->print(
   73:                     '<p><font color=red>Warning: change of MIME type!</font>');
   74:                }
   75:                if (-e 
   76:        	         '/home/httpd/'.$uname.'/'.$dir.'/'.$ENV{'form.newfilename'}) {
   77: 		   $r->print(
   78:                     '<p><font color=red>Warning: target file exists!</font>');
   79:                }
   80: 	       $r->print('<input type=hidden name=newfilename value="'.
   81:                          $ENV{'form.newfilename'}.
   82:                          '"><p>Rename <tt>'.$fn.'</tt> to <tt>'.
   83:                          $dir.'/'.$ENV{'form.newfilename'}.'</tt>?');
   84: 	    } else {
   85: 	       $r->print('<p>No new filename specified.</form>');
   86:                return;
   87: 	    }
   88:         } else {
   89: 	    $r->print('<p>No such file.</form>');
   90:             return;
   91:         }
   92:     } elsif ($ENV{'form.action'} eq 'delete') { 
   93: 	if (-e $conspace) {
   94:             $r->print('<p>Delete <tt>'.$fn.'</tt>?');
   95:         } else {
   96: 	    $r->print('<p>No such file.</form>');
   97:             return;
   98:         }
   99:     } elsif ($ENV{'form.action'} eq 'copy') { 
  100: 	if (-e $conspace) {
  101: 	    if ($ENV{'form.newfilename'}) {
  102:                $ENV{'form.newfilename'}=~/(.*)\/([^\/]+)\.(\w+)$/;
  103:                if ($3 ne $suffix) {
  104: 		   $r->print(
  105:                     '<p><font color=red>Warning: change of MIME type!</font>');
  106:                }
  107:                if (-e 
  108:        	         '/home/httpd/'.$uname.'/'.$dir.'/'.$ENV{'form.newfilename'}) {
  109: 		   $r->print(
  110:                     '<p><font color=red>Warning: target file exists!</font>');
  111:                }
  112: 	       $r->print('<input type=hidden name=newfilename value="'.
  113:                          $ENV{'form.newfilename'}.
  114:                          '"><p>Copy <tt>'.$fn.'</tt> to <tt>'.
  115:                          $dir.'/'.$ENV{'form.newfilename'}.'</tt>?');
  116: 	    } else {
  117: 	       $r->print('<p>No new filename specified.</form>');
  118:                return;
  119: 	    }
  120:         } else {
  121: 	    $r->print('<p>No such file.</form>');
  122:             return;
  123:         }
  124:     } elsif ($ENV{'form.action'} eq 'newdir') {
  125:         my $newdir='/home/'.$uname.'/public_html/'.
  126:                    $fn.$ENV{'form.newfilename'};
  127: 	if (-e $newdir) {
  128:             $r->print('<p>Directory exists.</form>');
  129:             return;
  130:         }
  131: 	$r->print('<input type=hidden name=newfilename value="'.
  132:                   $ENV{'form.newfilename'}.
  133:                   '"><p>Make new directory <tt>'.
  134:                   $fn.$ENV{'form.newfilename'}.'</tt>?');
  135:        
  136:     }
  137:     $r->print('<p><input type=submit value=Continue></form>'); 
  138: }
  139: 
  140: sub phasetwo {
  141:     my ($r,$fn,$uname,$udom)=@_;
  142: 
  143:     $fn=~/(.*)\/([^\/]+)\.(\w+)$/;
  144:     my $dir=$1;
  145:     my $main=$2;
  146:     my $suffix=$3;
  147: 
  148:     my $conspace='/home/'.$uname.'/public_html'.$fn;
  149: 
  150:     if ($ENV{'form.action'} eq 'rename') {
  151: 	if (-e $conspace) {
  152: 	    if ($ENV{'form.newfilename'}) {
  153:                unless (rename('/home/'.$uname.'/public_html'.$fn,
  154:           '/home/'.$uname.'/public_html'.$dir.'/'.$ENV{'form.newfilename'})) {
  155: 	    $r->print('<font color=red>Error: '.$!.'</font>');
  156:                }
  157:             }
  158:         } else {
  159: 	    $r->print('<p>No such file.</form>');
  160:             return;
  161:         }
  162:     } elsif ($ENV{'form.action'} eq 'delete') { 
  163: 	if (-e $conspace) {
  164:             unless (unlink('/home/'.$uname.'/public_html'.$fn)) {
  165: 	       $r->print('<font color=red>Error: '.$!.'</font>');
  166:             }
  167:         } else {
  168: 	    $r->print('<p>No such file.</form>');
  169:             return;
  170:         }
  171:     } elsif ($ENV{'form.action'} eq 'copy') { 
  172: 	if (-e $conspace) {
  173: 	    if ($ENV{'form.newfilename'}) {
  174:                unless (copy('/home/'.$uname.'/public_html'.$fn,
  175:            '/home/'.$uname.'/public_html'.$dir.'/'.$ENV{'form.newfilename'})) {
  176: 	          $r->print('<font color=red>Error: '.$!.'</font>');
  177:                }
  178: 	    } else {
  179: 	       $r->print('<p>No new filename specified.</form>');
  180:                return;
  181: 	    }
  182:         } else {
  183: 	    $r->print('<p>No such file.</form>');
  184:             return;
  185:         }
  186:     } elsif ($ENV{'form.action'} eq 'newdir') {
  187:         my $newdir='/home/'.$uname.'/public_html/'.
  188:                    $fn.$ENV{'form.newfilename'};
  189:         unless (mkdir($newdir,0770)) {
  190: 	    $r->print('<font color=red>Error: '.$!.'</font>');
  191:         }
  192:         $r->print('<h3><a href="/priv/'.$uname.$fn.'/">Done</a></h3>');
  193:         return;
  194:     }
  195:     $r->print('<h3><a href="/priv/'.$uname.$dir.'/">Done</a></h3>');
  196: }
  197: 
  198: sub handler {
  199: 
  200:   my $r=shift;
  201: 
  202:   my $fn;
  203: 
  204:   if ($ENV{'form.filename'}) {
  205:       $fn=$ENV{'form.filename'};
  206:       $fn=~s/^http\:\/\/[^\/]+//;
  207:   } else {
  208:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
  209:          ' unspecified filename for cfile', $r->filename); 
  210:      return HTTP_NOT_FOUND;
  211:   }
  212: 
  213:   unless ($fn) { 
  214:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
  215:          ' trying to cfile non-existing file', $r->filename); 
  216:      return HTTP_NOT_FOUND;
  217:   } 
  218: 
  219: # ----------------------------------------------------------- Start page output
  220:   my $uname;
  221:   my $udom;
  222: 
  223:   ($uname,$udom)=
  224:     &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
  225:   unless (($uname) && ($udom)) {
  226:      $r->log_reason($uname.' at '.$udom.
  227:          ' trying to manipulate file '.$ENV{'form.filename'}.
  228:          ' ('.$fn.') - not authorized', 
  229:          $r->filename); 
  230:      return HTTP_NOT_ACCEPTABLE;
  231:   }
  232: 
  233:   $fn=~s/\/\~(\w+)//;
  234: 
  235:   $r->content_type('text/html');
  236:   $r->send_http_header;
  237: 
  238:   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
  239: 
  240:   $r->print(
  241:    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
  242: 
  243:   
  244:   $r->print('<h1>Construction Space <tt>'.$fn.'</tt></h1>');
  245:   
  246:   if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
  247:           $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom.
  248:                '</font></h3>');
  249:   }
  250: 
  251:   if ($ENV{'form.action'} eq 'delete') {
  252:       $r->print('<h3>Delete</h3>');
  253:   } elsif ($ENV{'form.action'} eq 'rename') {
  254:       $r->print('<h3>Rename</h3>');
  255:   } elsif ($ENV{'form.action'} eq 'newdir') {
  256:       $r->print('<h3>New Directory</h3>');
  257:   } elsif ($ENV{'form.action'} eq 'copy') {
  258:       $r->print('<h3>Copy</h3>');
  259:   } else {
  260:      $r->print('<p>Unknown Action</body></html>');
  261:      return OK;  
  262:   }
  263:   if ($ENV{'form.phase'} eq 'two') {
  264:       &phasetwo($r,$fn,$uname,$udom);
  265:   } else {
  266:       &phaseone($r,$fn,$uname,$udom);
  267:   }
  268: 
  269:   $r->print('</body></html>');
  270:   return OK;  
  271: }
  272: 
  273: 1;
  274: __END__