diff options
Diffstat (limited to 'Debian/Dgit.pm')
| -rw-r--r-- | Debian/Dgit.pm | 83 |
1 files changed, 83 insertions, 0 deletions
diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index 5106f85..0e2464d 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -31,6 +31,7 @@ use Data::Dumper; use IPC::Open2; use File::Path; use File::Basename; +use Dpkg::Control::Hash; BEGIN { use Exporter (); @@ -41,6 +42,7 @@ BEGIN { @EXPORT = qw(setup_sigwarn forkcheck_setup forkcheck_mainprocess dep14_version_mangle debiantags debiantag_old debiantag_new + debiantag_maintview server_branch server_ref stat_exists link_ltarget hashfile @@ -66,6 +68,8 @@ BEGIN { $negate_harmful_gitattrs changedir git_slurp_config_src gdr_ffq_prev_branchinfo + parsecontrolfh parsecontrol parsechangelog + getfield parsechangelog_loop playtree_setup); # implicitly uses $main::us %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO NOCOMMITCHECK)], @@ -206,6 +210,11 @@ sub debiantag_new ($$) { return "archive/$distro/".dep14_version_mangle $v; } +sub debiantag_maintview ($$) { + my ($v,$distro) = @_; + return "$distro/".dep14_version_mangle $v; +} + sub debiantags ($$) { my ($version,$distro) = @_; map { $_->($version, $distro) } (\&debiantag_new, \&debiantag_old); @@ -554,6 +563,80 @@ sub gdr_ffq_prev_branchinfo ($) { return ('branch', undef, $symref, $ffq_prev, $gdrlast); } +sub parsecontrolfh ($$;$) { + my ($fh, $desc, $allowsigned) = @_; + our $dpkgcontrolhash_noissigned; + my $c; + for (;;) { + my %opts = ('name' => $desc); + $opts{allow_pgp}= $allowsigned || !$dpkgcontrolhash_noissigned; + $c = Dpkg::Control::Hash->new(%opts); + $c->parse($fh,$desc) or die "parsing of $desc failed"; + last if $allowsigned; + last if $dpkgcontrolhash_noissigned; + my $issigned= $c->get_option('is_pgp_signed'); + if (!defined $issigned) { + $dpkgcontrolhash_noissigned= 1; + seek $fh, 0,0 or die "seek $desc: $!"; + } elsif ($issigned) { + fail "control file $desc is (already) PGP-signed. ". + " Note that dgit push needs to modify the .dsc and then". + " do the signature itself"; + } else { + last; + } + } + return $c; +} + +sub parsecontrol { + my ($file, $desc, $allowsigned) = @_; + my $fh = new IO::Handle; + open $fh, '<', $file or die "$file: $!"; + my $c = parsecontrolfh($fh,$desc,$allowsigned); + $fh->error and die $!; + close $fh; + return $c; +} + +sub parsechangelog { + my $c = Dpkg::Control::Hash->new(name => 'parsed changelog'); + my $p = new IO::Handle; + my @cmd = (qw(dpkg-parsechangelog), @_); + open $p, '-|', @cmd or die $!; + $c->parse($p); + $?=0; $!=0; close $p or failedcmd @cmd; + return $c; +} + +sub getfield ($$) { + my ($dctrl,$field) = @_; + my $v = $dctrl->{$field}; + return $v if defined $v; + fail "missing field $field in ".$dctrl->get_option('name'); +} + +sub parsechangelog_loop ($$$) { + my ($clogcmd, $descbase, $fn) = @_; + # @$clogcmd is qw(dpkg-parsechangelog ...some...options...) + # calls $fn->($thisstanza, $desc); + debugcmd "|",@$clogcmd; + open CLOGS, "-|", @$clogcmd or die $!; + for (;;) { + my $stanzatext = do { local $/=""; <CLOGS>; }; + printdebug "clogp stanza ".Dumper($stanzatext) if $debuglevel>1; + last if !defined $stanzatext; + + my $desc = "$descbase, entry no.$."; + open my $stanzafh, "<", \$stanzatext or die; + my $thisstanza = parsecontrolfh $stanzafh, $desc, 1; + + $fn->($thisstanza, $desc); + } + die $! if CLOGS->error; + close CLOGS or $?==SIGPIPE or failedcmd @$clogcmd; +} + # ========== playground handling ========== # terminology: |