atool

   1 #!/usr/bin/perl -w
   2 #
   3 # atool - A script for managing file archives of various types.
   4 #
   5 # Copyright (C) 2001, 2002, 2003, 2004, 2005, 2007, 2008,
   6 # 2009 Oskar Liljeblad
   7 #
   8 # This program is free software; you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 2 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along
  19 # with this program; if not, write to the Free Software Foundation,
  20 # Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  21 #
  22 # See the atool(1) manual page for usage details.
  23 #
  24 # This file uses tab stops with a length of two.
  25 #
  26
  27 # XXX: We could use -CLSDA but 5.10.0 has a bug which prevents us from
  28 # specifying this with shebang. Thanks to some helpful dude on #perl
  29 # FreeNode.
  30 if (${^UTF8LOCALE}) {
  31   use Encode qw(decode_utf8);
  32   binmode($_, ':encoding(UTF-8)') for \*STDIN, \*STDOUT, \*STDERR;
  33   $_ = decode_utf8($_) for @ARGV, values %ENV;
  34 }
  35
  36 use File::Basename;
  37 use File::Spec;
  38 use Getopt::Long;
  39 use POSIX;
  40 use locale;
  41 use strict;
  42
  43 # Subroutine prototypes (needed for perl 5.6)
  44 sub runcmds($$$;@);
  45 sub getmode();
  46 sub multiarchivecmd($$$$@);
  47 sub singlearchivecmd($$$$$@);
  48 sub maketarcmd($$$$@);
  49 sub cmdexec($@);
  50 sub parsefmt($$);
  51 sub makeoutdir();
  52 sub makeoutfile($);
  53 sub explain($);
  54 sub extract(@);
  55 sub shquotemeta($);
  56 sub tailslash($);
  57 sub de($);
  58 sub makespec(@);
  59 sub backticks(@);
  60 sub readconfig($$);
  61 sub formatext($);
  62 sub stripext($);
  63 sub findformat($$);
  64 sub unlink_directory($);
  65 sub find_comparable_file($);
  66 sub makeabsolute($);
  67 sub quote($);
  68 sub shell_execute(@);
  69 sub save_outdir($);
  70 sub handle_empty_add(@);
  71 sub issingleformat($);
  72 sub repack_archive($$$$);
  73 sub set_config_option($$$);
  74
  75 $::SYSCONFDIR = '/usr/local/etc'; # This line is automatically updated by make
  76 $::PACKAGE = 'atool'; # This line is automatically updated by make
  77 $::VERSION = '0.37.0'; # This line is automatically updated by make
  78 $::BUG_EMAIL = 'oskar@osk.mine.nu'; # This line is automatically updated by make
  79 $::PROGRAM = $::PACKAGE;
  80
  81 # Configuration options and their built-in defaults
  82 $::cfg_args_diff            = '-ru';              # arguments to pass to diff program
  83 $::cfg_decompress_to_cwd    = 1;                  # decompress to current directory
  84 $::cfg_default_verbosity    = 1;                  # default verbosity level
  85 $::cfg_extract_deb_control  = 1;                  # extract DEBIAN control dir from .deb packages?
  86 $::cfg_keep_compressed      = 1;                  # keep compressed file after pack/unpack
  87 $::cfg_path_7z              = '7z';               # 7z program
  88 $::cfg_path_ar              = 'ar';               # ar program
  89 $::cfg_path_arc             = 'arc';              # arc program
  90 $::cfg_path_arj             = 'arj';              # arj program
  91 $::cfg_path_bzip            = 'bzip';             # bzip program
  92 $::cfg_path_bzip2           = 'bzip2';            # bzip2 program
  93 $::cfg_path_cabextract      = 'cabextract';       # cabextract program
  94 $::cfg_path_cat             = 'cat';              # cat program
  95 $::cfg_path_compress        = 'compress';         # compress program
  96 $::cfg_path_cpio            = 'cpio';             # cpio program
  97 $::cfg_path_diff            = 'diff';             # diff program
  98 $::cfg_path_dpkg_deb        = 'dpkg-deb';         # dpkg-deb program
  99 $::cfg_path_file            = 'file';             # file program
 100 $::cfg_path_find            = 'find';             # find program
 101 $::cfg_path_gzip            = 'gzip';             # gzip program
 102 $::cfg_path_jar             = 'jar';              # jar program
 103 $::cfg_path_lha             = 'lha';              # lha program
 104 $::cfg_path_lrzip           = 'lrzip';            # lrzip program
 105 $::cfg_path_lzip            = 'lzip';             # lzip program
 106 $::cfg_path_lzma            = 'lzma';             # lzma program
 107 $::cfg_path_lzop            = 'lzop';             # lzop program
 108 $::cfg_path_nomarch         = 'nomarch';          # nomarch program
 109 $::cfg_path_pager           = 'pager';            # pager program
 110 $::cfg_path_pbzip2          = 'pbzip2';           # pbzip2 program
 111 $::cfg_path_rar             = 'rar';              # rar program
 112 $::cfg_path_rpm             = 'rpm';              # rpm program
 113 $::cfg_path_rpm2cpio        = 'rpm2cpio';         # rpm2cpio program
 114 $::cfg_path_rzip            = 'rzip';             # rzip program
 115 $::cfg_path_syscfg          = File::Spec->catfile($::SYSCONFDIR, $::PROGRAM.'.conf');  # system-wide configuration file
 116 $::cfg_path_tar             = 'tar';              # tar program
 117 $::cfg_path_unace           = 'unace';            # unace program
 118 $::cfg_path_unalz           = 'unalz';            # unalz program
 119 $::cfg_path_unarj           = 'unarj';            # unarj program
 120 $::cfg_path_unrar           = 'unrar';            # unrar program
 121 $::cfg_path_unzip           = 'unzip';            # unzip program
 122 $::cfg_path_usercfg         = '.'.$::PROGRAM.'rc';  # user configuration file
 123 $::cfg_path_xargs           = 'xargs';            # xargs program
 124 $::cfg_path_xz              = 'xz';               # xz program
 125 $::cfg_path_zip             = 'zip';              # zip program
 126 $::cfg_show_extracted       = 1;                  # always show extracted file/directory
 127 $::cfg_strip_unknown_ext    = 1;                  # strip unknown extensions
 128 $::cfg_tmpdir_name          = 'Unpack-%04d';      # extraction directory name
 129 $::cfg_tmpfile_name         = 'Pack-%04d';        # temporary file used during packing
 130 $::cfg_use_arc_for_unpack   = 0;                  # use arc to unpack arc files?
 131 $::cfg_use_arj_for_unpack   = 0;                  # use arj to unpack arj files?
 132 $::cfg_use_file             = 1;                  # use file(1) for unknown extensions?
 133 $::cfg_use_file_always      = 0;                  # always use file to identify archives (ignore extension)
 134 $::cfg_use_find_cpio_print0 = 1;                  # use -print0/-0 find/cpio options?
 135 $::cfg_use_gzip_for_z       = 1;                  # use gzip to decompress .Z files?
 136 $::cfg_use_jar              = 0;                  # use jar or zip for .jar archives?
 137 $::cfg_use_pbzip2           = 0;                  # use pbzip2 instead of bzip2
 138 $::cfg_use_rar_for_unpack   = 0;                  # use rar to unpack rar files?
 139 $::cfg_use_tar_bzip2_option = 1;                  # does tar support --bzip2?
 140 $::cfg_use_tar_lzma_option  = 1;                  # does tar support --lzma?
 141 $::cfg_use_tar_lzop_option  = 0;                  # does tar support --lzop?
 142 $::cfg_use_tar_xv_option    = 0;                  # does tar support --xv?
 143 $::cfg_use_tar_z_option     = 1;                  # does tar support -z?
 144
 145 # Global variables
 146 $::basename = quote(File::Basename::basename($0));
 147 @::rmdirs = ();
 148 $::up = File::Spec->updir();
 149 $::cur = File::Spec->curdir();
 150 @::opt_options = ();
 151
 152 # Parse arguments
 153 Getopt::Long::config('bundling');
 154 Getopt::Long::GetOptions(
 155   'l|list'         => \$::opt_cmd_list,
 156   'x|extract'      => \$::opt_cmd_extract,
 157   'X|extract-to=s' => \$::opt_cmd_extract_to,
 158   'a|add'          => \$::opt_cmd_add,
 159   'c|cat'          => \$::opt_cmd_cat,
 160   'd|diff'         => \$::opt_cmd_diff,
 161   'r|repack'       => \$::opt_cmd_repack,
 162   'q|quiet'        => sub { $::opt_verbosity--; },
 163   'v|verbose'      => sub { $::opt_verbosity++; },
 164   'V|verbosity=i'  => \$::opt_verbosity,
 165   'config=s'       => \$::opt_config,
 166   'o|option=s'     => sub { push @::opt_options, $_[1] },
 167   'help'           => \$::opt_cmd_help,
 168   'version'        => \$::opt_cmd_version,
 169   'F|format=s'     => \$::opt_format,
 170   'f|force'        => \$::opt_force,
 171   'p|page'         => \$::opt_use_pager,
 172   'e|each'         => \$::opt_each,
 173   'E|explain'      => \$::opt_explain,
 174   'S|simulate'     => \$::opt_simulate,
 175   'save-outdir=s'  => \$::opt_save_outdir,
 176   'D|subdir'       => \$::opt_extract_subdir,
 177   '0|null'         => \$::opt_null,
 178 ) or exit 1;
 179
 180 # Display --version
 181 if ($::opt_cmd_version) {
 182   print $::PACKAGE.' '.$::VERSION."\
 183 Copyright (C) 2001, 2002, 2003, 2004, 2005, 2007, 2008 Oskar Liljeblad\
 184 This is free software.  You may redistribute copies of it under the terms of
 185 the GNU General Public License <http://www.gnu.org/licenses/gpl.html>.
 186 There is NO WARRANTY, to the extent permitted by law.
 187
 188 Written by Oskar Liljeblad.\n";
 189   exit;
 190 }
 191
 192 # Display --help
 193 if ($::opt_cmd_help) {
 194   print "Usage: $::PROGRAM [OPTION]... ARCHIVE [FILE]...\n";
 195   print "       $::PROGRAM -e [OPTION]... [ARCHIVE]...\n";
 196   print "Manage file archives of various types.\
 197 \
 198 Commands:\
 199   -l, --list              list files in archive (als)\
 200   -x, --extract           extract files from archive (aunpack)\
 201   -X, --extract-to=PATH   extract archive to specified directory\
 202   -a, --add               create archive (apack)\
 203   -c, --cat               extract file to standard out (acat)\
 204   -d, --diff              generate a diff between two archives (adiff)\
 205   -r, --repack            repack archives to a different format (arepack)\
 206       --help              display this help and exit\
 207       --version           output version information and exit\
 208 \
 209 Options:\
 210   -e, --each              execute command above for each file specified
 211   -F, --format=EXT        override archive format (see below)\
 212   -D, --subdir            always create subdirectory when extracting\
 213   -f, --force             allow overwriting of local files\
 214   -q, --quiet             decrease verbosity level by one\
 215   -v, --verbose           increase verbosity level by one\
 216   -V, --verbosity=LEVEL   specify verbosity (0, 1 or 2)\
 217   -p, --page              send output through pager\
 218   -0, --null              filenames from standard in are null-byte separated\
 219   -E, --explain           explain what is being done by ".$::PROGRAM."\
 220   -S, --simulate          simulation mode - no filesystem changes are made\
 221   -o, --option=KEY=VALUE  override a configuration option\
 222       --config=FILE       load configuration defaults from file\
 223 \
 224 Archive format (for --format) may be specified either as a\
 225 file extension (\"tar.gz\") or as \"tar+gzip\".\
 226 \
 227 Report bugs to Oskar Liljeblad <".$::BUG_EMAIL.">.\
 228 ";
 229   exit;
 230 }
 231
 232 # Read configuration files
 233 if (defined $::opt_config) {
 234   readconfig($::opt_config, 0);
 235 } else {
 236   readconfig($::cfg_path_syscfg, 1);
 237   if ($::cfg_path_usercfg !~ /^\//) {
 238     readconfig(File::Spec->catfile($ENV{HOME}, $::cfg_path_usercfg), 1);
 239   } else {
 240     readconfig($::cfg_path_usercfg, 1);
 241   }
 242 }
 243 foreach my $opt (@::opt_options) {
 244   my ($var,$val) = ($opt =~ /^([^=]+)=(.*)$/);
 245   die "$::basename: invalid value for --option: $opt\n" if !defined $val;
 246   set_config_option($var, $val, '');
 247 }
 248
 249 # Verify option integrity
 250 $::opt_verbosity += $::cfg_default_verbosity;
 251 if ($::opt_explain && $::opt_simulate) {
 252   die "$::basename: --explain and --simulate options are mutually exclusive\n"; #OK
 253 }
 254
 255 my $mode = getmode();
 256
 257 if (defined $::opt_save_outdir && $mode eq 'extract-to') {
 258   die "$::basename: --save-outdir cannot be used in extract-to mode\n";
 259 }
 260 if ($::opt_extract_subdir && $mode ne 'extract') {
 261   die "$::basename: --subdir can only be used in extract mode\n";
 262 }
 263
 264 if ($mode eq 'diff') {
 265   die "$::basename: missing archive argument\n" if (@ARGV < 2); #OK
 266   my $use_pager = $::opt_use_pager;
 267   $::opt_verbosity--;
 268   $::opt_use_pager = 0;
 269
 270   my $outfile1 = makeoutdir() || exit 1;
 271   my $outfile2 = makeoutdir() || exit 1;
 272   $::opt_cmd_extract_to = $outfile1;
 273   $::opt_cmd_extract_to_type = 'f';
 274   exit 1 if (!runcmds('extract-to', undef, $ARGV[0]));
 275   $::opt_cmd_extract_to = $outfile2;
 276   $::opt_cmd_extract_to_type = 'f';
 277   exit 1 if (!runcmds('extract-to', undef, $ARGV[1]));
 278
 279   my $match1 = find_comparable_file($outfile1);
 280   my $match2 = find_comparable_file($outfile2);
 281
 282   my @cmd = ($::cfg_path_diff, split(/ /, $::cfg_args_diff), $match1, $match2);
 283   push @cmd, ['|'], get_pager_program() if $use_pager;
 284   my $allok = cmdexec(1, @cmd);
 285
 286   foreach my $file ($outfile1,$outfile2) {
 287     warn 'rm -r ',quote($file),"\n" if $::opt_simulate;
 288     if (-e $file && -d $file) {
 289     #if (-e $file) {
 290       #print "$::basename: remove `$file'? ";
 291       #select((select(STDOUT), $| = 1)[0]);
 292       #my $line = <STDIN>;
 293       #if (defined $line && $line =~ /^y/) {
 294         #if (-d $file) {
 295           warn 'rm -r ',quote($file),"\n" if $::opt_explain;
 296           unlink_directory($file) if !$::opt_simulate;
 297         #} else {
 298           #unlink $file;
 299         #}
 300       #}
 301     }
 302   }
 303
 304   exit ($allok ? 0 : 1);
 305 }
 306 elsif ($mode eq 'repack') {
 307   if ($::opt_each) {
 308     my $totaldiff = 0;
 309     if (!defined $::opt_format) {
 310       die "$::basename: specify a format with -F when using --each in repack mode\n";
 311     }
 312     my $fmt2 = findformat($::opt_format, 1);
 313     for (my $c = 0; $c < @ARGV; $c++) {
 314       my $fmt1 = findformat($ARGV[$c], 0);
 315       if (!issingleformat($fmt1) && issingleformat($fmt2)) {
 316         warn "$::basename: format $fmt1 is cannot be repacked into format $fmt2\n";
 317         warn "skipping ", quote($ARGV[$c]), "\n";
 318         next;
 319       }
 320       if ($fmt1 eq $fmt2) {
 321         warn "$::basename: will not repack to same archive type\n";
 322         warn "skipping ", quote($ARGV[$c]), "\n";
 323         next;
 324       }
 325       my $newname = stripext($ARGV[$c]).formatext($fmt2);
 326       if (-e $newname) {
 327         warn "$::basename: ".quote($newname).": destination file exists\n";
 328         warn "skipping ", quote($ARGV[$c]), "\n";
 329         next;
 330       }
 331       repack_archive($ARGV[$c], $newname, $fmt1, $fmt2);
 332       my $diff = ($::opt_simulate ? 0 : -s $ARGV[$c] - -s $newname);
 333       $totaldiff += $diff;
 334       if ($::opt_verbosity >= 1) {
 335         print quote($newname), ': ',
 336             ($diff >= 0 ? 'saved '.$diff : 'grew '.-$diff),' ',
 337             ($diff == 1 ? 'byte':'bytes'), "\n";
 338       }
 339     }
 340     if ($::opt_verbosity >= 1) {
 341       print $totaldiff >= 0 ? 'saved '.$totaldiff : 'grew '.-$totaldiff, ' ',
 342           $totaldiff == 1 ? 'byte':'bytes', " in total\n";
 343     }
 344   } else {
 345     die "$::basename: missing archive arguments\n" if (@ARGV < 1); #OK
 346     die "$::basename: missing archive argument\n" if (@ARGV < 2); #OK
 347     die "$::basename: will not repack to same archive file\n"
 348       if ($ARGV[0] eq $ARGV[1] || File::Spec->canonpath($ARGV[0]) eq File::Spec->canonpath($ARGV[1]));
 349     die "$::basename: ".quote($ARGV[1]).": destination file exists\n" if -e $ARGV[1];
 350     my $fmt1 = findformat($ARGV[0], 0);
 351     my $fmt2 = findformat($ARGV[1], 0);
 352     die "$::basename: format $fmt1 is cannot be repacked into format $fmt1\n"
 353       if (!issingleformat($fmt1) && issingleformat($fmt2));
 354     die "$::basename: will not repack to same archive type\n" if $fmt1 eq $fmt2;
 355     repack_archive($ARGV[0], $ARGV[1], $fmt1, $fmt2);
 356     my $diff = ($::opt_simulate ? 0 : (-s $ARGV[0]) - (-s $ARGV[1]));
 357     if ($::opt_verbosity >= 1) {
 358       print quote($ARGV[1]), ': ',
 359           ($diff >= 0 ? 'saved '.$diff : 'grew '.-$diff),' ',
 360           ($diff == 1 ? 'byte':'bytes'), "\n";
 361     }
 362   }
 363 }
 364 elsif ($::opt_each) {
 365   my $allok = 1;
 366   if ($mode eq 'cat') {
 367     die "$::basename: --each can not be used with cat or add command\n";  #OK
 368   }
 369   if ($mode eq 'add') {
 370     if (!defined $::opt_format) {
 371       die "$::basename: specify a format with -F when using --each in add mode\n";
 372     }
 373     my $format = findformat($::opt_format, 1);
 374     for (my $c = 0; $c < @ARGV; $c++) {
 375       my $archive = File::Spec->canonpath($ARGV[$c]) . formatext($format);
 376       warn quote($archive).":\n" if $::opt_verbosity > 1;
 377       runcmds('add', $format, $archive, $ARGV[$c]) or $allok = 0;
 378     }
 379   } else {
 380     for (my $c = 0; $c < @ARGV; $c++) {
 381       warn quote($ARGV[$c]).":\n" if $::opt_verbosity > 1;
 382       runcmds($mode, undef, $ARGV[$c]) or $allok = 0;
 383     }
 384   }
 385   exit ($allok ? 0 : 1);
 386 }
 387 else {
 388   die "$::basename: missing archive argument\n" if (@ARGV == 0);  #OK
 389   runcmds($mode, undef, shift @ARGV, @ARGV) || exit 1;
 390 }
 391
 392 # runcmds(mode, format, archive, args)
 393 # Execute an atool command. This is where it all happens.
 394 # If mode is 'extract', returns the directory (or only file)
 395 # which was extracted.
 396 # If forceformat is undef, the format will be detected from
 397 # $::opt_format or the filename.
 398 sub runcmds($$$;@) {
 399   my ($mode, $format, $archive, @args) = @_;
 400
 401   if (!defined $format) {
 402     if (defined $::opt_format) {
 403       $format = findformat($::opt_format, 1);
 404     } else {
 405       $format = findformat($archive, 0);
 406     }
 407     return undef if !defined $format;
 408   }
 409
 410   my @cmd;
 411   my $outdir;
 412   if ($format eq 'tar+bzip2') {
 413     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 414     if ($::cfg_use_tar_bzip2_option) {
 415       push @cmd, maketarcmd($archive, $outdir, $mode, 'f', '--bzip2'), @args;
 416     } elsif ($::cfg_use_pbzip2) {
 417       if ($mode eq 'add') {
 418         # Unfortunately pbzip2 cannot read from standard in
 419         my $tmpname = makeoutfile($::cfg_tmpfile_name);
 420         push @cmd, maketarcmd($tmpname, $outdir, $mode, 'f'), @args;
 421         push @cmd, [';'], $::cfg_path_pbzip2, '-c', $tmpname, ['>'], $archive;
 422         push @cmd, [';'], 'rm', $tmpname;
 423       } else {
 424         push @cmd, $::cfg_path_pbzip2, '-cd', $archive, ['|'];
 425         push @cmd, maketarcmd('-', $outdir, $mode, 'f'), @args;
 426       }
 427     } else {
 428       push @cmd, $::cfg_path_bzip2, '-cd', $archive, ['|'] if $mode ne 'add';
 429       push @cmd, maketarcmd('-', $outdir, $mode, 'f'), @args;
 430       push @cmd, ['|'], $::cfg_path_bzip2, '-c', ['>'], $archive if $mode eq 'add';
 431     }
 432     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 433     return multiarchivecmd($archive, $outdir, $mode, 1, 0, \@args, @cmd);
 434   }
 435   elsif ($format eq 'tar+gzip') {
 436     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 437     if ($::cfg_use_tar_z_option) {
 438       push @cmd, maketarcmd($archive, $outdir, $mode, 'zf'), @args;
 439     } else {
 440       push @cmd, $::cfg_path_gzip, '-cd', $archive, ['|'] if $mode ne 'add';
 441       push @cmd, maketarcmd('-', $outdir, $mode, 'f'), @args;
 442       push @cmd, ['|'], $::cfg_path_gzip, '-c', ['>'], $archive if $mode eq 'add';
 443     }
 444     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 445     return multiarchivecmd($archive, $outdir, $mode, 1, 0, \@args, @cmd);
 446   }
 447   elsif ($format eq 'tar+bzip') {
 448     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 449     push @cmd, $::cfg_path_bzip, '-cd', $archive, ['|'] if $mode ne 'add';
 450     push @cmd, maketarcmd('-', $outdir, $mode, 'f'), @args;
 451     push @cmd, ['|'], $::cfg_path_bzip, '-c', ['>'], $archive if $mode eq 'add';
 452     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 453     return multiarchivecmd($archive, $outdir, $mode, 1, 0, \@args, @cmd);
 454   }
 455   elsif ($format eq 'tar+compress') {
 456     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 457     if ($::cfg_use_gzip_for_z) {
 458       push @cmd, $::cfg_path_gzip, '-cd', $archive, ['|'] if $mode ne 'add';
 459     } else {
 460       push @cmd, $::cfg_path_compress, '-cd', $archive, ['|'] if $mode ne 'add';
 461     }
 462     push @cmd, maketarcmd('-', $outdir, $mode, 'f'), @args;
 463     push @cmd, ['|'], $::cfg_path_compress, '-c', ['>'], $archive if $mode eq 'add';
 464     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 465     return multiarchivecmd($archive, $outdir, $mode, 1, 0, \@args, @cmd);
 466   }
 467   elsif ($format eq 'tar+lzop') {
 468     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 469     if ($::cfg_use_tar_lzop_option) {
 470       push @cmd, maketarcmd($archive, $outdir, $mode, 'f', '--lzop'), @args;
 471     } else {
 472       push @cmd, $::cfg_path_lzop, '-cd', $archive, ['|'] if $mode ne 'add';
 473       push @cmd, maketarcmd('-', $outdir, $mode, 'f'), @args;
 474       push @cmd, ['|'], $::cfg_path_lzop, '-c', ['>'], $archive if $mode eq 'add';
 475     }
 476     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 477     return multiarchivecmd($archive, $outdir, $mode, 1, 0, \@args, @cmd);
 478   }
 479   elsif ($format eq 'tar+lzip') {
 480     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 481     push @cmd, $::cfg_path_lzip, '-cd', $archive, ['|'] if $mode ne 'add';
 482     push @cmd, maketarcmd('-', $outdir, $mode, 'f'), @args;
 483     push @cmd, ['|'], $::cfg_path_lzip, '-c', ['>'], $archive if $mode eq 'add';
 484     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 485     return multiarchivecmd($archive, $outdir, $mode, 1, 0, \@args, @cmd);
 486   }
 487   elsif ($format eq 'tar+xz') {
 488     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 489     if ($::cfg_use_tar_xv_option) {
 490       push @cmd, maketarcmd($archive, $outdir, $mode, 'f', '--xv'), @args;
 491     } else {
 492       push @cmd, $::cfg_path_xz, '-cd', $archive, ['|'] if $mode ne 'add';
 493       push @cmd, maketarcmd('-', $outdir, $mode, 'f'), @args;
 494       push @cmd, ['|'], $::cfg_path_xz, '-c', ['>'], $archive if $mode eq 'add';
 495     }
 496     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 497     return multiarchivecmd($archive, $outdir, $mode, 1, 0, \@args, @cmd);
 498   }
 499   elsif ($format eq 'tar+7z') {
 500     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 501     push @cmd, $::cfg_path_7z, 'x', '-so', $archive, ['|']  if $mode ne 'add';
 502     push @cmd, maketarcmd('-', $outdir, $mode, 'f'), @args;
 503     push @cmd, ['|'], $::cfg_path_7z, 'a', '-si', $archive if $mode eq 'add';
 504     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 505     return multiarchivecmd($archive, $outdir, $mode, 1, 0, \@args, @cmd);
 506   }
 507   elsif ($format eq 'tar+lzma') {
 508     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 509     if ($::cfg_use_tar_lzma_option) {
 510       push @cmd, maketarcmd($archive, $outdir, $mode, 'f', '--lzma'), @args;
 511     } else {
 512       push @cmd, $::cfg_path_lzma, '-cd', $archive, ['|']     if $mode ne 'add';
 513       push @cmd, maketarcmd('-', $outdir, $mode, 'f'), @args;
 514       push @cmd, ['|'], $::cfg_path_lzma, '-c', ['>'], $archive if $mode eq 'add';
 515     }
 516     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 517     return multiarchivecmd($archive, $outdir, $mode, 1, 0, \@args, @cmd);
 518   }
 519   elsif ($format eq 'tar') {
 520     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 521     push @cmd, maketarcmd($archive, $outdir, $mode, 'f'), @args;
 522     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 523     return multiarchivecmd($archive, $outdir, $mode, 1, 0, \@args, @cmd);
 524   }
 525   elsif ($format eq 'jar' && $::cfg_use_jar) {
 526     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 527     my $opts = '';
 528     if ($mode eq 'add') {
 529       warn "$::basename: ".quote($archive).": $mode command not supported for $format archives\n";
 530       return undef;
 531     }
 532     $opts .= 'v' if $::opt_verbosity >= 1;
 533     push @cmd, $::cfg_path_jar;
 534     push @cmd, "x$opts", '-C', $outdir if $mode eq 'extract';
 535     push @cmd, "x$opts", '-C', $::opt_cmd_extract_to if $mode eq 'extract-to';
 536     push @cmd, "t$opts" if $mode eq 'list';
 537     push @cmd, "c$opts" if $mode eq 'add';
 538     push @cmd, $archive, @args;
 539     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 540     return multiarchivecmd($archive, $outdir, $mode, 1, 0, \@args, @cmd);
 541   }
 542   elsif ($format eq 'jar' || $format eq 'zip') {
 543     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 544     if ($mode eq 'add') {
 545       push @cmd, $::cfg_path_zip, '-r';
 546     } else {
 547       push @cmd, $::cfg_path_unzip;
 548       push @cmd, '-p' if $mode eq 'cat';
 549       push @cmd, '-l' if $mode eq 'list';
 550       push @cmd, '-d', $outdir if $mode eq 'extract';
 551       push @cmd, '-d', $::opt_cmd_extract_to if $mode eq 'extract-to';
 552     }
 553     push @cmd, '-v' if $::opt_verbosity > 1;
 554     push @cmd, '-qq' if $::opt_verbosity < 0;
 555     push @cmd, '-q' if $::opt_verbosity == 0;
 556     push @cmd, $archive, @args;
 557     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 558     return multiarchivecmd($archive, $outdir, $mode, 0, 0, \@args, @cmd);
 559   }
 560   elsif ($format eq 'rar') {
 561     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 562     if ($mode eq 'add' || $::cfg_use_rar_for_unpack) {
 563       push @cmd, $::cfg_path_rar;
 564     } else {
 565       push @cmd, $::cfg_path_unrar;
 566     }
 567     push @cmd, 'a' if $mode eq 'add';
 568     push @cmd, 'vt' if $mode eq 'list' && $::opt_verbosity >= 3;
 569     push @cmd, 'v' if $mode eq 'list' && $::opt_verbosity == 2;
 570     push @cmd, 'l' if $mode eq 'list' && $::opt_verbosity <= 1;
 571     push @cmd, 'x' if ($mode eq 'extract' || $mode eq 'extract-to');
 572     push @cmd, '-ierr', 'p' if $mode eq 'cat';
 573     push @cmd, '-r0' if ($mode eq 'add');
 574     push @cmd, $archive, @args;
 575     push @cmd, tailslash($outdir) if $mode eq 'extract';
 576     push @cmd, tailslash($::opt_cmd_extract_to) if $mode eq 'extract-to';
 577     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 578     return multiarchivecmd($archive, $outdir, $mode, 0, 0, \@args, @cmd);
 579   }
 580   elsif ($format eq '7z') {
 581     # 7z has the -so option for writing data to stdout, but it doesn't
 582     # write data to terminal even if the file is designed to be
 583     # read in a terminal...
 584     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 585     #if ($mode eq 'cat') {
 586     #  warn "$::basename: ".quote($archive).": $mode command not supported for $format archives\n";
 587     #  return undef;
 588     #}
 589     push @cmd, $::cfg_path_7z;
 590     push @cmd, 'a' if $mode eq 'add';
 591     push @cmd, 'l' if $mode eq 'list';
 592     push @cmd, 'x', '-so' if $mode eq 'cat';
 593     push @cmd, 'x', '-o'.$outdir if $mode eq 'extract';
 594     push @cmd, 'x', '-o'.$::opt_cmd_extract_to if $mode eq 'extract-to';
 595     push @cmd, $archive, @args;
 596     return multiarchivecmd($archive, $outdir, $mode, 1, 0, \@args, @cmd);
 597   }
 598   elsif ($format eq 'cab') {
 599     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 600     if ($mode eq 'add') {
 601       warn "$::basename: ".quote($archive).": $mode command not supported for $format archives\n";
 602       return undef;
 603     }
 604     push @cmd, $::cfg_path_cabextract;
 605     push @cmd, '--single';
 606     push @cmd, '--directory', $outdir if $mode eq 'extract';
 607     push @cmd, '--directory', $::opt_cmd_extract_to if $mode eq 'extract-to';
 608     push @cmd, '--pipe' if $mode eq 'cat';
 609     push @cmd, '--list' if $mode eq 'list';
 610     push @cmd, $archive;
 611     push @cmd, '--filter';
 612     push @cmd, @args;
 613     return multiarchivecmd($archive, $outdir, $mode, 0, 0, \@args, @cmd);
 614   }
 615   elsif ($format eq 'alzip') {
 616     if ($mode eq 'cat' || $mode eq 'add' || $mode eq 'list') {
 617       warn "$::basename: ".quote($archive).": $mode command not supported for $format archives\n";
 618       return undef;
 619     }
 620     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 621     push @cmd, $::cfg_path_unalz;
 622     push @cmd, $archive;
 623     push @cmd, $outdir if $mode eq 'extract';
 624     push @cmd, $::opt_cmd_extract_to if $mode eq 'extract-to';
 625     return multiarchivecmd($archive, $outdir, $mode, 0, 0, \@args, @cmd);
 626   }
 627   elsif ($format eq 'lha') {
 628     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 629     push @cmd, $::cfg_path_lha;
 630     push @cmd, 'a' if $mode eq 'add';
 631     push @cmd, 'v' if $mode eq 'list' && $::opt_verbosity >= 3;
 632     push @cmd, 'l' if $mode eq 'list' && $::opt_verbosity == 2;
 633     push @cmd, 'lq' if $mode eq 'list' && $::opt_verbosity <= 1;
 634     push @cmd, 'xw='.tailslash($outdir) if $mode eq 'extract';
 635     push @cmd, 'xw='.tailslash($::opt_cmd_extract_to) if $mode eq 'extract-to';
 636     push @cmd, 'p' if $mode eq 'cat';
 637     push @cmd, $archive, @args;
 638     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 639     return multiarchivecmd($archive, $outdir, $mode, 0, 0, \@args, @cmd);
 640   }
 641   elsif ($format eq 'ace') {
 642     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 643     push @cmd, $::cfg_path_unace;
 644     if ($mode eq 'add' || $mode eq 'cat') {
 645       warn "$::basename: ".quote($archive).": $mode command not supported for $format archives\n";
 646       return undef;
 647     }
 648     push @cmd, 'v', '-c' if $mode eq 'list' && $::opt_verbosity >= 3;
 649     push @cmd, 'v' if $mode eq 'list' && $::opt_verbosity == 2;
 650     push @cmd, 'l' if $mode eq 'list' && $::opt_verbosity <= 1;
 651     push @cmd, 'x' if ($mode eq 'extract' || $mode eq 'extract-to');
 652     push @cmd, $archive, @args;
 653     push @cmd, tailslash($outdir) if $mode eq 'extract';
 654     push @cmd, tailslash($::opt_cmd_extract_to) if $mode eq 'extract-to';
 655     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 656     return multiarchivecmd($archive, $outdir, $mode, 0, 0, \@args, @cmd);
 657   }
 658   elsif ($format eq 'arj') {
 659     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 660     if ($mode eq 'cat') {
 661       warn "$::basename: ".quote($archive).": $mode command not supported for $format archives\n";
 662       return undef;
 663     }
 664     if ($mode eq 'add' || $::cfg_use_arj_for_unpack) {
 665       push @cmd, $::cfg_path_arj;
 666       push @cmd, 'a' if $mode eq 'add';
 667       push @cmd, 'v' if $mode eq 'list' && $::opt_verbosity == 2;
 668       push @cmd, 'l' if $mode eq 'list' && $::opt_verbosity <= 1;
 669       push @cmd, 'x' if ($mode eq 'extract' || $mode eq 'extract-to');
 670       push @cmd, $archive, @args;
 671       push @cmd, tailslash($outdir) if $mode eq 'extract';
 672       push @cmd, tailslash($::opt_cmd_extract_to) if $mode eq 'extract-to';
 673       @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 674       return multiarchivecmd($archive, $outdir, $mode, 0, 0, \@args, @cmd);
 675     } else {
 676       push @cmd, $::cfg_path_unarj;
 677       # XXX: cat mode might work for arj archives, but it extract to stderr!
 678       push @cmd, 'v' if $mode eq 'list' && $::opt_verbosity == 2;
 679       push @cmd, 'l' if $mode eq 'list' && $::opt_verbosity <= 1;
 680       push @cmd, 'x' if ($mode eq 'extract' || $mode eq 'extract-to');
 681       push @cmd, $archive if ($mode ne 'extract' && $mode ne 'extract-to');;
 682       # we call makeabsolute here because needcwd=1 to the multiarchivecmd call
 683       push @cmd, makeabsolute($archive) if ($mode eq 'extract' || $mode eq 'extract-to');
 684       push @cmd, @args;
 685       @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 686       return multiarchivecmd($archive, $outdir, $mode, 0, 1, \@args, @cmd);
 687     }
 688   }
 689   elsif ($format eq 'arc') {
 690     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 691     if ($mode eq 'add' || $::cfg_use_arc_for_unpack) {
 692       push @cmd, $::cfg_path_arc;
 693       push @cmd, 'a' if $mode eq 'add';
 694       push @cmd, 'v' if $mode eq 'list' && $::opt_verbosity >= 3;
 695       push @cmd, 'l' if $mode eq 'list' && $::opt_verbosity == 2;
 696       push @cmd, 'ln' if $mode eq 'list' && $::opt_verbosity <= 1;
 697       push @cmd, 'x' if ($mode eq 'extract' || $mode eq 'extract-to');
 698       push @cmd, 'p' if $mode eq 'cat';
 699     } else {
 700       push @cmd, $::cfg_path_nomarch;
 701       push @cmd, '-lvU' if $mode eq 'list' && $::opt_verbosity >= 2;
 702       push @cmd, '-lU' if $mode eq 'list' && $::opt_verbosity <= 1;
 703       push @cmd, '-p' if $mode eq 'cat';
 704     }
 705     push @cmd, $archive if ($mode ne 'extract' && $mode ne 'extract-to');
 706     # we call makeabsolute here because needcwd=1 to the multiarchivecmd call
 707     push @cmd, makeabsolute($archive) if ($mode eq 'extract' || $mode eq 'extract-to');
 708     push @cmd, @args;
 709     @cmd = handle_empty_add(@cmd) if ($mode eq 'add' && @args == 0);
 710     return multiarchivecmd($archive, $outdir, $mode, 0, 1, \@args, @cmd);
 711   }
 712   elsif ($format eq 'rpm') {
 713     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 714     if ($mode eq 'list') {
 715       push @cmd, $::cfg_path_rpm;
 716       push @cmd, '-qlp';
 717       push @cmd, '-v' if $::opt_verbosity >= 1;
 718       push @cmd, $archive, @args;
 719       return multiarchivecmd($archive, $outdir, $mode, 0, 0, \@args, @cmd);
 720     }
 721     elsif ($mode eq 'extract' || $mode eq 'extract-to') {
 722       push @cmd, $::cfg_path_rpm2cpio;
 723       push @cmd, makeabsolute($archive);
 724       push @cmd, ['|'];
 725       push @cmd, $::cfg_path_cpio, '-imd', '--quiet', @args;
 726       return multiarchivecmd($archive, $outdir, $mode, 0, 1, \@args, @cmd);
 727     }
 728     else { # add and cat
 729       # FIXME: I guess cat could work too, but it would require that we
 730       # extracted to a temporary dir, read and printed it, then removed it.
 731       warn "$::basename: ".quote($archive).": $mode command not supported for $format archives\n";
 732       return undef;
 733     }
 734   }
 735   elsif ($format eq 'deb') {
 736     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 737     if ($mode eq 'cat') {
 738       push @cmd, $::cfg_path_dpkg_deb, '--fsys-tarfile', makeabsolute($archive), ['|'];
 739       push @cmd, $::cfg_path_tar, '-xO', @args;
 740     } elsif ($mode eq 'list' || $mode eq 'extract' || $mode eq 'extract-to') {
 741       push @cmd, $::cfg_path_dpkg_deb;
 742       push @cmd, '--contents' if $mode eq 'list';
 743       if ($mode eq 'extract' || $mode eq 'extract-to') {
 744         push @cmd, '--extract' if $::opt_verbosity <= 0;
 745         push @cmd, '--vextract' if $::opt_verbosity > 0;
 746       }
 747       push @cmd, $archive;
 748       push @cmd, $outdir if $mode eq 'extract';
 749       push @cmd, $::opt_cmd_extract_to if $mode eq 'extract-to';
 750       push @cmd, @args;
 751       if ($::cfg_extract_deb_control && ($mode eq 'extract' || $mode eq 'extract-to')) {
 752         push @cmd, [';'];
 753         push @cmd, $::cfg_path_dpkg_deb;
 754         push @cmd, '--control';
 755         push @cmd, $archive;
 756         push @cmd, File::Spec->catdir($outdir, 'DEBIAN') if $mode eq 'extract';
 757         push @cmd, File::Spec->catdir($::opt_cmd_extract_to, 'DEBIAN') if $mode eq 'extract-to';
 758       }
 759     }
 760     return multiarchivecmd($archive, $outdir, $mode, 0, 0, \@args, @cmd);
 761   }
 762   elsif ($format eq 'ar') {
 763     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 764     my $v = ($::opt_verbosity >= 1 ? 'v' : '');
 765     push @cmd, $::cfg_path_ar;
 766     push @cmd, 'rc'.$v if $mode eq 'add';
 767     push @cmd, 'x'.$v if ($mode eq 'extract' || $mode eq 'extract-to');
 768     push @cmd, 't'.$v if $mode eq 'list';
 769     # Don't use v(erbose) with cat command because ar would add "\n<member data>\n\n" to output
 770     push @cmd, 'p' if $mode eq 'cat';
 771     push @cmd, makeabsolute($archive), @args;
 772     return multiarchivecmd($archive, $outdir, $mode, 1, 1, \@args, @cmd);
 773   }
 774   elsif ($format eq 'cpio') {
 775     return undef if ($mode eq 'extract' && !defined ($outdir = makeoutdir()));
 776     if ($mode eq 'list') {
 777       push @cmd, $::cfg_path_cat, $archive, ['|'];
 778       push @cmd, $::cfg_path_cpio, '-t';
 779       push @cmd, '-v' if $::opt_verbosity >= 1;
 780       return multiarchivecmd($archive, $outdir, $mode, 0, 0, \@args, @cmd);
 781     }
 782     elsif ($mode eq 'extract' || $mode eq 'extract-to') {
 783       push @cmd, $::cfg_path_cat, makeabsolute($archive), ['|'];
 784       push @cmd, $::cfg_path_cpio, '-i';
 785       push @cmd, '-v' if $::opt_verbosity >= 1;
 786       return multiarchivecmd($archive, $outdir, $mode, 0, 1, \@args, @cmd);
 787     }
 788     elsif ($mode eq 'add') {
 789       if (@args == 0) {
 790         push @cmd, $::cfg_path_cpio;
 791         push @cmd, '-0' if $::opt_null;
 792         push @cmd, '-o';
 793         push @cmd, '-v' if $::opt_verbosity >= 1;
 794         push @cmd, ['>'], $archive;
 795       } else {
 796         push @cmd, $::cfg_path_find, @args;
 797         push @cmd, '-print0' if $::cfg_use_find_cpio_print0;
 798         push @cmd, ['|'], $::cfg_path_cpio;
 799         push @cmd, '-0' if $::cfg_use_find_cpio_print0;
 800         push @cmd, '-o';
 801         push @cmd, '-v' if $::opt_verbosity >= 1;
 802         push @cmd, ['>'], $archive;
 803       }
 804       return multiarchivecmd($archive, $outdir, $mode, 1, 1, \@args, @cmd);
 805     }
 806     else { # cat
 807       warn "$::basename: ".quote($archive).": $mode command not supported for $format archives\n";
 808       return undef;
 809     }
 810   }
 811   elsif ($format eq 'bzip2') {
 812     return singlearchivecmd($archive, $::cfg_use_pbzip2 ? $::cfg_path_pbzip2 : $::cfg_path_bzip2, $format, $mode, 1, @args);
 813   }
 814   elsif ($format eq 'bzip') {
 815     return singlearchivecmd($archive, $::cfg_path_bzip, $format, $mode, 1, @args);
 816   }
 817   elsif ($format eq 'gzip') {
 818     return singlearchivecmd($archive, $::cfg_path_gzip, $format, $mode, 1, @args);
 819   }
 820   elsif ($format eq 'compress') {
 821     if ($::cfg_use_gzip_for_z && $mode ne 'add') {
 822       return singlearchivecmd($archive, $::cfg_path_gzip, $format, $mode, 1, @args);
 823     } else {
 824       return singlearchivecmd($archive, $::cfg_path_compress, $format, $mode, 1, @args);
 825     }
 826   }
 827   elsif ($format eq 'lzma') {
 828     return singlearchivecmd($archive, $::cfg_path_lzma, $format, $mode, 1, @args);
 829   }
 830   elsif ($format eq 'lzop') {
 831     return singlearchivecmd($archive, $::cfg_path_lzop, $format, $mode, 0, @args);
 832   }
 833   elsif ($format eq 'lzip') {
 834     return singlearchivecmd($archive, $::cfg_path_lzip, $format, $mode, 1, @args);
 835   }
 836   elsif ($format eq 'xz') {
 837     return singlearchivecmd($archive, $::cfg_path_xz, $format, $mode, 1, @args);
 838   }
 839   elsif ($format eq 'rzip') {
 840     return singlearchivecmd($archive, $::cfg_path_rzip, $format, $mode, 0, @args);
 841   }
 842   elsif ($format eq 'lrzip') {
 843     return singlearchivecmd($archive, $::cfg_path_lrzip, $format, $mode, 0, @args);
 844   }
 845
 846   return undef;
 847 }
 848
 849 # de(value):
 850 # Return 1 if value defined and is non-zero, 0 otherwise.
 851 sub de($) {
 852   my ($value) = @_;
 853   return defined $value && $value ? 1 : 0;
 854 }
 855
 856 # getmode()
 857 # Identify the execution mode, and return it.
 858 # Possible modes are 'cat', 'extract', 'list', 'add' or 'extract-to'.
 859 sub getmode() {
 860   my $mode;
 861   if (de($::opt_cmd_list)
 862       + de($::opt_cmd_cat)
 863       + de($::opt_cmd_extract)
 864       + de($::opt_cmd_add)
 865       + de($::opt_cmd_extract_to)
 866       + de($::opt_cmd_diff)
 867       + de($::opt_cmd_repack) > 1) {
 868     die "$::basename: only one command may be specified\n"; #OK
 869   }
 870   $mode = 'cat'           if ($::basename eq 'acat');
 871   $mode = 'extract'       if ($::basename eq 'aunpack');
 872   $mode = 'list'          if ($::basename eq 'als');
 873   $mode = 'add'           if ($::basename eq 'apack');
 874   $mode = 'diff'          if ($::basename eq 'adiff');
 875   $mode = 'repack'        if ($::basename eq 'arepack');
 876   $mode = 'add'           if ($::opt_cmd_add);
 877   $mode = 'cat'           if ($::opt_cmd_cat);
 878   $mode = 'list'          if ($::opt_cmd_list);
 879   $mode = 'extract'       if ($::opt_cmd_extract);
 880   $mode = 'extract-to'    if ($::opt_cmd_extract_to);
 881   $mode = 'diff'          if ($::opt_cmd_diff);
 882   $mode = 'repack'        if ($::opt_cmd_repack);
 883   if (!defined $mode) {
 884     die "$::basename: no command specified\nTry `$::basename --help' for more information.\n"; #OK
 885   }
 886   return $mode;
 887 }
 888
 889 # singlearchivecmd(archive, command, format, mode, args)
 890 # Execute a command for single-file archives.
 891 # The command parameter specifies what command to execute.
 892 # If mode is 'extract-to', returns the directory (or only file)
 893 # which was extracted.
 894 sub singlearchivecmd($$$$$@) {
 895   my ($archive, $cmd, $format, $mode, $can_do_c, @args) = @_;
 896   my $outfile;
 897   my $reason;
 898   my @cmd;
 899   push @cmd, $cmd;
 900   push @cmd, '-v' if $::opt_verbosity > 1;
 901
 902   if ($mode eq 'list') {
 903     warn "$::basename: ".quote($archive).": $mode command not supported for $format archives\n";
 904     return undef;
 905   }
 906   elsif ($mode eq 'cat') {
 907     if (!$can_do_c) {
 908       warn "$::basename: ".quote($archive).": $mode command not supported for $format archives\n";
 909       return undef;
 910     }
 911     push @cmd, '-c', '-d', $archive, @args;
 912     $outfile = $archive; # Just so that we don't return undef
 913   }
 914   elsif ($mode eq 'add') {
 915     if (@args > 1) {
 916       warn "$::basename: cannot add more than one file with this format\n";
 917       return undef;
 918     }
 919     if (!$::opt_force && (-e $archive || -l $archive)) {
 920       warn "$::basename: ".quote($archive).": refusing to overwrite existing file\n";
 921       return undef;
 922     }
 923     #if (!$::cfg_keep_compressed && stripext($archive) ne $args[0]) {
 924     # warn "$::basename: ".quote($archive).": cannot create a $format archive with this name (use -X)\n";
 925     # return;
 926     #}
 927     if ($can_do_c) {
 928       push @cmd, '-c', @args, ['>'], $archive;
 929     } else {
 930       push @cmd, '-o', $archive, @args;
 931     }
 932     $outfile = $archive; # Just so that we don't return undef
 933   }
 934   elsif ($mode eq 'extract') {
 935     $outfile = stripext($archive);
 936     if ($::cfg_decompress_to_cwd) {
 937       $outfile = basename($outfile);
 938     }
 939     if (-e $outfile) {
 940       $outfile = makeoutfile($::cfg_tmpdir_name);
 941       $reason = 'local file exists';
 942     }
 943     if ($can_do_c) {
 944       push @cmd, '-c', '-d', $archive, @args, ['>'], $outfile;
 945     } else {
 946       push @cmd, '-o', $outfile, '-d', $archive, @args;
 947     }
 948   }
 949   elsif ($mode eq 'extract-to') {
 950     $outfile = $::opt_cmd_extract_to;
 951     if ($::opt_simulate ? $::opt_cmd_extract_to_type eq 'd' : -d $outfile) {
 952       my $base = File::Basename::basename($archive);
 953       $outfile = File::Spec->catfile($outfile, stripext($base));
 954     }
 955     if ($can_do_c) {
 956       push @cmd, '-c', '-d', $archive, @args, ['>'], $outfile;
 957     } else {
 958       push @cmd, '-o', $outfile, '-d', $archive, @args;
 959     }
 960   }
 961
 962   push @cmd, ['|'], get_pager_program() if $::opt_use_pager;
 963   cmdexec(0, @cmd) || return undef;
 964
 965   if ($mode eq 'extract' || $mode eq 'extract-to') {
 966     if ($::cfg_show_extracted && !$::opt_simulate) {
 967       my $archivebase = File::Basename::basename($archive);
 968       my $rmsg = defined $reason ? " ($reason)" : '';
 969       warn quote($archivebase).": extracted to `".quote($outfile)."'$rmsg\n";
 970     }
 971   }
 972
 973   if (!$::cfg_keep_compressed) {
 974     if ($mode eq 'extract') {
 975       warn 'unlink ', quote($archive), "\n" if ($::opt_explain || $::opt_simulate);
 976       if (!$::opt_simulate) {
 977         unlink($archive) || warn "$::basename: ".quote($archive).": cannot remove - $!\n";
 978       }
 979     }
 980     elsif ($mode eq 'add') {
 981       warn 'unlink ', quote($args[0]), "\n" if ($::opt_explain || $::opt_simulate);
 982       if (!$::opt_simulate) {
 983         unlink($args[0]) || warn "$::basename: ".quote($args[0]).": cannot remove - $!\n";
 984       }
 985     }
 986   }
 987
 988   return $outfile;
 989 }
 990
 991 # maketarcmd(opts):
 992 # Create (partial) command line arguments for a tar command.
 993 # The parameter opts specifies additional arguments to add.
 994 sub maketarcmd($$$$@) {
 995   my ($archive, $outdir, $mode, $opts, @rest) = @_;
 996   $opts = 'v'.$opts if $::opt_verbosity >= 1;
 997   my @cmd = ($::cfg_path_tar);
 998   push @cmd, "xO$opts" if $mode eq 'cat';
 999   push @cmd, "x$opts" if ($mode eq 'extract' || $mode eq 'extract-to');
1000   push @cmd, "t$opts" if $mode eq 'list';
1001   push @cmd, "c$opts" if $mode eq 'add';
1002   push @cmd, $archive if defined $archive;
1003   push @cmd, '-C', $outdir if $mode eq 'extract';
1004   push @cmd, '-C', $::opt_cmd_extract_to if $mode eq 'extract-to';
1005   push @cmd, @rest;
1006   return @cmd;
1007 }
1008
1009 # cmdexec(ignore_return, cmdspec)
1010 # Execute a command specification.
1011 # The cmdspec parameter is a list of string arguments building
1012 # the command line. If there's a list reference instead of a
1013 # string, it is a shell meta character/string which shouldn't
1014 # be quoted.
1015 sub cmdexec($@) {
1016   my ($ignret, @cmd) = @_;
1017
1018   if ($::opt_explain || $::opt_simulate) {
1019     my $spec = join(' ', map { ref $_ ? @{$_} : shquotemeta $_ } @cmd);
1020     explain quote($spec)."\n";
1021     return 1 if ($::opt_simulate);
1022   }
1023
1024   my $cmds = makespec(@cmd);
1025   if (!shell_execute(@cmd)) {
1026     warn "$::basename: ".quote($cmds).": cannot execute - $::errmsg\n";
1027     return 0;
1028   }
1029
1030   if ($? & 0xFF != 0) {
1031     warn "$::basename: ".quote($cmds).": abnormal exit (exit code $?)\n";
1032     return 0;
1033   }
1034
1035   if (!$ignret && $? >> 8 != 0) {
1036     warn "$::basename: ".quote($cmds).": non-zero return-code\n";
1037     return 0;
1038   }
1039
1040   return 1;
1041 }
1042
1043 # makespec(@)
1044 # Make a command specification when printing errors.
1045 sub makespec(@) {
1046   my (@cmd) = @_;
1047   my $spec = $cmd[0].' ...';
1048   my $lastref = 0;
1049   foreach (@cmd, '') {
1050     if ($lastref) {
1051       $spec .= " | $_ ...";
1052       $lastref = 0;
1053     }
1054     $lastref = 1 if (ref);
1055   }
1056   return $spec;
1057 }
1058
1059 # makeoutfile(template)
1060 # Make a unique output file for extraction command.
1061 sub makeoutfile($) {
1062   my ($template) = @_;
1063   my $file;
1064   do {
1065     $file = sprintf $template, int rand 10000;
1066   } while (-e $file);
1067   return $file;
1068 }
1069
1070 # makeoutdir()
1071 # Make a temporary (unique) output directory for extraction command.
1072 sub makeoutdir() {
1073   my $dir;
1074   do {
1075     $dir = sprintf $::cfg_tmpdir_name, int rand 10000;
1076   } while (-e $dir);
1077
1078   warn 'mkdir ', $dir, "\n" if $::opt_simulate || $::opt_explain;
1079   if (!$::opt_simulate) {
1080     if (!mkdir($dir, 0700)) {
1081       warn "$::basename: ".quote($dir).": cannot create directory - $!\n";
1082       return undef;
1083     }
1084     push @::rmdirs, $dir;
1085   }
1086   return $dir;
1087 }
1088
1089 # explain($)
1090 # Print on screen if $::opt_explain is true.
1091 sub explain($) {
1092   my ($msg) = @_;
1093   print STDERR $msg if ($::opt_explain || $::opt_simulate);
1094 }
1095
1096 # tailslash($)
1097 # If specified filename does not end with a slash,
1098 # add one and return the new filename.
1099 sub tailslash($) {
1100   my ($file) = @_;
1101   return ($file =~ /\/$/ ? $file : "$file/");
1102 }
1103
1104 # shquotemeta($)
1105 # A more sophisticated quotemeta for bourne shells.
1106 # (This should be used for printing only.)
1107 sub shquotemeta($) {
1108   my ($str) = @_;
1109   $str =~ s/([^A-Za-z0-9_.+,\/:=@%^-])/\\$1/g;
1110   return $str;
1111 }
1112
1113 # multiarchivecmd(archive, outdir, mode, create, needcwd, argref, cmdspec)
1114 # Execute a command for multi-file archives.
1115 # The `create' argument controls whether the archive
1116 # will be created (1) or just added to (0) if mode is "add".
1117 # If mode is 'extract', returns the directory (or only file)
1118 # which was extracted.
1119 # If needcwd is true, the outdir must be changed to.
1120 sub multiarchivecmd($$$$@) {
1121   my ($archive, $outdir, $mode, $create, $needcwd, $argref, @cmd) = @_;
1122   my @args = @{$argref};
1123
1124   if ($mode eq 'cat' && @args == 0) {
1125     die "$::basename: missing file argument\n"; #OK
1126   }
1127
1128   if ($mode eq 'add' && $create && !$::opt_force && (-e $archive || -l $archive)) {
1129     warn "$::basename: ".quote($archive).": refusing to overwrite existing file\n";
1130     return undef;
1131   }
1132
1133   push @cmd, ['|'], get_pager_program() if $::opt_use_pager;
1134
1135   my $olddir = undef;
1136   if ($needcwd) {
1137     $olddir = getcwd();
1138     if ($mode eq 'extract') {
1139       warn "cd ", quote($outdir), "\n" if $::opt_explain || $::opt_simulate;
1140       if (!$::opt_simulate && !chdir($outdir)) {
1141         warn "$::basename: ".quote($outdir).": cannot change to - $!\n";
1142         return undef;
1143       }
1144     }
1145     if ($mode eq 'extract-to') {
1146       warn "cd ", quote($::opt_cmd_extract_to), "\n" if $::opt_explain || $::opt_simulate;
1147       if (!$::opt_simulate && !chdir($::opt_cmd_extract_to)) {
1148         warn "$::basename: ".quote($::opt_cmd_extract_to).": cannot change to - $!\n";
1149         return undef;
1150       }
1151     }
1152   }
1153
1154   if ($mode ne 'extract') {
1155     cmdexec(0, @cmd) || return undef;
1156     if (defined $olddir) {
1157       warn "cd ", quote($olddir), "\n" if $::opt_explain || $::opt_simulate;
1158       if (!$::opt_simulate && !chdir($olddir)) {
1159         warn "$::basename: ".quote($olddir).": cannot change to - $!\n";
1160         return undef;
1161       }
1162     }
1163     # XXX: can't save outdir with extract-to.
1164     return 1;
1165   }
1166
1167   if (!cmdexec(0, @cmd)) {
1168     if (defined $olddir) {
1169       warn "cd ", quote($olddir), "\n" if $::opt_explain || $::opt_simulate;
1170       if (!$::opt_simulate && !chdir($olddir)) {
1171         warn "$::basename: ".quote($olddir).": cannot change to - $!\n";
1172       }
1173     }
1174     return undef;
1175   }
1176
1177   if (defined $olddir) {
1178     warn "cd ", quote($olddir), "\n" if $::opt_explain || $::opt_simulate;
1179     if (!$::opt_simulate && !chdir($olddir)) {
1180       warn "$::basename: ".quote($olddir).": cannot change to - $!\n";
1181       return undef;
1182     }
1183   }
1184
1185   return undef if $::opt_simulate;
1186
1187   if (!opendir(DIR, $outdir)) {
1188     warn "$::basename: ".quote($outdir).": cannot list - $!\n";
1189     return undef;
1190   }
1191   my @files = grep !/^\.\.?$/, readdir DIR;
1192   closedir DIR;
1193
1194   my $archivebase = File::Basename::basename($archive);
1195   my $reason;
1196   my $adddir = 0;
1197   if (@files == 0) {
1198     warn quote($archivebase).": archive is empty\n";
1199     rmdir $outdir;
1200     return undef;
1201   } elsif ($::opt_extract_subdir) {
1202     $reason = 'forced';
1203   } elsif (@files == 1) {
1204     my $fromfile = File::Spec->catfile($outdir, $files[0]);
1205     if ($::opt_force || (!-l $files[0] && !-e $files[0])) {
1206
1207       # If the file is a directory, it can only be moved if writable
1208       my $oldmode = undef;
1209       if (!-l $fromfile && -d $fromfile) {
1210         my @statinfo = stat($fromfile);
1211         if (!@statinfo) {
1212           warn quote($fromfile).": cannot get file info - $!\n";
1213           return undef;
1214         }
1215         $oldmode = $statinfo[2];
1216         if (!chmod(0700, $fromfile)) {
1217           warn quote($fromfile).": cannot change mode - $!\n";
1218           return undef;
1219         }
1220       }
1221
1222       if (!rename $fromfile, $files[0]) {
1223         warn quote($fromfile).": cannot rename - $!\n";
1224         return undef;
1225       }
1226       rmdir $outdir;
1227
1228       # If we changed mode previously, restore that mode now
1229       if (defined $oldmode) {
1230         if (!chmod($oldmode, $files[0])) {
1231           warn quote($files[0]).": cannot change mode - $!\n";
1232           return undef;
1233         }
1234       }
1235
1236       if ($::cfg_show_extracted) {
1237         my $file = ($files[0] =~ /\// ? dirname($files[0]) : $files[0]);
1238         warn quote($archivebase).": extracted to `".quote($file)."'\n" ;
1239       }
1240
1241       save_outdir($files[0]);
1242       return $files[0];
1243     }
1244     $reason = 'local file exists';
1245     $adddir = 1 if (!-l $files[0] && -d $files[0]);
1246   } else {
1247     $reason = 'multiple files in root';
1248   }
1249
1250   my $localoutdir = stripext($archivebase);
1251   if (!-e $localoutdir) {
1252     if (!rename $outdir, $localoutdir) {
1253       warn quote($outdir).": cannot rename - $!\n";
1254       return undef;
1255     }
1256     $outdir = $localoutdir;
1257   }
1258
1259   warn quote($archivebase).": extracted to `".quote($outdir)."' ($reason)\n";
1260   save_outdir($adddir ? File::Spec->catfile($outdir, $files[0]) : $outdir);
1261   return $outdir;
1262 }
1263
1264 # stripext(file)
1265 # Strip extension from the specified file.
1266 sub stripext($) {
1267   my ($file) = @_;
1268   return $file if ($file =~ s/(\.tar\.bz2|\.tbz2)$//);
1269   return $file if ($file =~ s/(\.tar\.bz|\.tbz)$//);
1270   return $file if ($file =~ s/(\.tar\.gz|\.tgz)$//);
1271   return $file if ($file =~ s/(\.tar\.Z|\.tZ)$//);
1272   return $file if ($file =~ s/(\.tar\.7z|\.t7z)$//);
1273   return $file if ($file =~ s/(\.tar\.lzma|\.tlzma)$//);
1274   return $file if ($file =~ s/(\.tar\.lzo|\.lzo)$//);
1275   return $file if ($file =~ s/(\.tar\.lz|\.lz)$//);
1276   return $file if ($file =~ s/\.tar$//);
1277   return $file if ($file =~ s/\.bz2$//);
1278   return $file if ($file =~ s/\.bz$//);
1279   return $file if ($file =~ s/\.lz$//);
1280   return $file if ($file =~ s/\.gz$//);
1281   return $file if ($file =~ s/\.zip$//);
1282   return $file if ($file =~ s/\.7z$//);
1283   return $file if ($file =~ s/\.alz$//);
1284   return $file if ($file =~ s/\.jar$//);
1285   return $file if ($file =~ s/\.war$//);
1286   return $file if ($file =~ s/\.Z$//);
1287   return $file if ($file =~ s/\.rar$//);
1288   return $file if ($file =~ s/\.(lha|lzh)$//);
1289   return $file if ($file =~ s/\.ace$//);
1290   return $file if ($file =~ s/\.arj$//);
1291   return $file if ($file =~ s/\.a$//);
1292   return $file if ($file =~ s/\.lzma$//);
1293   return $file if ($file =~ s/\.rpm$//);
1294   return $file if ($file =~ s/\.deb$//);
1295   return $file if ($file =~ s/\.cpio$//);
1296   return $file if ($file =~ s/\.cab$//);
1297   return $file if ($::cfg_strip_unknown_ext && $file =~ s/\.[^.]+$//);
1298   return $file;
1299 }
1300
1301 # formatext(format)
1302 # Return the usual extension for the specified file format
1303 sub formatext($) {
1304   my ($format) = @_;
1305   return '.tar.bz2'  if $format eq 'tar+bzip2';
1306   return '.tar.gz'   if $format eq 'tar+gzip';
1307   return '.tar.bz'   if $format eq 'tar+bzip';
1308   return '.tar.7z'   if $format eq 'tar+7z';
1309   return '.tar.lzo'  if $format eq 'tar+lzop';
1310   return '.tar.lzma' if $format eq 'tar+lzma';
1311   return '.tar.lz'   if $format eq 'tar+lzip';
1312   return '.tar.xz'   if $format eq 'tar+xz';
1313   return '.tar.Z'    if $format eq 'tar+compress';
1314   return '.tar'      if $format eq 'tar';
1315   return '.bz2'      if $format eq 'bzip2';
1316   return '.lzma'     if $format eq 'lzma';
1317   return '.7z'       if $format eq '7z';
1318   return '.alz'      if $format eq 'alzip';
1319   return '.bz'       if $format eq 'bzip';
1320   return '.gz'       if $format eq 'gzip';
1321   return '.lzo'      if $format eq 'lzop';
1322   return '.lz'       if $format eq 'lzip';
1323   return '.xz'       if $format eq 'xzip';
1324   return '.rz'       if $format eq 'rzip';
1325   return '.lrz'      if $format eq 'lrzip';
1326   return '.zip'      if $format eq 'zip';
1327   return '.jar'      if $format eq 'jar';
1328   return '.Z'        if $format eq 'compress';
1329   return '.rar'      if $format eq 'rar';
1330   return '.ace'      if $format eq 'ace';
1331   return '.a'        if $format eq 'ar';
1332   return '.arj'      if $format eq 'arj';
1333   return '.lha'      if $format eq 'lha';
1334   return '.rpm'      if $format eq 'rpm';
1335   return '.deb'      if $format eq 'deb';
1336   return '.cpio'     if $format eq 'cpio';
1337   return '.cab'      if $format eq 'cab';
1338   die "$::basename: ".quote($format).": don't know file extension for format\n";
1339 }
1340
1341 # issingleformat(fmt)
1342 # fmt is a file specification as returned by findformat.
1343 # This function returns true if fmt is a single file archive (gzip etc)
1344 # for certain. This means that 7zip is not a single file archive format,
1345 # although it can be used in this way.
1346 sub issingleformat($) {
1347   my ($fmt) = @_;
1348   return 1 if $fmt eq 'bzip2';
1349   return 1 if $fmt eq 'gzip';
1350   return 1 if $fmt eq 'bzip';
1351   return 1 if $fmt eq 'compress';
1352   return 1 if $fmt eq 'lzma';
1353   return 1 if $fmt eq 'lzop';
1354   return 1 if $fmt eq 'lzip';
1355   return 1 if $fmt eq 'xz';
1356   return 1 if $fmt eq 'rzip';
1357   return 1 if $fmt eq 'lrzip';
1358   return 0;
1359 }
1360
1361 # findformat(spec, manual)
1362 # Figure out format from specified file/string.
1363 # If manual is 0, spec is a filename, otherwise
1364 # it is a format description string.
1365 sub findformat($$) {
1366   my ($file, $manual) = @_;
1367   my $spec = lc $file;
1368   my @fileoutput = (
1369     ['tar+bzip2',      qr/^(GNU|POSIX) tar archive \(bzip2 compressed data(\W|$)/],
1370     ['tar+gzip',       qr/^(GNU|POSIX) tar archive \(gzip compressed data(\W|$)/],
1371     ['tar+bzip',       qr/^(GNU|POSIX) tar archive \(bzip compressed data(\W|$)/],
1372     ['tar+compress',   qr/^(GNU|POSIX) tar archive \(compress'd data(\W|$)/],
1373     ['tar',            qr/^(GNU|POSIX) tar archive(\W|$)/],
1374     ['zip',            qr/ \(Zip archive data[^)]+\)$/],
1375     ['zip',            qr/^Zip archive data(\W|$)/],
1376     ['zip',            qr/^MS-DOS executable (.*), ZIP self-extracting archive(\W|$)/],
1377     ['rar',            qr/^RAR archive data(\W|$)/],
1378     ['lha',            qr/^LHa \(2\.x\) archive data /],
1379     ['lha',            qr/^LHa 2\.x\? archive data /],
1380     ['lha',            qr/^LHarc 1\.x archive data /],
1381     ['lha',            qr/^MS-DOS executable .*, LHA's SFX$/],
1382     ['7z',             qr/^7z archive data, version .*$/],
1383     ['ar',             qr/^current ar archive(\W|$)/],
1384     ['arj',            qr/^ARJ archive data(\W|$)/],
1385     ['arc',            qr/^ARC archive data(\W|$)/],
1386     ['cpio',           qr/^cpio archive$/],
1387     ['cpio',           qr/^ASCII cpio archive /],
1388     ['rpm',            qr/^RPM v/],
1389     ['cab',            qr/^Microsoft Cabinet archive data\W/],
1390     ['cab',            qr/^PE executable for MS Windows /],
1391     ['deb',            qr/^Debian binary package(\W|$)/],
1392     ['bzip2',          qr/ \(bzip2 compressed data(\W|$)/],
1393     ['bzip',           qr/ \(bzip compressed data(\W|$)/],
1394     ['gzip',           qr/ \(gzip compressed data(\W|$)/],
1395     ['compress',       qr/ \(compress'd data(\W|$)/],
1396     ['lzma',           qr/^lzma compressed data /], # Not in my magic
1397     ['lzop',           qr/^lzop compressed data /],
1398     ['lzip',           qr/^lzip compressed data /], # Not in my magic
1399     ['xz',             qr/^xz compressed data /], # Not in my magic
1400     ['rzip',           qr/^rzip compressed data /],
1401     ['lrzip',          qr/^lrzip compressed data /], # Not in my magic
1402     ['bzip2',          qr/^bzip2 compressed data(\W|$)/],
1403     ['bzip',           qr/^bzip compressed data(\W|$)/],
1404     ['gzip',           qr/^gzip compressed data(\W|$)/],
1405     ['compress',       qr/^compress'd data(\W|$)/],
1406   );
1407   my @fileextensions = (
1408     ['tar+7z',         qr/(\.tar\.7z|\.t7z)$/],
1409     ['tar+bzip',       qr/(\.tar\.bz|\.tbz)$/],
1410     ['tar+bzip2',      qr/(\.tar\.bz2|\.tbz2)$/],
1411     ['tar+compress',   qr/(\.tar\.[zZ]|\.t[zZ])$/],
1412     ['tar+gzip',       qr/(\.tar\.gz|\.tgz)$/],
1413     ['tar+lzip',       qr/(\.tar\.lz|\.tlz)$/],
1414     ['tar+lzma',       qr/(\.tar\.lzma|\.tlzma)$/],
1415     ['tar+lzop',       qr/(\.tar\.lzo|\.tzo)$/],
1416     ['tar+xz',         qr/(\.tar\.xz|\.txz)$/],
1417
1418     ['7z',             qr/\.7z$/],
1419     ['ace',            qr/\.ace$/],
1420     ['alzip',          qr/\.alz$/],
1421     ['ar',             qr/\.a$/],
1422     ['arc',            qr/\.arc$/],
1423     ['arj',            qr/\.arj$/],
1424     ['bzip',           qr/\.bz$/],
1425     ['bzip2',          qr/\.bz2$/],
1426     ['cab',            qr/\.cab$/],
1427     ['compress',       qr/\.[zZ]$/],
1428     ['cpio',           qr/\.cpio$/],
1429     ['deb',            qr/\.deb$/],
1430     ['gzip',           qr/\.gz$/],
1431     ['jar',            qr/\.(jar|war)$/],
1432     ['lha',            qr/\.(lha|lzh)$/],
1433     ['lrzip',          qr/\.lrz$/],
1434     ['lzip',           qr/\.lz$/],
1435     ['lzma',           qr/\.lzma$/],
1436     ['lzop',           qr/\.lzo$/],
1437     ['rar',            qr/\.rar$/],
1438     ['rpm',            qr/\.rpm$/],
1439     ['rzip',           qr/\.rz$/],
1440     ['tar',            qr/\.tar$/],
1441     ['xz',             qr/\.xz$/],
1442     ['zip',            qr/\.zip$/],
1443   );
1444
1445   if ($manual) {
1446     $spec =~ tr/+/./;
1447     $spec =~ s/^\.*/\./;
1448     $spec =~ s/lzop/lzo/;
1449     $spec =~ s/lzip/lz/;
1450     $spec =~ s/rzip/rz/;
1451     $spec =~ s/lrzip/lrz/;
1452     $spec =~ s/bzip2/bz2/;
1453     $spec =~ s/bzip/bz/;
1454     $spec =~ s/gzip/gz/;
1455     $spec =~ s/7zip/7z/;
1456     $spec =~ s/alzip/alz/;
1457     $spec =~ s/compress/Z/;
1458     $spec =~ s/^ar$/a/;
1459   }
1460   if (!$::cfg_use_file_always) {
1461     foreach my $formatinfo (@fileextensions) {
1462       my ($format, $regex) = @{$formatinfo};
1463       return $format if ($spec =~ $regex);
1464     }
1465   }
1466   if (!$manual && $::cfg_use_file) {
1467     if (!-e $file) {
1468       warn "$::basename: ".quote($file).": no such file and cannot identify format from extension\n";
1469       return;
1470     }
1471     if (!sysopen(TMP, $file, O_RDONLY)) {
1472       warn "$::basename: ".quote($file).": cannot open - $!\n";
1473       return;
1474     }
1475     close TMP;
1476     if (!-f $file) {
1477       warn "$::basename: ".quote($file).": not a regular file\n";
1478       return;
1479     }
1480     if ($::opt_verbosity >= 1) {
1481             if ($::cfg_use_file_always) {
1482         warn "$::basename: ".quote($file).": identifying format using file\n";
1483             } else {
1484         warn "$::basename: ".quote($file).": format not known, identifying using file\n";
1485                         }
1486     }
1487     my @cmd = ($::cfg_path_file, '-b', '-L', '-z', '--', $file);
1488     $spec = backticks(@cmd);
1489     if (!defined $spec) {
1490       warn "$::basename: $::errmsg\n";
1491       return;
1492     }
1493     if ($? & 0xFF != 0) {
1494       warn "$::basename: ".quote($::cfg_path_file).": abnormal exit\n";
1495       return;
1496     }
1497     if ($? >> 8 != 0) {
1498       warn "$::basename: ".quote($file).": unknown file format\n";
1499       return;
1500     }
1501     chomp $spec;
1502     foreach my $formatinfo (@fileoutput) {
1503       my ($format, $regex) = @{$formatinfo};
1504       if ($spec =~ $regex) {
1505         warn "$::basename: ".quote($file).": format is `$format'\n" if $::opt_verbosity >= 1;
1506         return $format;
1507       }
1508     }
1509     warn "$::basename: ".quote($file).": unsupported file format `$spec'\n";
1510     return;
1511   }
1512   warn "$::basename: ".quote($file).": unrecognized file format\n";
1513   return;
1514 }
1515
1516 # backticks(cmdargs, ..)
1517 # An implementation of the backtick (qx//) operator.
1518 # The difference is that command STDERR output will still
1519 # be printed on STDERR, and the shell isn't used to parse
1520 # the command line.
1521 sub backticks(@) {
1522   if (!pipe(IN,OUT)) {
1523     $::errmsg = "pipe failed - $!";
1524     return;
1525   }
1526   my $child = fork;
1527   if (!defined $child) {
1528     $::errmsg = "fork failed - $!";
1529     return;
1530   }
1531   if ($child == 0) {
1532     close IN || exit 1;
1533     close STDOUT || exit 1;
1534     open(STDOUT, '>&OUT') || exit 1;
1535     close OUT || exit 1;
1536     $SIG{__WARN__} = sub {};
1537     exec(@_) || exit 1;
1538   }
1539   close OUT;
1540   my $text = join('', <IN>);
1541   close IN;
1542   if (waitpid($child,0) != $child && $^O ne 'MSWin32') {
1543     $::errmsg = "waitpid failed - $!";
1544     return;
1545   }
1546   return $text;
1547 }
1548
1549 # set_config_option(variable, value)
1550 # Set a configuration option.
1551 sub set_config_option($$$) {
1552   my ($var, $val, $context) = @_;
1553   my %optionmap = (
1554     'args_diff'               => [ 'option', \$::cfg_args_diff, qr/.*/ ],
1555     'decompress_to_cwd'       => [ 'option', \$::cfg_decompress_to_cwd, qr/^(0|1)$/ ],
1556     'default_verbosity'       => [ 'option', \$::cfg_default_verbosity, qr/^\d+$/ ],
1557     'extract_deb_control'     => [ 'option', \$::cfg_extract_deb_control, qr/^(0|1)$/ ],
1558     'keep_compressed'         => [ 'option', \$::cfg_keep_compressed, qr/^(0|1)$/ ],
1559     'path_7z'                 => [ 'option', \$::cfg_path_7z, qr/.*/ ],
1560     'path_ar'                 => [ 'option', \$::cfg_path_ar, qr/.*/ ],
1561     'path_arc'                => [ 'option', \$::cfg_path_arc, qr/.*/ ],
1562     'path_arj'                => [ 'option', \$::cfg_path_arj, qr/.*/ ],
1563     'path_bzip'               => [ 'option', \$::cfg_path_bzip, qr/.*/ ],
1564     'path_bzip2'              => [ 'option', \$::cfg_path_bzip2, qr/.*/ ],
1565     'path_cabextract'         => [ 'option', \$::cfg_path_cabextract, qr/.*/ ],
1566     'path_cat'                => [ 'option', \$::cfg_path_cat, qr/.*/ ],
1567     'path_compress'           => [ 'option', \$::cfg_path_compress, qr/.*/ ],
1568     'path_cpio'               => [ 'option', \$::cfg_path_cpio, qr/.*/ ],
1569     'path_diff'               => [ 'option', \$::cfg_path_diff, qr/.*/ ],
1570     'path_dpkg_deb'           => [ 'option', \$::cfg_path_dpkg_deb, qr/.*/ ],
1571     'path_file'               => [ 'option', \$::cfg_path_file, qr/.*/ ],
1572     'path_find'               => [ 'option', \$::cfg_path_find, qr/.*/ ],
1573     'path_gzip'               => [ 'option', \$::cfg_path_gzip, qr/.*/ ],
1574     'path_jar'                => [ 'option', \$::cfg_path_jar, qr/.*/ ],
1575     'path_lha'                => [ 'option', \$::cfg_path_lha, qr/.*/ ],
1576     'path_lrzip'              => [ 'option', \$::cfg_path_lrzip, qr/.*/ ],
1577     'path_lzip'               => [ 'option', \$::cfg_path_lzip, qr/.*/ ],
1578     'path_lzma'               => [ 'option', \$::cfg_path_lzma, qr/.*/ ],
1579     'path_lzop'               => [ 'option', \$::cfg_path_lzop, qr/.*/ ],
1580     'path_nomarch'            => [ 'option', \$::cfg_path_nomarch, qr/.*/ ],
1581     'path_pager'              => [ 'option', \$::cfg_path_pager, qr/.*/ ],
1582     'path_pbzip2'             => [ 'option', \$::cfg_path_pbzip2, qr/.*/ ],
1583     'path_rar'                => [ 'option', \$::cfg_path_rar, qr/.*/ ],
1584     'path_rpm'                => [ 'option', \$::cfg_path_rpm, qr/.*/ ],
1585     'path_rpm2cpio'           => [ 'option', \$::cfg_path_rpm2cpio, qr/.*/ ],
1586     'path_rzip'               => [ 'option', \$::cfg_path_rzip, qr/.*/ ],
1587     'path_tar'                => [ 'option', \$::cfg_path_tar, qr/.*/ ],
1588     'path_unace'              => [ 'option', \$::cfg_path_unace, qr/.*/ ],
1589     'path_unalz'              => [ 'option', \$::cfg_path_unalz, qr/.*/ ],
1590     'path_unarj'              => [ 'option', \$::cfg_path_unarj, qr/.*/ ],
1591     'path_unrar'              => [ 'option', \$::cfg_path_unrar, qr/.*/ ],
1592     'path_unzip'              => [ 'option', \$::cfg_path_unzip, qr/.*/ ],
1593     'path_usercfg'            => [ 'option', \$::cfg_path_usercfg, qr/.*/ ],
1594     'path_xargs'              => [ 'option', \$::cfg_path_xargs, qr/.*/ ],
1595     'path_xz'                 => [ 'option', \$::cfg_path_xz, qr/.*/ ],
1596     'path_zip'                => [ 'option', \$::cfg_path_zip, qr/.*/ ],
1597     'show_extracted'          => [ 'option', \$::cfg_show_extracted, qr/^(0|1)$/ ],
1598     'strip_unknown_ext'       => [ 'option', \$::cfg_strip_unknown_ext, qr/^(0|1)$/ ],
1599     'tmpdir_name'             => [ 'option', \$::cfg_tmpdir_name, qr/.*/ ],
1600     'tmpfile_name'            => [ 'option', \$::cfg_tmpfile_name, qr/.*/ ],
1601     'use_arc_for_unpack'      => [ 'option', \$::cfg_use_arc_for_unpack, qr/^(0|1)$/ ],
1602     'use_arj_for_unpack'      => [ 'option', \$::cfg_use_arj_for_unpack, qr/^(0|1)$/ ],
1603     'use_file'                => [ 'option', \$::cfg_use_file, qr/^(0|1)$/ ],
1604     'use_file_always'         => [ 'option', \$::cfg_use_file_always, qr/^(0|1)$/ ],
1605     'use_find_cpio_print0'    => [ 'option', \$::cfg_use_find_cpio_print0, qr/^(0|1)$/ ],
1606     'use_gzip_for_z'          => [ 'option', \$::cfg_use_gzip_for_z, qr/^(0|1)$/ ],
1607     'use_jar'                 => [ 'option', \$::cfg_use_jar, qr/^(0|1)$/ ],
1608     'use_pbzip2'              => [ 'option', \$::cfg_use_pbzip2, qr/^(0|1)$/ ],
1609     'use_rar_for_unpack'      => [ 'option', \$::cfg_use_rar_for_unpack, qr/^(0|1)$/ ],
1610     'use_rar_for_unrar'       => [ 'obsolete', 'use_rar_for_unpack' ],
1611     'use_tar_bzip2_option'    => [ 'option', \$::cfg_use_tar_bzip2_option, qr/^(0|1)$/ ],
1612     'use_tar_lzma_option'     => [ 'option', \$::cfg_use_tar_lzma_option, qr/^(0|1)$/ ],
1613     'use_tar_lzop_option'     => [ 'option', \$::cfg_use_tar_lzop_option, qr/^(0|1)$/ ],
1614     'use_tar_xv_option'       => [ 'option', \$::cfg_use_tar_xv_option, qr/^(0|1)$/ ],
1615     'use_tar_j_option'        => [ 'obsolete', 'use_tar_bzip2_option' ],
1616     'use_tar_z_option'        => [ 'option', \$::cfg_use_tar_z_option, qr/^(0|1)$/ ],
1617   );
1618   die $::basename,': ',$context,'unrecognized directive `',$var,"'\n" if !exists $optionmap{$var};
1619   return 0 if !exists $optionmap{$var};
1620   my ($type) = @{$optionmap{$var}};
1621   if ($type eq 'obsolete') {
1622     warn $context.$var.' is obsolete - use '.$optionmap{$var}->[1].')'."\n";
1623     $var = $optionmap{$var}->[1];
1624   }
1625   my ($varref,$check) = @{$optionmap{$var}}[1,2];
1626   die $::basename,': ',$context,'invalid value for `',$var,"'\n" if $val !~ $check;
1627   ${$varref} = $val;
1628   return 1;
1629 }
1630
1631 # readconfig(file)
1632 # Read and parse the specified configuration file.
1633 # If the file does not exist, just return.
1634 # If there is an error in the configuration file,
1635 # the program will be terminated. This could be a
1636 # problem when there are errors in the system-wide
1637 # configuration file.
1638 sub readconfig($$) {
1639   my ($file, $failok) = @_;
1640   return if ($failok && !-e $file);
1641   sysopen(FILE, $file, O_RDONLY) || die "$::basename: ".quote($file).": cannot open for reading - $!\n";  #OK
1642   while (<FILE>) {
1643     chomp;
1644     next if /^\s*(#(.*))?$/;
1645     my ($var,$val) = /^(.*?)\s+([^\s].*)$/; # joe markup bug -> ]]
1646     set_config_option($var, $val, quote($file).':'.$..': ');
1647   }
1648   close(FILE);
1649 }
1650
1651 # Remove a directory recursively. This function used to change
1652 # the mode on the directories is traverses, but I now consider
1653 # that to be unsafe (what if there's a bug in atool and it
1654 # removes a file it shouldn't?).
1655 sub unlink_directory($) {
1656   my ($dir) = @_;
1657   die "$::basename: internal error 1 - please report this bug\n"
1658     if ($dir eq '/' || $dir eq $ENV{HOME});
1659 # chmod 0700, $dir || die "$::basename: cannot chmod `".quote($dir)."': $!\n";
1660   chdir $dir || die "$::basename: ".quote($dir).": cannot change to - $!\n";
1661   opendir(DIR, $::cur) || die "$::basename: ".quote($dir).": cannot list - $!\n";
1662   my @files = readdir(DIR);
1663   closedir(DIR);
1664   foreach my $file (@files) {
1665     next if $file eq $::cur || $file eq $::up;
1666     if (-d $file && !-l $file) {
1667       unlink_directory($file);
1668     } else {
1669       unlink $file || die "$::basename: ".quote($file).": cannot remove - $!\n";
1670     }
1671   }
1672   chdir $::up || die "$::basename: $::up: cannot change to - $!\n";
1673   rmdir $dir || die "$::basename: ".quote($dir).": cannot remove - $!\n";
1674 }
1675
1676 # find_comparable_file(dir)
1677 # Assuming that the contents of some archive has been extracted to dir,
1678 # this function will determine the main file or directory in this
1679 # archive - the file or directory which will be compared when this
1680 # archive is compared to some other.
1681 sub find_comparable_file($) {
1682   my ($dir) = @_;
1683   my $result = $dir;
1684   if (opendir(my $dh, $dir)) {
1685     my @files;
1686     for (0..3) {
1687       my $file = readdir($dh);
1688       last if !defined $file;
1689       next if $file eq '.' || $file eq '..';
1690       push @files, $file;
1691     }
1692     closedir($dh);
1693     $result = File::Spec->catfile($dir, $files[0]) if @files == 1;
1694   }
1695   return $result;
1696 }
1697
1698 # makeabsolute(file)
1699 # Return the absolute version of file.
1700 sub makeabsolute($) {
1701   my ($file) = @_;
1702   return $file if (substr($file, 0, 1) eq '/');
1703   return File::Spec->catfile(getcwd(), $file);
1704 }
1705
1706 # quote(string)
1707 # Quote a style like the GNU fileutils would do (`locale'
1708 # quoting style).
1709 sub quote($) {
1710   my ($in) = @_;
1711   my $out = '';
1712   for (my $c = 0; $c < length($in); $c++) {
1713     my $ch = substr($in, $c, 1);
1714     if ($ch eq "\b") {
1715       $out .= "\\b";
1716     } elsif ($ch eq "\f") {
1717       $out .= "\\f";
1718     } elsif ($ch eq "\n") {
1719       $out .= "\\n";
1720     } elsif ($ch eq "\r") {
1721       $out .= "\\r";
1722     } elsif ($ch eq "\t") {
1723       $out .= "\\t";
1724     } elsif (ord($ch) == 11) {      # Vertical Tab, \v
1725       $out .= "\\v";
1726     } elsif ($ch eq "\\") {
1727       $out .= "\\\\";
1728     } elsif ($ch eq "'") {
1729       $out .= "\\'";
1730     } elsif ($ch !~ /[[:print:]]/) {
1731       $out .= sprintf('\\%03o', ord($ch));
1732     } else {
1733       $out .= $ch;
1734     }
1735   }
1736   return $out;
1737 }
1738
1739 # shell_execute(@)
1740 # Execute a command with pipes and output redirection like the
1741 # shell does. Only difference is we do it without the shell.
1742 # This reason for this is because we don't have to quote
1743 # meta-characters - some meta-characters like LF and DEL are
1744 # unquotable!
1745 sub shell_execute(@) {
1746   my @cmdspec = @_;
1747   my $start = 0;
1748   my $c;
1749   for ($c = 0; $c < @cmdspec; $c++) {
1750     if (ref $cmdspec[$c] && ${$cmdspec[$c]}[0] eq ';') {
1751       return 0 if !shell_execute_single_statement(@cmdspec[$start..$c-1]);
1752       $start = $c+1;
1753     }
1754   }
1755   if ($start != $c) {
1756     return 0 if !shell_execute_single_statement(@cmdspec[$start..$c-1]);
1757   }
1758   return 1;
1759 }
1760
1761 sub shell_execute_single_statement(@) {
1762   my (@cmdspec) = @_;
1763
1764   while (@cmdspec > 0) {
1765     my @cmds = ();
1766     my $start = 0;
1767     my $redir_out = undef;
1768     #my $more_cmds = 0;
1769     my $c;
1770     for ($c = 0; $c < @cmdspec; $c++) {
1771       if (ref $cmdspec[$c]) {
1772         push @cmds, [ @cmdspec[$start..$c-1] ];
1773         if (${$cmdspec[$c]}[0] eq '>') {
1774           $redir_out = $cmdspec[$c+1];
1775           $start = $c+2;
1776           $c++;
1777         #} elsif (${$cmdspec[$c]}[0] eq ';') {
1778           #$more_cmds = 1;
1779         #  $start = $c+1;
1780         #  $c++;
1781         #  last;
1782         } elsif (${$cmdspec[$c]}[0] eq '|') {
1783           $start = $c+1;
1784         }
1785       }
1786     }
1787     push @cmds, [ @cmdspec[$start..$c-1] ] if $start < $c;
1788     #for (my $x = 0; $x < @cmds; $x++) {
1789     #  print $x, ': ', join(':',@{$cmds[$x]}), "\n";
1790     #}
1791     splice @cmdspec,0,$c;
1792
1793     $SIG{INT} = 'IGNORE';
1794
1795     my @ip = ();
1796     my @op = ();
1797     my @children = ();
1798     for (my $c = 0; $c <= $#cmds; $c++) {
1799       if ($c != $#cmds) {
1800         @op = reverse POSIX::pipe();
1801         if (!@op || !defined $op[0] || !defined $op[1]) {
1802           $::errmsg = "pipe failed - $!";
1803           return 0;
1804         }
1805       }
1806       if ($c == $#cmds && defined $redir_out) {
1807         @_ = (); # XXX: necessary to overcome POSIX autoload bug!
1808         @op = (POSIX::open($redir_out, &POSIX::O_WRONLY | &POSIX::O_CREAT));
1809         if (!@op || !defined $op[0]) {
1810           $::errmsg = quote($redir_out).": cannot open for writing - $!";
1811           return 0;
1812         }
1813       }
1814       my $pid = fork();
1815       die "fork failed - $!\n" if !defined $pid;
1816       if ($pid == 0) {
1817         $SIG{INT} = '';
1818         if (@ip) {
1819           die "dup2 failed - $!\n" if POSIX::dup2($ip[1], 0) < 0;
1820           POSIX::close($_) foreach (@ip);
1821         }
1822         if (@op) {
1823           die "dup2 failed - $!\n" if POSIX::dup2($op[0], 1) < 0;
1824           POSIX::close($_) foreach (@op);
1825         }
1826         exec(@{$cmds[$c]}) || die ${$cmds[$c]}[0].": cannot execute - $!\n";
1827       }
1828       POSIX::close($op[0]) if ($c == $#cmds && defined $redir_out);
1829       POSIX::close($_) foreach (@ip);
1830       @ip = @op;
1831       @op = ();
1832       push @children, $pid;
1833     }
1834
1835     foreach (@children) {
1836       if (waitpid($_,0) < 0 && $^O ne 'MSWin32') {
1837         $::errmsg = "waitpid failed - $!";
1838         return 0;
1839       }
1840     }
1841     $SIG{INT} = '';
1842   }
1843
1844   return 1;
1845 }
1846
1847 # Write dir to file indicated by $::opt_save_outdir.
1848 #
1849 sub save_outdir($) {
1850   my ($dir) = @_;
1851   if (defined $::opt_save_outdir && !-l $dir && -d $dir) {
1852     if (!sysopen(TMP, $::opt_save_outdir, O_WRONLY)) {
1853       warn die "$::basename: ".quote($::opt_save_outdir).": cannot open for writing - $!\n";
1854     } else {
1855       print TMP $dir, "\n";
1856       close(TMP);
1857     }
1858   }
1859 }
1860
1861 # Somewhat stupid subroutine to add xargs to the command line.
1862 #
1863 sub handle_empty_add(@) {
1864   my @cmd = @_;
1865   unshift @cmd, '--';
1866   unshift @cmd, '-0' if ($::opt_null);
1867   unshift @cmd, $::cfg_path_xargs;
1868   return @cmd;
1869 }
1870
1871 # Return a suitable pager command
1872 #
1873 sub get_pager_program {
1874   return $ENV{PAGER} if (exists $ENV{PAGER});
1875   return $::cfg_path_pager;
1876 }
1877
1878 # repack_archive(srcfile,dstfile,srcfmt,dstfmt)
1879 # Repack an archive from a file to another (that shouldn't exist).
1880 sub repack_archive($$$$) {
1881   my ($file1,$file2,$fmt1,$fmt2) = @_;
1882
1883   # Special cases for tar-based archives (single file archives).
1884   if ($fmt1 =~ /^tar\+/ && $fmt2 =~ /^tar$/) {
1885     $fmt1 =~ s/^tar\+//;
1886     $::opt_cmd_extract_to = $file2; # XXX: would like to get rid of these
1887     $::opt_cmd_extract_to_type = 'f'; # XXX: would like to get rid of these
1888     exit 1 if (!runcmds('extract-to', $fmt1, $file1));
1889     return;
1890   } elsif ($fmt1 =~ /^tar$/ && $fmt2 =~ /^tar\+/) {
1891     $fmt2 =~ s/^tar\+//;
1892     exit 1 if (!runcmds('add', $fmt2, $file2, $file1));
1893     return;
1894   }
1895
1896   if ($fmt1 =~ /^tar\+/ && $fmt2 =~ /^tar\+/) {
1897     $fmt1 =~ s/^tar\+//;
1898     $fmt2 =~ s/^tar\+//;
1899   }
1900
1901   my $newarchive;
1902   if (File::Spec->file_name_is_absolute($file2)) {
1903     $newarchive = $file2;
1904   } else {
1905     $newarchive = File::Spec->catdir($::up, $file2);
1906   }
1907
1908   my $outdir;
1909   $outdir = makeoutdir() || exit 1;
1910   $::opt_cmd_extract_to = $outdir;
1911   $::opt_cmd_extract_to_type = 'd';
1912   exit 1 if !runcmds('extract-to', $fmt1, $file1);
1913   warn 'cd ',quote($outdir),"\n" if $::opt_explain || $::opt_simulate;
1914   if (!$::opt_simulate) {
1915     chdir($outdir) || die "$::basename: ".quote($outdir).": cannot change to - $!\n";
1916   }
1917   if (issingleformat($fmt2)) {
1918     # Preferrably we would like to find out what file it was
1919     # extracted to from the above execute-to command.
1920     #my $oldfile = stripext_exactly(basename($file1), $fmt1);
1921     my $oldfile = find_comparable_file($::cur); # FIXME: won't work in simulate mode
1922     exit 1 if !runcmds('add', $fmt2, $newarchive, $oldfile);
1923   } else {
1924     exit 1 if !runcmds('add', $fmt2, $newarchive, $::cur);
1925   }
1926   warn 'cd ',quote($::up),"\n" if $::opt_explain || $::opt_simulate;
1927   if (!$::opt_simulate) {
1928     chdir($::up) || die "$::basename: ".$::up.": cannot change to - $!\n"; #OK?????
1929   }
1930   warn 'rm -r ',quote($outdir),"\n" if $::opt_explain || $::opt_simulate;
1931   if (!$::opt_simulate) {
1932     unlink_directory($outdir);
1933   }
1934 }
1935
1936 sub END {
1937   map (rmdir, @::rmdirs) if !$::opt_simulate; # Errors are ignored
1938 }