dgit

   1 #!/usr/bin/perl -w
   2 # dgit
   3 # Integration between git and Debian-style archives
   4 #
   5 # Copyright (C)2013 Ian Jackson
   6 #
   7 # This program is free software: you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation, either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 use strict;
  21
  22 use IO::Handle;
  23 use Data::Dumper;
  24 use LWP::UserAgent;
  25 use Dpkg::Control::Hash;
  26 use File::Path;
  27 use POSIX;
  28
  29 our $suite = 'sid';
  30 our $package;
  31
  32 our $sign = 1;
  33 our $dryrun = 0;
  34 our $changesfile;
  35 our $new_package = 0;
  36
  37 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
  38
  39 our (@git) = qw(git);
  40 our (@dget) = qw(dget);
  41 our (@dput) = qw(dput);
  42 our (@debsign) = qw(debsign);
  43 our $keyid;
  44
  45 our $debug = 0;
  46 open DEBUG, ">/dev/null" or die $!;
  47
  48 our %opts_opt_map = ('dget' => \@dget,
  49                      'dput' => \@dput,
  50                      'debsign' => \@debsign);
  51
  52 our $remotename = 'dgit';
  53 our $ourdscfield = 'Vcs-Dgit-Master';
  54 our $branchprefix = 'dgit';
  55
  56 sub lbranch () { return "$branchprefix/$suite"; }
  57 my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$';
  58 sub lref () { return "refs/heads/".lbranch(); }
  59 sub lrref () { return "refs/remotes/$remotename/$suite"; }
  60 sub rrref () { return "refs/$branchprefix/$suite"; }
  61 sub debiantag ($) { return "debian/$_[0]"; }
  62
  63 sub fetchspec () {
  64     local $suite = '*';
  65     return  "+".rrref().":".lrref();
  66 }
  67
  68 our $ua;
  69
  70 sub url_get {
  71     if (!$ua) {
  72         $ua = LWP::UserAgent->new();
  73         $ua->env_proxy;
  74     }
  75     print "downloading @_...\n";
  76     my $r = $ua->get(@_) or die $!;
  77     die "$_[0]: ".$r->status_line."; failed.\n" unless $r->is_success;
  78     return $r->decoded_content();
  79 }
  80
  81 our ($dscdata,$dscurl,$dsc);
  82
  83 sub printcmd {
  84     my $fh = shift @_;
  85     my $intro = shift @_;
  86     print $fh $intro or die $!;
  87     local $_;
  88     foreach my $a (@_) {
  89         $_ = $a;
  90         if (s{['\\]}{\\$&}g || m{\s} || m{[^-_./0-9a-z]}i) {
  91             print $fh " '$_'" or die $!;
  92         } else {
  93             print $fh " $_" or die $!;
  94         }
  95     }
  96     print $fh "\n" or die $!;
  97 }
  98
  99 sub runcmd {
 100     printcmd(\*DEBUG,"+",@_) if $debug>0;
 101     $!=0; $?=0;
 102     die "@_ $! $?" if system @_;
 103 }
 104
 105 sub cmdoutput_errok {
 106     die Dumper(\@_)." ?" if grep { !defined } @_;
 107     printcmd(\*DEBUG,"|",@_) if $debug>0;
 108     open P, "-|", @_ or die $!;
 109     my $d;
 110     $!=0; $?=0;
 111     { local $/ = undef; $d = <P>; }
 112     die if P->error;
 113     close P or return undef;
 114     chomp $d;
 115     return $d;
 116 }
 117
 118 sub cmdoutput {
 119     my $d = cmdoutput_errok @_;
 120     defined $d or die "@_ $? $!";
 121     return $d;
 122 }
 123
 124 sub dryrun_report {
 125     printcmd(\*STDOUT,"#",@_);
 126 }
 127
 128 sub runcmd_ordryrun {
 129     if (!$dryrun) {
 130         runcmd @_;
 131     } else {
 132         dryrun_report @_;
 133     }
 134 }
 135
 136 our %defcfg = ('dgit.default.distro' => 'debian',
 137                'dgit.default.username' => '',
 138                'dgit.default.archive-query-default-component' => 'main',
 139                'dgit.default.ssh' => 'ssh',
 140                'dgit-distro.debian.git-host' => 'git.debian.org',
 141                'dgit-distro.debian.git-proto' => 'git+ssh://',
 142                'dgit-distro.debian.git-path' => '/git/dgit-repos',
 143                'dgit-distro.debian.git-check' => 'ssh-cmd',
 144                'dgit-distro.debian.git-create' => 'ssh-cmd',
 145                'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/');
 146
 147 sub cfg {
 148     foreach my $c (@_) {
 149         my $v;
 150         {
 151             local ($debug) = $debug-1;
 152             $v = cmdoutput_errok(@git, qw(config --), $c);
 153         };
 154         if ($?==0) {
 155             chomp $v;
 156             return $v;
 157         } elsif ($?!=256) {
 158             die "$c $?";
 159         }
 160         my $dv = $defcfg{$c};
 161         return $dv if defined $dv;
 162     }
 163     return undef;
 164 }
 165
 166 sub access_distro () {
 167     return cfg("dgit-suite.$suite.distro",
 168                "dgit.default.distro");
 169 }
 170
 171 sub access_cfg ($) {
 172     my ($key) = @_;
 173     my $distro = access_distro();
 174     my $value = cfg("dgit-distro.$distro.$key",
 175                     "dgit.default.$key");
 176     return $value;
 177 }
 178
 179 sub access_gituserhost () {
 180     my $user = access_cfg('git-user');
 181     my $host = access_cfg('git-host');
 182     return defined($user) && length($user) ? "$user\@$host" : $host;
 183 }
 184
 185 sub access_giturl () {
 186     my $url = access_cfg('git-url');
 187     if (!defined $url) {
 188         $url =
 189             access_cfg('git-proto').
 190             access_gituserhost().
 191             access_cfg('git-path');
 192     }
 193     return "$url/$package.git";
 194 }
 195
 196 sub parsecontrol {
 197     my $c = Dpkg::Control::Hash->new();
 198     $c->load(@_) or return undef;
 199     return $c;
 200 }
 201
 202 sub parsechangelog {
 203     my $c = Dpkg::Control::Hash->new();
 204     my $p = new IO::Handle;
 205     open $p, '-|', qw(dpkg-parsechangelog) or die $!;
 206     $c->parse($p);
 207     $?=0; $!=0; close $p or die "$! $?";
 208     return $c;
 209 }
 210
 211 our $rmad;
 212
 213 sub archive_query () {
 214     my $query = access_cfg('archive-query');
 215     $query ||= "madison:".access_distro();
 216     $query =~ s/^(\w+):// or die "$query ?";
 217     my $proto = $1;
 218     my $url = $'; #';
 219     die unless $proto eq 'madison';
 220     $rmad ||= cmdoutput qw(rmadison -asource),"-s$suite","-u$url",$package;
 221     if (!length $rmad) {
 222         return ();
 223     }
 224     $rmad =~ m{^ \s*( [^ \t|]+ )\s* \|
 225                  \s*( [^ \t|]+ )\s* \|
 226                  \s*( [^ \t|/]+ )(?:/([^ \t|/]+)) \s* \|
 227                  \s*( [^ \t|]+ )\s* }x or die "$rmad $?";
 228     $1 eq $package or die "$rmad $package ?";
 229     my $vsn = $2;
 230     if ($suite ne $3) {
 231         # madison canonicalises for us
 232         print "canonical suite name for $suite is $3\n";
 233         $suite = $3;
 234     }
 235     my $component;
 236     if (defined $4) {
 237         $component = $4;
 238     } else {
 239         $component = access_cfg('archive-query-default-component');
 240     }
 241     $5 eq 'source' or die "$rmad ?";
 242     my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
 243     my $subpath = "/pool/$component/$prefix/$package/${package}_$vsn.dsc";
 244     return ($vsn,$subpath);
 245 }
 246
 247 sub canonicalise_suite () {
 248     archive_query();
 249 }
 250
 251 sub get_archive_dsc () {
 252     my ($vsn,$subpath) = archive_query();
 253     if (!defined $vsn) { $dsc=undef; return undef; }
 254     $dscurl = access_cfg('mirror').$subpath;
 255     $dscdata = url_get($dscurl);
 256     my $dscfh = new IO::File \$dscdata, '<' or die $!;
 257     print DEBUG Dumper($dscdata) if $debug>1;
 258     $dsc = Dpkg::Control::Hash->new(allow_pgp=>1);
 259     $dsc->parse($dscfh, 'dsc') or die "parsing of $dscurl failed\n";
 260     print DEBUG Dumper($dsc) if $debug>1;
 261     my $fmt = $dsc->{Format};
 262     die "unsupported format $fmt, sorry\n" unless $format_ok{$fmt};
 263 }
 264
 265 sub check_for_git () {
 266     # returns 0 or 1
 267     my $how = access_cfg('git-check');
 268     if ($how eq 'ssh-cmd') {
 269         my $r= cmdoutput
 270             (access_cfg('ssh'),access_gituserhost(),
 271              " set -e; cd ".access_cfg('git-path').";".
 272              " if test -d $package.git; then echo 1; else echo 0; fi");
 273         print DEBUG "got \`$r'\n";
 274         die "$r $! $?" unless $r =~ m/^[01]$/;
 275         return $r+0;
 276     } else {
 277         die "unknown git-check $how ?";
 278     }
 279 }
 280
 281 sub create_remote_git_repo () {
 282     my $how = access_cfg('git-create');
 283     if ($how eq 'ssh-cmd') {
 284         runcmd_ordryrun
 285             (access_cfg('ssh'),access_gituserhost(),
 286              "set -e; cd ".access_cfg('git-path').";".
 287              " mkdir -p $package.git;".
 288              " cd $package.git;".
 289              " if ! test -d objects; then git init --bare; fi");
 290     } else {
 291         die "unknown git-create $how ?";
 292     }
 293 }
 294
 295 our ($dsc_hash,$upload_hash);
 296
 297 our $ud = '.git/dgit/unpack';
 298
 299 sub prep_ud () {
 300     rmtree($ud);
 301     mkpath '.git/dgit';
 302     mkdir $ud or die $!;
 303 }
 304
 305 sub mktree_in_ud_from_only_subdir () {
 306     # changes into the subdir
 307     my (@dirs) = <*/.>;
 308     die unless @dirs==1;
 309     $dirs[0] =~ m#^([^/]+)/\.$# or die;
 310     my $dir = $1;
 311     chdir $dir or die "$dir $!";
 312     die if stat '.git';
 313     die $! unless $!==&ENOENT;
 314     runcmd qw(git init -q);
 315     rmtree('.git/objects');
 316     symlink '../../../../objects','.git/objects' or die $!;
 317     runcmd @git, qw(add -Af);
 318     my $tree = cmdoutput @git, qw(write-tree);
 319     chomp $tree; $tree =~ m/^\w+$/ or die "$tree ?";
 320     return ($tree,$dir);
 321 }
 322
 323 sub dsc_files () {
 324     map {
 325         m/^\w+ \d+ (\S+)$/ or die "$_ ?";
 326         $1;
 327     } grep m/\S/, split /\n/, ($dsc->{'Checksums-Sha256'} || $dsc->{Files});
 328 }
 329
 330 sub is_orig_file ($) {
 331     local ($_) = @_;
 332     m/\.orig(?:-\w+)?\.tar\.\w+$/;
 333 }
 334
 335 sub generate_commit_from_dsc () {
 336     prep_ud();
 337     chdir $ud or die $!;
 338     my @files;
 339     foreach my $f (dsc_files()) {
 340         die if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
 341         push @files, $f;
 342         link "../../../$f", $f
 343             or $!==&ENOENT
 344             or die "$f $!";
 345     }
 346     runcmd @dget, qw(--), $dscurl;
 347     foreach my $f (grep { is_orig_file($_) } @files) {
 348         link $f, "../../../../$f"
 349             or $!==&EEXIST
 350             or die "$f $!";
 351     }
 352     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
 353     runcmd qw(sh -ec), 'dpkg-parsechangelog >../changelog.tmp';
 354     my $clogp = parsecontrol('../changelog.tmp','changelog') or die;
 355     my $date = cmdoutput qw(date), '+%s %z', qw(-d),$clogp->{Date};
 356     my $author = $clogp->{Maintainer};
 357     $author =~ s#,.*##ms;
 358     my $authline = "$author $date";
 359     $authline =~ m/^[^<>]+ \<\S+\> \d+ [-+]\d+$/ or die $authline;
 360     open C, ">../commit.tmp" or die $!;
 361     print C "tree $tree\n" or die $!;
 362     print C "parent $upload_hash\n" or die $! if $upload_hash;
 363     print C <<END or die $!;
 364 author $authline
 365 committer $authline
 366
 367 $clogp->{Changes}
 368
 369 # imported by dgit from the archive
 370 END
 371     close C or die $!;
 372     my $commithash = cmdoutput @git, qw(hash-object -w -t commit ../commit.tmp);
 373     print "synthesised git commit from .dsc $clogp->{Version}\n";
 374     chdir '../../../..' or die $!;
 375     cmdoutput @git, qw(update-ref -m),"dgit synthesise $clogp->{Version}",
 376               'DGIT_ARCHIVE', $commithash;
 377     cmdoutput @git, qw(log -n2), $commithash;
 378     # ... gives git a chance to complain if our commit is malformed
 379     my $outputhash = $commithash;
 380     if ($upload_hash) {
 381         chdir "$ud/$dir" or die $!;
 382         runcmd @git, qw(reset --hard), $upload_hash;
 383         runcmd qw(sh -ec), 'dpkg-parsechangelog >>../changelogold.tmp';
 384         my $oldclogp = Dpkg::Control::Hash->new();
 385         $oldclogp->parse('../changelogold.tmp','previous changelog') or die;
 386         my $vcmp =
 387             version_compare_string($oldclogp->{Version}, $clogp->{Version});
 388         if ($vcmp < 0) {
 389             # git upload/ is earlier vsn than archive, use archive
 390         } elsif ($vcmp >= 0) {
 391             print STDERR <<END or die $!;
 392 Version actually in archive:    $clogp->{Version} (older)
 393 Last allegedly pushed/uploaded: $oldclogp->{Version} (newer or same)
 394 Perhaps the upload is stuck in incoming.  Using the version from git.
 395 END
 396         } else {
 397             die "version in archive is same as version in git".
 398                 " to-be-uploaded (upload/) branch but archive".
 399                 " version hash no commit hash?!\n";
 400         }
 401         chdir '../../../..' or die $!;
 402     }
 403     rmtree($ud);
 404     return $outputhash;
 405 }
 406
 407 sub ensure_we_have_orig () {
 408     foreach my $f (dsc_files()) {
 409         next unless is_orig_file($f);
 410         if (stat "../$f") {
 411             die "$f ?" unless -f _;
 412         } else {
 413             die "$f $!" unless $!==&ENOENT;
 414         }
 415         my $origurl = $dscurl;
 416         $origurl =~ s{/[^/]+$}{};
 417         $origurl .= "/$f";
 418         die "$f ?" unless $f =~ m/^${package}_/;
 419         die "$f ?" if $f =~ m#/#;
 420         runcmd_ordryrun qw(sh -ec),'cd ..; exec "$@"','x',
 421             @dget,'--',$origurl;
 422     }
 423 }
 424
 425 sub rev_parse ($) {
 426     return cmdoutput @git, qw(rev-parse), "$_[0]~0";
 427 }
 428
 429 sub is_fast_fwd ($$) {
 430     my ($ancestor,$child) = @_;
 431     my $mb = cmdoutput @git, qw(merge-base), $dsc_hash, $upload_hash;
 432     return rev_parse($mb) eq rev_parse($ancestor);
 433 }
 434
 435 sub git_fetch_us () {
 436     die "cannot dry run with fetch" if $dryrun;
 437     runcmd @git, qw(fetch),access_giturl(),fetchspec();
 438 }
 439
 440 sub fetch_from_archive () {
 441     # ensures that lrref() is what is actually in the archive,
 442     #  one way or another
 443     get_archive_dsc() or return 0;
 444     $dsc_hash = $dsc->{$ourdscfield};
 445     if (defined $dsc_hash) {
 446         $dsc_hash =~ m/\w+/ or die "$dsc_hash $?";
 447         $dsc_hash = $&;
 448         print "last upload to archive specified git hash\n";
 449     } else {
 450         print "last upload to archive has NO git hash\n";
 451     }
 452
 453     $!=0; $upload_hash =
 454         cmdoutput_errok @git, qw(show-ref --heads), lrref();
 455     if ($?==0) {
 456         die unless chomp $upload_hash;
 457     } elsif ($?==256) {
 458         $upload_hash = '';
 459     } else {
 460         die $?;
 461     }
 462     my $hash;
 463     if (defined $dsc_hash) {
 464         die "missing git history even though dsc has hash"
 465             unless $upload_hash;
 466         $hash = $dsc_hash;
 467         ensure_we_have_orig();
 468     } else {
 469         $hash = generate_commit_from_dsc();
 470     }
 471     if ($upload_hash) {
 472         die "not fast forward on last upload branch!".
 473             " (archive's version left in DGIT_ARCHIVE)"
 474             unless is_fast_fwd($dsc_hash, $upload_hash);
 475     }
 476     if ($upload_hash ne $hash) {
 477         my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash);
 478         if (!$dryrun) {
 479             cmdoutput @upd_cmd;
 480         } else {
 481             dryrun_report @upd_cmd;
 482         }
 483     }
 484     return 1;
 485 }
 486
 487 sub clone ($) {
 488     my ($dstdir) = @_;
 489     die "dry run makes no sense with clone" if $dryrun;
 490     mkdir $dstdir or die "$dstdir $!";
 491     chdir "$dstdir" or die "$dstdir $!";
 492     runcmd @git, qw(init -q);
 493     runcmd @git, qw(config), "remote.$remotename.fetch", fetchspec();
 494     open H, "> .git/HEAD" or die $!;
 495     print H "ref: ".lref()."\n" or die $!;
 496     close H or die $!;
 497     runcmd @git, qw(remote add), 'origin', access_giturl();
 498     if (check_for_git()) {
 499         print "fetching existing git history\n";
 500         git_fetch_us();
 501         runcmd @git, qw(fetch origin);
 502     } else {
 503         print "starting new git history\n";
 504     }
 505     fetch_from_archive() or die;
 506     runcmd @git, qw(reset --hard), lrref();
 507     print "ready for work in $dstdir\n";
 508 }
 509
 510 sub fetch () {
 511     if (check_for_git()) {
 512         git_fetch_us();
 513     }
 514     fetch_from_archive() or die;
 515 }
 516
 517 sub pull () {
 518     fetch();
 519     runcmd_ordryrun @git, qw(merge -m),"Merge from $suite [dgit]",
 520         lrref();
 521 }
 522
 523 sub dopush () {
 524     runcmd @git, qw(diff --quiet HEAD);
 525     my $clogp = parsechangelog();
 526     $package = $clogp->{Source};
 527     my $dscfn = "${package}_$clogp->{Version}.dsc";
 528     stat "../$dscfn" or die "$dscfn $!";
 529     $dsc = parsecontrol("../$dscfn");
 530     prep_ud();
 531     chdir $ud or die $!;
 532     print "checking that $dscfn corresponds to HEAD\n";
 533     runcmd qw(dpkg-source -x --), "../../../../$dscfn";
 534     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
 535     chdir '../../../..' or die $!;
 536     runcmd @git, qw(diff --exit-code), $tree;
 537 #fetch from alioth
 538 #do fast forward check and maybe fake merge
 539 #    if (!is_fast_fwd(mainbranch
 540 #    runcmd @git, qw(fetch -p ), "$alioth_git/$package.git",
 541 #        map { lref($_).":".rref($_) }
 542 #        (uploadbranch());
 543     $dsc->{$ourdscfield} = rev_parse('HEAD');
 544     $dsc->save("../$dscfn.tmp") or die $!;
 545     if (!$dryrun) {
 546         rename "../$dscfn.tmp","../$dscfn" or die "$dscfn $!";
 547     } else {
 548         print "[new .dsc left in $dscfn.tmp]\n";
 549     }
 550     if (!$changesfile) {
 551         my $pat = "../${package}_$clogp->{Version}_*.changes";
 552         my @cs = glob $pat;
 553         die "$pat ?" unless @cs==1;
 554         ($changesfile) = @cs;
 555     }
 556     my $tag = debiantag($dsc->{Version});
 557     if (!check_for_git()) {
 558         create_remote_git_repo();
 559     }
 560     runcmd_ordryrun @git, qw(push),access_giturl(),"HEAD:".rrref();
 561     if ($sign) {
 562         my @tag_cmd = (@git, qw(tag -s -m),
 563                        "Release $dsc->{Version} for $suite [dgit]");
 564         push @tag_cmd, qw(-u),$keyid if defined $keyid;
 565         push @tag_cmd, $tag;
 566         runcmd_ordryrun @tag_cmd;
 567         my @debsign_cmd = @debsign;
 568         push @debsign_cmd, "-k$keyid" if defined $keyid;
 569         push @debsign_cmd, $changesfile;
 570         runcmd_ordryrun @debsign_cmd;
 571     }
 572     runcmd_ordryrun @git, qw(push),access_giturl(),"refs/tags/$tag";
 573     my $host = access_cfg('upload-host');
 574     my @hostarg = defined($host) ? ($host,) : ();
 575     runcmd_ordryrun @dput, @hostarg, $changesfile;
 576 }
 577
 578 sub cmd_clone {
 579     parseopts();
 580     my $dstdir;
 581     die if defined $package;
 582     if (@ARGV==1) {
 583         ($package) = @ARGV;
 584     } elsif (@ARGV==2 && $ARGV[1] =~ m#^\w#) {
 585         ($package,$suite) = @ARGV;
 586     } elsif (@ARGV==2 && $ARGV[1] =~ m#^[./]#) {
 587         ($package,$dstdir) = @ARGV;
 588     } elsif (@ARGV==3) {
 589         ($package,$suite,$dstdir) = @ARGV;
 590     } else {
 591         die;
 592     }
 593     $dstdir ||= "$package";
 594     clone($dstdir);
 595 }
 596
 597 sub branchsuite () {
 598     my $branch = cmdoutput_errok @git, qw(symbolic-ref HEAD);
 599     chomp $branch;
 600     if ($branch =~ m#$lbranch_re#o) {
 601         return $1;
 602     } else {
 603         return undef;
 604     }
 605 }
 606
 607 sub fetchpullargs () {
 608     if (!defined $package) {
 609         my $sourcep = parsecontrol('debian/control');
 610         $package = $sourcep->{Source};
 611     }
 612     if (@ARGV==0) {
 613         $suite = branchsuite();
 614         if (!$suite) {
 615             my $clogp = parsechangelog();
 616             $suite = $clogp->{Distribution};
 617         }
 618         canonicalise_suite();
 619         print "fetching from suite $suite\n";
 620     } elsif (@ARGV==1) {
 621         ($suite) = @ARGV;
 622         canonicalise_suite();
 623     } else {
 624         die;
 625     }
 626 }
 627
 628 sub cmd_fetch {
 629     parseopts();
 630     fetchpullargs();
 631     fetch();
 632 }
 633
 634 sub cmd_pull {
 635     parseopts();
 636     fetchpullargs();
 637     pull();
 638 }
 639
 640 sub cmd_push {
 641     parseopts();
 642     die if defined $package;
 643     my $clogp = parsechangelog();
 644     $package = $clogp->{Source};
 645     if (@ARGV==0) {
 646         $suite = $clogp->{Distribution};
 647         if ($new_package) {
 648             local ($package) = 'dpkg';
 649             canonicalise_suite();
 650         }
 651     } else {
 652         die;
 653     }
 654     if (fetch_from_archive()) {
 655         is_fast_fwd(lrref(), 'HEAD') or die;
 656     } else {
 657         die unless $new_package;
 658     }
 659     dopush();
 660 }
 661
 662 sub cmd_build {
 663     # we pass further options and args to git-buildpackage
 664     die if defined $package;
 665     my $clogp = parsechangelog();
 666     $suite = $clogp->{Distribution};
 667     $package = $clogp->{Source};
 668     canonicalise_suite();
 669     runcmd_ordryrun
 670         qw(git-buildpackage -us -uc --git-no-sign-tags),
 671         '--git-builder=dpkg-buildpackage -i\.git/ -I.git',
 672         "--git-debian-branch=".lbranch(),
 673         @ARGV;
 674 }
 675
 676 sub parseopts () {
 677     my $om;
 678     while (@ARGV) {
 679         last unless $ARGV[0] =~ m/^-/;
 680         $_ = shift @ARGV;
 681         last if m/^--?$/;
 682         if (m/^--/) {
 683             if (m/^--dry-run$/) {
 684                 $dryrun=1;
 685             } elsif (m/^--no-sign$/) {
 686                 $sign=0;
 687             } elsif (m/^--new$/) {
 688                 $new_package=1;
 689             } elsif (m/^--(\w+)=(.*)/s && ($om = $opts_opt_map{$1})) {
 690                 $om->[0] = $2;
 691             } elsif (m/^--(\w+):(.*)/s && ($om = $opts_opt_map{$1})) {
 692                 push @$om, $2;
 693             } else {
 694                 die "$_ ?";
 695             }
 696         } else {
 697             while (m/^-./s) {
 698                 if (s/^-n/-/) {
 699                     $dryrun=1;
 700                 } elsif (s/^-D/-/) {
 701                     open DEBUG, ">&STDERR" or die $!;
 702                     $debug++;
 703                 } elsif (s/^-N/-/) {
 704                     $new_package=1;
 705                 } elsif (s/^-c(.*=.*)//s) {
 706                     push @git, '-c', $1;
 707                 } elsif (s/^-C(.*)//s) {
 708                     $changesfile = $1;
 709                 } elsif (s/^-k(.*)//s) {
 710                     $keyid=$1;
 711                 } else {
 712                     die "$_ ?";
 713                 }
 714             }
 715         }
 716     }
 717 }
 718
 719 parseopts();
 720 die unless @ARGV;
 721 my $cmd = shift @ARGV;
 722
 723 { no strict qw(refs); &{"cmd_$cmd"}(); }