Annotation of loncom/publisher/loncfile.pm, revision 1.82

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to rename files, etc, in construction space
                      3: #
1.9       foxr        4: #  This file responds to the various buttons and events
                      5: #  in the top frame of the construction space directory.
                      6: #  Each event is processed in two phases.  The first phase
                      7: #  presents a page that describes the proposed action to the user
                      8: #  and requests confirmation.  The second phase commits the action
                      9: #  and displays a page showing the results of the action.
                     10: #
1.24      albertel   11: #
1.82    ! albertel   12: # $Id: loncfile.pm,v 1.81 2007/03/30 20:37:31 albertel Exp $
1.7       albertel   13: #
                     14: # Copyright Michigan State University Board of Trustees
                     15: #
                     16: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                     17: #
                     18: # LON-CAPA is free software; you can redistribute it and/or modify
                     19: # it under the terms of the GNU General Public License as published by
                     20: # the Free Software Foundation; either version 2 of the License, or
                     21: # (at your option) any later version.
                     22: #
                     23: # LON-CAPA is distributed in the hope that it will be useful,
                     24: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     25: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     26: # GNU General Public License for more details.
                     27: #
                     28: # You should have received a copy of the GNU General Public License
                     29: # along with LON-CAPA; if not, write to the Free Software
                     30: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     31: #
                     32: # /home/httpd/html/adm/gpl.txt
                     33: #
                     34: # http://www.lon-capa.org/
                     35: #
1.12      foxr       36: =pod
                     37: 
                     38: =head1 NAME
                     39: 
                     40: Apache::loncfile - Construction space file management.
                     41: 
                     42: =head1 SYNOPSIS
                     43:  
                     44:  Content handler for buttons on the top frame of the construction space 
                     45: directory.
                     46: 
                     47: =head1 INTRODUCTION
                     48: 
                     49:   loncfile is invoked when buttons in the top frame of the construction 
1.17      harris41   50: space directory listing are clicked.   All operations proceed in two phases.
1.12      foxr       51: The first phase describes to the user exactly what will be done.  If the user
                     52: confirms the operation, the second phase commits the operation and indicates
                     53: completion.  When the user dismisses the output of phase2, they are returned to
                     54: an "appropriate" directory listing in general.
                     55: 
                     56:     This is part of the LearningOnline Network with CAPA project
                     57: described at http://www.lon-capa.org.
                     58: 
                     59: =head2 Subroutines
                     60: 
                     61: =cut
1.1       www        62: 
                     63: package Apache::loncfile;
                     64: 
                     65: use strict;
                     66: use Apache::File;
1.15      foxr       67: use File::Basename;
1.1       www        68: use File::Copy;
1.18      foxr       69: use HTML::Entities();
1.1       www        70: use Apache::Constants qw(:common :http :methods);
                     71: use Apache::loncacc;
1.15      foxr       72: use Apache::lonnet;
1.33      www        73: use Apache::loncommon();
1.47      sakharuk   74: use Apache::lonlocal;
1.80      albertel   75: use LONCAPA qw(:DEFAULT :match);
                     76: 
1.9       foxr       77: 
1.45      taceyjo1   78: my $DEBUG=0;
1.10      foxr       79: my $r;				# Needs to be global for some stuff RF.
1.12      foxr       80: 
                     81: =pod
                     82: 
                     83: =item Debug($request, $message)
                     84: 
1.17      harris41   85:   If debugging is enabled puts out a debugging message determined by the
1.12      foxr       86:   caller.  The debug message goes to the Apache error log file. Debugging
1.17      harris41   87:   is enabled by setting the module global DEBUG variable to nonzero (TRUE).
1.12      foxr       88: 
                     89:  Parameters:
                     90: 
                     91: =over 4
                     92:  
1.17      harris41   93: =item $request - The current request operation.
1.12      foxr       94: 
1.17      harris41   95: =item $message - The message to put in the log file.
1.12      foxr       96: 
                     97: =back
                     98:   
                     99:  Returns:
                    100:    nothing.
                    101: 
                    102: =cut
                    103: 
1.9       foxr      104: sub Debug {
1.55      albertel  105:     # Put out the indicated message butonly if DEBUG is true.
                    106:     if ($DEBUG) {
1.73      albertel  107: 	my ($r,$message) = @_;
1.55      albertel  108: 	$r->log_reason($message);
                    109:     }
1.12      foxr      110: }
                    111: 
                    112: =pod
                    113: 
                    114: =item URLToPath($url)
                    115: 
                    116:   Convert a URL to a file system path.
                    117:   
                    118:   In order to manipulate the construction space objects, it is necessary
                    119:   to access url identified objects a filespace objects.  This function
                    120:   translates a construction space URL to a file system path.
                    121:  Parameters:
                    122: 
                    123: =over 4
                    124: 
                    125: =item  Url    - string [in] The url to convert.
                    126:   
                    127: =back
                    128:   
                    129:  Returns:
                    130: 
                    131: =over 4
                    132: 
1.16      harris41  133: =item  The corresponding file system path. 
1.12      foxr      134: 
                    135: =back
                    136: 
                    137: Global References
                    138: 
                    139: =over 4
                    140: 
                    141: =item  $r      - Request object [in] Referenced in the &Debug calls.
                    142: 
                    143: =back
                    144: 
                    145: =cut
                    146: 
                    147: sub URLToPath {
1.55      albertel  148:     my $Url = shift;
                    149:     &Debug($r, "UrlToPath got: $Url");
                    150:     $Url=~ s/\/+/\//g;
                    151:     $Url=~ s/^http\:\/\/[^\/]+//;
                    152:     $Url=~ s/^\///;
1.80      albertel  153:     $Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//;
1.55      albertel  154:     &Debug($r, "Returning $Url \n");
                    155:     return $Url;
1.12      foxr      156: }
                    157: 
1.36      www       158: sub url {
                    159:     my $fn=shift;
1.80      albertel  160:     $fn=~s/^\/home\/($match_username)\/public\_html/\/priv\/$1/;
1.56      albertel  161:     $fn=&HTML::Entities::encode($fn,'<>"&');
1.36      www       162:     return $fn;
                    163: }
                    164: 
                    165: sub display {
                    166:     my $fn=shift;
1.80      albertel  167:     $fn=~s-^/home/($match_username)/public_html-/priv/$1-;
1.36      www       168:     return '<tt>'.$fn.'</tt>';
                    169: }
                    170: 
1.50      www       171: 
                    172: # see if the file is
                    173: # a) published (return 0 if not)
                    174: # b) if, so obsolete (return 0 if not)
                    175: 
                    176: sub obsolete_unpub {
                    177:     my ($user,$domain,$construct)=@_;
                    178:     my $published=$construct;
                    179:     $published=~
                    180: 	s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;
                    181:     if (-e $published) {
                    182: 	if (&Apache::lonnet::metadata($published,'obsolete')) {
                    183: 	    return 1;
                    184: 	}
                    185: 	return 0;
                    186:     } else {
                    187: 	return 1;
                    188:     }
                    189: }
                    190: 
