X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=87a038009a006ad1feaa5d28b7721caa122f7959;hp=25afa6734dfebd9a692c524954a537e2b847dfcc;hb=3b8d3ae177321d340de16b1dced5c9d262e56f72;hpb=010a0e1ee137b4fc4d6e5cbfbc5551df8835ce7e diff --git a/dgit b/dgit index 25afa673..87a03800 100755 --- a/dgit +++ b/dgit @@ -102,6 +102,7 @@ our $remotename = 'dgit'; our @ourdscfield = qw(Dgit Vcs-Dgit-Master); our $branchprefix = 'dgit'; our $csuite; +our $instead_distro; sub lbranch () { return "$branchprefix/$csuite"; } my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$'; @@ -519,9 +520,15 @@ our %defcfg = ('dgit.default.distro' => 'debian', '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-host' => 'dgit-git.debian.net', + 'dgit-distro.debian.git-user-force' => 'dgit', 'dgit-distro.debian.git-proto' => 'git+ssh://', - 'dgit-distro.debian.git-path' => '/git/dgit-repos/repos', + 'dgit-distro.debian.git-path' => '/dgit/debian/repos', + '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.git-check' => 'ssh-cmd', 'dgit-distro.debian.git-create' => 'ssh-cmd', 'dgit-distro.debian.sshpsql-host' => 'mirror.ftp-master.debian.org', @@ -566,9 +573,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"); @@ -576,7 +581,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'); @@ -590,22 +595,53 @@ 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: + # 0. `instead of' distro name(s) we have been pointed to + # 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; + unshift @l, $instead_distro; + return grep { defined } @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; } @@ -627,9 +663,16 @@ 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'); + my $user = access_cfg("$some-user-force", 'RETURN-UNDEF'); + defined($user) && length($user) or + $user = access_cfg("$some-user",'username'); my $host = access_cfg("$some-host"); return length($user) ? "$user\@$host" : $host; } @@ -638,11 +681,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'); } @@ -742,20 +788,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'; if (!length $data) { - $data= access_cfg('madison-distro',access_basedistro()); + $data= access_cfg('madison-distro','RETURN-UNDEF'); + $data //= access_basedistro(); } - $rmad{$package} ||= cmdoutput + $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* \| @@ -777,9 +824,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;". @@ -787,8 +834,8 @@ 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'); @@ -797,7 +844,9 @@ sub sshpsql ($$) { 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 (

) { @@ -817,13 +866,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, < .git/HEAD" or die $!; - print H "ref: ".lref()."\n" or die $!; - close H or die $!; - runcmd @git, qw(remote add), 'origin', access_giturl(); - if (check_for_git()) { + my $giturl = access_giturl(1); + if (defined $giturl) { + runcmd @git, qw(config), "remote.$remotename.fetch", fetchspec(); + open H, "> .git/HEAD" or die $!; + print H "ref: ".lref()."\n" or die $!; + close H or die $!; + runcmd @git, qw(remote add), 'origin', $giturl; + } + if ($hasgit) { progress "fetching existing git history"; git_fetch_us(); runcmd_ordryrun_local @git, qw(fetch origin); @@ -1967,6 +2031,38 @@ our $dscfn; our $fakeeditorenv = 'DGIT_FAKE_EDITOR_QUILT'; +sub quiltify ($$) { + my ($clogp,$headref) = @_; + + my $author = getfield $clogp, 'Maintainer'; + my $time = time; + my $ncommits = 3; + my $patchname = "auto-$version-$headref-$time"; + my $msg = cmdoutput @git, qw(log), "-n$ncommits"; + mkpath '.git/dgit'; + my $descfn = ".git/dgit/quilt-description.tmp"; + open O, '>', $descfn or die "$descfn: $!"; + $msg =~ s/\n/\n /g; + $msg =~ s/^\s+$/ ./mg; + print O <{Version}) + Last (up to) $ncommits git changes, FYI: + . + $msg +Author: $author + +--- + +END + close O or die $!; + { + local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0; + local $ENV{'VISUAL'} = $ENV{'EDITOR'}; + local $ENV{$fakeeditorenv} = cmdoutput qw(realpath --), $descfn; + runcmd_ordryrun_local @dpkgsource, qw(--commit .), $patchname; + } +} + sub build_maybe_quilt_fixup () { my $format=get_source_format; return unless madformat $format; @@ -2085,33 +2181,7 @@ END rename '../fake/.pc','.pc' or die $!; } - my $author = getfield $clogp, 'Maintainer'; - my $time = time; - my $ncommits = 3; - my $patchname = "auto-$version-$headref-$time"; - my $msg = cmdoutput @git, qw(log), "-n$ncommits"; - mkpath '.git/dgit'; - my $descfn = ".git/dgit/quilt-description.tmp"; - open O, '>', $descfn or die "$descfn: $!"; - $msg =~ s/\n/\n /g; - $msg =~ s/^\s+$/ ./mg; - print O <{Version}) - Last (up to) $ncommits git changes, FYI: - . - $msg -Author: $author - ---- - -END - close O or die $!; - { - local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0; - local $ENV{'VISUAL'} = $ENV{'EDITOR'}; - local $ENV{$fakeeditorenv} = cmdoutput qw(realpath --), $descfn; - runcmd_ordryrun_local @dpkgsource, qw(--commit .), $patchname; - } + quiltify($clogp,$headref); if (!open P, '>>', ".pc/applied-patches") { $!==&ENOENT or die $!;