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

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.104   ! raeburn    12: # $Id: loncfile.pm,v 1.103 2009/12/02 09:53:02 bisitz 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: 
1.89      www       112: sub done {
                    113:    my ($url)=@_;
                    114:    my $done=&mt("Done");
                    115:    return(<<ENDDONE);
                    116: <a href="$url">$done</a>
                    117: <script type="text/javascript">
                    118: location.href="$url";
                    119: </script>
                    120: ENDDONE
                    121: }
                    122: 
1.12      foxr      123: =pod
                    124: 
                    125: =item URLToPath($url)
                    126: 
                    127:   Convert a URL to a file system path.
                    128:   
                    129:   In order to manipulate the construction space objects, it is necessary
                    130:   to access url identified objects a filespace objects.  This function
                    131:   translates a construction space URL to a file system path.
                    132:  Parameters:
                    133: 
                    134: =over 4
                    135: 
                    136: =item  Url    - string [in] The url to convert.
                    137:   
                    138: =back
                    139:   
                    140:  Returns:
                    141: 
                    142: =over 4
                    143: 
1.16      harris41  144: =item  The corresponding file system path. 
1.12      foxr      145: 
                    146: =back
                    147: 
                    148: Global References
                    149: 
                    150: =over 4
                    151: 
                    152: =item  $r      - Request object [in] Referenced in the &Debug calls.
                    153: 
                    154: =back
                    155: 
                    156: =cut
                    157: 
                    158: sub URLToPath {
1.55      albertel  159:     my $Url = shift;
                    160:     &Debug($r, "UrlToPath got: $Url");
                    161:     $Url=~ s/\/+/\//g;
1.91      raeburn   162:     $Url=~ s/^https?\:\/\/[^\/]+//;
1.55      albertel  163:     $Url=~ s/^\///;
1.80      albertel  164:     $Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//;
1.55      albertel  165:     &Debug($r, "Returning $Url \n");
                    166:     return $Url;
1.12      foxr      167: }
                    168: 
1.36      www       169: sub url {
                    170:     my $fn=shift;
1.80      albertel  171:     $fn=~s/^\/home\/($match_username)\/public\_html/\/priv\/$1/;
1.56      albertel  172:     $fn=&HTML::Entities::encode($fn,'<>"&');
1.36      www       173:     return $fn;
                    174: }
                    175: 
                    176: sub display {
                    177:     my $fn=shift;
1.80      albertel  178:     $fn=~s-^/home/($match_username)/public_html-/priv/$1-;
1.87      albertel  179:     return '<span class="LC_filename">'.$fn.'</span>';
1.36      www       180: }
                    181: 
1.50      www       182: 
                    183: # see if the file is
                    184: # a) published (return 0 if not)
                    185: # b) if, so obsolete (return 0 if not)
                    186: 
                    187: sub obsolete_unpub {
                    188:     my ($user,$domain,$construct)=@_;
                    189:     my $published=$construct;
                    190:     $published=~
                    191: 	s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;
                    192:     if (-e $published) {
                    193: 	if (&Apache::lonnet::metadata($published,'obsolete')) {
                    194: 	    return 1;
                    195: 	}
                    196: 	return 0;
                    197:     } else {
                    198: 	return 1;
                    199:     }
                    200: }
                    201: 
1.70      raeburn   202: # see if directory is empty
1.74      www       203: # ignores any .meta, .save, .bak, and .log files created for a previously
1.70      raeburn   204: # published file, which has since been marked obsolete and deleted.
                    205: sub empty_directory {
                    206:     my ($dirname,$phase) = @_;
                    207:     if (opendir DIR, $dirname) {
                    208:         my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and ..
                    209:         if (@files) { 
1.74      www       210:             my @orphans = grep(/\.(meta|save|log|bak)$/,@files);
1.70      raeburn   211:             if (scalar(@files) - scalar(@orphans) > 0) { 
                    212:                 return 0;
                    213:             } else {
                    214:                 if (($phase eq 'Delete2') && (@orphans > 0)) {
                    215:                     foreach my $file (@orphans) {
1.74      www       216:                         if ($file =~ /\.(meta|save|log|bak)$/) {
1.70      raeburn   217:                             unlink($dirname.$file);
                    218:                         }
                    219:                     }
                    220:                 }
                    221:             }
                    222:         }
                    223:         closedir(DIR);
                    224:         return 1;
                    225:     }
                    226:     return 0;
                    227: }
1.50      www       228: 
1.12      foxr      229: =pod
                    230: 
1.39      www       231: =item exists($user, $domain, $file)
1.12      foxr      232: 
1.17      harris41  233:    Determine if a resource file name has been published or exists
1.12      foxr      234:    in the construction space.
                    235: 
                    236:  Parameters:
                    237: 
                    238: =over 4
                    239: 
1.85      albertel  240: =item  $user     - string [in] - Name of the user for which to check.
1.12      foxr      241: 
1.85      albertel  242: =item  $domain   - string [in] - Name of the domain in which the resource
1.12      foxr      243:                           might have been published.
                    244: 
1.85      albertel  245: =item  $file     - string [in] - Name of the file.
                    246: 
                    247: =item  $creating - string [in] - optional, type of object being created,
                    248:                                either 'directory' or 'file'. Defaults to
                    249:                                'file' if unspecified.
1.12      foxr      250: 
                    251: =back
                    252: 
                    253: Returns:
                    254: 
                    255: =over 4
                    256: 
1.83      albertel  257: =item  string - Either undef, 'warning' or 'error' depending on the
                    258:                 type of problem
                    259: 
1.12      foxr      260: =item  string - Either where the resource exists as an html string that can
                    261:            be embedded in a dialog or an empty string if the resource
                    262:            does not exist.
                    263:   
                    264: =back
                    265: 
                    266: =cut
                    267: 
1.8       albertel  268: sub exists {
1.85      albertel  269:     my ($user, $domain, $construct, $creating) = @_;
                    270:     $creating ||= 'file';
                    271: 
1.55      albertel  272:     my $published=$construct;
                    273:     $published=~
1.83      albertel  274: 	s{^/home/$user/public_html/}{/home/httpd/html/res/$domain/$user/};
                    275:     my ($type,$result);
1.55      albertel  276:     if ( -d $construct ) {
1.83      albertel  277: 	return ('error','<p><span class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</span></p>');
                    278: 	
1.55      albertel  279:     }
1.83      albertel  280: 
1.55      albertel  281:     if ( -e $published) {
1.83      albertel  282: 	if ( -e $construct ) {
                    283: 	    $type = 'warning';
                    284: 	    $result.='<p><span class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</span></p>';
                    285: 	} else {
1.85      albertel  286: 	    my $published_type = (-d $published) ? 'directory' : 'file';
                    287: 
                    288: 	    if ($published_type eq $creating) {
                    289: 		$type = 'warning';
                    290: 		$result.='<p><span class="LC_warning">'.&mt("Warning: a published $published_type of this name exists.").'</span></p>';
                    291: 	    } else {
                    292: 		$type = 'error';
                    293: 		$result.='<p><span class="LC_error">'.&mt("Error: a published $published_type of this name exists.").'</span></p>';
                    294: 	    }
1.83      albertel  295: 	}
1.55      albertel  296:     } elsif ( -e $construct) {
1.83      albertel  297: 	$type = 'warning';
                    298: 	$result.='<p><span class="LC_warning">'.&mt('Warning: target file exists!').'</span></p>';
1.55      albertel  299:     }
1.83      albertel  300: 
                    301:     return ($type,$result);
1.8       albertel  302: }
                    303: 
1.12      foxr      304: =pod
                    305: 
                    306: =item checksuffix($old, $new)
                    307:         
                    308:   Determine if a resource filename suffix (the stuff after the .) would change
                    309: as a result of this operation.
                    310: 
                    311:  Parameters:
                    312: 
                    313: =over 4
                    314: 
                    315: =item  $old   = string [in]  Previous filename.
                    316: 
                    317: =item  $new   = string [in]  Resultant filename.
                    318: 
                    319: =back
                    320: 
                    321:  Returns:
                    322: 
                    323: =over 4
                    324: 
1.17      harris41  325: =item    Empty string if everything worked.
1.12      foxr      326: 
                    327: =item    String containing an error message if there was a problem.
                    328: 
                    329: =back
                    330: 
                    331: =cut
                    332: 
1.8       albertel  333: sub checksuffix {
                    334:     my ($old,$new) = @_;
                    335:     my $result;
                    336:     my $oldsuffix;
                    337:     my $newsuffix;
                    338:     if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }
                    339:     if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
1.82      albertel  340:     if (lc($oldsuffix) ne lc($newsuffix)) {
1.12      foxr      341: 	$result.=
1.82      albertel  342:             '<p><span class="LC_warning">'.&mt('Warning: change of MIME type!').'</span></p>';
1.8       albertel  343:     }
                    344:     return $result;
                    345: }
1.32      albertel  346: 
                    347: sub cleanDest {
1.64      albertel  348:     my ($request,$dest,$subdir,$fn,$uname)=@_;
1.32      albertel  349:     #remove bad characters
1.58      albertel  350:     my $foundbad=0;
                    351:     if ($subdir && $dest =~/\./) {
                    352: 	$foundbad=1;
                    353: 	$dest=~s/\.//g;
                    354:     }
1.87      albertel  355:     $dest =~ s/(\s+$|^\s+)//g;
1.72      albertel  356:     if  ($dest=~/[\#\?&%\":]/) {
1.58      albertel  357: 	$foundbad=1;
1.72      albertel  358: 	$dest=~s/[\#\?&%\":]//g;
1.58      albertel  359:     }
1.63      albertel  360:     if ($dest=~m|/|) {
                    361: 	my ($newpath)=($dest=~m|(.*)/|);
1.64      albertel  362: 	$newpath=&relativeDest($fn,$newpath,$uname);
                    363: 	if (! -d "$newpath") {
1.100     bisitz    364: 	    $request->print('<p><span class="LC_warning">'
1.92      bisitz    365:                            .&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."
1.103     bisitz    366:                                ,&display($newpath))
1.93      bisitz    367:                            .'</span></p>');
1.63      albertel  368: 	    $dest=~s|.*/||;
                    369: 	}
                    370:     }
1.84      albertel  371:     if ($dest =~ /\.(\d+)\.(\w+)$/){
1.100     bisitz    372: 	$request->print('<p><span class="LC_warning">'
1.103     bisitz    373: 			.&mt('Bad filename [_1]',&display($dest))
1.93      bisitz    374:                         .'<br />'
                    375:                         .&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>')
                    376:                         .'<br />'
                    377:                         .&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>')
1.100     bisitz    378: 			.'</span></p>');
1.84      albertel  379: 	$dest =~ s/\.(\d+)(\.\w+)$/$2/;
                    380:     }
1.58      albertel  381:     if ($foundbad) {
1.100     bisitz    382:         $request->print('<p><span class="LC_warning">'
                    383:                        .&mt('Invalid characters in requested name have been removed.')
                    384:                         .'</span></p>'
                    385:         );
1.32      albertel  386:     }
                    387:     return $dest;
                    388: }
                    389: 
1.36      www       390: sub relativeDest {
                    391:     my ($fn,$newfilename,$uname)=@_;
                    392:     if ($newfilename=~/^\//) {
                    393: # absolute, simply add path
                    394: 	$newfilename='/home/'.$uname.'/public_html/';
                    395:     } else {
                    396: 	my $dir=$fn;
                    397: 	$dir=~s/\/[^\/]+$//;
                    398: 	$newfilename=$dir.'/'.$newfilename;
                    399:     }
                    400:     $newfilename=~s://+:/:g; # remove duplicate /
                    401:     while ($newfilename=~m:/\.\./:) {
                    402: 	$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
                    403:     }
                    404:     return $newfilename;
                    405: }
                    406: 
1.12      foxr      407: =pod
                    408: 
                    409: =item CloseForm1($request, $user, $file)
                    410: 
                    411:    Close of a form on the successful completion of phase 1 processing
                    412: 
                    413: Parameters:
                    414: 
                    415: =over 4
                    416: 
                    417: =item  $request - Apache Request Object [in] - Apache server request object.
                    418: 
1.13      foxr      419: =item  $cancelurl - the url to go to on cancel.
1.12      foxr      420: 
                    421: =back
                    422: 
                    423: =cut
                    424: 
                    425: sub CloseForm1 {
1.55      albertel  426:     my ($request,  $fn) = @_;
                    427:     $request->print('<p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
                    428:     $request->print('<form action="'.&url($fn).
1.97      bisitz    429: 		    '" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
1.12      foxr      430: }
                    431: 
                    432: 
                    433: =pod
                    434: 
                    435: =item CloseForm2($request, $user, $directory)
                    436: 
                    437:    Successfully close off the phase 2 form.
                    438: 
                    439: Parameters:
                    440: 
                    441: =over 4
                    442: 
                    443: =item   $request    - Apache Request object [in] - The request that is being
                    444:                  executed.
                    445: 
                    446: =item   $user       - string [in] - Name of the user that is initiating the
                    447:                  request.
                    448: 
                    449: =item   $directory  - string [in] - Directory in which the operation is 
                    450:                  being done relative to the top level construction space
                    451:                  directory.
                    452: 
                    453: =back
                    454: 
                    455: =cut
                    456: 
                    457: sub CloseForm2 {
1.55      albertel  458:     my ($request, $user, $fn) = @_;
1.89      www       459:     $request->print(&done(&url($fn)));
1.12      foxr      460: }
                    461: 
                    462: =pod
                    463: 
                    464: =item Rename1($request, $filename, $user, $domain, $dir)
                    465:  
                    466:    Perform phase 1 processing of the file rename operation.
                    467: 
                    468: Parameters:
                    469: 
                    470: =over 4
                    471: 
                    472: =item  $request   - Apache Request Object [in] The request object for the 
                    473: current request.
                    474: 
                    475: =item  $filename  - The filename relative to construction space.
                    476: 
                    477: =item  $user      - Name of the user making the request.
                    478: 
                    479: =item  $domain    - User login domain.
                    480: 
                    481: =item  $dir       - Directory specification of the path to the file.
                    482: 
                    483: =back
                    484: 
                    485: Side effects:
                    486: 
                    487: =over 4
                    488: 
                    489: =item A new form is displayed prompting for confirmation.  The newfilename
                    490: hidden field of this form is loaded with
                    491: new filename relative to the current directory ($dir).
                    492: 
                    493: =back
                    494: 
                    495: =cut  
                    496: 
                    497: sub Rename1 {
1.52      albertel  498:     my ($request, $user, $domain, $fn, $newfilename, $style) = @_;
1.36      www       499: 
                    500:     if(-e $fn) {
                    501: 	if($newfilename) {
1.42      albertel  502: 	    # is dest a dir
1.52      albertel  503: 	    if ($style eq 'move') {
                    504: 		if (-d $newfilename) {
                    505: 		    if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; }
                    506: 		}
1.42      albertel  507: 	    }
1.29      albertel  508: 	    if ($newfilename =~ m|/[^\.]+$|) {
1.36      www       509: 		#no extension add on original extension
                    510: 		if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {
1.24      albertel  511: 		    $newfilename.='.'.$1;
                    512: 		}
                    513: 	    }
1.36      www       514: 	    $request->print(&checksuffix($fn, $newfilename));
1.27      albertel  515: 	    #renaming a dir, delete the trailing /
1.39      www       516:             #remove second to last element for current dir
                    517: 	    if (-d $fn) {
1.53      www       518: 		$newfilename=~/\.(\w+)$/;
                    519: 		if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {
1.100     bisitz    520: 		    $request->print('<p><span class="LC_error">'.
                    521: 				    &mt('Cannot change MIME type of a directory.').
1.82      albertel  522: 				    '</span>'.
1.100     bisitz    523: 				    '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>');
1.53      www       524: 		    return;
                    525: 		}
1.39      www       526: 		$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;
1.27      albertel  527: 	    }
1.42      albertel  528: 	    $newfilename=~s://+:/:g; # remove duplicate /
                    529: 	    while ($newfilename=~m:/\.\./:) {
                    530: 		$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
                    531: 	    }
1.83      albertel  532: 	    my ($type, $return)=&exists($user, $domain, $newfilename);
1.21      albertel  533: 	    $request->print($return);
1.83      albertel  534: 	    if ($type eq 'error') {
1.47      sakharuk  535: 		$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
1.21      albertel  536: 		return;
                    537: 	    }
1.50      www       538: 	    unless (&obsolete_unpub($user,$domain,$fn)) {
1.100     bisitz    539:                 $request->print('<p><span class="LC_error">'
                    540:                                .&mt('Cannot rename or move non-obsolete published file.')
                    541:                                .'</span><br />'
                    542:                                .'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>'
                    543:                 );
1.50      www       544: 		return;
                    545: 	    }
1.52      albertel  546: 	    my $action;
                    547: 	    if ($style eq 'rename') {
1.100     bisitz    548: 		$action='Rename';
1.52      albertel  549: 	    } else {
1.100     bisitz    550: 		$action='Move';
1.52      albertel  551: 	    }
1.100     bisitz    552:             $request->print('<input type="hidden" name="newfilename" value="'
                    553:                            .$newfilename.'" />'
                    554:                            .'<p>'
1.103     bisitz    555:                            .&mt($action.' [_1] to [_2]?',
                    556:                                 &display($fn),
                    557:                                 &display($newfilename))
1.100     bisitz    558:                            .'</p>'
                    559:         );
1.36      www       560: 	    &CloseForm1($request, $fn);
1.12      foxr      561: 	} else {
1.100     bisitz    562: 	    $request->print('<p class="LC_error">'.&mt('No new filename specified.').'</p></form>');
1.12      foxr      563: 	    return;
                    564: 	}
                    565:     } else {
1.100     bisitz    566:         $request->print('<p class="LC_error">'
1.103     bisitz    567:                        .&mt('No such file: [_1]',
                    568:                             &display($fn))
1.100     bisitz    569:                        .'</p></form>'
                    570:         );
1.12      foxr      571: 	return;
                    572:     }
                    573:     
                    574: }
1.55      albertel  575: 
1.12      foxr      576: =pod
                    577: 
                    578: =item Delete1
                    579: 
                    580:    Performs phase 1 processing of the delete operation.  In phase one
                    581:   we just check to be sure the file exists.
                    582: 
                    583: Parameters:
                    584: 
                    585: =over 4
                    586: 
1.36      www       587: =item   $request   - Apache Request Object [in] request object for the current 
1.12      foxr      588:                 request.
                    589: 
1.36      www       590: =item   $user      - string [in]  Name of the user initiating the request.
1.12      foxr      591: 
1.36      www       592: =item   $domain    - string [in]  Domain the initiating user is logged in as
1.13      foxr      593: 
1.36      www       594: =item   $filename  - string [in]  Source filename.
1.12      foxr      595: 
                    596: =back
                    597: 
                    598: =cut
                    599: 
                    600: sub Delete1 {
1.55      albertel  601:     my ($request, $user, $domain, $fn) = @_;
1.12      foxr      602: 
1.55      albertel  603:     if( -e $fn) {
                    604: 	$request->print('<input type="hidden" name="newfilename" value="'.
1.95      bisitz    605: 			$fn.'" />');
1.70      raeburn   606:         if (-d $fn) {
                    607:             unless (&empty_directory($fn,'Delete1')) {
1.100     bisitz    608:                 $request->print('<p>'
                    609:                                .'<span class="LC_error">'
                    610:                                .&mt('Only empty directories may be deleted.')
                    611:                                .'</span><br />'
                    612:                                .&mt('You must delete the contents of the directory first.')
                    613:                                .'</p>'
                    614:                                .'<p><a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>'
                    615:                 );
1.70      raeburn   616:                 return;
                    617:             }
                    618:         } else { 
                    619: 	    unless (&obsolete_unpub($user,$domain,$fn)) {
1.100     bisitz    620:                 $request->print('<p><span class="LC_error">'
                    621:                                .&mt('Cannot delete non-obsolete published file.')
                    622:                                .'</span><br />'
                    623:                                .'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>'
                    624:                 );
1.70      raeburn   625: 	        return;
                    626: 	    }
                    627:         }
1.100     bisitz    628:         $request->print('<p>'
1.103     bisitz    629:                        .&mt('Delete [_1]?',
                    630:                             &display($fn))
1.100     bisitz    631:                        .'</p>'
                    632:         );
1.55      albertel  633: 	&CloseForm1($request, $fn);
                    634:     } else {
1.100     bisitz    635:         $request->print('<p class="LC_error">'
1.103     bisitz    636:                        .&mt('No such file: [_1]',
                    637:                             &display($fn))
1.100     bisitz    638:                        .'</p></form>'
                    639:         );
1.50      www       640:     }
1.12      foxr      641: }
                    642: 
                    643: =pod
                    644: 
                    645: =item Copy1($request, $user, $domain, $filename, $newfilename)
                    646: 
                    647:    Performs phase 1 processing of the construction space copy command.
1.17      harris41  648:    Ensure that the source file exists.  Ensure that a destination exists,
                    649:    also warn if the destination already exists.
1.12      foxr      650: 
                    651: Parameters:
                    652: 
                    653: =over 4
                    654: 
                    655: =item   $request   - Apache Request Object [in] request object for the current 
                    656:                 request.
                    657: 
                    658: =item   $user      - string [in]  Name of the user initiating the request.
                    659: 
                    660: =item   $domain    - string [in]  Domain the initiating user is logged in as
                    661: 
1.36      www       662: =item   $fn  - string [in]  Source filename.
1.12      foxr      663: 
                    664: =item   $newfilename-string [in]  Destination filename.
                    665: 
                    666: =back
                    667: 
                    668: =cut
                    669: 
                    670: sub Copy1 {
1.42      albertel  671:     my ($request, $user, $domain, $fn, $newfilename) = @_;
1.12      foxr      672: 
1.42      albertel  673:     if(-e $fn) {
                    674: 	# is dest a dir
                    675: 	if (-d $newfilename) {
                    676: 	    if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; }
                    677: 	}
                    678: 	if ($newfilename =~ m|/[^\.]+$|) {
                    679: 	    #no extension add on original extension
                    680: 	    if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {	$newfilename.='.'.$1; }
                    681: 	} 
                    682: 	$newfilename=~s://+:/:g; # remove duplicate /
                    683: 	while ($newfilename=~m:/\.\./:) {
                    684: 	    $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
                    685: 	}
                    686: 	$request->print(&checksuffix($fn,$newfilename));
1.83      albertel  687: 	my ($type,$return)=&exists($user, $domain, $newfilename);
1.42      albertel  688: 	$request->print($return);
1.83      albertel  689: 	if ($type eq 'error') {
1.47      sakharuk  690: 	    $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
1.42      albertel  691: 	    return;
                    692: 	}
1.103     bisitz    693:     $request->print(
                    694:         '<input type="hidden" name="newfilename"'
                    695:        .' value="'.$newfilename.'" />'
                    696:        .'<p>'
                    697:        .&mt('Copy [_1] to [_2]?',
                    698:             &display($fn),
                    699:             &display($newfilename))
                    700:        .'</p>'
1.100     bisitz    701:         );
1.42      albertel  702: 	&CloseForm1($request, $fn);
                    703:     } else {
1.100     bisitz    704:         $request->print('<p class="LC_error">'
1.103     bisitz    705:                        .&mt('No such file: [_1]',
                    706:                             &display($fn))
1.100     bisitz    707:                        .'</p></form>'
                    708:         );
1.21      albertel  709:     }
1.19      albertel  710: }
                    711: 
                    712: =pod
                    713: 
1.12      foxr      714: =item NewDir1
                    715:  
                    716:   Does all phase 1 processing of directory creation:
                    717:   Ensures that the user provides a new directory name,
                    718:   and that the directory does not already exist.
                    719: 
                    720: Parameters:
                    721: 
                    722: =over 4
                    723: 
                    724: =item   $request  - Apache Request Object [in] - Server request object for the
1.17      harris41  725:                current url.
1.12      foxr      726: 
                    727: =item   $username - Name of the user that is requesting the directory creation.
                    728: 
1.36      www       729: =item $domain - Domain user is in
                    730: 
                    731: =item   $fn     - source file.
1.12      foxr      732: 
                    733: =item   $newdir   - Name of the directory to be created; path relative to the 
                    734:                top level of construction space.
                    735: =back
                    736: 
                    737: Side Effects:
                    738: 
                    739: =over 4
                    740: 
                    741: =item A new form is displayed.  Clicking on the confirmation button
                    742: causes the newdir operation to transition into phase 2.  The hidden field
                    743: "newfilename" is set with the construction space path to the new directory.
                    744: 
                    745: 
                    746: =back
                    747: 
                    748: =cut
                    749: 
                    750: 
1.55      albertel  751: sub NewDir1 {
                    752:     my ($request, $username, $domain, $fn, $newfilename, $mode) = @_;
                    753: 
1.85      albertel  754:     my ($type, $result)=&exists($username,$domain,$newfilename,'directory');
1.83      albertel  755:     $request->print($result);
1.85      albertel  756:     if ($type eq 'error') {
1.83      albertel  757: 	$request->print('</form>');
1.55      albertel  758:     } else {
1.104   ! raeburn   759: 	if (($mode eq 'testbank') || ($mode eq 'imsimport')) {
        !           760: 	    $request->print('<input type="hidden" name="callingmode" value="'.$mode.'" />'."\n".
        !           761:                             '<input type="hidden" name="inhibitmenu" value="yes" />');
1.55      albertel  762: 	}
1.100     bisitz    763:         $request->print('<input type="hidden" name="newfilename" value="'
                    764:                        .$newfilename.'" />'
                    765:                        .'<p>'
1.103     bisitz    766:                        .&mt('Make new directory [_1]?',
                    767:                             &display($newfilename))
1.100     bisitz    768:                        .'</p>'
                    769:         );
1.55      albertel  770: 	&CloseForm1($request, $fn);
                    771:     }
1.12      foxr      772: }
                    773: 
1.44      taceyjo1  774: 
                    775: sub Decompress1 {
1.55      albertel  776:     my ($request, $user, $domain, $fn) = @_;
                    777:     if( -e $fn) {
1.95      bisitz    778:    	$request->print('<input type="hidden" name="newfilename" value="'.$fn.'" />');
1.100     bisitz    779:    	$request->print('<p>'
1.103     bisitz    780:                    .&mt('Decompress [_1]?',
                    781:                         &display($fn))
1.100     bisitz    782:                    .'</p>'
                    783:     );
1.44      taceyjo1  784:    	&CloseForm1($request, $fn);
1.55      albertel  785:     } else {
1.100     bisitz    786:         $request->print('<p class="LC_error">'
1.103     bisitz    787:                        .&mt('No such file: [_1]',
                    788:                             &display($fn))
1.100     bisitz    789:                        .'</p></form>'
                    790:         );
1.55      albertel  791:     }
1.44      taceyjo1  792: }
1.55      albertel  793: 
1.12      foxr      794: =pod
                    795: 
1.22      albertel  796: =item NewFile1
                    797:  
                    798:   Does all phase 1 processing of file creation:
                    799:   Ensures that the user provides a new filename, adds proper extension
                    800:   if needed and that the file does not already exist, if it is a html,
                    801:   problem, page, or sequence, it then creates a form link to hand the
                    802:   actual creation off to the proper handler.
                    803: 
                    804: Parameters:
                    805: 
                    806: =over 4
                    807: 
                    808: =item   $request  - Apache Request Object [in] - Server request object for the
                    809:                current url.
                    810: 
                    811: =item   $username - Name of the user that is requesting the directory creation.
                    812: 
                    813: =item   $domain   - Name of the domain of the user
                    814: 
1.36      www       815: =item   $fn      - Source file name
1.22      albertel  816: 
                    817: =item   $newfilename
                    818:                   - Name of the file to be created; no path information
                    819: =back
                    820: 
                    821: Side Effects:
                    822: 
                    823: =over 4
                    824: 
                    825: =item 2 new forms are displayed.  Clicking on the confirmation button
                    826: causes the browser to attempt to load the specfied URL, allowing the
1.36      www       827: proper handler to take care of file creation. There is also a Cancel
1.22      albertel  828: button which returns you to the driectory listing you came from
                    829: 
                    830: =back
                    831: 
                    832: =cut
                    833: 
                    834: sub NewFile1 {
1.36      www       835:     my ($request, $user, $domain, $fn, $newfilename) = @_;
1.96      raeburn   836:     return if (&filename_check($newfilename) ne 'ok');
1.22      albertel  837: 
1.67      albertel  838:     if ($env{'form.action'} =~ /new(.+)file/) {
1.22      albertel  839: 	my $extension=$1;
                    840: 	if ($newfilename !~ /\Q.$extension\E$/) {
1.81      albertel  841: 	    if ($newfilename =~ m|/[^/.]*\.(?:[^/.]+)$|) {
1.26      albertel  842: 		#already has an extension strip it and add in expected one
1.81      albertel  843: 		$newfilename =~ s|(/[^./])\.(?:[^.]+)$|$1|;
1.26      albertel  844: 	    }
1.22      albertel  845: 	    $newfilename.=".$extension";
                    846: 	}
1.31      albertel  847:     }
1.83      albertel  848:     my ($type, $result)=&exists($user,$domain,$newfilename);
                    849:     $request->print($result);
                    850:     if ($type eq 'error') {
                    851: 	$request->print('</form>');
1.39      www       852:     } else {
1.96      raeburn   853:         my $extension;
                    854: 
                    855:         if ($newfilename =~ m{[^/.]+\.([^/.]+)$}) {
                    856:             $extension = $1;
                    857:         }
                    858: 
1.102     raeburn   859:         my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty task library js css txt);
1.96      raeburn   860:         if (($extension eq '') || (!grep(/^\Q$extension\E/,@okexts))) {
                    861:             my $validexts = '.'.join(', .',@okexts);
                    862:             $request->print('<p class="LC_warning">'.
                    863:                 &mt('Invalid filename: ').&display($newfilename).'</p><p>'.
                    864:                 &mt('The name of the new file needs to end with an appropriate file extension to indicate the type of file to create.').'<br />'.
                    865:                 &mt('The following are valid extensions: [_1].',$validexts).
                    866:                 '</p></form><p>'.
                    867: 		'<form name="fileaction" action="/adm/cfile" method="post">'.
                    868:                 '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
                    869: 		'<input type="hidden" name="action" value="newfile" />'.
                    870: 	        '<span class ="LC_nobreak">'.&mt('Enter a file name: ').'<input type="text" name="newfilename" value="Type Name Here" onfocus="if (this.value == '."'Type Name Here') this.value=''".'" />&nbsp;<input type="submit" value="Go" />'.
                    871:                 '</span></form></p>'.
                    872:                 '<p><form action="'.&url($fn).
1.97      bisitz    873:                 '" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>');
1.96      raeburn   874:             return;
                    875:         }
                    876: 
1.47      sakharuk  877: 	$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');
1.22      albertel  878: 	$request->print('</form>');
1.96      raeburn   879: 
1.36      www       880: 	$request->print('<form action="'.&url($newfilename).
1.97      bisitz    881: 			'" method="post"><p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
1.36      www       882: 	$request->print('<form action="'.&url($fn).
1.97      bisitz    883: 			'" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
1.22      albertel  884:     }
1.96      raeburn   885:     return;
                    886: }
                    887: 
                    888: sub filename_check {
                    889:     my ($newfilename) = @_;
                    890:     ##Informs User (name).(number).(extension) not allowed
                    891:     if($newfilename =~ /\.(\d+)\.(\w+)$/){
                    892:         $r->print('<span class="LC_error">'.$newfilename.
                    893:                   ' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '.
                    894:                   ' '.&mt('Not Allowed').'</span>');
                    895:         return;
                    896:     }
                    897:     if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){
                    898:         $r->print('<span class="LC_error">'.$newfilename.
                    899:                   ' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '.
                    900:                   ' '.&mt('Not Allowed').'</span>');
                    901:         return;
                    902:     }
                    903:     return 'ok'; 
1.22      albertel  904: }
                    905: 
                    906: =pod
                    907: 
1.12      foxr      908: =item phaseone($r, $fn, $uname, $udom)
                    909: 
                    910:   Peforms phase one processing of the request.  In phase one, error messages
                    911: are returned if the request cannot be performed (e.g. attempts to manipulate
                    912: files that are nonexistent).  If the operation can be performed, what is
                    913: about to be done will be presented to the user for confirmation.  If the
                    914: user confirms the request, then phase two is executed, the action 
                    915: performed and reported to the user.
                    916: 
                    917:  Parameters:
                    918: 
                    919: =over 4
                    920: 
                    921: =item $r  - request object [in] - The Apache request being executed.
                    922: 
                    923: =item $fn = string [in] - The filename being manipulated by the 
                    924:                              request.
                    925: 
                    926: =item $uname - string [in] Name of user logged in and doing this action.
                    927: 
1.17      harris41  928: =item $udom  - string [in] Domain name under which the user logged in. 
1.12      foxr      929: 
                    930: =back
                    931: 
                    932: =cut
1.8       albertel  933: 
1.1       www       934: sub phaseone {
1.55      albertel  935:     my ($r,$fn,$uname,$udom)=@_;
1.12      foxr      936:   
1.58      albertel  937:     my $doingdir=0;
1.67      albertel  938:     if ($env{'form.action'} eq 'newdir') { $doingdir=1; }
                    939:     my $newfilename=&cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname);
1.55      albertel  940:     $newfilename=&relativeDest($fn,$newfilename,$uname);
                    941:     $r->print('<form action="/adm/cfile" method="post">'.
                    942: 	      '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
                    943: 	      '<input type="hidden" name="phase" value="two" />'.
1.67      albertel  944: 	      '<input type="hidden" name="action" value="'.$env{'form.action'}.'" />');
1.12      foxr      945:   
1.67      albertel  946:     if ($env{'form.action'} eq 'rename') {
1.55      albertel  947: 	&Rename1($r, $uname, $udom, $fn, $newfilename, 'rename');
1.67      albertel  948:     } elsif ($env{'form.action'} eq 'move') {
1.55      albertel  949: 	&Rename1($r, $uname, $udom, $fn, $newfilename, 'move');
1.67      albertel  950:     } elsif ($env{'form.action'} eq 'delete') { 
1.55      albertel  951: 	&Delete1($r, $uname, $udom, $fn);
1.67      albertel  952:     } elsif ($env{'form.action'} eq 'decompress') {
1.55      albertel  953: 	&Decompress1($r, $uname, $udom, $fn);
1.67      albertel  954:     } elsif ($env{'form.action'} eq 'copy') { 
1.55      albertel  955: 	if($newfilename) {
                    956: 	    &Copy1($r, $uname, $udom, $fn, $newfilename);
                    957: 	} else {
1.100     bisitz    958:             $r->print('<p class="LC_error">'
                    959:                      .&mt('No new filename specified.')
                    960:                      .'</p></form>'
                    961:             );
1.55      albertel  962: 	}
1.67      albertel  963:     } elsif ($env{'form.action'} eq 'newdir') {
1.55      albertel  964: 	my $mode = '';
1.67      albertel  965: 	if (exists($env{'form.callingmode'}) ) {
                    966: 	    $mode = $env{'form.callingmode'};
1.55      albertel  967: 	}   
                    968: 	&NewDir1($r, $uname, $udom, $fn, $newfilename, $mode);
1.67      albertel  969:     }  elsif ($env{'form.action'} eq 'newfile' ||
                    970: 	      $env{'form.action'} eq 'newhtmlfile' ||
                    971: 	      $env{'form.action'} eq 'newproblemfile' ||
                    972: 	      $env{'form.action'} eq 'newpagefile' ||
                    973: 	      $env{'form.action'} eq 'newsequencefile' ||
                    974: 	      $env{'form.action'} eq 'newrightsfile' ||
                    975: 	      $env{'form.action'} eq 'newstyfile' ||
1.86      albertel  976: 	      $env{'form.action'} eq 'newtaskfile' ||
1.67      albertel  977:               $env{'form.action'} eq 'newlibraryfile' ||
                    978: 	      $env{'form.action'} eq 'Select Action') {
1.65      www       979:         my $empty=&mt('Type Name Here');
                    980: 	if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) {
1.55      albertel  981: 	    &NewFile1($r, $uname, $udom, $fn, $newfilename);
                    982: 	} else {
1.100     bisitz    983:             $r->print('<p class="LC_error">'
                    984:                      .&mt('No new filename specified.')
                    985:                      .'</p></form>'
                    986:             );
1.55      albertel  987: 	}
                    988:     }
