# The LearningOnline Network
# Opening converted problems and directory listings for Daxe
#
# $Id: daxeopen.pm,v 1.7 2023/08/23 20:33:06 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###
package Apache::daxeopen;
use Apache::Constants;
use DateTime;
use Try::Tiny;
use File::stat;
use Fcntl ':mode';
use LONCAPA qw(:match);
use Apache::loncommon;
use Apache::lonnet;
use Apache::pre_xml;
use Apache::html_to_xml;
use Apache::post_xml;
sub handler {
my $request = shift;
my $uri = $request->uri;
$uri =~ s{^/daxeopen}{};
&Apache::loncommon::no_cache($request);
if ($uri =~ m{/$}) {
return directory_listing($uri, $request);
} elsif ($uri =~ m{^/priv/.*\.(task|problem|exam|quiz|assess|survey|library|xml|html|htm|xhtml|xhtm)$}) {
return convert_problem($uri, $request);
} else {
# Apache should send other files directly
$request->status(406);
return OK;
}
}
sub convert_problem {
my ($uri, $request) = @_;
if ($uri =~ m{^/priv/([^/]+)/([^/]+)/}) {
my ($domain, $user) = ($1, $2);
my ($uname, $udom) = ($env{'user.name'}, $env{'user.domain'});
if (!defined $uname || !defined $udom || $domain ne $udom || $user ne $uname) {
$request->content_type('text/plain');
$request->print("Forbidden URI: $uri");
$request->status(403);
return OK;
}
}
my $file = &Apache::lonnet::filelocation('', $uri);
&Apache::lonnet::repcopy($file);
if (! -e $file) {
$request->status(404);
return OK;
}
try {
my $warnings = 0; # no warning printed
my $textref = &Apache::pre_xml::pre_xml($file, $warnings);
my $case_sensitive;
if ($uri =~ /\.(task)$/) {
$case_sensitive = 1;
} else {
$case_sensitive = 0;
}
$textref = &Apache::html_to_xml::html_to_xml($textref, $warnings, $case_sensitive);
my $text = &Apache::post_xml::post_xml($textref, $file, $perlvar{'lonDocRoot'}, $warnings);
&Apache::loncommon::content_type($request, 'text/xml', 'utf-8');
$request->print($text);
return OK;
} catch {
$request->content_type('text/plain');
$request->print("convert failed for $file: $_");
$request->status(406);
return OK;
};
}
sub directory_listing {
my ($uri, $request) = @_;
my $res = '<?xml version="1.0" encoding="UTF-8"?>'."\n";
if ($uri eq '/') {
# root: let users browse /res
$res .= "<directory name=\"/\">\n";
$res .= "<directory name=\"priv\"/>\n";
$res .= "<directory name=\"res\"/>\n";
} elsif ($uri !~ /^\/(priv|res)\//) {
$request->content_type('text/plain');
$request->print("Not found: $uri");
$request->status(404);
return OK;
} elsif ($uri =~ m{^/res/}) {
# NOTE: dirlist does not return an error for /res/idontexist/
(my $listref, $listerror) = &Apache::lonnet::dirlist($uri);
if ($listerror) {
$request->content_type('text/plain');
$request->print("listing error: $listerror");
$request->status(406);
return OK;
} elsif ($uri =~ m{^/res/[^/]+/$} && scalar(@{$listref}) == 0) {
$request->content_type('text/plain');
$request->print("Not found: $uri");
$request->status(404);
return OK;
}
my $dirname = $uri;
$dirname =~ s{^.*/([^/]*)$}{$1};
$res .= "<directory name=\"$dirname/\">\n";
if (ref($listref) eq 'ARRAY') {
my @lines = @{$listref};
foreach my $line (@lines) {
my ($path, $dom, undef, $testdir, undef, undef, undef, undef, $size, undef, $mtime, undef, undef, undef, $obs, undef) = split(/\&/, $line, 16);
my $isdir = ($testdir & 16384) || $dom =~ /^(user|domain)$/;
$path =~ s{^/home/httpd/html/res/}{};
next if $path eq '.' || $path eq '..';
next if $path =~ /\.meta$/ || $obs || $path =~ /\.\d+\.[^.]+$/;
if ($dom ne 'domain') {
my ($udom,$uname);
if ($dom eq 'user') {
($udom) = ($uri =~ m{^/res/($match_domain)});
$uname = $path;
} else {
($udom, $uname) = ($uri =~ m{^/res/($match_domain)/($match_courseid)});
}
if ($udom ne '' && $uname ne '') {
# remove courses from the list
next if (&Apache::lonnet::is_course($udom, $uname));
}
}
$path =~ s{/$}{};
my $name = $path;
if ($isdir) {
$res .= "<directory name=\"$name\"/>\n";
} else {
my $dt = DateTime->from_epoch(epoch => $mtime);
my $modified = $dt->iso8601().'Z';
$res .= "<file name=\"$name\" size=\"$size\" modified=\"$modified\"/>\n";
}
}
}
} elsif ($uri eq '/priv/') {
my $udom = $env{'user.domain'};
if (!defined $udom) {
$request->content_type('text/plain');
$request->print("Forbidden URI: $uri");
$request->status(403);
return OK;
}
$res .= "<directory name=\"priv\">\n";
$res .= "<directory name=\"$udom\"/>\n";
} elsif ($uri =~ m{^/priv/([^/]+)/$}) {
my $domain = $1;
my ($uname, $udom) = ($env{'user.name'}, $env{'user.domain'});
if (!defined $uname || !defined $udom || $domain ne $udom) {
$request->content_type('text/plain');
$request->print("Forbidden URI: $uri");
$request->status(403);
return OK;
}
$res .= "<directory name=\"$domain\">\n";
$res .= "<directory name=\"$uname\"/>\n";
} elsif ($uri =~ m{^/priv/([^/]+)/([^/]+)/}) {
my ($domain, $user) = ($1, $2);
my ($uname, $udom) = ($env{'user.name'}, $env{'user.domain'});
if (!defined $uname || !defined $udom || $domain ne $udom || $user ne $uname) {
$request->content_type('text/plain');
$request->print("Forbidden URI: $uri");
$request->status(403);
return OK;
}
my $dirpath = &Apache::lonnet::filelocation('', $uri);
if (! -e $dirpath) {
$request->content_type('text/plain');
$request->print("Not found: $uri");
$request->status(404);
return OK;
}
$dirpath =~ s{/$}{};
opendir my $dir, $dirpath or die "Cannot open directory: $dirpath";
my @files = readdir $dir;
closedir $dir;
my $dirname = $dirpath;
$dirname =~ s{^.*/([^/]*)$}{$1};
$res .= "<directory name=\"$dirname\">\n";
foreach my $name (@files) {
if ($name eq '.' || $name eq '..') {
next;
}
if ($name =~ /\.(bak|log|meta|save)$/) {
next;
}
$sb = stat($dirpath.'/'.$name);
my $mode = $sb->mode;
if (S_ISDIR($mode)) {
$res .= "<directory name=\"$name\"/>\n";
} else {
$res .= "<file name=\"$name\"";
my $size = $sb->size; # total size of file, in bytes
$res .= " size=\"$size\"";
my $mtime = $sb->mtime; # last modify time in seconds since the epoch
my $dt = DateTime->from_epoch(epoch => $mtime);
my $modified = $dt->iso8601().'Z';
$res .= " modified=\"$modified\"";
$res .= "/>\n";
}
}
} else {
$request->content_type('text/plain');
$request->print("Not found: $uri");
$request->status(404);
return OK;
}
$res .= "</directory>\n";
&Apache::loncommon::content_type($request, 'text/xml', 'utf-8');
$request->print($res);
return OK;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>