1:
2: # The LearningOnline Network with CAPA
3: # Handler to upload files into construction space
4: #
5: # $Id: lonupload.pm,v 1.22 2003/11/08 11:04:52 albertel Exp $
6: #
7: # Copyright Michigan State University Board of Trustees
8: #
9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
10: #
11: # LON-CAPA is free software; you can redistribute it and/or modify
12: # it under the terms of the GNU General Public License as published by
13: # the Free Software Foundation; either version 2 of the License, or
14: # (at your option) any later version.
15: #
16: # LON-CAPA is distributed in the hope that it will be useful,
17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19: # GNU General Public License for more details.
20: #
21: # You should have received a copy of the GNU General Public License
22: # along with LON-CAPA; if not, write to the Free Software
23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
24: #
25: # /home/httpd/html/adm/gpl.txt
26: #
27: # http://www.lon-capa.org/
28: #
29: ###
30:
31: package Apache::lonupload;
32:
33: use strict;
34: use Apache::File;
35: use File::Copy;
36: use File::Basename;
37: use Apache::Constants qw(:common :http :methods);
38: use Apache::loncacc;
39: use Apache::loncommon();
40: use Apache::Log();
41: use Apache::lonnet;
42: use HTML::Entities();
43: use Apache::lonlocal;
44:
45: my $DEBUG=0;
46:
47: sub Debug {
48:
49: # Marshall the parameters.
50:
51: my $r = shift;
52: my $log = $r->log;
53: my $message = shift;
54:
55: # Put out the indicated message butonly if DEBUG is false.
56:
57: if ($DEBUG) {
58: $log->debug($message);
59: }
60: }
61:
62: sub upfile_store {
63: my $r=shift;
64:
65: my $fname=$ENV{'form.upfile.filename'};
66: $fname=~s/\W//g;
67:
68: chomp($ENV{'form.upfile'});
69:
70: my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
71: '_upload_'.$fname.'_'.time.'_'.$$;
72: {
73: my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
74: '/tmp/'.$datatoken.'.tmp');
75: print $fh $ENV{'form.upfile'};
76: }
77: return $datatoken;
78: }
79:
80:
81: sub phaseone {
82: my ($r,$fn,$uname,$udom)=@_;
83: $ENV{'form.upfile.filename'}=~s/\\/\//g;
84: $ENV{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
85: if ($ENV{'form.upfile.filename'}) {
86: $fn=~s/\/[^\/]+$//;
87: $fn=~s/([^\/])$/$1\//;
88: $fn.=$ENV{'form.upfile.filename'};
89: $fn=~s/^\///;
90: $fn=~s/(\/)+/\//g;
91:
92: # Fn is the full path to the destination filename.
93: #
94:
95: &Debug($r, "Filename for upload: $fn");
96: if (($fn) && ($fn!~/\/$/)) {
97: $r->print('<form action=/adm/upload method=post>'.
98: '<input type=hidden name=phase value=two>'.
99: '<input type=hidden name=datatoken value="'.
100: &upfile_store.'">'.
101: '<input type=hidden name=uploaduname value="'.$uname.'">'.
102: &mt('Store uploaded file as ')."<tt>/priv/$uname/</tt>".
103: '<input type=text size=50 name=filename value="'.$fn.'"><br>'.
104: '<input type=submit value="'.&mt('Store').'"></form>');
105: # Check for bad extension and warn user
106: if ($fn=~/\.(\w+)$/ &&
107: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
108: $r->print('<font color=red>'.&mt('The extension on this file,').
109: ' "'.$1.'"'.&mt(', is reserved internally by LON-CAPA.').
110: ' <br \>'.&mt('Please change the extension.').'</font>');
111: } elsif($fn=~/\.(\w+)$/ &&
112: !defined(&Apache::loncommon::fileembstyle($1))) {
113: $r->print('<font color=red>'.&mt('The extension on this file,').
114: ' "'.$1.'"'.&mt(', is not recognized by LON-CAPA.').
115: ' <br \>'.&mt('Please change the extension.').
116: '</font>');
117: }
118: } else {
119: $r->print('<font color=red>'.&mt('Illegal filename.').'</font>');
120: }
121: } else {
122: $r->print('<font color=red>'.&mt('No upload file specified.').'</font>');
123: }
124: }
125:
126: sub phasetwo {
127: my ($r,$tfn,$uname,$udom)=@_;
128: my $fn='/priv/'.$uname.'/'.$tfn;
129: $fn=~s/\/+/\//g;
130: &Debug($r, "Filename is ".$tfn);
131: if ($tfn) {
132: &Debug($r, "Filename for tfn = ".$tfn);
133: my $target='/home/'.$uname.'/public_html'.$tfn;
134: &Debug($r, "target -> ".$target);
135: # target is the full filesystem path of the destination file.
136: my $base = &File::Basename::basename($fn);
137: my $path = &File::Basename::dirname($fn);
138: $base = &HTML::Entities::encode($base);
139: my $url = $path."/".$base;
140: &Debug($r, "URL is now ".$url);
141: my $datatoken=$ENV{'form.datatoken'};
142: if (($fn) && ($datatoken)) {
143: if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) {
144: $r->print('<form action=/adm/upload method=post>'.
145: &mt('File').' <tt>'.$fn.'</tt> '.
146: &mt('exists. Overwrite?').' '.
147: '<input type=hidden name=phase value=two>'.
148: '<input type=hidden name=filename value="'."$url".'">'.
149: '<input type=hidden name=datatoken value="'.$datatoken.'">'.
150: '<input type=submit name=override value="'.&mt('Yes').'"></form>');
151: } else {
152: my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
153: # Check for bad extension and disallow upload
154: if ($fn=~/\.(\w+)$/ &&
155: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
156: $r->print(&mt('File').' <tt>'.$fn.'</tt> '.
157: &mt('could not be copied.').'<br />'.
158: '<font color=red>'.
159: &mt('The extension on this file is reserved internally by LON-CAPA.').
160: '</font>');
161: $r->print('<p><font size=+2><a href="'.$path.'">'.
162: &mt('Back to Directory').'</a></font>');
163: } elsif ($fn=~/\.(\w+)$/ &&
164: !defined(&Apache::loncommon::fileembstyle($1))) {
165: $r->print(&mt('File').' <tt>'.$fn.'</tt> '.
166: &mt('could not be copied.').'<br />'.
167: '<font color=red>'.
168: &mt('The extension on this file is not recognized by LON-CAPA.').
169: '</font>');
170: $r->print('<p><font size=+2><a href="'.$path.'">'.
171: &mt('Back to Directory').'</a></font>');
172: } elsif (-d $target) {
173: $r->print('File <tt>'.$fn.'</tt> could not be copied.<br />'.
174: '<font color=red>'.
175: &mt('The target is an existing directory.').
176: '</font>');
177: $r->print('<p><font size=+2><a href="'.$path.'">'.
178: &mt('Back to Directory').'</a></font>');
179: } elsif (copy($source,$target)) {
180: chmod(0660, $target); # Set permissions to rw-rw---.
181: $r->print(&mt('File copied.'));
182: $r->print('<p><font size=+2><a href="'.$url.'">'.
183: &mt('View file').'</a></font>');
184: $r->print('<p><font size=+2><a href="'.$path.'">'.
185: &mt('Back to Directory').'</a></font>');
186: } else {
187: $r->print('Failed to copy: '.$!);
188: $r->print('<p><font size=+2><a href="'.$path.'">'.
189: &mt('Back to Directory').'</a></font>');
190: }
191: }
192: } else {
193: $r->print('<font size=+1 color=red>'.
194: &mt('Please use browser "Back" button and pick a filename').
195: '</font><p>');
196: }
197: } else {
198: $r->print('<font size=+1 color=red>'.
199: &mt('Please use browser "Back" button and pick a filename').
200: '</font><p>');
201: }
202: }
203:
204: # ---------------------------------------------------------------- Main Handler
205: sub handler {
206:
207: my $r=shift;
208:
209: my $uname;
210: my $udom;
211: #
212: # phase two: re-attach user
213: #
214: if ($ENV{'form.uploaduname'}) {
215: $ENV{'form.filename'}='/priv/'.$ENV{'form.uploaduname'}.'/'.
216: $ENV{'form.filename'};
217: }
218: #
219:
220: ($uname,$udom)=
221: &Apache::loncacc::constructaccess($ENV{'form.filename'},
222: $r->dir_config('lonDefDomain'));
223: unless (($uname) && ($udom)) {
224: $r->log_reason($uname.' at '.$udom.
225: ' trying to publish file '.$ENV{'form.filename'}.
226: ' - not authorized',
227: $r->filename);
228: return HTTP_NOT_ACCEPTABLE;
229: }
230:
231: my $fn;
232: if ($ENV{'form.filename'}) {
233: $fn=$ENV{'form.filename'};
234: $fn=~s/^http\:\/\/[^\/]+\///;
235: $fn=~s/^\///;
236: $fn=~s/(\~|priv\/)(\w+)//;
237: $fn=~s/\/+/\//g;
238: } else {
239: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
240: ' unspecified filename for upload', $r->filename);
241: return HTTP_NOT_FOUND;
242: }
243:
244: # ----------------------------------------------------------- Start page output
245:
246:
247: &Apache::loncommon::content_type($r,'text/html');
248: $r->send_http_header;
249:
250: $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
251:
252: $r->print(&Apache::loncommon::bodytag('Upload file to Construction Space'));
253:
254: if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
255: $r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
256: &mt(' at ').$udom.'</font></h3>');
257: }
258:
259: if ($ENV{'form.phase'} eq 'two') {
260: &phasetwo($r,$fn,$uname,$udom);
261: } else {
262: &phaseone($r,$fn,$uname,$udom);
263: }
264:
265: $r->print('</body></html>');
266: return OK;
267: }
268:
269: 1;
270: __END__
271:
272: =head1 NAME
273:
274: Apache::lonupload - upload files into construction space
275:
276: =head1 SYNOPSIS
277:
278: Invoked by /etc/httpd/conf/srm.conf:
279:
280: <Location /adm/upload>
281: PerlAccessHandler Apache::lonacc
282: SetHandler perl-script
283: PerlHandler Apache::lonupload
284: ErrorDocument 403 /adm/login
285: ErrorDocument 404 /adm/notfound.html
286: ErrorDocument 406 /adm/unauthorized.html
287: ErrorDocument 500 /adm/errorhandler
288: </Location>
289:
290: =head1 INTRODUCTION
291:
292: This module uploads a file sitting on a client computer into
293: library server construction space.
294:
295: This is part of the LearningOnline Network with CAPA project
296: described at http://www.lon-capa.org.
297:
298: =head1 HANDLER SUBROUTINE
299:
300: This routine is called by Apache and mod_perl.
301:
302: =over 4
303:
304: =item *
305:
306: Initialize variables
307:
308: =item *
309:
310: Start page output
311:
312: =item *
313:
314: output relevant interface phase (phaseone or phasetwo)
315:
316: =item *
317:
318: (phase one is to specify upload file; phase two is to handle conditions
319: subsequent to specification--like overwriting an existing file)
320:
321: =back
322:
323: =head1 OTHER SUBROUTINES
324:
325: =over 4
326:
327: =item *
328:
329: phaseone() : Interface for specifying file to upload.
330:
331: =item *
332:
333: phasetwo() : Interface for handling post-conditions about uploading (such
334: as overwriting an existing file).
335:
336: =item *
337:
338: upfile_store() : Store contents of uploaded file into temporary space. Invoked
339: by phaseone subroutine.
340:
341: =back
342:
343: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonupload.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / publisher