#!/usr/bin/perl
#
# $Id: archive.pl,v 1.2 2024/05/21 02:57:17 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',
                                            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 = '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

}