1: #!/usr/bin/perl
2: #
3: # $Id: archive.pl,v 1.1 2024/05/13 13:55:51 raeburn Exp $
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
31: # sub-directories, (b) filtering by filetype and (c) encryption.
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'};
85: my ($hashref,$dir,$dirurl,$jsdirurl,$auname,$audom,$allowed,$error,$encrypt,$enckey,$format,$compress);
86: 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);
87: if (($identifier) && (exists($env{'cgi.'.$identifier.'.archive'}))) {
88: $hashref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$identifier.'.archive'});
89: if (ref($hashref) eq 'HASH') {
90: $dir = $hashref->{'dir'};
91: # check for traversal
92: if (-d $dir) {
93: $dirurl = $dir;
94: ($auname,$audom) = &Apache::lonnet::constructaccess($dir);
95: if (($auname ne '') && ($audom ne '')) {
96: $dirurl =~ s/^\Q$londocroot\E//;
97: $prefix = $londocroot.$dirurl;
98: $maxdepth = $prefix =~ tr{/}{};
99: $jsdirurl = &js_escape($dirurl);
100: if (($auname eq $env{'user.name'}) && ($audom eq $env{'user.domain'}) &&
101: ($env{'environment.authorarchive'})) {
102: $allowed = 1;
103: if ($hashref->{'recurse'}) {
104: $recurse = 1;
105: } else {
106: $recurse = 0;
107: }
108: if ($hashref->{'types'} eq 'all') {
109: $alltypes = 1;
110: } else {
111: $alltypes = 0;
112: my %possincluded;
113: map { $possincluded{$_} = 1; } split(/,/,$hashref->{'types'});
114: $includeother = 0;
115: foreach my $type (@posstypes) {
116: if ($type eq 'other') {
117: if ($possincluded{$type}) {
118: $includeother = 1;
119: } else {
120: $includeother = 0;
121: }
122: } else {
123: if ($possincluded{$type}) {
124: $included{$type} = 1;
125: } else {
126: $excluded{$type} = 1;
127: }
128: }
129: }
130: }
131: if ((exists($hashref->{'encrypt'}) && $hashref->{'encrypt'} ne '')) {
132: $encrypt = 1;
133: $enckey = $hashref->{'encrypt'};
134: }
135: if ((exists($hashref->{'format'}) && $hashref->{'format'} =~ /^zip$/i)) {
136: $format = lc($hashref->{'format'});
137: } else {
138: $format = 'tar';
139: }
140: unless ($format eq 'zip') {
141: if ((exists($hashref->{'compress'})) && ($hashref->{'compress'} =~ /^(xz|bzip2)$/i)) {
142: $compress = lc($hashref->{'compress'});
143: } else {
144: $compress = 'gzip';
145: }
146: }
147: }
148: }
149: } else {
150: $error = 'indi';
151: }
152: } else {
153: $error = 'nohash';
154: }
155: # delete cgi.$identifier.archive from %env
156: &Apache::lonnet::delenv('cgi.'.$identifier.'.archive');
157: } else {
158: $error = 'noid';
159: }
160: $env{'request.noversionuri'} = '/cgi-bin/archive.pl';
161: my ($brcrum,$title);
162: if ($error) {
163: $brcrum = [{'href' => '',
164: 'text' => 'Missing information'}];
165: } elsif (!$allowed) {
166: $brcrum = [{'href' => '',
167: 'text' => 'Access denied'}];
168: } else {
169: # Breadcrumbs
170: $title = 'Creating archive file';
171: $brcrum = [{'href' => $dirurl,
172: 'text' => 'Authoring Space'},
173: {'href' => "javascript:gocstr('/adm/cfile?action=archive','$jsdirurl');",
174: 'text' => 'File Operation'},
175: {'href' => '',
176: 'text' => $title}];
177: }
178: my $js;
179: print &Apache::loncommon::start_page($title,
180: $js,
181: {'bread_crumbs' => $brcrum,})."\n".
182: '<form name="constspace" method="post" action="">'."\n".
183: '<input type="hidden" name="filename" value="" />'."\n";
184: if ($error) {
185: print "&mt('Cannot create archive file -- \n";
186: } elsif ($allowed) {
187: my (%location_of,@tocheck);
188: if ($format ne '') {
189: push(@tocheck,$format);
190: }
191: if ($compress ne '') {
192: push(@tocheck,$compress);
193: }
194: foreach my $program (@tocheck) {
195: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
196: '/usr/sbin/') {
197: if (-x $dir.$program) {
198: $location_of{$program} = $dir.$program;
199: last;
200: }
201: }
202: }
203: if (exists($location_of{$format})) {
204: my $suffix;
205: if ($format eq 'zip') {
206: $suffix = 'zip';
207: } else {
208: $suffix = 'tar';
209: if (exists($location_of{$compress})) {
210: if ($compress eq 'bzip2') {
211: $suffix .= '.bz2';
212: } elsif ($compress eq 'gzip') {
213: $suffix .= '.gz';
214: } elsif ($compress eq 'xz') {
215: $suffix .= '.xz';
216: }
217: }
218: }
219: my $namesdest = $perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.'.txt';
220: my $filesdest = $perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.'.'.$suffix;
221: my $filesurl = '/prtspool/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$identifier.'.'.$suffix;
222: unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Archiving [_1]',$dirurl)); }
223: if (open($fh,'>',$namesdest)) {
224: find(
225: {preprocess => \&filter_files,
226: wanted => \&store_names,
227: no_chdir => 1,
228: },$dir);
229: close($fh);
230: if (($totalfiles) || ($totalsubdirs)) {
231: print '<p>'.
232: &mt('Archiving: [quant,_1,file,files] with total size: [_2] bytes in [quant,_3,subdirectory,subdirectories] ...',
233: $totalfiles,$totalsize,$totalsubdirs).
234: '</p>';
235: my ($cwd,@args);
236: if ($format eq 'zip') {
237: $cwd = &Cwd::getcwd();
238: @args = ('zip',$filesdest,'-v','-r','.','-i@'.$namesdest);
239: chdir $prefix;
240: } else {
241: @args = ('tar',"--create","--verbose");
242: if (($compress ne '') && (exists($location_of{$compress}))) {
243: push(@args,"--$compress");
244: }
245: push(@args,("--file=$filesdest","--directory=$prefix","--files-from=$namesdest"));
246: }
247: if (open(my $pipe,'-|',@args)) {
248: my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin('',$totalfiles);
249: while (<$pipe>) {
250: &Apache::lonhtmlcommon::Increment_PrgWin('',\%prog_state,'last file');
251: }
252: &Apache::lonhtmlcommon::Close_PrgWin('',\%prog_state);
253: close($pipe);
254: if (!-e $filesdest) {
255: print '<p>'.&mt('No archive file available for download').'</p>'."\n";
256: }
257: } else {
258: print '<p>'.&mt('Could not call [_1] command',$format).'</p>'."\n";
259: }
260: if (($format eq 'zip') && ($cwd ne '')) {
261: chdir $cwd;
262: }
263: } else {
264: print '<p>'.&mt('No files match the requested types so no archive file was created.').'</p>'."\n";
265: }
266: unlink($namesdest);
267: } else {
268: print '<p>'.&mt('Could not store list of files to archive').'</p>'."\n";
269: }
270: if ($lock) { &Apache::lonnet::remove_lock($lock); }
271: } else {
272: print '<p>'.&mt('Could not find location of [_1] command',$format).'</p>'."\n";
273: }
274: }
275: if ($dirurl) {
276: print '<br /><br />'.
277: &Apache::lonhtmlcommon::actionbox(['<a href="'.&HTML::Entities::encode($dirurl,'\'"&<>').'">'.
278: &mt('Return to Directory').'</a>']);
279: }
280: print '</form>'.&Apache::loncommon::end_page();
281:
282: # Code to delete archive file after successful download
283: %included = ();
284: $alltypes = '';
285: $recurse = '';
286: $includeother = '';
287: $prefix = '';
288: $totalfiles = 0;
289: $totalsize = 0;
290: $totalsubdirs = 0;
291: %excluded = (
292: bak => 1,
293: save => 1,
294: log => 1,
295: );
296: }
297:
298: sub filter_files {
299: my @PossibleFiles = @_;
300: my @ChosenFiles;
301: foreach my $file (@PossibleFiles) {
302: if (-d $File::Find::dir."/".$file) {
303: if (!$recurse) {
304: my $depth = $File::Find::dir =~ tr[/][];
305: next unless ($depth < $maxdepth-1);
306: }
307: push(@ChosenFiles,$file);
308: } else {
309: my ($extension) = ($file =~ /\.([^.]+)$/);
310: if ((!$excluded{$extension}) && ($alltypes || $includeother || $included{$extension})) {
311: push(@ChosenFiles,$file);
312: }
313: }
314: }
315: return @ChosenFiles;
316: }
317:
318: sub store_names {
319: my $filename = $File::Find::name;
320: if (-d $filename) {
321: unless ("$filename/" eq $prefix) {
322: if ($recurse) {
323: $subdirs{$filename} = 1;
324: $totalsubdirs ++;
325: }
326: }
327: next;
328: }
329: $totalfiles ++;
330: $totalsize += -s $filename;
331: $filename =~ s{^$prefix}{};
332: print $fh "$filename\n";
333: }
334:
335: sub js {
336: my $output = <<'END';
337: const xhrButtonSuccess = document.querySelector(".xhr.success");
338: const xhrButtonError = document.querySelector(".xhr.error");
339: const xhrButtonAbort = document.querySelector(".xhr.abort");
340: const log = document.querySelector(".event-log");
341:
342: function handleEvent(e) {
343: log.textContent = `${log.textContent}${e.type}: ${e.loaded} bytes transferred\n`;
344: }
345:
346: function addListeners(xhr) {
347: xhr.addEventListener("loadstart", handleEvent);
348: xhr.addEventListener("load", handleEvent);
349: xhr.addEventListener("loadend", handleEvent);
350: xhr.addEventListener("progress", handleEvent);
351: xhr.addEventListener("error", handleEvent);
352: xhr.addEventListener("abort", handleEvent);
353: }
354:
355: function runXHR(url) {
356: log.textContent = "";
357:
358: const xhr = new XMLHttpRequest();
359: addListeners(xhr);
360: xhr.open("GET", url);
361: xhr.send();
362: return xhr;
363: }
364:
365: xhrButtonSuccess.addEventListener("click", () => {
366: runXHR(
367: "https://somewhere",
368: );
369: });
370:
371: xhrButtonError.addEventListener("click", () => {
372: runXHR("http://i-dont-exist");
373: });
374:
375: xhrButtonAbort.addEventListener("click", () => {
376: runXHR(
377: "https://somewhere",
378: ).abort();
379: });
380:
381: END
382:
383: }
384:
385:
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