summaryrefslogtreecommitdiffstats
path: root/scripts/git-deborig.pl
blob: fd5a166d88779390a578ec204bace9261240dd13 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
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";
}