Annotation of loncom/cgi/archive.pl, revision 1.3
1.1 raeburn 1: #!/usr/bin/perl
2: #
1.3 ! raeburn 3: # $Id: archive.pl,v 1.2 2024/05/21 02:57:17 raeburn Exp $
1.1 raeburn 4: #
5: # Copyright Michigan State University Board of Trustees
6: #
7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
8: #
9: # LON-CAPA is free software; you can redistribute it and/or modify
10: # it under the terms of the GNU General Public License as published by
11: # the Free Software Foundation; either version 2 of the License, or
12: # (at your option) any later version.
13: #
14: # LON-CAPA is distributed in the hope that it will be useful,
15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17: # GNU General Public License for more details.
18: #
19: # You should have received a copy of the GNU General Public License
20: # along with LON-CAPA; if not, write to the Free Software
21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22: #
23: # /home/httpd/cgi-bin/archive.pl
24: #
25: # http://www.lon-capa.org/
26: #
27: # The LearningOnline Network with CAPA
28: #
29: # A CGI script which creates a compressed archive file of the current
30: # directory in Authoring Space, with optional (a) recursion into
1.2 raeburn 31: # sub-directories, and (b) filtering by filetype.
1.1 raeburn 32: # Supported formats are: tar.gz, tar.bz2, tar.xz and zip.
33: ####
34: use strict;
35: use lib '/home/httpd/lib/perl';
36: use File::Find;
37: use Apache::lonnet;
38: use Apache::loncommon;
39: use Apache::lonlocal;
40: use LONCAPA::loncgi;
41: use Cwd;
42: use HTML::Entities;
43:
44: $|++;
45:
46: my $lock;
47:
48: our %excluded = (
49: bak => 1,
50: save => 1,
51: log => 1,
52: );
53:
54: our $maxdepth = 0;
55: our %included = ();
56: our $alltypes = '';
57: our $recurse = '';
58: our $includeother = '';
59: our $prefix = '';
60: our $totalfiles = 0;
61: our $totalsize = 0;
62: our $totalsubdirs = 0;
63: our %subdirs = ();
64: our $fh;
65:
66: if (!&LONCAPA::loncgi::check_cookie_and_load_env()) {
67: &Apache::lonlocal::get_language_handle();
68: print(&LONCAPA::loncgi::missing_cookie_msg());
69: } else {
70: &Apache::lonlocal::get_language_handle();
71: my %lt = &Apache::lonlocal::texthash (
72: indi => 'Invalid directory name',
1.3 ! raeburn 73: noau => 'Archive creation only available to Author',
1.1 raeburn 74: outo => 'Output of command:',
75: comp => 'Archive creation complete.',
76: erro => 'An error occurred.',
1.3 ! raeburn 77: cctf => 'Cannot create tar file',
1.1 raeburn 78: dtf => 'Download tar file',
79: );
80: # Get the identifier and set a lock
81: my %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
82: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
83: &Apache::lonlocal::get_language_handle();
84: &Apache::loncommon::content_type(undef,'text/html');
85: my $identifier = $ENV{'QUERY_STRING'};
1.2 raeburn 86: my ($hashref,$dir,$dirurl,$jsdirurl,$auname,$audom,$allowed,$error,
87: $format,$compress,$fname,$extension,$adload,$url,$mime);
1.1 raeburn 88: 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);
1.2 raeburn 89: if (($identifier =~ /^\d+_\d+_\d+$/) && (exists($env{'cgi.'.$identifier.'.archive'}))) {
1.1 raeburn 90: $hashref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$identifier.'.archive'});
91: if (ref($hashref) eq 'HASH') {
92: $dir = $hashref->{'dir'};
1.2 raeburn 93: $dir =~ s{\.+}{.}g;
1.1 raeburn 94: if (-d $dir) {
95: $dirurl = $dir;
96: ($auname,$audom) = &Apache::lonnet::constructaccess($dir);
97: if (($auname ne '') && ($audom ne '')) {
98: $dirurl =~ s/^\Q$londocroot\E//;
99: $prefix = $londocroot.$dirurl;
100: $maxdepth = $prefix =~ tr{/}{};
101: $jsdirurl = &js_escape($dirurl);
102: if (($auname eq $env{'user.name'}) && ($audom eq $env{'user.domain'}) &&
1.2 raeburn 103: ($env{'environment.canarchive'})) {
1.1 raeburn 104: $allowed = 1;
105: if ($hashref->{'recurse'}) {
106: $recurse = 1;
107: } else {
108: $recurse = 0;
109: }
110: if ($hashref->{'types'} eq 'all') {
111: $alltypes = 1;
112: } else {
113: $alltypes = 0;
114: my %possincluded;
115: map { $possincluded{$_} = 1; } split(/,/,$hashref->{'types'});
116: $includeother = 0;
117: foreach my $type (@posstypes) {
118: if ($type eq 'other') {
119: if ($possincluded{$type}) {
120: $includeother = 1;
121: } else {
122: $includeother = 0;
123: }
124: } else {
125: if ($possincluded{$type}) {
126: $included{$type} = 1;
127: } else {
128: $excluded{$type} = 1;
129: }
130: }
131: }
132: }
133: if ((exists($hashref->{'format'}) && $hashref->{'format'} =~ /^zip$/i)) {
134: $format = lc($hashref->{'format'});
135: } else {
136: $format = 'tar';
137: }
138: unless ($format eq 'zip') {
139: if ((exists($hashref->{'compress'})) && ($hashref->{'compress'} =~ /^(xz|bzip2)$/i)) {
140: $compress = lc($hashref->{'compress'});
141: } else {
142: $compress = 'gzip';
143: }
144: }
1.2 raeburn 145: if ($hashref->{'adload'}) {
146: $adload = $hashref->{'adload'};
147: }
148: if ($hashref->{'fname'}) {
149: $fname = $hashref->{'fname'};
150: }
151: if ($hashref->{'extension'}) {
152: $extension = $hashref->{'extension'};
153: }
1.3 ! raeburn 154: } else {
! 155: $error = 'noau';
1.1 raeburn 156: }
157: }
158: } else {
159: $error = 'indi';
160: }
161: } else {
162: $error = 'nohash';
163: }
1.2 raeburn 164: # delete cgi.$identifier.archive from %env if error
165: if ($error) {
166: &Apache::lonnet::delenv('cgi.'.$identifier.'.archive');
167: }
1.1 raeburn 168: } else {
169: $error = 'noid';
170: }
171: $env{'request.noversionuri'} = '/cgi-bin/archive.pl';
172: my ($brcrum,$title);
173: if ($error) {
174: $brcrum = [{'href' => '',
175: 'text' => 'Missing information'}];
176: } elsif (!$allowed) {
177: $brcrum = [{'href' => '',
178: 'text' => 'Access denied'}];
179: } else {
180: # Breadcrumbs
181: $title = 'Creating archive file';
182: $brcrum = [{'href' => $dirurl,
183: 'text' => 'Authoring Space'},
184: {'href' => "javascript:gocstr('/adm/cfile?action=archive','$jsdirurl');",
185: 'text' => 'File Operation'},
186: {'href' => '',
187: 'text' => $title}];
188: }
1.2 raeburn 189: # Set up files to write two and url
190: my ($js,%location_of,$suffix,$namesdest,$filesdest,$filesurl);
191: if ($allowed) {
192: my @tocheck;
1.1 raeburn 193: if ($format ne '') {
194: push(@tocheck,$format);
195: }
196: if ($compress ne '') {
197: push(@tocheck,$compress);
1.2 raeburn 198: }
1.1 raeburn 199: foreach my $program (@tocheck) {
200: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
201: '/usr/sbin/') {
202: if (-x $dir.$program) {
203: $location_of{$program} = $dir.$program;
204: last;
205: }
206: }
207: }
1.2 raeburn 208: if (($format ne '') && (exists($location_of{$format}))) {
1.1 raeburn 209: if ($format eq 'zip') {
1.2 raeburn 210: $suffix = '.zip';
211: $mime = 'application/x-zip-compressed';
1.1 raeburn 212: } else {
1.2 raeburn 213: $suffix = '.tar';
214: if (($compress ne '') &&
215: (exists($location_of{$compress}))) {
1.1 raeburn 216: if ($compress eq 'bzip2') {
1.2 raeburn 217: $suffix .= '.bz2';
218: $mime = 'application/x-bzip2';
1.1 raeburn 219: } elsif ($compress eq 'gzip') {
220: $suffix .= '.gz';
1.2 raeburn 221: $mime = 'application/x-gzip';
1.1 raeburn 222: } elsif ($compress eq 'xz') {
223: $suffix .= '.xz';
1.2 raeburn 224: $mime = 'application/x-xz';
1.1 raeburn 225: }
226: }
227: }
1.2 raeburn 228: $namesdest = $perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.'.txt';
229: $filesdest = $perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.$suffix;
230: $filesurl = '/prtspool/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.$suffix;
231: if ($suffix eq $extension) {
232: $fname =~ s{\Q$suffix\E$}{};
233: }
234: if ($fname eq '') {
235: $fname = $env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.$suffix;
236: } else {
237: $fname .= $suffix;
238: }
239: my $downloadurl = &Apache::lonnet::absolute_url().$filesurl;
240: my $delarchive = $identifier.$suffix;
241: $js = &js($filesurl,$mime,$fname,$delarchive);
242: }
243: }
244: print &Apache::loncommon::start_page($title,
245: '',
246: {'bread_crumbs' => $brcrum,})."\n".
247: '<form name="constspace" method="post" action="">'."\n".
248: '<input type="hidden" name="filename" value="" />'."\n";
249: if ($error) {
250: print &mt('Cannot create archive file');
251: } elsif ($allowed) {
252: if (-e $filesdest) {
253: my $mtime = (stat($filesdest))[9];
254: print '<div id="LC_archive_desc">'."\n";
255: if ($mtime) {
256: print '<p class="LC_warning">'.&mt('Archive file already exists -- created: [_1].',
257: &Apache::lonlocal::locallocaltime($mtime)).'</p>';
258: } else {
259: print '<p class="LC_warning">'.&mt('Archive file already exists.').'</p>';
260: }
261: print '</div>'."\n";
262: print &archive_link($adload,$filesurl,$suffix);
263: if ($adload) {
264: print $js;
265: }
266: } elsif (exists($location_of{$format})) {
267: unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Creating Archive file for [_1]',$dirurl)); }
1.1 raeburn 268: if (open($fh,'>',$namesdest)) {
269: find(
270: {preprocess => \&filter_files,
271: wanted => \&store_names,
272: no_chdir => 1,
273: },$dir);
274: close($fh);
1.2 raeburn 275: if (ref($hashref) eq 'HASH') {
276: $hashref->{'numfiles'} = $totalfiles;
277: $hashref->{'numdirs'} = $totalsubdirs;
278: $hashref->{'bytes'} = $totalsize;
279: my $storestring = &Apache::lonnet::freeze_escape($hashref);
280: &Apache::lonnet::appenv({'cgi.'.$identifier.'.archive' => $storestring});
281: }
282: &Apache::lonnet::thaw_unescape($env{'cgi.'.$identifier.'.archive'});
1.1 raeburn 283: if (($totalfiles) || ($totalsubdirs)) {
1.2 raeburn 284: my $freespace;
285: my @dfargs = ('df','-k','--output=avail','/home');
286: if (open(my $pipe,'-|',@dfargs)) {
287: while (my $line = <$pipe>) {
288: chomp($line);
289: if ($line =~ /^\d+$/) {
290: $freespace = $line;
291: last;
292: }
1.1 raeburn 293: }
1.2 raeburn 294: close($pipe);
1.1 raeburn 295: }
1.2 raeburn 296: if (($freespace ne '') && ($totalsize < $freespace*1024)) {
297: my $showsize = $totalsize/(1024*1024);
298: if ($showsize <= 0.01) {
299: $showsize = sprintf("%.3f",$showsize);
300: } elsif ($showsize <= 0.1) {
301: $showsize = sprintf("%.2f",$showsize);
302: } elsif ($showsize < 10) {
303: $showsize = sprintf("%.1f",$showsize);
304: } else {
305: $showsize = sprintf("%.0f",$showsize);
306: }
307: print '<div id="LC_archive_desc"><p>'.
308: &mt('Creating archive file for [quant,_1,file,files] with total size before compression of [_2] MB.',
309: $totalfiles,$showsize);
310: if ($totalsubdirs) {
311: print '<br />'.&mt('Archive includes [quant,_1,subdirectory,subdirectories].',
312: $totalsubdirs);
313: }
314: print '</p></div>';
315: my ($cwd,@args);
316: if ($format eq 'zip') {
317: $cwd = &Cwd::getcwd();
318: @args = ('zip',$filesdest,'-v','-r','.','-i@'.$namesdest);
319: chdir $prefix;
320: } else {
321: @args = ('tar',"--create","--verbose");
322: if (($compress ne '') && (exists($location_of{$compress}))) {
323: push(@args,"--$compress");
324: }
325: push(@args,("--file=$filesdest","--directory=$prefix","--files-from=$namesdest"));
326: }
327: if (open(my $pipe,'-|',@args)) {
328: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin('',$totalfiles);
329: while (<$pipe>) {
330: &Apache::lonhtmlcommon::Increment_PrgWin('',\%prog_state,'last file');
331: }
332: &Apache::lonhtmlcommon::Close_PrgWin('',\%prog_state);
333: close($pipe);
334: if (-e $filesdest) {
335: my $size = (stat($filesdest))[7];
336: &Apache::lonnet::authorarchivelog($hashref,$size,$filesdest,'create');
337: print &archive_link($adload,$filesurl,$suffix);
338: if ($adload) {
339: print $js;
340: }
341: } else {
342: print '<p>'.&mt('No archive file available for download').'</p>'."\n";
343: }
344: } else {
345: print '<p>'.&mt('Could not call [_1] command',$format).'</p>'."\n";
1.1 raeburn 346: }
1.2 raeburn 347: if (($format eq 'zip') && ($cwd ne '')) {
348: chdir $cwd;
1.1 raeburn 349: }
1.2 raeburn 350: } elsif ($freespace eq '') {
351: print '<p>'.&mt('No archive file created as the available free space could not be determined.').'</p>'."\n";
1.1 raeburn 352: } else {
1.2 raeburn 353: print '<p>'.&mt('No archive file created because there is insufficient free space available.').'</p>'."\n";
1.1 raeburn 354: }
355: } else {
356: print '<p>'.&mt('No files match the requested types so no archive file was created.').'</p>'."\n";
357: }
358: unlink($namesdest);
359: } else {
360: print '<p>'.&mt('Could not store list of files to archive').'</p>'."\n";
361: }
362: if ($lock) { &Apache::lonnet::remove_lock($lock); }
363: } else {
364: print '<p>'.&mt('Could not find location of [_1] command',$format).'</p>'."\n";
365: }
366: }
367: if ($dirurl) {
1.2 raeburn 368: print '<br />'.
1.1 raeburn 369: &Apache::lonhtmlcommon::actionbox(['<a href="'.&HTML::Entities::encode($dirurl,'\'"&<>').'">'.
370: &mt('Return to Directory').'</a>']);
371: }
372: print '</form>'.&Apache::loncommon::end_page();
373:
374: # Code to delete archive file after successful download
375: %included = ();
376: $alltypes = '';
377: $recurse = '';
378: $includeother = '';
379: $prefix = '';
380: $totalfiles = 0;
381: $totalsize = 0;
382: $totalsubdirs = 0;
383: %excluded = (
384: bak => 1,
385: save => 1,
386: log => 1,
387: );
388: }
389:
390: sub filter_files {
391: my @PossibleFiles = @_;
392: my @ChosenFiles;
393: foreach my $file (@PossibleFiles) {
394: if (-d $File::Find::dir."/".$file) {
395: if (!$recurse) {
396: my $depth = $File::Find::dir =~ tr[/][];
397: next unless ($depth < $maxdepth-1);
398: }
399: push(@ChosenFiles,$file);
400: } else {
1.2 raeburn 401: next if ($file =~ /^\./);
1.1 raeburn 402: my ($extension) = ($file =~ /\.([^.]+)$/);
403: if ((!$excluded{$extension}) && ($alltypes || $includeother || $included{$extension})) {
404: push(@ChosenFiles,$file);
405: }
406: }
407: }
408: return @ChosenFiles;
409: }
410:
411: sub store_names {
412: my $filename = $File::Find::name;
413: if (-d $filename) {
414: unless ("$filename/" eq $prefix) {
415: if ($recurse) {
416: $subdirs{$filename} = 1;
417: $totalsubdirs ++;
418: }
419: }
420: next;
421: }
422: $totalfiles ++;
423: $totalsize += -s $filename;
424: $filename =~ s{^$prefix}{};
425: print $fh "$filename\n";
426: }
427:
1.2 raeburn 428: sub archive_link {
429: my ($adload,$filesurl,$suffix) = @_;
430: if ($adload) {
431: return
432: '<button id="LC_download_button" onclick="return false">'.&mt('Download').'</button></p>'."\n".
433: '<div style="display:none; width:100%;" id="LC_dload_progress" >'."\n".
434: '<div id="LC_dl_progressbar"></div>'."\n".
435: '</div>'."\n".
436: '<span id="LC_download_result"></span>'."\n";
437: } else {
438: return
439: '<p><a href="'.$filesurl.'">'.&mt('Download [_1] file',$suffix).'</a></p>'."\n";
440: }
441: }
442:
1.1 raeburn 443: sub js {
1.2 raeburn 444: my ($url,$mime,$fname,$delarchive) = @_;
445: &js_escape(\$url);
446: &js_escape(\$mime);
447: &js_escape(\$fname);
448: my %js_lt = &Apache::lonlocal::texthash (
449: afdo => 'Archive file download complete.',
450: diun => 'Download is unavailable.',
451: tfbr => 'The archive file has been removed.',
452: ynrd => 'You do not have rights to download the archive file.',
453: );
454: &js_escape(\%js_lt);
455: return <<"END";
456: <script type="text/javascript">
457: // <![CDATA[
458:
459: function showProgress(event) {
460: if (event.lengthComputable) {
461: var complete = 0;
462: if (event.total > 0) {
463: complete = Math.round( (event.loaded / event.total) * 100);
464: }
465: \$( "#LC_dl_progressbar" ).progressbar({
466: value: complete
467: });
468: if (complete == '100') {
469: if (document.getElementById('LC_dload_progress')) {
470: document.getElementById('LC_dload_progress').style.display = 'none';
471: }
472: }
473: }
474: }
475:
476: function cleanUp(event) {
477: showProgress(event);
478: if (event.lengthComputable) {
479: var complete = 0;
480: if (event.total > 0) {
481: complete = Math.round( (event.loaded / event.total) * 100);
482: }
483: if (complete == 100) {
484: var dbtn = document.querySelector('#LC_download_button');
485: if (dbtn !== null) {
486: dbtn.style.display = 'none';
487: }
488: var http = new XMLHttpRequest();
489: var lcurl = "/adm/cfile";
490: var params = 'delarchive=$delarchive';
491: var result;
492: http.open("POST",lcurl, true);
493: http.setRequestHeader("Content-type", "application/x-www-form-urlencoded");
494: http.onreadystatechange = function() {
495: if ((http.readyState == 4) && (http.status == 200)) {
496: if (http.responseText.length > 0) {
497: if (http.responseText == 1) {
498: if (document.getElementById('LC_archive_desc')) {
499: document.getElementById('LC_archive_desc').style.display = 'none';
500: }
501: if (document.getElementById('LC_download_result')) {
502: document.getElementById('LC_download_result').innerHTML = '$js_lt{afdo}<br />';
503: }
504: }
505: }
506: }
507: }
508: http.send(params);
509: }
510: }
511: }
512:
513: function filecheck(file, callback) {
514: const xhr = new XMLHttpRequest();
515: xhr.open('HEAD',file,true);
516: xhr.onreadystatechange = function() {
517: if (this.readyState >= 2) {
518: callback(this.status);
519: this.abort();
520: }
521: };
522: xhr.send();
523: }
524:
525: function download(file,callback) {
526: if (document.getElementById('LC_dload_progress')) {
527: document.getElementById('LC_dload_progress').style.display = 'block';
528: }
529: const xhr = new XMLHttpRequest();
530: xhr.responseType = 'blob';
531: xhr.open('GET', file);
532: xhr.addEventListener('progress',showProgress);
533: xhr.addEventListener('load', function () {
534: callback(xhr.response);
535: });
536: xhr.addEventListener("loadend", cleanUp);
537: xhr.send();
538: }
1.1 raeburn 539:
1.2 raeburn 540: function save(object,mime,name) {
541: var a = document.createElement('a');
542: var url = URL.createObjectURL(object);
543: a.href = url;
544: a.type = mime;
545: a.download = name;
546: a.click();
547: }
1.1 raeburn 548:
1.2 raeburn 549: var dbtn = document.querySelector('#LC_download_button');
550: if (dbtn !== null) {
551: dbtn.addEventListener('click', function () {
552: filecheck('$url',function (response) {
553: if (response == 200) {
554: download('$url', function (file) {
555: save(file,'$mime','$fname');
556: });
557: } else if ((response == 404) || (response == 403) || (response == 406)) {
558: dbtn.style.display = 'none';
559: if (document.getElementById('LC_dload_progress')) {
560: document.getElementById('LC_dload_progress').style.display = 'none';
561: }
562: if (document.getElementById('LC_download_result')) {
563: if (response == 404) {
564: document.getElementById('LC_download_result').innerHTML = '$js_lt{diun} $js_lt{tfbr}<br />';
565: } else {
566: document.getElementById('LC_download_result').innerHTML = '$js_lt{diun} $js_lt{ynrd}<br />';
567: }
568: }
569: }
570: });
571: });
1.1 raeburn 572: }
573:
1.2 raeburn 574: // ]]>
575: </script>
1.1 raeburn 576:
1.2 raeburn 577: END
578:
579: }
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