1.12      foxr      989: }
                    990: 
                    991: =pod
                    992: 
                    993: =item Rename2($request, $user, $directory, $oldfile, $newfile)
                    994: 
1.17      harris41  995: Performs phase 2 processing of a rename reequest.   This is where the
1.12      foxr      996: actual rename is performed.
                    997: 
                    998: Parameters
                    999: 
                   1000: =over 4
                   1001: 
                   1002: =item $request - Apache request object [in] The request being processed.
                   1003: 
                   1004: =item $user  - string [in] The name of the user initiating the request.
                   1005: 
                   1006: =item $directory - string [in] The name of the directory relative to the
                   1007:                  construction space top level of the renamed file.
                   1008: 
                   1009: =item $oldfile - Name of the file.
                   1010: 
                   1011: =item $newfile - Name of the new file.
                   1012: 
                   1013: =back
                   1014: 
                   1015: Returns:
                   1016: 
                   1017: =over 4
                   1018: 
                   1019: =item 1 Success.
                   1020: 
                   1021: =item 0 Failure.
                   1022: 
                   1023: =cut
                   1024: 
                   1025: sub Rename2 {
                   1026: 
1.55      albertel 1027:     my ($request, $user, $directory, $oldfile, $newfile) = @_;
1.12      foxr     1028: 
1.55      albertel 1029:     &Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile.
                   1030: 	   " new file ".$newfile."\n");
                   1031:     &Debug($request, "Target is: ".$directory.'/'.
                   1032: 	   $newfile);
                   1033:     if (-e $oldfile) {
                   1034: 
                   1035: 	my $oRN=$oldfile;
                   1036: 	my $nRN=$newfile;
                   1037: 	unless (rename($oldfile,$newfile)) {
1.83      albertel 1038: 	    $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
1.55      albertel 1039: 	    return 0;
                   1040: 	}
                   1041: 	## If old name.(extension) exits, move under new name.
                   1042: 	## If it doesn't exist and a new.(extension) exists  
                   1043: 	## delete it (only concern when renaming over files)
                   1044: 	my $tmp1=$oRN.'.meta';
                   1045: 	my $tmp2=$nRN.'.meta';
                   1046: 	if(-e $tmp1){
                   1047: 	    unless(rename($tmp1,$tmp2)){ }
                   1048: 	} elsif(-e $tmp2){
                   1049: 	    unlink $tmp2;
                   1050: 	}
                   1051: 	$tmp1=$oRN.'.save';
                   1052: 	$tmp2=$nRN.'.save';
                   1053: 	if(-e $tmp1){
                   1054: 	    unless(rename($tmp1,$tmp2)){ }
                   1055: 	} elsif(-e $tmp2){
                   1056: 	    unlink $tmp2;
                   1057: 	}
                   1058: 	$tmp1=$oRN.'.log';
                   1059: 	$tmp2=$nRN.'.log';
                   1060: 	if(-e $tmp1){
                   1061: 	    unless(rename($tmp1,$tmp2)){ }
                   1062: 	} elsif(-e $tmp2){
                   1063: 	    unlink $tmp2;
                   1064: 	}
                   1065: 	$tmp1=$oRN.'.bak';
                   1066: 	$tmp2=$nRN.'.bak';
                   1067: 	if(-e $tmp1){
                   1068: 	    unless(rename($tmp1,$tmp2)){ }
                   1069: 	} elsif(-e $tmp2){
                   1070: 	    unlink $tmp2;
                   1071: 	}
                   1072:     } else {
1.103     bisitz   1073:         $request->print(
                   1074:             '<p>'
                   1075:            .&mt('No such file: [_1]',
                   1076:                 &display($oldfile))
                   1077:            .'</p></form>'
1.100     bisitz   1078:         );
1.55      albertel 1079: 	return 0;
                   1080:     }
                   1081:     return 1;
1.12      foxr     1082: }
1.55      albertel 1083: 
1.12      foxr     1084: =pod
                   1085: 
                   1086: =item Delete2($request, $user, $filename)
                   1087: 
                   1088:   Performs phase two of a delete.  The user has confirmed that they want 
                   1089: to delete the selected file.   The file is deleted and the results of the
                   1090: delete attempt are indicated.
                   1091: 
                   1092: Parameters:
                   1093: 
                   1094: =over 4
                   1095: 
                   1096: =item $request - Apache Request object [in] the request object for the current
                   1097:                  delete operation.
                   1098: 
                   1099: =item $user    - string [in]  The name of the user initiating the delete
                   1100:                  request.
                   1101: 
1.17      harris41 1102: =item $filename - string [in] The name of the file, relative to construction
                   1103:                   space, to delete.
1.12      foxr     1104: 
                   1105: =back
                   1106: 
                   1107: Returns:
                   1108:   1 - success.
                   1109:   0 - Failure.
                   1110: 
                   1111: =cut
                   1112: 
                   1113: sub Delete2 {
1.55      albertel 1114:     my ($request, $user, $filename) = @_;
1.70      raeburn  1115:     if (-d $filename) { 
                   1116: 	unless (&empty_directory($filename,'Delete2')) { 
1.83      albertel 1117: 	    $request->print('<span class="LC_error">'.&mt('Error: Directory Non Empty').'</span>'); 
1.55      albertel 1118: 	    return 0;
                   1119: 	} else {   
                   1120: 	    if(-e $filename) {
                   1121: 		unless(rmdir($filename)) {
1.83      albertel 1122: 		    $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
1.55      albertel 1123: 		    return 0;
                   1124: 		}
                   1125: 	    } else {
1.100     bisitz   1126:         	$request->print('<p class="LC_error">'.&mt('No such file').'</p></form>');
1.55      albertel 1127: 		return 0;
                   1128: 	    }
                   1129: 	}
1.48      taceyjo1 1130:     } else {
1.55      albertel 1131: 	if(-e $filename) {
                   1132: 	    unless(unlink($filename)) {
1.83      albertel 1133: 		$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
1.55      albertel 1134: 		return 0;
                   1135: 	    }
                   1136: 	} else {
1.100     bisitz   1137:             $request->print('<p class="LC_error">'.&mt('No such file').'</p></form>');
1.55      albertel 1138: 	    return 0;
1.46      taceyjo1 1139: 	}
1.55      albertel 1140:     }
                   1141:     return 1;
1.12      foxr     1142: }
                   1143: 
                   1144: =pod
                   1145: 
                   1146: =item Copy2($request, $username, $dir, $oldfile, $newfile)
                   1147: 
                   1148:    Performs phase 2 of a copy.  The file is copied and the status 
                   1149:    of that copy is reported back to the user.
                   1150: 
                   1151: =over 4
                   1152: 
                   1153: =item $request - Apache request object [in]; the apache request currently
                   1154:                  being executed.
                   1155: 
                   1156: =item $username - string [in] Name of the user who is requesting the copy.
                   1157: 
                   1158: =item $dir - string [in] Directory path relative to the construction space
                   1159:              of the destination file.
                   1160: 
                   1161: =item $oldfile - string [in] Name of the source file.
                   1162: 
                   1163: =item $newfile - string [in] Name of the destination file.
                   1164: 
                   1165: 
                   1166: =back
                   1167: 
