Annotation of loncom/homework/daxeopen.pm, revision 1.15
1.1 damieng 1: # The LearningOnline Network
2: # Opening converted problems and directory listings for Daxe
3: #
1.15 ! raeburn 4: # $Id: daxeopen.pm,v 1.14 2023/11/19 21:28:17 raeburn Exp $
1.1 damieng 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;
1.8 raeburn 31: use strict;
1.1 damieng 32:
1.8 raeburn 33: use Apache::Constants qw(:common);
1.1 damieng 34: use DateTime;
35: use Try::Tiny;
36: use File::stat;
37: use Fcntl ':mode';
38:
1.5 damieng 39: use LONCAPA qw(:match);
1.1 damieng 40: use Apache::loncommon;
41: use Apache::lonnet;
42: use Apache::pre_xml;
43: use Apache::html_to_xml;
44: use Apache::post_xml;
1.10 raeburn 45: use Apache::lonlocal;
1.1 damieng 46:
47: sub handler {
48: my $request = shift;
49: my $uri = $request->uri;
1.7 raeburn 50: $uri =~ s{^/daxeopen}{};
1.1 damieng 51: &Apache::loncommon::no_cache($request);
1.15 ! raeburn 52: my %editors = &Apache::loncommon::permitted_editors($uri);
1.14 raeburn 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: }
1.7 raeburn 59: if ($uri =~ m{/$}) {
1.1 damieng 60: return directory_listing($uri, $request);
1.7 raeburn 61: } elsif ($uri =~ m{^/priv/.*\.(task|problem|exam|quiz|assess|survey|library|xml|html|htm|xhtml|xhtm)$}) {
1.1 damieng 62: return convert_problem($uri, $request);
1.13 raeburn 63: } elsif ($uri =~ m{^/uploaded/$match_domain/$match_courseid/(docs|supplemental)/(default|\d+)/\d+/.*\.(html|htm|xhtml|xhtm)$}) {
64: return convert_problem($uri, $request);
1.1 damieng 65: } else {
66: # Apache should send other files directly
1.2 damieng 67: $request->status(406);
68: return OK;
1.1 damieng 69: }
70: }
71:
72: sub convert_problem {
73: my ($uri, $request) = @_;
1.12 raeburn 74: if ($uri =~ m{^/priv/$match_domain/$match_username/}) {
75: unless (&has_priv_access($uri)) {
1.6 damieng 76: $request->content_type('text/plain');
1.10 raeburn 77: $request->print(&mt('Forbidden URI: [_1]',$uri));
1.6 damieng 78: $request->status(403);
79: return OK;
80: }
1.13 raeburn 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: }
1.6 damieng 99: }
1.1 damieng 100: my $file = &Apache::lonnet::filelocation('', $uri);
1.13 raeburn 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);
1.2 damieng 110: return OK;
1.1 damieng 111: }
112: try {
113: my $warnings = 0; # no warning printed
114: my $textref = &Apache::pre_xml::pre_xml($file, $warnings);
1.4 damieng 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);
1.8 raeburn 122: my $text = &Apache::post_xml::post_xml($textref, $file, $Apache::lonnet::perlvar{'lonDocRoot'}, $warnings);
1.1 damieng 123: &Apache::loncommon::content_type($request, 'text/xml', 'utf-8');
124: $request->print($text);
125: return OK;
126: } catch {
1.2 damieng 127: $request->content_type('text/plain');
1.10 raeburn 128: $request->print(&mt('convert failed for [_1]:',$file)." $_");
1.2 damieng 129: $request->status(406);
130: return OK;
1.1 damieng 131: };
132: }
133:
134: sub directory_listing {
135: my ($uri, $request) = @_;
1.5 damieng 136: my $res = '<?xml version="1.0" encoding="UTF-8"?>'."\n";
1.13 raeburn 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: }
1.5 damieng 143: if ($uri eq '/') {
144: $res .= "<directory name=\"/\">\n";
1.13 raeburn 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: }
1.11 raeburn 228: } elsif ($uri !~ m{^/(priv|res)/}) {
1.6 damieng 229: $request->content_type('text/plain');
1.10 raeburn 230: $request->print(&mt('Not found: [_1]',$uri));
1.2 damieng 231: $request->status(404);
232: return OK;
1.7 raeburn 233: } elsif ($uri =~ m{^/res/}) {
1.6 damieng 234: # NOTE: dirlist does not return an error for /res/idontexist/
1.8 raeburn 235: my ($listref, $listerror) = &Apache::lonnet::dirlist($uri);
1.5 damieng 236: if ($listerror) {
237: $request->content_type('text/plain');
1.10 raeburn 238: $request->print(&mt('listing error: [_1]',$listerror));
1.5 damieng 239: $request->status(406);
240: return OK;
1.7 raeburn 241: } elsif ($uri =~ m{^/res/[^/]+/$} && scalar(@{$listref}) == 0) {
1.6 damieng 242: $request->content_type('text/plain');
1.10 raeburn 243: $request->print(&mt('Not found: [_1]',$uri));
1.6 damieng 244: $request->status(404);
245: return OK;
1.5 damieng 246: }
247: my $dirname = $uri;
1.7 raeburn 248: $dirname =~ s{^.*/([^/]*)$}{$1};
1.5 damieng 249: $res .= "<directory name=\"$dirname/\">\n";
1.12 raeburn 250: my (%is_course,%is_courseauthor);
1.5 damieng 251: if (ref($listref) eq 'ARRAY') {
252: my @lines = @{$listref};
253: foreach my $line (@lines) {
1.6 damieng 254: my ($path, $dom, undef, $testdir, undef, undef, undef, undef, $size, undef, $mtime, undef, undef, undef, $obs, undef) = split(/\&/, $line, 16);
1.5 damieng 255: my $isdir = ($testdir & 16384) || $dom =~ /^(user|domain)$/;
1.7 raeburn 256: $path =~ s{^/home/httpd/html/res/}{};
1.5 damieng 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 '') {
1.12 raeburn 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: }
1.5 damieng 291: }
292: }
1.7 raeburn 293: $path =~ s{/$}{};
1.5 damieng 294: my $name = $path;
295: if ($isdir) {
296: $res .= "<directory name=\"$name\"/>\n";
297: } else {
1.6 damieng 298: my $dt = DateTime->from_epoch(epoch => $mtime);
299: my $modified = $dt->iso8601().'Z';
300: $res .= "<file name=\"$name\" size=\"$size\" modified=\"$modified\"/>\n";
1.5 damieng 301: }
302: }
1.1 damieng 303: }
1.6 damieng 304: } elsif ($uri eq '/priv/') {
1.12 raeburn 305: my $defdom = &get_defdom($referrer);
306: if (!defined $defdom) {
1.6 damieng 307: $request->content_type('text/plain');
1.10 raeburn 308: $request->print(&mt('Forbidden URI: [_1]',$uri));
1.6 damieng 309: $request->status(403);
310: return OK;
311: }
312: $res .= "<directory name=\"priv\">\n";
1.12 raeburn 313: $res .= "<directory name=\"$defdom\"/>\n";
314: } elsif ($uri =~ m{^/priv/($match_domain)/$}) {
1.6 damieng 315: my $domain = $1;
1.12 raeburn 316: my $defdom = &get_defdom($referrer);
317: if ($domain ne $defdom) {
1.6 damieng 318: $request->content_type('text/plain');
1.10 raeburn 319: $request->print(&mt('Forbidden URI: [_1]',$uri));
1.6 damieng 320: $request->status(403);
321: return OK;
322: }
1.12 raeburn 323: my $defname = &get_defname($domain,$referrer);
1.6 damieng 324: $res .= "<directory name=\"$domain\">\n";
1.12 raeburn 325: $res .= "<directory name=\"$defname\"/>\n";
326: } elsif ($uri =~ m{^/priv/($match_domain)\/($match_username)/}) {
327: unless (&has_priv_access($uri)) {
1.6 damieng 328: $request->content_type('text/plain');
1.10 raeburn 329: $request->print(&mt('Forbidden URI: [_1]',$uri));
1.6 damieng 330: $request->status(403);
331: return OK;
332: }
1.5 damieng 333: my $dirpath = &Apache::lonnet::filelocation('', $uri);
334: if (! -e $dirpath) {
1.6 damieng 335: $request->content_type('text/plain');
1.10 raeburn 336: $request->print(&mt('Not found: [_1]',$uri));
1.5 damieng 337: $request->status(404);
338: return OK;
1.1 damieng 339: }
1.7 raeburn 340: $dirpath =~ s{/$}{};
1.9 raeburn 341: my @files;
342: if (opendir(my $dir, $dirpath)) {
343: @files = readdir($dir);
344: closedir($dir);
345: } else {
346: $request->content_type('text/plain');
1.10 raeburn 347: $request->print(&mt('Error opening directory: [_1]',$dirpath));
1.9 raeburn 348: $request->status(403);
349: return OK;
350: }
1.5 damieng 351: my $dirname = $dirpath;
1.7 raeburn 352: $dirname =~ s{^.*/([^/]*)$}{$1};
1.5 damieng 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: }
1.8 raeburn 361: my $sb = stat($dirpath.'/'.$name);
1.5 damieng 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: }
1.1 damieng 375: }
1.6 damieng 376: } else {
377: $request->content_type('text/plain');
1.10 raeburn 378: $request->print(&mt('Not found: [_1]',$uri));
1.6 damieng 379: $request->status(404);
380: return OK;
1.1 damieng 381: }
382: $res .= "</directory>\n";
383: &Apache::loncommon::content_type($request, 'text/xml', 'utf-8');
384: $request->print($res);
385: return OK;
386: }
387:
1.12 raeburn 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:
1.1 damieng 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