changelog: finalise 5.7

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 00da67d7ed6af8988d265ee039bbe0d62cfd45d9..3a737d0b0bbd607dc002542fdd9f582bf14edfaa 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -90,6 +90,7 @@ our $chase_dsc_distro=1;
 our %forceopts = map { $_=>0 }
     qw(unrepresentable unsupported-source-format
        dsc-changes-mismatch changes-origs-exactly
+       uploading-binaries uploading-source-only
        import-gitapply-absurd
        import-gitapply-no-absurd
        import-dsc-with-dgit-field);
@@ -614,6 +615,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit.default.sshpsql-dbname' => 'service=projectb',
               'dgit.default.aptget-components' => 'main',
               'dgit.default.dgit-tag-format' => 'new,old,maint',
+              'dgit.default.source-only-uploads' => 'ok',
               'dgit.dsc-url-proto-ok.http'    => 'true',
               'dgit.dsc-url-proto-ok.https'   => 'true',
               'dgit.dsc-url-proto-ok.git'     => 'true',
@@ -628,6 +630,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit-distro.debian.git-check' => 'url',
               'dgit-distro.debian.git-check-suffix' => '/info/refs',
               'dgit-distro.debian.new-private-pushers' => 't',
+              'dgit-distro.debian.source-only-uploads' => 'not-wholly-new',
               'dgit-distro.debian/push.git-url' => '',
               'dgit-distro.debian/push.git-host' => 'push.dgit.debian.org',
               'dgit-distro.debian/push.git-user-force' => 'dgit',
@@ -1179,6 +1182,12 @@ sub file_in_archive_ftpmasterapi {
     my $info = api_query($data, "file_in_archive/$pat", 1);
 }
 
+sub package_not_wholly_new_ftpmasterapi {
+    my ($proto,$data,$pkg) = @_;
+    my $info = api_query($data,"madison?package=${pkg}&f=json");
+    return !!@$info;
+}
+
 #---------- `aptget' archive query method ----------
 
 our $aptget_base;
@@ -1342,34 +1351,55 @@ sub archive_query_aptget {
 }
 
 sub file_in_archive_aptget () { return undef; }
+sub package_not_wholly_new_aptget () { return undef; }
 
 #---------- `dummyapicat' archive query method ----------
 
 sub archive_query_dummycatapi { archive_query_ftpmasterapi @_; }
 sub canonicalise_suite_dummycatapi { canonicalise_suite_ftpmasterapi @_; }
 
-sub file_in_archive_dummycatapi ($$$) {
-    my ($proto,$data,$filename) = @_;
+sub dummycatapi_run_in_mirror ($@) {
+    # runs $fn with FIA open onto rune
+    my ($rune, $argl, $fn) = @_;
+
     my $mirror = access_cfg('mirror');
     $mirror =~ s#^file://#/# or die "$mirror ?";
-    my @out;
-    my @cmd = (qw(sh -ec), '
-            cd "$1"
-            find -name "$2" -print0 |
-            xargs -0r sha256sum
-        ', qw(x), $mirror, $filename);
+    my @cmd = (qw(sh -ec), 'cd "$1"; shift'."\n".$rune,
+              qw(x), $mirror, @$argl);
     debugcmd "-|", @cmd;
     open FIA, "-|", @cmd or die $!;
-    while (<FIA>) {
-       chomp or die;
-       printdebug "| $_\n";
-       m/^(\w+)  (\S+)$/ or die "$_ ?";
-       push @out, { sha256sum => $1, filename => $2 };
-    }
-    close FIA or die failedcmd @cmd;
+    my $r = $fn->();
+    close FIA or ($!==0 && $?==141) or die failedcmd @cmd;
+    return $r;
+}
+
+sub file_in_archive_dummycatapi ($$$) {
+    my ($proto,$data,$filename) = @_;
+    my @out;
+    dummycatapi_run_in_mirror '
+            find -name "$1" -print0 |
+            xargs -0r sha256sum
+    ', [$filename], sub {
+       while (<FIA>) {
+           chomp or die;
+           printdebug "| $_\n";
+           m/^(\w+)  (\S+)$/ or die "$_ ?";
+           push @out, { sha256sum => $1, filename => $2 };
+       }
+    };
     return \@out;
 }
 
+sub package_not_wholly_new_dummycatapi {
+    my ($proto,$data,$pkg) = @_;
+    dummycatapi_run_in_mirror "
+            find -name ${pkg}_*.dsc
+    ", [], sub {
+       local $/ = undef;
+       !!<FIA>;
+    };
+}
+
 #---------- `madison' archive query method ----------
 
 sub archive_query_madison {
@@ -1420,6 +1450,7 @@ sub canonicalise_suite_madison {
 }
 
 sub file_in_archive_madison { return undef; }
+sub package_not_wholly_new_madison { return undef; }
 
 #---------- `sshpsql' archive query method ----------
 
@@ -1497,6 +1528,7 @@ END
 }
 
 sub file_in_archive_sshpsql ($$$) { return undef; }
+sub package_not_wholly_new_sshpsql ($$$) { return undef; }
 
 #---------- `dummycat' archive query method ----------
 
@@ -1541,6 +1573,7 @@ sub archive_query_dummycat ($$) {
 }
 
 sub file_in_archive_dummycat () { return undef; }
+sub package_not_wholly_new_dummycat () { return undef; }
 
 #---------- tag format handling ----------
 
@@ -4418,6 +4451,29 @@ END
     files_compare_inputs($dsc, $changes)
        unless forceing [qw(dsc-changes-mismatch)];
 
+    # Check whether this is a source only upload
+    my $hasdebs = $changes->{Files} =~ m{\.deb$}m;
+    my $sourceonlypolicy = access_cfg 'source-only-uploads';
+    if ($sourceonlypolicy eq 'ok') {
+    } elsif ($sourceonlypolicy eq 'always') {
+       forceable_fail [qw(uploading-binaries)],
+           "uploading binaries, although distroy policy is source only"
+           if $hasdebs;
+    } elsif ($sourceonlypolicy eq 'never') {
+       forceable_fail [qw(uploading-source-only)],
+           "source-only upload, although distroy policy requires .debs"
+           if !$hasdebs;
+    } elsif ($sourceonlypolicy eq 'not-wholly-new') {
+       forceable_fail [qw(uploading-source-only)],
+           "source-only upload, even though package is entirely NEW\n".
+           "(this is contrary to policy in ".(access_nomdistro()).")"
+           if !$hasdebs
+           && $new_package
+           && !(archive_query('package_not_wholly_new', $package) // 1);
+    } else {
+       badcfg "unknown source-only-uploads policy \`$sourceonlypolicy'";
+    }
+
     # Perhaps adjust .dsc to contain right set of origs
     changes_update_origs_from_dsc($dsc, $changes, $upstreamversion,
                                  $changesfile)