--- loncom/publisher/loncfile.pm 2023/07/14 23:20:15 1.127 +++ loncom/publisher/loncfile.pm 2024/09/03 11:07:47 1.129.2.2 @@ -9,7 +9,7 @@ # and displays a page showing the results of the action. # # -# $Id: loncfile.pm,v 1.127 2023/07/14 23:20:15 raeburn Exp $ +# $Id: loncfile.pm,v 1.129.2.2 2024/09/03 11:07:47 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -70,10 +70,10 @@ use HTML::Entities(); use Apache::Constants qw(:common :http :methods); use Apache::lonnet; use Apache::loncommon(); +use Apache::lonhtmlcommon; use Apache::lonlocal; use LONCAPA qw(:DEFAULT :match); - my $DEBUG=0; my $r; # Needs to be global for some stuff RF. @@ -819,6 +819,219 @@ 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,%defaults); + my ($compstyle,$canarchive,$cancompress,$numformat,$numcompress,$defext) = + &archive_tools(\%location_of,\%defaults); + if (!$canarchive) { + $request->print('

'. + &mt('This LON-CAPA instance does not seem to have either tar or zip installed.').'

'."\n". + ''. + &mt('At least one of the two is needed in order to be able to create an archive file for: [_1].', + &display($fn))."\n". + ''); + } elsif (-e $fn) { + $request->print(''."\n". + &Apache::lonhtmlcommon::start_pick_box(). + &Apache::lonhtmlcommon::row_title(&mt('Directory')). + &display($fn). + &Apache::lonhtmlcommon::row_closure(). + &Apache::lonhtmlcommon::row_title(&mt('Options'). + &Apache::loncommon::help_open_topic('Archiving_Directory_Options')). + '
'.&mt('Recurse').''. + ''. + '
'. + '
'.&mt('File types (extensions) to include').(' 'x2). + ''.(' 'x5).''.(' 'x2). + ''. + (' 'x2). + ''. + ''); + my $rem; + my $numinrow = 6; + for (my $i=0; $i<@posstypes; $i++) { + my $rem = $i%($numinrow); + if ($rem == 0) { + if ($i > 0) { + $request->print(''."\n"); + } + $request->print(''."\n"); + } + $request->print(''."\n"); + } + $rem = scalar(@posstypes)%($numinrow); + my $colsleft; + if ($rem) { + $colsleft = $numinrow - $rem; + } + if ($colsleft > 1 ) { + $request->print(''."\n"); + } elsif ($colsleft == 1) { + $request->print(''."\n"); + } + $request->print('
'. + ''. + '  
'."\n". + '
'. + '
'.&mt('Archive file format').''); + foreach my $possfmt ('tar','zip') { + if (exists($location_of{$possfmt})) { + $request->print(''. + '   '); + } + } + $request->print('
'."\n". + '
'. + ''.&mt('Compression to apply to tar file').''. + ''); + if ($cancompress) { + foreach my $compress ('gzip','bzip2','xz') { + if (exists($location_of{$compress})) { + $request->print('  '); + } + } + } else { + $request->print(''. + &mt('This LON-CAPA instance does not seem to have gzip, bzip2 or xz installed.'). + '
'.&mt('No compression will be used.').''); + } + $request->print('
'."\n". + ''."\n". + &Apache::lonhtmlcommon::row_closure(1). + &Apache::lonhtmlcommon::end_pick_box().'
'."\n" + ); + &CloseForm1($request, $fn); + } else { + $request->print('

' + .&mt('No such directory: [_1]', + &display($fn)) + .'

' + ); + } + 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('

'.$title.'

'."\n". + '
'."\n". + ''."\n". + ''."\n". + '

'.&mt('Each author may only have one archive request in process at a time.')."\n".'

'."\n". + '

'.&mt('Remove existing archive request?').' '."\n". + ''. + (' 'x2)."\n". + '

'."\n". + '
'); +} + =pod =item NewFile1 @@ -994,10 +1207,10 @@ sub phaseone { '

'); return; } - $r->print(''. - ''. - ''. - ''); + $r->print(''."\n". + ''."\n". + ''."\n". + ''."\n"); if ($env{'form.action'} eq 'newfile' || $env{'form.action'} eq 'newhtmlfile' || @@ -1033,6 +1246,15 @@ sub phaseone { &Delete1($r, $uname, $udom, $fn); } elsif ($env{'form.action'} eq 'decompress') { &Decompress1($r, $uname, $udom, $fn); + } elsif ($env{'form.action'} eq 'archive') { + if (($uname eq $env{'user.name'}) && ($udom eq $env{'user.domain'})) { + &Archive1($r,$fn); + } else { + $r->print('

' + .&mt('Archiving of Authoring Spaces is only permitted by Author') + .'

