X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;ds=sidebyside;f=dgit;h=5f88625d300ef44bccda6c67b5995f4f9726a26e;hb=c683c8f8e7b9e917b68ed02bd584a505b1636734;hp=d00ab1f04fc7d61b69f10d03cf0dbf1f18628771;hpb=e41608c3549b3e34839ad15b2e29607794c1ccd6;p=dgit.git diff --git a/dgit b/dgit index d00ab1f0..5f88625d 100755 --- a/dgit +++ b/dgit @@ -30,6 +30,7 @@ use Dpkg::Version; use POSIX; use IPC::Open2; use Digest::SHA; +use Digest::MD5; use Config; our $our_version = 'UNRELEASED'; ###substituted### @@ -119,9 +120,14 @@ sub stripepoch ($) { return $vsn; } +sub srcfn ($$) { + my ($vsn,$sfx) = @_; + return "${package}_".(stripepoch $vsn).$sfx +} + sub dscfn ($) { my ($vsn) = @_; - return "${package}_".(stripepoch $vsn).".dsc"; + return srcfn($vsn,".dsc"); } our $us = 'dgit'; @@ -510,13 +516,15 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit.default.username' => '', 'dgit.default.archive-query-default-component' => 'main', 'dgit.default.ssh' => 'ssh', + 'dgit.default.archive-query' => 'madison:', + 'dgit.default.sshpsql-dbname' => 'service=projectb', + 'dgit-distro.debian.archive-query' => 'sshpsql:', 'dgit-distro.debian.git-host' => 'git.debian.org', 'dgit-distro.debian.git-proto' => 'git+ssh://', 'dgit-distro.debian.git-path' => '/git/dgit-repos/repos', 'dgit-distro.debian.git-check' => 'ssh-cmd', 'dgit-distro.debian.git-create' => 'ssh-cmd', 'dgit-distro.debian.sshpsql-host' => 'mirror.ftp-master.debian.org', - 'dgit-distro.debian.sshpsql-dbname' => 'service=projectb', '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*', @@ -558,9 +566,7 @@ sub cfg { sub access_basedistro () { if (defined $idistro) { - return cfg("dgit-distro.basedistro.distro", - "dgit-suite.$isuite.distro", - 'RETURN-UNDEF') // $idistro; + return $idistro; } else { return cfg("dgit-suite.$isuite.distro", "dgit.default.distro"); @@ -568,7 +574,7 @@ sub access_basedistro () { } sub access_quirk () { - # returns (quirk name, distro to use instead, quirk-specific info) + # returns (quirk name, distro to use instead or undef, quirk-specific info) my $basedistro = access_basedistro(); my $backports_quirk = cfg("dgit-distro.$basedistro.backports-quirk", 'RETURN-UNDEF'); @@ -582,22 +588,52 @@ sub access_quirk () { return ('backports',"$basedistro-backports",$1); } } - return ('none',$basedistro); + return ('none',undef); } -sub access_distro () { - return (access_quirk())[1]; +sub access_distros () { + # Returns list of distros to try, in order + # + # We want to try: + # 1. the access_quirk distro, if any + # 2a. the user's specified distro, or failing that } basedistro + # 2b. the distro calculated from the suite } + my @l = access_basedistro(); + + my (undef,$quirkdistro) = access_quirk(); + unshift @l, $quirkdistro if defined $quirkdistro; + + return @l; } sub access_cfg (@) { my (@keys) = @_; - my $basedistro = access_basedistro(); - my $distro = $idistro || access_distro(); - my $value = cfg(map { - ("dgit-distro.$distro.$_", - "dgit-distro.$basedistro.$_", - "dgit.default.$_") - } @keys); + my @cfgs; + # The nesting of these loops determines the search order. We put + # the key loop on the outside so that we search all the distros + # for each key, before going on to the next key. That means that + # if access_cfg is called with a more specific, and then a less + # specific, key, an earlier distro can override the less specific + # without necessarily overriding any more specific keys. (If the + # distro wants to override the more specific keys it can simply do + # so; whereas if we did the loop the other way around, it would be + # impossible to for an earlier distro to override a less specific + # key but not the more specific ones without restating the unknown + # values of the more specific keys. + my @realkeys; + my @rundef; + # We have to deal with RETURN-UNDEF specially, so that we don't + # terminate the search prematurely. + foreach (@keys) { + if (m/RETURN-UNDEF/) { push @rundef, $_; last; } + push @realkeys, $_ + } + foreach my $d (access_distros()) { + push @cfgs, map { "dgit-distro.$d.$_" } @realkeys; + } + push @cfgs, map { "dgit.default.$_" } @realkeys; + push @cfgs, @rundef; + my $value = cfg(@cfgs); return $value; } @@ -619,6 +655,11 @@ sub access_cfg_ssh () { } } +sub access_runeinfo ($) { + my ($info) = @_; + return ": dgit ".access_basedistro()." $info ;"; +} + sub access_someuserhost ($) { my ($some) = @_; my $user = access_cfg("$some-user",'username'); @@ -630,11 +671,14 @@ sub access_gituserhost () { return access_someuserhost('git'); } -sub access_giturl () { +sub access_giturl (;$) { + my ($optional) = @_; my $url = access_cfg('git-url','RETURN-UNDEF'); if (!defined $url) { + my $proto = access_cfg('git-proto', 'RETURN-UNDEF'); + return undef unless defined $proto; $url = - access_cfg('git-proto'). + $proto. access_gituserhost(). access_cfg('git-path'); } @@ -722,16 +766,6 @@ our %rmad; sub archive_query ($) { my ($method) = @_; my $query = access_cfg('archive-query','RETURN-UNDEF'); - if (!defined $query) { - my $distro = access_basedistro(); - if ($distro eq 'debian') { - $query = "sshpsql:". - access_someuserhost('sshpsql').':'. - access_cfg('sshpsql-dbname'); - } else { - $query = "madison:$distro"; - } - } $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'"; my $proto = $1; my $data = $'; #'; @@ -744,17 +778,21 @@ sub pool_dsc_subpath ($$) { return "/pool/$component/$prefix/$package/".dscfn($vsn); } -sub archive_query_madison ($$) { +sub archive_query_madison { + return map { [ @$_[0..1] ] } madison_get_parse(@_); +} + +sub madison_get_parse { my ($proto,$data) = @_; die unless $proto eq 'madison'; - $rmad{$package} ||= cmdoutput + if (!length $data) { + $data= access_cfg('madison-distro','RETURN-UNDEF'); + $data //= access_basedistro(); + } + $rmad{$proto,$data,$package} ||= cmdoutput qw(rmadison -asource),"-s$isuite","-u$data",$package; - my $rmad = $rmad{$package}; - return madison_parse($rmad); -} + my $rmad = $rmad{$proto,$data,$package}; -sub madison_parse ($) { - my ($rmad) = @_; my @out; foreach my $l (split /\n/, $rmad) { $l =~ m{^ \s*( [^ \t|]+ )\s* \| @@ -776,9 +814,9 @@ sub madison_parse ($) { return sort { -version_compare($a->[0],$b->[0]); } @out; } -sub canonicalise_suite_madison ($$) { +sub canonicalise_suite_madison { # madison canonicalises for us - my @r = archive_query_madison($_[0],$_[1]); + my @r = madison_get_parse(@_); @r or fail "unable to canonicalise suite using package $package". " which does not appear to exist in suite $isuite;". @@ -786,13 +824,19 @@ sub canonicalise_suite_madison ($$) { return $r[0][2]; } -sub sshpsql ($$) { - my ($data,$sql) = @_; +sub sshpsql ($$$) { + my ($data,$runeinfo,$sql) = @_; + if (!length $data) { + $data= access_someuserhost('sshpsql').':'. + access_cfg('sshpsql-dbname'); + } $data =~ m/:/ or badcfg "invalid sshpsql method string \`$data'"; my ($userhost,$dbname) = ($`,$'); #'; my @rows; my @cmd = (access_cfg_ssh, $userhost, - "export LANG=C; ".shellquote qw(psql -A), $dbname, qw(-c), $sql); + access_runeinfo("ssh-psql $runeinfo"). + " export LANG=C;". + " ".shellquote qw(psql -A), $dbname, qw(-c), $sql); printcmd(\*DEBUG,$debugprefix."|",@cmd) if $debug>0; open P, "-|", @cmd or die $!; while (
) {
@@ -812,13 +856,13 @@ sub sshpsql ($$) {
}
sub sql_injection_check {
- foreach (@_) { die "$_ $& ?" if m/[']/; }
+ foreach (@_) { die "$_ $& ?" if m{[^-+=:_.,/0-9a-zA-Z]}; }
}
sub archive_query_sshpsql ($$) {
my ($proto,$data) = @_;
sql_injection_check $isuite, $package;
- my @rows = sshpsql($data, <