git-debexport

#!/bin/sh
readonly D=/dev/null
export TAR_OPTIONS='--blocking-factor=1 --format=gnu --sort=name --numeric-owner --owner=0 --group=0 --no-selinux --no-xattrs --exclude-vcs --sparse'

G=$(git rev-parse --show-toplevel)
[ -n "$G" ] || exit 1
G=$(readlink -e "$G")
[ -n "$G" ] || exit 1

cd "$G/" || exit 1
dpkg-parsechangelog >$D 2>$D || exit 1

if git config --get commit.gpgsign 2>$D | grep -Fq true ; then
    NO_SIGN_OPT=''
    _sign_file() { _sign_file_do "$@"; }
else
    NO_SIGN_OPT='--no-sign'
    _sign_file() { :; }

    unset DEBEMAIL DEBFULLNAME DEB_SIGN_KEYID
fi

a=source
n=$(dpkg-parsechangelog -S Source)
v=$(dpkg-parsechangelog -S Version)

ts=$(dpkg-parsechangelog -S Timestamp)
export SOURCE_DATE_EPOCH=${ts}
export TAR_OPTIONS="${TAR_OPTIONS} --mtime @${ts}"

## match pattern "epoch:version-revision"
mp0='([0-9]+):([0-9][0-9a-zA-Z.+~:-]*)-([0-9a-zA-Z+.~]+)'
## match pattern "epoch:debian_version"
mp1='([0-9]+):([0-9][0-9a-zA-Z.+~:]*)'
## match pattern "version-revision"
mp2='([0-9][0-9a-zA-Z.+~-]*)-([0-9a-zA-Z+.~]+)'
## match pattern "debian_version"
mp3='([0-9][0-9a-zA-Z.+~]*)'
## replace pattern "epoch|version|revision or debian_version"
rp0='\2\5|\3\7|\4\6\8\9'

pv_sed='/^('${mp0}'|'${mp1}'|'${mp2}'|'${mp3}')$/{s##'${rp0}'#;p;}'

pv=$(echo "$v" | sed -En "${pv_sed}")
[ -n "${pv}" ] || exit 1

# v0=$(echo "${pv}" | cut -d '|' -f 1)
v1=$(echo "${pv}" | cut -d '|' -f 2)
v2=$(echo "${pv}" | cut -d '|' -f 3)

_sign_file_do() {
    _sf_i=$(stat -c '%s' "$1")
    [ -n "${_sf_i}" ] || return
    _sf_t0=$(mktemp)
    if [ "${_sf_i}" -gt 0 ]; then
        cat < "$1" > "${_sf_t0}"

        _sf_i=$((_sf_i-1))
        _sf_t1=$(od -N 1 -j ${_sf_i} -t u1 "$1" | head -n 1)
        _sf_t1=$(echo "${_sf_t1}" | tr -s '[:space:]' ' ')
        _sf_t1=$(echo "${_sf_t1}" | cut -d ' ' -f 2)
        if [ "${_sf_t1}" -ne 10 ]; then
            echo >> "${_sf_t0}"
        fi
        echo >> "${_sf_t0}"
    fi

    _sf_t1=$(mktemp -u); rm -f "${_sf_t1}"
    gpg \
      --utf8-strings --textmode --armor --clearsign \
      --output "${_sf_t1}" "${_sf_t0}"
    _sf_i=$?
    if [ "${_sf_i}" -eq 0 ] ; then
        cat < "${_sf_t1}" > "$1"
    fi
    rm -f "${_sf_t0}" "${_sf_t1}"; unset _sf_t0 _sf_t1
    return ${_sf_i}
}

T=$(mktemp -d)

_cleanup() {
    cd "${TMP}/"
    rm -rf "$T/"
}

W=$T/tmp/; mkdir -p "$W/"
if [ -z "${v1}" ]; then
    ## native Debian package
    ## grab all the things
    tar -cf - ./ | tar -C "$W" -xf -
else
    ## grab only debian related files
    tar -cf - debian/ | tar -C "$W" -xf -
fi
cd "$W/"

chmod 755 debian/rules

## prepare gpg
t=$T/z; date > "$t"; _sign_file "$t"; rm "$t"; unset t