1.70      raeburn   191: # see if directory is empty
1.74      www       192: # ignores any .meta, .save, .bak, and .log files created for a previously
1.70      raeburn   193: # published file, which has since been marked obsolete and deleted.
                    194: sub empty_directory {
                    195:     my ($dirname,$phase) = @_;
                    196:     if (opendir DIR, $dirname) {
                    197:         my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and ..
                    198:         if (@files) { 
1.74      www       199:             my @orphans = grep(/\.(meta|save|log|bak)$/,@files);
1.70      raeburn   200:             if (scalar(@files) - scalar(@orphans) > 0) { 
                    201:                 return 0;
                    202:             } else {
                    203:                 if (($phase eq 'Delete2') && (@orphans > 0)) {
                    204:                     foreach my $file (@orphans) {
1.74      www       205:                         if ($file =~ /\.(meta|save|log|bak)$/) {
1.70      raeburn   206:                             unlink($dirname.$file);
                    207:                         }
                    208:                     }
                    209:                 }
                    210:             }
                    211:         }
                    212:         closedir(DIR);
                    213:         return 1;
                    214:     }
                    215:     return 0;
                    216: }
1.50      www       217: 
1.12      foxr      218: =pod
                    219: 
1.39      www       220: =item exists($user, $domain, $file)
1.12      foxr      221: 
1.17      harris41  222:    Determine if a resource file name has been published or exists
1.12      foxr      223:    in the construction space.
                    224: 
                    225:  Parameters:
                    226: 
                    227: =over 4
                    228: 
                    229: =item  $user   - string [in] - Name of the user for which to check.
                    230: 
                    231: =item  $domain - string [in] - Name of the domain in which the resource
                    232:                           might have been published.
                    233: 
                    234: =item  $file   - string [in] - Name of the file.
                    235: 
                    236: =back
                    237: 
                    238: Returns:
                    239: 
                    240: =over 4
                    241: 
                    242: =item  string - Either where the resource exists as an html string that can
                    243:            be embedded in a dialog or an empty string if the resource
                    244:            does not exist.
                    245:   
                    246: =back
                    247: 
                    248: =cut
                    249: 
1.8       albertel  250: sub exists {
1.55      albertel  251:     my ($user, $domain, $construct) = @_;
                    252:     my $published=$construct;
                    253:     $published=~
                    254: 	s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;
                    255:     my $result='';    
                    256:     if ( -d $construct ) {
                    257: 	return &mt('Error: destination for operation is an existing directory.');
                    258:     }
                    259:     if ( -e $published) {
                    260: 	$result.='<p><font color="red">'.&mt('Warning: target file exists, and has been published!').'</font></p>';
                    261:     } elsif ( -e $construct) {
                    262: 	$result.='<p><font color="red">'.&mt('Warning: target file exists!').'</font></p>';
                    263:     }
                    264:     return $result;
1.8       albertel  265: }
                    266: 
1.12      foxr      267: =pod
                    268: 
                    269: =item checksuffix($old, $new)
                    270:         
                    271:   Determine if a resource filename suffix (the stuff after the .) would change
                    272: as a result of this operation.
                    273: 
                    274:  Parameters:
                    275: 
                    276: =over 4
                    277: 
                    278: =item  $old   = string [in]  Previous filename.
                    279: 
                    280: =item  $new   = string [in]  Resultant filename.
                    281: 
                    282: =back
                    283: 
                    284:  Returns:
                    285: 
                    286: =over 4
                    287: 
1.17      harris41  288: =item    Empty string if everything worked.
1.12      foxr      289: 
                    290: =item    String containing an error message if there was a problem.
                    291: 
                    292: =back
                    293: 
                    294: =cut
                    295: 
1.8       albertel  296: sub checksuffix {
                    297:     my ($old,$new) = @_;
                    298:     my $result;
                    299:     my $oldsuffix;
                    300:     my $newsuffix;
                    301:     if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }
                    302:     if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
1.82    ! albertel  303:     if (lc($oldsuffix) ne lc($newsuffix)) {
1.12      foxr      304: 	$result.=
1.82    ! albertel  305:             '<p><span class="LC_warning">'.&mt('Warning: change of MIME type!').'</span></p>';
1.8       albertel  306:     }
                    307:     return $result;
                    308: }
