--- loncom/publisher/loncfile.pm	2024/05/13 13:55:50	1.128
+++ loncom/publisher/loncfile.pm	2024/09/03 10:40:04	1.130
@@ -9,7 +9,7 @@
 #  and displays a page showing the results of the action.
 #
 #
-# $Id: loncfile.pm,v 1.128 2024/05/13 13:55:50 raeburn Exp $
+# $Id: loncfile.pm,v 1.130 2024/09/03 10:40:04 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -822,42 +822,19 @@ sub Decompress1 {
 sub Archive1 {
     my ($request,$fn) = @_;
     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);
-    my (%location_of,%default,$compstyle);
-    foreach my $program ('tar','gzip','bzip2','xz','zip') {
-        foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
-                         '/usr/sbin/') {
-            if (-x $dir.$program) {
-                $location_of{$program} = $dir.$program;
-                last;
-            }
-        }
-    }
-    my (%defaults,$cancompress,$canarchive);
-    if (exists($location_of{'tar'})) {
-        $default{'tar'} = ' checked="checked"';
-        $canarchive = 1;
-        $compstyle = 'block';
-    } elsif (exists($location_of{'zip'})) {
-        $default{'zip'} = ' checked="checked"';
-        $canarchive = 1;
-        $compstyle = 'none';
-    }
-    foreach my $compress ('gzip','bzip2','xz') {
-        if (exists($location_of{$compress})) {
-            $default{$compress} = ' checked="checked"';
-            $cancompress = 1;
-            last;
-        }
-    }
+    my (%location_of,%defaults);
+    my ($compstyle,$canarchive,$cancompress,$numformat,$numcompress,$defext) =
+        &archive_tools(\%location_of,\%defaults);
     if (!$canarchive) {
         $request->print('<p class="LC_error">'.
-                        &mt('This LON-CAPA instance does not seem to have either tar or zip installed.').'</p>'.
+                        &mt('This LON-CAPA instance does not seem to have either tar or zip installed.').'</p>'."\n".
                         '<span class="LC_warning">'.
                         &mt('At least one of the two is needed in order to be able to create an archive file for: [_1].',
-                            &display($fn)).
+                            &display($fn))."\n".
                         '</span></form>');
     } elsif (-e $fn) {
-        $request->print(&Apache::lonhtmlcommon::start_pick_box().
+        $request->print('<input type="hidden" name="adload" value="" />'."\n".
+                        &Apache::lonhtmlcommon::start_pick_box().
                         &Apache::lonhtmlcommon::row_title(&mt('Directory')).
                         &display($fn).
                         &Apache::lonhtmlcommon::row_closure().
@@ -909,7 +886,7 @@ sub Archive1 {
             if (exists($location_of{$possfmt})) {
                 $request->print('<span class="LC_nobreak">'.
                                 '<label><input type="radio" name="format" value="'.$possfmt.'"'.
-                                $default{$possfmt}.' onclick="toggleCompression(this.form);" /> '.
+                                $defaults{$possfmt}.' onclick="toggleCompression(this.form);" /> '.
                                 $possfmt.'</label></span>&nbsp;&nbsp; ');
             }
         }
@@ -921,7 +898,8 @@ sub Archive1 {
             foreach my $compress ('gzip','bzip2','xz') {
                 if (exists($location_of{$compress})) {
                     $request->print('<label><input type="radio" name="compress" value="'.$compress.'"'.
-                                    $default{$compress}.'  />'.$compress.'</label>&nbsp;&nbsp;');
+                                    $defaults{$compress}.' onclick="setArchiveExt(this.form);"  />'.
+                                    $compress.'</label>&nbsp;&nbsp;');
                 }
             }
         } else {
@@ -929,9 +907,16 @@ sub Archive1 {
                             &mt('This LON-CAPA instance does not seem to have gzip, bzip2 or xz installed.').
                             '<br />'.&mt('No compression will be used.').'</span>');
         }
-        $request->print('</fieldset>'. 
+        $request->print('</fieldset>'."\n".
+                        '<fieldset style="display:none" id="archive_saveas">'.
+                        '<legend>'.&mt('Filename to download').'</legend>'.
+                        '<table style="border-spacing:0"><tr><td style="padding:0;">'.&mt('Name').'<br />'."\n".
+                        '<input type="text" name="archivefname" value="" size="8" /></td><td style="padding:0;">'.
+                        &mt('Extension').'<br />'."\n".
+                        '<input type="text" name="archiveext" id="archiveext" value="" size="4" readonly="readonly" />'.
+                        '</td></tr></table></fieldset>'."\n".
                         &Apache::lonhtmlcommon::row_closure(1).
-                        &Apache::lonhtmlcommon::end_pick_box()
+                        &Apache::lonhtmlcommon::end_pick_box().'<br />'."\n"
         );
         &CloseForm1($request, $fn);
     } else {
@@ -941,6 +926,110 @@ sub Archive1 {
                        .'</p></form>'
         );
     }
+    return;
+}
+
+sub archive_tools {
+    my ($location_of,$defaults) = @_;
+    my ($compstyle,$canarchive,$cancompress,$numformat,$numcompress,$defext);
+    ($numformat,$numcompress) = (0,0);
+    if ((ref($location_of) eq 'HASH') && (ref($defaults) eq 'HASH')) {
+        foreach my $program ('tar','gzip','bzip2','xz','zip') {
+            foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
+                             '/usr/sbin/') {
+                if (-x $dir.$program) {
+                    $location_of->{$program} = $dir.$program;
+                    last;
+                }
+            }
+        }
+        foreach my $format ('tar','zip') {
+            if (exists($location_of->{$format})) {
+                unless ($canarchive) {
+                    $defext = $format;
+                    $defaults->{$format} = ' checked="checked"';
+                    if ($format eq 'tar') {
+                        $compstyle = 'block';
+                    } else {
+                        $compstyle = 'none';
+                    }
+                }
+                $canarchive = 1;
+                $numformat ++;
+            }
+        }
+        foreach my $compress ('gzip','bzip2','xz') {
+            if (exists($location_of->{$compress})) {
+                $numcompress ++;
+                unless ($cancompress) {
+                    if ($defext eq 'tar') {
+                        if ($compress eq 'gzip') {
+                            $defext .= '.gz';
+                        } elsif ($compress eq 'bzip2') {
+                            $defext .= '.bz2';
+                        } else {
+                            $defext .= ".$compress";
+                        }
+                    }
+                    $defaults->{$compress} = ' checked="checked"';
+                    $cancompress = 1;
+                }
+            }
+        }
+    }
+    if (wantarray) {
+        return ($compstyle,$canarchive,$cancompress,$numformat,$numcompress,$defext);
+    } else {
+        return $defext;
+    }
+}
+
+sub archive_in_progress {
+    my ($earlyout,$idnum);
+    if ($env{'cgi.author.archive'} =~ /^(\d+)_\d+_\d+$/) {
+        my $timestamp = $1;
+        $idnum = $env{'cgi.author.archive'};
+        if (exists($env{'cgi.'.$idnum.'.archive'})) {
+            my $hashref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$idnum.'.archive'});
+            my $lonprtdir = $Apache::lonnet::perlvar{'lonPrtDir'};
+            if (-e $lonprtdir.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$idnum.'.txt') {
+                $earlyout = $timestamp;
+            } elsif (ref($hashref) eq 'HASH') {
+                my $suffix = $hashref->{'extension'};
+                if (-e $lonprtdir.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$idnum.$suffix) {
+                    $earlyout = $timestamp;
+                }
+            }
+            unless ($earlyout) {
+                &Apache::lonnet::delenv('cgi.'.$idnum.'.archive');
+                &Apache::lonnet::delenv('cgi.author.archive');
+            }
+        } else {
+            &Apache::lonnet::delenv('cgi.author.archive');
+        }
+    }
+    return ($earlyout,$idnum);
+}
+
+sub cancel_archive_form {
+    my ($r,$title,$fname,$earlyout,$idnum) = @_;
+    $r->print('<h2>'.$title.'</h2>'."\n".
+              '<form action="/adm/cfile" method="post" onsubmit="return confirmation(this);">'."\n".
+              '<input type="hidden" name="filename" value="'.$fname.'" />'."\n".
+              '<input type="hidden" name="action" value="'.$env{'form.action'}.'" />'."\n".
+              '<p>'.&mt('Each author may only have one archive request in process at a time.')."\n".'<ul>'.
+              '<li>'.&mt('An incomplete archive request was begun: [_1].',
+                         &Apache::lonlocal::locallocaltime($earlyout)).
+              '</li>'."\n".
+              '<li>'.&mt('An archive request is considered complete when the archive file has been successfully downloaded.').'</li>'."\n".
+              '<li>'.
+              &mt('To submit a new archive request, either wait for the existing request (e.g., in another tab/window) to complete, or remove it.').'</li>'."\n".
+              '</ul></p>'."\n".
+              '<p><span class="LC_nobreak">'.&mt('Remove existing archive request?').'&nbsp;'."\n".
+              '<label><input type="radio" name="remove_archive_request" value="'.$idnum.'" />'.&mt('Yes').'</label>'.
+              ('&nbsp;'x2)."\n".
+              '<label><input type="radio" name="remove_archive_request" value="" checked="checked" />'.&mt('No').'</label></span></p>'."\n".
+              '<br />');
 }
 
 =pod
