#!/usr/bin/perl
#
# $Id: archive.pl,v 1.1 2024/05/13 13:55:51 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/cgi-bin/archive.pl
#
# http://www.lon-capa.org/
#
# The LearningOnline Network with CAPA
#
# A CGI script which creates a compressed archive file of the current
# directory in Authoring Space, with optional (a) recursion into
# sub-directories, (b) filtering by filetype and (c) encryption.
# Supported formats are: tar.gz, tar.bz2, tar.xz and zip.
####
use strict;
use lib '/home/httpd/lib/perl';
use File::Find;
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonlocal;
use LONCAPA::loncgi;
use Cwd;
use HTML::Entities;
$|++;
my $lock;
our %excluded = (
bak => 1,
save => 1,
log => 1,
);
our $maxdepth = 0;
our %included = ();
our $alltypes = '';
our $recurse = '';
our $includeother = '';
our $prefix = '';
our $totalfiles = 0;
our $totalsize = 0;
our $totalsubdirs = 0;
our %subdirs = ();
our $fh;
if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
&Apache::lonlocal::get_language_handle();
print(&LONCAPA::loncgi::missing_cookie_msg());
} else {
&Apache::lonlocal::get_language_handle();
my %lt = &Apache::lonlocal::texthash (
indi => 'Invalid directory name',
outo => 'Output of command:',
comp => 'Archive creation complete.',
erro => 'An error occurred.',
cctf => 'Cannot create tar file',
dtf => 'Download tar file',
);
# Get the identifier and set a lock
my %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
&Apache::lonlocal::get_language_handle();
&Apache::loncommon::content_type(undef,'text/html');
my $identifier = $ENV{'QUERY_STRING'};
my ($hashref,$dir,$dirurl,$jsdirurl,$auname,$audom,$allowed,$error,$encrypt,$enckey,$format,$compress);
my @posstypes = qw(problem library sty sequence page task rights meta xml html xhtml htm xhtm css js tex txt gif jpg jpeg png svg other);
if (($identifier) && (exists($env{'cgi.'.$identifier.'.archive'}))) {
$hashref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$identifier.'.archive'});
if (ref($hashref) eq 'HASH') {
$dir = $hashref->{'dir'};
# check for traversal
if (-d $dir) {
$dirurl = $dir;
($auname,$audom) = &Apache::lonnet::constructaccess($dir);
if (($auname ne '') && ($audom ne '')) {
$dirurl =~ s/^\Q$londocroot\E//;
$prefix = $londocroot.$dirurl;
$maxdepth = $prefix =~ tr{/}{};
$jsdirurl = &js_escape($dirurl);
if (($auname eq $env{'user.name'}) && ($audom eq $env{'user.domain'}) &&
($env{'environment.authorarchive'})) {
$allowed = 1;
if ($hashref->{'recurse'}) {
$recurse = 1;
} else {
$recurse = 0;
}
if ($hashref->{'types'} eq 'all') {
$alltypes = 1;
} else {
$alltypes = 0;
my %possincluded;
map { $possincluded{$_} = 1; } split(/,/,$hashref->{'types'});
$includeother = 0;
foreach my $type (@posstypes) {
if ($type eq 'other') {
if ($possincluded{$type}) {
$includeother = 1;
} else {
$includeother = 0;
}
} else {
if ($possincluded{$type}) {
$included{$type} = 1;
} else {
$excluded{$type} = 1;
}
}
}
}
if ((exists($hashref->{'encrypt'}) && $hashref->{'encrypt'} ne '')) {
$encrypt = 1;
$enckey = $hashref->{'encrypt'};
}
if ((exists($hashref->{'format'}) && $hashref->{'format'} =~ /^zip$/i)) {
$format = lc($hashref->{'format'});
} else {
$format = 'tar';
}
unless ($format eq 'zip') {
if ((exists($hashref->{'compress'})) && ($hashref->{'compress'} =~ /^(xz|bzip2)$/i)) {
$compress = lc($hashref->{'compress'});
} else {
$compress = 'gzip';
}
}
}
}
} else {
$error = 'indi';
}
} else {
$error = 'nohash';
}
# delete cgi.$identifier.archive from %env
&Apache::lonnet::delenv('cgi.'.$identifier.'.archive');
} else {
$error = 'noid';
}
$env{'request.noversionuri'} = '/cgi-bin/archive.pl';
my ($brcrum,$title);
if ($error) {
$brcrum = [{'href' => '',
'text' => 'Missing information'}];
} elsif (!$allowed) {
$brcrum = [{'href' => '',
'text' => 'Access denied'}];
} else {
# Breadcrumbs
$title = 'Creating archive file';
$brcrum = [{'href' => $dirurl,
'text' => 'Authoring Space'},
{'href' => "javascript:gocstr('/adm/cfile?action=archive','$jsdirurl');",
'text' => 'File Operation'},
{'href' => '',
'text' => $title}];
}
my $js;
print &Apache::loncommon::start_page($title,
$js,
{'bread_crumbs' => $brcrum,})."\n".
'<form name="constspace" method="post" action="">'."\n".
'<input type="hidden" name="filename" value="" />'."\n";
if ($error) {
print "&mt('Cannot create archive file -- \n";
} elsif ($allowed) {
my (%location_of,@tocheck);
if ($format ne '') {
push(@tocheck,$format);
}
if ($compress ne '') {
push(@tocheck,$compress);
}
foreach my $program (@tocheck) {
foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
'/usr/sbin/') {
if (-x $dir.$program) {
$location_of{$program} = $dir.$program;
last;
}
}
}
if (exists($location_of{$format})) {
my $suffix;
if ($format eq 'zip') {
$suffix = 'zip';
} else {
$suffix = 'tar';
if (exists($location_of{$compress})) {
if ($compress eq 'bzip2') {
$suffix .= '.bz2';
} elsif ($compress eq 'gzip') {
$suffix .= '.gz';
} elsif ($compress eq 'xz') {
$suffix .= '.xz';
}
}
}
my $namesdest = $perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.'.txt';
my $filesdest = $perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.'.'.$suffix;
my $filesurl = '/prtspool/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.'.'.$suffix;
unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Archiving [_1]',$dirurl)); }
if (open($fh,'>',$namesdest)) {
find(
{preprocess => \&filter_files,
wanted => \&store_names,
no_chdir => 1,
},$dir);
close($fh);
if (($totalfiles) || ($totalsubdirs)) {
print '<p>'.
&mt('Archiving: [quant,_1,file,files] with total size: [_2] bytes in [quant,_3,subdirectory,subdirectories] ...',
$totalfiles,$totalsize,$totalsubdirs).
'</p>';
my ($cwd,@args);
if ($format eq 'zip') {
$cwd = &Cwd::getcwd();
@args = ('zip',$filesdest,'-v','-r','.','-i@'.$namesdest);
chdir $prefix;
} else {
@args = ('tar',"--create","--verbose");
if (($compress ne '') && (exists($location_of{$compress}))) {
push(@args,"--$compress");
}
push(@args,("--file=$filesdest","--directory=$prefix","--files-from=$namesdest"));
}
if (open(my $pipe,'-|',@args)) {
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin('',$totalfiles);
while (<$pipe>) {
&Apache::lonhtmlcommon::Increment_PrgWin('',\%prog_state,'last file');
}
&Apache::lonhtmlcommon::Close_PrgWin('',\%prog_state);
close($pipe);
if (!-e $filesdest) {
print '<p>'.&mt('No archive file available for download').'</p>'."\n";
}
} else {
print '<p>'.&mt('Could not call [_1] command',$format).'</p>'."\n";
}
if (($format eq 'zip') && ($cwd ne '')) {
chdir $cwd;
}
} else {
print '<p>'.&mt('No files match the requested types so no archive file was created.').'</p>'."\n";
}
unlink($namesdest);
} else {
print '<p>'.&mt('Could not store list of files to archive').'</p>'."\n";
}
if ($lock) { &Apache::lonnet::remove_lock($lock); }
} else {
print '<p>'.&mt('Could not find location of [_1] command',$format).'</p>'."\n";
}
}
if ($dirurl) {
print '<br /><br />'.
&Apache::lonhtmlcommon::actionbox(['<a href="'.&HTML::Entities::encode($dirurl,'\'"&<>').'">'.
&mt('Return to Directory').'</a>']);
}
print '</form>'.&Apache::loncommon::end_page();
# Code to delete archive file after successful download
%included = ();
$alltypes = '';
$recurse = '';
$includeother = '';
$prefix = '';
$totalfiles = 0;
$totalsize = 0;
$totalsubdirs = 0;
%excluded = (
bak => 1,
save => 1,
log => 1,
);
}
sub filter_files {
my @PossibleFiles = @_;
my @ChosenFiles;
foreach my $file (@PossibleFiles) {
if (-d $File::Find::dir."/".$file) {
if (!$recurse) {
my $depth = $File::Find::dir =~ tr[/][];
next unless ($depth < $maxdepth-1);
}
push(@ChosenFiles,$file);
} else {
my ($extension) = ($file =~ /\.([^.]+)$/);
if ((!$excluded{$extension}) && ($alltypes || $includeother || $included{$extension})) {
push(@ChosenFiles,$file);
}
}
}
return @ChosenFiles;
}
sub store_names {
my $filename = $File::Find::name;
if (-d $filename) {
unless ("$filename/" eq $prefix) {
if ($recurse) {
$subdirs{$filename} = 1;
$totalsubdirs ++;
}
}
next;
}
$totalfiles ++;
$totalsize += -s $filename;
$filename =~ s{^$prefix}{};
print $fh "$filename\n";
}
sub js {
my $output = <<'END';
const xhrButtonSuccess = document.querySelector(".xhr.success");
const xhrButtonError = document.querySelector(".xhr.error");
const xhrButtonAbort = document.querySelector(".xhr.abort");
const log = document.querySelector(".event-log");
function handleEvent(e) {
log.textContent = `${log.textContent}${e.type}: ${e.loaded} bytes transferred\n`;
}
function addListeners(xhr) {
xhr.addEventListener("loadstart", handleEvent);
xhr.addEventListener("load", handleEvent);
xhr.addEventListener("loadend", handleEvent);
xhr.addEventListener("progress", handleEvent);
xhr.addEventListener("error", handleEvent);
xhr.addEventListener("abort", handleEvent);
}
function runXHR(url) {
log.textContent = "";
const xhr = new XMLHttpRequest();
addListeners(xhr);
xhr.open("GET", url);
xhr.send();
return xhr;
}
xhrButtonSuccess.addEventListener("click", () => {
runXHR(
"https://somewhere",
);
});
xhrButtonError.addEventListener("click", () => {
runXHR("http://i-dont-exist");
});
xhrButtonAbort.addEventListener("click", () => {
runXHR(
"https://somewhere",
).abort();
});
END
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to archive.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi