X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=13b47fd32b1fcd017cb6234965e9495b9000966e;hp=e8603ba87e0736a1fa230ad92bc93380dfe2fabb;hb=ca067bcb7c0f986a103a7730d452a8c4b39a158f;hpb=657404118ad3d99c849bc3d8803f9440ef4ec9e6 diff --git a/dgit b/dgit index e8603ba8..13b47fd3 100755 --- a/dgit +++ b/dgit @@ -18,7 +18,9 @@ # along with this program. If not, see . use strict; -$SIG{__WARN__} = sub { die $_[0]; }; + +use Debian::Dgit; +setup_sigwarn(); use IO::Handle; use Data::Dumper; @@ -37,7 +39,8 @@ use Debian::Dgit; our $our_version = 'UNRELEASED'; ###substituted### -our $rpushprotovsn = 2; +our @rpushprotovsn_support = qw(3 2); +our $protovsn; our $isuite = 'unstable'; our $idistro; @@ -100,6 +103,13 @@ our $keyid; autoflush STDOUT 1; +our $supplementary_message = ''; + +END { + local ($@, $?); + print STDERR "! $_\n" foreach $supplementary_message =~ m/^.+$/mg; +} + our $remotename = 'dgit'; our @ourdscfield = qw(Dgit Vcs-Dgit-Master); our $csuite; @@ -173,7 +183,9 @@ sub deliberately_not_fast_forward () { #---------- remote protocol support, common ---------- # remote push initiator/responder protocol: -# < dgit-remote-push-ready [optional extra info ignored by old initiators] +# $ dgit remote-push-build-host ... ... +# where is ,... ... +# < dgit-remote-push-ready # # > file parsed-changelog # [indicates that output of dpkg-parsechangelog follows] @@ -268,7 +280,7 @@ sub protocol_send_file ($$) { sub protocol_read_bytes ($$) { my ($fh, $nbytes) = @_; - $nbytes =~ m/^[1-9]\d{0,5}$/ or badproto \*RO, "bad byte count"; + $nbytes =~ m/^[1-9]\d{0,5}$|^0$/ or badproto \*RO, "bad byte count"; my $d; my $got = read $fh, $d, $nbytes; $got==$nbytes or badproto_badread $fh, "data block"; @@ -444,11 +456,16 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit.default.archive-query' => 'madison:', 'dgit.default.sshpsql-dbname' => 'service=projectb', 'dgit-distro.debian.archive-query' => 'ftpmasterapi:', - 'dgit-distro.debian.git-host' => 'dgit-git.debian.net', - '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.git-check' => 'url', + 'dgit-distro.debian.git-check-suffix' => '/info/refs', + 'dgit-distro.debian.new-private-pushers' => 't', + 'dgit-distro.debian/push.git-url' => '', + 'dgit-distro.debian/push.git-host' => 'push.dgit.debian.org', + 'dgit-distro.debian/push.git-user-force' => 'dgit', + 'dgit-distro.debian/push.git-proto' => 'git+ssh://', + 'dgit-distro.debian/push.git-path' => '/dgit/debian/repos', + 'dgit-distro.debian/push.git-create' => 'true', + 'dgit-distro.debian/push.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', @@ -459,12 +476,8 @@ our %defcfg = ('dgit.default.distro' => 'debian', # 'dgit-distro.debian.archive-query-tls-curl-args', # '--ca-path=/etc/ssl/ca-debian', # ^ this is a workaround but works (only) on DSA-administered machines - '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/alioth.git-create' => 'ssh-cmd', + 'dgit-distro.debian.git-url' => 'https://git.dgit.debian.org', + 'dgit-distro.debian.git-url-suffix' => '', 'dgit-distro.debian.upload-host' => 'ftp-master', # for dput 'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/', 'dgit-distro.debian.backports-quirk' => '(squeeze)-backports*', @@ -484,20 +497,35 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit-distro.test-dummy.upload-host' => 'test-dummy', ); +sub git_get_config ($) { + my ($c) = @_; + + our %git_get_config_memo; + if (exists $git_get_config_memo{$c}) { + return $git_get_config_memo{$c}; + } + + my $v; + my @cmd = (@git, qw(config --), $c); + { + local ($debuglevel) = $debuglevel-2; + $v = cmdoutput_errok @cmd; + }; + if ($?==0) { + } elsif ($?==256) { + $v = undef; + } else { + failedcmd @cmd; + } + $git_get_config_memo{$c} = $v; + return $v; +} + sub cfg { foreach my $c (@_) { return undef if $c =~ /RETURN-UNDEF/; - my @cmd = (@git, qw(config --), $c); - my $v; - { - local ($debuglevel) = $debuglevel-2; - $v = cmdoutput_errok @cmd; - }; - if ($?==0) { - return $v; - } elsif ($?!=256) { - failedcmd @cmd; - } + my $v = git_get_config($c); + return $v if defined $v; my $dv = $defcfg{$c}; return $dv if defined $dv; } @@ -532,6 +560,63 @@ sub access_quirk () { return ('none',undef); } +our $access_forpush; + +sub parse_cfg_bool ($$$) { + my ($what,$def,$v) = @_; + $v //= $def; + return + $v =~ m/^[ty1]/ ? 1 : + $v =~ m/^[fn0]/ ? 0 : + badcfg "$what needs t (true, y, 1) or f (false, n, 0) not \`$v'"; +} + +sub access_forpush_config () { + my $d = access_basedistro(); + + return 1 if + $new_package && + parse_cfg_bool('new-private-pushers', 0, + cfg("dgit-distro.$d.new-private-pushers", + 'RETURN-UNDEF')); + + my $v = cfg("dgit-distro.$d.readonly", 'RETURN-UNDEF'); + $v //= 'a'; + return + $v =~ m/^[ty1]/ ? 0 : # force readonly, forpush = 0 + $v =~ m/^[fn0]/ ? 1 : # force nonreadonly, forpush = 1 + $v =~ m/^[a]/ ? '' : # auto, forpush = '' + badcfg "readonly needs t (true, y, 1) or f (false, n, 0) or a (auto)"; +} + +sub access_forpush () { + $access_forpush //= access_forpush_config(); + return $access_forpush; +} + +sub pushing () { + die "$access_forpush ?" if ($access_forpush // 1) ne 1; + badcfg "pushing but distro is configured readonly" + if access_forpush_config() eq '0'; + $access_forpush = 1; + $supplementary_message = <<'END' unless $we_are_responder; +Push failed, before we got started. +You can retry the push, after fixing the problem, if you like. +END +} + +sub supplementary_message ($) { + my ($msg) = @_; + if (!$we_are_responder) { + $supplementary_message = $msg; + return; + } elsif ($protovsn >= 3) { + responder_send_command "supplementary-message ".length($msg) + or die $!; + print PO $msg or die $!; + } +} + sub access_distros () { # Returns list of distros to try, in order # @@ -545,7 +630,12 @@ sub access_distros () { my (undef,$quirkdistro) = access_quirk(); unshift @l, $quirkdistro; unshift @l, $instead_distro; - return grep { defined } @l; + @l = grep { defined } @l; + + if (access_forpush()) { + @l = map { ("$_/push", $_) } @l; + } + @l; } sub access_cfg (@) { @@ -618,15 +708,19 @@ sub access_gituserhost () { sub access_giturl (;$) { my ($optional) = @_; my $url = access_cfg('git-url','RETURN-UNDEF'); - if (!defined $url) { + my $suffix; + if (!length $url) { my $proto = access_cfg('git-proto', 'RETURN-UNDEF'); return undef unless defined $proto; $url = $proto. access_gituserhost(). access_cfg('git-path'); + } else { + $suffix = access_cfg('git-url-suffix','RETURN-UNDEF'); } - return "$url/$package.git"; + $suffix //= '.git'; + return "$url/$package$suffix"; } sub parsecontrolfh ($$;$) { @@ -1018,6 +1112,7 @@ sub check_for_git () { if ($r =~ m/^divert (\w+)$/) { my $divert=$1; my ($usedistro,) = access_distros(); + # NB that if we are pushing, $usedistro will be $distro/push $instead_distro= cfg("dgit-distro.$usedistro.diverts.$divert"); $instead_distro =~ s{^/}{ access_basedistro()."/" }e; progress "diverting to $divert (using config for $instead_distro)"; @@ -1025,6 +1120,24 @@ sub check_for_git () { } failedcmd @cmd unless $r =~ m/^[01]$/; return $r+0; + } elsif ($how eq 'url') { + my $prefix = access_cfg('git-check-url','git-url'); + 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 $result = cmdoutput @cmd; + $result =~ m/^\S+ (404|200) /s or + fail "unexpected results from git check query - ". + Dumper($prefix, $result); + my $code = $1; + if ($code eq '404') { + return 0; + } elsif ($code eq '200') { + return 1; + } else { + die; + } } elsif ($how eq 'true') { return 1; } elsif ($how eq 'false') { @@ -1078,7 +1191,21 @@ sub mktree_in_ud_from_only_subdir () { $dirs[0] =~ m#^([^/]+)/\.$# or die; my $dir = $1; changedir $dir; - fail "source package contains .git directory" if stat_exists '.git'; + + my @gitscmd = qw(find -name .git -prune -print0); + debugcmd "|",@gitscmd; + open GITS, "-|", @gitscmd or failedcmd @gitscmd; + { + local $/="\0"; + while () { + chomp or die; + print STDERR "$us: warning: removing from source package: ", + (messagequote $_), "\n"; + rmtree $_; + } + } + $!=0; $?=0; close GITS or failedcmd @gitscmd; + mktree_in_ud_here(); my $format=get_source_format(); if (madformat($format)) { @@ -1718,6 +1845,10 @@ sub sign_changes ($) { sub dopush ($) { my ($forceflag) = @_; printdebug "actually entering push\n"; + supplementary_message(<<'END'); +Push failed, while preparing your push. +You can retry the push, after fixing the problem, if you like. +END prep_ud(); access_giturl(); # check that success is vaguely likely @@ -1767,12 +1898,6 @@ sub dopush ($) { failedcmd @diffcmd; } } -#fetch from alioth -#do fast forward check and maybe fake merge -# if (!is_fast_fwd(mainbranch -# runcmd @git, qw(fetch -p ), "$alioth_git/$package.git", -# map { lref($_).":".rref($_) } -# (uploadbranch()); my $head = git_rev_parse('HEAD'); if (!$changesfile) { my $multi = "$buildproductsdir/". @@ -1808,6 +1933,11 @@ sub dopush ($) { my $tfn = sub { ".git/dgit/tag$_[0]"; }; my $tagobjfn; + supplementary_message(<<'END'); +Push failed, while signing the tag. +You can retry the push, after fixing the problem, if you like. +END + # If we manage to sign but fail to record it anywhere, it's fine. if ($we_are_responder) { $tagobjfn = $tfn->('.signed.tmp'); responder_receive_files('signed-tag', $tagobjfn); @@ -1818,12 +1948,19 @@ sub dopush ($) { $changesfile,$changesfile, $tfn); } + supplementary_message(<<'END'); +Push failed, *after* signing the tag. +If you want to try again, you should use a new version number. +END my $tag_obj_hash = cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn; runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash; runcmd_ordryrun_local @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash; - runcmd_ordryrun @git, qw(tag -v --), $tag; + supplementary_message(<<'END'); +Push failed, while updating the remote git repository - see messages above. +If you want to try again, you should use a new version number. +END if (!check_for_git()) { create_remote_git_repo(); } @@ -1831,6 +1968,10 @@ sub dopush ($) { $forceflag."HEAD:".rrref(), $forceflag."refs/tags/$tag"; runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD'; + supplementary_message(<<'END'); +Push failed, after updating the remote git repository. +If you want to try again, you must use a new version number. +END if ($we_are_responder) { my $dryrunsuffix = act_local() ? "" : ".tmp"; responder_receive_files('signed-dsc-changes', @@ -1845,11 +1986,19 @@ sub dopush ($) { sign_changes $changesfile; } + supplementary_message(<<'END'); +Push failed, while uploading package(s) to the archive server. +You can retry the upload of exactly these same files with dput of: + $changesfile +If that .changes file is broken, you will need to use a new version +number for your next attempt at the upload. +END my $host = access_cfg('upload-host','RETURN-UNDEF'); my @hostarg = defined($host) ? ($host,) : (); runcmd_ordryrun @dput, @hostarg, $changesfile; printdone "pushed and uploaded $cversion"; + supplementary_message(''); responder_send_command("complete"); } @@ -1935,6 +2084,7 @@ sub cmd_pull { } sub cmd_push { + pushing(); parseopts(); badusage "-p is not allowed with dgit push" if defined $package; check_not_dirty(); @@ -1960,6 +2110,10 @@ sub cmd_push { fail "dgit push: changelog specifies $isuite ($csuite)". " but command line specifies $specsuite"; } + supplementary_message(<<'END'); +Push failed, while checking state of the archive. +You can retry the push, after fixing the problem, if you like. +END if (check_for_git()) { git_fetch_us(); } @@ -2000,6 +2154,8 @@ sub cmd_remote_push_build_host { $we_are_responder = 1; $us .= " (build host)"; + pushing(); + open PI, "<&STDIN" or die $!; open STDIN, "/dev/null" or die $!; open PO, ">&STDOUT" or die $!; @@ -2008,11 +2164,16 @@ sub cmd_remote_push_build_host { autoflush STDOUT 1; $vsnwant //= 1; - fail "build host has dgit rpush protocol version". - " $rpushprotovsn but invocation host has $vsnwant" - unless grep { $rpushprotovsn eq $_ } split /,/, $vsnwant; + ($protovsn) = grep { + $vsnwant =~ m{^(?:.*,)?$_(?:,.*)?$} + } @rpushprotovsn_support; + + fail "build host has dgit rpush protocol versions ". + (join ",", @rpushprotovsn_support). + " but invocation host has $vsnwant" + unless defined $protovsn; - responder_send_command("dgit-remote-push-ready $rpushprotovsn"); + responder_send_command("dgit-remote-push-ready $protovsn"); changedir $dir; &cmd_push; @@ -2048,6 +2209,7 @@ sub i_method { } sub cmd_rpush { + pushing(); my $host = nextarg; my $dir; if ($host =~ m/^((?:[^][]|\[[^][]*\])*)\:/) { @@ -2057,7 +2219,8 @@ sub cmd_rpush { $dir = nextarg; } $dir =~ s{^-}{./-}; - my @rargs = ($dir,$rpushprotovsn); + my @rargs = ($dir); + push @rargs, join ",", @rpushprotovsn_support; my @rdgit; push @rdgit, @dgit; push @rdgit, @ropts; @@ -2075,7 +2238,9 @@ sub cmd_rpush { } $i_child_pid = open2(\*RO, \*RI, @cmd); changedir $i_tmp; - initiator_expect { m/^dgit-remote-push-ready/ }; + ($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 { m/^(\S+)(?: (.*))?$/; @@ -2091,6 +2256,11 @@ sub i_resp_progress ($) { progress $msg; } +sub i_resp_supplementary_message ($) { + my ($rhs) = @_; + $supplementary_message = protocol_read_bytes \*RO, $rhs; +} + sub i_resp_complete { my $pid = $i_child_pid; $i_child_pid = undef; # prevents killing some other process with same pid @@ -2633,8 +2803,18 @@ sub quilt_fixup_editor () { sub clean_tree () { if ($cleanmode eq 'dpkg-source') { runcmd_ordryrun_local @dpkgbuildpackage, qw(-T clean); + } elsif ($cleanmode eq 'dpkg-source-d') { + runcmd_ordryrun_local @dpkgbuildpackage, qw(-d -T clean); } elsif ($cleanmode eq 'git') { runcmd_ordryrun_local @git, qw(clean -xdf); + } elsif ($cleanmode eq 'git-ff') { + runcmd_ordryrun_local @git, qw(clean -xdff); + } elsif ($cleanmode eq 'check') { + my $leftovers = cmdoutput @git, qw(clean -xdn); + if (length $leftovers) { + print STDERR $leftovers, "\n" or die $!; + fail "tree contains uncommitted files and --clean=check specified"; + } } elsif ($cleanmode eq 'none') { } else { die "$cleanmode ?"; @@ -2729,6 +2909,9 @@ sub build_source { if ($cleanmode eq 'dpkg-source') { runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S)), changesopts(); + } elsif ($cleanmode eq 'dpkg-source-d') { + runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S -d)), + changesopts(); } else { my $pwd = must_getcwd(); my $leafdir = basename $pwd; @@ -2847,7 +3030,7 @@ sub parseopts () { } elsif (m/^--since-version=([^_]+|_)$/) { push @ropts, $_; $changes_since_version = $1; - } elsif (m/^--([-0-9a-z]+)=(.*)/s && + } elsif (m/^--([-0-9a-z]+)=(.+)/s && ($om = $opts_opt_map{$1}) && length $om->[0]) { push @ropts, $_; @@ -2871,7 +3054,7 @@ sub parseopts () { } elsif (m/^--build-products-dir=(.*)/s) { push @ropts, $_; $buildproductsdir = $1; - } elsif (m/^--clean=(dpkg-source|git|none)$/s) { + } elsif (m/^--clean=(dpkg-source(?:-d)?|git|git-ff|check|none)$/s) { push @ropts, $_; $cleanmode = $1; } elsif (m/^--clean=(.*)$/s) { @@ -2943,9 +3126,18 @@ sub parseopts () { } elsif (s/^-wg$//s) { push @ropts, $&; $cleanmode = 'git'; + } elsif (s/^-wgf$//s) { + push @ropts, $&; + $cleanmode = 'git-ff'; } elsif (s/^-wd$//s) { push @ropts, $&; $cleanmode = 'dpkg-source'; + } elsif (s/^-wdd$//s) { + push @ropts, $&; + $cleanmode = 'dpkg-source-d'; + } elsif (s/^-wc$//s) { + push @ropts, $&; + $cleanmode = 'check'; } else { badusage "unknown short option \`$_'"; } @@ -2959,6 +3151,7 @@ if ($ENV{$fakeeditorenv}) { } parseopts(); + print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1; print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n" if $dryrun_level == 1; @@ -2970,6 +3163,7 @@ my $cmd = shift @ARGV; $cmd =~ y/-/_/; if (!defined $quilt_mode) { + local $access_forpush; $quilt_mode = cfg('dgit.force.quilt-mode', 'RETURN-UNDEF') // access_cfg('quilt-mode', 'RETURN-UNDEF') // 'linear';