X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=d51a826ed54eaee0b8eb410d636aaf137ec1e626;hp=7b5803aa82c1f641695743e2529019247a8f67d8;hb=c58dc9ccba2a6c82639f945d9ea389244558248b;hpb=820e6dffcbc02d66950cf62424b263e953b9c714 diff --git a/dgit b/dgit index 7b5803aa..d51a826e 100755 --- a/dgit +++ b/dgit @@ -1,4 +1,22 @@ #!/usr/bin/perl -w +# dgit +# Integration between git and Debian-style archives +# +# Copyright (C)2013 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 +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + use strict; use IO::Handle; @@ -23,8 +41,10 @@ our (@dget_opts) = qw(-u); our $remotename = 'dgit'; -sub mainbranch () { return "$suite"; } -sub uploadbranch () { return "upload/$suite"; } +sub mainbranch () { return "dgit/$suite"; } +sub uploadbranch () { return "dgit/$suite.upload"; } +sub lref ($) { return "refs/heads/$_[0]"; } +sub rref ($) { return "refs/remotes/$remotename/$_[0]"; } our $ua; @@ -63,6 +83,14 @@ sub parsecontrol { return $c; } +sub parsechangelog { + my $c = Dpkg::Control::Hash->new(); + my $p = new IO::File '-|', qw(dpkg-parsechangelog) or die $!; + $c->parse($p); + $?=0; $!=0; close $p or die "$! $?"; + return $c; +} + sub get_archive_dsc () { my $rmad = cmdoutput qw(rmadison -asource),"-s$suite",$package; $rmad =~ m/^ \s*( [^ \t|]+ )\s* \| @@ -103,13 +131,36 @@ sub check_for_git () { return $r+0; } -our ($dsc_hash,$lastupl_hash); +our ($dsc_hash,$upload_hash); -sub generate_commit_from_dsc () { - my $ud = '.git/dgit/unpack'; +our $ud = '.git/dgit/unpack'; + +sub prep_ud () { rmtree($ud); mkpath '.git/dgit'; mkdir $ud or die $!; +} + +sub mktree_in_ud_from_only_subdir () { + # changes into the subdir + my (@dirs) = <*/.>; + die unless @dirs==1; + $dirs[0] =~ m#^([^/]+)/\.$# or die; + my $dir = $1; + chdir $dir or die "$dir $!"; + die if stat '.git'; + die $! unless $!==&ENOENT; + runcmd qw(git init -q); + rmtree('.git/objects'); + symlink '../../../../objects','.git/objects' or die $!; + runcmd qw(git add -Af); + my $tree = cmdoutput qw(git write-tree); + chomp $tree; $tree =~ m/^\w+$/ or die "$tree ?"; + return ($tree,$dir); +} + +sub generate_commit_from_dsc () { + prep_ud(); chdir $ud or die $!; my @files; foreach (split /\n/, ($dsc->{'Checksums-Sha256'} || $dsc->{Files})) { @@ -128,19 +179,7 @@ sub generate_commit_from_dsc () { or $!==&EEXIST or die "$f $!"; } - my (@dirs) = <*/.>; - die unless @dirs==1; - $dirs[0] =~ m#^([^/]+)/\.$# or die; - my $dir = $1; - chdir $dir or die "$dir $!"; - die if stat '.git'; - die $! unless $!==&ENOENT; - runcmd qw(git init -q); - rmtree('.git/objects'); - symlink '../../../../objects','.git/objects' or die $!; - runcmd qw(git add -Af); - my $tree = cmdoutput qw(git write-tree); - chomp $tree; $tree =~ m/^\w+$/ or die "$tree ?"; + my ($tree,$dir) = mktree_in_ud_from_only_subdir(); runcmd qw(sh -ec), 'dpkg-parsechangelog >../changelog.tmp'; my $clogp = parsecontrol('../changelog.tmp','changelog') or die; my $date = cmdoutput qw(date), '+%s %z', qw(-d),$clogp->{Date}; @@ -150,7 +189,7 @@ sub generate_commit_from_dsc () { $authline =~ m/^[^<>]+ \<\S+\> \d+ [-+]\d+$/ or die $authline; open C, ">../commit.tmp" or die $!; print C "tree $tree\n" or die $!; - print C "parent $lastupl_hash\n" or die $! if defined $lastupl_hash; + print C "parent $upload_hash\n" or die $! if defined $upload_hash; print C <>../changelogold.tmp'; my $oldclogp = Dpkg::Control::Hash->new(); $oldclogp->parse('../changelogold.tmp','previous changelog') or die; @@ -195,29 +234,39 @@ END return $outputhash; } -my $lastupl_ref = "refs/remotes/$remotename/upload/$suite"; +sub rev_parse ($) { + return cmdoutput qw(git rev-parse --), "$_[0]~0"; +} + +sub is_fast_fwd ($$) { + my ($ancestor,$child) = @_; + my $mb = cmdoutput qw(git merge-base), $dsc_hash, $upload_hash; + return rev_parse($mb) eq rev_parse($ancestor); +} sub fetch_from_archive () { - # ensures that $lastupl_ref is what is actually in the archive, + # ensures that rref(uploadbranch()) is what is actually in the archive, # one way or another - $!=0; $lastupl_hash = `git show-ref --heads $lastupl_ref`; + my $upload_ref = rref(uploadbranch()); + $!=0; $upload_hash = `git show-ref --heads $upload_ref`; die $! if $!; - die $? unless ($?==0 && chomp $lastupl_hash) - or ($?==128 && !length $lastupl_hash); + die $? unless ($?==0 && chomp $upload_hash) + or ($?==128 && !length $upload_hash); my $hash; if (defined $dsc_hash) { + die "missing git history even though dsc has hash" + unless length $upload_hash; $hash = $dsc_hash; } else { $hash = generate_commit_from_dsc(); } - if ($lastupl_hash) { - my $mb = cmdoutput qw(git merge-base), $dsc_hash, $lastupl_hash; + if (length $upload_hash) { die "not fast forward on last upload branch!". " (archive's version left in DGIT_ARCHIVE)" - unless $mb eq $lastupl_hash; + unless is_fast_fwd($dsc_hash, $upload_hash); } - if ($lastupl_ref ne $hash) { - cmdoutput qw(git update-ref -m), 'dgit fetch', $lastupl_ref, $hash; + if ($upload_hash ne $hash) { + cmdoutput qw(git update-ref -m), 'dgit fetch', $upload_ref, $hash; } } @@ -238,19 +287,18 @@ sub clone () { $alioth_git, $dstdir; chdir "$dstdir" or die "$dstdir $!"; fetch_from_archive(); - runcmd qw(git reset --hard), $lastupl_ref; + runcmd qw(git reset --hard), rref(uploadbranch()); } else { - die "missing git history even though dsc has hash" if defined $dsc_hash; print "starting new git history\n"; mkdir $dstdir or die "$dstdir $!"; chdir "$dstdir" or die "$dstdir $!"; runcmd qw(git init -q); open H, "> .git/HEAD" or die $!; - print H "ref: refs/heads/$suite\n" or die $!; + print H "ref: ".lref(mainbranch())."\n" or die $!; close H or die $!; runcmd qw(git remote add), $remotename, $alioth_git; runcmd "git config branch.$suite.remote $remotename"; - runcmd "git config branch.$suite.merge refs/heads/$suite"; + runcmd "git config branch.$suite.merge ".lref(mainbranch()); my $newhash = generate_commit_from_dsc(); runcmd qw(git reset --hard), $newhash; } @@ -258,7 +306,46 @@ sub clone () { } sub fetch () { - + if (check_for_git()) { + runcmd qw(git fetch -p),$remotename, + '+refs/heads/*:refs/remotes/origin/*'; + } + fetch_from_archive(); +} + +sub pull () { + fetch(); + runcmd qw(git merge),lref(uploadbranch()); +} + +sub push () { + runcmd qw(git diff --quiet HEAD); + my $clogp = parsechangelog(); + $package = $clogp->{Source}; + my $dscfn = "${package}_$clogp->{Version}.dsc"; + stat $dscfn or die "$dscfn $!"; + $dsc = parsecontrol("../$dscfn"); + prep_ud(); + chdir $ud or die $!; + print "checking that $dscfn corresponds to HEAD\n"; + runcmd qw(dpkg-source -x --), "../../../../$dscfn"; + my $tree = mktree_in_ud_from_only_subdir(); + chdir '../../../..' or die $!; + runcmd qw(git diff --exit-code), $tree; + runcmd qw(git fetch), $alioth_git, + map { lref($_).":".rref($_) } + (mainbranch(), uploadbranch()); + die <