X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=0e0ff6575c3e79bc67227b809e36c876b53fb4f1;hb=e82d9492c0a63d75c96e2ebdbc93300d57927d60;hp=3032c56d5f3f7a7178b41dd69e5a67e6a125905d;hpb=7adb1a2ff884501c97fbb92b4b91337929c047fd;p=dgit.git diff --git a/dgit b/dgit index 3032c56d..0e0ff657 100755 --- a/dgit +++ b/dgit @@ -2,8 +2,9 @@ # dgit # Integration between git and Debian-style archives # -# Copyright (C)2013-2018 Ian Jackson -# Copyright (C)2017-2018 Sean Whitton +# Copyright (C)2013-2019 Ian Jackson +# Copyright (C)2017-2019 Sean Whitton +# Copyright (C)2019 Matthew Vernon / Sanger Institute # # 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 @@ -53,7 +54,7 @@ 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 @rpushprotovsn_support = qw(6 5 4); # Reverse order! our $protovsn; our $cmd; @@ -79,16 +80,19 @@ our $changes_since_version; 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 $quilt_upstream_commitish; +our $quilt_upstream_commitish_used; +our $quilt_upstream_commitish_message; +our $quilt_options_re = 'gbp|dpm|baredebian(?:\+tarball|\+git)?'; +our $quilt_modes_re = "linear|smash|auto|nofix|nocheck|unapplied|$quilt_options_re"; +our $splitview_mode; +our $splitview_modes_re = qr{auto|always|never}; our $dodep14tag; our %internal_object_save; our $we_are_responder; our $we_are_initiator; our $initiator_tempdir; our $patches_applied_dirtily = 00; -our $tagformat_want; -our $tagformat; -our $tagformatfn; our $chase_dsc_distro=1; our %forceopts = map { $_=>0 } @@ -101,7 +105,6 @@ our %forceopts = map { $_=>0 } our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)"); -our $suite_re = '[-+.0-9a-z]+'; our $cleanmode_re = qr{(?: dpkg-source (?: -d )? (?: ,no-check | ,all-check )? | (?: git | git-ff ) (?: ,always )? | check (?: ,ignores )? @@ -165,6 +168,7 @@ our %opts_cfg_insertpos = map { } keys %opts_opt_map; sub parseopts_late_defaults(); +sub quiltify_trees_differ ($$;$$$); sub setup_gitattrs(;$); sub check_gitattrs($$); @@ -174,7 +178,31 @@ our $keyid; autoflush STDOUT 1; our $supplementary_message = ''; -our $split_brain = 0; +our $made_split_brain = 0; +our $do_split_brain; + +# Interactions between quilt mode and split brain +# (currently, split brain only implemented iff +# madformat_wantfixup && quiltmode_splitting) +# +# source format sane `3.0 (quilt)' +# madformat_wantfixup() +# +# quilt mode normal quiltmode +# (eg linear) _splitbrain +# +# ------------ ------------------------------------------------ +# +# no split no q cache no q cache forbidden, +# brain PM on master q fixup on master prevented +# !do_split_brain() PM on master +# +# split brain no q cache q fixup cached, to dgit view +# PM in dgit view PM in dgit view +# +# PM = pseudomerge to make ff, due to overwrite (or split view) +# "no q cache" = do not record in cache on build, do not check cache +# `3.0 (quilt)' with --quilt=nocheck is treated as sane format END { local ($@, $?); @@ -192,11 +220,6 @@ if (!defined $absurdity) { $absurdity =~ s{/[^/]+$}{/absurd} or die; } -sub debiantag ($$) { - my ($v,$distro) = @_; - return $tagformatfn->($v, $distro); -} - sub madformat ($) { $_[0] eq '3.0 (quilt)' } sub lbranch () { return "$branchprefix/$csuite"; } @@ -274,10 +297,16 @@ sub deliberately_not_fast_forward () { } } -sub quiltmode_splitbrain () { - $quilt_mode =~ m/gbp|dpm|unapplied/; +sub quiltmode_splitting () { + $quilt_mode =~ m/gbp|dpm|unapplied|baredebian/; +} +sub format_quiltmode_splitting ($) { + my ($format) = @_; + return madformat_wantfixup($format) && quiltmode_splitting(); } +sub do_split_brain () { !!($do_split_brain // confess) } + sub opts_opt_multi_cmd { my $extra = shift; my @cmd; @@ -397,7 +426,9 @@ sub branch_is_gdr ($) { return 0; } if ($tip_patches eq '' and - !defined git_cat_file "$walk:debian") { + !defined git_cat_file "$walk~:debian" and + !quiltify_trees_differ "$walk~", $walk + ) { # (gdr classification of parent: BreakwaterStart printdebug "branch_is_gdr $walk unmarked BreakwaterStart YES\n"; return 1; @@ -421,7 +452,7 @@ sub branch_is_gdr ($) { # > progress NBYTES # [NBYTES message] # -# > supplementary-message NBYTES # $protovsn >= 3 +# > supplementary-message NBYTES # [NBYTES message] # # main sequence: @@ -441,7 +472,8 @@ sub branch_is_gdr ($) { # # > param head DGIT-VIEW-HEAD # > param csuite SUITE -# > param tagformat old|new +# > param tagformat new # $protovsn == 4 +# > param splitbrain 0|1 # $protovsn >= 6 # > param maint-view MAINT-VIEW-HEAD # # > param buildinfo-filename P_V_X.buildinfo # zero or more times @@ -521,11 +553,11 @@ sub protocol_send_file ($$) { my $got = read PF, $d, 65536; die "$ourfn: $!" unless defined $got; last if !$got; - print $fh "data-block ".length($d)."\n" or confess $!; - print $fh $d or confess $!; + print $fh "data-block ".length($d)."\n" or confess "$!"; + print $fh $d or confess "$!"; } PF->error and die "$ourfn $!"; - print $fh "data-end\n" or confess $!; + print $fh "data-end\n" or confess "$!"; close PF; } @@ -550,9 +582,9 @@ sub protocol_receive_file ($$) { } $fh; last unless $y; my $d = protocol_read_bytes $fh, $l; - print PF $d or confess $!; + print PF $d or confess "$!"; } - close PF or confess $!; + close PF or confess "$!"; } #---------- remote protocol support, responder ---------- @@ -562,7 +594,7 @@ sub responder_send_command ($) { return unless $we_are_responder; # called even without $we_are_responder printdebug ">> $command\n"; - print PO $command, "\n" or confess $!; + print PO $command, "\n" or confess "$!"; } sub responder_send_file ($$) { @@ -597,8 +629,8 @@ sub initiator_expect (&) { sub progress { if ($we_are_responder) { my $m = join '', @_; - responder_send_command "progress ".length($m) or confess $!; - print PO $m or confess $!; + responder_send_command "progress ".length($m) or confess "$!"; + print PO $m or confess "$!"; } else { print @_, "\n"; } @@ -613,7 +645,7 @@ sub url_get { } my $what = $_[$#_]; progress "downloading $what..."; - my $r = $ua->get(@_) or confess $!; + my $r = $ua->get(@_) or confess "$!"; return undef if $r->code == 404; $r->is_success or fail f_ "failed to fetch %s: %s", $what, $r->status_line; @@ -677,7 +709,7 @@ Perhaps the upload is stuck in incoming. Using the version from git. END sub badusage { - print STDERR f_ "%s: %s\n%s", $us, "@_", __ $helpmsg or confess $!; + print STDERR f_ "%s: %s\n%s", $us, "@_", __ $helpmsg or confess "$!"; finish 8; } @@ -690,7 +722,7 @@ sub pre_help () { not_necessarily_a_tree(); } sub cmd_help () { - print __ $helpmsg or confess $!; + print __ $helpmsg or confess "$!"; finish 0; } @@ -706,7 +738,6 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit.default.archive-query' => 'madison:', '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', @@ -753,6 +784,12 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit-distro.debian-backports.mirror' => 'http://backports.debian.org/debian-backports/', 'dgit-distro.ubuntu.git-check' => 'false', 'dgit-distro.ubuntu.mirror' => 'http://archive.ubuntu.com/ubuntu', + 'dgit-distro.ubuntucloud.git-check' => 'false', + 'dgit-distro.ubuntucloud.nominal-distro' => 'ubuntu', + 'dgit-distro.ubuntucloud.archive-query' => 'aptget:', + 'dgit-distro.ubuntucloud.mirror' => 'http://ubuntu-cloud.archive.canonical.com/ubuntu', + 'dgit-distro.ubuntucloud.aptget-suite-map' => 's#^([^-]+):([^:]+)$#${1}-updates/$2#; s#^(.+)-(.+):(.+)#$1-$2/$3#;', + 'dgit-distro.ubuntucloud.aptget-suite-rmap' => 's#/(.+)$#-$1#', 'dgit-distro.test-dummy.ssh' => "$td/ssh", 'dgit-distro.test-dummy.username' => "alice", 'dgit-distro.test-dummy.git-check' => "ssh-cmd", @@ -916,6 +953,20 @@ sub access_forpush () { return $access_forpush; } +sub default_from_access_cfg ($$$;$) { + my ($var, $keybase, $defval, $permit_re) = @_; + return if defined $$var; + + $$var = access_cfg("$keybase-newer", 'RETURN-UNDEF'); + $$var = undef if $$var && $$var !~ m/^$permit_re$/; + + $$var //= access_cfg($keybase, 'RETURN-UNDEF'); + $$var //= $defval; + + badcfg f_ "unknown %s \`%s'", $keybase, $$var + if defined $permit_re and $$var !~ m/$permit_re/; +} + sub pushing () { confess +(__ 'internal error').' '.Dumper($access_forpush)," ?" if defined $access_forpush and !$access_forpush; @@ -933,15 +984,36 @@ sub notpushing () { parseopts_late_defaults(); } +sub determine_whether_split_brain ($) { + my ($format) = @_; + { + local $access_forpush; + default_from_access_cfg(\$splitview_mode, 'split-view', 'auto', + $splitview_modes_re); + $do_split_brain = 1 if $splitview_mode eq 'always'; + } + + printdebug "format $format, quilt mode $quilt_mode\n"; + + if (format_quiltmode_splitting $format) { + $splitview_mode ne 'never' or + fail f_ "dgit: quilt mode \`%s' (for format \`%s')". + " implies split view, but split-view set to \`%s'", + $quilt_mode, $format, $splitview_mode; + $do_split_brain = 1; + } + $do_split_brain //= 0; +} + sub supplementary_message ($) { my ($msg) = @_; if (!$we_are_responder) { $supplementary_message = $msg; return; - } elsif ($protovsn >= 3) { + } else { responder_send_command "supplementary-message ".length($msg) - or confess $!; - print PO $msg or confess $!; + or confess "$!"; + print PO $msg or confess "$!"; } } @@ -1078,7 +1150,7 @@ sub commit_getclogp ($) { } sub parse_dscdata () { - my $dscfh = new IO::File \$dscdata, '<' or confess $!; + my $dscfh = new IO::File \$dscdata, '<' or confess "$!"; printdebug Dumper($dscdata) if $debuglevel>1; $dsc = parsecontrolfh($dscfh,$dscurl,1); printdebug Dumper($dsc) if $debuglevel>1; @@ -1296,17 +1368,17 @@ sub aptget_prep ($) { cfg_apply_map(\$aptsuites, 'suite map', access_cfg('aptget-suite-map', 'RETURN-UNDEF')); - open SRCS, ">", "$aptget_base/$sourceslist" or confess $!; + open SRCS, ">", "$aptget_base/$sourceslist" or confess "$!"; printf SRCS "deb-src %s %s %s\n", access_cfg('mirror'), $aptsuites, access_cfg('aptget-components') - or confess $!; + or confess "$!"; ensuredir "$aptget_base/cache"; ensuredir "$aptget_base/lists"; - open CONF, ">", $aptget_configpath or confess $!; + open CONF, ">", $aptget_configpath or confess "$!"; print CONF <) { next unless stat_exists $oldlist; my ($mtime) = (stat _)[9]; @@ -1370,11 +1442,11 @@ sub canonicalise_suite_aptget { my $val = $release->{$name}; if (defined $val) { printdebug "release file $name: $val\n"; + cfg_apply_map(\$val, 'suite rmap', + access_cfg('aptget-suite-rmap', 'RETURN-UNDEF')); $val =~ m/^$suite_re$/o or fail f_ "Release file (%s) specifies intolerable %s", $aptget_releasefile, $name; - cfg_apply_map(\$val, 'suite rmap', - access_cfg('aptget-suite-rmap', 'RETURN-UNDEF')); return $val } } @@ -1429,7 +1501,7 @@ sub dummycatapi_run_in_mirror ($@) { my @cmd = (qw(sh -ec), 'cd "$1"; shift'."\n".$rune, qw(x), $mirror, @$argl); debugcmd "-|", @cmd; - open FIA, "-|", @cmd or confess $!; + open FIA, "-|", @cmd or confess "$!"; my $r = $fn->(); close FIA or ($!==0 && $?==141) or die failedcmd @cmd; return $r; @@ -1532,7 +1604,7 @@ sub sshpsql ($$$) { " export LC_MESSAGES=C; export LC_CTYPE=C;". " ".shellquote qw(psql -A), $dbname, qw(-c), $sql); debugcmd "|",@cmd; - open P, "-|", @cmd or confess $!; + open P, "-|", @cmd or confess "$!"; while (

) { chomp or die; printdebug(">|$_|\n"); @@ -1640,58 +1712,6 @@ sub archive_query_dummycat ($$) { sub file_in_archive_dummycat () { return undef; } sub package_not_wholly_new_dummycat () { return undef; } -#---------- tag format handling ---------- -# (untranslated, because everything should be new tag format by now) - -sub access_cfg_tagformats () { - split /\,/, access_cfg('dgit-tag-format'); -} - -sub access_cfg_tagformats_can_splitbrain () { - my %y = map { $_ => 1 } access_cfg_tagformats; - foreach my $needtf (qw(new maint)) { - next if $y{$needtf}; - return 0; - } - return 1; -} - -sub need_tagformat ($$) { - my ($fmt, $why) = @_; - fail "need to use tag format $fmt ($why) but also need". - " to use tag format $tagformat_want->[0] ($tagformat_want->[1])". - " - no way to proceed" - if $tagformat_want && $tagformat_want->[0] ne $fmt; - $tagformat_want = [$fmt, $why, $tagformat_want->[2] // 0]; -} - -sub select_tagformat () { - # sets $tagformatfn - return if $tagformatfn && !$tagformat_want; - die 'bug' if $tagformatfn && $tagformat_want; - # ... $tagformat_want assigned after previous select_tagformat - - my (@supported) = grep { $_ =~ m/^(?:old|new)$/ } access_cfg_tagformats(); - printdebug "select_tagformat supported @supported\n"; - - $tagformat_want //= [ $supported[0], "distro access configuration", 0 ]; - printdebug "select_tagformat specified @$tagformat_want\n"; - - my ($fmt,$why,$override) = @$tagformat_want; - - fail "target distro supports tag formats @supported". - " but have to use $fmt ($why)" - unless $override - or grep { $_ eq $fmt } @supported; - - $tagformat_want = undef; - $tagformat = $fmt; - $tagformatfn = ${*::}{"debiantag_$fmt"}; - - fail "trying to use unknown tag format \`$fmt' ($why) !" - unless $tagformatfn; -} - #---------- archive query entrypoints and rest of program ---------- sub canonicalise_suite () { @@ -1833,7 +1853,7 @@ sub remove_stray_gits ($) { my ($what) = @_; my @gitscmd = qw(find -name .git -prune -print0); debugcmd "|",@gitscmd; - open GITS, "-|", @gitscmd or confess $!; + open GITS, "-|", @gitscmd or confess "$!"; { local $/="\0"; while () { @@ -2106,11 +2126,6 @@ END } } -sub make_commit ($) { - my ($file) = @_; - return cmdoutput @git, qw(hash-object -w -t commit), $file; -} - sub clogp_authline ($) { my ($clogp) = @_; my $author = getfield $clogp, 'Maintainer'; @@ -2234,7 +2249,7 @@ sub dotdot_bpd_transfer_origs ($$$) { "check orig file %s in ..: %s", $leaf, $!; if (-l _) { stat "$dotdot/$leaf" or fail f_ - "check targe of orig symlink %s in ..: %s", $leaf, $!; + "check target of orig symlink %s in ..: %s", $leaf, $!; my $ltarget = readlink "$dotdot/$leaf" or die "readlink $dotdot/$leaf: $!"; if ($ltarget !~ m{^/}) { @@ -2264,62 +2279,9 @@ sub dotdot_bpd_transfer_origs ($$$) { closedir DD; } -sub generate_commits_from_dsc () { - # See big comment in fetch_from_archive, below. - # See also README.dsc-import. - prep_ud(); - changedir $playground; - - my $bpd_abs = bpd_abs(); - my $upstreamv = upstreamversion $dsc->{version}; - my @dfi = dsc_files_info(); - - dotdot_bpd_transfer_origs $bpd_abs, $upstreamv, - sub { grep { $_->{Filename} eq $_[0] } @dfi }; - - foreach my $fi (@dfi) { - my $f = $fi->{Filename}; - die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#; - my $upper_f = "$bpd_abs/$f"; - - printdebug "considering reusing $f: "; - - if (link_ltarget "$upper_f,fetch", $f) { - printdebug "linked (using ...,fetch).\n"; - } elsif ((printdebug "($!) "), - $! != ENOENT) { - fail f_ "accessing %s: %s", "$buildproductsdir/$f,fetch", $!; - } elsif (link_ltarget $upper_f, $f) { - printdebug "linked.\n"; - } elsif ((printdebug "($!) "), - $! != ENOENT) { - fail f_ "accessing %s: %s", "$buildproductsdir/$f", $!; - } else { - printdebug "absent.\n"; - } - - my $refetched; - complete_file_from_dsc('.', $fi, \$refetched) - or next; - - printdebug "considering saving $f: "; - - if (rename_link_xf 1, $f, $upper_f) { - printdebug "linked.\n"; - } elsif ((printdebug "($@) "), - $! != EEXIST) { - fail f_ "saving %s: %s", "$buildproductsdir/$f", $@; - } elsif (!$refetched) { - printdebug "no need.\n"; - } elsif (rename_link_xf 1, $f, "$upper_f,fetch") { - printdebug "linked (using ...,fetch).\n"; - } elsif ((printdebug "($@) "), - $! != EEXIST) { - fail f_ "saving %s: %s", "$buildproductsdir/$f,fetch", $@; - } else { - printdebug "cannot.\n"; - } - } +sub import_tarball_tartrees ($$) { + my ($upstreamv, $dfi) = @_; + # cwd should be the playground # We unpack and record the orig tarballs first, so that we only # need disk space for one private copy of the unpacked source. @@ -2329,14 +2291,13 @@ sub generate_commits_from_dsc () { my @tartrees; my $orig_f_base = srcfn $upstreamv, ''; - foreach my $fi (@dfi) { + foreach my $fi (@$dfi) { # We actually import, and record as a commit, every tarball # (unless there is only one file, in which case there seems # little point. my $f = $fi->{Filename}; printdebug "import considering $f "; - (printdebug "only one dfi\n"), next if @dfi == 1; (printdebug "not tar\n"), next unless $f =~ m/\.tar(\.\w+)?$/; (printdebug "signature\n"), next if $f =~ m/$orig_f_sig_re$/o; my $compr_ext = $1; @@ -2348,6 +2309,7 @@ sub generate_commits_from_dsc () { $compr_ext, $orig_f_part ), "\n"; + my $path = $fi->{Path} // $f; my $input = new IO::File $f, '<' or die "$f $!"; my $compr_pid; my @compr_cmd; @@ -2361,9 +2323,9 @@ sub generate_commits_from_dsc () { new Dpkg::Compression::Process compression => $cname; @compr_cmd = $compr_proc->get_uncompress_cmdline(); my $compr_fh = new IO::Handle; - my $compr_pid = open $compr_fh, "-|" // confess $!; + my $compr_pid = open $compr_fh, "-|" // confess "$!"; if (!$compr_pid) { - open STDIN, "<&", $input or confess $!; + open STDIN, "<&", $input or confess "$!"; exec @compr_cmd; die "dgit (child): exec $compr_cmd[0]: $!\n"; } @@ -2371,23 +2333,23 @@ sub generate_commits_from_dsc () { } rmtree "_unpack-tar"; - mkdir "_unpack-tar" or confess $!; + mkdir "_unpack-tar" or confess "$!"; my @tarcmd = qw(tar -x -f - --no-same-owner --no-same-permissions --no-acls --no-xattrs --no-selinux); - my $tar_pid = fork // confess $!; + my $tar_pid = fork // confess "$!"; if (!$tar_pid) { - chdir "_unpack-tar" or confess $!; - open STDIN, "<&", $input or confess $!; + chdir "_unpack-tar" or confess "$!"; + open STDIN, "<&", $input or confess "$!"; exec @tarcmd; die f_ "dgit (child): exec %s: %s", $tarcmd[0], $!; } - $!=0; (waitpid $tar_pid, 0) == $tar_pid or confess $!; + $!=0; (waitpid $tar_pid, 0) == $tar_pid or confess "$!"; !$? or failedcmd @tarcmd; close $input or (@compr_cmd ? ($?==SIGPIPE || failedcmd @compr_cmd) - : confess $!); + : confess "$!"); # finally, we have the results in "tarball", but maybe # with the wrong permissions @@ -2413,6 +2375,7 @@ sub generate_commits_from_dsc () { Sort => (!$orig_f_part ? 2 : $orig_f_part =~ m/-/g ? 1 : 0), + OrigPart => $orig_f_part, # 'orig', 'orig-XXX', or undef F => $f, Tree => $tree, }; @@ -2426,36 +2389,15 @@ sub generate_commits_from_dsc () { $a->{F} cmp $b->{F} } @tartrees; - my $any_orig = grep { $_->{Orig} } @tartrees; - - my $dscfn = "$package.dsc"; - - my $treeimporthow = 'package'; - - open D, ">", $dscfn or die "$dscfn: $!"; - print D $dscdata or die "$dscfn: $!"; - close D or die "$dscfn: $!"; - my @cmd = qw(dpkg-source); - push @cmd, '--no-check' if $dsc_checked; - if (madformat $dsc->{format}) { - push @cmd, '--skip-patches'; - $treeimporthow = 'unpatched'; - } - push @cmd, qw(-x --), $dscfn; - runcmd @cmd; + @tartrees; +} - my ($tree,$dir) = mktree_in_ud_from_only_subdir(__ "source package"); - if (madformat $dsc->{format}) { - check_for_vendor_patches(); - } +sub import_tarball_commits ($$) { + my ($tartrees, $upstreamv) = @_; + # cwd should be a playtree which has a relevant debian/changelog + # fills in $tt->{Commit} for each one - my $dappliedtree; - if (madformat $dsc->{format}) { - my @pcmd = qw(dpkg-source --before-build .); - runcmd shell_cmd 'exec >/dev/null', @pcmd; - rmtree '.pc'; - $dappliedtree = git_add_write_tree(); - } + my $any_orig = grep { $_->{Orig} } @$tartrees; my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all); my $clogp; @@ -2509,20 +2451,22 @@ sub generate_commits_from_dsc () { $changes =~ s/^\n//; # Changes: \n my $cversion = getfield $clogp, 'Version'; - if (@tartrees) { + my $r1authline; + if (@$tartrees) { $r1clogp //= $clogp; # maybe there's only one entry; - my $r1authline = clogp_authline $r1clogp; + $r1authline = clogp_authline $r1clogp; # Strictly, r1authline might now be wrong if it's going to be # unused because !$any_orig. Whatever. printdebug "import tartrees authline $authline\n"; printdebug "import tartrees r1authline $r1authline\n"; - foreach my $tt (@tartrees) { + foreach my $tt (@$tartrees) { printdebug "import tartree $tt->{F} $tt->{Tree}\n"; - my $mbody = f_ "Import %s", $tt->{F}; - $tt->{Commit} = make_commit_text($tt->{Orig} ? <{F}; + $tt->{Commit} = hash_commit_text($tt->{Orig} ? <{Tree} author $r1authline committer $r1authline @@ -2542,16 +2486,114 @@ END_T } } + return ($authline, $r1authline, $clogp, $changes); +} + +sub generate_commits_from_dsc () { + # See big comment in fetch_from_archive, below. + # See also README.dsc-import. + prep_ud(); + changedir $playground; + + my $bpd_abs = bpd_abs(); + my $upstreamv = upstreamversion $dsc->{version}; + my @dfi = dsc_files_info(); + + dotdot_bpd_transfer_origs $bpd_abs, $upstreamv, + sub { grep { $_->{Filename} eq $_[0] } @dfi }; + + foreach my $fi (@dfi) { + my $f = $fi->{Filename}; + die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#; + my $upper_f = "$bpd_abs/$f"; + + printdebug "considering reusing $f: "; + + if (link_ltarget "$upper_f,fetch", $f) { + printdebug "linked (using ...,fetch).\n"; + } elsif ((printdebug "($!) "), + $! != ENOENT) { + fail f_ "accessing %s: %s", "$buildproductsdir/$f,fetch", $!; + } elsif (link_ltarget $upper_f, $f) { + printdebug "linked.\n"; + } elsif ((printdebug "($!) "), + $! != ENOENT) { + fail f_ "accessing %s: %s", "$buildproductsdir/$f", $!; + } else { + printdebug "absent.\n"; + } + + my $refetched; + complete_file_from_dsc('.', $fi, \$refetched) + or next; + + printdebug "considering saving $f: "; + + if (rename_link_xf 1, $f, $upper_f) { + printdebug "linked.\n"; + } elsif ((printdebug "($@) "), + $! != EEXIST) { + fail f_ "saving %s: %s", "$buildproductsdir/$f", $@; + } elsif (!$refetched) { + printdebug "no need.\n"; + } elsif (rename_link_xf 1, $f, "$upper_f,fetch") { + printdebug "linked (using ...,fetch).\n"; + } elsif ((printdebug "($@) "), + $! != EEXIST) { + fail f_ "saving %s: %s", "$buildproductsdir/$f,fetch", $@; + } else { + printdebug "cannot.\n"; + } + } + + my @tartrees; + @tartrees = import_tarball_tartrees($upstreamv, \@dfi) + unless @dfi == 1; # only one file in .dsc + + my $dscfn = "$package.dsc"; + + my $treeimporthow = 'package'; + + open D, ">", $dscfn or die "$dscfn: $!"; + print D $dscdata or die "$dscfn: $!"; + close D or die "$dscfn: $!"; + my @cmd = qw(dpkg-source); + push @cmd, '--no-check' if $dsc_checked; + if (madformat $dsc->{format}) { + push @cmd, '--skip-patches'; + $treeimporthow = 'unpatched'; + } + push @cmd, qw(-x --), $dscfn; + runcmd @cmd; + + my ($tree,$dir) = mktree_in_ud_from_only_subdir(__ "source package"); + if (madformat $dsc->{format}) { + check_for_vendor_patches(); + } + + my $dappliedtree; + if (madformat $dsc->{format}) { + my @pcmd = qw(dpkg-source --before-build .); + runcmd shell_cmd 'exec >/dev/null', @pcmd; + rmtree '.pc'; + $dappliedtree = git_add_write_tree(); + } + + my ($authline, $r1authline, $clogp, $changes) = + import_tarball_commits(\@tartrees, $upstreamv); + + my $cversion = getfield $clogp, 'Version'; + printdebug "import main commit\n"; - open C, ">../commit.tmp" or confess $!; - print C <../commit.tmp" or confess "$!"; + print C <{Commit} END - print C <{format}) { printdebug "import apply patches...\n"; # regularise the state of the working tree so that # the checkout of $rawimport_hash works nicely. - my $dappliedcommit = make_commit_text(< 1, - Message => (f_ < (sprintf < 0) { @@ -2671,7 +2716,7 @@ Version actually in archive: %s (older) Last version pushed with dgit: %s (newer or same) %s END - __ $later_warning_msg or confess $!; + __ $later_warning_msg or confess "$!"; @output = $lastpush_mergeinput; } else { # Same version. Use what's in the server git branch, @@ -2701,7 +2746,7 @@ sub complete_file_from_dsc ($$;$) { open F, "<", "$tf" or die "$tf: $!"; $fi->{Digester}->reset(); $fi->{Digester}->addfile(*F); - F->error and confess $!; + F->error and confess "$!"; $got = $fi->{Digester}->hexdigest(); return $got eq $fi->{Hash}; }; @@ -2835,7 +2880,7 @@ sub git_lrfetch_sane { debugcmd "|",@lcmd; my %wantr; - open GITLS, "-|", @lcmd or confess $!; + open GITLS, "-|", @lcmd or confess "$!"; while () { printdebug "=> ", $_; m/^(\w+)\s+(\S+)\n/ or die "ls-remote $_ ?"; @@ -2942,11 +2987,7 @@ sub git_fetch_us () { # deliberately-not-ff, in which case we must fetch everything. my @specs = deliberately_not_fast_forward ? qw(tags/*) : - map { "tags/$_" } - (quiltmode_splitbrain - ? (map { $_->('*',access_nomdistro) } - \&debiantag_new, \&debiantag_maintview) - : debiantags('*',access_nomdistro)); + map { "tags/$_" } debiantags('*',access_nomdistro); push @specs, server_branch($csuite); push @specs, $rewritemap; push @specs, qw(heads/*) if deliberately_not_fast_forward; @@ -3257,7 +3298,7 @@ sub fetch_from_archive () { printdebug "del_lrfetchrefs: $objid $fullrefname\n"; if (!$gur) { $gur ||= new IO::Handle; - open $gur, "|-", qw(git update-ref --stdin) or confess $!; + open $gur, "|-", qw(git update-ref --stdin) or confess "$!"; } printf $gur "delete %s %s\n", $fullrefname, $objid; } @@ -3278,7 +3319,7 @@ Commit referred to by archive: %s Last version pushed with dgit: %s %s END - __ $later_warning_msg or confess $!; + __ $later_warning_msg or confess "$!"; @mergeinputs = ($lastpush_mergeinput); } else { # Archive has .dsc which is not a descendant of the last dgit @@ -3313,11 +3354,11 @@ END Package not found in the archive, but has allegedly been pushed using dgit. %s END - __ $later_warning_msg or confess $!; + __ $later_warning_msg or confess "$!"; } else { printdebug "nothing found!\n"; if (defined $skew_warning_vsn) { - print STDERR f_ <", $mcf or die "$mcf $!"; - print MC <{Commit} } @mergeinputs; @parents = reverse @parents if $compat_info->{ReverseParents}; - print MC <{Commit} END - print MC <{Message}) { - print MC $compat_info->{Message} or confess $!; + print MC $compat_info->{Message} or confess "$!"; } else { - print MC f_ <{Info} - or confess $!; + or confess "$!"; }; $message_add_info->($mergeinputs[0]); - print MC __ <($_) foreach @mergeinputs[1..$#mergeinputs]; } - close MC or confess $!; - $hash = make_commit $mcf; + close MC or confess "$!"; + $hash = hash_commit $mcf; } else { $hash = $mergeinputs[0]{Commit}; } @@ -3446,7 +3487,7 @@ END my $got_vsn = getfield $gotclogp, 'Version'; printdebug "SKEW CHECK GOT $got_vsn\n"; if (version_compare($got_vsn, $skew_warning_vsn) < 0) { - print STDERR f_ <) { chomp; next if m{^debian/changelog\s}; - print NATTRS $_, "\n" or confess $!; + print NATTRS $_, "\n" or confess "$!"; } - ATTRS->error and confess $!; + ATTRS->error and confess "$!"; close ATTRS; } - print NATTRS "debian/changelog merge=$driver\n" or confess $!; + print NATTRS "debian/changelog merge=$driver\n" or confess "$!"; close NATTRS; set_local_git_config "$cb.name", __ 'debian/changelog merge driver'; @@ -3551,7 +3592,7 @@ sub is_gitattrs_setup () { printdebug "is_gitattrs_setup: found old macro\n"; return 0; } - $gai->error and confess $!; + $gai->error and confess "$!"; printdebug "is_gitattrs_setup: found nothing\n"; return undef; } @@ -3572,8 +3613,8 @@ END my $af = "$maindir_gitcommon/info/attributes"; ensuredir "$maindir_gitcommon/info"; - open GAO, "> $af.new" or confess $!; - print GAO < $af.new" or confess "$!"; + print GAO <error and confess $!; + $gai->error and confess "$!"; } - close GAO or confess $!; + close GAO or confess "$!"; rename "$af.new", "$af" or fail f_ "install %s: %s", $af, $!; } @@ -3610,7 +3651,7 @@ sub check_gitattrs ($$) { my @cmd = (@git, qw(ls-tree -lrz --), "${treeish}:"); debugcmd "|",@cmd; my $gafl = new IO::File; - open $gafl, "-|", @cmd or confess $!; + open $gafl, "-|", @cmd or confess "$!"; while (<$gafl>) { chomp or die; s/^\d+\s+\w+\s+\w+\s+(\d+)\t// or die; @@ -3635,7 +3676,7 @@ sub multisuite_suite_child ($$$) { # in child, sets things up, calls $fn->(), and returns undef # in parent, returns canonical suite name for $tsuite my $canonsuitefh = IO::File::new_tmpfile; - my $pid = fork // confess $!; + my $pid = fork // confess "$!"; if (!$pid) { forkcheck_setup(); $isuite = $tsuite; @@ -3643,17 +3684,17 @@ sub multisuite_suite_child ($$$) { $debugprefix .= " "; progress f_ "fetching %s...", $tsuite; canonicalise_suite(); - print $canonsuitefh $csuite, "\n" or confess $!; - close $canonsuitefh or confess $!; + print $canonsuitefh $csuite, "\n" or confess "$!"; + close $canonsuitefh or confess "$!"; $fn->(); return undef; } - waitpid $pid,0 == $pid or confess $!; + waitpid $pid,0 == $pid or confess "$!"; fail f_ "failed to obtain %s: %s", $tsuite, waitstatusmsg() if $? && $?!=256*4; - seek $canonsuitefh,0,0 or confess $!; + seek $canonsuitefh,0,0 or confess "$!"; local $csuite = <$canonsuitefh>; - confess $! unless defined $csuite && chomp $csuite; + confess "$!" unless defined $csuite && chomp $csuite; if ($? == 256*4) { printdebug "multisuite $tsuite missing\n"; return $csuite; @@ -3783,7 +3824,7 @@ sub fork_for_multisuite ($) { $commit .= "author $authline\n". "committer $authline\n\n"; - $output = make_commit_text $commit.$msg; + $output = hash_commit_text $commit.$msg; printdebug "multisuite merge generated $output\n"; } @@ -3796,9 +3837,9 @@ sub fork_for_multisuite ($) { } sub clone_set_head () { - open H, "> .git/HEAD" or confess $!; - print H "ref: ".lref()."\n" or confess $!; - close H or confess $!; + open H, "> .git/HEAD" or confess "$!"; + print H "ref: ".lref()."\n" or confess "$!"; + close H or confess "$!"; } sub clone_finish ($) { my ($dstdir) = @_; @@ -3980,18 +4021,18 @@ sub get_source_format () { $options{$_} = 1; } } - F->error and confess $!; + F->error and confess "$!"; close F; } else { - confess $! unless $!==&ENOENT; + confess "$!" unless $!==&ENOENT; } if (!open F, "debian/source/format") { - confess $! unless $!==&ENOENT; + confess "$!" unless $!==&ENOENT; return ''; } $_ = ; - F->error and confess $!; + F->error and confess "$!"; chomp; return ($_, \%options); } @@ -4093,6 +4134,7 @@ sub pseudomerge_version_check ($$) { $cd = $gf->('Distribution'); }; if ($@) { + $@ =~ s/^\n//s; $@ =~ s/^dgit: //gm; fail "$@". f_ "Perhaps debian/changelog does not mention %s ?", $v; @@ -4109,7 +4151,7 @@ END return $i_arch_v; } -sub pseudomerge_make_commit ($$$$ $$) { +sub pseudomerge_hash_commit ($$$$ $$) { my ($clogp, $dgitview, $archive_hash, $i_arch_v, $msg_cmd, $msg_msg) = @_; progress f_ "Declaring that HEAD includes all changes in %s...", @@ -4128,7 +4170,7 @@ sub pseudomerge_make_commit ($$$$ $$) { # git rev-list --first-parent DTRT. my $pmf = dgit_privdir()."/pseudomerge"; open MC, ">", $pmf or die "$pmf $!"; - print MC <[0]; - my $r = pseudomerge_make_commit + my $r = pseudomerge_hash_commit $clogp, $dgitview, $archive_hash, $i_arch_v, "dgit --quilt=$quilt_mode", (defined $overwrite_version @@ -4223,7 +4265,7 @@ sub plain_overwrite_pseudomerge ($$$) { my $m = f_ "Declare fast forward from %s", $i_arch_v->[0]; - my $r = pseudomerge_make_commit + my $r = pseudomerge_hash_commit $clogp, $head, $archive_hash, $i_arch_v, "dgit", $m; @@ -4248,7 +4290,7 @@ sub push_parse_changelog ($) { if (!$we_are_initiator) { # rpush initiator can't do this because it doesn't have $isuite yet - my $tag = debiantag($cversion, access_nomdistro); + my $tag = debiantag_new($cversion, access_nomdistro); runcmd @git, qw(check-ref-format), $tag; } @@ -4272,7 +4314,7 @@ sub push_tagwants ($$$$) { my ($cversion, $dgithead, $maintviewhead, $tfbase) = @_; my @tagwants; push @tagwants, { - TagFn => \&debiantag, + TagFn => \&debiantag_new, Objid => $dgithead, TfSuffix => '', View => 'dgit', @@ -4284,14 +4326,7 @@ sub push_tagwants ($$$$) { TfSuffix => '-maintview', View => 'maint', }; - } elsif ($dodep14tag eq 'no' ? 0 - : $dodep14tag eq 'want' ? access_cfg_tagformats_can_splitbrain - : $dodep14tag eq 'always' - ? (access_cfg_tagformats_can_splitbrain or fail < \&debiantag_maintview, Objid => $dgithead, @@ -4319,7 +4354,7 @@ sub push_mktags ($$ $$ $) { $dsc->{$ourdscfield[0]} = join " ", $tagwants->[0]{Objid}, $declaredistro, $tagwants->[0]{Tag}, $reader_giturl; - $dsc->save("$dscfn.tmp") or confess $!; + $dsc->save("$dscfn.tmp") or confess "$!"; my $changes = parsecontrol($changesfile,$changesfilewhat); foreach my $field (qw(Source Distribution Version)) { @@ -4330,11 +4365,11 @@ sub push_mktags ($$ $$ $) { my $cversion = getfield $clogp, 'Version'; my $clogsuite = getfield $clogp, 'Distribution'; + my $format = getfield $dsc, 'Format'; # We make the git tag by hand because (a) that makes it easier # to control the "tagger" (b) we can do remote signing my $authline = clogp_authline $clogp; - my $delibs = join(" ", "",@deliberatelies); my $mktag = sub { my ($tw) = @_; @@ -4342,39 +4377,51 @@ sub push_mktags ($$ $$ $) { my $head = $tw->{Objid}; my $tag = $tw->{Tag}; - open TO, '>', $tfn->('.tmp') or confess $!; - print TO <', $tfn->('.tmp') or confess "$!"; + print TO <{View} eq 'dgit') { - print TO f_ <{View} eq 'dgit') { + print TO sprintf <{View} eq 'maint') { - print TO f_ <('.tmp'); if ($sign) { @@ -4384,7 +4431,7 @@ END if (!defined $keyid) { $keyid = getfield $clogp, 'Maintainer'; } - unlink $tfn->('.tmp.asc') or $!==&ENOENT or confess $!; + unlink $tfn->('.tmp.asc') or $!==&ENOENT or confess "$!"; my @sign_cmd = (@gpg, qw(--detach-sign --armor)); push @sign_cmd, qw(-u),$keyid if defined $keyid; push @sign_cmd, $tfn->('.tmp'); @@ -4435,14 +4482,10 @@ Push failed, while preparing your push. You can retry the push, after fixing the problem, if you like. END - need_tagformat 'new', "quilt mode $quilt_mode" - if quiltmode_splitbrain; - prep_ud(); access_giturl(); # check that success is vaguely likely rpush_handle_protovsn_bothends() if $we_are_initiator; - select_tagformat(); my $clogpfn = dgit_privdir()."/changelog.822.tmp"; runcmd shell_cmd "exec >$clogpfn", qw(dpkg-parsechangelog); @@ -4462,13 +4505,12 @@ END push_parse_dsc($dscpath, $dscfn, $cversion); my $format = getfield $dsc, 'Format'; - printdebug "format $format\n"; my $symref = git_get_symref(); my $actualhead = git_rev_parse('HEAD'); if (branch_is_gdr_unstitched_ff($symref, $actualhead, $archive_hash)) { - if (quiltmode_splitbrain()) { + if (quiltmode_splitting()) { my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $actualhead); fail f_ <&STDOUT" or confess $!; + open PI, "<&STDIN" or confess "$!"; + open STDIN, "/dev/null" or confess "$!"; + open PO, ">&STDOUT" or confess "$!"; autoflush PO 1; - open STDOUT, ">&STDERR" or confess $!; + open STDOUT, ">&STDERR" or confess "$!"; autoflush STDOUT 1; $vsnwant //= 1; @@ -5021,10 +5070,6 @@ sub cmd_remote_push_responder { cmd_remote_push_build_host(); } # a good error message) sub rpush_handle_protovsn_bothends () { - if ($protovsn < 4) { - need_tagformat 'old', "rpush negotiated protocol $protovsn"; - } - select_tagformat(); } our $i_tmp; @@ -5092,7 +5137,6 @@ sub cmd_rpush { changedir $i_tmp; ($protovsn) = initiator_expect { m/^dgit-remote-push-ready (\S+)/ }; die "$protovsn ?" unless grep { $_ eq $protovsn } @rpushprotovsn_support; - $supplementary_message = '' unless $protovsn >= 3; for (;;) { my ($icmd,$iargs) = initiator_expect { @@ -5119,7 +5163,7 @@ sub i_resp_complete { $i_child_pid = undef; # prevents killing some other process with same pid printdebug "waiting for build host child $pid...\n"; my $got = waitpid $pid, 0; - confess $! unless $got == $pid; + confess "$!" unless $got == $pid; fail f_ "build host child failed: %s", waitstatusmsg() if $?; i_cleanup(); @@ -5153,6 +5197,7 @@ sub i_resp_previously ($) { } our %i_wanted; +our ($i_clogp, $i_version, $i_dscfn, $i_changesfn, @i_buildinfos); sub i_resp_want ($) { my ($keyword) = @_; @@ -5162,24 +5207,27 @@ sub i_resp_want ($) { $isuite = $i_param{'isuite'} // $i_param{'csuite'}; die unless $isuite =~ m/^$suite_re$/; - pushing(); - rpush_handle_protovsn_bothends(); - - fail f_ "rpush negotiated protocol version %s". - " which does not support quilt mode %s", - $protovsn, $quilt_mode - if quiltmode_splitbrain; + if (!defined $dsc) { + pushing(); + rpush_handle_protovsn_bothends(); + push_parse_dsc $i_dscfn, 'remote dsc', $i_version; + if ($protovsn >= 6) { + determine_whether_split_brain getfield $dsc, 'Format'; + $do_split_brain eq ($i_param{'splitbrain'} // '') + or badproto \*RO, + "split brain mismatch, $do_split_brain != $i_param{'split_brain'}"; + printdebug "rpush split brain $do_split_brain\n"; + } + } my @localpaths = i_method "i_want", $keyword; printdebug "[[ $keyword @localpaths\n"; foreach my $localpath (@localpaths) { protocol_send_file \*RI, $localpath; } - print RI "files-end\n" or confess $!; + print RI "files-end\n" or confess "$!"; } -our ($i_clogp, $i_version, $i_dscfn, $i_changesfn, @i_buildinfos); - sub i_localname_parsed_changelog { return "remote-changelog.822"; } @@ -5239,16 +5287,15 @@ sub i_want_signed_tag { my $maintview = $i_param{'maint-view'}; die if defined $maintview && $maintview =~ m/[^0-9a-f]/; - select_tagformat(); - if ($protovsn >= 4) { + if ($protovsn == 4) { my $p = $i_param{'tagformat'} // ''; - $p eq $tagformat - or badproto \*RO, "tag format mismatch: $p vs. $tagformat"; + $p eq 'new' + or badproto \*RO, "tag format mismatch: $p vs. new"; } die unless $i_param{'csuite'} =~ m/^$suite_re$/; $csuite = $&; - push_parse_dsc $i_dscfn, 'remote dsc', $i_version; + defined $dsc or badproto \*RO, "dsc (before parsed-changelog)"; my @tagwants = push_tagwants $i_version, $head, $maintview, "tag"; @@ -5282,13 +5329,13 @@ sub quiltify_dpkg_commit ($$$;$) { my $descfn = ".git/dgit/quilt-description.tmp"; open O, '>', $descfn or confess "$descfn: $!"; $msg =~ s/\n+/\n\n/; - print O <{O2H} & 01)) { my $msg = f_ "--quilt=%s specified, implying patches-unapplied git tree\n". " but git tree differs from orig in upstream files.", $quilt_mode; $msg .= $fulldiffhint->($unapplied, 'HEAD'); - if (!stat_exists "debian/patches") { + if (!stat_exists "debian/patches" and $quilt_mode !~ m/baredebian/) { $msg .= __ "\n ... debian/patches is missing; perhaps this is a patch queue branch?"; } @@ -5426,9 +5467,24 @@ sub quiltify_splitbrain ($$$$$$$) { but git tree differs from result of applying debian/patches to upstream END } - if ($quilt_mode =~ m/gbp|unapplied/ && + if ($quilt_mode =~ m/baredebian/) { + # We need to construct a merge which has upstream files from + # upstream and debian/ files from HEAD. + + read_tree_upstream $quilt_upstream_commitish, 1, $headref; + my $version = getfield $clogp, 'Version'; + my $upsversion = upstreamversion $version; + my $merge = make_commit + [ $headref, $quilt_upstream_commitish ], + [ +(f_ <{O2A} & 01)) { # some patches - quiltify_splitbrain_needed(); progress __ "dgit view: creating patches-applied version using gbp pq"; runcmd shell_cmd 'exec >/dev/null', gbp_pq, qw(import); # gbp pq import creates a fresh branch; push back to dgit-view @@ -5445,7 +5501,6 @@ END } 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"; ensuredir "debian/patches"; @@ -5470,12 +5525,12 @@ ENDU close GIPATCH or die "$gipatch: $!"; runcmd shell_cmd "exec >>$gipatch", @git, qw(diff), $unapplied, $headref, "--", sort keys %$editedignores; - open SERIES, "+>>", "debian/patches/series" or confess $!; - defined seek SERIES, -1, 2 or $!==EINVAL or confess $!; + open SERIES, "+>>", "debian/patches/series" or confess "$!"; + defined seek SERIES, -1, 2 or $!==EINVAL or confess "$!"; my $newline; - defined read SERIES, $newline, 1 or confess $!; - print SERIES "\n" or confess $! unless $newline eq "\n"; - print SERIES "auto-gitignore\n" or confess $!; + defined read SERIES, $newline, 1 or confess "$!"; + print SERIES "\n" or confess "$!" unless $newline eq "\n"; + print SERIES "auto-gitignore\n" or confess "$!"; close SERIES or die $!; runcmd @git, qw(add -f -- debian/patches/series), $gipatch; commit_admin +(__ <{'single-debian-patch'} - && branch_is_gdr($headref)) { - # This is much faster. It also makes patches that gdr - # likes better for future updates without laundering. - # - # However, it can fail in some casses where we would - # succeed: if there are existing patches, which correspond - # to a prefix of the branch, but are not in gbp/gdr - # format, gdr will fail (exiting status 7), but we might - # be able to figure out where to start linearising. That - # will be slower so hopefully there's not much to do. - my @cmd = (@git_debrebase, - qw(--noop-ok -funclean-mixed -funclean-ordering - make-patches --quiet-would-amend)); - # We tolerate soe snags that gdr wouldn't, by default. - if (act_local()) { - debugcmd "+",@cmd; - $!=0; $?=-1; - failedcmd @cmd - if system @cmd - and not ($? == 7*256 or - $? == -1 && $!==ENOENT); - } else { - dryrun_report @cmd; - } - $headref = git_rev_parse('HEAD'); - } + my $upstreamversion = upstreamversion $version; prep_ud(); changedir $playground; - my $upstreamversion = upstreamversion $version; + my $splitbrain_cachekey; + + if (do_split_brain()) { + my $cachehit; + ($cachehit, $splitbrain_cachekey) = + quilt_check_splitbrain_cache($headref, $upstreamversion); + if ($cachehit) { + changedir $maindir; + return; + } + } + + unpack_playtree_need_cd_work($headref); + if (do_split_brain()) { + runcmd @git, qw(checkout -q -b dgit-view); + # so long as work is not deleted, its current branch will + # remain dgit-view, rather than master, so subsequent calls to + # unpack_playtree_need_cd_work + # will DTRT, resetting dgit-view. + confess if $made_split_brain; + $made_split_brain = 1; + } + chdir '..'; if ($fopts->{'single-debian-patch'}) { + fail f_ + "quilt mode %s does not make sense (or is not supported) with single-debian-patch", + $quilt_mode + if quiltmode_splitting(); quilt_fixup_singlepatch($clogp, $headref, $upstreamversion); } else { - quilt_fixup_multipatch($clogp, $headref, $upstreamversion); + quilt_fixup_multipatch($clogp, $headref, $upstreamversion, + $splitbrain_cachekey); + } + + if (do_split_brain()) { + my $dgitview = git_rev_parse 'HEAD'; + + changedir $maindir; + reflog_cache_insert "refs/$splitbraincache", + $splitbrain_cachekey, $dgitview; + + changedir "$playground/work"; + + my $saved = maybe_split_brain_save $headref, $dgitview, __ "converted"; + progress f_ "dgit view: created (%s)", $saved; } changedir $maindir; @@ -5842,12 +5890,22 @@ END @git, qw(pull --ff-only -q), "$playground/work", qw(master); } -sub unpack_playtree_mkwork ($) { +sub build_check_quilt_splitbrain () { + build_maybe_quilt_fixup(); +} + +sub unpack_playtree_need_cd_work ($) { my ($headref) = @_; - mkdir "work" or confess $!; - changedir "work"; - mktree_in_ud_here(); + # prep_ud() must have been called already. + if (!chdir "work") { + # Check in the filesystem because sometimes we run prep_ud + # in between multiple calls to unpack_playtree_need_cd_work. + confess "$!" unless $!==ENOENT; + mkdir "work" or confess "$!"; + changedir "work"; + mktree_in_ud_here(); + } runcmd @git, qw(reset -q --hard), $headref; } @@ -5896,7 +5954,7 @@ sub quilt_fixup_singlepatch ($$$) { # necessary to build the source package. unpack_playtree_linkorigs($upstreamversion, sub { }); - unpack_playtree_mkwork($headref); + unpack_playtree_need_cd_work($headref); rmtree("debian/patches"); @@ -5912,13 +5970,18 @@ sub quilt_fixup_singlepatch ($$$) { commit_quilty_patch(); } -sub quilt_make_fake_dsc ($) { +sub quilt_need_fake_dsc ($) { + # cwd should be playground my ($upstreamversion) = @_; + return if stat_exists "fake.dsc"; + # ^ OK to test this as a sentinel because if we created it + # we must either have done the rest too, or crashed. + my $fakeversion="$upstreamversion-~~DGITFAKE"; - my $fakedsc=new IO::File 'fake.dsc', '>' or confess $!; - print $fakedsc <' or confess "$!"; + print $fakedsc <addfile($fh); - print $fakedsc " ".$md->hexdigest." $size $leaf\n" or confess $!; + print $fakedsc " ".$md->hexdigest." $size $leaf\n" or confess "$!"; }; unpack_playtree_linkorigs($upstreamversion, $dscaddfile); @@ -5952,14 +6015,15 @@ END runcmd qw(env GZIP=-1n tar -zcf), "./$debtar", qw(-C), $maindir, @files; $dscaddfile->($debtar); - close $fakedsc or confess $!; + close $fakedsc or confess "$!"; } sub quilt_fakedsc2unapplied ($$) { my ($headref, $upstreamversion) = @_; # must be run in the playground - # quilt_make_fake_dsc must have been called + # quilt_need_fake_dsc must have been called + quilt_need_fake_dsc($upstreamversion); runcmd qw(sh -ec), 'exec dpkg-source --no-check --skip-patches -x fake.dsc >/dev/null'; @@ -5987,6 +6051,8 @@ sub quilt_check_splitbrain_cache ($$) { # Computes the cache key and looks in the cache. # Returns ($dgit_view_commitid, $cachekey) or (undef, $cachekey) + quilt_need_fake_dsc($upstreamversion); + my $splitbrain_cachekey; progress f_ @@ -5998,6 +6064,7 @@ sub quilt_check_splitbrain_cache ($$) { push @cachekey, $upstreamversion; push @cachekey, $quilt_mode; push @cachekey, $headref; + push @cachekey, $quilt_upstream_commitish // '-'; push @cachekey, hashfile('fake.dsc'); @@ -6018,12 +6085,12 @@ sub quilt_check_splitbrain_cache ($$) { "refs/$splitbraincache", $splitbrain_cachekey; if ($cachehit) { - unpack_playtree_mkwork($headref); + unpack_playtree_need_cd_work($headref); my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit"; if ($cachehit ne $headref) { progress f_ "dgit view: found cached (%s)", $saved; runcmd @git, qw(checkout -q -b dgit-view), $cachehit; - $split_brain = 1; + $made_split_brain = 1; return ($cachehit, $splitbrain_cachekey); } progress __ "dgit view: found cached, no changes required"; @@ -6034,8 +6101,32 @@ sub quilt_check_splitbrain_cache ($$) { return (undef, $splitbrain_cachekey); } +sub baredebian_origtarballs_scan ($$$) { + my ($fakedfi, $upstreamversion, $dir) = @_; + if (!opendir OD, $dir) { + return if $! == ENOENT; + fail "opendir $dir (origs): $!"; + } + + while ($!=0, defined(my $leaf = readdir OD)) { + { + local ($debuglevel) = $debuglevel-1; + printdebug "BDOS $dir $leaf ?\n"; + } + next unless is_orig_file_of_vsn $leaf, $upstreamversion; + next if grep { $_->{Filename} eq $leaf } @$fakedfi; + push @$fakedfi, { + Filename => $leaf, + Path => "$dir/$leaf", + }; + } + + die "$dir; $!" if $!; + closedir OD; +} + sub quilt_fixup_multipatch ($$$) { - my ($clogp, $headref, $upstreamversion) = @_; + my ($clogp, $headref, $upstreamversion, $splitbrain_cachekey) = @_; progress f_ "examining quilt state (multiple patches, %s mode)", $quilt_mode; @@ -6109,16 +6200,39 @@ sub quilt_fixup_multipatch ($$$) { # afterwards with dpkg-source --before-build. That lets us save a # tree object corresponding to .origs. - my $splitbrain_cachekey; + if ($quilt_mode eq 'linear' + && branch_is_gdr($headref)) { + # This is much faster. It also makes patches that gdr + # likes better for future updates without laundering. + # + # However, it can fail in some casses where we would + # succeed: if there are existing patches, which correspond + # to a prefix of the branch, but are not in gbp/gdr + # format, gdr will fail (exiting status 7), but we might + # be able to figure out where to start linearising. That + # will be slower so hopefully there's not much to do. - quilt_make_fake_dsc($upstreamversion); + unpack_playtree_need_cd_work $headref; - if (quiltmode_splitbrain()) { - my $cachehit; - ($cachehit, $splitbrain_cachekey) = - quilt_check_splitbrain_cache($headref, $upstreamversion); - return if $cachehit; + my @cmd = (@git_debrebase, + qw(--noop-ok -funclean-mixed -funclean-ordering + make-patches --quiet-would-amend)); + # We tolerate soe snags that gdr wouldn't, by default. + if (act_local()) { + debugcmd "+",@cmd; + $!=0; $?=-1; + failedcmd @cmd + if system @cmd + and not ($? == 7*256 or + $? == -1 && $!==ENOENT); + } else { + dryrun_report @cmd; + } + $headref = git_rev_parse('HEAD'); + + chdir '..'; } + my $unapplied=quilt_fakedsc2unapplied($headref, $upstreamversion); ensuredir '.pc'; @@ -6137,7 +6251,7 @@ END changedir '..'; - unpack_playtree_mkwork($headref); + unpack_playtree_need_cd_work($headref); my $mustdeletepc=0; if (stat_exists ".pc") { @@ -6145,7 +6259,7 @@ END progress __ "Tree already contains .pc - will use it then delete it."; $mustdeletepc=1; } else { - rename '../fake/.pc','.pc' or confess $!; + rename '../fake/.pc','.pc' or confess "$!"; } changedir '../fake'; @@ -6158,15 +6272,97 @@ END # We calculate some guesswork now about what kind of tree this might # be. This is mostly for error reporting. + my $tentries = cmdoutput @git, qw(ls-tree --name-only -z), $headref; + my $onlydebian = $tentries eq "debian\0"; + + my $uheadref = $headref; + my $uhead_whatshort = 'HEAD'; + + if ($quilt_mode =~ m/baredebian\+tarball/) { + # We need to make a tarball import. Yuk. + # We want to do this here so that we have a $uheadref value + + my @fakedfi; + baredebian_origtarballs_scan \@fakedfi, $upstreamversion, bpd_abs(); + baredebian_origtarballs_scan \@fakedfi, $upstreamversion, + "$maindir/.." unless $buildproductsdir eq '..'; + changedir '..'; + + my @tartrees = import_tarball_tartrees $upstreamversion, \@fakedfi; + + fail __ "baredebian quilt fixup: could not find any origs" + unless @tartrees; + + changedir 'work'; + my ($authline, $r1authline, $clogp,) = + import_tarball_commits \@tartrees, $upstreamversion; + + if (@tartrees == 1) { + $uheadref = $tartrees[0]{Commit}; + # TRANSLATORS: this translation must fit in the ASCII art + # quilt differences display. The untranslated display + # says %9.9s, so with that display it must be at most 9 + # characters. + $uhead_whatshort = __ 'tarball'; + } else { + # on .dsc import we do not make a separate commit, but + # here we need to do so + rm_subdir_cached '.'; + my $parents; + foreach my $ti (@tartrees) { + my $c = $ti->{Commit}; + if ($ti->{OrigPart} eq 'orig') { + runcmd qw(git read-tree), $c; + } elsif ($ti->{OrigPart} =~ m/orig-/) { + read_tree_subdir $', $c; + } else { + confess "$ti->OrigPart} ?" + } + $parents .= "parent $c\n"; + } + my $tree = git_write_tree(); + my $mbody = f_ 'Combine orig tarballs for %s %s', + $package, $upstreamversion; + $uheadref = hash_commit_text < quiltify_trees_differ($unapplied,$headref, 1, + O2H => quiltify_trees_differ($unapplied,$uheadref, 1, \%editedignores, \@unrepres), - H2A => quiltify_trees_differ($headref, $oldtiptree,1), + H2A => quiltify_trees_differ($uheadref, $oldtiptree,1), O2A => quiltify_trees_differ($unapplied,$oldtiptree,1), }; @@ -6181,13 +6377,23 @@ END progress f_ "%s: base trees orig=%.20s o+d/p=%.20s", $us, $unapplied, $oldtiptree; + # TRANSLATORS: Try to keep this ascii-art layout right. The 0s in + # %9.00009s will be ignored and are there to make the format the + # same length (9 characters) as the output it generates. If you + # change the value 9, your translations of "upstream" and + # 'tarball' must fit into the new length, and you should change + # the number of 0s. Do not reduce it below 4 as HEAD has to fit + # too. progress f_ "%s: quilt differences: src: %s orig %s gitignores: %s orig %s\n". -"%s: quilt differences: HEAD %s o+d/p HEAD %s o+d/p", +"%s: quilt differences: %9.00009s %s o+d/p %9.00009s %s o+d/p", $us, $dl[0], $dl[1], $dl[3], $dl[4], - $us, $dl[2], $dl[5]; + $us, $uhead_whatshort, $dl[2], $uhead_whatshort, $dl[5]; - if (@unrepres) { + if (@unrepres && $quilt_mode !~ m/baredebian/) { + # With baredebian, even if the upstream commitish has this + # problem, we don't want to print this message, as nothing + # is going to try to make a patch out of it anyway. print STDERR f_ "dgit: cannot represent change: %s: %s\n", $_->[1], $_->[0] foreach @unrepres; @@ -6197,7 +6403,11 @@ END } my @failsuggestion; - if (!($diffbits->{O2H} & $diffbits->{O2A})) { + if ($onlydebian) { + push @failsuggestion, [ 'onlydebian', __ + "This has only a debian/ directory; you probably want --quilt=bare debian." ] + unless $quilt_mode =~ m/baredebian/; + } elsif (!($diffbits->{O2H} & $diffbits->{O2A})) { push @failsuggestion, [ 'unapplied', __ "This might be a patches-unapplied branch." ]; } elsif (!($diffbits->{H2A} & $diffbits->{O2A})) { @@ -6212,20 +6422,23 @@ END if stat_exists '.gitattributes'; push @failsuggestion, [ 'origs', __ - "Maybe orig tarball(s) are not identical to git representation?" ]; - - if (quiltmode_splitbrain()) { - quiltify_splitbrain($clogp, $unapplied, $headref, $oldtiptree, - $diffbits, \%editedignores, - $splitbrain_cachekey); + "Maybe orig tarball(s) are not identical to git representation?" ] + unless $onlydebian && $quilt_mode !~ m/baredebian/; + # ^ in that case, we didn't really look properly + + if (quiltmode_splitting()) { + quiltify_splitting($clogp, $unapplied, $headref, $oldtiptree, + $diffbits, \%editedignores, + $splitbrain_cachekey); return; } progress f_ "starting quiltify (multiple patches, %s mode)", $quilt_mode; quiltify($clogp,$headref,$oldtiptree,\@failsuggestion); + runcmd @git, qw(checkout -q), (qw(master dgit-view)[do_split_brain()]); if (!open P, '>>', ".pc/applied-patches") { - $!==&ENOENT or confess $!; + $!==&ENOENT or confess "$!"; } else { close P; } @@ -6244,21 +6457,21 @@ sub quilt_fixup_editor () { open I2, '<', $editing or confess "$editing: $!"; unlink $editing or confess "$editing: $!"; open O, '>', $editing or confess "$editing: $!"; - while () { print O or confess $!; } I1->error and confess $!; + while () { print O or confess "$!"; } I1->error and confess "$!"; my $copying = 0; while () { $copying ||= m/^\-\-\- /; next unless $copying; - print O or confess $!; + print O or confess "$!"; } - I2->error and confess $!; + I2->error and confess "$!"; close O or die $1; finish 0; } sub maybe_apply_patches_dirtily () { - return unless $quilt_mode =~ m/gbp|unapplied/; - print STDERR __ <abs2rel($there,$buildproductsdir); # now $there is relative to bpd, great + printdebug "not in bpd, $f, abs2rel, $there ...\n"; } else { $there = (dirname $maindir)."/$there_from_parent"; # now $there is absoute + printdebug "not in bpd, $f, rel2rel, $there ...\n"; } } elsif ($there =~ m#^/#) { # $there is absolute already + printdebug "not in bpd, $f, abs, $there ...\n"; } else { fail f_ "cannot import %s which seems to be inside working tree!", @@ -7063,7 +7318,7 @@ END my $version = getfield $dsc, 'Version'; my $clogp = commit_getclogp $newhash; my $authline = clogp_authline $clogp; - $newhash = make_commit_text < 1; print STDERR __ "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n" if $dryrun_level == 1; if (!@ARGV) { - print STDERR __ $helpmsg or confess $!; + print STDERR __ $helpmsg or confess "$!"; finish 8; } $cmd = $subcommand = shift @ARGV;