diff options
Diffstat (limited to 'dgit')
| -rwxr-xr-x | dgit | 183 |
1 files changed, 140 insertions, 43 deletions
@@ -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 ---------- @@ -1975,12 +2008,12 @@ END if ($found_same) { # in archive, delete from .changes if it's there $changed{$file} = "removed" if - $changes->{$fname} =~ s/^.* \Q$file\E$(?:)\n//m; - } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)\n/m) { + $changes->{$fname} =~ s/\n.* \Q$file\E$(?:)$//m; + } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)$/m) { # not in archive, but it's here in the .changes } else { my $dsc_data = getfield $dsc, $fname; - $dsc_data =~ m/^(.* \Q$file\E$)\n/m or die "$dsc_data $file ?"; + $dsc_data =~ m/^(.* \Q$file\E$)$/m or die "$dsc_data $file ?"; my $extra = $1; $extra =~ s/ \d+ /$&$placementinfo / or die "$fname $extra >$dsc_data< ?" @@ -2851,15 +2884,14 @@ sub mergeinfo_version ($) { sub fetch_from_archive_record_1 ($) { my ($hash) = @_; - runcmd @git, qw(update-ref -m), "dgit fetch $csuite", - 'DGIT_ARCHIVE', $hash; + runcmd git_update_ref_cmd "dgit fetch $csuite", 'DGIT_ARCHIVE', $hash; cmdoutput @git, qw(log -n2), $hash; # ... gives git a chance to complain if our commit is malformed } sub fetch_from_archive_record_2 ($) { my ($hash) = @_; - my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash); + my @upd_cmd = (git_update_ref_cmd 'dgit fetch', lrref(), $hash); if (act_local()) { cmdoutput @upd_cmd; } else { @@ -3558,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 @@ -3716,7 +3748,7 @@ sub clone ($) { clone_finish($dstdir); } -sub fetch () { +sub fetch_one () { canonicalise_suite(); if (check_for_git()) { git_fetch_us(); @@ -3739,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"; @@ -3776,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}++; } } @@ -3850,7 +3886,7 @@ sub maybe_split_brain_save ($$$) { # => message fragment "$saved" describing disposition of $dgitview return "commit id $dgitview" unless defined $split_brain_save; my @cmd = (shell_cmd 'cd "$1"; shift', $maindir, - @git, qw(update-ref -m), + git_update_ref_cmd "dgit --dgit-view-save $msg HEAD=$headref", $split_brain_save, $dgitview); runcmd @cmd; @@ -4014,10 +4050,12 @@ sub splitbrain_pseudomerge ($$$$) { infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]); 1; }) { + $@ =~ s/^\n//; chomp $@; print STDERR <<END; -$us: check failed (maybe --overwrite is needed, consult documentation) +$@ +| Not fast forward; maybe --overwrite is needed, see dgit(1) END - die "$@"; + finish -1; } my $r = pseudomerge_make_commit @@ -4050,7 +4088,7 @@ sub plain_overwrite_pseudomerge ($$$) { $clogp, $head, $archive_hash, $i_arch_v, "dgit", $m; - runcmd @git, qw(update-ref -m), $m, 'HEAD', $r, $head; + runcmd git_update_ref_cmd $m, 'HEAD', $r, $head; progress "Make pseudo-merge of $i_arch_v->[0] into your HEAD."; return $r; @@ -4413,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) @@ -4496,7 +4557,7 @@ END runcmd_ordryrun @git, qw(-c push.followTags=false push), access_giturl(), @pushrefs; - runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead; + runcmd_ordryrun git_update_ref_cmd 'dgit push', lrref(), $dgithead; supplementary_message(<<'END'); Push failed, while obtaining signatures on the .changes and .dsc. @@ -4596,11 +4657,15 @@ sub branchsuite () { } } -sub fetchpullargs () { +sub package_from_d_control () { if (!defined $package) { my $sourcep = parsecontrol('debian/control','debian/control'); $package = getfield $sourcep, 'Source'; } +} + +sub fetchpullargs () { + package_from_d_control(); if (@ARGV==0) { $isuite = branchsuite(); if (!$isuite) { @@ -4619,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 { @@ -4636,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/^-/) { @@ -4653,11 +4750,10 @@ sub cmd_update_vcs_git () { } } - my $sourcep = parsecontrol 'debian/control', 'debian/control'; - $package = getfield $sourcep, 'Source'; + package_from_d_control(); my $ctrl; if ($specsuite eq '.') { - $ctrl = $sourcep; + $ctrl = parsecontrol 'debian/control', 'debian/control'; } else { $isuite = $specsuite; get_archive_dsc(); @@ -5222,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 <<END Commit patch to update .gitignore @@ -5399,7 +5495,8 @@ sub quiltify ($$$$) { print STDERR "$us: ", $reportnot->($notp), "\n"; } print STDERR "$us: $_\n" foreach @$failsuggestion; - fail "quilt fixup naive history linearisation failed.\n". + fail + "quilt history linearisation failed. Search \`quilt fixup' in dgit(7).\n". "Use dpkg-source --commit by hand; or, --quilt=smash for one ugly patch"; } elsif ($quilt_mode eq 'smash') { } elsif ($quilt_mode eq 'auto') { @@ -6437,7 +6534,7 @@ sub cmd_quilt_fixup { sub import_dsc_result { my ($dstref, $newhash, $what_log, $what_msg) = @_; - my @cmd = (@git, qw(update-ref -m), $what_log, $dstref, $newhash); + my @cmd = (git_update_ref_cmd $what_log, $dstref, $newhash); runcmd @cmd; check_gitattrs($newhash, "source tree"); |