X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=ad6289d53411a4ca155484dc48a1699e4ff6f056;hp=5c8d24a7908eb891ef1ebf5765593100683f47e7;hb=b7dec4080f555d202570cd3293465db52a9139ec;hpb=346892585656da58a8d913cf9f808872a3096823 diff --git a/dgit b/dgit index 5c8d24a7..ad6289d5 100755 --- a/dgit +++ b/dgit @@ -33,6 +33,8 @@ use Digest::SHA; use Digest::MD5; use Config; +use Debian::Dgit; + our $our_version = 'UNRELEASED'; ###substituted### our $rpushprotovsn = 2; @@ -48,11 +50,13 @@ our $changesfile; our $buildproductsdir = '..'; our $new_package = 0; our $ignoredirty = 0; -our $noquilt = 0; our $rmonerror = 1; +our @deliberatelies; our $existing_package = 'dpkg'; our $cleanmode = 'dpkg-source'; our $changes_since_version; +our $quilt_mode; +our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck'; our $we_are_responder; our $initiator_tempdir; @@ -100,20 +104,14 @@ autoflush STDOUT 1; our $remotename = 'dgit'; our @ourdscfield = qw(Dgit Vcs-Dgit-Master); -our $branchprefix = 'dgit'; our $csuite; our $instead_distro; sub lbranch () { return "$branchprefix/$csuite"; } my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$'; sub lref () { return "refs/heads/".lbranch(); } -sub lrref () { return "refs/remotes/$remotename/$branchprefix/$csuite"; } -sub rrref () { return "refs/$branchprefix/$csuite"; } -sub debiantag ($) { - my ($v) = @_; - $v =~ y/~:/_%/; - return "debian/$v"; -} +sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); } +sub rrref () { return server_ref($csuite); } sub stripepoch ($) { my ($vsn) = @_; @@ -163,7 +161,10 @@ sub waitstatusmsg () { sub printdebug { print DEBUG $debugprefix, @_ or die $!; } sub fail { - die $us.($we_are_responder ? " (build host)" : "").": @_\n"; + my $s = "@_\n"; + my $prefix = $us.($we_are_responder ? " (build host)" : "").": "; + $s =~ s/^/$prefix/gm; + die $s; } sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; } @@ -184,11 +185,8 @@ sub changedir ($) { chdir $newdir or die "chdir: $newdir: $!"; } -sub stat_exists ($) { - my ($f) = @_; - return 1 if stat $f; - return 0 if $!==&ENOENT; - die "stat $f: $!"; +sub deliberately ($) { + return !!grep { $_[0] eq $_ } @deliberatelies; } #---------- remote protocol support, common ---------- @@ -524,13 +522,16 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit-distro.debian.git-user-force' => 'dgit', 'dgit-distro.debian.git-proto' => 'git+ssh://', 'dgit-distro.debian.git-path' => '/dgit/debian/repos', + 'dgit-distro.debian.git-check' => 'ssh-cmd', + 'dgit-distro.debian.archive-query-url', 'https://api.ftp-master.debian.org/', + 'dgit-distro.debian.archive-query-tls-key', + '/etc/ssl/certs/%HOST%.pem:/etc/dgit/%HOST%.pem', 'dgit-distro.debian.diverts.alioth' => '/alioth', 'dgit-distro.debian/alioth.git-host' => 'git.debian.org', 'dgit-distro.debian/alioth.git-user-force' => '', 'dgit-distro.debian/alioth.git-proto' => 'git+ssh://', 'dgit-distro.debian/alioth.git-path' => '/git/dgit-repos/repos', - 'dgit-distro.debian.git-check' => 'ssh-cmd', - 'dgit-distro.debian.git-create' => 'ssh-cmd', + 'dgit-distro.debian/alioth.git-create' => 'ssh-cmd', 'dgit-distro.debian.sshpsql-host' => 'mirror.ftp-master.debian.org', 'dgit-distro.debian.upload-host' => 'ftp-master', # for dput 'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/', @@ -771,6 +772,27 @@ sub must_getcwd () { return $d; } +sub archive_api_query_cmd ($) { + my ($subpath) = @_; + my @cmd = qw(curl -sS); + my $url = access_cfg('archive-query-url'); + if ($url =~ m#^https://([-.0-9a-z]+)/#) { + my $host = $1; + my $keys = access_cfg('archive-query-tls-key','RETURN-UNDEF'); + foreach my $key (split /\:/, $keys) { + $key =~ s/\%HOST\%/$host/g; + if (!stat $key) { + fail "for $url: stat $key: $!" unless $!==ENOENT; + next; + } + push @cmd, "--ca-certificate=$key", "--ca-directory=/dev/enoent"; + last; + } + } + push @cmd, $url.$subpath; + return @cmd; +} + our %rmad; sub archive_query ($) { @@ -1409,6 +1431,7 @@ sub clone ($) { } fetch_from_archive() or no_such_package; my $vcsgiturl = $dsc->{'Vcs-Git'}; + $vcsgiturl =~ s/\s+-b\s+\S+//g; if (length $vcsgiturl) { runcmd @git, qw(remote add vcs-git), $vcsgiturl; } @@ -1482,7 +1505,7 @@ sub get_source_format () { sub madformat ($) { my ($format) = @_; return 0 unless $format eq '3.0 (quilt)'; - if ($noquilt) { + if ($quilt_mode eq 'nocheck') { progress "Not doing any fixup of \`$format' due to --no-quilt-fixup"; return 0; } @@ -1538,6 +1561,7 @@ sub push_mktag ($$$$$$$) { # 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); open TO, '>', $tfn->('.tmp') or die $!; print TO <', $descfn or die "$descfn: $!"; + $msg =~ s/\s+$//g; $msg =~ s/\n/\n /g; $msg =~ s/^\s+$/ ./mg; print O <{Version}) - Last (up to) $ncommits git changes, FYI: - . - $msg +Description: $msg Author: $author - +$xinfo --- END close O or die $!; + { local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0; local $ENV{'VISUAL'} = $ENV{'EDITOR'}; @@ -2068,6 +2090,245 @@ END } } +sub quiltify_trees_differ ($$) { + my ($x,$y) = @_; + # returns 1 iff the two tree objects differ other than in debian/ + local $/=undef; + my @cmd = (@git, qw(diff-tree --name-only -z), $x, $y); + my $diffs= cmdoutput @cmd; + foreach my $f (split /\0/, $diffs) { + next if $f eq 'debian'; + return 1; + } + return 0; +} + +sub quiltify_tree_sentinelfiles ($) { + # lists the `sentinel' files present in the tree + my ($x) = @_; + my $r = cmdoutput @git, qw(ls-tree --name-only), $x, + qw(-- debian/rules debian/control); + $r =~ s/\n/,/g; + return $r; +} + +sub quiltify ($$) { + my ($clogp,$target) = @_; + + # Quilt patchification algorithm + # + # We search backwards through the history of the main tree's HEAD + # (T) looking for a start commit S whose tree object is identical + # to to the patch tip tree (ie the tree corresponding to the + # current dpkg-committed patch series). For these purposes + # `identical' disregards anything in debian/ - this wrinkle is + # necessary because dpkg-source treates debian/ specially. + # + # We can only traverse edges where at most one of the ancestors' + # trees differs (in changes outside in debian/). And we cannot + # handle edges which change .pc/ or debian/patches. To avoid + # going down a rathole we avoid traversing edges which introduce + # debian/rules or debian/control. And we set a limit on the + # number of edges we are willing to look at. + # + # If we succeed, we walk forwards again. For each traversed edge + # PC (with P parent, C child) (starting with P=S and ending with + # C=T) to we do this: + # - git checkout C + # - dpkg-source --commit with a patch name and message derived from C + # After traversing PT, we git commit the changes which + # should be contained within debian/patches. + + changedir '../fake'; + mktree_in_ud_here(); + rmtree '.pc'; + runcmd @git, 'add', '.'; + my $oldtiptree=git_write_tree(); + changedir '../work'; + + # The search for the path S..T is breadth-first. We maintain a + # todo list containing search nodes. A search node identifies a + # commit, and looks something like this: + # $p = { + # Commit => $git_commit_id, + # Child => $c, # or undef if P=T + # Whynot => $reason_edge_PC_unsuitable, # in @nots only + # Nontrivial => true iff $p..$c has relevant changes + # }; + + my @todo; + my @nots; + my $sref_S; + my $max_work=100; + my %considered; # saves being exponential on some weird graphs + + my $t_sentinels = quiltify_tree_sentinelfiles $target; + + my $not = sub { + my ($search,$whynot) = @_; + printdebug " search NOT $search->{Commit} $whynot\n"; + $search->{Whynot} = $whynot; + push @nots, $search; + no warnings qw(exiting); + next; + }; + + push @todo, { + Commit => $target, + }; + + while (@todo) { + my $c = shift @todo; + next if $considered{$c->{Commit}}++; + + $not->($c, "maximum search space exceeded") if --$max_work <= 0; + + printdebug "quiltify investigate $c->{Commit}\n"; + + # are we done? + if (!quiltify_trees_differ $c->{Commit}, $oldtiptree) { + printdebug " search finished hooray!\n"; + $sref_S = $c; + last; + } + + if ($quilt_mode eq 'nofix') { + fail "quilt fixup required but quilt mode is \`nofix'\n". + "HEAD commit $c->{Commit} differs from tree implied by ". + " debian/patches (tree object $oldtiptree)"; + } + if ($quilt_mode eq 'smash') { + printdebug " search quitting smash\n"; + last; + } + + my $c_sentinels = quiltify_tree_sentinelfiles $c->{Commit}; + $not->($c, "has $c_sentinels not $t_sentinels") + if $c_sentinels ne $t_sentinels; + + my $commitdata = cmdoutput @git, qw(cat-file commit), $c->{Commit}; + $commitdata =~ m/\n\n/; + $commitdata =~ $`; + my @parents = ($commitdata =~ m/^parent (\w+)$/gm); + @parents = map { { Commit => $_, Child => $c } } @parents; + + $not->($c, "root commit") if !@parents; + + foreach my $p (@parents) { + $p->{Nontrivial}= quiltify_trees_differ $p->{Commit},$c->{Commit}; + } + my $ndiffers = grep { $_->{Nontrivial} } @parents; + $not->($c, "merge ($ndiffers nontrivial parents)") if $ndiffers > 1; + + foreach my $p (@parents) { + printdebug "considering C=$c->{Commit} P=$p->{Commit}\n"; + + my @cmd= (@git, qw(diff-tree -r --name-only), + $p->{Commit},$c->{Commit}, qw(-- debian/patches .pc)); + my $patchstackchange = cmdoutput @cmd; + if (length $patchstackchange) { + $patchstackchange =~ s/\n/,/g; + $not->($p, "changed $patchstackchange"); + } + + printdebug " search queue P=$p->{Commit} ", + ($p->{Nontrivial} ? "NT" : "triv"),"\n"; + push @todo, $p; + } + } + + if (!$sref_S) { + printdebug "quiltify want to smash\n"; + + my $abbrev = sub { + my $x = $_[0]{Commit}; + $x =~ s/(.*?[0-9a-z]{8})[0-9a-z]*$/$1/; + return $; + }; + my $reportnot = sub { + my ($notp) = @_; + my $s = $abbrev->($notp); + my $c = $notp->{Child}; + $s .= "..".$abbrev->($c) if $c; + $s .= ": ".$c->{Whynot}; + return $s; + }; + if ($quilt_mode eq 'linear') { + print STDERR "$us: quilt fixup cannot be linear. Stopped at:\n"; + foreach my $notp (@nots) { + print STDERR "$us: ", $reportnot->($notp), "\n"; + } + fail "quilt fixup naive history linearisation failed.\n". + "Use dpkg-source --commit by hand; or, --quilt=smash for one ugly patch"; + } elsif ($quilt_mode eq 'smash') { + } elsif ($quilt_mode eq 'auto') { + progress "quilt fixup cannot be linear, smashing..."; + } else { + die "$quilt_mode ?"; + } + + my $time = time; + my $ncommits = 3; + my $msg = cmdoutput @git, qw(log), "-n$ncommits"; + + quiltify_dpkg_commit "auto-$version-$target-$time", + (getfield $clogp, 'Maintainer'), + "Automatically generated patch ($clogp->{Version})\n". + "Last (up to) $ncommits git changes, FYI:\n\n". $msg; + return; + } + + progress "quiltify linearisation planning successful, executing..."; + + for (my $p = $sref_S; + my $c = $p->{Child}; + $p = $p->{Child}) { + printdebug "quiltify traverse $p->{Commit}..$c->{Commit}\n"; + next unless $p->{Nontrivial}; + + my $cc = $c->{Commit}; + + my $commitdata = cmdoutput @git, qw(cat-file commit), $cc; + $commitdata =~ m/\n\n/ or die "$c ?"; + $commitdata = $`; + my $msg = $'; #'; + $commitdata =~ m/^author (.*) \d+ [-+0-9]+$/m or die "$cc ?"; + my $author = $1; + + $msg =~ s/^(.*)\n*/$1\n/ or die "$cc $msg ?"; + + 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 $index; + for ($index=''; + stat "debian/patches/$patchname$index"; + $index++) { } + $!==ENOENT or die "$patchname$index $!"; + + runcmd @git, qw(checkout -q), $cc; + + # We use the tip's changelog so that dpkg-source doesn't + # produce complaining messages from dpkg-parsechangelog. None + # of the information dpkg-source gets from the changelog is + # actually relevant - it gets put into the original message + # which dpkg-source provides our stunt editor, and then + # overwritten. + runcmd @git, qw(checkout -q), $target, qw(debian/changelog); + + quiltify_dpkg_commit "$patchname$index", $author, $msg, + "X-Dgit-Generated: $clogp->{Version} $cc\n"; + + runcmd @git, qw(checkout -q), $cc, qw(debian/changelog); + } + + runcmd @git, qw(checkout -q master); +} + sub build_maybe_quilt_fixup () { my $format=get_source_format; return unless madformat $format; @@ -2224,6 +2485,8 @@ sub quilt_fixup_editor () { exit 0; } +#----- other building ----- + sub clean_tree () { if ($cleanmode eq 'dpkg-source') { runcmd_ordryrun_local @dpkgbuildpackage, qw(-T clean); @@ -2361,6 +2624,13 @@ sub cmd_quilt_fixup { build_maybe_quilt_fixup(); } +sub cmd_archive_api_query { + badusage "need only 1 subpath argument" unless @ARGV==1; + my ($subpath) = @ARGV; + my @cmd = archive_api_query_cmd($subpath); + exec @cmd or fail "exec curl: $!\n"; +} + #---------- argument parsing and main program ---------- sub cmd_version { @@ -2430,15 +2700,23 @@ sub parseopts () { $cleanmode = $1; } elsif (m/^--clean=(.*)$/s) { badusage "unknown cleaning mode \`$1'"; + } elsif (m/^--quilt=($quilt_modes_re)$/s) { + push @ropts, $_; + $quilt_mode = $1; + } elsif (m/^--quilt=(.*)$/s) { + badusage "unknown quilt fixup mode \`$1'"; } elsif (m/^--ignore-dirty$/s) { push @ropts, $_; $ignoredirty = 1; } elsif (m/^--no-quilt-fixup$/s) { push @ropts, $_; - $noquilt = 1; + $quilt_mode = 'nocheck'; } elsif (m/^--no-rm-on-error$/s) { push @ropts, $_; $rmonerror = 0; + } elsif (m/^--deliberately-($suite_re)$/s) { + push @ropts, $_; + push @deliberatelies, $&; } else { badusage "unknown long option \`$_'"; } @@ -2470,24 +2748,27 @@ sub parseopts () { } elsif (s/^-c(.*=.*)//s) { push @ropts, $&; push @git, '-c', $1; - } elsif (s/^-d(.*)//s) { + } elsif (s/^-d(.+)//s) { push @ropts, $&; $idistro = $1; - } elsif (s/^-C(.*)//s) { + } elsif (s/^-C(.+)//s) { push @ropts, $&; $changesfile = $1; if ($changesfile =~ s#^(.*)/##) { $buildproductsdir = $1; } - } elsif (s/^-k(.*)//s) { + } elsif (s/^-k(.+)//s) { $keyid=$1; - } elsif (s/^-wn//s) { + } elsif (m/^-[vdCk]$/) { + badusage + "option \`$_' requires an argument (and no space before the argument)"; + } elsif (s/^-wn$//s) { push @ropts, $&; $cleanmode = 'none'; - } elsif (s/^-wg//s) { + } elsif (s/^-wg$//s) { push @ropts, $&; $cleanmode = 'git'; - } elsif (s/^-wd//s) { + } elsif (s/^-wd$//s) { push @ropts, $&; $cleanmode = 'dpkg-source'; } else { @@ -2513,6 +2794,15 @@ if (!@ARGV) { my $cmd = shift @ARGV; $cmd =~ y/-/_/; +if (!defined $quilt_mode) { + $quilt_mode = cfg('dgit.force.quilt-mode', 'RETURN-UNDEF') + // access_cfg('quilt-mode', 'RETURN-UNDEF') + // 'linear'; + $quilt_mode =~ m/^($quilt_modes_re)$/ + or badcfg "unknown quilt-mode \`$quilt_mode'"; + $quilt_mode = $1; +} + my $fn = ${*::}{"cmd_$cmd"}; $fn or badusage "unknown operation $cmd"; $fn->();