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