loncom/publisher/loncfile.pm - view

File: [LON-CAPA] / loncom / publisher / loncfile.pm
Revision 1.9: download - view: text, annotated - select for diffs
Fri May 24 05:11:40 2002 UTC (22 years, 10 months ago) by foxr
Branches: MAIN
CVS tags: HEAD

(Bug 259).
Correct directory mapping in construction space:
- Generation of names for creational operations was wrong for internally
  authenticated users.
- Stage 2 Create directory: Done left us in a bad directory.

# The LearningOnline Network with CAPA # Handler to rename files, etc, in construction space # # This file responds to the various buttons and events # in the top frame of the construction space directory. # Each event is processed in two phases. The first phase # presents a page that describes the proposed action to the user # and requests confirmation. The second phase commits the action # and displays a page showing the results of the action. # # # $Id: loncfile.pm,v 1.9 2002/05/24 05:11:40 foxr Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # # (Handler to retrieve an old version of a file # # (Publication Handler # # (TeX Content Handler # # 05/29/00,05/30,10/11 Gerd Kortemeyer) # # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer # 03/23 Guy Albertelli # 03/24,03/29 Gerd Kortemeyer) # # 03/31,04/03,05/02,05/09,06/23,06/24 Gerd Kortemeyer) # # 06/23 Gerd Kortemeyer # 05/07/02 Ron Fox: # - Added Debug log output so that I can trace what the heck this # undocumented thingy does. package Apache::loncfile; use strict; use Apache::File; use File::Copy; use Apache::Constants qw(:common :http :methods); use Apache::loncacc; use Apache::Log (); my $DEBUG=1; # # Debug # If debugging is enabled puts out a debuggin message determined by the # caller. The debug message goes to the Apache error log file. # # Parameters: # r - Apache request [in] # message - String [in] # Returns: # nothing. sub Debug { my $r = shift; my $log = $r->log; my $message = shift; if ($DEBUG) { $log->debug($message); } } sub exists { my ($uname,$udom,$dir,$newfile)=@_; my $published='/home/httpd/html/res/'.$udom.'/'.$uname.'/'.$dir.'/'. $ENV{'form.newfilename'}; my $construct='/home/'.$uname.'/public_html/'.$dir.'/'. $ENV{'form.newfilename'}; my $result; if (-e $published) { $result.='<p><font color=red>Warning: target file exists, and has been published!</font></p>'; } elsif ( -e $construct ) { $result.='<p><font color=red>Warning: target file exists!</font></p>'; } return $result; } sub checksuffix { my ($old,$new) = @_; my $result; my $oldsuffix; my $newsuffix; if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; } if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; } if ($oldsuffix ne $newsuffix) { $result.='<p><font color=red>Warning: change of MIME type!</font></p>'; } return $result; } sub phaseone { my ($r,$fn,$uname,$udom)=@_; $fn=~m:(.*)/([^/]+)\.(\w+)$:; my $dir=$1; my $main=$2; my $suffix=$3; my $conspace='/home/'.$uname.'/public_html'.$fn; $r->print('<form action=/adm/cfile method=post>'. '<input type=hidden name=filename value="/~'.$uname.$fn.'">'. '<input type=hidden name=phase value=two>'. '<input type=hidden name=action value='.$ENV{'form.action'}.'>'); if ($ENV{'form.action'} eq 'rename') { if (-e $conspace) { if ($ENV{'form.newfilename'}) { $r->print(&checksuffix($fn,$ENV{'form.newfilename'})); $r->print(&exists($uname,$udom,$dir,$ENV{'form.newfilename'})); $r->print('<input type=hidden name=newfilename value="'. $ENV{'form.newfilename'}. '"><p>Rename <tt>'.$fn.'</tt> to <tt>'. $dir.'/'.$ENV{'form.newfilename'}.'</tt>?</p>'); } else { $r->print('<p>No new filename specified.</p></form>'); return; } } else { $r->print('<p>No such file.</p></form>'); return; } } elsif ($ENV{'form.action'} eq 'delete') { if (-e $conspace) { $r->print('<p>Delete <tt>'.$fn.'</tt>?</p>'); } else { $r->print('<p>No such file.</p></form>'); return; } } elsif ($ENV{'form.action'} eq 'copy') { if (-e $conspace) { if ($ENV{'form.newfilename'}) { $r->print(&checksuffix($fn,$ENV{'form.newfilename'})); $r->print(&exists($uname,$udom,$dir,$ENV{'form.newfilename'})); $r->print('<input type=hidden name=newfilename value="'. $ENV{'form.newfilename'}. '"><p>Copy <tt>'.$fn.'</tt> to <tt>'. $dir.'/'.$ENV{'form.newfilename'}.'</tt>?</p>'); } else { $r->print('<p>No new filename specified.</p></form>'); return; } } else { $r->print('<p>No such file.</p></form>'); return; } } elsif ($ENV{'form.action'} eq 'newdir') { my $newdir='/home/'.$uname.'/public_html/'. $fn.$ENV{'form.newfilename'}; if (-e $newdir) { $r->print('<p>Directory exists.</p></form>'); return; } $r->print('<input type=hidden name=newfilename value="'. $ENV{'form.newfilename'}. '"><p>Make new directory <tt>'. $fn.$ENV{'form.newfilename'}.'</tt>?</p>'); } $r->print('<p><input type=submit value=Continue></p></form>'); $r->print('<form action="/priv/'.$uname.$fn. '" method="GET"><p><input type=submit value=Cancel></p></form>'); } sub phasetwo { my ($r,$fn,$uname,$udom)=@_; &Debug($r, "loncfile - Entering phase 2 for $fn"); $fn=~/(.*)\/([^\/]+)\.(\w+)$/; my $dir=$1; my $main=$2; my $suffix=$3; &Debug($r, "loncfile::phase2 dir = $dir main = $main suffix = $suffix"); my $conspace=$fn; &Debug($r, "loncfile::phase2 Full construction space name: $conspace"); &Debug($r, "loncfie::phase2 action is $ENV{'form.action'}"); if ($ENV{'form.action'} eq 'rename') { if (-e $conspace) { if ($ENV{'form.newfilename'}) { unless (rename('/home/'.$uname.'/public_html'.$fn, '/home/'.$uname.'/public_html'.$dir.'/'.$ENV{'form.newfilename'})) { $r->print('<font color=red>Error: '.$!.'</font>'); } } } else { $r->print('<p>No such file.</form>'); return; } } elsif ($ENV{'form.action'} eq 'delete') { if (-e $conspace) { unless (unlink('/home/'.$uname.'/public_html'.$fn)) { $r->print('<font color=red>Error: '.$!.'</font>'); } } else { $r->print('<p>No such file.</form>'); return; } } elsif ($ENV{'form.action'} eq 'copy') { if (-e $conspace) { if ($ENV{'form.newfilename'}) { unless (copy('/home/'.$uname.'/public_html'.$fn, '/home/'.$uname.'/public_html'.$dir.'/'.$ENV{'form.newfilename'})) { $r->print('<font color=red>Error: '.$!.'</font>'); } } else { $r->print('<p>No new filename specified.</form>'); return; } } else { $r->print('<p>No such file.</form>'); return; } } elsif ($ENV{'form.action'} eq 'newdir') { my $newdir= $fn.$ENV{'form.newfilename'}; &Debug($r, "loncfile::phasetwo - new directory name: $newdir"); unless (mkdir($newdir,0770)) { $r->print('<font color=red>Error: '.$!.'</font>'); &Debug($r, "loncfile::phasetwo - mkdir failed $!"); } &Debug($r, "Done button: uname = $uname, dir = $dir, fn = $fn"); my $url = '/priv/'.$uname.$newdir.'/'; &Debug($r, "URL[1] = ".$url); $url =~ s/\/home\/$uname\/public_html//o; &Debug($r, "URL = ".$url); $r->print('<h3><a href="'.$url.'">Done</a></h3>'); return; } $r->print('<h3><a href="/priv/'.$uname.$dir.'/">Done</a></h3>'); } sub handler { my $r=shift; &Debug($r, "loncfile.pm - handler entered"); my $fn; if ($ENV{'form.filename'}) { $fn=$ENV{'form.filename'}; &Debug($r, "loncfile::handler - raw url: $fn"); $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; $fn=~s/^http\:\/\/[^\/]+//; &Debug($r, "loncfile::handler - doctored url: $fn"); } else { &Debug($r, "loncfile::handler - no form.filename"); $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. ' unspecified filename for cfile', $r->filename); return HTTP_NOT_FOUND; } unless ($fn) { &Debug($r, "loncfile::handler - doctored url is empty"); $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. ' trying to cfile non-existing file', $r->filename); return HTTP_NOT_FOUND; } # ----------------------------------------------------------- Start page output my $uname; my $udom; ($uname,$udom)= &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); &Debug($r, "loncfile::handler constructaccess uname = $uname domain = $udom"); unless (($uname) && ($udom)) { $r->log_reason($uname.' at '.$udom. ' trying to manipulate file '.$ENV{'form.filename'}. ' ('.$fn.') - not authorized', $r->filename); return HTTP_NOT_ACCEPTABLE; } $fn=~s/\/\~(\w+)//; &Debug($r, "loncfile::handler ~ removed filename: $fn"); $r->content_type('text/html'); $r->send_http_header; $r->print('<html><head><title>LON-CAPA Construction Space</title></head>'); $r->print( '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); $r->print('<h1>Construction Space <tt>'.$fn.'</tt></h1>'); if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom. '</font></h3>'); } &Debug($r, "loncfile::handler Form action is $ENV{'form.action'} "); if ($ENV{'form.action'} eq 'delete') { $r->print('<h3>Delete</h3>'); } elsif ($ENV{'form.action'} eq 'rename') { $r->print('<h3>Rename</h3>'); } elsif ($ENV{'form.action'} eq 'newdir') { $r->print('<h3>New Directory</h3>'); } elsif ($ENV{'form.action'} eq 'copy') { $r->print('<h3>Copy</h3>'); } else { $r->print('<p>Unknown Action</body></html>'); return OK; } if ($ENV{'form.phase'} eq 'two') { &Debug($r, "loncfile::handler entering phase2"); &phasetwo($r,$fn,$uname,$udom); } else { &Debug($r, "loncfile::handler entering phase1"); &phaseone($r,$fn,$uname,$udom); } $r->print('</body></html>'); return OK; } 1; __END__