1.32      albertel  309: 
                    310: sub cleanDest {
1.64      albertel  311:     my ($request,$dest,$subdir,$fn,$uname)=@_;
1.32      albertel  312:     #remove bad characters
1.58      albertel  313:     my $foundbad=0;
                    314:     if ($subdir && $dest =~/\./) {
                    315: 	$foundbad=1;
                    316: 	$dest=~s/\.//g;
                    317:     }
1.72      albertel  318:     if  ($dest=~/[\#\?&%\":]/) {
1.58      albertel  319: 	$foundbad=1;
1.72      albertel  320: 	$dest=~s/[\#\?&%\":]//g;
1.58      albertel  321:     }
1.63      albertel  322:     if ($dest=~m|/|) {
                    323: 	my ($newpath)=($dest=~m|(.*)/|);
1.64      albertel  324: 	$newpath=&relativeDest($fn,$newpath,$uname);
                    325: 	if (! -d "$newpath") {
                    326: 	    $request->print("<p><font color=\"red\">".&mt('You have requested to create file in directory [_1] which doesn\'t exist. The requested directory path has been removed from the requested file name.','"<tt>'.$newpath.'</tt>"')."</font></p>");
1.63      albertel  327: 	    $dest=~s|.*/||;
                    328: 	}
                    329:     }
1.58      albertel  330:     if ($foundbad) {
1.47      sakharuk  331: 	$request->print("<p><font color=\"red\">".&mt('Invalid characters in requested name have been removed.')."</font></p>");
1.32      albertel  332:     }
                    333:     return $dest;
                    334: }
                    335: 
1.36      www       336: sub relativeDest {
                    337:     my ($fn,$newfilename,$uname)=@_;
                    338:     if ($newfilename=~/^\//) {
                    339: # absolute, simply add path
                    340: 	$newfilename='/home/'.$uname.'/public_html/';
                    341:     } else {
                    342: 	my $dir=$fn;
                    343: 	$dir=~s/\/[^\/]+$//;
                    344: 	$newfilename=$dir.'/'.$newfilename;
                    345:     }
                    346:     $newfilename=~s://+:/:g; # remove duplicate /
                    347:     while ($newfilename=~m:/\.\./:) {
                    348: 	$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
                    349:     }
                    350:     return $newfilename;
                    351: }
                    352: 
1.12      foxr      353: =pod
                    354: 
                    355: =item CloseForm1($request, $user, $file)
                    356: 
                    357:    Close of a form on the successful completion of phase 1 processing
                    358: 
                    359: Parameters:
                    360: 
                    361: =over 4
                    362: 
                    363: =item  $request - Apache Request Object [in] - Apache server request object.
                    364: 
1.13      foxr      365: =item  $cancelurl - the url to go to on cancel.
1.12      foxr      366: 
                    367: =back
                    368: 
                    369: =cut
                    370: 
                    371: sub CloseForm1 {
1.55      albertel  372:     my ($request,  $fn) = @_;
                    373:     $request->print('<p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
                    374:     $request->print('<form action="'.&url($fn).
                    375: 		    '" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
1.12      foxr      376: }
                    377: 
                    378: 
                    379: =pod
                    380: 
                    381: =item CloseForm2($request, $user, $directory)
                    382: 
                    383:    Successfully close off the phase 2 form.
                    384: 
                    385: Parameters:
                    386: 
                    387: =over 4
                    388: 
                    389: =item   $request    - Apache Request object [in] - The request that is being
                    390:                  executed.
                    391: 
                    392: =item   $user       - string [in] - Name of the user that is initiating the
                    393:                  request.
                    394: 
                    395: =item   $directory  - string [in] - Directory in which the operation is 
                    396:                  being done relative to the top level construction space
                    397:                  directory.
                    398: 
                    399: =back
                    400: 
                    401: =cut
                    402: 
                    403: sub CloseForm2 {
1.55      albertel  404:     my ($request, $user, $fn) = @_;
                    405:     $request->print('<h3><a href="'.&url($fn).'/">'.&mt('Done').'</a></h3>');
1.12      foxr      406: }
                    407: 
                    408: =pod
                    409: 
                    410: =item Rename1($request, $filename, $user, $domain, $dir)
                    411:  
                    412:    Perform phase 1 processing of the file rename operation.
                    413: 
                    414: Parameters:
                    415: 
                    416: =over 4
                    417: 
                    418: =item  $request   - Apache Request Object [in] The request object for the 
                    419: current request.
                    420: 
                    421: =item  $filename  - The filename relative to construction space.
                    422: 
                    423: =item  $user      - Name of the user making the request.
                    424: 
                    425: =item  $domain    - User login domain.
                    426: 
                    427: =item  $dir       - Directory specification of the path to the file.
                    428: 
                    429: =back
                    430: 
                    431: Side effects:
                    432: 
                    433: =over 4
                    434: 
                    435: =item A new form is displayed prompting for confirmation.  The newfilename
                    436: hidden field of this form is loaded with
                    437: new filename relative to the current directory ($dir).
                    438: 
                    439: =back
                    440: 
                    441: =cut  
                    442: 
                    443: sub Rename1 {
1.52      albertel  444:     my ($request, $user, $domain, $fn, $newfilename, $style) = @_;
1.36      www       445: 
                    446:     if(-e $fn) {
                    447: 	if($newfilename) {
1.42      albertel  448: 	    # is dest a dir
1.52      albertel  449: 	    if ($style eq 'move') {
                    450: 		if (-d $newfilename) {
                    451: 		    if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; }
                    452: 		}
1.42      albertel  453: 	    }
1.29      albertel  454: 	    if ($newfilename =~ m|/[^\.]+$|) {
1.36      www       455: 		#no extension add on original extension
                    456: 		if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {
1.24      albertel  457: 		    $newfilename.='.'.$1;
                    458: 		}
                    459: 	    }
1.36      www       460: 	    $request->print(&checksuffix($fn, $newfilename));
1.27      albertel  461: 	    #renaming a dir, delete the trailing /
1.39      www       462:             #remove second to last element for current dir
                    463: 	    if (-d $fn) {
1.53      www       464: 		$newfilename=~/\.(\w+)$/;
                    465: 		if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {
1.82    ! albertel  466: 		    $request->print('<br /><span classr="LC_warning">'.
1.55      albertel  467: 				    &mt('Cannot change MIME type of a directory').
1.82    ! albertel  468: 				    '</span>'.
1.55      albertel  469: 				    '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
1.53      www       470: 		    return;
                    471: 		}
1.39      www       472: 		$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;
1.27      albertel  473: 	    }
1.42      albertel  474: 	    $newfilename=~s://+:/:g; # remove duplicate /
                    475: 	    while ($newfilename=~m:/\.\./:) {
                    476: 		$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
                    477: 	    }
1.39      www       478: 	    my $return=&exists($user, $domain, $newfilename);
1.21      albertel  479: 	    $request->print($return);
                    480: 	    if ($return =~/^Error:/) {
1.47      sakharuk  481: 		$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
1.21      albertel  482: 		return;
                    483: 	    }
1.50      www       484: 	    unless (&obsolete_unpub($user,$domain,$fn)) {
                    485: 		$request->print('<h3>'.&mt('Cannot rename or move non-obsolete published file').'</h3>'.
                    486: 				'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
                    487: 		return;
                    488: 	    }
1.52      albertel  489: 	    my $action;
                    490: 	    if ($style eq 'rename') {
                    491: 		$action=&mt('Rename');
                    492: 	    } else {
                    493: 		$action=&mt('Move');
                    494: 	    }
1.23      albertel  495: 	    $request->print('<input type="hidden" name="newfilename" value="'.
1.12      foxr      496: 			    $newfilename.
1.52      albertel  497: 			    '" /><p>'.$action.' '.&display($fn).
1.36      www       498: 			    '</tt><br />to '.&display($newfilename).'?</p>');
                    499: 	    &CloseForm1($request, $fn);
1.12      foxr      500: 	} else {
1.47      sakharuk  501: 	    $request->print('<p>'.&mt('No new filename specified.').'</p></form>');
1.12      foxr      502: 	    return;
                    503: 	}
                    504:     } else {
1.47      sakharuk  505: 	$request->print('<p> '.&mt('No such file').': '.&display($fn).'</p></form>');
1.12      foxr      506: 	return;
                    507:     }
                    508:     
                    509: }
1.55      albertel  510: 
1.12      foxr      511: =pod
                    512: 
                    513: =item Delete1
                    514: 
                    515:    Performs phase 1 processing of the delete operation.  In phase one
                    516:   we just check to be sure the file exists.
                    517: 
                    518: Parameters:
                    519: 
                    520: =over 4
                    521: 
1.36      www       522: =item   $request   - Apache Request Object [in] request object for the current 
1.12      foxr      523:                 request.
                    524: 
1.36      www       525: =item   $user      - string [in]  Name of the user initiating the request.
1.12      foxr      526: 
1.36      www       527: =item   $domain    - string [in]  Domain the initiating user is logged in as
1.13      foxr      528: 
1.36      www       529: =item   $filename  - string [in]  Source filename.
1.12      foxr      530: 
                    531: =back
                    532: 
                    533: =cut
                    534: 
                    535: sub Delete1 {
1.55      albertel  536:     my ($request, $user, $domain, $fn) = @_;
1.12      foxr      537: 
1.55      albertel  538:     if( -e $fn) {
                    539: 	$request->print('<input type="hidden" name="newfilename" value="'.
                    540: 			$fn.'"/>');
1.70      raeburn   541:         if (-d $fn) {
                    542:             unless (&empty_directory($fn,'Delete1')) {
                    543:                 $request->print('<h3>'.&mt('Only empty directories may be deleted.').'</h3>'.
                    544:                             'You must delete the contents of the directory first.<br />'.
                    545:                             '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
                    546:                 return;
                    547:             }
                    548:         } else { 
                    549: 	    unless (&obsolete_unpub($user,$domain,$fn)) {
                    550: 	        $request->print('<h3>'.&mt('Cannot delete non-obsolete published file').'</h3>'.
1.55      albertel  551: 			    '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
1.70      raeburn   552: 	        return;
                    553: 	    }
                    554:         }
1.55      albertel  555: 	$request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>');
                    556: 	&CloseForm1($request, $fn);
                    557:     } else {
                    558: 	$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
1.50      www       559:     }
1.12      foxr      560: }
                    561: 
                    562: =pod
                    563: 
                    564: =item Copy1($request, $user, $domain, $filename, $newfilename)
                    565: 
                    566:    Performs phase 1 processing of the construction space copy command.
1.17      harris41  567:    Ensure that the source file exists.  Ensure that a destination exists,
                    568:    also warn if the destination already exists.
1.12      foxr      569: 
                    570: Parameters:
                    571: 
                    572: =over 4
                    573: 
                    574: =item   $request   - Apache Request Object [in] request object for the current 
                    575:                 request.
                    576: 
                    577: =item   $user      - string [in]  Name of the user initiating the request.
                    578: 
                    579: =item   $domain    - string [in]  Domain the initiating user is logged in as
                    580: 
1.36      www       581: =item   $fn  - string [in]  Source filename.
1.12      foxr      582: 
                    583: =item   $newfilename-string [in]  Destination filename.
                    584: 
                    585: =back
                    586: 
                    587: =cut
                    588: 
                    589: sub Copy1 {
1.42      albertel  590:     my ($request, $user, $domain, $fn, $newfilename) = @_;
1.12      foxr      591: 
1.42      albertel  592:     if(-e $fn) {
                    593: 	# is dest a dir
                    594: 	if (-d $newfilename) {
                    595: 	    if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; }
                    596: 	}
                    597: 	if ($newfilename =~ m|/[^\.]+$|) {
                    598: 	    #no extension add on original extension
                    599: 	    if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {	$newfilename.='.'.$1; }
                    600: 	} 
                    601: 	$newfilename=~s://+:/:g; # remove duplicate /
                    602: 	while ($newfilename=~m:/\.\./:) {
                    603: 	    $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
                    604: 	}
                    605: 	$request->print(&checksuffix($fn,$newfilename));
                    606: 	my $return=&exists($user, $domain, $newfilename);
                    607: 	$request->print($return);
                    608: 	if ($return =~/^Error:/) {
1.47      sakharuk  609: 	    $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
1.42      albertel  610: 	    return;
                    611: 	}
                    612: 	$request->print('<input type="hidden" name="newfilename" value="'.
                    613: 			$newfilename.
1.47      sakharuk  614: 			'" /><p>'.&mt('Copy').' '.&display($fn).'<br />to '.
1.42      albertel  615: 			&display($newfilename).'?</p>');
                    616: 	&CloseForm1($request, $fn);
                    617:     } else {
1.47      sakharuk  618: 	$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
1.21      albertel  619:     }
1.19      albertel  620: }
                    621: 
                    622: =pod
                    623: 
1.12      foxr      624: =item NewDir1
                    625:  
                    626:   Does all phase 1 processing of directory creation:
                    627:   Ensures that the user provides a new directory name,
                    628:   and that the directory does not already exist.
                    629: 
                    630: Parameters:
                    631: 
                    632: =over 4
                    633: 
                    634: =item   $request  - Apache Request Object [in] - Server request object for the
1.17      harris41  635:                current url.
1.12      foxr      636: 
                    637: =item   $username - Name of the user that is requesting the directory creation.
                    638: 
1.36      www       639: =item $domain - Domain user is in
                    640: 
                    641: =item   $fn     - source file.
1.12      foxr      642: 
                    643: =item   $newdir   - Name of the directory to be created; path relative to the 
                    644:                top level of construction space.
                    645: =back
                    646: 
                    647: Side Effects:
                    648: 
                    649: =over 4
                    650: 
                    651: =item A new form is displayed.  Clicking on the confirmation button
                    652: causes the newdir operation to transition into phase 2.  The hidden field
                    653: "newfilename" is set with the construction space path to the new directory.
                    654: 
                    655: 
                    656: =back
                    657: 
                    658: =cut
                    659: 
                    660: 
1.55      albertel  661: sub NewDir1 {
                    662:     my ($request, $username, $domain, $fn, $newfilename, $mode) = @_;
                    663: 
                    664:     my $result=&exists($username,$domain,$newfilename);
                    665:     if ($result) {
                    666: 	$request->print('<font color="red">'.$result.'</font></form>');
                    667:     } else {
                    668: 	if ($mode eq 'testbank') {
                    669: 	    $request->print('<input type="hidden" name="callingmode" value="testbank">');
                    670: 	} elsif ($mode eq 'imsimport') {
                    671: 	    $request->print('<input type="hidden" name="callingmode" value="imsimport">');
                    672: 	}
                    673: 	$request->print('<input type="hidden" name="newfilename" value="'.
                    674: 			$newfilename.'" /><p>'.&mt('Make new directory').' '.
                    675: 			&display($newfilename).'?</p>');
                    676: 	&CloseForm1($request, $fn);
                    677:     }
1.12      foxr      678: }
                    679: 
1.44      taceyjo1  680: 
                    681: sub Decompress1 {
1.55      albertel  682:     my ($request, $user, $domain, $fn) = @_;
                    683:     if( -e $fn) {
1.44      taceyjo1  684:    	$request->print('<input type="hidden" name="newfilename" value="'.$fn.'"/>');
1.47      sakharuk  685:    	$request->print('<p>'.&mt('Decompress').' '.&display($fn).'?</p>');
1.44      taceyjo1  686:    	&CloseForm1($request, $fn);
1.55      albertel  687:     } else {
                    688: 	$request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
                    689:     }
1.44      taceyjo1  690: }
1.55      albertel  691: 
1.12      foxr      692: =pod
                    693: 
1.22      albertel  694: =item NewFile1
                    695:  
                    696:   Does all phase 1 processing of file creation:
                    697:   Ensures that the user provides a new filename, adds proper extension
                    698:   if needed and that the file does not already exist, if it is a html,
                    699:   problem, page, or sequence, it then creates a form link to hand the
                    700:   actual creation off to the proper handler.
                    701: 
                    702: Parameters:
                    703: 
                    704: =over 4
                    705: 
                    706: =item   $request  - Apache Request Object [in] - Server request object for the
                    707:                current url.
                    708: 
                    709: =item   $username - Name of the user that is requesting the directory creation.
                    710: 
                    711: =item   $domain   - Name of the domain of the user
                    712: 
1.36      www       713: =item   $fn      - Source file name
1.22      albertel  714: 
                    715: =item   $newfilename
                    716:                   - Name of the file to be created; no path information
                    717: =back
                    718: 
                    719: Side Effects:
                    720: 
                    721: =over 4
                    722: 
                    723: =item 2 new forms are displayed.  Clicking on the confirmation button
                    724: causes the browser to attempt to load the specfied URL, allowing the
1.36      www       725: proper handler to take care of file creation. There is also a Cancel
1.22      albertel  726: button which returns you to the driectory listing you came from
                    727: 
                    728: =back
                    729: 
                    730: =cut
                    731: 
                    732: sub NewFile1 {
1.36      www       733:     my ($request, $user, $domain, $fn, $newfilename) = @_;
1.22      albertel  734: 
1.67      albertel  735:     if ($env{'form.action'} =~ /new(.+)file/) {
1.22      albertel  736: 	my $extension=$1;
1.40      www       737: 
                    738:         ##Informs User (name).(number).(extension) not allowed 
                    739: 	if($newfilename =~ /\.(\d+)\.(\w+)$/){
                    740: 	    $r->print('<font color="red">'.$newfilename.
1.69      www       741: 		      ' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '.
                    742: 		      ' '.&mt('Not Allowed').'</font>');
                    743: 	    return;
                    744: 	}
                    745: 	if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){
                    746: 	    $r->print('<font color="red">'.$newfilename.
                    747: 		      ' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '.
1.47      sakharuk  748: 		      ' '.&mt('Not Allowed').'</font>');
1.40      www       749: 	    return;
                    750: 	}
1.22      albertel  751: 	if ($newfilename !~ /\Q.$extension\E$/) {
1.81      albertel  752: 	    if ($newfilename =~ m|/[^/.]*\.(?:[^/.]+)$|) {
1.26      albertel  753: 		#already has an extension strip it and add in expected one
1.81      albertel  754: 		$newfilename =~ s|(/[^./])\.(?:[^.]+)$|$1|;
1.26      albertel  755: 	    }
1.22      albertel  756: 	    $newfilename.=".$extension";
                    757: 	}
1.31      albertel  758:     }
1.39      www       759:     my $result=&exists($user,$domain,$newfilename);
                    760:     if($result) {
1.81      albertel  761: 	$request->print('<span class="LC_error">'.$result.'</span></form>');
1.39      www       762:     } else {
1.47      sakharuk  763: 	$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');
1.22      albertel  764: 	$request->print('</form>');
1.36      www       765: 	$request->print('<form action="'.&url($newfilename).
1.47      sakharuk  766: 			'" method="POST"><p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
1.36      www       767: 	$request->print('<form action="'.&url($fn).
1.47      sakharuk  768: 			'" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
1.22      albertel  769:     }
                    770: }
                    771: 
                    772: =pod
                    773: 
1.12      foxr      774: =item phaseone($r, $fn, $uname, $udom)
                    775: 
                    776:   Peforms phase one processing of the request.  In phase one, error messages
                    777: are returned if the request cannot be performed (e.g. attempts to manipulate
                    778: files that are nonexistent).  If the operation can be performed, what is
                    779: about to be done will be presented to the user for confirmation.  If the
                    780: user confirms the request, then phase two is executed, the action 
                    781: performed and reported to the user.
                    782: 
                    783:  Parameters:
                    784: 
                    785: =over 4
                    786: 
                    787: =item $r  - request object [in] - The Apache request being executed.
                    788: 
                    789: =item $fn = string [in] - The filename being manipulated by the 
                    790:                              request.
                    791: 
                    792: =item $uname - string [in] Name of user logged in and doing this action.
                    793: 
1.17      harris41  794: =item $udom  - string [in] Domain name under which the user logged in. 
1.12      foxr      795: 
                    796: =back
                    797: 
                    798: =cut
1.8       albertel  799: 
1.1       www       800: sub phaseone {
1.55      albertel  801:     my ($r,$fn,$uname,$udom)=@_;
1.12      foxr      802:   
1.58      albertel  803:     my $doingdir=0;
1.67      albertel  804:     if ($env{'form.action'} eq 'newdir') { $doingdir=1; }
                    805:     my $newfilename=&cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname);
1.55      albertel  806:     $newfilename=&relativeDest($fn,$newfilename,$uname);
                    807:     $r->print('<form action="/adm/cfile" method="post">'.
                    808: 	      '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
                    809: 	      '<input type="hidden" name="phase" value="two" />'.
1.67      albertel  810: 	      '<input type="hidden" name="action" value="'.$env{'form.action'}.'" />');
1.12      foxr      811:   
1.67      albertel  812:     if ($env{'form.action'} eq 'rename') {
1.55      albertel  813: 	&Rename1($r, $uname, $udom, $fn, $newfilename, 'rename');
1.67      albertel  814:     } elsif ($env{'form.action'} eq 'move') {
1.55      albertel  815: 	&Rename1($r, $uname, $udom, $fn, $newfilename, 'move');
1.67      albertel  816:     } elsif ($env{'form.action'} eq 'delete') { 
1.55      albertel  817: 	&Delete1($r, $uname, $udom, $fn);
1.67      albertel  818:     } elsif ($env{'form.action'} eq 'decompress') {
1.55      albertel  819: 	&Decompress1($r, $uname, $udom, $fn);
1.67      albertel  820:     } elsif ($env{'form.action'} eq 'copy') { 
1.55      albertel  821: 	if($newfilename) {
                    822: 	    &Copy1($r, $uname, $udom, $fn, $newfilename);
                    823: 	} else {
                    824: 	    $r->print('<p>'.&mt('No new filename specified.').'</p></form>');
                    825: 	}
1.67      albertel  826:     } elsif ($env{'form.action'} eq 'newdir') {
1.55      albertel  827: 	my $mode = '';
1.67      albertel  828: 	if (exists($env{'form.callingmode'}) ) {
                    829: 	    $mode = $env{'form.callingmode'};
1.55      albertel  830: 	}   
                    831: 	&NewDir1($r, $uname, $udom, $fn, $newfilename, $mode);
1.67      albertel  832:     }  elsif ($env{'form.action'} eq 'newfile' ||
                    833: 	      $env{'form.action'} eq 'newhtmlfile' ||
                    834: 	      $env{'form.action'} eq 'newproblemfile' ||
                    835: 	      $env{'form.action'} eq 'newpagefile' ||
                    836: 	      $env{'form.action'} eq 'newsequencefile' ||
                    837: 	      $env{'form.action'} eq 'newrightsfile' ||
                    838: 	      $env{'form.action'} eq 'newstyfile' ||
                    839:               $env{'form.action'} eq 'newlibraryfile' ||
                    840: 	      $env{'form.action'} eq 'Select Action') {
1.65      www       841:         my $empty=&mt('Type Name Here');
                    842: 	if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) {
1.55      albertel  843: 	    &NewFile1($r, $uname, $udom, $fn, $newfilename);
                    844: 	} else {
                    845: 	    $r->print('<p>'.&mt('No new filename specified.').'</p></form>');
                    846: 	}
                    847:     }
1.12      foxr      848: }
                    849: 
                    850: =pod
                    851: 
                    852: =item Rename2($request, $user, $directory, $oldfile, $newfile)
                    853: 
1.17      harris41  854: Performs phase 2 processing of a rename reequest.   This is where the
1.12      foxr      855: actual rename is performed.
                    856: 
                    857: Parameters
                    858: 
                    859: =over 4
                    860: 
                    861: =item $request - Apache request object [in] The request being processed.
                    862: 
                    863: =item $user  - string [in] The name of the user initiating the request.
                    864: 
                    865: =item $directory - string [in] The name of the directory relative to the
                    866:                  construction space top level of the renamed file.
                    867: 
                    868: =item $oldfile - Name of the file.
                    869: 
                    870: =item $newfile - Name of the new file.
                    871: 
                    872: =back
                    873: 
                    874: Returns:
                    875: 
                    876: =over 4
                    877: 
                    878: =item 1 Success.
                    879: 
                    880: =item 0 Failure.
                    881: 
                    882: =cut
                    883: 
                    884: sub Rename2 {
                    885: 
1.55      albertel  886:     my ($request, $user, $directory, $oldfile, $newfile) = @_;
1.12      foxr      887: 
1.55      albertel  888:     &Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile.
                    889: 	   " new file ".$newfile."\n");
                    890:     &Debug($request, "Target is: ".$directory.'/'.
                    891: 	   $newfile);
                    892:     if (-e $oldfile) {
                    893: 
                    894: 	my $oRN=$oldfile;
                    895: 	my $nRN=$newfile;
                    896: 	unless (rename($oldfile,$newfile)) {
                    897: 	    $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
                    898: 	    return 0;
                    899: 	}
                    900: 	## If old name.(extension) exits, move under new name.
                    901: 	## If it doesn't exist and a new.(extension) exists  
                    902: 	## delete it (only concern when renaming over files)
                    903: 	my $tmp1=$oRN.'.meta';
                    904: 	my $tmp2=$nRN.'.meta';
                    905: 	if(-e $tmp1){
                    906: 	    unless(rename($tmp1,$tmp2)){ }
                    907: 	} elsif(-e $tmp2){
                    908: 	    unlink $tmp2;
                    909: 	}
                    910: 	$tmp1=$oRN.'.save';
                    911: 	$tmp2=$nRN.'.save';
                    912: 	if(-e $tmp1){
                    913: 	    unless(rename($tmp1,$tmp2)){ }
                    914: 	} elsif(-e $tmp2){
                    915: 	    unlink $tmp2;
                    916: 	}
                    917: 	$tmp1=$oRN.'.log';
                    918: 	$tmp2=$nRN.'.log';
                    919: 	if(-e $tmp1){
                    920: 	    unless(rename($tmp1,$tmp2)){ }
                    921: 	} elsif(-e $tmp2){
                    922: 	    unlink $tmp2;
                    923: 	}
                    924: 	$tmp1=$oRN.'.bak';
                    925: 	$tmp2=$nRN.'.bak';
                    926: 	if(-e $tmp1){
                    927: 	    unless(rename($tmp1,$tmp2)){ }
                    928: 	} elsif(-e $tmp2){
                    929: 	    unlink $tmp2;
                    930: 	}
                    931:     } else {
                    932: 	$request->print("<p> ".&mt('No such file').": ".&display($oldfile).'</p></form>');
                    933: 	return 0;
                    934:     }
                    935:     return 1;
1.12      foxr      936: }
1.55      albertel  937: 
1.12      foxr      938: =pod
                    939: 
                    940: =item Delete2($request, $user, $filename)
                    941: 
                    942:   Performs phase two of a delete.  The user has confirmed that they want 
                    943: to delete the selected file.   The file is deleted and the results of the
                    944: delete attempt are indicated.
                    945: 
                    946: Parameters:
                    947: 
                    948: =over 4
                    949: 
                    950: =item $request - Apache Request object [in] the request object for the current
                    951:                  delete operation.
                    952: 
                    953: =item $user    - string [in]  The name of the user initiating the delete
                    954:                  request.
                    955: 
1.17      harris41  956: =item $filename - string [in] The name of the file, relative to construction
                    957:                   space, to delete.
1.12      foxr      958: 
                    959: =back
                    960: 
                    961: Returns:
                    962:   1 - success.
                    963:   0 - Failure.
                    964: 
                    965: =cut
                    966: 
                    967: sub Delete2 {
1.55      albertel  968:     my ($request, $user, $filename) = @_;
1.70      raeburn   969:     if (-d $filename) { 
                    970: 	unless (&empty_directory($filename,'Delete2')) { 
1.55      albertel  971: 	    $request->print('<font color="red"> '.&mt('Error: Directory Non Empty').'</font>'); 
                    972: 	    return 0;
                    973: 	} else {   
                    974: 	    if(-e $filename) {
                    975: 		unless(rmdir($filename)) {
                    976: 		    $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
                    977: 		    return 0;
                    978: 		}
                    979: 	    } else {
                    980: 		$request->print('<p> '.&mt('No such file').'. </p></form>');
                    981: 		return 0;
                    982: 	    }
                    983: 	}
1.48      taceyjo1  984:     } else {
1.55      albertel  985: 	if(-e $filename) {
                    986: 	    unless(unlink($filename)) {
                    987: 		$request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
                    988: 		return 0;
                    989: 	    }
                    990: 	} else {
                    991: 	    $request->print('<p> '.&mt('No such file').'. </p></form>');
                    992: 	    return 0;
1.46      taceyjo1  993: 	}
1.55      albertel  994:     }
                    995:     return 1;
1.12      foxr      996: }
                    997: 
                    998: =pod
                    999: 
                   1000: =item Copy2($request, $username, $dir, $oldfile, $newfile)
                   1001: 
                   1002:    Performs phase 2 of a copy.  The file is copied and the status 
                   1003:    of that copy is reported back to the user.
                   1004: 
                   1005: =over 4
                   1006: 
                   1007: =item $request - Apache request object [in]; the apache request currently
                   1008:                  being executed.
                   1009: 
                   1010: =item $username - string [in] Name of the user who is requesting the copy.
                   1011: 
                   1012: =item $dir - string [in] Directory path relative to the construction space
                   1013:              of the destination file.
                   1014: 
                   1015: =item $oldfile - string [in] Name of the source file.
                   1016: 
                   1017: =item $newfile - string [in] Name of the destination file.
                   1018: 
                   1019: 
                   1020: =back
                   1021: 
1.71      raeburn  1022: Returns 0 failure, and 1 successs.
1.12      foxr     1023: 
                   1024: =cut
1.1       www      1025: 
1.12      foxr     1026: sub Copy2 {
                   1027:     my ($request, $username, $dir, $oldfile, $newfile) = @_;
                   1028:     &Debug($request ,"Will try to copy $oldfile to $newfile");
                   1029:     if(-e $oldfile) {
1.71      raeburn  1030:         if ($oldfile eq $newfile) {
                   1031:             $request->print('<font color="red"> '.&mt('Warning').': '.&mt('Name of new file is the same as name of old file').' - '.&mt('no action taken').'.</font>');
                   1032:             return 1;
                   1033:         }
1.12      foxr     1034: 	unless (copy($oldfile, $newfile)) {
1.47      sakharuk 1035: 	    $request->print('<font color="red"> '.&mt('copy Error').': '.$!.'</font>');
1.12      foxr     1036: 	    return 0;
1.61      albertel 1037: 	} elsif (!chmod(0660, $newfile)) {
                   1038: 	    $request->print('<font color="red"> '.&mt('chmod error').': '.$!.'</font>');
                   1039: 	    return 0;
                   1040: 	} elsif (-e $oldfile.'.meta' && 
                   1041: 		 !copy($oldfile.'.meta', $newfile.'.meta') &&
                   1042: 		 !chmod(0660, $newfile.'.meta')) {
                   1043: 	    $request->print('<font color="red"> '.&mt('copy metadata error').
                   1044: 			    ': '.$!.'</font>');
                   1045: 	    return 0;
1.12      foxr     1046: 	} else {
                   1047: 	    return 1;
                   1048: 	}
1.11      albertel 1049:     } else {
1.47      sakharuk 1050: 	$request->print('<p> '.&mt('No such file').' </p>');
1.12      foxr     1051: 	return 0;
1.11      albertel 1052:     }
1.12      foxr     1053:     return 1;
                   1054: }
1.55      albertel 1055: 
1.12      foxr     1056: =pod
                   1057: 
                   1058: =item NewDir2($request, $user, $newdirectory)
1.1       www      1059: 
1.12      foxr     1060: 	Performs phase 2 processing of directory creation.  This involves creating the directory and
                   1061: 	reporting the results of that creation to the user.
                   1062: 	
                   1063: Parameters:
                   1064: =over 4
                   1065: 
                   1066: =item $request  - Apache request object [in].  Object representing the current HTTP request.
                   1067: 
                   1068: =item $user - string [in] The name of the user that is initiating the request.
                   1069: 
                   1070: =item $newdirectory - string [in] The full path of the directory being created.
                   1071: 
                   1072: =back
                   1073: 
                   1074: Returns 0 - failure 1 - success.
                   1075: 
                   1076: =cut
1.8       albertel 1077: 
1.12      foxr     1078: sub NewDir2 {
1.55      albertel 1079:     my ($request, $user, $newdirectory) = @_;
1.12      foxr     1080:   
1.55      albertel 1081:     unless(mkdir($newdirectory, 02770)) {
                   1082: 	$request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
                   1083: 	return 0;
                   1084:     }
                   1085:     unless(chmod(02770, ($newdirectory))) {
                   1086: 	$request->print('<font color="red"> '.&mt('Error').': '.$!.'</font>');
                   1087: 	return 0;
                   1088:     }
                   1089:     return 1;
1.1       www      1090: }
1.55      albertel 1091: 
1.44      taceyjo1 1092: sub decompress2 {
1.55      albertel 1093:     my ($r, $user, $dir, $file) = @_;
                   1094:     &Apache::lonnet::appenv('cgi.file' => $file);
                   1095:     &Apache::lonnet::appenv('cgi.dir' => $dir);
                   1096:     my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   1097:     $r->print($result);
                   1098:     &Apache::lonnet::delenv('cgi.file');
                   1099:     &Apache::lonnet::delenv('cgi.dir');
                   1100:     return 1;
1.44      taceyjo1 1101: }
1.55      albertel 1102: 
1.12      foxr     1103: =pod
                   1104: 
                   1105: =item phasetwo($r, $fn, $uname, $udom)
                   1106: 
                   1107:    Controls the phase 2 processing of file management
                   1108:    requests for construction space.  In phase one, the user
                   1109:    was asked to confirm the operation.  In phase 2, the operation
                   1110:    is performed and the result is shown.
                   1111: 
                   1112:   The strategy is to break out the processing into specific action processors
                   1113:   named action2 where action is the requested action and the 2 denotes 
                   1114:   phase 2 processing.
                   1115: 
                   1116: Parameters:
                   1117: 
                   1118: =over 4
                   1119: 
                   1120: =item  $r     - Apache Request object [in] The request object for this httpd
                   1121:            transaction.
                   1122: 
                   1123: =item  $fn    - string [in]  A filename indicating the object that is being
                   1124:            manipulated.
                   1125: 
                   1126: =item  $uname - string [in] The name of the user initiating the file management
                   1127:            request.
                   1128: 
                   1129: =item  $udom  - string  [in] The login domain of the user initiating the
                   1130:            file management request.
                   1131: =back
                   1132: 
                   1133: =cut
                   1134: 
1.1       www      1135: sub phasetwo {
                   1136:     my ($r,$fn,$uname,$udom)=@_;
1.12      foxr     1137:     
1.9       foxr     1138:     &Debug($r, "loncfile - Entering phase 2 for $fn");
1.12      foxr     1139:     
1.78      banghart 1140:     # Break down the file into its component pieces.
1.12      foxr     1141:     
1.27      albertel 1142:     my $dir;		# Directory path
                   1143:     my $main;		# Filename.
                   1144:     my $suffix;		# Extension.
1.46      taceyjo1 1145:     if ($fn=~m:(.*)/([^/]+):) {
1.27      albertel 1146: 	$dir=$1;		# Directory path
                   1147: 	$main=$2;		# Filename.
1.54      albertel 1148:     }
                   1149:     if($main=~m:\.(\w+)$:){ # Fixes problems with filenames with no extensions
1.68      albertel 1150: 	$suffix=$1; #This is the actually filename extension if it exists
1.66      albertel 1151: 	$main=~s/\.\w+$//; #strip the extension
1.54      albertel 1152:     }
1.79      banghart 1153:     my $dest;                       #
                   1154:     my $dest_dir;                   # On success this is where we'll go.
                   1155:     my $disp_newname;               #
                   1156:     my $dest_newname;               #
1.55      albertel 1157:     &Debug($r,"loncfile::phase2 dir = $dir main = $main suffix = $suffix");
1.67      albertel 1158:     &Debug($r,"    newfilename = ".$env{'form.newfilename'});
1.9       foxr     1159: 
                   1160:     my $conspace=$fn;
1.12      foxr     1161:     
1.55      albertel 1162:     &Debug($r,"loncfile::phase2 Full construction space name: $conspace");
1.12      foxr     1163:     
1.67      albertel 1164:     &Debug($r,"loncfie::phase2 action is $env{'form.action'}");
1.12      foxr     1165:     
                   1166:     # Select the appropriate processing sub.
1.67      albertel 1167:     if ($env{'form.action'} eq 'decompress') { 
1.66      albertel 1168: 	$main .= '.'.$suffix;
1.55      albertel 1169: 	if(!&decompress2($r, $uname, $dir, $main)) {
                   1170: 	    return ;
                   1171: 	}
                   1172: 	$dest = $dir."/.";
1.67      albertel 1173:     } elsif ($env{'form.action'} eq 'rename' ||
                   1174: 	     $env{'form.action'} eq 'move') {
                   1175: 	if($env{'form.newfilename'}) {
1.27      albertel 1176: 	    if (!defined($dir)) {
                   1177: 		$fn=~m:^(.*)/:;
1.55      albertel 1178: 		$dir=$1; 
1.27      albertel 1179: 	    }
1.67      albertel 1180: 	    if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) {
1.12      foxr     1181: 		return;
                   1182: 	    }
1.78      banghart 1183: 	    $dest = $dir."/";
1.79      banghart 1184: 	    $dest_newname = $env{'form.newfilename'};
                   1185: 	    $env{'form.newfilename'} =~ /.+(\/.+$)/;
                   1186: 	    $disp_newname = $1;
                   1187: 	    $disp_newname =~ s/\///;
1.12      foxr     1188: 	}
1.67      albertel 1189:     } elsif ($env{'form.action'} eq 'delete') { 
                   1190: 	if(!&Delete2($r, $uname, $env{'form.newfilename'})) {
1.12      foxr     1191: 	    return ;
                   1192: 	}
                   1193: 	# Once a resource is deleted, we just list the directory that
                   1194: 	# previously held it.
                   1195: 	#
1.20      albertel 1196: 	$dest = $dir."/.";		# Parent dir.
1.67      albertel 1197:     } elsif ($env{'form.action'} eq 'copy') { 
                   1198: 	if($env{'form.newfilename'}) {
                   1199: 	    if(!&Copy2($r, $uname, $dir, $fn, $env{'form.newfilename'})) {
1.44      taceyjo1 1200: 		return ;
1.55      albertel 1201: 	    }
1.67      albertel 1202: 	    $dest = $env{'form.newfilename'};
1.55      albertel 1203:      	} else {
1.47      sakharuk 1204: 	    $r->print('<p>'.&mt('No New filename specified').'</p></form>');
1.12      foxr     1205: 	    return;
                   1206: 	}
                   1207: 	
1.67      albertel 1208:     } elsif ($env{'form.action'} eq 'newdir') {
                   1209:         my $newdir= $env{'form.newfilename'};
1.12      foxr     1210: 	if(!&NewDir2($r, $uname, $newdir)) {
                   1211: 	    return;
                   1212: 	}
1.55      albertel 1213: 	$dest = $newdir."/";
1.12      foxr     1214:     }
1.67      albertel 1215:     if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
1.55      albertel 1216: 	$r->print('<h3><a href="javascript:self.close()">'.&mt('Done').'</a></h3>');
1.51      raeburn  1217:     } else {
1.79      banghart 1218:         if ($env{'form.action'} eq 'rename') {
                   1219:             $r->print('<h3><a href="'.&url($dest).'">'.&mt('Return to Directory').'</a></h3>');
                   1220:             $r->print('<h3><a href="'.&url($dest_newname).'">'.$disp_newname.'</a></h3>');
                   1221:         } else {
                   1222: 	    $r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>');
                   1223: 	}
1.51      raeburn  1224:     }
1.1       www      1225: }
                   1226: 
                   1227: sub handler {
                   1228: 
1.55      albertel 1229:     $r=shift;
1.1       www      1230: 
1.60      www      1231:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress','action','filename','newfilename']);
1.9       foxr     1232: 
1.55      albertel 1233:     &Debug($r, "loncfile.pm - handler entered");
1.67      albertel 1234:     &Debug($r, " filename: ".$env{'form.filename'});
                   1235:     &Debug($r, " newfilename: ".$env{'form.newfilename'});
1.36      www      1236: #
                   1237: # Determine the root filename
                   1238: # This could come in as "filename", which actually is a URL, or
                   1239: # as "qualifiedfilename", which is indeed a real filename in filesystem
                   1240: #
1.55      albertel 1241:     my $fn;
1.1       www      1242: 
1.67      albertel 1243:     if ($env{'form.filename'}) {
                   1244: 	&Debug($r, "test: $env{'form.filename'}");
1.77      www      1245: 	$fn=&unescape($env{'form.filename'});
1.55      albertel 1246: 	$fn=&URLToPath($fn);
1.67      albertel 1247:     }  elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') {  
1.55      albertel 1248: 	#Just hijack the script only the first time around to inject the
                   1249: 	#correct information for further processing
1.77      www      1250: 	$fn=&unescape($env{'form.decompress'});
1.44      taceyjo1 1251: 	$fn=&URLToPath($fn);
1.67      albertel 1252: 	$env{'form.action'}="decompress";
                   1253:     } elsif ($env{'form.qualifiedfilename'}) {
                   1254: 	$fn=$env{'form.qualifiedfilename'};
1.55      albertel 1255:     } else {
                   1256: 	&Debug($r, "loncfile::handler - no form.filename");
1.67      albertel 1257: 	$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1.55      albertel 1258: 		       ' unspecified filename for cfile', $r->filename); 
                   1259: 	return HTTP_NOT_FOUND;
                   1260:     }
1.44      taceyjo1 1261: 
1.55      albertel 1262:     unless ($fn) { 
                   1263: 	&Debug($r, "loncfile::handler - doctored url is empty");
1.67      albertel 1264: 	$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1.55      albertel 1265: 		       ' trying to cfile non-existing file', $r->filename); 
                   1266: 	return HTTP_NOT_FOUND;
                   1267:     } 
