Annotation of loncom/cgi/archive.pl, revision 1.1
1.1 ! raeburn 1: #!/usr/bin/perl
! 2: #
! 3: # $Id: archive.pl,v 1.1 2024/05/02 18:33:17 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