chiark / gitweb /
dgit: Always canonicalise suite rather earlier
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 1e348f366858c775bb9a31bffb567fc513f03806..f8b4fddabf46a87e7ce4b210ef24f6f83800b964 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -2,7 +2,7 @@
 # dgit
 # Integration between git and Debian-style archives
 #
-# Copyright (C)2013 Ian Jackson
+# Copyright (C)2013-2015 Ian Jackson
 #
 # 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
@@ -52,7 +52,7 @@ our $new_package = 0;
 our $ignoredirty = 0;
 our $rmonerror = 1;
 our @deliberatelies;
-our %supersedes;
+our %previously;
 our $existing_package = 'dpkg';
 our $cleanmode = 'dpkg-source';
 our $changes_since_version;
@@ -111,6 +111,8 @@ sub lref () { return "refs/heads/".lbranch(); }
 sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); }
 sub rrref () { return server_ref($csuite); }
 
+sub lrfetchrefs () { return "refs/dgit-fetch/$isuite"; }
+
 sub stripepoch ($) {
     my ($vsn) = @_;
     $vsn =~ s/^\d+\://;
@@ -162,6 +164,12 @@ sub deliberately ($) {
     return !!grep { $_ eq "--deliberately-$enquiry" } @deliberatelies;
 }
 
+sub deliberately_not_fast_forward () {
+    foreach (qw(not-fast-forward fresh-repo)) {
+       return 1 if deliberately($_) || deliberately("TEST-dgit-only-$_");
+    }
+}
+
 #---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:
@@ -442,8 +450,15 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit-distro.debian.git-path' => '/dgit/debian/repos',
               'dgit-distro.debian.git-check' => 'ssh-cmd',
  'dgit-distro.debian.archive-query-url', 'https://api.ftp-master.debian.org/',
- 'dgit-distro.debian.archive-query-tls-key',
-    '/etc/ssl/certs/%HOST%.pem:/etc/dgit/%HOST%.pem',
+# 'dgit-distro.debian.archive-query-tls-key',
+#    '/etc/ssl/certs/%HOST%.pem:/etc/dgit/%HOST%.pem',
+# ^ this does not work because curl is broken nowadays
+# Fixing #790093 properly will involve providing providing the key
+# in some pacagke and maybe updating these paths.
+#
+# 'dgit-distro.debian.archive-query-tls-curl-args',
+#   '--ca-path=/etc/ssl/ca-debian',
+# ^ this is a workaround but works (only) on DSA-administered machines
               'dgit-distro.debian.diverts.alioth' => '/alioth',
               'dgit-distro.debian/alioth.git-host' => 'git.debian.org',
               'dgit-distro.debian/alioth.git-user-force' => '',
@@ -667,23 +682,6 @@ sub parsechangelog {
     return $c;
 }
 
-sub git_get_ref ($) {
-    my ($refname) = @_;
-    my $got = cmdoutput_errok @git, qw(show-ref --), $refname;
-    if (!defined $got) {
-       $?==256 or fail "git show-ref failed (status $?)";
-       printdebug "ref $refname= [show-ref exited 1]\n";
-       return '';
-    }
-    if ($got =~ m/^(\w+) \Q$refname\E$/m) {
-       printdebug "ref $refname=$1\n";
-       return $1;
-    } else {
-       printdebug "ref $refname= [no match]\n";
-       return '';
-    }
-}
-
 sub must_getcwd () {
     my $d = getcwd();
     defined $d or fail "getcwd failed: $!";
@@ -715,16 +713,25 @@ sub archive_api_query_cmd ($) {
     my $url = access_cfg('archive-query-url');
     if ($url =~ m#^https://([-.0-9a-z]+)/#) {
        my $host = $1;
-       my $keys = access_cfg('archive-query-tls-key','RETURN-UNDEF');
+       my $keys = access_cfg('archive-query-tls-key','RETURN-UNDEF') //'';
        foreach my $key (split /\:/, $keys) {
            $key =~ s/\%HOST\%/$host/g;
            if (!stat $key) {
                fail "for $url: stat $key: $!" unless $!==ENOENT;
                next;
            }
-           push @cmd, "--ca-certificate=$key", "--ca-directory=/dev/enoent";
+           fail "config requested specific TLS key but do not know".
+               " how to get curl to use exactly that EE key ($key)";
+#          push @cmd, "--cacert", $key, "--capath", "/dev/enoent";
+#           # Sadly the above line does not work because of changes
+#           # to gnutls.   The real fix for #790093 may involve
+#           # new curl options.
            last;
        }
+       # Fixing #790093 properly will involve providing a value
+       # for this on clients.
+       my $kargs = access_cfg('archive-query-tls-curl-ca-args','RETURN-UNDEF');
+       push @cmd, split / /, $kargs if defined $kargs;
     }
     push @cmd, $url.$subpath;
     return @cmd;
@@ -1138,6 +1145,69 @@ sub clogp_authline ($) {
     return $authline;
 }
 
+sub vendor_patches_distro ($$) {
+    my ($checkdistro, $what) = @_;
+    return unless defined $checkdistro;
+
+    my $series = "debian/patches/\L$checkdistro\E.series";
+    printdebug "checking for vendor-specific $series ($what)\n";
+
+    if (!open SERIES, "<", $series) {
+       die "$series $!" unless $!==ENOENT;
+       return;
+    }
+    while (<SERIES>) {
+       next unless m/\S/;
+       next if m/^\s+\#/;
+
+       print STDERR <<END;
+
+Unfortunately, this source package uses a feature of dpkg-source where
+the same source package unpacks to different source code on different
+distros.  dgit cannot safely operate on such packages on affected
+distros, because the meaning of source packages is not stable.
+
+Please ask the distro/maintainer to remove the distro-specific series
+files and use a different technique (if necessary, uploading actually
+different packages, if different distros are supposed to have
+different code).
+
+END
+       fail "Found active distro-specific series file for".
+           " $checkdistro ($what): $series, cannot continue";
+    }
+    die "$series $!" if SERIES->error;
+    close SERIES;
+}
+
+sub check_for_vendor_patches () {
+    # This dpkg-source feature doesn't seem to be documented anywhere!
+    # But it can be found in the changelog (reformatted):
+
+    #   commit  4fa01b70df1dc4458daee306cfa1f987b69da58c
+    #   Author: Raphael Hertzog <hertzog@debian.org>
+    #   Date: Sun  Oct  3  09:36:48  2010 +0200
+
+    #   dpkg-source: correctly create .pc/.quilt_series with alternate
+    #   series files
+    #   
+    #   If you have debian/patches/ubuntu.series and you were
+    #   unpacking the source package on ubuntu, quilt was still
+    #   directed to debian/patches/series instead of
+    #   debian/patches/ubuntu.series.
+    #   
+    #   debian/changelog                        |    3 +++
+    #   scripts/Dpkg/Source/Package/V3/quilt.pm |    4 +++-
+    #   2 files changed, 6 insertions(+), 1 deletion(-)
+
+    use Dpkg::Vendor;
+    vendor_patches_distro($ENV{DEB_VENDOR}, "DEB_VENDOR");
+    vendor_patches_distro(Dpkg::Vendor::get_current_vendor(),
+                        "Dpkg::Vendor \`current vendor'");
+    vendor_patches_distro(access_basedistro(),
+                         "distro being accessed");
+}
+
 sub generate_commit_from_dsc () {
     prep_ud();
     changedir $ud;
@@ -1170,6 +1240,7 @@ sub generate_commit_from_dsc () {
     runcmd @cmd;
 
     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
+    check_for_vendor_patches() if madformat($dsc->{format});
     runcmd qw(sh -ec), 'dpkg-parsechangelog >../changelog.tmp';
     my $clogp = parsecontrol('../changelog.tmp',"commit's changelog");
     my $authline = clogp_authline $clogp;
@@ -1273,6 +1344,11 @@ sub ensure_we_have_orig () {
 
 sub git_fetch_us () {
     runcmd_ordryrun_local @git, qw(fetch),access_giturl(),fetchspec();
+    if (deliberately_not_fast_forward) {
+       runcmd_ordryrun_local @git, qw(fetch -p), access_giturl(),
+           map { "+refs/$_/*:".lrfetchrefs."/$_/*" }
+           qw(tags heads);
+    }
 }
 
 sub fetch_from_archive () {
@@ -1494,7 +1570,7 @@ sub push_parse_changelog ($) {
 
     $package = getfield $clogp, 'Source';
     my $cversion = getfield $clogp, 'Version';
-    my $tag = debiantag($cversion);
+    my $tag = debiantag($cversion, access_basedistro);
     runcmd @git, qw(check-ref-format), $tag;
 
     my $dscfn = dscfn($cversion);
@@ -1546,9 +1622,9 @@ tagger $authline
 $package release $cversion for $clogsuite ($csuite) [dgit]
 [dgit distro=$declaredistro$delibs]
 END
-    foreach my $ref (sort keys %supersedes) {
+    foreach my $ref (sort keys %previously) {
                    print TO <<END or die $!;
-[dgit supersede:$ref=$supersedes{$ref}]
+[dgit previously:$ref=$previously{$ref}]
 END
     }
 
@@ -1620,6 +1696,7 @@ sub dopush ($) {
     runcmd qw(dpkg-source -x --),
         $dscpath =~ m#^/# ? $dscpath : "../../../$dscpath";
     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
+    check_for_vendor_patches() if madformat($dsc->{format});
     changedir '../../../..';
     my $diffopt = $debuglevel>0 ? '--exit-code' : '--quiet';
     my @diffcmd = (@git, qw(diff), $diffopt, $tree);
@@ -1665,11 +1742,12 @@ sub dopush ($) {
     responder_send_command("param head $head");
     responder_send_command("param csuite $csuite");
 
-    if ($forceflag && defined $lastpush_hash) {
-       git_for_each_tag_referring($lastpush_hash, sub {
-           my ($objid,$refobjid,$fullrefname,$tagname) = @_;
-           responder_send_command("supersedes $fullrefname=$objid");
-           $supersedes{$fullrefname} = $objid;
+    if (deliberately_not_fast_forward) {
+       git_for_each_ref(lrfetchrefs, sub {
+           my ($objid,$objtype,$lrfetchrefname,$reftail) = @_;
+           my $rrefname= substr($lrfetchrefname, length(lrfetchrefs) + 1);
+           responder_send_command("previously $rrefname=$objid");
+           $previously{$rrefname} = $objid;
        });
     }
 
@@ -1696,7 +1774,7 @@ sub dopush ($) {
        create_remote_git_repo();
     }
     runcmd_ordryrun @git, qw(push),access_giturl(),
-        $forceflag."HEAD:".rrref(), "refs/tags/$tag";
+        $forceflag."HEAD:".rrref(), $forceflag."refs/tags/$tag";
     runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD';
 
     if ($we_are_responder) {
@@ -1819,10 +1897,12 @@ sub cmd_push {
     if ($new_package) {
        local ($package) = $existing_package; # this is a hack
        canonicalise_suite();
-    }
-    if (defined $specsuite && $specsuite ne $isuite) {
+    } else {
        canonicalise_suite();
-       $csuite eq $specsuite or
+    }
+    if (defined $specsuite &&
+       $specsuite ne $isuite &&
+       $specsuite ne $csuite) {
            fail "dgit push: changelog specifies $isuite ($csuite)".
                " but command line specifies $specsuite";
     }
@@ -1833,8 +1913,7 @@ sub cmd_push {
     if (fetch_from_archive()) {
        if (is_fast_fwd(lrref(), 'HEAD')) {
            # ok
-       } elsif (deliberately('not-fast-forward') ||
-                deliberately('TEST-not-fast-forward-dgit-only')) {
+       } elsif (deliberately_not_fast_forward) {
            $forceflag = '+';
        } else {
            fail "dgit push: HEAD is not a descendant".
@@ -1988,12 +2067,12 @@ sub i_resp_param ($) {
     $i_param{$1} = $2;
 }
 
-sub i_resp_supersedes ($) {
+sub i_resp_previously ($) {
     $_[0] =~ m#^(refs/tags/\S+)=(\w+)$#
-       or badproto \*RO, "bad supersedes spec";
+       or badproto \*RO, "bad previously spec";
     my $r = system qw(git check-ref-format), $1;
-    die "bad supersedes ref spec ($r)" if $r;
-    $supersedes{$1} = $2;
+    die "bad previously ref spec ($r)" if $r;
+    $previously{$1} = $2;
 }
 
 our %i_wanted;
@@ -2258,7 +2337,7 @@ sub quiltify ($$) {
            my $s = $abbrev->($notp);
            my $c = $notp->{Child};
            $s .= "..".$abbrev->($c) if $c;
-           $s .= ": ".$c->{Whynot};
+           $s .= ": ".$notp->{Whynot};
            return $s;
        };
        if ($quilt_mode eq 'linear') {
@@ -2342,6 +2421,8 @@ sub build_maybe_quilt_fixup () {
     return unless madformat $format;
     # sigh
 
+    check_for_vendor_patches();
+
     # Our objective is:
     #  - honour any existing .pc in case it has any strangeness
     #  - determine the git commit corresponding to the tip of
@@ -2466,7 +2547,7 @@ END
     commit_quilty_patch();
 
     if ($mustdeletepc) {
-        runcmd @git, qw(rm -rq .pc);
+        runcmd @git, qw(rm -rqf .pc);
         commit_admin "Commit removal of .pc (quilt series tracking data)";
     }
 
@@ -2549,17 +2630,35 @@ sub changesopts () {
     return @opts;
 }
 
+sub massage_dbp_args ($) {
+    my ($cmd) = @_;
+    return unless $cleanmode =~ m/git|none/;
+    debugcmd '#massaging#', @$cmd if $debuglevel>1;
+    my @newcmd = shift @$cmd;
+    # -nc has the side effect of specifying -b if nothing else specified
+    push @newcmd, '-nc';
+    # and some combinations of -S, -b, et al, are errors, rather than
+    # later simply overriding earlier
+    push @newcmd, '-F' unless grep { m/^-[bBASF]$/ } @$cmd;
+    push @newcmd, @$cmd;
+    @$cmd = @newcmd;
+}
+
 sub cmd_build {
     build_prep();
-    runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc), changesopts(), @ARGV;
+    my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts(), @ARGV);
+    massage_dbp_args \@dbp;
+    runcmd_ordryrun_local @dbp;
     printdone "build successful\n";
 }
 
 sub cmd_git_build {
     build_prep();
+    my @dbp = @dpkgbuildpackage;
+    massage_dbp_args \@dbp;
     my @cmd =
        (qw(git-buildpackage -us -uc --git-no-sign-tags),
-        "--git-builder=@dpkgbuildpackage");
+        "--git-builder=@dbp");
     unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) {
        canonicalise_suite();
        push @cmd, "--git-debian-branch=".lbranch();
@@ -2640,6 +2739,15 @@ sub cmd_archive_api_query {
     exec @cmd or fail "exec curl: $!\n";
 }
 
+sub cmd_clone_dgit_repos_server {
+    badusage "need destination argument" unless @ARGV==1;
+    my ($destdir) = @ARGV;
+    $package = '_dgit-repos-server';
+    my @cmd = (@git, qw(clone), access_giturl(), $destdir);
+    debugcmd ">",@cmd;
+    exec @cmd or fail "exec git clone: $!\n";
+}
+
 #---------- argument parsing and main program ----------
 
 sub cmd_version {