--- loncom/publisher/loncfile.pm 2001/06/23 18:51:32 1.2 +++ loncom/publisher/loncfile.pm 2002/06/07 01:35:48 1.11 @@ -1,6 +1,40 @@ # 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.11 2002/06/07 01:35:48 albertel 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 @@ -13,9 +47,12 @@ # 03/23 Guy Albertelli # 03/24,03/29 Gerd Kortemeyer) # -# 03/31,04/03,05/02,05/09,06/23 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; @@ -24,135 +61,259 @@ use Apache::File; use File::Copy; use Apache::Constants qw(:common :http :methods); use Apache::loncacc; +use Apache::Log (); -sub phaseone { - my ($r,$fn,$uname,$udom)=@_; - my $docroot=$r->dir_config('lonDocRoot'); +my $DEBUG=0; +my $r; # Needs to be global for some stuff RF. +# +# 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); + } +} +# +# URLToPath +# Convert a URL to a file system path. +# +# In order to manipulate the construction space objects, it's necessary +# to access url identified objects a filespace objects. This function +# translates a construction space URL to a file system path. +# Parameters: +# Url - string [in] The url to convert. +# Returns: +# The corresponing file system path. +sub URLToPath +{ + my $Url = shift; + &Debug($r, "UrlToPath got: $Url"); + $Url=~ s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; + $Url=~ s/^http\:\/\/[^\/]+//; + &Debug($r, "Returning $Url \n"); + return $Url; +} +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.='

Warning: target file exists, and has been published!

'; + } elsif ( -e $construct ) { + $result.='

Warning: target file exists!

'; + } + return $result; +} - my $urldir='/res/'.$udom.'/'.$uname.$fn; - $urldir=~s/\/[^\/]+$/\//; +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.='

Warning: change of MIME type!

'; + } + return $result; +} - my $resfn=$docroot.'/res/'.$udom.'/'.$uname.$fn; - my $resdir=$resfn; - $resdir=~s/\/[^\/]+$/\//; +sub phaseone { + my ($r,$fn,$uname,$udom)=@_; - $fn=~/\/([^\/]+)\.(\w+)$/; - my $main=$1; - my $suffix=$2; + $fn=~m:(.*)/([^/]+)\.(\w+)$:; + my $dir=$1; + my $main=$2; + my $suffix=$3; + + my $conspace; + if ($fn =~ m-^/home/-) { + $conspace=$fn; + } else { + $conspace='/home/'.$uname.'/public_html'.$fn; + } - if (-e $resfn) { - $r->print('
'. + $r->print(''. ''. ''. - ''. - ''. - ''); - my $filename; - opendir(DIR,$resdir); - while ($filename=readdir(DIR)) { - if ($filename=~/^$main\.(\d+)\.$suffix$/) { - my $version=$1; - my ($rdev,$rino,$rmode,$rnlink, - $ruid,$rgid,$rrdev,$rsize, - $ratime,$rmtime,$rctime, - $rblksize,$rblocks)=stat($resdir.'/'.$filename); - $r->print(''); - } - } - closedir(DIR); - my ($rdev,$rino,$rmode,$rnlink, - $ruid,$rgid,$rrdev,$rsize, - $ratime,$rmtime,$rctime, - $rblksize,$rblocks)=stat($resfn); - $r->print(''. - '
SelectVersionBecame this version on ...Metadata
'.$version.''. - localtime($rmtime).''. - ''. - 'Metadata Version '.$version.''); - if (&Apache::lonnet::fileembstyle($suffix) eq 'ssi') { - $r->print( - '  Diffs with Version '.$version.''); - } - $r->print('
Current'.localtime($rmtime). - ''. - 'Metadata current version'); - if (&Apache::lonnet::fileembstyle($suffix) eq 'ssi') { - $r->print( - '  Diffs with current Version'); - } - $r->print('

'. - 'Retrieval of an old version will '. - 'overwrite the file currently in construction space

'. - '

'); -} else { - $r->print('

No previous versions published.

'); -} + ''); + + 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('

Rename '.$fn.' to '. + $dir.'/'.$ENV{'form.newfilename'}.'?

'); + } else { + $r->print('

No new filename specified.

'); + return; + } + } else { + $r->print('

No such file.

'); + return; + } + } elsif ($ENV{'form.action'} eq 'delete') { + if (-e $conspace) { + $r->print('

Delete '.$fn.'?

'); + } else { + $r->print('

No such file.

'); + 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('

Copy '.$fn.' to '. + $dir.'/'.$ENV{'form.newfilename'}.'?

'); + } else { + $r->print('

No new filename specified.

'); + return; + } + } else { + $r->print('

No such file.

'); + return; + } + } elsif ($ENV{'form.action'} eq 'newdir') { + my $newdir='/home/'.$uname.'/public_html/'. + $fn.$ENV{'form.newfilename'}; + if (-e $newdir) { + $r->print('

Directory exists.

'); + return; + } + $r->print('

Make new directory '. + $fn.$ENV{'form.newfilename'}.'?

'); + + } + $r->print('

'); + $r->print('

'); + } sub phasetwo { my ($r,$fn,$uname,$udom)=@_; - if ($ENV{'form.version'}) { - my $version=$ENV{'form.version'}; - if ($version eq 'new') { - $r->print('

Retrieving current (most recent) version

'); - } else { - $r->print('

Retrieving old version '.$version.'

'); - } - my $logfile; - my $ctarget='/home/'.$uname.'/public_html'.$fn; - my $vfn=$fn; - if ($version ne 'new') { - $vfn=~s/\.(\w+)$/\.$version\.$1/; - } - my $csource=$r->dir_config('lonDocRoot').'/res/'.$udom.'/'.$uname.$vfn; - unless ($logfile=Apache::File->new('>>'.$ctarget.'.log')) { - $r->print( - 'No write permission to user directory, FAIL'); - } - print $logfile -"\n\n================= Retrieve ".localtime()." ================\n". -"Version: $version\nSource: $csource\nTarget: $ctarget\n"; - $r->print('

Copying file: '); - if (copy($csource,$ctarget)) { - $r->print('ok

'); - print $logfile "Copied sucessfully.\n\n"; - } else { - my $error=$!; - $r->print('fail, '.$error.'

'); - print $logfile "Copy failed: $error\n\n"; + + &Debug($r, "loncfile - Entering phase 2 for $fn"); + + $fn=~/(.*)\/([^\/]+)\.(\w+)$/; + my $dir=$1; + my $main=$2; + my $suffix=$3; + $dir =~ s-^/[^/]*/[^/]*/[^/]*--; + + + &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($fn, + '/home/'.$uname.'/public_html'.$dir.'/'.$ENV{'form.newfilename'})) { + $r->print('Error: '.$!.''); + } + } + } else { + $r->print('

No such file.'); + return; } - $r->print('Back to '.$fn.''); - } else { - $r->print( - 'Please pick a version to retrieve

'); - &phaseone($r,$fn,$uname,$udom); + } elsif ($ENV{'form.action'} eq 'delete') { + if (-e $conspace) { + unless (unlink($fn)) { + $r->print('Error: '.$!.''); + } + } else { + $r->print('

No such file.'); + return; + } + } elsif ($ENV{'form.action'} eq 'copy') { + if (-e $conspace) { + if ($ENV{'form.newfilename'}) { + unless (copy($fn, + '/home/'.$uname.'/public_html'.$dir.'/'.$ENV{'form.newfilename'})) { + $r->print('Error: '.$!.''); + } + } else { + $r->print('

No new filename specified.'); + return; + } + } else { + $r->print('

No such file.'); + 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('Error: '.$!.''); + &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('

Done

'); + return; } + $r->print('

Done

'); } sub handler { - my $r=shift; + $r=shift; + + + &Debug($r, "loncfile.pm - handler entered"); my $fn; if ($ENV{'form.filename'}) { $fn=$ENV{'form.filename'}; - $fn=~s/^http\:\/\/[^\/]+//; + &Debug($r, "loncfile::handler - raw url: $fn"); +# $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; +# $fn=~s/^http\:\/\/[^\/]+//; + $fn=URLToPath($fn); + &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; @@ -164,15 +325,18 @@ sub handler { ($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 publish file '.$ENV{'form.filename'}. + ' 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; @@ -190,7 +354,10 @@ sub handler { ''); } + + &Debug($r, "loncfile::handler Form action is $ENV{'form.action'} "); if ($ENV{'form.action'} eq 'delete') { + $r->print('

Delete

'); } elsif ($ENV{'form.action'} eq 'rename') { $r->print('

Rename

'); @@ -203,9 +370,11 @@ sub handler { return OK; } if ($ENV{'form.phase'} eq 'two') { -# &phasetwo($r,$fn,$uname,$udom); + &Debug($r, "loncfile::handler entering phase2"); + &phasetwo($r,$fn,$uname,$udom); } else { -# &phaseone($r,$fn,$uname,$udom); + &Debug($r, "loncfile::handler entering phase1"); + &phaseone($r,$fn,$uname,$udom); } $r->print(''); @@ -214,3 +383,4 @@ sub handler { 1; __END__ +