@@ -1118,10 +1207,10 @@ sub phaseone {
                   '</a></p>');
         return;
     }
-    $r->print('<form action="/adm/cfile" method="post" name="phaseone">'.
-	      '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
-	      '<input type="hidden" name="phase" value="two" />'.
-	      '<input type="hidden" name="action" value="'.$env{'form.action'}.'" />');
+    $r->print('<form action="/adm/cfile" method="post" name="phaseone">'."\n".
+	      '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'."\n".
+	      '<input type="hidden" name="phase" value="two" />'."\n".
+	      '<input type="hidden" name="action" value="'.$env{'form.action'}.'" />'."\n");
 
     if ($env{'form.action'} eq 'newfile' ||
         $env{'form.action'} eq 'newhtmlfile' ||
@@ -1158,7 +1247,14 @@ sub phaseone {
         } elsif ($env{'form.action'} eq 'decompress') {
 	    &Decompress1($r, $uname, $udom, $fn);
         } elsif ($env{'form.action'} eq 'archive') {
-            &Archive1($r,$fn);
+            if (($uname eq $env{'user.name'}) && ($udom eq $env{'user.domain'})) {
+                &Archive1($r,$fn);
+            } else {
+                $r->print('<p class="LC_error">'
+                         .&mt('Archiving of Authoring Spaces is only permitted by Author')
+                         .'</p></form>'
+                );
+            }
         } elsif ($env{'form.action'} eq 'copy') {
 	    if ($newfilename) {
 	        &Copy1($r, $uname, $udom, $fn, $newfilename);
@@ -1437,10 +1533,22 @@ sub decompress2 {
 }
 
 sub Archive2 {
-    my ($r,$name,$udom,$fn,$identifier) = @_;
+    my ($r,$uname,$udom,$fn,$identifier) = @_;
     my %options = (
                     dir => $fn,
+                    uname => $uname,
+                    udom => $udom,
                   );
+    if ($env{'form.adload'}) {
+        $options{'adload'} = 1;
+        if ($env{'form.archivefname'} ne '') {
+            $env{'form.archivefname'} =~ s{\.+}{.}g;
+            $options{'fname'} = $env{'form.archivefname'};
+        }
+        if ($env{'form.archiveext'} ne '') {
+            $options{'extension'} = $env{'form.archiveext'};
+        }
+    }
     my @filetypes = qw(problem library sty sequence page task rights meta xml html xhtml htm xhtm css js tex txt gif jpg jpeg png svg other);
     my (@include,%oktypes);
     map { $oktypes{$_} = 1; } @filetypes;
@@ -1473,10 +1581,40 @@ sub Archive2 {
     }
     my $key = 'cgi.'.$identifier.'.archive';
     my $storestring = &Apache::lonnet::freeze_escape(\%options);
-    &Apache::lonnet::appenv({$key => $storestring});
+    &Apache::lonnet::appenv({$key => $storestring,
+                             'cgi.author.archive' => $identifier});
     return 1;
 }
 
+sub Archive3 {
+    my ($hashref) = @_;
+    if (ref($hashref) eq 'HASH') {
+        if (($hashref->{'uname'} eq $env{'user.name'}) &&
+            ($hashref->{'udom'} eq $env{'user.domain'}) &&
+            ($env{'environment.canarchive'}) &&
+            ($env{'form.delarchive'})) {
+            my $filesdest = $Apache::lonnet::perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$env{'form.delarchive'};
+            if (-e $filesdest) {
+                my $size = (stat($filesdest))[7];
+                if (unlink($filesdest)) {
+                    my ($identifier,$suffix) = split(/\./,$env{'form.delarchive'},2);
+                    if (($identifier) && (exists($env{'cgi.'.$identifier.'.archive'}))) {
+                        my $delres = &Apache::lonnet::delenv('cgi.'.$identifier.'.archive');
+                        if (($delres eq 'ok') &&
+                            (exists($env{'cgi.author.archive'})) &&
+                            ($env{'cgi.author.archive'} eq $identifier)) {
+                            &Apache::lonnet::authorarchivelog($hashref,$size,$filesdest,'delete');
+                            &Apache::lonnet::delenv('cgi.author.archive');
+                        }
+                    }
+                    return 1;
+                }
+            }
+        }
+    }
+    return 0;
+}
+
 =pod
 
 =item phasetwo($r, $fn, $uname, $udom,$identifier)
@@ -1548,7 +1686,13 @@ sub phasetwo {
 	}
 	$dest = $dir."/.";
     } elsif ($env{'form.action'} eq 'archive') {
-        &Archive2($r,$uname,$udom,$fn,$identifier);
+        if (($env{'environment.archive'}) &&
+            ($env{'user.name'} eq $uname) &&
+            ($env{'user.domain'} eq $udom)) {
+            &Archive2($r,$uname,$udom,$fn,$identifier);
+        } else {
+            $r->print(&mt('You do not have permission to export to an archive file in this Authoring Space'));
+        }
         return;
     } elsif ($env{'form.action'} eq 'rename' ||
 	     $env{'form.action'} eq 'move') {
@@ -1624,20 +1768,34 @@ sub handler {
 #
 # Determine the root filename
 # This could come in as "filename", which actually is a URL, or
-# as "qualifiedfilename", which is indeed a real filename in filesystem
+# as "qualifiedfilename", which is indeed a real filename in filesystem,
+# or in value of decompress form element, or need to be extracted
+# from %env from hashref retrieved for cgi.<id>.archive key, where id
+# is a unique cgi_id created when an Author creates an archive of
+# Authoring Space for download.
 #
-    my $fn;
+    my ($fn,$archiveref);
 
     if ($env{'form.filename'}) {
 	&Debug($r, "test: $env{'form.filename'}");
 	$fn=&unescape($env{'form.filename'});
 	$fn=&URLToPath($fn);
+    } elsif ($env{'form.delarchive'}) {
+        my ($delarchive,$suffix) = split(/\./,$env{'form.delarchive'});
+        if (($delarchive) && (exists($env{'cgi.'.$delarchive.'.archive'}))) {
+            $archiveref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$delarchive.'.archive'});
+            if (ref($archiveref) eq 'HASH') {
+                $fn = $archiveref->{'dir'};
+            }
+        }
     } elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') {
 	#Just hijack the script only the first time around to inject the
 	#correct information for further processing
-	$fn=&unescape($env{'form.decompress'});
-	$fn=&URLToPath($fn);
-	$env{'form.action'}="decompress";
+        if ($env{'form.decompress'} ne '') {
+	    $fn=&unescape($env{'form.decompress'});
+	    $fn=&URLToPath($fn);
+	    $env{'form.action'}="decompress";
+        }
     } elsif ($env{'form.qualifiedfilename'}) {
 	$fn=$env{'form.qualifiedfilename'};
     } else {
@@ -1666,12 +1824,24 @@ sub handler {
 		       $r->filename);
 	return HTTP_NOT_ACCEPTABLE;
     }
-
+    if (($env{'form.delarchive'}) &&
+        ($env{'environment.canarchive'})) {
+        &Apache::loncommon::content_type($r,'text/plain');
+        $r->send_http_header;
+        if (($env{'user.name'} eq $uname) &&
+            ($env{'user.domain'} eq $udom)) {
+            $r->print(&Archive3($archiveref));
+        } else {
+            $r->print(&mt('You do not have permission to export to an archive file in this Authoring Space'));
+        }
+        return OK;
+    }
 
     &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;
 
-    my ($js,$identifier);
+# Declarations for items used for directory archive requests
+    my ($js,$identifier,$defext,$archive_earlyout,$archive_idnum);
     my $args = {};
 
     if (($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && 
@@ -1691,15 +1861,60 @@ function writeDone() {
 ENDJS
         $args->{'add_entries'} = { onload => "writeDone()" };
     } elsif (($env{'form.action'} eq 'archive') &&
-             ($env{'environment.authorarchive'})) { 
-        if ($env{'form.phase'} eq 'two') {
-            $identifier = &Apache::loncommon::get_cgi_id();
-            $args->{'redirect'} = [0,"/cgi-bin/archive.pl?$identifier"];
-        } else {
-            my $check_uncheck_js = &Apache::loncommon::check_uncheck_jscript();
+             ($env{'environment.canarchive'})) {
+# Check if author already has an archive request in process
+        ($archive_earlyout,$archive_idnum) = &archive_in_progress();
+# Check if archive request was in process which author wishes to terminate
+        if ($env{'form.remove_archive_request'}) {
+            if ($env{'form.remove_archive_request'} eq $archive_idnum) {
+                if (exists($env{'cgi.'.$archive_idnum.'.archive'})) {
+                    my $archiveref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$archive_idnum.'.archive'});
+                    if (ref($archiveref) eq 'HASH') {
+                        $env{'form.delarchive'} = $archive_idnum.$archiveref->{'extension'};
+                        if (&Archive3($archiveref)) {
+                            ($archive_earlyout,$archive_idnum) = &archive_in_progress();
+                        }
+                        delete($env{'form.delarchive'});
+                    }
+                }
+            }
+        }
+        if ($archive_earlyout) {
+            my $conftext =
+                &mt('Removing an existing request will terminate an active download of the archive file.');
+            &js_escape(\$conftext);
             $js = <<"ENDJS";
 <script type="text/javascript">
 // <![CDATA[
+function confirmation(form) {
+    if (form.remove_archive_request.length) {
+        for (var i=0; i<form.remove_archive_request.length; i++) {
+            if (form.remove_archive_request[i].checked) {
+                if (form.remove_archive_request[i].value == '$archive_idnum') {
+                    if (!confirm('$conftext')) {
+                        return false;
+                    }
+                }
+            }
+        }
+    }
+    return true;
+}
+// ]]>
+</script>
+
+ENDJS
+        } else {
+            if ($env{'form.phase'} eq 'two') {
+                $identifier = &Apache::loncommon::get_cgi_id();
+                $args->{'redirect'} = [0.1,"/cgi-bin/archive.pl?$identifier"];
+            } else {
+                my (%location_of,%defaults);
+                $defext = &archive_tools(\%location_of,\%defaults);
+                my $check_uncheck_js = &Apache::loncommon::check_uncheck_jscript();
+                $js = <<"ENDJS";
+<script type="text/javascript">
+// <![CDATA[
 function toggleCompression(form) {
     if (document.getElementById('tar_compression')) {
         if (form.format.length > 1) {
@@ -1715,9 +1930,57 @@ function toggleCompression(form) {
             }
         }
     }
+    setArchiveExt(form);
     return;
 }
 
+function setArchiveExt(form) {
+    var newfmt;
+    var newcomp;
+    var newdef;
+    if (document.getElementById('archiveext')) {
+        if (form.format.length) {
+            for (var i=0; i<form.format.length; i++) {
+                if (form.format[i].checked) {
+                    newfmt = form.format[i].value;
+                    break;
+                }
+            }
+        } else {
+            newfmt = form.format[0];
+        }
+        if (newfmt == 'tar') {
+            if (document.getElementById('tar_compression')) {
+                if (form.compress.length) {
+                    for (var i=0; i<form.compress.length; i++) {
+                        if (form.compress[i].checked) {
+                            newcomp = form.compress[i].value;
+                            break;
+                        }
+                    }
+                } else {
+                    newcomp = form.compress[0];
+                }
+            }
+            if (newcomp == 'gzip') {
+                newdef = newfmt+'.gz';
+            } else if (newcomp == 'bzip2') {
+                newdef = newfmt+'.bz2';
+            } else if (newcomp == 'xz') {
+                newdef = newfmt+'.'+newcomp;
+            } else {
+                newdef = newfmt;
+            }
+        } else if (newfmt == 'zip') {
+            newdef = newfmt;
+        }
+        if ((newdef == '') || (newdef == undefined) || (newdef == null)) {
+            newdef = '.$defext';
+        }
+        document.getElementById('archiveext').value = newdef;
+    }
+}
+
 function resetForm() {
     if (document.phaseone.filetype.length) {
         for (var i=0; i<document.phaseone.filetype.length; i++) {
@@ -1746,6 +2009,27 @@ function resetForm() {
         }
     }
     document.phaseone.recurse.checked = false;
+    var a = document.createElement('a');
+    var vis;
+    if (typeof a.download != "undefined") {
+        document.phaseone.adload.value = '1';
+        if (document.getElementById('archive_saveas')) {
+            document.getElementById('archive_saveas').style.display = 'block';
+            vis = '1';
+        }
+    }
+    if (vis == '1') {
+        if (document.getElementById('archiveext')) {
+            document.getElementById('archiveext').value='.$defext';
+        }
+    } else {
+        if (document.getElementById('archive_saveas')) {
+            document.getElementById('archive_saveas').style.display = 'none';
+        }
+        if (document.getElementById('archiveext')) {
+            document.getElementById('archiveext').value='';
+        }
+    }
 }
 
 $check_uncheck_js
@@ -1754,7 +2038,8 @@ $check_uncheck_js
 </script>
 
 ENDJS
-            $args->{'add_entries'} = { onload => "resetForm()" }; 
+                $args->{'add_entries'} = { onload => "resetForm()" };
+            }
         }
     }
     my $londocroot = $r->dir_config('lonDocRoot');
@@ -1854,7 +2139,16 @@ ENDJS
                 return OK; 
             }
         } elsif ($env{'form.action'} eq 'archive') {
-            unless ($env{'environment.authorarchive'}) {
+            if ($env{'environment.canarchive'}) {
+                if ($archive_earlyout) {
+                    my $fname = &url($fn);
+                    my $title = $action{$env{'form.action'}};
+                    &cancel_archive_form($r,$title,$fname,$archive_earlyout,$archive_idnum);
+                    &CloseForm1($r,$fn);
+                    $r->print(&Apache::loncommon::end_page());
+                    return OK;
+                }
+            } else {
                 $r->print('<p>'.&mt('Location').': '.&display($fn).'</p>'."\n".
                           '<p class="LC_error">'.
                           &mt('You do not have permission to export to an archive file in this Authoring Space').
@@ -1863,7 +2157,7 @@ ENDJS
                 return OK;
             }
         }
-        $r->print('<h2>'.$action{$env{'form.action'}}.'</h2>');
+        $r->print('<h2>'.$action{$env{'form.action'}}.'</h2>'."\n");
     } else {
         $r->print('<p class="LC_error">'
                  .&mt('Unknown Action: [_1]',$env{'form.action'})