1: # The LearningOnline Network
2: # Opening converted problems and directory listings for Daxe
3: #
4: # $Id: daxeopen.pm,v 1.15 2024/04/14 17:12:28 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: my %editors = &Apache::loncommon::permitted_editors($uri);
53: unless ($editors{'daxe'}) {
54: $request->content_type('text/plain');
55: $request->print(&mt('Daxe editor is not enabled for this Authoring Space.'));
56: $request->status(403);
57: return OK;
58: }
59: if ($uri =~ m{/$}) {
60: return directory_listing($uri, $request);
61: } elsif ($uri =~ m{^/priv/.*\.(task|problem|exam|quiz|assess|survey|library|xml|html|htm|xhtml|xhtm)$}) {
62: return convert_problem($uri, $request);
63: } elsif ($uri =~ m{^/uploaded/$match_domain/$match_courseid/(docs|supplemental)/(default|\d+)/\d+/.*\.(html|htm|xhtml|xhtm)$}) {
64: return convert_problem($uri, $request);
65: } else {
66: # Apache should send other files directly
67: $request->status(406);
68: return OK;
69: }
70: }
71:
72: sub convert_problem {
73: my ($uri, $request) = @_;
74: if ($uri =~ m{^/priv/$match_domain/$match_username/}) {
75: unless (&has_priv_access($uri)) {
76: $request->content_type('text/plain');
77: $request->print(&mt('Forbidden URI: [_1]',$uri));
78: $request->status(403);
79: return OK;
80: }
81: } elsif ($uri =~ m{^/uploaded/($match_domain)/($match_courseid)/}) {
82: my ($posscdom,$posscnum) = ($1,$2);
83: my $allowed;
84: if ($env{'request.course.id'}) {
85: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
86: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
87: if (($posscdom eq $cdom) && ($posscnum eq $cnum)) {
88: if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
89: $allowed = 1;
90: }
91: }
92: }
93: unless ($allowed) {
94: $request->content_type('text/plain');
95: $request->print(&mt('Forbidden URI: [_1]',$uri));
96: $request->status(403);
97: return OK;
98: }
99: }
100: my $file = &Apache::lonnet::filelocation('', $uri);
101: if (&Apache::lonnet::repcopy($file) eq 'ok') {
102: if (! -e $file) {
103: $request->print(&mt('Not found: [_1]',$uri));
104: $request->status(404);
105: return OK;
106: }
107: } else {
108: $request->print(&mt('Forbidden URI: [_1]',$uri));
109: $request->status(403);
110: return OK;
111: }
112: try {
113: my $warnings = 0; # no warning printed
114: my $textref = &Apache::pre_xml::pre_xml($file, $warnings);
115: my $case_sensitive;
116: if ($uri =~ /\.(task)$/) {
117: $case_sensitive = 1;
118: } else {
119: $case_sensitive = 0;
120: }
121: $textref = &Apache::html_to_xml::html_to_xml($textref, $warnings, $case_sensitive);
122: my $text = &Apache::post_xml::post_xml($textref, $file, $Apache::lonnet::perlvar{'lonDocRoot'}, $warnings);
123: &Apache::loncommon::content_type($request, 'text/xml', 'utf-8');
124: $request->print($text);
125: return OK;
126: } catch {
127: $request->content_type('text/plain');
128: $request->print(&mt('convert failed for [_1]:',$file)." $_");
129: $request->status(406);
130: return OK;
131: };
132: }
133:
134: sub directory_listing {
135: my ($uri, $request) = @_;
136: my $res = '<?xml version="1.0" encoding="UTF-8"?>'."\n";
137: my $referrer = $request->headers_in->{'Referer'};
138: my ($cdom,$cnum);
139: if ($env{'request.course.id'}) {
140: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
141: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
142: }
143: if ($uri eq '/') {
144: $res .= "<directory name=\"/\">\n";
145: if (($env{'request.course.id'}) &&
146: ($referrer =~ m{\Qfile=/daxeopen/uploaded/$cdom/$cnum/\E(docs|supplemental)/(default|\d+)/(\d+)/})) {
147: $res .= "<directory name=\"uploaded\"/>\n";
148: } else {
149: # root: let users browse /res
150: $res .= "<directory name=\"priv\"/>\n";
151: $res .= "<directory name=\"res\"/>\n";
152: }
153: } elsif ($uri =~ m{^/uploaded/(.*)$}) {
154: my $rem = $1;
155: $rem =~ s{/$}{};
156: if (($env{'request.course.id'}) &&
157: ($referrer =~ m{\Qfile=/daxeopen/uploaded/$cdom/$cnum/\E(docs|supplemental)/(default|\d+)/(\d+)/})) {
158: my ($type,$folder,$rid) = ($1,$2,$3);
159: if ($rem eq '') {
160: $res .= "<directory name=\"uploaded\">\n";
161: $res .= "<directory name=\"$cdom\"/>\n";
162: } else {
163: my @expected = ($cdom,$cnum,$type,$folder,$rid);
164: my @rest = split(/\//,$rem);
165: my $valid = 1;
166: for (my $i=0; $i<@rest; $i++) {
167: unless ($rest[$i] eq $expected[$i]) {
168: $valid = 0;
169: last;
170: }
171: }
172: if ($valid) {
173: my $dirname = $rest[-1];
174: $res .= "<directory name=\"$dirname\">\n";
175: if (scalar(@rest) == scalar(@expected)) {
176: my $subdir = "/userfiles/$type/$folder/$rid";
177: my ($listref, $listerror) = &Apache::lonnet::dirlist($subdir,$cdom,$cnum,'',1);
178: if ($listerror) {
179: $request->content_type('text/plain');
180: $request->print(&mt('listing error: [_1]',$listerror));
181: $request->status(406);
182: return OK;
183: } elsif (scalar(@{$listref}) == 0) {
184: $request->content_type('text/plain');
185: $request->print(&mt('Not found: [_1]',$uri));
186: $request->status(404);
187: return OK;
188: } else {
189: my @lines = @{$listref};
190: my $dirpath = &LONCAPA::propath($cdom,$cnum).'/userfiles';
191: my $dirname = $uri;
192: $dirname =~ s{^.*/([^/]*)$}{$1};
193: foreach my $line (@lines) {
194: my ($path,$dom,undef,$testdir,undef,undef,undef,undef,$size,undef,$mtime) = split(/\&/,$line,12);
195: my $isdir = ($testdir & 16384);
196: $path =~ s{^$dirpath}{};
197: next if ($path eq '.' || $path eq '..');
198: $path =~ s{/$}{};
199: my $name = $path;
200: if ($isdir) {
201: $res .= "<directory name=\"$name\"/>\n";
202: } else {
203: next if ($name =~ /\.bak$/);
204: my $dt = DateTime->from_epoch(epoch => $mtime);
205: my $modified = $dt->iso8601().'Z';
206: $res .= "<file name=\"$name\" size=\"$size\" modified=\"$modified\"/>\n";
207: }
208: }
209: }
210: } else {
211: my $nextidx = scalar(@rest);
212: my $subdir = $expected[$nextidx];
213: $res .= "<directory name=\"$subdir\"/>"."\n";
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: }
222: } else {
223: $request->content_type('text/plain');
224: $request->print(&mt('Forbidden URI: [_1]',$uri));
225: $request->status(403);
226: return OK;
227: }
228: } elsif ($uri !~ m{^/(priv|res)/}) {
229: $request->content_type('text/plain');
230: $request->print(&mt('Not found: [_1]',$uri));
231: $request->status(404);
232: return OK;
233: } elsif ($uri =~ m{^/res/}) {
234: # NOTE: dirlist does not return an error for /res/idontexist/
235: my ($listref, $listerror) = &Apache::lonnet::dirlist($uri);
236: if ($listerror) {
237: $request->content_type('text/plain');
238: $request->print(&mt('listing error: [_1]',$listerror));
239: $request->status(406);
240: return OK;
241: } elsif ($uri =~ m{^/res/[^/]+/$} && scalar(@{$listref}) == 0) {
242: $request->content_type('text/plain');
243: $request->print(&mt('Not found: [_1]',$uri));
244: $request->status(404);
245: return OK;
246: }
247: my $dirname = $uri;
248: $dirname =~ s{^.*/([^/]*)$}{$1};
249: $res .= "<directory name=\"$dirname/\">\n";
250: my (%is_course,%is_courseauthor);
251: if (ref($listref) eq 'ARRAY') {
252: my @lines = @{$listref};
253: foreach my $line (@lines) {
254: my ($path, $dom, undef, $testdir, undef, undef, undef, undef, $size, undef, $mtime, undef, undef, undef, $obs, undef) = split(/\&/, $line, 16);
255: my $isdir = ($testdir & 16384) || $dom =~ /^(user|domain)$/;
256: $path =~ s{^/home/httpd/html/res/}{};
257: next if $path eq '.' || $path eq '..';
258: next if $path =~ /\.meta$/ || $obs || $path =~ /\.\d+\.[^.]+$/;
259: if ($dom ne 'domain') {
260: my ($udom,$uname);
261: if ($dom eq 'user') {
262: ($udom) = ($uri =~ m{^/res/($match_domain)});
263: $uname = $path;
264: } else {
265: ($udom, $uname) = ($uri =~ m{^/res/($match_domain)/($match_courseid)});
266: }
267: if ($udom ne '' && $uname ne '') {
268: my $key = $udom.':'.$uname;
269: if (exists($is_course{$key})) {
270: if ($is_course{$key}) {
271: next unless ($is_courseauthor{$key});
272: }
273: } else {
274: if (&Apache::lonnet::is_course($udom, $uname)) {
275: $is_course{$key} = 1;
276: if ($env{'request.course.id'}) {
277: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
278: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
279: if (($cdom eq $udom) && ($cnum eq $uname)) {
280: if (&Apache::lonnet::allowed('mdc', $env{'request.course.id'})) {
281: $is_courseauthor{$key} = 1;
282: }
283: }
284: }
285: # remove courses from the list
286: next unless ($is_courseauthor{$key});
287: } else {
288: $is_course{$key} = 0;
289: }
290: }
291: }
292: }
293: $path =~ s{/$}{};
294: my $name = $path;
295: if ($isdir) {
296: $res .= "<directory name=\"$name\"/>\n";
297: } else {
298: my $dt = DateTime->from_epoch(epoch => $mtime);
299: my $modified = $dt->iso8601().'Z';
300: $res .= "<file name=\"$name\" size=\"$size\" modified=\"$modified\"/>\n";
301: }
302: }
303: }
304: } elsif ($uri eq '/priv/') {
305: my $defdom = &get_defdom($referrer);
306: if (!defined $defdom) {
307: $request->content_type('text/plain');
308: $request->print(&mt('Forbidden URI: [_1]',$uri));
309: $request->status(403);
310: return OK;
311: }
312: $res .= "<directory name=\"priv\">\n";
313: $res .= "<directory name=\"$defdom\"/>\n";
314: } elsif ($uri =~ m{^/priv/($match_domain)/$}) {
315: my $domain = $1;
316: my $defdom = &get_defdom($referrer);
317: if ($domain ne $defdom) {
318: $request->content_type('text/plain');
319: $request->print(&mt('Forbidden URI: [_1]',$uri));
320: $request->status(403);
321: return OK;
322: }
323: my $defname = &get_defname($domain,$referrer);
324: $res .= "<directory name=\"$domain\">\n";
325: $res .= "<directory name=\"$defname\"/>\n";
326: } elsif ($uri =~ m{^/priv/($match_domain)\/($match_username)/}) {
327: unless (&has_priv_access($uri)) {
328: $request->content_type('text/plain');
329: $request->print(&mt('Forbidden URI: [_1]',$uri));
330: $request->status(403);
331: return OK;
332: }
333: my $dirpath = &Apache::lonnet::filelocation('', $uri);
334: if (! -e $dirpath) {
335: $request->content_type('text/plain');
336: $request->print(&mt('Not found: [_1]',$uri));
337: $request->status(404);
338: return OK;
339: }
340: $dirpath =~ s{/$}{};
341: my @files;
342: if (opendir(my $dir, $dirpath)) {
343: @files = readdir($dir);
344: closedir($dir);
345: } else {
346: $request->content_type('text/plain');
347: $request->print(&mt('Error opening directory: [_1]',$dirpath));
348: $request->status(403);
349: return OK;
350: }
351: my $dirname = $dirpath;
352: $dirname =~ s{^.*/([^/]*)$}{$1};
353: $res .= "<directory name=\"$dirname\">\n";
354: foreach my $name (@files) {
355: if ($name eq '.' || $name eq '..') {
356: next;
357: }
358: if ($name =~ /\.(bak|log|meta|save)$/) {
359: next;
360: }
361: my $sb = stat($dirpath.'/'.$name);
362: my $mode = $sb->mode;
363: if (S_ISDIR($mode)) {
364: $res .= "<directory name=\"$name\"/>\n";
365: } else {
366: $res .= "<file name=\"$name\"";
367: my $size = $sb->size; # total size of file, in bytes
368: $res .= " size=\"$size\"";
369: my $mtime = $sb->mtime; # last modify time in seconds since the epoch
370: my $dt = DateTime->from_epoch(epoch => $mtime);
371: my $modified = $dt->iso8601().'Z';
372: $res .= " modified=\"$modified\"";
373: $res .= "/>\n";
374: }
375: }
376: } else {
377: $request->content_type('text/plain');
378: $request->print(&mt('Not found: [_1]',$uri));
379: $request->status(404);
380: return OK;
381: }
382: $res .= "</directory>\n";
383: &Apache::loncommon::content_type($request, 'text/xml', 'utf-8');
384: $request->print($res);
385: return OK;
386: }
387:
388: sub has_priv_access {
389: my ($uri) = @_;
390: my ($ownername,$ownerdom,$ownerhome) =
391: &Apache::lonnet::constructaccess($uri);
392: my $allowed;
393: if (($ownername ne '') && ($ownerdom ne '') && ($ownerhome ne '')) {
394: unless ($ownerhome eq 'no_host') {
395: my @hosts = &Apache::lonnet::current_machine_ids();
396: if (grep(/^\Q$ownerhome\E$/,@hosts)) {
397: $allowed = 1;
398: }
399: }
400: }
401: return $allowed;
402: }
403:
404: sub get_defdom {
405: my ($referrer) = @_;
406: my $defdom;
407: if ($env{'request.role'} =~ m{^au\./($match_domain)/$}) {
408: $defdom = $1;
409: } elsif ($env{'request.role'} =~ m{^(?:ca|aa)\.($match_domain)/($match_username)$}) {
410: $defdom = $1;
411: } elsif ($env{'request.course.id'}) {
412: if ($referrer =~ m{\Qfile=/daxeopen/priv/\E($match_domain)/($match_username)/}) {
413: my ($possdom,$possuname) = ($1,$2);
414: if (&Apache::lonnet::is_course($possdom,$possuname)) {
415: my $crsurl = &Apache::lonnet::courseid_to_courseurl($env{'request.course.id'});
416: if ($crsurl eq "/$possdom/$possuname") {
417: $defdom = $possdom;
418: }
419: } else {
420: if (&Apache::lonnet::domain($possdom) ne '') {
421: $defdom = $possdom;
422: }
423: }
424: }
425: }
426: if ($defdom eq '') {
427: my ($is_adv,$is_author) = &Apache::lonnet::is_advanced_user($env{'user.domain'},$env{'user.name'});
428: if ($is_author) {
429: $defdom = $env{'user.domain'};
430: }
431: }
432: return $defdom;
433: }
434:
435: sub get_defname {
436: my ($domain,$referrer) = @_;
437: my $defname;
438: if ($env{'request.role'} eq "au./$domain/") {
439: $defname = $env{'user.name'};
440: } elsif ($env{'request.role'} =~ m{^(?:ca|aa)\./\Q$domain\E/($match_username)$}) {
441: $defname = $1;
442: } elsif ($env{'request.course.id'}) {
443: if ($referrer =~ m{\Qfile=/daxeopen/priv/\E($match_domain)/($match_username)/}) {
444: my ($possdom,$possuname) = ($1,$2);
445: if ($domain eq $possdom) {
446: if (&Apache::lonnet::is_course($possdom,$possuname)) {
447: my $crsurl = &Apache::lonnet::courseid_to_courseurl($env{'request.course.id'});
448: if ($crsurl eq "/$possdom/$possuname") {
449: $defname = $possuname;
450: }
451: } else {
452: unless (&Apache::lonnet::homeserver($possuname,$possdom) eq 'no_host') {
453: $defname = $possuname;
454: }
455: }
456: }
457: }
458: }
459: if ($defname eq '') {
460: my ($is_adv,$is_author) = &Apache::lonnet::is_advanced_user($domain,$env{'user.name'});
461: if ($is_author) {
462: $defname = $env{'user.name'};
463: }
464: }
465: return $defname;
466: }
467:
468: 1;
469: __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