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