From 4c3ff1c38c7db68f382041fb1068d092eaabd875 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 12 Jan 2014 14:32:46 +0000 Subject: dgit-repos-server: rename from dgit-repos-push-receiver --- dgit-repos-push-receiver | 324 ----------------------------------------------- dgit-repos-server | 324 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 324 insertions(+), 324 deletions(-) delete mode 100644 dgit-repos-push-receiver create mode 100644 dgit-repos-server diff --git a/dgit-repos-push-receiver b/dgit-repos-push-receiver deleted file mode 100644 index 0f7c4b0..0000000 --- a/dgit-repos-push-receiver +++ /dev/null @@ -1,324 +0,0 @@ -#!/usr/bin/perl -w -# dgit-repos-push-receiver -# -# usages: -# .../dgit-repos-push-receiver KEYRING-AUTH-SPEC DGIT-REPOS-DIR --ssh -# .../dgit-repos-push-receiver KEYRING-AUTH-SPEC DGIT-REPOS-DIR PACKAGE -# internal usage: -# .../dgit-repos-push-receiver --pre-receive-hook PACKAGE -# -# Invoked as the ssh restricted command -# -# Works like git-receive-pack -# -# KEYRING-AUTH-SPEC is a :-separated list of -# KEYRING.GPG,AUTH-SPEC -# where AUTH-SPEC is one of -# a -# mDM.TXT - -use strict; - -# What we do is this: -# - extract the destination repo name somehow -# - make a hardlink clone of the destination repo -# - provide the destination with a stunt pre-receive hook -# - run actual git-receive-pack with that new destination -# as a result of this the stunt pre-receive hook runs; it does this -# find the keyring(s) to use for verification -# verify the signed tag -# check that the signed tag has a suitable name -# parse the signed tag body to extract the intended -# distro and suite -# check that the distro is right -# check that the suite is the same as the branch we are -# supposed to update -# check that the signed tag refers to the same commit -# as the new suite -# check that the signer was correct -# push the signed tag to the actual repo -# push the new dgit branch head to the actual repo - -use POSIX; -use Fcntl qw(:flock); - -our $package_re = '[0-9a-z][-+.0-9a-z]+'; - -our $dgitrepos; -our $pkg; -our $destrepo; -our $workrepo; -our @keyrings; - -sub acquirelock ($$) { - my ($lock, $must) = @_; - for (;;) { - my $fh = new IO::File, ">", $lock or die "open $lock: $!"; - my $ok = flock $fh, $must ? LOCK_EX : (LOCK_EX|LOCK_NB); - if (!$ok) { - return unless $must; - die "flock $lock: $!"; - } - if (!stat $lock) { - next if $! == ENOENT; - die "stat $lock: $!"; - } - my $want = (stat _)[1]; - stat $fh or die $!; - my $got = (stat _)[1]; - return $fh if $got == $want; - } -} - -sub makeworkingclone () { - $workrepo = "$dgitrepos/_tmp/${pkg}_incoming$$"; - my $lock = "$workrepo.lock"; - my $lockfh = acquirelock($lock, 1); - if (!stat $destrepo) { - $! == ENOENT or die "stat dest repo $destrepo: $!"; - mkdir $workrepo or die "create work repo $workrepo: $!"; - runcmd qw(git init --bare), $workrepo; - } else { - runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo; - } -} - -sub setupstunthook () { - my $prerecv = "$workrepo/hooks/pre-receive"; - my $fh = new IO::File, $prerecv, O_WRONLY|O_CREAT|O_TRUNC, 0777 - or die "$prerecv: $!"; - print $fh <) { - m/^(\S+) (\S+) (\S+)$/ or die "$_ ?"; - my ($old, $sha1, $refname) = ($1, $2, $3); - if ($refname =~ m{^refs/tags/(?=debian/)}) { - die if defined $tagname; - $tagname = $'; #'; - $tagval = $sha1; - reject "tag $tagname already exists -". - " not replacing previously-pushed version" - if $old =~ m/[^0]/; - } elsif ($refname =~ m{^refs/dgit/}) { - die if defined $suite; - $suite = $'; #'; - $oldcommit = $old; - $commit = $sha1; - } else { - die; - } - } - STDIN->error and die $!; - - die unless defined $refname; - die unless defined $branchname; -} - -sub parsetag () { - open PT, ">dgit-tmp/plaintext" or die $!; - open DS, ">dgit-tmp/plaintext.asc" or die $!; - open T, "-|", qw(git cat-file tag), $tagval or die $!; - my %tagh; - for (;;) { - $!=0; $_=; defined or die $!; - print PT or die $!; - if (m/^(\S+) (.*)/) { - push @{ $tagh{$1} }, $2; - } elsif (!m/\S/) { - last; - } else { - die; - } - } - $!=0; $_=; defined or die $!; - m/^($package_re) release (\S+) for (\S+) \[dgit\]$/ or die; - - die unless $1 eq $pkg; - $version = $2; - die unless $3 eq $suite; - - for (;;) { - print PT or die $!; - $!=0; $_=; defined or die $!; - last if m/^-----BEGIN PGP/; - } - for (;;) { - print DS or die $!; - $!=0; $_=; - last if !defined; - } - T->error and die $!; - close PT or die $!; - close DS or die $!; -} - -sub checksig_keyring ($) { - my ($keyringfile) = @_; - # returns primary-keyid if signed by a key in this keyring - # or undef if not - # or dies on other errors - - my $ok = undef; - - open P, "-|", (qw(gpgv --status-fd=1), - map { '--keyring', $_ }, @keyrings, - qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext)) - or die $!; - - while (

) { - next unless s/^\[GNUPG:\]: //; - chomp or die; - my @l = split / /, $_; - if ($l[0] eq 'NO_PUBKEY') { - last; - } elsif ($l[0] eq 'VALIDSIG') { - my $sigtype = $l[9]; - $sigtype eq '00' or reject "signature is not of type 00!"; - $ok = $l[10]; - die unless defined $ok; - last; - } - } - close P; - - return $ok; -} - -sub dm_txt_check ($$) { - my ($keyid, $dmtxtfn) = @_; - open DT, '<', $dmtxtfn or die "$dmtxtfn $!"; - while (

) { - m/^fingerprint:\s+$keyid$/oi - ..0 or next; - m/^\S/ - or reject "key $keyid missing Allow section in permissions!"; - # in right stanza... - s/^allow:/ /i - ..0 or next; - s/^\s+// - or reject "package $package not allowed for key $keyid"; - # in allow field... - s/\([^()]+\)//; - s/\,//; - foreach my $p (split /\s+/) { - return if $p eq $package; # yay! - } - } - DT->error and die $!; - close DT or die $!; - reject "key $keyid not in permissions list although in keyring!"; -} - -sub verifytag () { - foreach my $kas (split /:/, $keyrings) { - $kas =~ s/^([^,]+),// or die; - my $keyid = checksig_keyring $1; - if (defined $keyid) { - if ($kas =~ m/^a$/) { - return; # yay - } elsif ($kas =~ m/^m([^,]+)$/) { - dm_txt_check($keyid, $1); - return; - } else { - die; - } - } - } - reject "key not found in keyrings"; -} - -sub checktag () { - tagh1('object') eq $branchval or die; - tagh1('type') eq 'commit' or die; - tagh1('tag') eq $tagname or die; - - my $v = $version; - $v =~ y/~:/_%/; - $tagname eq "debian/$v" or die; - - check fast forward; -} - - -sub stunthook () { - chdir $workrepo or die "chdir $workrepo: $!"; - mkdir "dgit-tmp" or $!==EEXIST or die $!; - readupdates(); - parsetag(); - verifytag(); - checktag(); -... ... -} - -#----- arg parsing and main program ----- - -sub parseargs () { - die unless @ARGV; - - if ($ARGV[0] eq '--pre-receive-hook') { - shift @ARGV; - @ARGV == 1 or die; - $pkg = shift @ARGV; - defined($workrepo = $ENV{'DGIT_RPR_WORK'}) or die; - defined($destrepo = $ENV{'DGIT_RPR_DEST'}) or die; - defined($keyrings = $ENV{'DGIT_RPR_KEYRINGS'}) or die $!; - open STDOUT, ">&STDERR" or die $!; - stunthook(); - exit 0; - } - - die unless @ARGV>=2; - - die if $ARGV[0] =~ m/^-/; - $ENV{'DGIT_RPR_KEYRINGS'} = shift @ARGV; - die if $ARGV[0] =~ m/^-/; - $dgitrepos = shift @ARGV; - - die unless @ARGV; - if ($ARGV[0] != m/^-/) { - @ARGV == 1 or die; - $pkg = shift @ARGV; - } elsif ($ARGV[0] eq '--ssh') { - shift @ARGV; - !@ARGV or die; - my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'}; - $cmd =~ m{ - ^ - (?:\S*/)? - (git-receive-pack|git-upload-pack) - \s+ - (?:\S*/)? - ($package_re)\.git - $ - }ox - or die "requested command $cmd not understood"; - $method = $1; - $pkg = $2; - } else { - die; - } - - $destrepo = "$dgitrepos/$pkg.git"; -} - -sub main () { - parseargs(); -fixme check method; - makeworkingclone(); - setupstunthook(); - runcmd qw(git receive-pack), $destdir; -} diff --git a/dgit-repos-server b/dgit-repos-server new file mode 100644 index 0000000..0f7c4b0 --- /dev/null +++ b/dgit-repos-server @@ -0,0 +1,324 @@ +#!/usr/bin/perl -w +# dgit-repos-push-receiver +# +# usages: +# .../dgit-repos-push-receiver KEYRING-AUTH-SPEC DGIT-REPOS-DIR --ssh +# .../dgit-repos-push-receiver KEYRING-AUTH-SPEC DGIT-REPOS-DIR PACKAGE +# internal usage: +# .../dgit-repos-push-receiver --pre-receive-hook PACKAGE +# +# Invoked as the ssh restricted command +# +# Works like git-receive-pack +# +# KEYRING-AUTH-SPEC is a :-separated list of +# KEYRING.GPG,AUTH-SPEC +# where AUTH-SPEC is one of +# a +# mDM.TXT + +use strict; + +# What we do is this: +# - extract the destination repo name somehow +# - make a hardlink clone of the destination repo +# - provide the destination with a stunt pre-receive hook +# - run actual git-receive-pack with that new destination +# as a result of this the stunt pre-receive hook runs; it does this +# find the keyring(s) to use for verification +# verify the signed tag +# check that the signed tag has a suitable name +# parse the signed tag body to extract the intended +# distro and suite +# check that the distro is right +# check that the suite is the same as the branch we are +# supposed to update +# check that the signed tag refers to the same commit +# as the new suite +# check that the signer was correct +# push the signed tag to the actual repo +# push the new dgit branch head to the actual repo + +use POSIX; +use Fcntl qw(:flock); + +our $package_re = '[0-9a-z][-+.0-9a-z]+'; + +our $dgitrepos; +our $pkg; +our $destrepo; +our $workrepo; +our @keyrings; + +sub acquirelock ($$) { + my ($lock, $must) = @_; + for (;;) { + my $fh = new IO::File, ">", $lock or die "open $lock: $!"; + my $ok = flock $fh, $must ? LOCK_EX : (LOCK_EX|LOCK_NB); + if (!$ok) { + return unless $must; + die "flock $lock: $!"; + } + if (!stat $lock) { + next if $! == ENOENT; + die "stat $lock: $!"; + } + my $want = (stat _)[1]; + stat $fh or die $!; + my $got = (stat _)[1]; + return $fh if $got == $want; + } +} + +sub makeworkingclone () { + $workrepo = "$dgitrepos/_tmp/${pkg}_incoming$$"; + my $lock = "$workrepo.lock"; + my $lockfh = acquirelock($lock, 1); + if (!stat $destrepo) { + $! == ENOENT or die "stat dest repo $destrepo: $!"; + mkdir $workrepo or die "create work repo $workrepo: $!"; + runcmd qw(git init --bare), $workrepo; + } else { + runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo; + } +} + +sub setupstunthook () { + my $prerecv = "$workrepo/hooks/pre-receive"; + my $fh = new IO::File, $prerecv, O_WRONLY|O_CREAT|O_TRUNC, 0777 + or die "$prerecv: $!"; + print $fh <) { + m/^(\S+) (\S+) (\S+)$/ or die "$_ ?"; + my ($old, $sha1, $refname) = ($1, $2, $3); + if ($refname =~ m{^refs/tags/(?=debian/)}) { + die if defined $tagname; + $tagname = $'; #'; + $tagval = $sha1; + reject "tag $tagname already exists -". + " not replacing previously-pushed version" + if $old =~ m/[^0]/; + } elsif ($refname =~ m{^refs/dgit/}) { + die if defined $suite; + $suite = $'; #'; + $oldcommit = $old; + $commit = $sha1; + } else { + die; + } + } + STDIN->error and die $!; + + die unless defined $refname; + die unless defined $branchname; +} + +sub parsetag () { + open PT, ">dgit-tmp/plaintext" or die $!; + open DS, ">dgit-tmp/plaintext.asc" or die $!; + open T, "-|", qw(git cat-file tag), $tagval or die $!; + my %tagh; + for (;;) { + $!=0; $_=; defined or die $!; + print PT or die $!; + if (m/^(\S+) (.*)/) { + push @{ $tagh{$1} }, $2; + } elsif (!m/\S/) { + last; + } else { + die; + } + } + $!=0; $_=; defined or die $!; + m/^($package_re) release (\S+) for (\S+) \[dgit\]$/ or die; + + die unless $1 eq $pkg; + $version = $2; + die unless $3 eq $suite; + + for (;;) { + print PT or die $!; + $!=0; $_=; defined or die $!; + last if m/^-----BEGIN PGP/; + } + for (;;) { + print DS or die $!; + $!=0; $_=; + last if !defined; + } + T->error and die $!; + close PT or die $!; + close DS or die $!; +} + +sub checksig_keyring ($) { + my ($keyringfile) = @_; + # returns primary-keyid if signed by a key in this keyring + # or undef if not + # or dies on other errors + + my $ok = undef; + + open P, "-|", (qw(gpgv --status-fd=1), + map { '--keyring', $_ }, @keyrings, + qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext)) + or die $!; + + while (

) { + next unless s/^\[GNUPG:\]: //; + chomp or die; + my @l = split / /, $_; + if ($l[0] eq 'NO_PUBKEY') { + last; + } elsif ($l[0] eq 'VALIDSIG') { + my $sigtype = $l[9]; + $sigtype eq '00' or reject "signature is not of type 00!"; + $ok = $l[10]; + die unless defined $ok; + last; + } + } + close P; + + return $ok; +} + +sub dm_txt_check ($$) { + my ($keyid, $dmtxtfn) = @_; + open DT, '<', $dmtxtfn or die "$dmtxtfn $!"; + while (

) { + m/^fingerprint:\s+$keyid$/oi + ..0 or next; + m/^\S/ + or reject "key $keyid missing Allow section in permissions!"; + # in right stanza... + s/^allow:/ /i + ..0 or next; + s/^\s+// + or reject "package $package not allowed for key $keyid"; + # in allow field... + s/\([^()]+\)//; + s/\,//; + foreach my $p (split /\s+/) { + return if $p eq $package; # yay! + } + } + DT->error and die $!; + close DT or die $!; + reject "key $keyid not in permissions list although in keyring!"; +} + +sub verifytag () { + foreach my $kas (split /:/, $keyrings) { + $kas =~ s/^([^,]+),// or die; + my $keyid = checksig_keyring $1; + if (defined $keyid) { + if ($kas =~ m/^a$/) { + return; # yay + } elsif ($kas =~ m/^m([^,]+)$/) { + dm_txt_check($keyid, $1); + return; + } else { + die; + } + } + } + reject "key not found in keyrings"; +} + +sub checktag () { + tagh1('object') eq $branchval or die; + tagh1('type') eq 'commit' or die; + tagh1('tag') eq $tagname or die; + + my $v = $version; + $v =~ y/~:/_%/; + $tagname eq "debian/$v" or die; + + check fast forward; +} + + +sub stunthook () { + chdir $workrepo or die "chdir $workrepo: $!"; + mkdir "dgit-tmp" or $!==EEXIST or die $!; + readupdates(); + parsetag(); + verifytag(); + checktag(); +... ... +} + +#----- arg parsing and main program ----- + +sub parseargs () { + die unless @ARGV; + + if ($ARGV[0] eq '--pre-receive-hook') { + shift @ARGV; + @ARGV == 1 or die; + $pkg = shift @ARGV; + defined($workrepo = $ENV{'DGIT_RPR_WORK'}) or die; + defined($destrepo = $ENV{'DGIT_RPR_DEST'}) or die; + defined($keyrings = $ENV{'DGIT_RPR_KEYRINGS'}) or die $!; + open STDOUT, ">&STDERR" or die $!; + stunthook(); + exit 0; + } + + die unless @ARGV>=2; + + die if $ARGV[0] =~ m/^-/; + $ENV{'DGIT_RPR_KEYRINGS'} = shift @ARGV; + die if $ARGV[0] =~ m/^-/; + $dgitrepos = shift @ARGV; + + die unless @ARGV; + if ($ARGV[0] != m/^-/) { + @ARGV == 1 or die; + $pkg = shift @ARGV; + } elsif ($ARGV[0] eq '--ssh') { + shift @ARGV; + !@ARGV or die; + my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'}; + $cmd =~ m{ + ^ + (?:\S*/)? + (git-receive-pack|git-upload-pack) + \s+ + (?:\S*/)? + ($package_re)\.git + $ + }ox + or die "requested command $cmd not understood"; + $method = $1; + $pkg = $2; + } else { + die; + } + + $destrepo = "$dgitrepos/$pkg.git"; +} + +sub main () { + parseargs(); +fixme check method; + makeworkingclone(); + setupstunthook(); + runcmd qw(git receive-pack), $destdir; +} -- cgit v1.2.3