1.71      raeburn  1168: Returns 0 failure, and 1 successs.
1.12      foxr     1169: 
                   1170: =cut
1.1       www      1171: 
1.12      foxr     1172: sub Copy2 {
                   1173:     my ($request, $username, $dir, $oldfile, $newfile) = @_;
                   1174:     &Debug($request ,"Will try to copy $oldfile to $newfile");
                   1175:     if(-e $oldfile) {
1.71      raeburn  1176:         if ($oldfile eq $newfile) {
1.83      albertel 1177:             $request->print('<span class="LC_error">'.&mt('Warning').': '.&mt('Name of new file is the same as name of old file').' - '.&mt('no action taken').'.</span>');
1.71      raeburn  1178:             return 1;
                   1179:         }
1.12      foxr     1180: 	unless (copy($oldfile, $newfile)) {
1.83      albertel 1181: 	    $request->print('<span class="LC_error">'.&mt('copy Error').': '.$!.'</span>');
1.12      foxr     1182: 	    return 0;
1.61      albertel 1183: 	} elsif (!chmod(0660, $newfile)) {
1.83      albertel 1184: 	    $request->print('<span class="LC_error">'.&mt('chmod error').': '.$!.'</span>');
1.61      albertel 1185: 	    return 0;
                   1186: 	} elsif (-e $oldfile.'.meta' && 
                   1187: 		 !copy($oldfile.'.meta', $newfile.'.meta') &&
                   1188: 		 !chmod(0660, $newfile.'.meta')) {
1.83      albertel 1189: 	    $request->print('<span class="LC_error">'.&mt('copy metadata error').
                   1190: 			    ': '.$!.'</span>');
1.61      albertel 1191: 	    return 0;
1.12      foxr     1192: 	} else {
                   1193: 	    return 1;
                   1194: 	}
1.11      albertel 1195:     } else {
1.100     bisitz   1196:         $request->print('<p class="LC_error">'.&mt('No such file').'</p>');
1.12      foxr     1197: 	return 0;
1.11      albertel 1198:     }
1.12      foxr     1199:     return 1;
                   1200: }
