diff options
author | Ian Jackson <ijackson@chiark.greenend.org.uk> | 2015-05-02 20:33:10 +0100 |
---|---|---|
committer | Ian Jackson <ijackson@chiark.greenend.org.uk> | 2015-05-31 11:54:09 +0100 |
commit | 41d1bd6a6c194f11f906e1140861e976fac3f4e0 (patch) | |
tree | 5e44292c499fae0072107714504fcc8ae181ab07 | |
parent | c02c4c21a1ae474acf22b09b400081d4e21fb149 (diff) |
dgit-repos-policy-debian: Add debugging output
-rw-r--r-- | Debian/Dgit.pm | 9 | ||||
-rwxr-xr-x | infra/dgit-repos-policy-debian | 20 | ||||
-rwxr-xr-x | tests/drs-git-ext | 3 |
3 files changed, 26 insertions, 6 deletions
diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index f166f11..e2a503d 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -17,7 +17,8 @@ BEGIN { @EXPORT = qw(debiantag server_branch server_ref stat_exists git_for_each_ref $package_re $component_re $branchprefix - initdebug enabledebug printdebug debugcmd + initdebug enabledebug enabledebuglevel + printdebug debugcmd $debugprefix *debuglevel *DEBUG shellquote printcmd); %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO)] ); @@ -91,6 +92,12 @@ sub enabledebug () { $debuglevel ||= 1; } +sub enabledebuglevel ($) { + die if $debuglevel; + ($debuglevel) = @_ + 0; + enabledebug(); +} + sub printdebug { print DEBUG $debugprefix, @_ or die $! if $debuglevel>0; } diff --git a/infra/dgit-repos-policy-debian b/infra/dgit-repos-policy-debian index 3c7c006..3353d42 100755 --- a/infra/dgit-repos-policy-debian +++ b/infra/dgit-repos-policy-debian @@ -9,10 +9,14 @@ use JSON; use File::Temp qw(tempfile); use DBI; use IPC::Open2; +use Data::Dumper; use Debian::Dgit qw(:DEFAULT :policyflags); use Debian::Dgit::Policy::Debian; +initdebug('%'); +enabledebuglevel $ENV{'DGIT_DRS_DEBUG'}; + our $distro = shift @ARGV // die "need DISTRO"; our $repos = shift @ARGV // die "need DGIT-REPOS-DIR"; our $dgitlive = shift @ARGV // die "need DGIT-LIVE-DIR"; @@ -79,11 +83,16 @@ our %deliberately; sub apiquery ($) { my ($subpath) = @_; local $/=undef; - my $cmd = "$dgitlive/dgit -d $distro ". - "\$DGIT_TEST_OPTS \$DGIT_TEST_DEBUG archive-api-query $subpath"; + my $cmd = "$dgitlive/dgit -d $distro \$DGIT_TEST_OPTS"; + $cmd .= " -".("D" x $debuglevel) if $debuglevel; + $cmd .= " archive-api-query $subpath"; + printdebug "apiquery $cmd\n"; $!=0; $?=0; my $json = `$cmd`; defined $json or die "$subpath $! $?"; - return decode_json $json; + my $r = decode_json $json; + my $d = new Data::Dumper([$r], [qw(r)]); + printdebug "apiquery $subpath | ", $d->Dump(), "\n" if $debuglevel>=2; + return $r; } sub specific_suite_has_vsn_in_our_history ($) { @@ -123,10 +132,12 @@ sub good_suite_has_vsn_in_our_history () { sub statpackage () { $pkgdir = "$repos/$pkg.git"; if (!stat_exists $pkgdir) { + printdebug "statpackage $pkg => ENOENT\n"; $pkg_exists = 0; } else { $pkg_exists = 1; $pkg_secret = !!(~(stat _)[2] & 05); + printdebug "statpackage $pkg => exists, secret=$pkg_secret.\n"; } } @@ -381,7 +392,7 @@ sub action_check_list () { statpackage(); next unless $pkg_exists; next unless $pkg_secret; - print "$pkg\n" or die $!; + printdebug "$pkg\n" or die $!; } closedir L or die $!; close STDOUT or die $!; @@ -391,6 +402,7 @@ sub action_check_list () { $action =~ y/-/_/; my $fn = ${*::}{"action_$action"}; if (!$fn) { + printdebug "dgit-repos-policy-debian: unknown action $action\n"; exit 0; } diff --git a/tests/drs-git-ext b/tests/drs-git-ext index 06ab0ea..ad27c9b 100755 --- a/tests/drs-git-ext +++ b/tests/drs-git-ext @@ -2,7 +2,8 @@ set -e tmp=$DGIT_TEST_TMP -export DGIT_DRS_DEBUG=1 +: ${DGIT_DRS_DEBUG:=1} +export DGIT_DRS_DEBUG echo >&2 '((((((((((((((((((((((((((((((((((((((((' set -x export SSH_ORIGINAL_COMMAND="$*" |