## native Debian package
if [ -z "${v1}" ]; then
    if ! dpkg-buildpackage --build=source -z9 -d -nc ${NO_SIGN_OPT}; then
        _cleanup
        exit 1
    fi

    cd "$T/"; rm -rf "$W/"
    echo "index of $T/" 1>&2
    ls -lhgG
    exit
fi

pnu=${n}_${v1}
pnd=${pnu}-${v2}
(
    find -L "$G/../" -mindepth 1 -maxdepth 1 -name "${pnu}.orig.*" 2>$D | \
    while read i; do
        k=$(readlink -e "$i" 2>$D)
        [ -n "$k" ] || continue
        i=$(basename "$i")
        cp "$k" "$T/$i"
    done; unset i k

    if ! [ -f debian/control ]; then
        if ! debian/rules debian/control 2>&1; then
            return 1
        fi
    fi

    tar -cf - debian/ | xz -9 > "$T/${pnd}.debian.tar.xz"

    cat > "$W/dpkg-source-raw" <<-"EOF"
        #!/usr/bin/perl
        #
        # dpkg-source-raw:
        #   hackish script based on original dpkg-source
        #
        # Copyright © 1996 Ian Jackson <ijackson@chiark.greenend.org.uk>
        # Copyright © 1997 Klee Dienes <klee@debian.org>
        # Copyright © 1999-2003 Wichert Akkerman <wakkerma@debian.org>
        # Copyright © 1999 Ben Collins <bcollins@debian.org>
        # Copyright © 2000-2003 Adam Heath <doogie@debian.org>
        # Copyright © 2005 Brendan O'Dea <bod@debian.org>
        # Copyright © 2006-2008 Frank Lichtenheld <djpig@debian.org>
        # Copyright © 2006-2009,2012 Guillem Jover <guillem@debian.org>
        # Copyright © 2008-2011 Raphaël Hertzog <hertzog@debian.org>
        #
        # 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 2 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 <https://www.gnu.org/licenses/>.

        use strict;
        use warnings;

        use List::Util qw(any none);
        use Cwd;
        use File::Basename;
        use File::Spec;

        use Dpkg ();
        use Dpkg::Gettext;
        use Dpkg::ErrorHandling;
        use Dpkg::Arch qw(:operators);
        use Dpkg::Deps;
        use Dpkg::Compression;
        use Dpkg::Conf;
        use Dpkg::Control::Info;
        use Dpkg::Control::Tests;
        use Dpkg::Control::Fields;
        use Dpkg::Substvars;
        use Dpkg::Version;
        use Dpkg::Vars;
        use Dpkg::Changelog::Parse;
        use Dpkg::Source::Package;
        use Dpkg::Vendor;

        # textdomain('dpkg-dev');

        my $build_format;
        my %options = ();

        my $substvars = Dpkg::Substvars->new();

        my @options;

        # --format options are not allowed, they would take precedence
        # over real command line options, debian/source/format should be used
        # instead
        # --unapply-patches is only allowed in local-options as it's a matter
        # of personal taste and the default should be to keep patches applied
        my $forbidden_opts_re = {
            'options' => qr/^--(?:format=|unapply-patches$|abort-on-upstream-changes$)/,
            'local-options' => qr/^--format=/,
        };

        foreach my $filename ('local-options', 'options') {
            my $conf = Dpkg::Conf->new();
            my $optfile = "debian/source/$filename";
            next unless -f $optfile;
            $conf->load($optfile);
            $conf->filter(remove => sub { $_[0] =~ $forbidden_opts_re->{$filename} });
            if (@$conf) {
                unshift @options, @$conf;
            }
        }

        $options{origtardir} = $ARGV[0];
        # report_options(quiet_warnings => 1);
        # $options{quiet} = 1;

        my %ch_options = (file => "debian/changelog");
        my $changelog = changelog_parse(%ch_options);
        my $control = Dpkg::Control::Info->new("debian/control");

        # <https://reproducible-builds.org/specs/source-date-epoch/>
        $ENV{SOURCE_DATE_EPOCH} ||= $changelog->{timestamp} || time;

        my $srcpkg = Dpkg::Source::Package->new(options => \%options);
        my $fields = $srcpkg->{fields};

        my @sourcearch;
        my %archadded;
        my @binarypackages;

        # Scan control info of source package
        my $src_fields = $control->get_source();
        error(g_("debian/control doesn't contain any information about the source package")) unless defined $src_fields;
        my $src_sect = $src_fields->{'Section'} || 'unknown';
        my $src_prio = $src_fields->{'Priority'} || 'unknown';

        foreach (keys %{$src_fields}) {
            my $v = $src_fields->{$_};
            if (m/^Source$/i) {
                set_source_package($v);
                $fields->{$_} = $v;
            } elsif (m/^Uploaders$/i) {
                ($fields->{$_} = $v) =~ s/\s*[\r\n]\s*/ /g; # Merge in a single-line
            } elsif (m/^Build-(?:Depends|Conflicts)(?:-Arch|-Indep)?$/i) {
                my $dep;
                my $type = field_get_dep_type($_);
                $dep = deps_parse($v, build_dep => 1, union => $type eq 'union');
                error(g_('error occurred while parsing %s'), $_) unless defined $dep;
                my $facts = Dpkg::Deps::KnownFacts->new();
                $dep->simplify_deps($facts);
                $dep->sort() if $type eq 'union';
                $fields->{$_} = $dep->output();
            } else {
                field_transfer_single($src_fields, $fields);
            }
        }

        # Scan control info of binary packages
        my @pkglist;
        foreach my $pkg ($control->get_packages()) {
            my $p = $pkg->{'Package'};
            my $sect = $pkg->{'Section'} || $src_sect;
            my $prio = $pkg->{'Priority'} || $src_prio;
            my $type = $pkg->{'Package-Type'} ||
                    $pkg->get_custom_field('Package-Type') || 'deb';
            my $arch = $pkg->{'Architecture'};
            my $profile = $pkg->{'Build-Profiles'};

            my $pkg_summary = sprintf('%s %s %s %s', $p, $type, $sect, $prio);

            $pkg_summary .= ' arch=' . join ',', split ' ', $arch;

            if (defined $profile) {
                # If the string does not contain brackets then it is using the
                # old syntax. Emit a fatal error.
                if ($profile !~ m/^\s*<.*>\s*$/) {
                    error(g_('binary package stanza %s is using an obsolete ' .
                             'Build-Profiles field syntax'), $p);
                }

                # Instead of splitting twice and then joining twice, we just do
                # simple string replacements:

                # Remove the enclosing <>
                $profile =~ s/^\s*<(.*)>\s*$/$1/;
                # Join lists with a plus (OR)
                $profile =~ s/>\s+</+/g;
                # Join their elements with a comma (AND)
                $profile =~ s/\s+/,/g;
                $pkg_summary .= " profile=$profile";
            }

            if (defined $pkg->{'Essential'} and $pkg->{'Essential'} eq 'yes') {
                $pkg_summary .= ' essential=yes';
            }

            push @pkglist, $pkg_summary;
            push @binarypackages, $p;
            foreach (keys %{$pkg}) {
                my $v = $pkg->{$_};
                if (m/^Architecture$/) {
                    # Gather all binary architectures in one set. 'any' and 'all'
                    # are special-cased as they need to be the only ones in the
                    # current stanza if present.
                    if (debarch_eq($v, 'any') || debarch_eq($v, 'all')) {
                        push(@sourcearch, $v) unless $archadded{$v}++;
                    } else {
                        for my $a (split(/\s+/, $v)) {
                            error(g_("'%s' is not a legal architecture string"), $a)
                                if debarch_is_illegal($a);
                            error(g_('architecture %s only allowed on its ' .
                                     "own (list for package %s is '%s')"),
                                  $a, $p, $a)
                                if $a eq 'any' or $a eq 'all';
                            push(@sourcearch, $a) unless $archadded{$a}++;
                        }
                    }
                } elsif (m/^(?:Homepage|Description)$/) {
                    # Do not overwrite the same field from the source entry
                } else {
                    field_transfer_single($pkg, $fields);
                }
            }
        }

        unless (scalar(@pkglist)) {
            error(g_("debian/control doesn't list any binary package"));
        }

        if (any { $_ eq 'any' } @sourcearch) {
            # If we encounter one 'any' then the other arches become insignificant
            # except for 'all' that must also be kept
            if (any { $_ eq 'all' } @sourcearch) {
                @sourcearch = qw(any all);
            } else {
                @sourcearch = qw(any);
            }
        } else {
            # Minimize arch list, by removing arches already covered by wildcards
            my @arch_wildcards = grep { debarch_is_wildcard($_) } @sourcearch;
            my @mini_sourcearch = @arch_wildcards;
            foreach my $arch (@sourcearch) {
                if (none { debarch_is($arch, $_) } @arch_wildcards) {
                    push @mini_sourcearch, $arch;
                }
            }
            @sourcearch = @mini_sourcearch;
        }
        $fields->{'Architecture'} = join(' ', @sourcearch);
        $fields->{'Package-List'} = "\n" . join("\n", sort @pkglist);

        # Scan fields of dpkg-parsechangelog
        foreach (keys %{$changelog}) {
            my $v = $changelog->{$_};

            if (m/^Source$/) {
                set_source_package($v);
                $fields->{$_} = $v;
            } elsif (m/^Version$/) {
                my ($ok, $error) = version_check($v);
                error($error) unless $ok;
                $fields->{$_} = $v;
            } elsif (m/^Binary-Only$/) {
                error(g_('building source for a binary-only release'))
                    if $v eq 'yes';
            } elsif (m/^Maintainer$/i) {
                # Do not replace the field coming from the source entry
            } else {
                field_transfer_single($changelog, $fields);
            }
        }

        $fields->{'Binary'} = join(', ', @binarypackages);
        # Avoid overly long line by splitting over multiple lines
        if (length($fields->{'Binary'}) > 980) {
            $fields->{'Binary'} =~ s/(.{0,980}), ?/$1,\n/g;
        }

        # Select the format to use
        if (not defined $build_format) {
            if (-e "debian/source/format") {
                open(my $format_fh, '<', "debian/source/format")
                    or syserr(g_('cannot read debian/source/format'));
                $build_format = <$format_fh>;
                chomp($build_format) if defined $build_format;
                error(g_('debian/source/format is empty'))
                    unless defined $build_format and length $build_format;
                close($format_fh);
            } else {
                $build_format = '1.0';
            }
        }

        $fields->{'Format'} = $build_format;
        $srcpkg->upgrade_object_type(); # Fails if format is unsupported
        # Parse command line options
        $srcpkg->init_options();

        my $basenamerev = $srcpkg->get_basename(1);

            ## portions from /usr/share/perl5/Dpkg/Source/Package/V2.pm
            ## Dpkg::Source::Package::V2::_generate_patch

            my ($tarfile);
            my $comp_ext_regex = compression_get_file_extension_regex();
            foreach my $file (sort $srcpkg->find_original_tarballs()) {
                if ($file =~ /\.orig\.tar\.$comp_ext_regex$/) {
                    if (defined($tarfile)) {
                        error(g_('several orig.tar files found (%s and %s) but only ' .
                                 'one is allowed'), $tarfile, $file);
                    }
                    $srcpkg->add_file($file);
                } elsif ($file =~ /\.orig-([[:alnum:]-]+)\.tar\.$comp_ext_regex$/) {
                    $srcpkg->add_file($file);
                }
            }

            ## portions from /usr/share/perl5/Dpkg/Source/Package/V2.pm
            ## Dpkg::Source::Package::V2::do_build

            $srcpkg->add_file("$ARGV[0]/$basenamerev.debian.tar.xz");

        # Write the .dsc
        my $dscname = "$ARGV[0]/$basenamerev.dsc";
        $srcpkg->write_dsc(filename => $dscname, substvars => $substvars);
        exit(0);
    EOF
    chmod +x "$W/dpkg-source-raw"
    perl "$W/dpkg-source-raw" "$T" || return
    rm "$W/dpkg-source-raw"

    _sign_file "$T/${pnd}.dsc"

    dpkg-genbuildinfo --build=source || return
    _sign_file "$T/${pnd}_${a}.buildinfo"

    dpkg-genchanges --build=source -q >"$T/${pnd}_${a}.changes" || return
    _sign_file "$T/${pnd}_${a}.changes"

    cd "$T/"; rm -rf "$W/"
    echo "index of $T/" 1>&2
    ls -lhgG
    exit
)
if [ $? -ne 0 ]; then
    _cleanup
    exit 1
fi