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