X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=0d36361f2609a4d18f40e6e873c9ba262337202a;hp=404eab9620edd61190668285164899d0010ad960;hb=efc587b04a40fb84004690694004ec4641bb82dd;hpb=d561b2284c6e988d70794c9871d44c3bb5f0463f diff --git a/dgit b/dgit index 404eab96..0d36361f 100755 --- 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 () { - 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 () { + 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; + !!; + }; +} + #---------- `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 ---------- @@ -3557,7 +3590,7 @@ sub fork_for_multisuite ($) { my $csubsuite = multisuite_suite_child($tsuite, \@mergeinputs, sub { @end = (); - fetch(); + fetch_one(); finish 0; }); # xxx collecte the ref here @@ -3715,7 +3748,7 @@ sub clone ($) { clone_finish($dstdir); } -sub fetch () { +sub fetch_one () { canonicalise_suite(); if (check_for_git()) { git_fetch_us(); @@ -3738,10 +3771,14 @@ END printdone "fetched into ".lrref(); } -sub pull () { +sub dofetch () { my $multi_fetched = fork_for_multisuite(sub { }); - fetch() unless $multi_fetched; # parent - return if $multi_fetched eq '0'; # child + fetch_one() unless $multi_fetched; # parent + finish 0 if $multi_fetched eq '0'; # child +} + +sub pull () { + dofetch(); runcmd_ordryrun_local @git, qw(merge -m),"Merge from $csuite [dgit]", lrref(); printdone "fetched to ".lrref()." and merged into HEAD"; @@ -3775,11 +3812,11 @@ sub quiltify_nofix_bail ($$) { } sub commit_quilty_patch () { - my $output = cmdoutput @git, qw(status --porcelain); + my $output = cmdoutput @git, qw(status --ignored --porcelain); my %adds; foreach my $l (split /\n/, $output) { next unless $l =~ m/\S/; - if ($l =~ m{^(?:\?\?| [MADRC]) (.pc|debian/patches)}) { + if ($l =~ m{^(?:[?!][?!]| [MADRC]) (.pc|debian/patches)}) { $adds{$1}++; } } @@ -4414,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) @@ -4624,9 +4684,7 @@ sub fetchpullargs () { sub cmd_fetch { parseopts(); fetchpullargs(); - my $multi_fetched = fork_for_multisuite(sub { }); - finish 0 if $multi_fetched; - fetch(); + dofetch(); } sub cmd_pull { @@ -4641,6 +4699,40 @@ END pull(); } +sub cmd_checkout { + parseopts(); + package_from_d_control(); + @ARGV==1 or badusage "dgit checkout needs a suite argument"; + ($isuite) = @ARGV; + notpushing(); + + foreach my $canon (qw(0 1)) { + if (!$canon) { + $csuite= $isuite; + } else { + undef $csuite; + canonicalise_suite(); + } + if (length git_get_ref lref()) { + # local branch already exists, yay + last; + } + if (!length git_get_ref lrref()) { + if (!$canon) { + # nope + next; + } + dofetch(); + } + # now lrref exists + runcmd (@git, qw(update-ref), lref(), lrref(), ''); + last; + } + local $ENV{GIT_REFLOG_ACTION} = git_reflog_action_msg + "dgit checkout $isuite"; + runcmd (@git, qw(checkout), lbranch()); +} + sub cmd_update_vcs_git () { my $specsuite; if (@ARGV==0 || $ARGV[0] =~ m/^-/) { @@ -5226,7 +5318,7 @@ END print SERIES "\n" or die $! unless $newline eq "\n"; print SERIES "auto-gitignore\n" or die $!; close SERIES or die $!; - runcmd @git, qw(add -- debian/patches/series), $gipatch; + runcmd @git, qw(add -f -- debian/patches/series), $gipatch; commit_admin <