<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package URPM;

use strict;

#- compare keys to avoid glitches introduced during the importation where
#- some characters may be modified on the fly by rpm --import...
sub compare_pubkeys {
    my ($a, $b, %options) = @_;
    my $diff = 0;
    my @a = unpack "C*", $a-&gt;{content};
    my @b = unpack "C*", $b-&gt;{content};

    #- default options to use.
    $options{start} ||= 0;
    $options{end} ||= @a &lt; @b ? scalar(@b) : scalar(@a);
    $options{diff} ||= 1;

    #- check element one by one, count all difference (do not work well if elements
    #- have been inserted/deleted).
    foreach ($options{start} .. $options{end}) {
	$a[$_] != $b[$_] and ++$diff;
    }

    #- diff options give level to consider the key equal (a character is not always the same).
    $diff &lt;= $options{diff} ? 0 : $diff;
}

#- parse an armored file and import in keys hash if the key does not already exists.
sub parse_armored_file {
    my (undef, $file) = @_;
    my ($block, $content, @l);

    #- check if an already opened file has been given directly.
    unless (ref $file) {
	my $F;
	open $F, $file or return ();
	$file = $F;
    }

    #- read armored file.
    local $_;
    while (&lt;$file&gt;) {
	my $inside_block = /^-----BEGIN PGP PUBLIC KEY BLOCK-----$/ ... /^-----END PGP PUBLIC KEY BLOCK-----$/;
	if ($inside_block) {
	    $block .= $_;
	    if ($inside_block =~ /E/) {
		#- block is needed to import the key if needed.
		push @l, { block =&gt; $block, content =&gt; $content };
		$block = $content = undef;
	    } else {
		#- compute content for finding the right key.
		chomp;
		/^$/ and $content = '';
		defined $content and $content .= $_;
	    }
	}
    }
    @l;
}

#- pare from rpmlib db.
sub parse_pubkeys {
    my ($urpm, %options) = @_;
    my ($block, $content);

    my $db = $options{db};
    $db ||= URPM::DB::open($options{root});

    $db-&gt;traverse_tag('name', [ 'gpg-pubkey' ], sub {
	    my ($p) = @_;
	    foreach (split "\n", $p-&gt;description) {
		$block ||= /^-----BEGIN PGP PUBLIC KEY BLOCK-----$/;
		if ($block) {
		    my $inside_block = /^$/ ... /^-----END PGP PUBLIC KEY BLOCK-----$/;
		    if ($inside_block &gt; 1) {
			if ($inside_block =~ /E/) {
			    $urpm-&gt;{keys}{$p-&gt;version} = {
				$p-&gt;summary =~ /^gpg\((.*)\)$/ ? (name =&gt; $1) : @{[]},
				id =&gt; $p-&gt;version,
				content =&gt; $content,
				block =&gt; $p-&gt;description,
			    };
			    $block = undef;
			    $content = '';
			} else {
			    $content .= $_;
			}
		    }
		}
	    }
	});
}

#- import pubkeys only if it is needed.
sub import_needed_pubkeys {
    my ($urpm, $l, %options) = @_;

    #- use the same database handle to avoid re-opening multiple times the database.
    my $db = $options{db};
    $db ||= URPM::DB::open($options{root}, 1);

    #- assume $l is a reference to an array containing all the keys to import
    #- if needed.
    foreach my $k (@{$l || []}) {
	my ($id, $imported);
	foreach my $kv (values %{$urpm-&gt;{keys} || {}}) {
	    compare_pubkeys($k, $kv, %options) == 0 and $id = $kv-&gt;{id}, last;
	}
	unless ($id) {
	    $imported = 1;
	    import_pubkey(block =&gt; $k-&gt;{block}, db =&gt; $db);
	    $urpm-&gt;parse_pubkeys(db =&gt; $db);
	    foreach my $kv (values %{$urpm-&gt;{keys} || {}}) {
		compare_pubkeys($k, $kv, %options) == 0 and $id = $kv-&gt;{id}, last;
	    }
	}
	#- let the caller know about what has been found.
	#- this is an error if the key is not found.
	$options{callback} and $options{callback}-&gt;($urpm, $db, $k, $id, $imported, %options);
    }
}

1;
</pre></body></html>