view release on metacpan or  search on metacpan

GPG.pm  view on Meta::CPAN

        $j                   =~ / created (\d*)\s/;
        $sub_hash->{created} =  $1 if $1;
        push @{$hash->{sig}},$sub_hash;
      }
      $hash->{key_id} = $hash->{sig}[0]{key_id};
      push @$res, $hash;
    }
    return $res;
  }


### import #################################################

    sub read_import_key_result { my ($msg) = @_;
      my $ret = {};
         $ret->{total_ok}    = 0;
         $ret->{total_found} = 0;
         $ret->{secret}      = [];
         $ret->{public}      = [];

      my @secret = grep(/secret key imported/,$msg);
      for my $i (@secret) {
        $i =~ /.*\skey\s(\w+)\:\ssecret key imported/;
        push @{$ret->{secret}}, $1 and $ret->{total_ok}++ if $1;
        
      }

      my @public = grep(/public key imported/,$msg);
      for my $i (@public) {
        $i =~ /.*\skey\s(\w+)\:\spublic key imported/;
        push @{$ret->{public}}, $1 and $ret->{total_ok}++ if $1;
      }

      $msg =~ /Total number processed\:\s+(\d+)\s/;
      $ret->{total_found} = $1 if $1;

      return $ret;
    }

  # import is a Perl reserved keyword, sorry...
  sub import_keys { my ($this,$import) = @_;
    my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.' --import', $import);
    return if !$pid;

    my $res = read_import_key_result($error);
    #$this->error($error) and return if !$res;

    return $res;
  }

  sub fast_import { my ($this,$import) = @_;
    my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.' --fast-import', $import);
    return if !$pid;

    my $res = read_import_key_result($error);
    #$this->error($error) and return if !$res;

    return $res;
  }

  sub update_trustdb { my ($this) = @_;
    my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.' --update-trustdb', '');
    return if !$pid;

    $error =~ s/^gpg: (\d+) keys processed\s*//;
    my $number_processed = $1 || '0';

    $this->error($error) and return if $error;
    return $number_processed;
  }

### fingerprint ############################################

  sub fingerprint { my ($this,$key_id) = @_;
    my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
         "--fingerprint $key_id", "");
    return if !$pid;
    $this->error($error) and return if $error;

    my $fingerprint = [];
    my @text = split(/\s*\n/,$output);

    for(my $i = 0; $i < $#text; $i++) {
      if ($text[$i] =~ /^pub\s+.*\/(\w+)\s+\S+\s+(.*)\s*$/) {
        my $hash = {};
        $hash->{'key_id'}   =  $1 if $1;
        $hash->{'key_name'} =  $2 if $2;

        $text[$i+1]            =~ /^\s+Key fingerprint = (.*)\s*$/m;
        $hash->{'fingerprint'} =  $1 if $1;
        push @$fingerprint, $hash;
        $i++;
      }
    }

    return $fingerprint;
  }


### sign_key ###############################################

  sub sign_key { my ($this,$key_id,$passphrase,$key_to_sign) = @_;
    return "gpg: can't do that in batchmode (thanks gnupg...)";
    my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
         "--passphrase-fd 0 --default-key $key_id --sign-key $key_to_sign","$passphrase");
    return if !$pid;

    $this->error($error) and return if $error;
    return $output;
  }

  sub lsign_key { my ($this,$key_id) = @_;
    return "gpg: can't do that in batchmode (thanks gnupg...)";
  }


### export_key #############################################

  sub export_key { my ($this,$key_id) = @_;
    my ($pid,$output,$error) = start_gpg($this,$this->{'COMMAND'}.
         "--export-all $key_id", "");