1: # The LearningOnline Network
2: # Opening converted problems and directory listings for Daxe
3: #
4: # $Id: daxeopen.pm,v 1.13 2023/08/28 18:58:44 raeburn Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: ###
29:
30: package Apache::daxeopen;
31: use strict;
32:
33: use Apache::Constants qw(:common);
34: use DateTime;
35: use Try::Tiny;
36: use File::stat;
37: use Fcntl ':mode';
38:
39: use LONCAPA qw(:match);
40: use Apache::loncommon;
41: use Apache::lonnet;
42: use Apache::pre_xml;
43: use Apache::html_to_xml;
44: use Apache::post_xml;
45: use Apache::lonlocal;
46:
47: sub handler {
48: my $request = shift;
49: my $uri = $request->uri;
50: $uri =~ s{^/daxeopen}{};
51: &Apache::loncommon::no_cache($request);
52: if ($uri =~ m{/$}) {
53: return directory_listing($uri, $request);
54: } elsif ($uri =~ m{^/priv/.*\.(task|problem|exam|quiz|assess|survey|library|xml|html|htm|xhtml|xhtm)$}) {
55: return convert_problem($uri, $request);
56: } elsif ($uri =~ m{^/uploaded/$match_domain/$match_courseid/(docs|supplemental)/(default|\d+)/\d+/.*\.(html|htm|xhtml|xhtm)$}) {
57: return convert_problem($uri, $request);
58: } else {
59: # Apache should send other files directly
60: $request->status(406);
61: return OK;
62: }
63: }
64:
65: sub convert_problem {
66: my ($uri, $request) = @_;
67: if ($uri =~ m{^/priv/$match_domain/$match_username/}) {
68: unless (&has_priv_access($uri)) {
69: $request->content_type('text/plain');
70: $request->print(&mt('Forbidden URI: [_1]',$uri));
71: $request->status(403);
72: return OK;
73: }
74: } elsif ($uri =~ m{^/uploaded/($match_domain)/($match_courseid)/}) {
75: my ($posscdom,$posscnum) = ($1,$2);
76: my $allowed;
77: if ($env{'request.course.id'}) {
78: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
79: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
80: if (($posscdom eq $cdom) && ($posscnum eq $cnum)) {
81: if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
82: $allowed = 1;
83: }
84: }
85: }
86: unless ($allowed) {
87: $request->content_type('text/plain');
88: $request->print(&mt('Forbidden URI: [_1]',$uri));
89: $request->status(403);
90: return OK;
91: }
92: }
93: my $file = &Apache::lonnet::filelocation('', $uri);
94: if (&Apache::lonnet::repcopy($file) eq 'ok') {
95: if (! -e $file) {
96: $request->print(&mt('Not found: [_1]',$uri));
97: $request->status(404);
98: return OK;
99: }
100: } else {
101: $request->print(&mt('Forbidden URI: [_1]',$uri));
102: $request->status(403);
103: return OK;
104: }
105: try {
106: my $warnings = 0; # no warning printed
107: my $textref = &Apache::pre_xml::pre_xml($file, $warnings);
108: my $case_sensitive;
109: if ($uri =~ /\.(task)$/) {
110: $case_sensitive = 1;
111: } else {
112: $case_sensitive = 0;
113: }
114: $textref = &Apache::html_to_xml::html_to_xml($textref, $warnings, $case_sensitive);
115: my $text = &Apache::post_xml::post_xml($textref, $file, $Apache::lonnet::perlvar{'lonDocRoot'}, $warnings);
116: &Apache::loncommon::content_type($request, 'text/xml', 'utf-8');
117: $request->print($text);
118: return OK;
119: } catch {
120: $request->content_type('text/plain');
121: $request->print(&mt('convert failed for [_1]:',$file)." $_");
122: $request->status(406);
123: return OK;
124: };
125: }
126:
127: sub directory_listing {
128: my ($uri, $request) = @_;
129: my $res = '<?xml version="1.0" encoding="UTF-8"?>'."\n";
130: my $referrer = $request->headers_in->{'Referer'};
131: my ($cdom,$cnum);
132: if ($env{'request.course.id'}) {
133: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
134: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
135: }
136: if ($uri eq '/') {
137: $res .= "<directory name=\"/\">\n";
138: if (($env{'request.course.id'}) &&
139: ($referrer =~ m{\Qfile=/daxeopen/uploaded/$cdom/$cnum/\E(docs|supplemental)/(default|\d+)/(\d+)/})) {
140: $res .= "<directory name=\"uploaded\"/>\n";
141: } else {
142: # root: let users browse /res
143: $res .= "<directory name=\"priv\"/>\n";
144: $res .= "<directory name=\"res\"/>\n";
145: }
146: } elsif ($uri =~ m{^/uploaded/(.*)$}) {
147: my $rem = $1;
148: $rem =~ s{/$}{};
149: if (($env{'request.course.id'}) &&
150: ($referrer =~ m{\Qfile=/daxeopen/uploaded/$cdom/$cnum/\E(docs|supplemental)/(default|\d+)/(\d+)/})) {
151: my ($type,$folder,$rid) = ($1,$2,$3);
152: if ($rem eq '') {
153: $res .= "<directory name=\"uploaded\">\n";
154: $res .= "<directory name=\"$cdom\"/>\n";
155: } else {
156: my @expected = ($cdom,$cnum,$type,$folder,$rid);
157: my @rest = split(/\//,$rem);
158: my $valid = 1;
159: for (my $i=0; $i<@rest; $i++) {
160: unless ($rest[$i] eq $expected[$i]) {
161: $valid = 0;
162: last;
163: }
164: }
165: if ($valid) {
166: my $dirname = $rest[-1];
167: $res .= "<directory name=\"$dirname\">\n";
168: if (scalar(@rest) == scalar(@expected)) {
169: my $subdir = "/userfiles/$type/$folder/$rid";
170: my ($listref, $listerror) = &Apache::lonnet::dirlist($subdir,$cdom,$cnum,'',1);
171: if ($listerror) {
172: $request->content_type('text/plain');
173: $request->print(&mt('listing error: [_1]',$listerror));
174: $request->status(406);
175: return OK;
176: } elsif (scalar(@{$listref}) == 0) {
177: $request->content_type('text/plain');
178: $request->print(&mt('Not found: [_1]',$uri));
179: $request->status(404);
180: return OK;
181: } else {
182: my @lines = @{$listref};
183: my $dirpath = &LONCAPA::propath($cdom,$cnum).'/userfiles';
184: my $dirname = $uri;
185: $dirname =~ s{^.*/([^/]*)$}{$1};
186: foreach my $line (@lines) {
187: my ($path,$dom,undef,$testdir,undef,undef,undef,undef,$size,undef,$mtime) = split(/\&/,$line,12);
188: my $isdir = ($testdir & 16384);
189: $path =~ s{^$dirpath}{};
190: next if ($path eq '.' || $path eq '..');
191: $path =~ s{/$}{};
192: my $name = $path;
193: if ($isdir) {
194: $res .= "<directory name=\"$name\"/>\n";
195: } else {
196: next if ($name =~ /\.bak$/);
197: my $dt = DateTime->from_epoch(epoch => $mtime);
198: my $modified = $dt->iso8601().'Z';
199: $res .= "<file name=\"$name\" size=\"$size\" modified=\"$modified\"/>\n";
200: }
201: }
202: }
203: } else {
204: my $nextidx = scalar(@rest);
205: my $subdir = $expected[$nextidx];
206: $res .= "<directory name=\"$subdir\"/>"."\n";
207: }
208: } else {
209: $request->content_type('text/plain');
210: $request->print(&mt('Forbidden URI: [_1]',$uri));
211: $request->status(403);
212: return OK;
213: }
214: }
215: } else {
216: $request->content_type('text/plain');
217: $request->print(&mt('Forbidden URI: [_1]',$uri));
218: $request->status(403);
219: return OK;
220: }
221: } elsif ($uri !~ m{^/(priv|res)/}) {
222: $request->content_type('text/plain');
223: $request->print(&mt('Not found: [_1]',$uri));
224: $request->status(404);
225: return OK;
226: } elsif ($uri =~ m{^/res/}) {
227: # NOTE: dirlist does not return an error for /res/idontexist/
228: my ($listref, $listerror) = &Apache::lonnet::dirlist($uri);
229: if ($listerror) {
230: $request->content_type('text/plain');
231: $request->print(&mt('listing error: [_1]',$listerror));
232: $request->status(406);
233: return OK;
234: } elsif ($uri =~ m{^/res/[^/]+/$} && scalar(@{$listref}) == 0) {
235: $request->content_type('text/plain');
236: $request->print(&mt('Not found: [_1]',$uri));
237: $request->status(404);
238: return OK;
239: }
240: my $dirname = $uri;
241: $dirname =~ s{^.*/([^/]*)$}{$1};
242: $res .= "<directory name=\"$dirname/\">\n";
243: my (%is_course,%is_courseauthor);
244: if (ref($listref) eq 'ARRAY') {
245: my @lines = @{$listref};
246: foreach my $line (@lines) {
247: my ($path, $dom, undef, $testdir, undef, undef, undef, undef, $size, undef, $mtime, undef, undef, undef, $obs, undef) = split(/\&/, $line, 16);
248: my $isdir = ($testdir & 16384) || $dom =~ /^(user|domain)$/;
249: $path =~ s{^/home/httpd/html/res/}{};
250: next if $path eq '.' || $path eq '..';
251: next if $path =~ /\.meta$/ || $obs || $path =~ /\.\d+\.[^.]+$/;
252: if ($dom ne 'domain') {
253: my ($udom,$uname);
254: if ($dom eq 'user') {
255: ($udom) = ($uri =~ m{^/res/($match_domain)});
256: $uname = $path;
257: } else {
258: ($udom, $uname) = ($uri =~ m{^/res/($match_domain)/($match_courseid)});
259: }
260: if ($udom ne '' && $uname ne '') {
261: my $key = $udom.':'.$uname;
262: if (exists($is_course{$key})) {
263: if ($is_course{$key}) {
264: next unless ($is_courseauthor{$key});
265: }
266: } else {
267: if (&Apache::lonnet::is_course($udom, $uname)) {
268: $is_course{$key} = 1;
269: if ($env{'request.course.id'}) {
270: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
271: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
272: if (($cdom eq $udom) && ($cnum eq $uname)) {
273: if (&Apache::lonnet::allowed('mdc', $env{'request.course.id'})) {
274: $is_courseauthor{$key} = 1;
275: }
276: }
277: }
278: # remove courses from the list
279: next unless ($is_courseauthor{$key});
280: } else {
281: $is_course{$key} = 0;
282: }
283: }
284: }
285: }
286: $path =~ s{/$}{};
287: my $name = $path;
288: if ($isdir) {
289: $res .= "<directory name=\"$name\"/>\n";
290: } else {
291: my $dt = DateTime->from_epoch(epoch => $mtime);
292: my $modified = $dt->iso8601().'Z';
293: $res .= "<file name=\"$name\" size=\"$size\" modified=\"$modified\"/>\n";
294: }
295: }
296: }
297: } elsif ($uri eq '/priv/') {
298: my $defdom = &get_defdom($referrer);
299: if (!defined $defdom) {
300: $request->content_type('text/plain');
301: $request->print(&mt('Forbidden URI: [_1]',$uri));
302: $request->status(403);
303: return OK;
304: }
305: $res .= "<directory name=\"priv\">\n";
306: $res .= "<directory name=\"$defdom\"/>\n";
307: } elsif ($uri =~ m{^/priv/($match_domain)/$}) {
308: my $domain = $1;
309: my $defdom = &get_defdom($referrer);
310: if ($domain ne $defdom) {
311: $request->content_type('text/plain');
312: $request->print(&mt('Forbidden URI: [_1]',$uri));
313: $request->status(403);
314: return OK;
315: }
316: my $defname = &get_defname($domain,$referrer);
317: $res .= "<directory name=\"$domain\">\n";
318: $res .= "<directory name=\"$defname\"/>\n";
319: } elsif ($uri =~ m{^/priv/($match_domain)\/($match_username)/}) {
320: unless (&has_priv_access($uri)) {
321: $request->content_type('text/plain');
322: $request->print(&mt('Forbidden URI: [_1]',$uri));
323: $request->status(403);
324: return OK;
325: }
326: my $dirpath = &Apache::lonnet::filelocation('', $uri);
327: if (! -e $dirpath) {
328: $request->content_type('text/plain');
329: $request->print(&mt('Not found: [_1]',$uri));
330: $request->status(404);
331: return OK;
332: }
333: $dirpath =~ s{/$}{};
334: my @files;
335: if (opendir(my $dir, $dirpath)) {
336: @files = readdir($dir);
337: closedir($dir);
338: } else {
339: $request->content_type('text/plain');
340: $request->print(&mt('Error opening directory: [_1]',$dirpath));
341: $request->status(403);
342: return OK;
343: }
344: my $dirname = $dirpath;
345: $dirname =~ s{^.*/([^/]*)$}{$1};
346: $res .= "<directory name=\"$dirname\">\n";
347: foreach my $name (@files) {
348: if ($name eq '.' || $name eq '..') {
349: next;
350: }
351: if ($name =~ /\.(bak|log|meta|save)$/) {
352: next;
353: }
354: my $sb = stat($dirpath.'/'.$name);
355: my $mode = $sb->mode;
356: if (S_ISDIR($mode)) {
357: $res .= "<directory name=\"$name\"/>\n";
358: } else {
359: $res .= "<file name=\"$name\"";
360: my $size = $sb->size; # total size of file, in bytes
361: $res .= " size=\"$size\"";
362: my $mtime = $sb->mtime; # last modify time in seconds since the epoch
363: my $dt = DateTime->from_epoch(epoch => $mtime);
364: my $modified = $dt->iso8601().'Z';
365: $res .= " modified=\"$modified\"";
366: $res .= "/>\n";
367: }
368: }
369: } else {
370: $request->content_type('text/plain');
371: $request->print(&mt('Not found: [_1]',$uri));
372: $request->status(404);
373: return OK;
374: }
375: $res .= "</directory>\n";
376: &Apache::loncommon::content_type($request, 'text/xml', 'utf-8');
377: $request->print($res);
378: return OK;
379: }
380:
381: sub has_priv_access {
382: my ($uri) = @_;
383: my ($ownername,$ownerdom,$ownerhome) =
384: &Apache::lonnet::constructaccess($uri);
385: my $allowed;
386: if (($ownername ne '') && ($ownerdom ne '') && ($ownerhome ne '')) {
387: unless ($ownerhome eq 'no_host') {
388: my @hosts = &Apache::lonnet::current_machine_ids();
389: if (grep(/^\Q$ownerhome\E$/,@hosts)) {
390: $allowed = 1;
391: }
392: }
393: }
394: return $allowed;
395: }
396:
397: sub get_defdom {
398: my ($referrer) = @_;
399: my $defdom;
400: if ($env{'request.role'} =~ m{^au\./($match_domain)/$}) {
401: $defdom = $1;
402: } elsif ($env{'request.role'} =~ m{^(?:ca|aa)\.($match_domain)/($match_username)$}) {
403: $defdom = $1;
404: } elsif ($env{'request.course.id'}) {
405: if ($referrer =~ m{\Qfile=/daxeopen/priv/\E($match_domain)/($match_username)/}) {
406: my ($possdom,$possuname) = ($1,$2);
407: if (&Apache::lonnet::is_course($possdom,$possuname)) {
408: my $crsurl = &Apache::lonnet::courseid_to_courseurl($env{'request.course.id'});
409: if ($crsurl eq "/$possdom/$possuname") {
410: $defdom = $possdom;
411: }
412: } else {
413: if (&Apache::lonnet::domain($possdom) ne '') {
414: $defdom = $possdom;
415: }
416: }
417: }
418: }
419: if ($defdom eq '') {
420: my ($is_adv,$is_author) = &Apache::lonnet::is_advanced_user($env{'user.domain'},$env{'user.name'});
421: if ($is_author) {
422: $defdom = $env{'user.domain'};
423: }
424: }
425: return $defdom;
426: }
427:
428: sub get_defname {
429: my ($domain,$referrer) = @_;
430: my $defname;
431: if ($env{'request.role'} eq "au./$domain/") {
432: $defname = $env{'user.name'};
433: } elsif ($env{'request.role'} =~ m{^(?:ca|aa)\./\Q$domain\E/($match_username)$}) {
434: $defname = $1;
435: } elsif ($env{'request.course.id'}) {
436: if ($referrer =~ m{\Qfile=/daxeopen/priv/\E($match_domain)/($match_username)/}) {
437: my ($possdom,$possuname) = ($1,$2);
438: if ($domain eq $possdom) {
439: if (&Apache::lonnet::is_course($possdom,$possuname)) {
440: my $crsurl = &Apache::lonnet::courseid_to_courseurl($env{'request.course.id'});
441: if ($crsurl eq "/$possdom/$possuname") {
442: $defname = $possuname;
443: }
444: } else {
445: unless (&Apache::lonnet::homeserver($possuname,$possdom) eq 'no_host') {
446: $defname = $possuname;
447: }
448: }
449: }
450: }
451: }
452: if ($defname eq '') {
453: my ($is_adv,$is_author) = &Apache::lonnet::is_advanced_user($domain,$env{'user.name'});
454: if ($is_author) {
455: $defname = $env{'user.name'};
456: }
457: }
458: return $defname;
459: }
460:
461: 1;
462: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to daxeopen.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework