fixes, upload-host

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 7e464fe0a34fd08fc076385b980545bef8a20502..c66a001482120f40932a3b300d4f4704783c1a2d 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -102,6 +102,7 @@ sub runcmd {
 }
 
 sub cmdoutput_errok {
+    die Dumper(\@_)." ?" if grep { !defined } @_;
     printcmd(\*DEBUG,"|",@_);
     open P, "-|", @_ or die $!;
     my $d;
@@ -133,6 +134,7 @@ sub runcmd_ordryrun {
 
 our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit.default.username' => '',
+              'dgit.default.ssh' => 'ssh',
               'dgit-distro.debian.git-host' => 'git.debian.org',
               'dgit-distro.debian.git-proto' => 'git+ssh://',
               'dgit-distro.debian.git-path' => '/git/dgit-repos',
@@ -141,7 +143,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
 
 sub cfg {
     foreach my $c (@_) {
-       my $v = cmdoutput_errok qw(git config --), $c;
+       my $v = cmdoutput_errok(@git, qw(config --), $c);
        if ($?==0) {
            chomp $v;
            return $v;
@@ -157,7 +159,7 @@ sub cfg {
 sub access_cfg ($) {
     my ($key) = @_;
     my $distro = cfg("dgit-suite.$suite.distro",
-                    "dgit.default.distro"); });
+                    "dgit.default.distro");
     my $value = cfg("dgit-distro.$distro.$key",
                    "dgit.default.$key");
     return $value;
@@ -171,11 +173,13 @@ sub access_gituserhost () {
 
 sub access_giturl () {
     my $url = access_cfg('git-url');
-    return $url if defined $url;
-    return
-       access_cfg('git-proto').
-       access_gituserhost().
-       access_cfg('git-path');
+    if (!defined $url) {
+       $url =
+           access_cfg('git-proto').
+           access_gituserhost().
+           access_cfg('git-path');
+    }
+    return "$url/$package.git";
 }             
 
 sub parsecontrol {
@@ -233,15 +237,12 @@ sub get_archive_dsc () {
 
 sub check_for_git () {
     # returns 0 or 1
-    my $how = access_config('git-check');
+    my $how = access_cfg('git-check');
     if ($how eq 'ssh-cmd') {
-       my $r= cmd_getoutput 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 "$cmd\n";
-       open P, "$cmd |" or die $!;
-       $!=0; $?=0;
-       my $r = <P>; close P;
+       my $r= cmdoutput
+           (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 ">$r<\n";
        die "$r $! $?" unless $r =~ m/^[01]$/;
        return $r+0;
@@ -251,13 +252,14 @@ sub check_for_git () {
 }
 
 sub create_remote_git_repo () {
-    my $how = access_config('git-create');
+    my $how = access_cfg('git-create');
     if ($how eq 'ssh-cmd') {
-       runcmd_ordryrun access_cfg('ssh'),access_gituserhost(),
-           "set -e; cd ".access_cfg('git-path').";".
-           " mkdir -p $package.git;".
-           " cd $package.git;".
-           " if ! test -d objects; then git init --bare; fi";
+       runcmd_ordryrun
+           (access_cfg('ssh'),access_gituserhost(),
+            "set -e; cd ".access_cfg('git-path').";".
+            " mkdir -p $package.git;".
+            " cd $package.git;".
+            " if ! test -d objects; then git init --bare; fi");
     } else {
        die "unknown git-create $how ?";
     }
@@ -405,7 +407,7 @@ sub is_fast_fwd ($$) {
 
 sub git_fetch_us () {
     die "cannot dry run with fetch" if $dryrun;
-    runcmd @git, qw(fetch),$remotename,fetchspec();
+    runcmd @git, qw(fetch),access_giturl(),fetchspec();
 }
 
 sub fetch_from_archive () {
@@ -423,10 +425,13 @@ sub fetch_from_archive () {
 
     $!=0; $upload_hash =
        cmdoutput_errok @git, qw(show-ref --heads), lrref();
-    die $! if $!;
-    die $? unless ($?==0 && chomp $upload_hash) 
-       or ($?==256 && !length $upload_hash);
-    $upload_hash ||= '';
+    if ($?==0) {
+       die unless chomp $upload_hash;
+    } elsif ($?==256) {
+       $upload_hash = '';
+    } else {
+       die $?;
+    }
     my $hash;
     if (defined $dsc_hash) {
        die "missing git history even though dsc has hash"
@@ -461,7 +466,7 @@ sub clone ($) {
     open H, "> .git/HEAD" or die $!;
     print H "ref: ".lref()."\n" or die $!;
     close H or die $!;
-    runcmd @git, qw(remote add), 'origin', access_giturl($package);
+    runcmd @git, qw(remote add), 'origin', access_giturl();
     if (check_for_git()) {
        print "fetching existing git history\n";
        git_fetch_us();
@@ -490,7 +495,6 @@ sub pull () {
 sub dopush () {
     runcmd @git, qw(diff --quiet HEAD);
     my $clogp = parsechangelog();
-    die if defined $package;
     $package = $clogp->{Source};
     my $dscfn = "${package}_$clogp->{Version}.dsc";
     stat "../$dscfn" or die "$dscfn $!";
@@ -525,7 +529,7 @@ sub dopush () {
     if (!check_for_git()) {
        create_remote_git_repo();
     }
-    runcmd_ordryrun @git, qw(push),$remotename,"HEAD:".rrref();
+    runcmd_ordryrun @git, qw(push),access_giturl(),"HEAD:".rrref();
     if ($sign) {
        my @tag_cmd = (@git, qw(tag -s -m),
                       "Release $dsc->{Version} for $suite [dgit]");
@@ -537,8 +541,10 @@ sub dopush () {
        push @debsign_cmd, $changesfile;
        runcmd_ordryrun @debsign_cmd;
     }
-    runcmd_ordryrun @git, qw(push),$remotename,"refs/tags/$tag";
-    runcmd_ordryrun @dput, $changesfile;
+    runcmd_ordryrun @git, qw(push),access_giturl(),"refs/tags/$tag";
+    my $host = access_cfg('upload-host');
+    my @hostarg = defined($host) ? ($host,) : ();
+    runcmd_ordryrun @dput, @hostarg, $changesfile;
 }
 
 sub cmd_clone {
@@ -650,7 +656,7 @@ sub parseopts () {
                } elsif (s/^-D/-/) {
                    open DEBUG, ">&STDERR" or die $!;
                } elsif (s/^-c(.*=.*)//s) {
-                   push @git, $1;
+                   push @git, '-c', $1;
                } elsif (s/^-C(.*)//s) {
                    $changesfile = $1;
                } elsif (s/^-k(.*)//s) {