1.1       www      1268: 
                   1269: # ----------------------------------------------------------- Start page output
1.55      albertel 1270:     my $uname;
                   1271:     my $udom;
                   1272: 
                   1273:     ($uname,$udom)=
                   1274: 	&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
                   1275:     &Debug($r, 
                   1276: 	   "loncfile::handler constructaccess uname = $uname domain = $udom");
                   1277:     unless (($uname) && ($udom)) {
                   1278: 	$r->log_reason($uname.' at '.$udom.
1.67      albertel 1279: 		       ' trying to manipulate file '.$env{'form.filename'}.
1.55      albertel 1280: 		       ' ('.$fn.') - not authorized', 
                   1281: 		       $r->filename); 
                   1282: 	return HTTP_NOT_ACCEPTABLE;
                   1283:     }
                   1284: 
1.1       www      1285: 
1.55      albertel 1286:     &Apache::loncommon::content_type($r,'text/html');
                   1287:     $r->send_http_header;
                   1288: 
1.75      albertel 1289:     my (%loaditem,$js);
                   1290: 
1.67      albertel 1291:     if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
                   1292: 	my $newdirname = $env{'form.newfilename'};
1.75      albertel 1293: 	$js = qq|
                   1294: <script type="text/javascript">
1.51      raeburn  1295: function writeDone() {
                   1296:     var winName = window.opener
                   1297:     window.focus();
                   1298:     winName.document.dataForm.newdir.value = "$newdirname"
                   1299:     setTimeout("self.close()",10000)
                   1300: }
                   1301:   </script>