' + ); + } } elsif ($env{'form.action'} eq 'copy') { if ($newfilename) { &Copy1($r, $uname, $udom, $fn, $newfilename); @@ -1310,9 +1532,92 @@ sub decompress2 { return 1; } +sub Archive2 { + 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; + my @posstypes = &Apache::loncommon::get_env_multiple('form.filetype'); + foreach my $type (@posstypes) { + if ($oktypes{$type}) { + push(@include,$type); + } + } + if (scalar(@include) == scalar(@filetypes)) { + $options{'types'} = 'all'; + } else { + $options{'types'} = join(',',@include); + } + if (exists($env{'form.recurse'})) { + $options{'recurse'} = 1; + } + if (exists($env{'form.encrypt'})) { + if ($env{'form.enckey'} ne '') { + $options{'encrypt'} = $env{'form.enckey'}; + } + } + $options{'format'} = 'tar'; + $options{'compress'} = 'gzip'; + if ((exists($env{'form.format'})) && $env{'form.format'} =~ /^zip$/i) { + $options{'format'} = 'zip'; + delete($options{'compress'}); + } elsif ((exists($env{'form.compress'})) && ($env{'form.compress'} =~ /^(xz|bzip2)$/i)) { + $options{'compress'} = lc($env{'form.compress'}); + } + my $key = 'cgi.'.$identifier.'.archive'; + my $storestring = &Apache::lonnet::freeze_escape(\%options); + &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) +=item phasetwo($r, $fn, $uname, $udom,$identifier) Controls the phase 2 processing of file management requests for construction space. In phase one, the user @@ -1343,7 +1648,7 @@ Parameters: =cut sub phasetwo { - my ($r,$fn,$uname,$udom)=@_; + my ($r,$fn,$uname,$udom,$identifier)=@_; &Debug($r, "loncfile - Entering phase 2 for $fn"); @@ -1380,6 +1685,15 @@ sub phasetwo { return ; } $dest = $dir."/."; + } elsif ($env{'form.action'} eq 'archive') { + 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') { if($env{'form.newfilename'}) { @@ -1454,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..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{'QUERY_STRING'} && $env{'form.phase'} ne 'two') { + } 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 { @@ -1496,45 +1824,232 @@ 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 (%loaditem,$js); +# 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') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) { + if (($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && + (($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport'))) { my $newdirname = $env{'form.newfilename'}; - $js = qq| + &js_escape(\$newdirname); + $js = <<"ENDJS"; -|; - $loaditem{'onload'} = "writeDone()"; +// ]]> + +ENDJS + $args->{'add_entries'} = { onload => "writeDone()" }; + } elsif (($env{'form.action'} eq 'archive') && + ($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"; + + +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"; + +ENDJS + $args->{'add_entries'} = { onload => "resetForm()" }; + } + } + } my $londocroot = $r->dir_config('lonDocRoot'); my $trailfile = $fn; $trailfile =~ s{^/(priv/)}{$londocroot/$1}; # Breadcrumbs - my $crsauthor; my $text = 'Authoring Space'; my $title = 'Authoring Space File Operation', my $href = &Apache::loncommon::authorspace(&url($fn)); - if ($env{'request.course.id'}) { - my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - if ($href eq "/priv/$cdom/$cnum/") { - $text = 'Course Authoring Space'; - $title = 'Course Authoring Space File Operation', - $crsauthor = 1; - } - } &Apache::lonhtmlcommon::clear_breadcrumbs(); &Apache::lonhtmlcommon::add_breadcrumb({ 'text' => $text, @@ -1546,23 +2061,21 @@ function writeDone() { 'href' => '', }); - $r->print(&Apache::loncommon::start_page($title, - $js, - {'add_entries' => \%loaditem,}) + $r->print(&Apache::loncommon::start_page($title,$js,$args) .&Apache::lonhtmlcommon::breadcrumbs() .&Apache::loncommon::head_subbox( &Apache::loncommon::CSTR_pageheader($trailfile)) ); - $r->print('

'.&mt('Location').': '.&display($fn).'

'); + unless ($env{'form.action'} eq 'archive') { + $r->print('

'.&mt('Location').': '.&display($fn).'

'); + } if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { - unless ($crsauthor) { - $r->print('

' - .&mt('Co-Author [_1]',$uname.':'.$udom) - .'

' - ); - } + $r->print('

' + .&mt('Co-Author [_1]',$uname.':'.$udom) + .'

' + ); } @@ -1573,6 +2086,7 @@ function writeDone() { 'move' => 'Move', 'newdir' => 'New Directory', 'decompress' => 'Decompress', + 'archive' => 'Export directory to archive file', 'copy' => 'Copy', 'newfile' => 'New Resource', 'newhtmlfile' => 'New Resource', @@ -1586,26 +2100,26 @@ function writeDone() { 'Select Action' => 'New Resource', ); if ($action{$env{'form.action'}}) { - if ($crsauthor) { - my @disallowed = qw(page sequence rights library); - my $newtype; - if ($env{'form.action'} =~ /^new(\w+)file$/) { - $newtype = $1; - } elsif ($env{'form.action'} eq 'newfile') { - ($newtype) = ($env{'form.newfilename'} =~ m{\.([^/.]+)$}); - $newtype = lc($newtype); - } - if (($newtype ne '') && - (grep(/^\Q$newtype\E$/,@disallowed))) { - $r->print('

' - .&mt('Creation of a new file of type: [_1] is not permitted in Course Authoring Space',$newtype) - .'

' - .&Apache::loncommon::end_page() - ); + if ($env{'form.action'} eq 'archive') { + 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('

'.&mt('Location').': '.&display($fn).'

'."\n". + '

'. + &mt('You do not have permission to export to an archive file in this Authoring Space'). + '

'."\n". + &Apache::loncommon::end_page()); return OK; } } - $r->print('

'.$action{$env{'form.action'}}.'

'); + $r->print('

'.$action{$env{'form.action'}}.'

'."\n"); } else { $r->print('

' .&mt('Unknown Action: [_1]',$env{'form.action'}) @@ -1617,7 +2131,7 @@ function writeDone() { if ($env{'form.phase'} eq 'two') { &Debug($r, "loncfile::handler entering phase2"); - &phasetwo($r,$fn,$uname,$udom); + &phasetwo($r,$fn,$uname,$udom,$identifier); } else { &Debug($r, "loncfile::handler entering phase1"); &phaseone($r,$fn,$uname,$udom);