Annotation of loncom/homework/daxeopen.pm, revision 1.13
1.1 damieng 1: # The LearningOnline Network
2: # Opening converted problems and directory listings for Daxe
3: #
1.13 ! raeburn 4: # $Id: daxeopen.pm,v 1.12 2023/08/23 22:57:39 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.7 raeburn 52: if ($uri =~ m{/$}) {
1.1 damieng 53: return directory_listing($uri, $request);
1.7 raeburn 54: } elsif ($uri =~ m{^/priv/.*\.(task|problem|exam|quiz|assess|survey|library|xml|html|htm|xhtml|xhtm)$}) {
1.1 damieng 55: return convert_problem($uri, $request);
1.13 ! raeburn 56: } elsif ($uri =~ m{^/uploaded/$match_domain/$match_courseid/(docs|supplemental)/(default|\d+)/\d+/.*\.(html|htm|xhtml|xhtm)$}) {
! 57: return convert_problem($uri, $request);
1.1 damieng 58: } else {
59: # Apache should send other files directly
1.2 damieng 60: $request->status(406);
61: return OK;
1.1 damieng 62: }
63: }
64:
65: sub convert_problem {
66: my ($uri, $request) = @_;
1.12 raeburn 67: if ($uri =~ m{^/priv/$match_domain/$match_username/}) {
68: unless (&has_priv_access($uri)) {
1.6 damieng 69: $request->content_type('text/plain');
1.10 raeburn 70: $request->print(&mt('Forbidden URI: [_1]',$uri));
1.6 damieng 71: $request->status(403);
72: return OK;
73: }
1.13 ! raeburn 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: }
1.6 damieng 92: }
1.1 damieng 93: my $file = &Apache::lonnet::filelocation('', $uri);
1.13 ! raeburn 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);
1.2 damieng 103: return OK;
1.1 damieng 104: }
105: try {
106: my $warnings = 0; # no warning printed
107: my $textref = &Apache::pre_xml::pre_xml($file, $warnings);
1.4 damieng 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);
1.8 raeburn 115: my $text = &Apache::post_xml::post_xml($textref, $file, $Apache::lonnet::perlvar{'lonDocRoot'}, $warnings);
1.1 damieng 116: &Apache::loncommon::content_type($request, 'text/xml', 'utf-8');
117: $request->print($text);
118: return OK;
119: } catch {
1.2 damieng 120: $request->content_type('text/plain');
1.10 raeburn 121: $request->print(&mt('convert failed for [_1]:',$file)." $_");
1.2 damieng 122: $request->status(406);
123: return OK;
1.1 damieng 124: };
125: }
126:
127: sub directory_listing {
128: my ($uri, $request) = @_;
1.5 damieng 129: my $res = '<?xml version="1.0" encoding="UTF-8"?>'."\n";
1.13 ! raeburn 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: }
1.5 damieng 136: if ($uri eq '/') {
137: $res .= "<directory name=\"/\">\n";
1.13 ! raeburn 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: }
1.11 raeburn 221: } elsif ($uri !~ m{^/(priv|res)/}) {
1.6 damieng 222: $request->content_type('text/plain');
1.10 raeburn 223: $request->print(&mt('Not found: [_1]',$uri));
1.2 damieng 224: $request->status(404);
225: return OK;
1.7 raeburn 226: } elsif ($uri =~ m{^/res/}) {
1.6 damieng 227: # NOTE: dirlist does not return an error for /res/idontexist/
1.8 raeburn 228: my ($listref, $listerror) = &Apache::lonnet::dirlist($uri);
1.5 damieng 229: if ($listerror) {
230: $request->content_type('text/plain');
1.10 raeburn 231: $request->print(&mt('listing error: [_1]',$listerror));
1.5 damieng 232: $request->status(406);
233: return OK;
1.7 raeburn 234: } elsif ($uri =~ m{^/res/[^/]+/$} && scalar(@{$listref}) == 0) {
1.6 damieng 235: $request->content_type('text/plain');
1.10 raeburn 236: $request->print(&mt('Not found: [_1]',$uri));
1.6 damieng 237: $request->status(404);
238: return OK;
1.5 damieng 239: }
240: my $dirname = $uri;
1.7 raeburn 241: $dirname =~ s{^.*/([^/]*)$}{$1};
1.5 damieng 242: $res .= "<directory name=\"$dirname/\">\n";
1.12 raeburn 243: my (%is_course,%is_courseauthor);
1.5 damieng 244: if (ref($listref) eq 'ARRAY') {
245: my @lines = @{$listref};
246: foreach my $line (@lines) {
1.6 damieng 247: my ($path, $dom, undef, $testdir, undef, undef, undef, undef, $size, undef, $mtime, undef, undef, undef, $obs, undef) = split(/\&/, $line, 16);
1.5 damieng 248: my $isdir = ($testdir & 16384) || $dom =~ /^(user|domain)$/;
1.7 raeburn 249: $path =~ s{^/home/httpd/html/res/}{};
1.5 damieng 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 '') {
1.12 raeburn 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: }
1.5 damieng 284: }
285: }
1.7 raeburn 286: $path =~ s{/$}{};
1.5 damieng 287: my $name = $path;
288: if ($isdir) {
289: $res .= "<directory name=\"$name\"/>\n";
290: } else {
1.6 damieng 291: my $dt = DateTime->from_epoch(epoch => $mtime);
292: my $modified = $dt->iso8601().'Z';
293: $res .= "<file name=\"$name\" size=\"$size\" modified=\"$modified\"/>\n";
1.5 damieng 294: }
295: }
1.1 damieng 296: }
1.6 damieng 297: } elsif ($uri eq '/priv/') {
1.12 raeburn 298: my $defdom = &get_defdom($referrer);
299: if (!defined $defdom) {
1.6 damieng 300: $request->content_type('text/plain');
1.10 raeburn 301: $request->print(&mt('Forbidden URI: [_1]',$uri));
1.6 damieng 302: $request->status(403);
303: return OK;
304: }
305: $res .= "<directory name=\"priv\">\n";
1.12 raeburn 306: $res .= "<directory name=\"$defdom\"/>\n";
307: } elsif ($uri =~ m{^/priv/($match_domain)/$}) {
1.6 damieng 308: my $domain = $1;
1.12 raeburn 309: my $defdom = &get_defdom($referrer);
310: if ($domain ne $defdom) {
1.6 damieng 311: $request->content_type('text/plain');
1.10 raeburn 312: $request->print(&mt('Forbidden URI: [_1]',$uri));
1.6 damieng 313: $request->status(403);
314: return OK;
315: }
1.12 raeburn 316: my $defname = &get_defname($domain,$referrer);
1.6 damieng 317: $res .= "<directory name=\"$domain\">\n";
1.12 raeburn 318: $res .= "<directory name=\"$defname\"/>\n";
319: } elsif ($uri =~ m{^/priv/($match_domain)\/($match_username)/}) {
320: unless (&has_priv_access($uri)) {
1.6 damieng 321: $request->content_type('text/plain');
1.10 raeburn 322: $request->print(&mt('Forbidden URI: [_1]',$uri));
1.6 damieng 323: $request->status(403);
324: return OK;
325: }
1.5 damieng 326: my $dirpath = &Apache::lonnet::filelocation('', $uri);
327: if (! -e $dirpath) {
1.6 damieng 328: $request->content_type('text/plain');
1.10 raeburn 329: $request->print(&mt('Not found: [_1]',$uri));
1.5 damieng 330: $request->status(404);
331: return OK;
1.1 damieng 332: }
1.7 raeburn 333: $dirpath =~ s{/$}{};
1.9 raeburn 334: my @files;
335: if (opendir(my $dir, $dirpath)) {
336: @files = readdir($dir);
337: closedir($dir);
338: } else {
339: $request->content_type('text/plain');
1.10 raeburn 340: $request->print(&mt('Error opening directory: [_1]',$dirpath));
1.9 raeburn 341: $request->status(403);
342: return OK;
343: }
1.5 damieng 344: my $dirname = $dirpath;
1.7 raeburn 345: $dirname =~ s{^.*/([^/]*)$}{$1};
1.5 damieng 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: }
1.8 raeburn 354: my $sb = stat($dirpath.'/'.$name);
1.5 damieng 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: }
1.1 damieng 368: }
1.6 damieng 369: } else {
370: $request->content_type('text/plain');
1.10 raeburn 371: $request->print(&mt('Not found: [_1]',$uri));
1.6 damieng 372: $request->status(404);
373: return OK;
1.1 damieng 374: }
375: $res .= "</directory>\n";
376: &Apache::loncommon::content_type($request, 'text/xml', 'utf-8');
377: $request->print($res);
378: return OK;
379: }
380:
1.12 raeburn 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:
1.1 damieng 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