summaryrefslogtreecommitdiffstats
path: root/scripts/git-deborig.pl
diff options
context:
space:
mode:
Diffstat (limited to '')
-rwxr-xr-xscripts/git-deborig.pl284
1 files changed, 284 insertions, 0 deletions
diff --git a/scripts/git-deborig.pl b/scripts/git-deborig.pl
new file mode 100755
index 0000000..7ef342f
--- /dev/null
+++ b/scripts/git-deborig.pl
@@ -0,0 +1,284 @@
+#!/usr/bin/perl
+
+# git-deborig -- try to produce Debian orig.tar using git-archive(1)
+
+# Copyright (C) 2016-2019 Sean Whitton <spwhitton@spwhitton.name>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or (at
+# your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+=head1 NAME
+
+git-deborig - try to produce Debian orig.tar using git-archive(1)
+
+=head1 SYNOPSIS
+
+B<git deborig> [B<--force>|B<-f>] [B<--just-print>|B<--just-print-tag-names>] [B<--version=>I<VERSION>] [I<COMMITTISH>]
+
+=head1 DESCRIPTION
+
+B<git-deborig> tries to produce the orig.tar you need for your upload
+by calling git-archive(1) on an existing git tag or branch head. It
+was written with the dgit-maint-merge(7) workflow in mind, but can be
+used with other workflows.
+
+B<git-deborig> will try several common tag names. If this fails, or
+if more than one of those common tags are present, you can specify the
+tag or branch head to archive on the command line (I<COMMITTISH> above).
+
+B<git-deborig> will override gitattributes(5) that would cause the
+contents of the tarball generated by git-archive(1) not to be
+identical with the commitish archived: the B<export-subst> and
+B<export-ignore> attributes.
+
+B<git-deborig> should be invoked from the root of the git repository,
+which should contain I<debian/changelog>.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-f>|B<--force>
+
+Overwrite any existing orig.tar in the parent directory.
+
+=item B<--just-print>
+
+Instead of actually invoking git-archive(1), output information about
+how it would be invoked. Ignores I<--force>.
+
+Note that running the git-archive(1) invocation outputted with this
+option may not produce the same output. This is because
+B<git-deborig> takes care to disables git attributes otherwise heeded
+by git-archive(1), as detailed above.
+
+=item B<--just-print-tag-names>
+
+Instead of actually invoking git-archive(1), or even checking which
+tags exist, print the tag names we would consider for the upstream
+version number in the first entry in the Debian changelog, or that
+supplied with B<--version>.
+
+=item B<--version=>I<VERSION>
+
+Instead of reading the new upstream version from the first entry in
+the Debian changelog, use I<VERSION>.
+
+=back
+
+=head1 SEE ALSO
+
+git-archive(1), dgit-maint-merge(7), dgit-maint-debrebase(7)
+
+=head1 AUTHOR
+
+B<git-deborig> was written by Sean Whitton <spwhitton@spwhitton.name>.
+
+=cut
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+use Git::Wrapper;
+use Dpkg::Changelog::Parse;
+use Dpkg::IPC;
+use Dpkg::Version;
+use List::Compare;
+use String::ShellQuote;
+use Try::Tiny;
+
+my $git = Git::Wrapper->new(".");
+
+# Sanity check #1
+try {
+ $git->rev_parse({ git_dir => 1 });
+} catch {
+ die "pwd doesn't look like a git repository ..\n";
+};
+
+# Sanity check #2
+die "pwd doesn't look like a Debian source package ..\n"
+ unless (-e "debian/changelog");
+
+# Process command line args
+my $orig_args = join(" ", map { shell_quote($_) } ("git", "deborig", @ARGV));
+my $overwrite = '';
+my $user_version = '';
+my $user_ref = '';
+my $just_print = '';
+my $just_print_tag_names = '';
+GetOptions(
+ 'force|f' => \$overwrite,
+ 'just-print' => \$just_print,
+ 'just-print-tag-names' => \$just_print_tag_names,
+ 'version=s' => \$user_version
+) || usage();
+
+if (scalar @ARGV == 1) {
+ $user_ref = shift @ARGV;
+} elsif (scalar @ARGV >= 2
+ || ($just_print && $just_print_tag_names)) {
+ usage();
+}
+
+# Extract source package name from d/changelog and either extract
+# version too, or parse user-supplied version
+my $version;
+my $changelog = Dpkg::Changelog::Parse->changelog_parse({});
+if ($user_version) {
+ $version = Dpkg::Version->new($user_version);
+} else {
+ $version = $changelog->{Version};
+}
+
+# Sanity check #3
+die "version number $version is not valid ..\n" unless $version->is_valid();
+
+my $source = $changelog->{Source};
+my $upstream_version = $version->version();
+
+# Sanity check #4
+# Only complain if the user didn't supply a version, because the user
+# is not required to include a Debian revision when they pass
+# --version
+die "this looks like a native package .."
+ if (!$user_version && $version->is_native());
+
+# Convert the upstream version according to DEP-14 rules
+my $git_upstream_version = $upstream_version;
+$git_upstream_version =~ y/:~/%_/;
+$git_upstream_version =~ s/\.(?=\.|$|lock$)/.#/g;
+
+# This list could be expanded if new conventions come into use
+my @candidate_tags = (
+ "$git_upstream_version", "v$git_upstream_version",
+ "upstream/$git_upstream_version"
+);
+
+# Handle the --just-print-tag-names option
+if ($just_print_tag_names) {
+ for my $candidate_tag (@candidate_tags) {
+ print "$candidate_tag\n";
+ }
+ exit 0;
+}
+
+# Default to gzip
+my $compressor = "gzip -cn";
+my $compression = "gz";
+# Now check if we can use xz
+if (-e "debian/source/format") {
+ open(my $format_fh, '<', "debian/source/format")
+ or die "couldn't open debian/source/format for reading";
+ my $format = <$format_fh>;
+ chomp($format) if defined $format;
+ if ($format eq "3.0 (quilt)") {
+ $compressor = "xz -c";
+ $compression = "xz";
+ }
+ close $format_fh;
+}
+
+my $orig = "../${source}_$upstream_version.orig.tar.$compression";
+die "$orig already exists: not overwriting without --force\n"
+ if (-e $orig && !$overwrite && !$just_print);
+
+if ($user_ref) { # User told us the tag/branch to archive
+ # We leave it to git-archive(1) to determine whether or not this
+ # ref exists; this keeps us forward-compatible
+ archive_ref_or_just_print($user_ref);
+} else { # User didn't specify a tag/branch to archive
+ # Get available git tags
+ my @all_tags = $git->tag();
+
+ # See which candidate version tags are present in the repo
+ my $lc = List::Compare->new(\@all_tags, \@candidate_tags);
+ my @version_tags = $lc->get_intersection();
+
+ # If there is only one candidate version tag, we're good to go.
+ # Otherwise, let the user know they can tell us which one to use
+ if (scalar @version_tags > 1) {
+ print STDERR "tags ", join(", ", @version_tags),
+ " all exist in this repository\n";
+ print STDERR
+"tell me which one you want to make an orig.tar from: $orig_args TAG\n";
+ exit 1;
+ } elsif (scalar @version_tags < 1) {
+ print STDERR "couldn't find any of the following tags: ",
+ join(", ", @candidate_tags), "\n";
+ print STDERR
+"tell me a tag or branch head to make an orig.tar from: $orig_args COMMITTISH\n";
+ exit 1;
+ } else {
+ my $tag = shift @version_tags;
+ archive_ref_or_just_print($tag);
+ }
+}
+
+sub archive_ref_or_just_print {
+ my $ref = shift;
+
+ my $cmd = [
+ 'git', '-c', "tar.tar.${compression}.command=${compressor}",
+ 'archive', "--prefix=${source}-${upstream_version}/",
+ '-o', $orig, $ref
+ ];
+ if ($just_print) {
+ print "$ref\n";
+ print "$orig\n";
+ my @cmd_mapped = map { shell_quote($_) } @$cmd;
+ print "@cmd_mapped\n";
+ } else {
+ my ($info_dir) = $git->rev_parse(qw|--git-path info/|);
+ my ($info_attributes)
+ = $git->rev_parse(qw|--git-path info/attributes|);
+ my ($deborig_attributes)
+ = $git->rev_parse(qw|--git-path info/attributes-deborig|);
+
+ # sometimes the info/ dir may not exist
+ mkdir $info_dir unless (-e $info_dir);
+
+ # For compatibility with dgit, we have to override any
+ # export-subst and export-ignore git attributes that might be set
+ rename $info_attributes, $deborig_attributes
+ if (-e $info_attributes);
+ my $attributes_fh;
+ unless (open($attributes_fh, '>', $info_attributes)) {
+ rename $deborig_attributes, $info_attributes
+ if (-e $deborig_attributes);
+ die "could not open $info_attributes for writing";
+ }
+ print $attributes_fh "* -export-subst\n";
+ print $attributes_fh "* -export-ignore\n";
+ close $attributes_fh;
+
+ spawn(
+ exec => $cmd,
+ wait_child => 1,
+ nocheck => 1
+ );
+
+ # Restore situation before we messed around with git attributes
+ if (-e $deborig_attributes) {
+ rename $deborig_attributes, $info_attributes;
+ } else {
+ unlink $info_attributes;
+ }
+ }
+}
+
+sub usage {
+ die
+"usage: git deborig [--force|-f] [--just-print|--just-print-tag-names] [--version=VERSION] [COMMITTISH]\n";
+}