1.55      albertel 1201: 
1.12      foxr     1202: =pod
                   1203: 
                   1204: =item NewDir2($request, $user, $newdirectory)
1.1       www      1205: 
1.12      foxr     1206: 	Performs phase 2 processing of directory creation.  This involves creating the directory and
                   1207: 	reporting the results of that creation to the user.
                   1208: 	
                   1209: Parameters:
                   1210: =over 4
                   1211: 
                   1212: =item $request  - Apache request object [in].  Object representing the current HTTP request.
                   1213: 
                   1214: =item $user - string [in] The name of the user that is initiating the request.
                   1215: 
                   1216: =item $newdirectory - string [in] The full path of the directory being created.
                   1217: 
                   1218: =back
                   1219: 
                   1220: Returns 0 - failure 1 - success.
                   1221: 
                   1222: =cut
1.8       albertel 1223: 
1.12      foxr     1224: sub NewDir2 {
1.55      albertel 1225:     my ($request, $user, $newdirectory) = @_;
1.12      foxr     1226:   
1.55      albertel 1227:     unless(mkdir($newdirectory, 02770)) {
1.83      albertel 1228: 	$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
1.55      albertel 1229: 	return 0;
                   1230:     }
                   1231:     unless(chmod(02770, ($newdirectory))) {
1.83      albertel 1232: 	$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
1.55      albertel 1233: 	return 0;
                   1234:     }
                   1235:     return 1;
1.1       www      1236: }
1.55      albertel 1237: 
1.44      taceyjo1 1238: sub decompress2 {
1.55      albertel 1239:     my ($r, $user, $dir, $file) = @_;
1.88      raeburn  1240:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   1241:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
1.55      albertel 1242:     my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   1243:     $r->print($result);
                   1244:     &Apache::lonnet::delenv('cgi.file');
                   1245:     &Apache::lonnet::delenv('cgi.dir');
                   1246:     return 1;
1.44      taceyjo1 1247: }
1.55      albertel 1248: 
1.12      foxr     1249: =pod
                   1250: 
                   1251: =item phasetwo($r, $fn, $uname, $udom)
                   1252: 
                   1253:    Controls the phase 2 processing of file management
                   1254:    requests for construction space.  In phase one, the user
                   1255:    was asked to confirm the operation.  In phase 2, the operation
                   1256:    is performed and the result is shown.
                   1257: 
                   1258:   The strategy is to break out the processing into specific action processors
                   1259:   named action2 where action is the requested action and the 2 denotes 
                   1260:   phase 2 processing.
                   1261: 
                   1262: Parameters:
                   1263: 
                   1264: =over 4
                   1265: 
                   1266: =item  $r     - Apache Request object [in] The request object for this httpd
                   1267:            transaction.
                   1268: 
                   1269: =item  $fn    - string [in]  A filename indicating the object that is being
                   1270:            manipulated.
                   1271: 
                   1272: =item  $uname - string [in] The name of the user initiating the file management
                   1273:            request.
                   1274: 
                   1275: =item  $udom  - string  [in] The login domain of the user initiating the
                   1276:            file management request.
                   1277: =back
                   1278: 
                   1279: =cut
                   1280: 
