Adding upstream version 2.23.4+deb12u1.upstream/2.23.4+deb12u1upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

2 files changed, 878 insertions, 0 deletions

diff --git a/lib/Devscripts/MkOrigtargz.pm b/lib/Devscripts/MkOrigtargz.pm
new file mode 100644
index 0000000..f4fa5fb
--- /dev/null
+++ b/lib/Devscripts/MkOrigtargz.pm
@@ -0,0 +1,631 @@
+package Devscripts::MkOrigtargz;
+
+use strict;
+use Cwd 'abs_path';
+use Devscripts::Compression
+  qw/compression_guess_from_file compression_get_property/;
+use Devscripts::MkOrigtargz::Config;
+use Devscripts::Output;
+use Devscripts::Uscan::Output;
+use Devscripts::Utils;
+use Dpkg::Changelog::Debian;
+use Dpkg::Control::Hash;
+use Dpkg::IPC;
+use Dpkg::Version;
+use File::Copy;
+use File::Spec;
+use File::Temp qw/tempdir/;
+use Moo;
+
+has config => (
+    is      => 'rw',
+    default => sub {
+        Devscripts::MkOrigtargz::Config->new->parse;
+    },
+);
+
+has exclude_globs => (
+    is      => 'rw',
+    lazy    => 1,
+    default => sub { $_[0]->config->exclude_file },
+);
+
+has include_globs => (
+    is      => 'rw',
+    lazy    => 1,
+    default => sub { $_[0]->config->include_file },
+);
+
+has status        => (is => 'rw', default => sub { 0 });
+has destfile_nice => (is => 'rw');
+
+our $found_comp;
+
+sub do {
+    my ($self) = @_;
+    $self->parse_copyrights or $self->make_orig_targz;
+    return $self->status;
+}
+
+sub make_orig_targz {
+    my ($self) = @_;
+
+    # Now we know what the final filename will be
+    my $destfilebase = sprintf "%s_%s.%s.tar", $self->config->package,
+      $self->config->version, $self->config->orig;
+    my $destfiletar = sprintf "%s/%s", $self->config->directory, $destfilebase;
+    my $destext
+      = $self->config->compression eq 'default'
+      ? 'default'
+      : compression_get_property($self->config->compression, "file_ext");
+    my $destfile;
+
+    # $upstream_tar is $upstream, unless the latter was a zip file.
+    my $upstream_tar = $self->config->upstream;
+
+    # Remember this for the final report
+    my $zipfile_deleted = 0;
+
+    # If the file is a zipfile, we need to create a tarfile from it.
+    if ($self->config->upstream_type eq 'zip') {
+        $destfile = $self->fix_dest_file($destfiletar);
+        if ($self->config->signature) {
+            $self->config->signature(4);    # repack upstream file
+        }
+
+        my $tempdir = tempdir("uscanXXXX", TMPDIR => 1, CLEANUP => 1);
+        # Parent of the target directory should be under our control
+        $tempdir .= '/repack';
+        my @cmd;
+        if ($self->config->upstream_comp eq 'xpi') {
+            @cmd = ('xpi-unpack', $upstream_tar, $tempdir);
+            unless (ds_exec_no_fail(@cmd) >> 8 == 0) {
+                ds_die("Repacking from xpi failed (could not xpi-unpack)\n");
+                return $self->status(1);
+            }
+        } else {
+            unless (mkdir $tempdir) {
+                ds_die("Unable to mkdir($tempdir): $!\n");
+                return $self->status(1);
+            }
+            @cmd = ('unzip', '-q');
+            push @cmd, split ' ', $self->config->unzipopt
+              if defined $self->config->unzipopt;
+            push @cmd, ('-d', $tempdir, $upstream_tar);
+            unless (ds_exec_no_fail(@cmd) >> 8 == 0) {
+                ds_die("Repacking from zip or jar failed (could not unzip)\n");
+                return $self->status(1);
+            }
+        }
+
+        # Figure out the top-level contents of the tarball.
+        # If we'd pass "." to tar we'd get the same contents, but the filenames
+        # would start with ./, which is confusing later.
+        # This should also be more reliable than, say, changing directories and
+        # globbing.
+        unless (opendir(TMPDIR, $tempdir)) {
+            ds_die("Can't open $tempdir $!\n");
+            return $self->status(1);
+        }
+        my @files = grep { $_ ne "." && $_ ne ".." } readdir(TMPDIR);
+        close TMPDIR;
+
+        # tar it all up
+        spawn(
+            exec => [
+                'tar',          '--owner=root',
+                '--group=root', '--mode=a+rX',
+                '--create',     '--file',
+                "$destfiletar", '--directory',
+                $tempdir,       @files
+            ],
+            wait_child => 1
+        );
+        unless (-e "$destfiletar") {
+            ds_die(
+"Repacking from zip or jar to tar.$destext failed (could not create tarball)\n"
+            );
+            return $self->status(1);
+        }
+        eval {
+            compress_archive($destfiletar, $destfile,
+                $self->config->compression);
+        };
+        if ($@) {
+            ds_die($@);
+            return $self->status(1);
+        }
+
+        # rename means the user did not want this file to exist afterwards
+        if ($self->config->mode eq "rename") {
+            unlink $upstream_tar;
+            $zipfile_deleted++;
+        }
+
+        $self->config->mode('repack');
+        $upstream_tar = $destfile;
+    } elsif (compression_guess_from_file($upstream_tar) =~ /^zstd?$/) {
+        $self->config->force_repack(1);
+    }
+
+    # From now on, $upstream_tar is guaranteed to be a compressed tarball. It
+    # is always a full (possibly relative) path, and distinct from $destfile.
+
+    # Find out if we have to repack
+    my $do_repack = 0;
+    if ($self->config->repack) {
+        my $comp = compression_guess_from_file($upstream_tar);
+        unless ($comp) {
+            ds_die("Cannot determine compression method of $upstream_tar");
+            return $self->status(1);
+        }
+        $do_repack = (
+            $comp eq 'tar'
+              or (  $self->config->compression ne 'default'
+                and $comp ne $self->config->compression)
+              or (  $self->config->compression eq 'default'
+                and $comp ne
+                &Devscripts::MkOrigtargz::Config::default_compression));
+    }
+
+    # Removing files
+    my $deletecount = 0;
+    my @to_delete;
+
+    if (@{ $self->exclude_globs }) {
+        my @files;
+        my $files;
+        spawn(
+            exec       => ['tar', '-t', '-a', '-f', $upstream_tar],
+            to_string  => \$files,
+            wait_child => 1
+        );
+        @files = split /^/, $files;
+        chomp @files;
+
+        my %delete;
+        # find out what to delete
+        my @exclude_info;
+        eval {
+            @exclude_info
+              = map { { glob => $_, used => 0, regex => glob_to_regex($_) } }
+              @{ $self->exclude_globs };
+        };
+        if ($@) {
+            ds_die($@);
+            return $self->status(1);
+        }
+        for my $filename (sort @files) {
+            my $last_match;
+            for my $info (@exclude_info) {
+                if (
+                    $filename
+                    =~ m@^(?:[^/]*/)? # Possible leading directory, ignore it
+				(?:$info->{regex}) # User pattern
+				(?:/.*)?$          # Possible trailing / for a directory
+			      @x
+                ) {
+                    if (!$last_match) {
+                        # if the current entry is a directory, check if it
+                        # matches any exclude-ignored glob
+                        my $ignore_this_exclude = 0;
+                        for my $ignore_exclude (@{ $self->include_globs }) {
+                            my $ignore_exclude_regex
+                              = glob_to_regex($ignore_exclude);
+
+                            if ($filename =~ $ignore_exclude_regex) {
+                                $ignore_this_exclude = 1;
+                                last;
+                            }
+                            if (   $filename =~ m,/$,
+                                && $ignore_exclude =~ $info->{regex}) {
+                                $ignore_this_exclude = 1;
+                                last;
+                            }
+                        }
+                        next if $ignore_this_exclude;
+                        $delete{$filename} = 1;
+                    }
+                    $last_match = $info;
+                }
+            }
+            if (defined $last_match) {
+                $last_match->{used} = 1;
+            }
+        }
+
+        for my $info (@exclude_info) {
+            if (!$info->{used}) {
+                ds_warn
+"No files matched excluded pattern as the last matching glob: $info->{glob}\n";
+            }
+        }
+
+        # ensure files are mentioned before the directory they live in
+        # (otherwise tar complains)
+        @to_delete = sort { $b cmp $a } keys %delete;
+
+        $deletecount = scalar(@to_delete);
+    }
+
+    if ($deletecount or $self->config->force_repack) {
+        $destfilebase = sprintf "%s_%s%s.%s.tar", $self->config->package,
+          $self->config->version, $self->config->repack_suffix,
+          $self->config->orig;
+        $destfiletar = sprintf "%s/%s", $self->config->directory,
+          $destfilebase;
+        $destfile = $self->fix_dest_file($destfiletar);
+
+        # Zip -> tar process already created $destfile, so need to rename it
+        if ($self->config->upstream_type eq 'zip') {
+            move($upstream_tar, $destfile);
+            $upstream_tar = $destfile;
+        }
+    }
+
+    # Actually do the unpack, remove, pack cycle
+    if ($do_repack || $deletecount || $self->config->force_repack) {
+        $destfile ||= $self->fix_dest_file($destfiletar);
+        if ($self->config->signature) {
+            $self->config->signature(4);    # repack upstream file
+        }
+        if ($self->config->upstream_comp) {
+            eval { decompress_archive($upstream_tar, $destfiletar) };
+            if ($@) {
+                ds_die($@);
+                return $self->status(1);
+            }
+        } else {
+            copy $upstream_tar, $destfiletar;
+        }
+        unlink $upstream_tar if $self->config->mode eq "rename";
+        # We have to use piping because --delete is broken otherwise, as
+        # documented at
+        # https://www.gnu.org/software/tar/manual/html_node/delete.html
+        if (@to_delete) {
+            # ARG_MAX: max number of bytes exec() can handle
+            my $arg_max;
+            spawn(
+                exec       => ['getconf', 'ARG_MAX'],
+                to_string  => \$arg_max,
+                wait_child => 1
+            );
+            # Under Hurd `getconf` above returns "undefined".
+            # It's apparently unlimited (?), so we just use a arbitrary number.
+            if ($arg_max =~ /\D/) { $arg_max = 131072; }
+            # Usually NAME_MAX=255, but here we use 128 to be on the safe side.
+            $arg_max = int($arg_max / 128);
+            # We use this lame splice on a totally arbitrary $arg_max because
+            # counting how many bytes there are in @to_delete is too
+            # inefficient.
+            while (my @next_n = splice @to_delete, 0, $arg_max) {
+                spawn(
+                    exec       => ['tar', '--delete', @next_n],
+                    from_file  => $destfiletar,
+                    to_file    => $destfiletar . ".tmp",
+                    wait_child => 1
+                ) if scalar(@next_n) > 0;
+                move($destfiletar . ".tmp", $destfiletar);
+            }
+        }
+        eval {
+            compress_archive($destfiletar, $destfile,
+                $self->config->compression);
+        };
+        if ($@) {
+            ds_die $@;
+            return $self->status(1);
+        }
+
+        # Symlink no longer makes sense
+        $self->config->mode('repack');
+        $upstream_tar = $destfile;
+    } else {
+        $destfile = $self->fix_dest_file($destfiletar,
+            compression_guess_from_file($upstream_tar), 1);
+    }
+
+    # Final step: symlink, copy or rename for tarball.
+
+    my $same_name = abs_path($destfile) eq abs_path($self->config->upstream);
+    unless ($same_name) {
+        if (    $self->config->mode ne "repack"
+            and $upstream_tar ne $self->config->upstream) {
+            ds_die "Assertion failed";
+            return $self->status(1);
+        }
+
+        if ($self->config->mode eq "symlink") {
+            my $rel
+              = File::Spec->abs2rel($upstream_tar, $self->config->directory);
+            symlink $rel, $destfile;
+        } elsif ($self->config->mode eq "copy") {
+            copy($upstream_tar, $destfile);
+        } elsif ($self->config->mode eq "rename") {
+            move($upstream_tar, $destfile);
+        }
+    }
+
+    # Final step: symlink, copy or rename for signature file.
+
+    my $destsigfile;
+    if ($self->config->signature == 1) {
+        $destsigfile = sprintf "%s.asc", $destfile;
+    } elsif ($self->config->signature == 2) {
+        $destsigfile = sprintf "%s.asc", $destfiletar;
+    } elsif ($self->config->signature == 3) {
+        # XXX FIXME XXX place holder
+        $destsigfile = sprintf "%s.asc", $destfile;
+    } else {
+        # $self->config->signature == 0 or 4
+        $destsigfile = "";
+    }
+
+    if ($self->config->signature == 1 or $self->config->signature == 2) {
+        my $is_openpgp_ascii_armor = 0;
+        my $fh_sig;
+        unless (open($fh_sig, '<', $self->config->signature_file)) {
+            ds_die "Cannot open $self->{config}->{signature_file}\n";
+            return $self->status(1);
+        }
+        while (<$fh_sig>) {
+            if (m/^-----BEGIN PGP /) {
+                $is_openpgp_ascii_armor = 1;
+                last;
+            }
+        }
+        close($fh_sig);
+
+        if (not $is_openpgp_ascii_armor) {
+            my @enarmor
+              = `gpg --no-options --output - --enarmor $self->{config}->{signature_file} 2>&1`;
+            unless ($? == 0) {
+                ds_die
+"Failed to convert $self->{config}->{signature_file} to *.asc\n";
+                return $self->status(1);
+            }
+            unless (open(DESTSIG, '>', $destsigfile)) {
+                ds_die "Failed to open $destsigfile for write $!\n";
+                return $self->status(1);
+            }
+            foreach my $line (@enarmor) {
+                next if $line =~ m/^Version:/;
+                next if $line =~ m/^Comment:/;
+                $line =~ s/ARMORED FILE/SIGNATURE/;
+                print DESTSIG $line;
+            }
+            unless (close(DESTSIG)) {
+                ds_die
+"Cannot write signature file $self->{config}->{signature_file}\n";
+                return $self->status(1);
+            }
+        } else {
+            if (abs_path($self->config->signature_file) ne
+                abs_path($destsigfile)) {
+                if ($self->config->mode eq "symlink") {
+                    my $rel = File::Spec->abs2rel(
+                        $self->config->signature_file,
+                        $self->config->directory
+                    );
+                    symlink $rel, $destsigfile;
+                } elsif ($self->config->mode eq "copy") {
+                    copy($self->config->signature_file, $destsigfile);
+                } elsif ($self->config->mode eq "rename") {
+                    move($self->config->signature_file, $destsigfile);
+                } else {
+                    ds_die 'Strange mode="' . $self->config->mode . "\"\n";
+                    return $self->status(1);
+                }
+            }
+        }
+    } elsif ($self->config->signature == 3) {
+        uscan_msg_raw
+"Skip adding upstream signature since upstream file has non-detached signature file.";
+    } elsif ($self->config->signature == 4) {
+        uscan_msg_raw
+          "Skip adding upstream signature since upstream file is repacked.";
+    }
+
+    # Final check: Is the tarball usable
+
+    # We are lazy and rely on Dpkg::IPC to report an error message
+    # (spawn does not report back the error code).
+    # We don't expect this to occur often anyways.
+    my $ret = spawn(
+        exec => ['tar', '--list', '--auto-compress', '--file', $destfile],
+        wait_child => 1,
+        to_file    => '/dev/null'
+    );
+
+    # Tell the user what we did
+
+    my $upstream_nice = File::Spec->canonpath($self->config->upstream);
+    my $destfile_nice = File::Spec->canonpath($destfile);
+    $self->destfile_nice($destfile_nice);
+
+    if ($same_name) {
+        uscan_msg_raw "Leaving $destfile_nice where it is";
+    } else {
+        if (   $self->config->upstream_type eq 'zip'
+            or $do_repack
+            or $deletecount
+            or $self->config->force_repack) {
+            uscan_msg_raw
+              "Successfully repacked $upstream_nice as $destfile_nice";
+        } elsif ($self->config->mode eq "symlink") {
+            uscan_msg_raw
+              "Successfully symlinked $upstream_nice to $destfile_nice";
+        } elsif ($self->config->mode eq "copy") {
+            uscan_msg_raw
+              "Successfully copied $upstream_nice to $destfile_nice";
+        } elsif ($self->config->mode eq "rename") {
+            uscan_msg_raw
+              "Successfully renamed $upstream_nice to $destfile_nice";
+        } else {
+            ds_die 'Unknown mode ' . $self->config->mode;
+            return $self->status(1);
+        }
+    }
+
+    if ($deletecount) {
+        uscan_msg_raw ", deleting ${deletecount} files from it";
+    }
+    if ($zipfile_deleted) {
+        uscan_msg_raw ", and removed the original file";
+    }
+    print ".\n";
+    return 0;
+}
+
+sub decompress_archive {
+    my ($from_file, $to_file) = @_;
+    my $comp = compression_guess_from_file($from_file);
+    unless ($comp) {
+        die("Cannot determine compression method of $from_file");
+    }
+
+    my $cmd = compression_get_property($comp, 'decomp_prog');
+    spawn(
+        exec       => $cmd,
+        from_file  => $from_file,
+        to_file    => $to_file,
+        wait_child => 1
+    );
+}
+
+sub compress_archive {
+    my ($from_file, $to_file, $comp) = @_;
+
+    my $cmd = compression_get_property($comp, 'comp_prog');
+    push(@{$cmd}, '-' . compression_get_property($comp, 'default_level'));
+    spawn(
+        exec       => $cmd,
+        from_file  => $from_file,
+        to_file    => $to_file,
+        wait_child => 1
+    );
+    unlink $from_file;
+}
+
+# Adapted from Text::Glob::glob_to_regex_string
+sub glob_to_regex {
+    my ($glob) = @_;
+
+    if ($glob =~ m@/$@) {
+        ds_warn
+          "Files-Excluded pattern ($glob) should not have a trailing /\n";
+        chop($glob);
+    }
+    if ($glob =~ m/(?<!\\)(?:\\{2})*\\(?![\\*?])/) {
+        die
+"Invalid Files-Excluded pattern ($glob), \\ can only escape \\, *, or ? characters\n";
+    }
+
+    my ($regex, $escaping);
+    for my $c ($glob =~ m/(.)/gs) {
+        if (
+               $c eq '.'
+            || $c eq '('
+            || $c eq ')'
+            || $c eq '|'
+            || $c eq '+'
+            || $c eq '^'
+            || $c eq '$'
+            || $c eq '@'
+            || $c eq '%'
+            || $c eq '{'
+            || $c eq '}'
+            || $c eq '['
+            || $c eq ']'
+            ||
+
+            # Escape '#' since we're using /x in the pattern match
+            $c eq '#'
+        ) {
+            $regex .= "\\$c";
+        } elsif ($c eq '*') {
+            $regex .= $escaping ? "\\*" : ".*";
+        } elsif ($c eq '?') {
+            $regex .= $escaping ? "\\?" : ".";
+        } elsif ($c eq "\\") {
+            if ($escaping) {
+                $regex .= "\\\\";
+                $escaping = 0;
+            } else {
+                $escaping = 1;
+            }
+            next;
+        } else {
+            $regex .= $c;
+            $escaping = 0;
+        }
+        $escaping = 0;
+    }
+
+    return $regex;
+}
+
+sub parse_copyrights {
+    my ($self) = @_;
+    for my $copyright_file (@{ $self->config->copyright_file }) {
+        my $data = Dpkg::Control::Hash->new();
+        my $okformat
+          = qr'https?://www.debian.org/doc/packaging-manuals/copyright-format/[.\d]+';
+        eval {
+            $data->load($copyright_file);
+            1;
+        } or do {
+            undef $data;
+        };
+        if (not -e $copyright_file) {
+            ds_die "File $copyright_file not found.";
+            return $self->status(1);
+        } elsif ($data
+            && defined $data->{format}
+            && $data->{format} =~ m@^$okformat/?$@) {
+            if ($data->{ $self->config->excludestanza }) {
+                push(
+                    @{ $self->exclude_globs },
+                    grep { $_ }
+                      split(/\s+/, $data->{ $self->config->excludestanza }));
+            }
+            if ($data->{ $self->config->includestanza }) {
+                push(
+                    @{ $self->include_globs },
+                    grep { $_ }
+                      split(/\s+/, $data->{ $self->config->includestanza }));
+            }
+        } else {
+            if (open my $file, '<', $copyright_file) {
+                while (my $line = <$file>) {
+                    if ($line =~ m/\b$self->{config}->{excludestanza}.*:/i) {
+                        ds_warn "The file $copyright_file mentions "
+                          . $self->config->excludestanza
+                          . ", but its "
+                          . "format is not recognized. Specify Format: "
+                          . "https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ "
+                          . "in order to remove files from the tarball with mk-origtargz.\n";
+                        last;
+                    }
+                }
+                close $file;
+            } else {
+                ds_die "Unable to read $copyright_file: $!\n";
+                return $self->status(1);
+            }
+        }
+    }
+}
+
+sub fix_dest_file {
+    my ($self, $destfiletar, $comp, $force) = @_;
+    if ($self->config->compression eq 'default' or $force) {
+        $self->config->compression($comp
+              || &Devscripts::MkOrigtargz::Config::default_compression);
+    }
+    $comp = compression_get_property($self->config->compression, "file_ext");
+    $found_comp ||= $self->config->compression;
+    return sprintf "%s.%s", $destfiletar, $comp;
+}
+
+1;
diff --git a/lib/Devscripts/MkOrigtargz/Config.pm b/lib/Devscripts/MkOrigtargz/Config.pm
new file mode 100644
index 0000000..a4612be
--- /dev/null
+++ b/lib/Devscripts/MkOrigtargz/Config.pm
@@ -0,0 +1,247 @@
+package Devscripts::MkOrigtargz::Config;
+
+use strict;
+
+use Devscripts::Compression qw'compression_is_supported
+  compression_guess_from_file
+  compression_get_property';
+use Devscripts::Uscan::Output;
+use Exporter 'import';
+use File::Which;
+use Moo;
+
+use constant default_compression => 'xz';
+
+# regexp-assemble << END
+# tar\.gz
+# tgz
+# tar\.bz2
+# tbz2?
+# tar\.lzma
+# tlz(?:ma?)?
+# tar\.xz
+# txz
+# tar\.Z
+# tar
+# tar.zst
+# tar.zstd
+# END
+use constant tar_regex =>
+  qr/t(?:ar(?:\.(?:[gx]z|lzma|bz2|Z)|.zstd?)?|lz(?:ma?)?|[gx]z|bz2?)$/;
+
+extends 'Devscripts::Config';
+
+# Command-line parameters
+has component      => (is => 'rw');
+has compression    => (is => 'rw');
+has copyright_file => (is => 'rw');
+has directory      => (is => 'rw');
+has exclude_file   => (is => 'rw');
+has include_file   => (is => 'rw');
+has force_repack   => (is => 'rw');
+has package        => (is => 'rw');
+has signature      => (is => 'rw');
+has signature_file => (is => 'rw');
+has repack         => (is => 'rw');
+has repack_suffix  => (is => 'rw');
+has unzipopt       => (is => 'rw');
+has version        => (is => 'rw');
+
+# Internal accessors
+has mode          => (is => 'rw');
+has orig          => (is => 'rw', default => sub { 'orig' });
+has excludestanza => (is => 'rw', default => sub { 'Files-Excluded' });
+has includestanza => (is => 'rw', default => sub { 'Files-Included' });
+has upstream      => (is => 'rw');
+has upstream_type => (is => 'rw');
+has upstream_comp => (is => 'rw');
+
+use constant keys => [
+    ['package=s'],
+    ['version|v=s'],
+    [
+        'component|c=s',
+        undef,
+        sub {
+            if ($_[1]) {
+                $_[0]->orig("orig-$_[1]");
+                $_[0]->excludestanza("Files-Excluded-$_[1]");
+                $_[0]->includestanza("Files-Included-$_[1]");
+            }
+            1;
+
+        }
+    ],
+    ['directory|C=s'],
+    ['exclude-file=s', undef, undef, sub { [] }],
+    ['include-file=s', undef, undef, sub { [] }],
+    ['force-repack'],
+    ['copyright-file=s', undef, undef, sub { [] }],
+    ['signature=i',      undef, undef, 0],
+    ['signature-file=s', undef, undef, ''],
+    [
+        'compression=s',
+        undef,
+        sub {
+            return (0, "Unknown compression scheme $_[1]")
+              unless ($_[1] eq 'default' or compression_is_supported($_[1]));
+            $_[0]->compression($_[1]);
+        },
+    ],
+    ['symlink', undef, \&setmode],
+    ['rename',  undef, \&setmode],
+    ['copy',    undef, \&setmode],
+    ['repack'],
+    ['repack-suffix|S=s', undef, undef, ''],
+    ['unzipopt=s'],
+];
+
+use constant rules => [
+    # Check --package if --version is used
+    sub {
+        return (
+              (defined $_[0]->{package} and not defined $_[0]->{version})
+            ? (0, 'If you use --package, you also have to specify --version')
+            : (1));
+    },
+    # Check that a tarball has been given and store it in $self->upstream
+    sub {
+        return (0, 'Please specify original tarball') unless (@ARGV == 1);
+        $_[0]->upstream($ARGV[0]);
+        return (
+            -r $_[0]->upstream
+            ? (1)
+            : (0, "Could not read $_[0]->{upstream}: $!"));
+    },
+    # Get Debian package name an version unless given
+    sub {
+        my ($self) = @_;
+        unless (defined $self->package) {
+
+            # get package name
+            my $c = Dpkg::Changelog::Debian->new(range => { count => 1 });
+            $c->load('debian/changelog');
+            if (my $msg = $c->get_parse_errors()) {
+                return (0, "could not parse debian/changelog:\n$msg");
+            }
+            my ($entry) = @{$c};
+            $self->package($entry->get_source());
+
+            # get version number
+            unless (defined $self->version) {
+                my $debversion = Dpkg::Version->new($entry->get_version());
+                if ($debversion->is_native()) {
+                    return (0,
+                            "Package with native version number $debversion; "
+                          . "mk-origtargz makes no sense for native packages."
+                    );
+                }
+                $self->version($debversion->version());
+            }
+
+            unshift @{ $self->copyright_file }, "debian/copyright"
+              if -r "debian/copyright";
+
+            # set destination directory
+            unless (defined $self->directory) {
+                $self->directory('..');
+            }
+        } else {
+            unless (defined $self->directory) {
+                $self->directory('.');
+            }
+        }
+        return 1;
+    },
+    # Get upstream type and compression
+    sub {
+        my ($self) = @_;
+        my $mime = compression_guess_from_file($self->upstream);
+
+        if (defined $mime and $mime eq 'zip') {
+            $self->upstream_type('zip');
+            my ($prog, $pkg);
+            if ($self->upstream =~ /\.xpi$/i) {
+                $self->upstream_comp('xpi');
+                $prog = 'xpi-unpack';
+                $pkg  = 'mozilla-devscripts';
+            } else {
+                $self->upstream_comp('zip');
+                $prog = $pkg = 'unzip';
+            }
+            return (0,
+                    "$prog binary not found."
+                  . " You need to install the package $pkg"
+                  . " to be able to repack "
+                  . $self->upstream_type
+                  . " upstream archives.\n")
+              unless (which $prog);
+        } elsif ($self->upstream =~ tar_regex) {
+            $self->upstream_type('tar');
+            if ($self->upstream =~ /\.tar$/) {
+                $self->upstream_comp('');
+            } else {
+                unless (
+                    $self->upstream_comp(
+                        compression_guess_from_file($self->upstream))
+                ) {
+                    return (0,
+                        "Unknown compression used in $self->{upstream}");
+                }
+            }
+        } else {
+            # TODO: Should we ignore the name and only look at what file knows?
+            return (0,
+                    'Parameter '
+                  . $self->upstream
+                  . ' does not look like a tar archive or a zip file.');
+        }
+        return 1;
+    },
+    # Default compression
+    sub {
+        my ($self) = @_;
+
+        # Case 1: format is 1.0
+        if (-r 'debian/source/format') {
+            open F, 'debian/source/format';
+            my $str = <F>;
+            unless ($str =~ /^([\d\.]+)/ and $1 >= 2.0) {
+                ds_warn
+"Source format is earlier than 2.0, switch compression to gzip";
+                $self->compression('gzip');
+                $self->repack(1) unless ($self->upstream_comp eq 'gzip');
+            }
+            close F;
+        } elsif (-d 'debian') {
+            ds_warn "Missing debian/source/format, switch compression to gzip";
+            $self->compression('gzip');
+            $self->repack(1) unless ($self->upstream_comp eq 'gzip');
+        } elsif ($self->upstream_type eq 'tar') {
+
+            # Uncompressed tar
+            if (!$self->upstream_comp) {
+                $self->repack(1);
+            }
+        }
+        # Set to default. Will be changed after setting do_repack
+        $self->compression('default')
+          unless ($self->compression);
+        return 1;
+    },
+    sub {
+        my ($self) = @_;
+        $self->{mode} ||= 'symlink';
+    },
+];
+
+sub setmode {
+    my ($self, $nv, $kname) = @_;
+    return unless ($nv);
+    if (defined $self->mode and $self->mode ne $kname) {
+        return (0, "--$self->{mode} and --$kname are mutually exclusive");
+    }
+    $self->mode($kname);
+}
+
+1;