1.75      albertel 1302: |;
1.76      albertel 1303: 	$loaditem{'onload'} = "writeDone()";
1.55      albertel 1304:     }
1.75      albertel 1305:     
                   1306:     $r->print(&Apache::loncommon::start_page('Construction Space File Operation',
                   1307: 					     $js,
                   1308: 					     {'add_entries' => \%loaditem,}));
1.1       www      1309:   
1.55      albertel 1310:     $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
1.1       www      1311:   
1.67      albertel 1312:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.55      albertel 1313: 	$r->print('<h3><font color="red">'.&mt('Co-Author').': '.$uname.' at '.$udom.
                   1314: 		  '</font></h3>');
                   1315:     }
                   1316: 
                   1317: 
1.67      albertel 1318:     &Debug($r, "loncfile::handler Form action is $env{'form.action'} ");
                   1319:     if ($env{'form.action'} eq 'delete') {
1.55      albertel 1320:       	$r->print('<h3>'.&mt('Delete').'</h3>');
1.67      albertel 1321:     } elsif ($env{'form.action'} eq 'rename') {
1.55      albertel 1322: 	$r->print('<h3>'.&mt('Rename').'</h3>');
1.67      albertel 1323:     } elsif ($env{'form.action'} eq 'move') {
1.55      albertel 1324: 	$r->print('<h3>'.&mt('Move').'</h3>');
1.67      albertel 1325:     } elsif ($env{'form.action'} eq 'newdir') {
1.55      albertel 1326: 	$r->print('<h3>'.&mt('New Directory').'</h3>');
1.67      albertel 1327:     } elsif ($env{'form.action'} eq 'decompress') {
1.55      albertel 1328: 	$r->print('<h3>'.&mt('Decompress').'</h3>');
1.67      albertel 1329:     } elsif ($env{'form.action'} eq 'copy') {
1.55      albertel 1330: 	$r->print('<h3>'.&mt('Copy').'</h3>');
1.67      albertel 1331:     } elsif ($env{'form.action'} eq 'newfile' ||
                   1332: 	     $env{'form.action'} eq 'newhtmlfile' ||
                   1333: 	     $env{'form.action'} eq 'newproblemfile' ||
                   1334: 	     $env{'form.action'} eq 'newpagefile' ||
                   1335: 	     $env{'form.action'} eq 'newsequencefile' ||
                   1336: 	     $env{'form.action'} eq 'newrightsfile' ||
                   1337: 	     $env{'form.action'} eq 'newstyfile' ||
                   1338:              $env{'form.action'} eq 'newlibraryfile' ||
                   1339: 	     $env{'form.action'} eq 'Select Action' ) {
1.55      albertel 1340: 	$r->print('<h3>'.&mt('New Resource').'</h3>');
                   1341:     } else {
1.75      albertel 1342: 	$r->print('<p>'.&mt('Unknown Action').' '.$env{'form.action'}.' </p>'.
                   1343: 		  &Apache::loncommon::end_page());
1.55      albertel 1344: 	return OK;  
                   1345:     }
1.67      albertel 1346:     if ($env{'form.phase'} eq 'two') {
1.55      albertel 1347: 	&Debug($r, "loncfile::handler  entering phase2");
                   1348: 	&phasetwo($r,$fn,$uname,$udom);
                   1349:     } else {
                   1350: 	&Debug($r, "loncfile::handler  entering phase1");
                   1351: 	&phaseone($r,$fn,$uname,$udom);
                   1352:     }
1.1       www      1353: 
1.75      albertel 1354:     $r->print(&Apache::loncommon::end_page());
1.55      albertel 1355:     return OK;  
1.1       www      1356: }
                   1357: 
                   1358: 1;
                   1359: __END__
1.9       foxr     1360: 

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