#!/usr/bin/perl
#
# $Id: archive.pl,v 1.3 2024/09/03 10:40:04 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, and (b) filtering by filetype.
# 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',
noau => 'Archive creation only available to Author',
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,
$format,$compress,$fname,$extension,$adload,$url,$mime);
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 =~ /^\d+_\d+_\d+$/) && (exists($env{'cgi.'.$identifier.'.archive'}))) {
$hashref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$identifier.'.archive'});
if (ref($hashref) eq 'HASH') {
$dir = $hashref->{'dir'};
$dir =~ s{\.+}{.}g;
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.canarchive'})) {
$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->{'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';
}
}
if ($hashref->{'adload'}) {
$adload = $hashref->{'adload'};
}
if ($hashref->{'fname'}) {
$fname = $hashref->{'fname'};
}
if ($hashref->{'extension'}) {
$extension = $hashref->{'extension'};
}
} else {
$error = 'noau';
}
}
} else {
$error = 'indi';
}
} else {
$error = 'nohash';
}
# delete cgi.$identifier.archive from %env if error
if ($error) {
&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}];
}
# Set up files to write two and url
my ($js,%location_of,$suffix,$namesdest,$filesdest,$filesurl);
if ($allowed) {
my @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 (($format ne '') && (exists($location_of{$format}))) {
if ($format eq 'zip') {
$suffix = '.zip';
$mime = 'application/x-zip-compressed';
} else {
$suffix = '.tar';
if (($compress ne '') &&
(exists($location_of{$compress}))) {
if ($compress eq 'bzip2') {
$suffix .= '.bz2';
$mime = 'application/x-bzip2';
} elsif ($compress eq 'gzip') {
$suffix .= '.gz';
$mime = 'application/x-gzip';
} elsif ($compress eq 'xz') {
$suffix .= '.xz';
$mime = 'application/x-xz';
}
}
}
$namesdest = $perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.'.txt';
$filesdest = $perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.$suffix;
$filesurl = '/prtspool/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.$suffix;
if ($suffix eq $extension) {
$fname =~ s{\Q$suffix\E$}{};
}
if ($fname eq '') {
$fname = $env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.$suffix;
} else {
$fname .= $suffix;
}
my $downloadurl = &Apache::lonnet::absolute_url().$filesurl;
my $delarchive = $identifier.$suffix;
$js = &js($filesurl,$mime,$fname,$delarchive);
}
}
print &Apache::loncommon::start_page($title,
'',
{'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');
} elsif ($allowed) {
if (-e $filesdest) {
my $mtime = (stat($filesdest))[9];
print '<div id="LC_archive_desc">'."\n";
if ($mtime) {
print '<p class="LC_warning">'.&mt('Archive file already exists -- created: [_1].',
&Apache::lonlocal::locallocaltime($mtime)).'</p>';
} else {
print '<p class="LC_warning">'.&mt('Archive file already exists.').'</p>';
}
print '</div>'."\n";
print &archive_link($adload,$filesurl,$suffix);
if ($adload) {
print $js;
}
} elsif (exists($location_of{$format})) {
unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Creating Archive file for [_1]',$dirurl)); }
if (open($fh,'>',$namesdest)) {
find(
{preprocess => \&filter_files,
wanted => \&store_names,
no_chdir => 1,
},$dir);
close($fh);
if (ref($hashref) eq 'HASH') {
$hashref->{'numfiles'} = $totalfiles;
$hashref->{'numdirs'} = $totalsubdirs;
$hashref->{'bytes'} = $totalsize;
my $storestring = &Apache::lonnet::freeze_escape($hashref);
&Apache::lonnet::appenv({'cgi.'.$identifier.'.archive' => $storestring});
}
&Apache::lonnet::thaw_unescape($env{'cgi.'.$identifier.'.archive'});
if (($totalfiles) || ($totalsubdirs)) {
my $freespace;
my @dfargs = ('df','-k','--output=avail','/home');
if (open(my $pipe,'-|',@dfargs)) {
while (my $line = <$pipe>) {
chomp($line);
if ($line =~ /^\d+$/) {
$freespace = $line;
last;
}
}
close($pipe);
}
if (($freespace ne '') && ($totalsize < $freespace*1024)) {
my $showsize = $totalsize/(1024*1024);
if ($showsize <= 0.01) {
$showsize = sprintf("%.3f",$showsize);
} elsif ($showsize <= 0.1) {
$showsize = sprintf("%.2f",$showsize);
} elsif ($showsize < 10) {
$showsize = sprintf("%.1f",$showsize);
} else {
$showsize = sprintf("%.0f",$showsize);
}
print '<div id="LC_archive_desc"><p>'.
&mt('Creating archive file for [quant,_1,file,files] with total size before compression of [_2] MB.',
$totalfiles,$showsize);
if ($totalsubdirs) {
print '<br />'.&mt('Archive includes [quant,_1,subdirectory,subdirectories].',
$totalsubdirs);
}
print '</p></div>';
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) {
my $size = (stat($filesdest))[7];
&Apache::lonnet::authorarchivelog($hashref,$size,$filesdest,'create');
print &archive_link($adload,$filesurl,$suffix);
if ($adload) {
print $js;
}
} else {
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;
}
} elsif ($freespace eq '') {
print '<p>'.&mt('No archive file created as the available free space could not be determined.').'</p>'."\n";
} else {
print '<p>'.&mt('No archive file created because there is insufficient free space available.').'</p>'."\n";
}
} 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 />'.
&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 {
next if ($file =~ /^\./);
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 archive_link {
my ($adload,$filesurl,$suffix) = @_;
if ($adload) {
return
'<button id="LC_download_button" onclick="return false">'.&mt('Download').'</button></p>'."\n".
'<div style="display:none; width:100%;" id="LC_dload_progress" >'."\n".
'<div id="LC_dl_progressbar"></div>'."\n".
'</div>'."\n".
'<span id="LC_download_result"></span>'."\n";
} else {
return
'<p><a href="'.$filesurl.'">'.&mt('Download [_1] file',$suffix).'</a></p>'."\n";
}
}
sub js {
my ($url,$mime,$fname,$delarchive) = @_;
&js_escape(\$url);
&js_escape(\$mime);
&js_escape(\$fname);
my %js_lt = &Apache::lonlocal::texthash (
afdo => 'Archive file download complete.',
diun => 'Download is unavailable.',
tfbr => 'The archive file has been removed.',
ynrd => 'You do not have rights to download the archive file.',
);
&js_escape(\%js_lt);
return <<"END";
<script type="text/javascript">
// <![CDATA[
function showProgress(event) {
if (event.lengthComputable) {
var complete = 0;
if (event.total > 0) {
complete = Math.round( (event.loaded / event.total) * 100);
}
\$( "#LC_dl_progressbar" ).progressbar({
value: complete
});
if (complete == '100') {
if (document.getElementById('LC_dload_progress')) {
document.getElementById('LC_dload_progress').style.display = 'none';
}
}
}
}
function cleanUp(event) {
showProgress(event);
if (event.lengthComputable) {
var complete = 0;
if (event.total > 0) {
complete = Math.round( (event.loaded / event.total) * 100);
}
if (complete == 100) {
var dbtn = document.querySelector('#LC_download_button');
if (dbtn !== null) {
dbtn.style.display = 'none';
}
var http = new XMLHttpRequest();
var lcurl = "/adm/cfile";
var params = 'delarchive=$delarchive';
var result;
http.open("POST",lcurl, true);
http.setRequestHeader("Content-type", "application/x-www-form-urlencoded");
http.onreadystatechange = function() {
if ((http.readyState == 4) && (http.status == 200)) {
if (http.responseText.length > 0) {
if (http.responseText == 1) {
if (document.getElementById('LC_archive_desc')) {
document.getElementById('LC_archive_desc').style.display = 'none';
}
if (document.getElementById('LC_download_result')) {
document.getElementById('LC_download_result').innerHTML = '$js_lt{afdo}<br />';
}
}
}
}
}
http.send(params);
}
}
}
function filecheck(file, callback) {
const xhr = new XMLHttpRequest();
xhr.open('HEAD',file,true);
xhr.onreadystatechange = function() {
if (this.readyState >= 2) {
callback(this.status);
this.abort();
}
};
xhr.send();
}
function download(file,callback) {
if (document.getElementById('LC_dload_progress')) {
document.getElementById('LC_dload_progress').style.display = 'block';
}
const xhr = new XMLHttpRequest();
xhr.responseType = 'blob';
xhr.open('GET', file);
xhr.addEventListener('progress',showProgress);
xhr.addEventListener('load', function () {
callback(xhr.response);
});
xhr.addEventListener("loadend", cleanUp);
xhr.send();
}
function save(object,mime,name) {
var a = document.createElement('a');
var url = URL.createObjectURL(object);
a.href = url;
a.type = mime;
a.download = name;
a.click();
}
var dbtn = document.querySelector('#LC_download_button');
if (dbtn !== null) {
dbtn.addEventListener('click', function () {
filecheck('$url',function (response) {
if (response == 200) {
download('$url', function (file) {
save(file,'$mime','$fname');
});
} else if ((response == 404) || (response == 403) || (response == 406)) {
dbtn.style.display = 'none';
if (document.getElementById('LC_dload_progress')) {
document.getElementById('LC_dload_progress').style.display = 'none';
}
if (document.getElementById('LC_download_result')) {
if (response == 404) {
document.getElementById('LC_download_result').innerHTML = '$js_lt{diun} $js_lt{tfbr}<br />';
} else {
document.getElementById('LC_download_result').innerHTML = '$js_lt{diun} $js_lt{ynrd}<br />';
}
}
}
});
});
}
// ]]>
</script>
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