--- loncom/cgi/archive.pl	2024/05/13 13:55:51	1.1
+++ loncom/cgi/archive.pl	2024/09/03 10:40:04	1.3
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 #
-# $Id: archive.pl,v 1.1 2024/05/13 13:55:51 raeburn Exp $
+# $Id: archive.pl,v 1.3 2024/09/03 10:40:04 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -28,7 +28,7 @@
 #
 # 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.
+# sub-directories, and (b) filtering by filetype.
 # Supported formats are: tar.gz, tar.bz2, tar.xz and zip.
 ####
 use strict;
@@ -70,10 +70,11 @@ if (!&LONCAPA::loncgi::check_cookie_and_
     &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',
+                                            cctf => 'Cannot create tar file',
                                             dtf  => 'Download tar file',
                                          );
 # Get the identifier and set a lock
@@ -82,13 +83,14 @@ if (!&LONCAPA::loncgi::check_cookie_and_
     &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 ($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) && (exists($env{'cgi.'.$identifier.'.archive'}))) {
+    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'};
-            # check for traversal
+            $dir =~ s{\.+}{.}g;
             if (-d $dir) {
                 $dirurl = $dir;
                 ($auname,$audom) = &Apache::lonnet::constructaccess($dir);
@@ -98,7 +100,7 @@ if (!&LONCAPA::loncgi::check_cookie_and_
                     $maxdepth = $prefix =~ tr{/}{};
                     $jsdirurl = &js_escape($dirurl);
                     if (($auname eq $env{'user.name'}) && ($audom eq $env{'user.domain'}) &&
-                        ($env{'environment.authorarchive'})) {
+                        ($env{'environment.canarchive'})) {
                         $allowed = 1;
                         if ($hashref->{'recurse'}) {
                             $recurse = 1;
@@ -128,10 +130,6 @@ if (!&LONCAPA::loncgi::check_cookie_and_
                                 }
                             }
                         }
-                        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 {
@@ -144,6 +142,17 @@ if (!&LONCAPA::loncgi::check_cookie_and_
                                 $compress = 'gzip';
                             }
                         }
+                        if ($hashref->{'adload'}) {
+                            $adload = $hashref->{'adload'};
+                        }
+                        if ($hashref->{'fname'}) {
+                            $fname = $hashref->{'fname'};
+                        }
+                        if ($hashref->{'extension'}) {
+                            $extension = $hashref->{'extension'};
+                        }
+                    } else {
+                        $error = 'noau';
                     }
                 }
             } else {
@@ -152,8 +161,10 @@ if (!&LONCAPA::loncgi::check_cookie_and_
         } else {
             $error = 'nohash';
         }
-# delete cgi.$identifier.archive from %env
-        &Apache::lonnet::delenv('cgi.'.$identifier.'.archive');
+# delete cgi.$identifier.archive from %env if error
+        if ($error) {
+            &Apache::lonnet::delenv('cgi.'.$identifier.'.archive');
+        }
     } else {
         $error = 'noid';
     }
@@ -175,22 +186,16 @@ if (!&LONCAPA::loncgi::check_cookie_and_
                    {'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);
+# 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/') {
@@ -200,26 +205,66 @@ if (!&LONCAPA::loncgi::check_cookie_and_
                 }
             }
         }
-        if (exists($location_of{$format})) {
-            my $suffix;
+        if (($format ne '') && (exists($location_of{$format}))) {
             if ($format eq 'zip') {
-                $suffix = 'zip';
+                $suffix = '.zip';
+                $mime = 'application/x-zip-compressed';
             } else {
-                $suffix = 'tar';
-                if (exists($location_of{$compress})) {
+                $suffix = '.tar';
+                if (($compress ne '') &&
+                    (exists($location_of{$compress}))) {
                     if ($compress eq 'bzip2') {
-                        $suffix .= '.bz2'; 
+                        $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';
                     }
                 }
             }
-            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)); }
+            $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,
@@ -227,38 +272,85 @@ if (!&LONCAPA::loncgi::check_cookie_and_
                       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)) {
-                    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");
+                    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;
+                            }
                         }
-                        push(@args,("--file=$filesdest","--directory=$prefix","--files-from=$namesdest"));
+                        close($pipe);
                     }
-                    if (open(my $pipe,'-|',@args)) {
-                        my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin('',$totalfiles); 
-                        while (<$pipe>) {
-                            &Apache::lonhtmlcommon::Increment_PrgWin('',\%prog_state,'last file');
+                    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);
                         }
-                        &Apache::lonhtmlcommon::Close_PrgWin('',\%prog_state);
-                        close($pipe);
-                        if (!-e $filesdest) {
-                            print '<p>'.&mt('No archive file available for download').'</p>'."\n"; 
+                        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('Could not call [_1] command',$format).'</p>'."\n";
-                    }
-                    if (($format eq 'zip') && ($cwd ne '')) {
-                        chdir $cwd;
+                        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";
@@ -273,7 +365,7 @@ if (!&LONCAPA::loncgi::check_cookie_and_
         }
     }
     if ($dirurl) {
-        print '<br /><br />'.
+        print '<br />'.
               &Apache::lonhtmlcommon::actionbox(['<a href="'.&HTML::Entities::encode($dirurl,'\'"&<>').'">'.
                                                  &mt('Return to Directory').'</a>']);
     }
@@ -306,6 +398,7 @@ sub filter_files {
             }
             push(@ChosenFiles,$file);
         } else {
+            next if ($file =~ /^\./);
             my ($extension) = ($file =~ /\.([^.]+)$/);
             if ((!$excluded{$extension}) && ($alltypes || $includeother || $included{$extension})) {
                 push(@ChosenFiles,$file);
@@ -332,54 +425,155 @@ sub store_names {
     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 $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();
-});
+    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';
+            }
+        }
+    }
+}
 
-END
+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
+
+}