1.1       www      1281: sub phasetwo {
                   1282:     my ($r,$fn,$uname,$udom)=@_;
1.12      foxr     1283:     
1.9       foxr     1284:     &Debug($r, "loncfile - Entering phase 2 for $fn");
1.12      foxr     1285:     
1.78      banghart 1286:     # Break down the file into its component pieces.
1.12      foxr     1287:     
1.27      albertel 1288:     my $dir;		# Directory path
                   1289:     my $main;		# Filename.
                   1290:     my $suffix;		# Extension.
1.46      taceyjo1 1291:     if ($fn=~m:(.*)/([^/]+):) {
1.27      albertel 1292: 	$dir=$1;		# Directory path
                   1293: 	$main=$2;		# Filename.
1.54      albertel 1294:     }
                   1295:     if($main=~m:\.(\w+)$:){ # Fixes problems with filenames with no extensions
1.68      albertel 1296: 	$suffix=$1; #This is the actually filename extension if it exists
1.66      albertel 1297: 	$main=~s/\.\w+$//; #strip the extension
1.54      albertel 1298:     }
1.79      banghart 1299:     my $dest;                       #
                   1300:     my $dest_dir;                   # On success this is where we'll go.
                   1301:     my $disp_newname;               #
                   1302:     my $dest_newname;               #
1.55      albertel 1303:     &Debug($r,"loncfile::phase2 dir = $dir main = $main suffix = $suffix");
1.67      albertel 1304:     &Debug($r,"    newfilename = ".$env{'form.newfilename'});
1.9       foxr     1305: 
                   1306:     my $conspace=$fn;
1.12      foxr     1307:     
1.55      albertel 1308:     &Debug($r,"loncfile::phase2 Full construction space name: $conspace");
1.12      foxr     1309:     
1.67      albertel 1310:     &Debug($r,"loncfie::phase2 action is $env{'form.action'}");
1.12      foxr     1311:     
                   1312:     # Select the appropriate processing sub.
1.67      albertel 1313:     if ($env{'form.action'} eq 'decompress') { 
1.66      albertel 1314: 	$main .= '.'.$suffix;
1.55      albertel 1315: 	if(!&decompress2($r, $uname, $dir, $main)) {
                   1316: 	    return ;
                   1317: 	}
                   1318: 	$dest = $dir."/.";
1.67      albertel 1319:     } elsif ($env{'form.action'} eq 'rename' ||
                   1320: 	     $env{'form.action'} eq 'move') {
                   1321: 	if($env{'form.newfilename'}) {
1.27      albertel 1322: 	    if (!defined($dir)) {
                   1323: 		$fn=~m:^(.*)/:;
1.55      albertel 1324: 		$dir=$1; 
1.27      albertel 1325: 	    }
1.67      albertel 1326: 	    if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) {
1.12      foxr     1327: 		return;
                   1328: 	    }
1.78      banghart 1329: 	    $dest = $dir."/";
1.79      banghart 1330: 	    $dest_newname = $env{'form.newfilename'};
                   1331: 	    $env{'form.newfilename'} =~ /.+(\/.+$)/;
                   1332: 	    $disp_newname = $1;
                   1333: 	    $disp_newname =~ s/\///;
1.12      foxr     1334: 	}
1.67      albertel 1335:     } elsif ($env{'form.action'} eq 'delete') { 
                   1336: 	if(!&Delete2($r, $uname, $env{'form.newfilename'})) {
1.12      foxr     1337: 	    return ;
                   1338: 	}
                   1339: 	# Once a resource is deleted, we just list the directory that
                   1340: 	# previously held it.
                   1341: 	#
1.20      albertel 1342: 	$dest = $dir."/.";		# Parent dir.
1.67      albertel 1343:     } elsif ($env{'form.action'} eq 'copy') { 
                   1344: 	if($env{'form.newfilename'}) {
                   1345: 	    if(!&Copy2($r, $uname, $dir, $fn, $env{'form.newfilename'})) {
1.44      taceyjo1 1346: 		return ;
1.55      albertel 1347: 	    }
1.67      albertel 1348: 	    $dest = $env{'form.newfilename'};
1.55      albertel 1349:      	} else {
1.100     bisitz   1350:             $r->print('<p class="LC_error">'.&mt('No New filename specified').'</p></form>');
1.12      foxr     1351: 	    return;
                   1352: 	}
                   1353: 	
1.67      albertel 1354:     } elsif ($env{'form.action'} eq 'newdir') {
                   1355:         my $newdir= $env{'form.newfilename'};
1.12      foxr     1356: 	if(!&NewDir2($r, $uname, $newdir)) {
                   1357: 	    return;
                   1358: 	}
1.55      albertel 1359: 	$dest = $newdir."/";
1.12      foxr     1360:     }
1.67      albertel 1361:     if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
1.55      albertel 1362: 	$r->print('<h3><a href="javascript:self.close()">'.&mt('Done').'</a></h3>');
1.51      raeburn  1363:     } else {
1.79      banghart 1364:         if ($env{'form.action'} eq 'rename') {
                   1365:             $r->print('<h3><a href="'.&url($dest).'">'.&mt('Return to Directory').'</a></h3>');
                   1366:             $r->print('<h3><a href="'.&url($dest_newname).'">'.$disp_newname.'</a></h3>');
                   1367:         } else {
1.89      www      1368: 	    $r->print(&done(&url($dest)));
1.79      banghart 1369: 	}
1.51      raeburn  1370:     }
1.1       www      1371: }
                   1372: 
                   1373: sub handler {
                   1374: 
1.55      albertel 1375:     $r=shift;
1.1       www      1376: 
1.60      www      1377:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress','action','filename','newfilename']);
1.9       foxr     1378: 
1.55      albertel 1379:     &Debug($r, "loncfile.pm - handler entered");
1.67      albertel 1380:     &Debug($r, " filename: ".$env{'form.filename'});
                   1381:     &Debug($r, " newfilename: ".$env{'form.newfilename'});
1.36      www      1382: #
                   1383: # Determine the root filename
                   1384: # This could come in as "filename", which actually is a URL, or
                   1385: # as "qualifiedfilename", which is indeed a real filename in filesystem
                   1386: #
1.55      albertel 1387:     my $fn;
1.1       www      1388: 
1.67      albertel 1389:     if ($env{'form.filename'}) {
                   1390: 	&Debug($r, "test: $env{'form.filename'}");
1.77      www      1391: 	$fn=&unescape($env{'form.filename'});
1.55      albertel 1392: 	$fn=&URLToPath($fn);
1.67      albertel 1393:     }  elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') {  
1.55      albertel 1394: 	#Just hijack the script only the first time around to inject the
                   1395: 	#correct information for further processing
1.77      www      1396: 	$fn=&unescape($env{'form.decompress'});
1.44      taceyjo1 1397: 	$fn=&URLToPath($fn);
1.67      albertel 1398: 	$env{'form.action'}="decompress";
                   1399:     } elsif ($env{'form.qualifiedfilename'}) {
                   1400: 	$fn=$env{'form.qualifiedfilename'};
1.55      albertel 1401:     } else {
                   1402: 	&Debug($r, "loncfile::handler - no form.filename");
1.67      albertel 1403: 	$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1.55      albertel 1404: 		       ' unspecified filename for cfile', $r->filename); 
                   1405: 	return HTTP_NOT_FOUND;
                   1406:     }
1.44      taceyjo1 1407: 
1.55      albertel 1408:     unless ($fn) { 
                   1409: 	&Debug($r, "loncfile::handler - doctored url is empty");
1.67      albertel 1410: 	$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1.55      albertel 1411: 		       ' trying to cfile non-existing file', $r->filename); 
                   1412: 	return HTTP_NOT_FOUND;
                   1413:     } 
1.1       www      1414: 
                   1415: # ----------------------------------------------------------- Start page output
1.55      albertel 1416:     my $uname;
                   1417:     my $udom;
                   1418: 
                   1419:     ($uname,$udom)=
                   1420: 	&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
                   1421:     &Debug($r, 
                   1422: 	   "loncfile::handler constructaccess uname = $uname domain = $udom");
                   1423:     unless (($uname) && ($udom)) {
                   1424: 	$r->log_reason($uname.' at '.$udom.
1.67      albertel 1425: 		       ' trying to manipulate file '.$env{'form.filename'}.
1.55      albertel 1426: 		       ' ('.$fn.') - not authorized', 
                   1427: 		       $r->filename); 
                   1428: 	return HTTP_NOT_ACCEPTABLE;
                   1429:     }
                   1430: 
1.1       www      1431: 
1.55      albertel 1432:     &Apache::loncommon::content_type($r,'text/html');
                   1433:     $r->send_http_header;
                   1434: 
1.75      albertel 1435:     my (%loaditem,$js);
                   1436: 
1.67      albertel 1437:     if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
                   1438: 	my $newdirname = $env{'form.newfilename'};
1.75      albertel 1439: 	$js = qq|
                   1440: <script type="text/javascript">
1.51      raeburn  1441: function writeDone() {
                   1442:     window.focus();
1.90      raeburn  1443:     opener.document.info.newdir.value = "$newdirname";
                   1444:     setTimeout("self.close()",10000);
1.51      raeburn  1445: }
                   1446:   </script>
1.75      albertel 1447: |;
1.76      albertel 1448: 	$loaditem{'onload'} = "writeDone()";
1.55      albertel 1449:     }
1.75      albertel 1450:     
1.99      bisitz   1451:     # Breadcrumbs
                   1452:     &Apache::lonhtmlcommon::clear_breadcrumbs();
                   1453:     &Apache::lonhtmlcommon::add_breadcrumb({
                   1454:         'text'  => 'Construction Space',
1.101     bisitz   1455:         'href'  => &Apache::loncommon::authorspace(),
1.99      bisitz   1456:     });
                   1457:     &Apache::lonhtmlcommon::add_breadcrumb({
                   1458:         'text'  => 'File Operation',
                   1459:         'title' => 'Construction Space File Operation',
                   1460:         'href'  => '',
                   1461:     });
                   1462: 
1.75      albertel 1463:     $r->print(&Apache::loncommon::start_page('Construction Space File Operation',
                   1464: 					     $js,
1.99      bisitz   1465: 					     {'add_entries' => \%loaditem,})
                   1466:              .&Apache::lonhtmlcommon::breadcrumbs()
                   1467:              .&Apache::loncommon::head_subbox(
                   1468:                   &Apache::loncommon::CSTR_pageheader())
                   1469:     );
1.1       www      1470:   
1.55      albertel 1471:     $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
1.1       www      1472:   
1.67      albertel 1473:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.94      bisitz   1474:         $r->print('<p class="LC_warning">'
1.98      bisitz   1475:                  .&mt('Co-Author [_1]',$uname.':'.$udom)
1.94      bisitz   1476:                  .'</p>'
                   1477:         );
1.55      albertel 1478:     }
                   1479: 
                   1480: 
1.67      albertel 1481:     &Debug($r, "loncfile::handler Form action is $env{'form.action'} ");
                   1482:     if ($env{'form.action'} eq 'delete') {
1.55      albertel 1483:       	$r->print('<h3>'.&mt('Delete').'</h3>');
1.67      albertel 1484:     } elsif ($env{'form.action'} eq 'rename') {
1.55      albertel 1485: 	$r->print('<h3>'.&mt('Rename').'</h3>');
1.67      albertel 1486:     } elsif ($env{'form.action'} eq 'move') {
1.55      albertel 1487: 	$r->print('<h3>'.&mt('Move').'</h3>');
1.67      albertel 1488:     } elsif ($env{'form.action'} eq 'newdir') {
1.55      albertel 1489: 	$r->print('<h3>'.&mt('New Directory').'</h3>');
1.67      albertel 1490:     } elsif ($env{'form.action'} eq 'decompress') {
1.55      albertel 1491: 	$r->print('<h3>'.&mt('Decompress').'</h3>');
1.67      albertel 1492:     } elsif ($env{'form.action'} eq 'copy') {
1.55      albertel 1493: 	$r->print('<h3>'.&mt('Copy').'</h3>');
1.67      albertel 1494:     } elsif ($env{'form.action'} eq 'newfile' ||
                   1495: 	     $env{'form.action'} eq 'newhtmlfile' ||
                   1496: 	     $env{'form.action'} eq 'newproblemfile' ||
                   1497: 	     $env{'form.action'} eq 'newpagefile' ||
                   1498: 	     $env{'form.action'} eq 'newsequencefile' ||
                   1499: 	     $env{'form.action'} eq 'newrightsfile' ||
                   1500: 	     $env{'form.action'} eq 'newstyfile' ||
1.86      albertel 1501: 	     $env{'form.action'} eq 'newtaskfile' ||
1.67      albertel 1502:              $env{'form.action'} eq 'newlibraryfile' ||
                   1503: 	     $env{'form.action'} eq 'Select Action' ) {
1.55      albertel 1504: 	$r->print('<h3>'.&mt('New Resource').'</h3>');
                   1505:     } else {
1.100     bisitz   1506:         $r->print('<p class="LC_error">'
                   1507:                  .&mt('Unknown Action').' '.$env{'form.action'}
                   1508:                  .'</p>'
                   1509:                  .&Apache::loncommon::end_page()
                   1510:         );
1.55      albertel 1511: 	return OK;  
                   1512:     }
1.67      albertel 1513:     if ($env{'form.phase'} eq 'two') {
1.55      albertel 1514: 	&Debug($r, "loncfile::handler  entering phase2");
                   1515: 	&phasetwo($r,$fn,$uname,$udom);
                   1516:     } else {
                   1517: 	&Debug($r, "loncfile::handler  entering phase1");
                   1518: 	&phaseone($r,$fn,$uname,$udom);
                   1519:     }
1.1       www      1520: 
1.75      albertel 1521:     $r->print(&Apache::loncommon::end_page());
1.55      albertel 1522:     return OK;  
1.1       www      1523: }
                   1524: 
                   1525: 1;
                   1526: __END__
1.9       foxr     1527: 

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