X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=11ca5f53bcbe3f02b2dfda4d2b5edf6a55aaca8e;hp=368d764cb91dd8badbac63bafbc693485e25b97c;hb=e28f906f107c69d18d68f47538077c868cc1e77c;hpb=e61ace88409a7b6672a7589336dee8163fb5a216 diff --git a/dgit b/dgit index 368d764c..11ca5f53 100755 --- a/dgit +++ b/dgit @@ -2,7 +2,7 @@ # dgit # Integration between git and Debian-style archives # -# Copyright (C)2013-2015 Ian Jackson +# Copyright (C)2013-2016 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 @@ -41,6 +41,7 @@ use Carp; use Debian::Dgit; our $our_version = 'UNRELEASED'; ###substituted### +our $absurdity = undef; ###substituted### our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format our $protovsn; @@ -66,6 +67,7 @@ our $rmchanges; our $overwrite_version; # undef: not specified; '': check changelog our $quilt_mode; our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|dpm|unapplied'; +our $split_brain_save; our $we_are_responder; our $initiator_tempdir; our $patches_applied_dirtily = 00; @@ -73,6 +75,13 @@ our $tagformat_want; our $tagformat; our $tagformatfn; +our %forceopts = map { $_=>0 } + qw(unrepresentable unsupported-source-format + dsc-changes-mismatch changes-origs-exactly + import-gitapply-absurd + import-gitapply-no-absurd + import-dsc-with-dgit-field); + our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)"); our $suite_re = '[-+.0-9a-z]+'; @@ -86,7 +95,7 @@ our $splitbraincache = 'dgit-intern/quilt-cache'; our (@git) = qw(git); our (@dget) = qw(dget); -our (@curl) = qw(curl -f); +our (@curl) = qw(curl); our (@dput) = qw(dput); our (@debsign) = qw(debsign); our (@gpg) = qw(gpg); @@ -97,7 +106,8 @@ our (@dpkgbuildpackage) = qw(dpkg-buildpackage -i\.git/ -I.git); our (@dpkgsource) = qw(dpkg-source -i\.git/ -I.git); our (@dpkggenchanges) = qw(dpkg-genchanges); our (@mergechanges) = qw(mergechanges -f); -our (@gbp) = qw(gbp); +our (@gbp_build) = (''); +our (@gbp_pq) = ('gbp pq'); our (@changesopts) = (''); our %opts_opt_map = ('dget' => \@dget, # accept for compatibility @@ -112,7 +122,8 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility 'dpkg-source' => \@dpkgsource, 'dpkg-buildpackage' => \@dpkgbuildpackage, 'dpkg-genchanges' => \@dpkggenchanges, - 'gbp' => \@gbp, + 'gbp-build' => \@gbp_build, + 'gbp-pq' => \@gbp_pq, 'ch' => \@changesopts, 'mergechanges' => \@mergechanges); @@ -142,6 +153,11 @@ our @ourdscfield = qw(Dgit Vcs-Dgit-Master); our $csuite; our $instead_distro; +if (!defined $absurdity) { + $absurdity = $0; + $absurdity =~ s{/[^/]+$}{/absurd} or die; +} + sub debiantag ($$) { my ($v,$distro) = @_; return $tagformatfn->($v, $distro); @@ -206,6 +222,12 @@ sub changespat ($;$) { return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes"; } +sub upstreamversion ($) { + my ($vsn) = @_; + $vsn =~ s/-[^-]+$//; + return $vsn; +} + our $us = 'dgit'; initdebug(''); @@ -220,6 +242,20 @@ END { sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; } +sub forceable_fail ($$) { + my ($forceoptsl, $msg) = @_; + fail $msg unless grep { $forceopts{$_} } @$forceoptsl; + print STDERR "warning: overriding problem due to --force:\n". $msg; +} + +sub forceing ($) { + my ($forceoptsl) = @_; + my @got = grep { $forceopts{$_} } @$forceoptsl; + return 0 unless @got; + print STDERR + "warning: skipping checks or functionality due to --force-$got[0]\n"; +} + sub no_such_package () { print STDERR "$us: package $package does not exist in suite $isuite\n"; exit 4; @@ -246,6 +282,17 @@ sub quiltmode_splitbrain () { $quilt_mode =~ m/gbp|dpm|unapplied/; } +sub opts_opt_multi_cmd { + my @cmd; + push @cmd, split /\s+/, shift @_; + push @cmd, @_; + @cmd; +} + +sub gbp_pq { + return opts_opt_multi_cmd @gbp_pq; +} + #---------- remote protocol support, common ---------- # remote push initiator/responder protocol: @@ -538,7 +585,7 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit.default.ssh' => 'ssh', 'dgit.default.archive-query' => 'madison:', 'dgit.default.sshpsql-dbname' => 'service=projectb', - 'dgit.default.dgit-tag-format' => 'old,new,maint', + 'dgit.default.dgit-tag-format' => 'new,old,maint', # old means "repo server accepts pushes with old dgit tags" # new means "repo server accepts pushes with new dgit tags" # maint means "repo server accepts split brain pushes" @@ -548,7 +595,6 @@ 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.dgit-tag-format' => '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', @@ -581,42 +627,55 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit-distro.test-dummy.git-url' => "$td/git", 'dgit-distro.test-dummy.git-host' => "git", 'dgit-distro.test-dummy.git-path' => "$td/git", - 'dgit-distro.test-dummy.archive-query' => "ftpmasterapi:", + 'dgit-distro.test-dummy.archive-query' => "dummycatapi:", 'dgit-distro.test-dummy.archive-query-url' => "file://$td/aq/", 'dgit-distro.test-dummy.mirror' => "file://$td/mirror/", 'dgit-distro.test-dummy.upload-host' => 'test-dummy', ); -our %gitcfg; +our %gitcfgs; +our @gitcfgsources = qw(cmdline local global system); sub git_slurp_config () { local ($debuglevel) = $debuglevel-2; local $/="\0"; - my @cmd = (@git, qw(config -z --get-regexp .*)); - debugcmd "|",@cmd; - - open GITS, "-|", @cmd or die $!; - while () { - chomp or die; - printdebug "=> ", (messagequote $_), "\n"; - m/\n/ or die "$_ ?"; - push @{ $gitcfg{$`} }, $'; #'; + # This algoritm is a bit subtle, but this is needed so that for + # options which we want to be single-valued, we allow the + # different config sources to override properly. See #835858. + foreach my $src (@gitcfgsources) { + next if $src eq 'cmdline'; + # we do this ourselves since git doesn't handle it + + my @cmd = (@git, qw(config -z --get-regexp), "--$src", qw(.*)); + debugcmd "|",@cmd; + + open GITS, "-|", @cmd or die $!; + while () { + chomp or die; + printdebug "=> ", (messagequote $_), "\n"; + m/\n/ or die "$_ ?"; + push @{ $gitcfgs{$src}{$`} }, $'; #'; + } + $!=0; $?=0; + close GITS + or ($!==0 && $?==256) + or failedcmd @cmd; } - $!=0; $?=0; - close GITS - or ($!==0 && $?==256) - or failedcmd @cmd; } sub git_get_config ($) { my ($c) = @_; - my $l = $gitcfg{$c}; - printdebug"C $c ".(defined $l ? messagequote "'$l'" : "undef")."\n" - if $debuglevel >= 4; - $l or return undef; - @$l==1 or badcfg "multiple values for $c" if @$l > 1; - return $l->[0]; + foreach my $src (@gitcfgsources) { + my $l = $gitcfgs{$src}{$c}; + printdebug"C $c ".(defined $l ? messagequote "'$l'" : "undef")."\n" + if $debuglevel >= 4; + $l or next; + @$l==1 or badcfg "multiple values for $c". + " (in $src git config)" if @$l > 1; + return $l->[0]; + } + return undef; } sub cfg { @@ -864,10 +923,10 @@ sub parsecontrolfh ($$;$) { } sub parsecontrol { - my ($file, $desc) = @_; + my ($file, $desc, $allowsigned) = @_; my $fh = new IO::Handle; open $fh, '<', $file or die "$file: $!"; - my $c = parsecontrolfh($fh,$desc); + my $c = parsecontrolfh($fh,$desc,$allowsigned); $fh->error and die $!; close $fh; return $c; @@ -909,15 +968,27 @@ sub must_getcwd () { return $d; } +sub parse_dscdata () { + my $dscfh = new IO::File \$dscdata, '<' or die $!; + printdebug Dumper($dscdata) if $debuglevel>1; + $dsc = parsecontrolfh($dscfh,$dscurl,1); + printdebug Dumper($dsc) if $debuglevel>1; +} + our %rmad; -sub archive_query ($) { - my ($method) = @_; +sub archive_query ($;@) { + my ($method) = shift @_; my $query = access_cfg('archive-query','RETURN-UNDEF'); $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'"; my $proto = $1; my $data = $'; #'; - { no strict qw(refs); &{"${method}_${proto}"}($proto,$data); } + { no strict qw(refs); &{"${method}_${proto}"}($proto,$data,@_); } +} + +sub archive_query_prepend_mirror { + my $m = access_cfg('mirror'); + return map { [ $_->[0], $m.$_->[1], @$_[2..$#$_] ] } @_; } sub pool_dsc_subpath ($$) { @@ -930,7 +1001,7 @@ sub pool_dsc_subpath ($$) { sub archive_api_query_cmd ($) { my ($subpath) = @_; - my @cmd = qw(curl -sS); + my @cmd = (@curl, qw(-sS)); my $url = access_cfg('archive-query-url'); if ($url =~ m#^https://([-.0-9a-z]+)/#) { my $host = $1; @@ -958,17 +1029,27 @@ sub archive_api_query_cmd ($) { return @cmd; } -sub api_query ($$) { +sub api_query ($$;$) { use JSON; - my ($data, $subpath) = @_; + my ($data, $subpath, $ok404) = @_; badcfg "ftpmasterapi archive query method takes no data part" if length $data; my @cmd = archive_api_query_cmd($subpath); + my $url = $cmd[$#cmd]; + push @cmd, qw(-w %{http_code}); my $json = cmdoutput @cmd; + unless ($json =~ s/\d+\d+\d$//) { + failedcmd_report_cmd undef, @cmd; + fail "curl failed to print 3-digit HTTP code"; + } + my $code = $&; + return undef if $code eq '404' && $ok404; + fail "fetch of $url gave HTTP code $code" + unless $url =~ m#^file://# or $code =~ m/^2/; return decode_json($json); } -sub canonicalise_suite_ftpmasterapi () { +sub canonicalise_suite_ftpmasterapi { my ($proto,$data) = @_; my $suites = api_query($data, 'suites'); my @matched; @@ -992,7 +1073,7 @@ sub canonicalise_suite_ftpmasterapi () { return $cn; } -sub archive_query_ftpmasterapi () { +sub archive_query_ftpmasterapi { my ($proto,$data) = @_; my $info = api_query($data, "dsc_in_suite/$isuite/$package"); my @rows; @@ -1016,13 +1097,50 @@ sub archive_query_ftpmasterapi () { if length $@; } @rows = sort { -version_compare($a->[0],$b->[0]) } @rows; - return @rows; + return archive_query_prepend_mirror @rows; +} + +sub file_in_archive_ftpmasterapi { + my ($proto,$data,$filename) = @_; + my $pat = $filename; + $pat =~ s/_/\\_/g; + $pat = "%/$pat"; + $pat =~ s#[^-+_.0-9a-z/]# sprintf '%%%02x', ord $& #ge; + my $info = api_query($data, "file_in_archive/$pat", 1); +} + +#---------- `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) = @_; + 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); + 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; + return \@out; } #---------- `madison' archive query method ---------- sub archive_query_madison { - return map { [ @$_[0..1] ] } madison_get_parse(@_); + return archive_query_prepend_mirror + map { [ @$_[0..1] ] } madison_get_parse(@_); } sub madison_get_parse { @@ -1067,6 +1185,8 @@ sub canonicalise_suite_madison { return $r[0][2]; } +sub file_in_archive_madison { return undef; } + #---------- `sshpsql' archive query method ---------- sub sshpsql ($$$) { @@ -1126,7 +1246,7 @@ END my ($vsn,$component,$filename,$sha256sum) = @$_; [ $vsn, "/pool/$component/$filename",$digester,$sha256sum ]; } @rows; - return @rows; + return archive_query_prepend_mirror @rows; } sub canonicalise_suite_sshpsql ($$) { @@ -1142,6 +1262,8 @@ END return $rows[0]; } +sub file_in_archive_sshpsql ($$$) { return undef; } + #---------- `dummycat' archive query method ---------- sub canonicalise_suite_dummycat ($$) { @@ -1180,9 +1302,12 @@ sub archive_query_dummycat ($$) { } C->error and die "$dpath: $!"; close C; - return sort { -version_compare($a->[0],$b->[0]); } @rows; + return archive_query_prepend_mirror + sort { -version_compare($a->[0],$b->[0]); } @rows; } +sub file_in_archive_dummycat () { return undef; } + #---------- tag format handling ---------- sub access_cfg_tagformats () { @@ -1240,8 +1365,8 @@ sub get_archive_dsc () { canonicalise_suite(); my @vsns = archive_query('archive_query'); foreach my $vinfo (@vsns) { - my ($vsn,$subpath,$digester,$digest) = @$vinfo; - $dscurl = access_cfg('mirror').$subpath; + my ($vsn,$vsn_dscurl,$digester,$digest) = @$vinfo; + $dscurl = $vsn_dscurl; $dscdata = url_get($dscurl); if (!$dscdata) { $skew_warning_vsn = $vsn if !defined $skew_warning_vsn; @@ -1255,12 +1380,11 @@ sub get_archive_dsc () { fail "$dscurl has hash $got but". " archive told us to expect $digest"; } - my $dscfh = new IO::File \$dscdata, '<' or die $!; - printdebug Dumper($dscdata) if $debuglevel>1; - $dsc = parsecontrolfh($dscfh,$dscurl,1); - printdebug Dumper($dsc) if $debuglevel>1; + parse_dscdata(); my $fmt = getfield $dsc, 'Format'; - fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt}; + $format_ok{$fmt} or forceable_fail [qw(unsupported-source-format)], + "unsupported source format $fmt, sorry"; + $dsc_checked = !!$digester; printdebug "get_archive_dsc: Version ".(getfield $dsc, 'Version')."\n"; return; @@ -1296,7 +1420,7 @@ sub check_for_git () { my $suffix = access_cfg('git-check-suffix','git-suffix', 'RETURN-UNDEF') // '.git'; my $url = "$prefix/$package$suffix"; - my @cmd = (qw(curl -sS -I), $url); + my @cmd = (@curl, qw(-sS -I), $url); my $result = cmdoutput @cmd; $result =~ s/^\S+ 200 .*\n\r?\n//; # curl -sS -I with https_proxy prints @@ -1401,10 +1525,13 @@ sub mktree_in_ud_from_only_subdir (;$) { return ($tree,$dir); } +our @files_csum_info_fields = + (['Checksums-Sha256','Digest::SHA', 'new(256)', 'sha256sum'], + ['Checksums-Sha1', 'Digest::SHA', 'new(1)', 'sha1sum'], + ['Files', 'Digest::MD5', 'new()', 'md5sum']); + sub dsc_files_info () { - foreach my $csumi (['Checksums-Sha256','Digest::SHA', 'new(256)'], - ['Checksums-Sha1', 'Digest::SHA', 'new(1)'], - ['Files', 'Digest::MD5', 'new()']) { + foreach my $csumi (@files_csum_info_fields) { my ($fname, $module, $method) = @$csumi; my $field = $dsc->{$fname}; next unless defined $field; @@ -1432,6 +1559,65 @@ sub dsc_files () { map { $_->{Filename} } dsc_files_info(); } +sub files_compare_inputs (@) { + my $inputs = \@_; + my %record; + my %fchecked; + + my $showinputs = sub { + return join "; ", map { $_->get_option('name') } @$inputs; + }; + + foreach my $in (@$inputs) { + my $expected_files; + my $in_name = $in->get_option('name'); + + printdebug "files_compare_inputs $in_name\n"; + + foreach my $csumi (@files_csum_info_fields) { + my ($fname) = @$csumi; + printdebug "files_compare_inputs $in_name $fname\n"; + + my $field = $in->{$fname}; + next unless defined $field; + + my @files; + foreach (split /\n/, $field) { + next unless m/\S/; + + my ($info, $f) = m/^(\w+ \d+) (?:\S+ \S+ )?(\S+)$/ or + fail "could not parse $in_name $fname line \`$_'"; + + printdebug "files_compare_inputs $in_name $fname $f\n"; + + push @files, $f; + + my $re = \ $record{$f}{$fname}; + if (defined $$re) { + $fchecked{$f}{$in_name} = 1; + $$re eq $info or + fail "hash or size of $f varies in $fname fields". + " (between: ".$showinputs->().")"; + } else { + $$re = $info; + } + } + @files = sort @files; + $expected_files //= \@files; + "@$expected_files" eq "@files" or + fail "file list in $in_name varies between hash fields!"; + } + $expected_files or + fail "$in_name has no files list field(s)"; + } + printdebug "files_compare_inputs ".Dumper(\%fchecked, \%record) + if $debuglevel>=2; + + grep { keys %$_ == @$inputs-1 } values %fchecked + or fail "no file appears in all file lists". + " (looked in: ".$showinputs->().")"; +} + sub is_orig_file_in_dsc ($$) { my ($f, $dsc_files_info) = @_; return 0 if @$dsc_files_info <= 1; @@ -1448,6 +1634,101 @@ sub is_orig_file_of_vsn ($$) { return 1; } +sub changes_update_origs_from_dsc ($$$$) { + my ($dsc, $changes, $upstreamvsn, $changesfile) = @_; + my %changes_f; + printdebug "checking origs needed ($upstreamvsn)...\n"; + $_ = getfield $changes, 'Files'; + m/^\w+ \d+ (\S+ \S+) \S+$/m or + fail "cannot find section/priority from .changes Files field"; + my $placementinfo = $1; + my %changed; + printdebug "checking origs needed placement '$placementinfo'...\n"; + foreach my $l (split /\n/, getfield $dsc, 'Files') { + $l =~ m/\S+$/ or next; + my $file = $&; + printdebug "origs $file | $l\n"; + next unless is_orig_file_of_vsn $file, $upstreamvsn; + printdebug "origs $file is_orig\n"; + my $have = archive_query('file_in_archive', $file); + if (!defined $have) { + print STDERR <{$archivefield}; + $_ = $dsc->{$fname}; + next unless defined; + m/^(\w+) .* \Q$file\E$/m or + fail ".dsc $fname missing entry for $file"; + if ($h->{$archivefield} eq $1) { + $same++; + } else { + push @differ, + "$archivefield: $h->{$archivefield} (archive) != $1 (local .dsc)"; + } + } + die "$file ".Dumper($h)." ?!" if $same && @differ; + $found_same++ + if $same; + push @found_differ, "archive $h->{filename}: ".join "; ", @differ + if @differ; + } + print "origs $file f.same=$found_same #f._differ=$#found_differ\n"; + if (@found_differ && !$found_same) { + fail join "\n", + "archive contains $file with different checksum", + @found_differ; + } + # Now we edit the changes file to add or remove it + foreach my $csumi (@files_csum_info_fields) { + my ($fname, $module, $method, $archivefield) = @$csumi; + next unless defined $changes->{$fname}; + 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) { + # 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 ?"; + my $extra = $1; + $extra =~ s/ \d+ /$&$placementinfo / + or die "$fname $extra >$dsc_data< ?" + if $fname eq 'Files'; + $changes->{$fname} .= "\n". $extra; + $changed{$file} = "added"; + } + } + } + if (%changed) { + foreach my $file (keys %changed) { + progress sprintf + "edited .changes for archive .orig contents: %s %s", + $changed{$file}, $file; + } + my $chtmp = "$changesfile.tmp"; + $changes->save($chtmp); + if (act_local()) { + rename $chtmp,$changesfile or die "$changesfile $!"; + } else { + progress "[new .changes left in $changesfile]"; + } + } else { + progress "$changesfile already has appropriate .orig(s) (if any)"; + } +} + sub make_commit ($) { my ($file) = @_; return cmdoutput @git, qw(hash-object -w -t commit), $file; @@ -1553,6 +1834,7 @@ sub check_for_vendor_patches () { sub generate_commits_from_dsc () { # See big comment in fetch_from_archive, below. + # See also README.dsc-import. prep_ud(); changedir $ud; @@ -1561,10 +1843,15 @@ sub generate_commits_from_dsc () { my $f = $fi->{Filename}; die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#; - link_ltarget "../../../$f", $f + printdebug "considering linking $f: "; + + link_ltarget "../../../../$f", $f + or ((printdebug "($!) "), 0) or $!==&ENOENT or die "$f $!"; + printdebug "linked.\n"; + complete_file_from_dsc('.', $fi) or next; @@ -1581,8 +1868,7 @@ sub generate_commits_from_dsc () { # from the debian/changelog, so we record the tree objects now and # make them into commits later. my @tartrees; - my $upstreamv = $dsc->{version}; - $upstreamv =~ s/-[^-]+$//; + my $upstreamv = upstreamversion $dsc->{version}; my $orig_f_base = srcfn $upstreamv, ''; foreach my $fi (@dfi) { @@ -1757,7 +2043,7 @@ sub generate_commits_from_dsc () { printdebug "import clog $r1clogp->{version} becomes r1\n"; } die $! if CLOGS->error; - close CLOGS or $?==(SIGPIPE<<8) or failedcmd @clogcmd; + close CLOGS or $?==SIGPIPE or failedcmd @clogcmd; $clogp or fail "package changelog has no entries!"; @@ -1833,17 +2119,64 @@ END runcmd @git, qw(checkout -q -b dapplied), $dappliedcommit; runcmd @git, qw(checkout -q -b unpa), $rawimport_hash; - runcmd shell_cmd 'exec >/dev/null', @gbp, qw(pq import); - my $gapplied = git_rev_parse('HEAD'); - my $gappliedtree = cmdoutput @git, qw(rev-parse HEAD:); - $gappliedtree eq $dappliedtree or - fail </dev/null 2>../../gbp-pq-output', @showcmd; + debugcmd "+",@realcmd; + if (system @realcmd) { + die +(shellquote @showcmd). + " failed: ". + failedcmd_waitstatus()."\n"; + } + + my $gapplied = git_rev_parse('HEAD'); + my $gappliedtree = cmdoutput @git, qw(rev-parse HEAD:); + $gappliedtree eq $dappliedtree or + fail < 10) { fail "too many iterations trying to get sane fetch!"; } @@ -1996,7 +2333,7 @@ sub git_fetch_us () { my ($objid,$rrefname) = ($1,$2); if (!$wanted_rref->($rrefname)) { print STDERR <($rrefname)) { printdebug <($lastpush_hash, 'dgit repo server tip (last push)'); + $chkff->($lastpush_hash, 'dgit repo server tip (last push)') + if $lastpush_hash; $chkff->($lastfetch_hash, 'local tracking tip (last fetch)'); runcmd @git, qw(update-ref -m), "dgit fetch $csuite", @@ -2503,6 +2842,13 @@ sub setup_useremail (;$) { $setup->('name', 'DEBFULLNAME'); } +sub ensure_setup_existing_tree () { + my $k = "remote.$remotename.skipdefaultupdate"; + my $c = git_get_config $k; + return if defined $c; + set_local_git_config $k, 'true'; +} + sub setup_new_tree () { setup_mergechangelogs(); setup_useremail(); @@ -2538,6 +2884,11 @@ sub clone ($) { } setup_new_tree(); runcmd @git, qw(reset --hard), lrref(); + runcmd qw(bash -ec), <<'END'; + set -o pipefail + git ls-tree -r --name-only -z HEAD | \ + xargs -0r touch -r . -- +END printdone "ready for work in $dstdir"; } @@ -2598,7 +2949,11 @@ sub commit_quilty_patch () { } my @adds = map { s/[][*?\\]/\\$&/g; $_; } sort keys %adds; runcmd_ordryrun_local @git, qw(add -f), @adds; - commit_admin "Commit Debian 3.0 (quilt) metadata"; + commit_admin < message fragment "$saved" describing disposition of $dgitview + return "commit id $dgitview" unless defined $split_brain_save; + my @cmd = (shell_cmd "cd ../../../..", + @git, qw(update-ref -m), + "dgit --dgit-view-save $msg HEAD=$headref", + $split_brain_save, $dgitview); + runcmd @cmd; + return "and left in $split_brain_save"; +} + # An "infopair" is a tuple [ $thing, $what ] # (often $thing is a commit hash; $what is a description) @@ -2765,39 +3132,50 @@ sub splitbrain_pseudomerge ($$$$) { # this: $dgitview' # + return $dgitview unless defined $archive_hash; + printdebug "splitbrain_pseudomerge...\n"; my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash); - return $dgitview unless defined $archive_hash; - if (!defined $overwrite_version) { progress "Checking that HEAD inciudes all changes in archive..."; } return $dgitview if is_fast_fwd $archive_hash, $dgitview; - my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro; - my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag"); - my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro; - my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag"); - my $i_archive = [ $archive_hash, "current archive contents" ]; - - printdebug "splitbrain_pseudomerge i_archive @$i_archive\n"; - - infopair_cond_equal($i_dgit, $i_archive); - infopair_cond_ff($i_dep14, $i_dgit); - $overwrite_version // infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]); + if (defined $overwrite_version) { + } elsif (!eval { + my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro; + my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag"); + my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro; + my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag"); + my $i_archive = [ $archive_hash, "current archive contents" ]; + + printdebug "splitbrain_pseudomerge i_archive @$i_archive\n"; + + infopair_cond_equal($i_dgit, $i_archive); + infopair_cond_ff($i_dep14, $i_dgit); + infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]); + 1; + }) { + print STDERR <[0] END_OVERWR Make fast forward from $i_arch_v->[0] END_MAKEFF + maybe_split_brain_save $maintview, $r, "pseudomerge"; + progress "Made pseudo-merge of $i_arch_v->[0] into dgit view."; return $r; } @@ -2809,16 +3187,6 @@ sub plain_overwrite_pseudomerge ($$$) { my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash); - my @tagformats = access_cfg_tagformats(); - my @t_overwr = - map { $_->($i_arch_v->[0], access_basedistro) } - (grep { m/^(?:old|hist)$/ } @tagformats) - ? \&debiantags : \&debiantag_new; - my $i_overwr = infopair_lrf_tag_lookup \@t_overwr, "previous version tag"; - my $i_archive = [ $archive_hash, "current archive contents" ]; - - infopair_cond_equal($i_overwr, $i_archive); - return $head if is_fast_fwd $archive_hash, $head; my $m = "Declare fast forward from $i_arch_v->[0]"; @@ -2839,7 +3207,10 @@ sub push_parse_changelog ($) { my $clogp = Dpkg::Control::Hash->new(); $clogp->load($clogpfn) or die; - $package = getfield $clogp, 'Source'; + my $clogpackage = getfield $clogp, 'Source'; + $package //= $clogpackage; + fail "-p specified $package but changelog specified $clogpackage" + unless $package eq $clogpackage; my $cversion = getfield $clogp, 'Version'; my $tag = debiantag($cversion, access_basedistro); runcmd @git, qw(check-ref-format), $tag; @@ -3036,21 +3407,22 @@ END my $dgithead = $actualhead; my $maintviewhead = undef; + my $upstreamversion = upstreamversion $clogp->{Version}; + if (madformat_wantfixup($format)) { # user might have not used dgit build, so maybe do this now: if (quiltmode_splitbrain()) { - my $upstreamversion = $clogp->{Version}; - $upstreamversion =~ s/-[^-]*$//; changedir $ud; quilt_make_fake_dsc($upstreamversion); - my ($dgitview, $cachekey) = + my $cachekey; + ($dgithead, $cachekey) = quilt_check_splitbrain_cache($actualhead, $upstreamversion); - $dgitview or fail + $dgithead or fail "--quilt=$quilt_mode but no cached dgit view: perhaps tree changed since dgit build[-source] ?"; $split_brain = 1; $dgithead = splitbrain_pseudomerge($clogp, - $actualhead, $dgitview, + $actualhead, $dgithead, $archive_hash); $maintviewhead = $actualhead; changedir '../../../..'; @@ -3091,17 +3463,20 @@ END 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, $dgithead); + my @diffcmd = (@git, qw(diff --quiet), $tree, $dgithead); debugcmd "+",@diffcmd; $!=0; $?=-1; my $r = system @diffcmd; if ($r) { if ($r==256) { - fail "$dscfn specifies a different tree to your HEAD commit;". - " perhaps you forgot to build". - ($diffopt eq '--exit-code' ? "" : - " (run with -D to see full diff output)"); + my $diffs = cmdoutput @git, qw(diff --stat), $tree, $dgithead; + fail <{Tag}"; } - runcmd_ordryrun @git, qw(push),access_giturl(), @pushrefs; + runcmd_ordryrun @git, + qw(-c push.followTags=false push), access_giturl(), @pushrefs; runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead; supplementary_message(<<'END'); @@ -3256,7 +3643,7 @@ sub cmd_clone { } if (stat $dstdir) { rmtree($dstdir) or die "remove $dstdir: $!\n"; - } elsif (!grep { $! == $_ } + } elsif (grep { $! == $_ } (ENOENT, ENOTDIR, EACCES, EPERM, ELOOP)) { } else { print STDERR "check whether to remove $dstdir: $!\n"; @@ -3308,6 +3695,12 @@ sub cmd_fetch { sub cmd_pull { parseopts(); fetchpullargs(); + if (quiltmode_splitbrain()) { + my ($format, $fopts) = get_source_format(); + madformat($format) and fail <', $descfn or die "$descfn: $!"; - $msg =~ s/\s+$//g; - $msg =~ s/\n/\n /g; - $msg =~ s/^\s+$/ ./mg; + $msg =~ s/\n+/\n\n/; print O <{$fn} # is set for each modified .gitignore filename $fn + # if $unrepres is defined, array ref to which is appeneded + # a list of unrepresentable changes (removals of upstream files + # (as messages) local $/=undef; - my @cmd = (@git, qw(diff-tree --name-only -z)); - push @cmd, qw(-r) if $finegrained; + my @cmd = (@git, qw(diff-tree -z)); + push @cmd, qw(--name-only) unless $unrepres; + push @cmd, qw(-r) if $finegrained || $unrepres; push @cmd, $x, $y; my $diffs= cmdoutput @cmd; my $r = 0; + my @lmodes; foreach my $f (split /\0/, $diffs) { + if ($unrepres && !@lmodes) { + @lmodes = $f =~ m/^\:(\w+) (\w+) \w+ \w+ / or die "$_ ?"; + next; + } + my ($oldmode,$newmode) = @lmodes; + @lmodes = (); + next if $f =~ m#^debian(?:/.*)?$#s; + + if ($unrepres) { + eval { + die "deleted\n" unless $newmode =~ m/[^0]/; + die "not a plain file\n" unless $newmode =~ m/^10\d{4}$/; + if ($oldmode =~ m/[^0]/) { + die "mode changed\n" if $oldmode ne $newmode; + } else { + die "non-default mode\n" unless $newmode =~ m/^100644$/; + } + }; + if ($@) { + local $/="\n"; chomp $@; + push @$unrepres, [ $f, $@ ]; + } + } + my $isignore = $f =~ m#^(?:.*/)?.gitignore$#s; $r |= $isignore ? 02 : 01; $ignorenamesr->{$f}=1 if $ignorenamesr && $isignore; @@ -3684,7 +4103,7 @@ sub quiltify_splitbrain ($$$$$$) { local $ENV{GIT_AUTHOR_DATE} = $authline[2]; if ($quilt_mode =~ m/gbp|unapplied/ && - ($diffbits->{H2O} & 01)) { + ($diffbits->{O2H} & 01)) { my $msg = "--quilt=$quilt_mode specified, implying patches-unapplied git tree\n". " but git tree differs from orig in upstream files."; @@ -3705,7 +4124,7 @@ END ($diffbits->{O2A} & 01)) { # some patches quiltify_splitbrain_needed(); progress "dgit view: creating patches-applied version using gbp pq"; - runcmd shell_cmd 'exec >/dev/null', @gbp, qw(pq import); + runcmd shell_cmd 'exec >/dev/null', gbp_pq, qw(import); # gbp pq import creates a fresh branch; push back to dgit-view runcmd @git, qw(update-ref refs/heads/dgit-view HEAD); runcmd @git, qw(checkout -q dgit-view); @@ -3718,7 +4137,7 @@ END .gitignores: but, such patches exist in debian/patches. END } - if (($diffbits->{H2O} & 02) && # user has modified .gitignore + if (($diffbits->{O2H} & 02) && # user has modified .gitignore !($diffbits->{O2A} & 02)) { # patches do not change .gitignore quiltify_splitbrain_needed(); progress "dgit view: creating patch to represent .gitignore changes"; @@ -3749,21 +4168,44 @@ END print SERIES "auto-gitignore\n" or die $!; close SERIES or die $!; runcmd @git, qw(add -- debian/patches/series), $gipatch; - commit_admin "Commit patch to update .gitignore"; + commit_admin <>' or die $!; + + my $oldcache = git_get_ref "refs/$splitbraincache"; + if ($oldcache eq $dgitview) { + my $tree = cmdoutput qw(git rev-parse), "$dgitview:"; + # git update-ref doesn't always update, in this case. *sigh* + my $dummy = make_commit_text < 1000000000 +0000 +committer Dgit 1000000000 +0000 + +Dummy commit - do not use +END + runcmd @git, qw(update-ref -m), "dgit $our_version - dummy", + "refs/$splitbraincache", $dummy; + } runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache", $dgitview; - progress "dgit view: created (commit id $dgitview)"; - changedir '.git/dgit/unpack/work'; + + my $saved = maybe_split_brain_save $headref, $dgitview, "converted"; + progress "dgit view: created ($saved)"; } sub quiltify ($$$$) { @@ -3944,15 +4386,75 @@ sub quiltify ($$$$) { $commitdata =~ m/^author (.*) \d+ [-+0-9]+$/m or die "$cc ?"; my $author = $1; + my $commitdate = cmdoutput + @git, qw(log -n1 --pretty=format:%aD), $cc; + $msg =~ s/^(.*)\n*/$1\n/ or die "$cc $msg ?"; + my $strip_nls = sub { $msg =~ s/\n+$//; $msg .= "\n"; }; + $strip_nls->(); + my $title = $1; - my $patchname = $title; - $patchname =~ s/[.:]$//; - $patchname =~ y/ A-Z/-a-z/; - $patchname =~ y/-a-z0-9_.+=~//cd; - $patchname =~ s/^\W/x-$&/; - $patchname = substr($patchname,0,40); + my $patchname; + my $patchdir; + + my $gbp_check_suitable = sub { + $_ = shift; + my ($what) = @_; + + eval { + die "contains unexpected slashes\n" if m{//} || m{/$}; + die "contains leading punctuation\n" if m{^\W} || m{/\W}; + die "contains bad character(s)\n" if m{[^-a-z0-9_.+=~/]}i; + die "too long" if length > 200; + }; + return $_ unless $@; + print STDERR "quiltifying commit $cc:". + " ignoring/dropping Gbp-Pq $what: $@"; + return undef; + }; + + if ($msg =~ s/^ (?: gbp(?:-pq)? : \s* name \s+ | + gbp-pq-name: \s* ) + (\S+) \s* \n //ixm) { + $patchname = $gbp_check_suitable->($1, 'Name'); + } + if ($msg =~ s/^ (?: gbp(?:-pq)? : \s* topic \s+ | + gbp-pq-topic: \s* ) + (\S+) \s* \n //ixm) { + $patchdir = $gbp_check_suitable->($1, 'Topic'); + } + + $strip_nls->(); + + if (!defined $patchname) { + $patchname = $title; + $patchname =~ s/[.:]$//; + use Text::Iconv; + eval { + my $converter = new Text::Iconv qw(UTF-8 ASCII//TRANSLIT); + my $translitname = $converter->convert($patchname); + die unless defined $translitname; + $patchname = $translitname; + }; + print STDERR + "dgit: patch title transliteration error: $@" + if $@; + $patchname =~ y/ A-Z/-a-z/; + $patchname =~ y/-a-z0-9_.+=~//cd; + $patchname =~ s/^\W/x-$&/; + $patchname = substr($patchname,0,40); + } + if (!defined $patchdir) { + $patchdir = ''; + } + if (length $patchdir) { + $patchname = "$patchdir/$patchname"; + } + if ($patchname =~ m{^(.*)/}) { + mkpath "debian/patches/$1"; + } + my $index; for ($index=''; stat "debian/patches/$patchname$index"; @@ -3970,6 +4472,7 @@ sub quiltify ($$$$) { runcmd @git, qw(checkout -q), $target, qw(debian/changelog); quiltify_dpkg_commit "$patchname$index", $author, $msg, + "Date: $commitdate\n". "X-Dgit-Generated: $clogp->{Version} $cc\n"; runcmd @git, qw(checkout -q), $cc, qw(debian/changelog); @@ -4001,8 +4504,7 @@ END prep_ud(); changedir $ud; - my $upstreamversion=$version; - $upstreamversion =~ s/-[^-]*$//; + my $upstreamversion = upstreamversion $version; if ($fopts->{'single-debian-patch'}) { quilt_fixup_singlepatch($clogp, $headref, $upstreamversion); @@ -4045,7 +4547,11 @@ sub quilt_fixup_linkorigs ($$) { sub quilt_fixup_delete_pc () { runcmd @git, qw(rm -rqf .pc); - commit_admin "Commit removal of .pc (quilt series tracking data)"; + commit_admin <new(256); my %sfs = ( %INC, '$0(dgit)' => $0 ); foreach my $sfk (sort keys %sfs) { - next unless m/^\$0\b/ || m{^Debian/Dgit\b}; + next unless $sfk =~ m/^\$0\b/ || $sfk =~ m{^Debian/Dgit\b}; $srcshash->add($sfk," "); $srcshash->add(hashfile($sfs{$sfk})); $srcshash->add("\n"); @@ -4147,7 +4653,7 @@ sub quilt_check_splitbrain_cache ($$) { push @cachekey, $srcshash->hexdigest(); $splitbrain_cachekey = "@cachekey"; - my @cmd = (@git, qw(reflog), '--pretty=format:%H %gs', + my @cmd = (@git, qw(log -g), '--pretty=format:%H %gs', $splitbraincache); printdebug "splitbrain cachekey $splitbrain_cachekey\n"; debugcmd "|(probably)",@cmd; @@ -4168,8 +4674,9 @@ sub quilt_check_splitbrain_cache ($$) { my $cachehit = $1; quilt_fixup_mkwork($headref); + my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit"; if ($cachehit ne $headref) { - progress "dgit view: found cached (commit id $cachehit)"; + progress "dgit view: found cached ($saved)"; runcmd @git, qw(checkout -q -b dgit-view), $cachehit; $split_brain = 1; return ($cachehit, $splitbrain_cachekey); @@ -4227,10 +4734,10 @@ sub quilt_fixup_multipatch ($$$) { # 2. Copy .pc from the fake's extraction, if necessary # 3. Run dpkg-source --commit # 4. If the result has changes to debian/, then - # - git-add them them - # - git-add .pc if we had a .pc in-tree - # - git-commit - # 5. If we had a .pc in-tree, delete it, and git-commit + # - git add them them + # - git add .pc if we had a .pc in-tree + # - git commit + # 5. If we had a .pc in-tree, delete it, and git commit # 6. Back in the main tree, fast forward to the new HEAD # Another situation we may have to cope with is gbp-style @@ -4239,7 +4746,7 @@ sub quilt_fixup_multipatch ($$$) { # We would want to detect these, so we know to escape into # quilt_fixup_gbp. However, this is in general not possible. # Consider a package with a one patch which the dgit user reverts - # (with git-revert or the moral equivalent). + # (with git revert or the moral equivalent). # # That is indistinguishable in contents from a patches-unapplied # tree. And looking at the history to distinguish them is not @@ -4288,8 +4795,17 @@ sub quilt_fixup_multipatch ($$$) { ensuredir '.pc'; - runcmd qw(sh -ec), - 'exec dpkg-source --before-build . >/dev/null'; + my @bbcmd = (qw(sh -ec), 'exec dpkg-source --before-build . >/dev/null'); + $!=0; $?=-1; + if (system @bbcmd) { + failedcmd @bbcmd if $? < 0; + fail < quiltify_trees_differ($headref, $unapplied, 1,\%editedignores), + O2H => quiltify_trees_differ($unapplied,$headref, 1, + \%editedignores, \@unrepres), H2A => quiltify_trees_differ($headref, $oldtiptree,1), O2A => quiltify_trees_differ($unapplied,$oldtiptree,1), }; my @dl; foreach my $b (qw(01 02)) { - foreach my $v (qw(H2O O2A H2A)) { + foreach my $v (qw(O2H O2A H2A)) { push @dl, ($diffbits->{$v} & $b) ? '##' : '=='; } } printdebug "differences \@dl @dl.\n"; progress sprintf +"$us: base trees orig=%.20s o+d/p=%.20s", + $unapplied, $oldtiptree; + progress sprintf "$us: quilt differences: src: %s orig %s gitignores: %s orig %s\n". "$us: quilt differences: HEAD %s o+d/p HEAD %s o+d/p", $dl[0], $dl[1], $dl[3], $dl[4], $dl[2], $dl[5]; + if (@unrepres) { + print STDERR "dgit: cannot represent change: $_->[1]: $_->[0]\n" + foreach @unrepres; + forceable_fail [qw(unrepresentable)], <{H2O} & $diffbits->{O2A})) { + if (!($diffbits->{O2H} & $diffbits->{O2A})) { push @failsuggestion, "This might be a patches-unapplied branch."; } elsif (!($diffbits->{H2A} & $diffbits->{O2A})) { push @failsuggestion, "This might be a patches-applied branch."; } push @failsuggestion, "Maybe you need to specify one of". - " --quilt=gbp --quilt=dpm --quilt=unapplied ?"; + " --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?"; if (quiltmode_splitbrain()) { quiltify_splitbrain($clogp, $unapplied, $headref, @@ -4453,15 +4982,21 @@ sub cmd_clean () { maybe_unapply_patches_again(); } -sub build_prep () { +sub build_prep_early () { + our $build_prep_early_done //= 0; + return if $build_prep_early_done++; notpushing(); badusage "-p is not allowed when building" if defined $package; - check_not_dirty(); - clean_tree(); my $clogp = parsechangelog(); $isuite = getfield $clogp, 'Distribution'; $package = getfield $clogp, 'Source'; $version = getfield $clogp, 'Version'; + check_not_dirty(); +} + +sub build_prep () { + build_prep_early(); + clean_tree(); build_maybe_quilt_fixup(); if ($rmchanges) { my $pat = changespat $version; @@ -4562,11 +5097,87 @@ sub massage_dbp_args ($;$) { return $r; } +sub in_parent (&) { + my ($fn) = @_; + my $wasdir = must_getcwd(); + changedir ".."; + $fn->(); + changedir $wasdir; +} + +sub postbuild_mergechanges ($) { # must run with CWD=.. (eg in in_parent) + my ($msg_if_onlyone) = @_; + # If there is only one .changes file, fail with $msg_if_onlyone, + # or if that is undef, be a no-op. + # Returns the changes file to report to the user. + my $pat = changespat $version; + my @changesfiles = glob $pat; + @changesfiles = sort { + ($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/) + or $a cmp $b + } @changesfiles; + my $result; + if (@changesfiles==1) { + fail < 0) { build_source(); + midbuild_checkchanges_vanilla $wantsrc; } else { build_prep(); } @@ -4576,24 +5187,68 @@ sub cmd_build { runcmd_ordryrun_local @dbp; } maybe_unapply_patches_again(); - printdone "build successful\n"; + postbuild_mergechanges_vanilla $wantsrc; +} + +sub pre_gbp_build { + $quilt_mode //= 'gbp'; } sub cmd_gbp_build { + build_prep_early(); + + # gbp can make .origs out of thin air. In my tests it does this + # even for a 1.0 format package, with no origs present. So I + # guess it keys off just the version number. We don't know + # exactly what .origs ought to exist, but let's assume that we + # should run gbp if: the version has an upstream part and the main + # orig is absent. + my $upstreamversion = upstreamversion $version; + my $origfnpat = srcfn $upstreamversion, '.orig.tar.*'; + my $gbp_make_orig = $version =~ m/-/ && !(() = glob "../$origfnpat"); + + if ($gbp_make_orig) { + clean_tree(); + $cleanmode = 'none'; # don't do it again + $need_split_build_invocation = 1; + } + my @dbp = @dpkgbuildpackage; my $wantsrc = massage_dbp_args \@dbp, \@ARGV; - my @cmd; - if (length executable_on_path('git-buildpackage')) { - @cmd = qw(git-buildpackage); - } else { - @cmd = qw(gbp buildpackage); + if (!length $gbp_build[0]) { + if (length executable_on_path('git-buildpackage')) { + $gbp_build[0] = qw(git-buildpackage); + } else { + $gbp_build[0] = 'gbp buildpackage'; + } } + my @cmd = opts_opt_multi_cmd @gbp_build; + push @cmd, (qw(-us -uc --git-no-sign-tags), "--git-builder=@dbp"); + if ($gbp_make_orig) { + ensuredir '.git/dgit'; + my $ok = '.git/dgit/origs-gen-ok'; + unlink $ok or $!==&ENOENT or die $!; + my @origs_cmd = @cmd; + push @origs_cmd, qw(--git-cleaner=true); + push @origs_cmd, "--git-prebuild=touch $ok .git/dgit/no-such-dir/ok"; + push @origs_cmd, @ARGV; + if (act_local()) { + debugcmd @origs_cmd; + system @origs_cmd; + do { local $!; stat_exists $ok; } + or failedcmd @origs_cmd; + } else { + dryrun_report @origs_cmd; + } + } + if ($wantsrc > 0) { build_source(); + midbuild_checkchanges_vanilla $wantsrc; } else { if (!$clean_using_builder) { push @cmd, '--git-cleaner=true'; @@ -4602,14 +5257,10 @@ sub cmd_gbp_build { } maybe_unapply_patches_again(); if ($wantsrc < 2) { - unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) { - canonicalise_suite(); - push @cmd, "--git-debian-branch=".lbranch(); - } push @cmd, changesopts(); runcmd_ordryrun_local @cmd, @ARGV; } - printdone "build successful\n"; + postbuild_mergechanges_vanilla $wantsrc; } sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0 @@ -4682,47 +5333,22 @@ sub cmd_build_source { sub cmd_sbuild { build_source(); - my $pat = changespat $version; - if (!$rmchanges) { - my @unwanted = map { s#^\.\./##; $_; } glob "../$pat"; - @unwanted = grep { $_ ne changespat $version,'source' } @unwanted; - fail "changes files other than source matching $pat". - " already present (@unwanted);". - " building would result in ambiguity about the intended results" - if @unwanted; - } - my $wasdir = must_getcwd(); - changedir ".."; - if (act_local()) { - stat_exists $dscfn or fail "$dscfn (in parent directory): $!"; - stat_exists $sourcechanges - or fail "$sourcechanges (in parent directory): $!"; - } - runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn; - my @changesfiles = glob $pat; - @changesfiles = sort { - ($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/) - or $a cmp $b - } @changesfiles; - fail "wrong number of different changes files (@changesfiles)" - unless @changesfiles==2; - my $binchanges = parsecontrol($changesfiles[1], "binary changes file"); - foreach my $l (split /\n/, getfield $binchanges, 'Files') { - fail "$l found in binaries changes file $binchanges" - if $l =~ m/\.dsc$/; - } - runcmd_ordryrun_local @mergechanges, @changesfiles; - my $multichanges = changespat $version,'multi'; - if (act_local()) { - stat_exists $multichanges or fail "$multichanges: $!"; - foreach my $cf (glob $pat) { - next if $cf eq $multichanges; - rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!"; + midbuild_checkchanges(); + in_parent { + if (act_local()) { + stat_exists $dscfn or fail "$dscfn (in parent directory): $!"; + stat_exists $sourcechanges + or fail "$sourcechanges (in parent directory): $!"; } - } - changedir $wasdir; + runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn; + }; maybe_unapply_patches_again(); - printdone "build successful, results in $multichanges\n" or die $!; + in_parent { + postbuild_mergechanges(<; }; + D->error and fail "read $dscfn: $!"; + close C; + + # we don't normally need this so import it here + use Dpkg::Source::Package; + my $dp = new Dpkg::Source::Package filename => $dscfn, + require_valid_signature => $needsig; + { + local $SIG{__WARN__} = sub { + print STDERR $_[0]; + return unless $needsig; + fail "import-dsc signature check failed"; + }; + if (!$dp->is_signed()) { + warn "$us: warning: importing unsigned .dsc\n"; + } else { + my $r = $dp->check_signature(); + die "->check_signature => $r" if $needsig && $r; + } + } + + parse_dscdata(); + + my $dgit_commit = $dsc->{$ourdscfield[0]}; + if (defined $dgit_commit && + !forceing [qw(import-dsc-with-dgit-field)]) { + $dgit_commit =~ m/\w+/ or fail "invalid hash in .dsc"; + progress "dgit: import-dsc of .dsc with Dgit field, using git hash"; + my @cmd = (qw(sh -ec), + "echo $dgit_commit | git cat-file --batch-check"); + my $objgot = cmdoutput @cmd; + if ($objgot =~ m#^\w+ missing\b#) { + fail < 0) { + progress "Not fast forward, forced update."; + } else { + fail "Not fast forward to $dgit_commit"; + } + } + @cmd = (@git, qw(update-ref -m), "dgit import-dsc (Dgit): $info", + $dstbranch, $dgit_commit); + runcmd @cmd; + progress "dgit: import-dsc updated git ref $dstbranch"; + return 0; + } + + fail <{Filename}; + my $here = "../$f"; + next if lstat $here; + fail "stat $here: $!" unless $! == ENOENT; + my $there = $dscfn; + if ($dscfn =~ m#^(?:\./+)?\.\./+#) { + $there = $'; + } elsif ($dscfn =~ m#^/#) { + $there = $dscfn; + } else { + fail "cannot import $dscfn which seems to be inside working tree!"; + } + $there =~ s#/+[^/]+$## or + fail "cannot import $dscfn which seems to not have a basename"; + $there .= "/$f"; + symlink $there, $here or fail "symlink $there to $here: $!"; + progress "made symlink $here -> $there"; + print STDERR Dumper($fi); + } + my @mergeinputs = generate_commits_from_dsc(); + die unless @mergeinputs == 1; + + my $newhash = $mergeinputs[0]{Commit}; + + if ($oldhash) { + if ($force > 0) { + progress "Import, forced update - synthetic orphan git history."; + } elsif ($force < 0) { + progress "Import, merging."; + my $tree = cmdoutput @git, qw(rev-parse), "$newhash:"; + my $version = getfield $dsc, 'Version'; + $newhash = make_commit_text <",@cmd; exec @cmd or fail "exec curl: $!\n"; } @@ -4794,10 +5572,9 @@ defvalopt '', '-k', '.+', \$keyid; defvalopt '--existing-package','', '.*', \$existing_package; defvalopt '--build-products-dir','','.*', \$buildproductsdir; defvalopt '--clean', '', $cleanmode_re, \$cleanmode; +defvalopt '--package', '-p', $package_re, \$package; defvalopt '--quilt', '', $quilt_modes_re, \$quilt_mode; -defvalopt '', '-c', '.*=.*', sub { push @git, '-c', @_; }; - defvalopt '', '-C', '.+', sub { ($changesfile) = (@_); if ($changesfile =~ s#^(.*)/##) { @@ -4873,6 +5650,9 @@ sub parseopts () { ($om = $opts_opt_map{$1})) { push @ropts, $_; push @$om, $2; + } elsif (m/^--(gbp|dpm)$/s) { + push @ropts, "--quilt=$1"; + $quilt_mode = $1; } elsif (m/^--ignore-dirty$/s) { push @ropts, $_; $ignoredirty = 1; @@ -4888,12 +5668,27 @@ sub parseopts () { } elsif (m/^--overwrite=(.+)$/s) { push @ropts, $_; $overwrite_version = $1; + } elsif (m/^--delayed=(\d+)$/s) { + push @ropts, $_; + push @dput, $_; + } elsif (m/^--dgit-view-save=(.+)$/s) { + push @ropts, $_; + $split_brain_save = $1; + $split_brain_save =~ s#^(?!refs/)#refs/heads/#; } elsif (m/^--(no-)?rm-old-changes$/s) { push @ropts, $_; $rmchanges = !$1; } elsif (m/^--deliberately-($deliberately_re)$/s) { push @ropts, $_; push @deliberatelies, $&; + } elsif (m/^--force-(.*)/ && defined $forceopts{$1}) { + push @ropts, $&; + $forceopts{$1} = 1; + $_=''; + } elsif (m/^--force-/) { + print STDERR + "$us: warning: ignoring unknown force option $_\n"; + $_=''; } elsif (m/^--dgit-tag-format=(old|new)$/s) { # undocumented, for testing push @ropts, $_; @@ -4948,6 +5743,12 @@ sub parseopts () { } elsif (s/^-wc$//s) { push @ropts, $&; $cleanmode = 'check'; + } elsif (s/^-c([^=]*)\=(.*)$//s) { + push @git, '-c', $&; + $gitcfgs{cmdline}{$1} = [ $2 ]; + } elsif (s/^-c([^=]+)$//s) { + push @git, '-c', $&; + $gitcfgs{cmdline}{$1} = [ 'true' ]; } elsif (m/^-[a-zA-Z]/ && ($oi = $valopts_short{$&})) { $val = $'; #'; $val = undef unless length $val; @@ -4961,6 +5762,30 @@ sub parseopts () { } } +sub check_env_sanity () { + my $blocked = new POSIX::SigSet; + sigprocmask SIG_UNBLOCK, $blocked, $blocked or die $!; + + eval { + foreach my $name (qw(PIPE CHLD)) { + my $signame = "SIG$name"; + my $signum = eval "POSIX::$signame" // die; + ($SIG{$name} // 'DEFAULT') eq 'DEFAULT' or + die "$signame is set to something other than SIG_DFL\n"; + $blocked->ismember($signum) and + die "$signame is blocked\n"; + } + }; + return unless $@; + chomp $@; + fail <= 4; - next unless $vl; + next unless @vl; badcfg "cannot configure options for $k" if $opts_opt_cmdonly{$k}; my $insertpos = $opts_cfg_insertpos{$k}; @$om = ( @$om[0..$insertpos-1], - @$vl, + @vl, @$om[$insertpos..$#$om] ); } } @@ -4994,6 +5821,7 @@ if ($ENV{$fakeeditorenv}) { } parseopts(); +check_env_sanity(); git_slurp_config(); print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1; @@ -5006,6 +5834,9 @@ if (!@ARGV) { my $cmd = shift @ARGV; $cmd =~ y/-/_/; +my $pre_fn = ${*::}{"pre_$cmd"}; +$pre_fn->() if $pre_fn; + if (!defined $rmchanges) { local $access_forpush; $rmchanges = access_cfg_bool(0, 'rm-old-changes');