X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=a2f3eae095f8ec45881b55f08088e946ba7ad22f;hp=78b05f9edcd3a7bd2d2e13f91aca7a3a2dd72ce8;hb=9091cb44adb19146d6a4c32e1a4d3946634a73b7;hpb=2641d83f454808b2a97c32df5556c50da31660b3 diff --git a/dgit b/dgit index 78b05f9e..a2f3eae0 100755 --- a/dgit +++ b/dgit @@ -24,6 +24,7 @@ use Data::Dumper; use LWP::UserAgent; use Dpkg::Control::Hash; use File::Path; +use Dpkg::Version; use POSIX; our $suite = 'sid'; @@ -111,8 +112,10 @@ sub cmdoutput_errok { $!=0; $?=0; { local $/ = undef; $d =

; } die if P->error; - close P or return undef; + if (!close P) { print DEBUG "=>!$?\n" if $debug>0; return undef; } chomp $d; + $d =~ m/^.*/; + print DEBUG "=> \`$&'",(length $' ? '...' : ''),"\n" if $debug>0; #'; return $d; } @@ -153,7 +156,6 @@ sub cfg { $v = cmdoutput_errok(@git, qw(config --), $c); }; if ($?==0) { - chomp $v; return $v; } elsif ($?!=256) { die "$c $?"; @@ -273,7 +275,6 @@ sub check_for_git () { (access_cfg('ssh'),access_gituserhost(), " set -e; cd ".access_cfg('git-path').";". " if test -d $package.git; then echo 1; else echo 0; fi"); - print DEBUG "got \`$r'\n"; die "$r $! $?" unless $r =~ m/^[01]$/; return $r+0; } else { @@ -319,7 +320,7 @@ sub mktree_in_ud_from_only_subdir () { symlink '../../../../objects','.git/objects' or die $!; runcmd @git, qw(add -Af); my $tree = cmdoutput @git, qw(write-tree); - chomp $tree; $tree =~ m/^\w+$/ or die "$tree ?"; + $tree =~ m/^\w+$/ or die "$tree ?"; return ($tree,$dir); } @@ -335,6 +336,11 @@ sub is_orig_file ($) { m/\.orig(?:-\w+)?\.tar\.\w+$/; } +sub make_commit ($) { + my ($file) = @_; + return cmdoutput @git, qw(hash-object -w -t commit), $file; +} + sub generate_commit_from_dsc () { prep_ud(); chdir $ud or die $!; @@ -361,48 +367,56 @@ sub generate_commit_from_dsc () { my $authline = "$author $date"; $authline =~ m/^[^<>]+ \<\S+\> \d+ [-+]\d+$/ or die $authline; open C, ">../commit.tmp" or die $!; - print C "tree $tree\n" or die $!; - print C "parent $upload_hash\n" or die $! if $upload_hash; print C <{Changes} -# imported by dgit from the archive +# imported from the archive END close C or die $!; - my $commithash = cmdoutput @git, qw(hash-object -w -t commit ../commit.tmp); + my $outputhash = make_commit qw(../commit.tmp); print "synthesised git commit from .dsc $clogp->{Version}\n"; - chdir '../../../..' or die $!; - cmdoutput @git, qw(update-ref -m),"dgit synthesise $clogp->{Version}", - 'DGIT_ARCHIVE', $commithash; - cmdoutput @git, qw(log -n2), $commithash; - # ... gives git a chance to complain if our commit is malformed - my $outputhash = $commithash; if ($upload_hash) { - chdir "$ud/$dir" or die $!; runcmd @git, qw(reset --hard), $upload_hash; runcmd qw(sh -ec), 'dpkg-parsechangelog >>../changelogold.tmp'; my $oldclogp = Dpkg::Control::Hash->new(); - $oldclogp->parse('../changelogold.tmp','previous changelog') or die; + $oldclogp->load('../changelogold.tmp','previous changelog') or die; my $vcmp = version_compare_string($oldclogp->{Version}, $clogp->{Version}); if ($vcmp < 0) { # git upload/ is earlier vsn than archive, use archive - } elsif ($vcmp >= 0) { + open C, ">../commit2.tmp" or die $!; + print C <{Version}) in archive suite $suite +END + $outputhash = make_commit qw(../commit2.tmp); + } elsif ($vcmp > 0) { print STDERR <{Version} (older) Last allegedly pushed/uploaded: $oldclogp->{Version} (newer or same) Perhaps the upload is stuck in incoming. Using the version from git. END + $outputhash = $upload_hash; } else { die "version in archive is same as version in git". " to-be-uploaded (upload/) branch but archive". " version hash no commit hash?!\n"; } - chdir '../../../..' or die $!; } + chdir '../../../..' or die $!; + runcmd @git, qw(update-ref -m),"dgit fetch import $clogp->{Version}", + 'DGIT_ARCHIVE', $outputhash; + cmdoutput @git, qw(log -n2), $outputhash; + # ... gives git a chance to complain if our commit is malformed rmtree($ud); return $outputhash; } @@ -453,15 +467,17 @@ sub fetch_from_archive () { print "last upload to archive has NO git hash\n"; } - $!=0; $upload_hash = - cmdoutput_errok @git, qw(show-ref --heads), lrref(); - if ($?==0) { - die unless chomp $upload_hash; - } elsif ($?==256) { + my $lrref_fn = ".git/".lrref(); + if (open H, $lrref_fn) { + $upload_hash = ; + chomp $upload_hash; + die "$lrref_fn $upload_hash ?" unless $upload_hash =~ m/^\w+$/; + } elsif ($! == &ENOENT) { $upload_hash = ''; } else { - die $?; + die "$lrref_fn $!"; } + print DEBUG "last upload hash $upload_hash\n"; my $hash; if (defined $dsc_hash) { die "missing git history even though dsc has hash" @@ -471,10 +487,11 @@ sub fetch_from_archive () { } else { $hash = generate_commit_from_dsc(); } + print DEBUG "current hash $hash\n"; if ($upload_hash) { die "not fast forward on last upload branch!". " (archive's version left in DGIT_ARCHIVE)" - unless is_fast_fwd($dsc_hash, $upload_hash); + unless is_fast_fwd($upload_hash, $hash); } if ($upload_hash ne $hash) { my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash); @@ -507,7 +524,7 @@ sub clone ($) { } fetch_from_archive() or die; runcmd @git, qw(reset --hard), lrref(); - print "ready for work in $dstdir\n"; + print "dgit ok: ready for work in $dstdir\n"; } sub fetch () { @@ -515,12 +532,14 @@ sub fetch () { git_fetch_us(); } fetch_from_archive() or die; + print "dgit ok: fetched into ".lrref()."\n"; } sub pull () { fetch(); runcmd_ordryrun @git, qw(merge -m),"Merge from $suite [dgit]", lrref(); + print "dgit ok: fetched to ".lrref()." and merged into HEAD\n"; } sub dopush () { @@ -576,6 +595,7 @@ sub dopush () { my $host = access_cfg('upload-host'); my @hostarg = defined($host) ? ($host,) : (); runcmd_ordryrun @dput, @hostarg, $changesfile; + print "dgit ok: pushed and uploaded $dsc->{Version}\n"; } sub cmd_clone { @@ -599,7 +619,6 @@ sub cmd_clone { sub branchsuite () { my $branch = cmdoutput_errok @git, qw(symbolic-ref HEAD); - chomp $branch; if ($branch =~ m#$lbranch_re#o) { return $1; } else {