Crypt/Monkeysphere/Validator.pm

   1 package Crypt::Monkeysphere::Validator;
   2 use Carp;
   3 use strict;
   4 use warnings;
   5
   6 use parent 'Crypt::Monkeysphere::Keyserver';
   7
   8 =pod
   9
  10 =head2 new
  11
  12 Create a new Crypt::Monkeysphere::Validator instance
  13
  14 Arguments
  15
  16      Param hash, all optional.
  17
  18      findall => 0|1   return all suitable keys, rather than first suitable
  19
  20      context => 'e-mail' | something else.
  21                         control what counts as a suitable key.
  22
  23      kspolicy => 'always|never|unlessvalid'
  24                         when to fetch keys from keyserver.
  25
  26   (plus arguments for Crypt::Monkeysphere::{Keyserver,Logger}::new )
  27
  28 =cut
  29
  30 sub new {
  31   my $class=shift;
  32   my %opts=@_;
  33
  34   my $self=$class->SUPER::new(%opts);
  35
  36   $self->{findall} = $opts{findall} || 0;
  37   $self->{context}=$opts{context} || 'ssh';
  38   $self->{kspolicy}=$opts{kspolicy} || 'unlessvalid';
  39   return $self;
  40 }
  41
  42 sub test_capable {
  43   my $self=shift;
  44   my $subkey=shift;
  45
  46   if ($self->{context} eq 'e-mail') {
  47     if ($subkey->usage_flags =~ /s/) {
  48       $self->log('verbose', "...and is signing-capable...\n");
  49       return 1;
  50     } else {
  51       $self->log('verbose', "...but is not signing-capable (%s).\n",$subkey->usage_flags);
  52     }
  53   } else {
  54     if ($subkey->usage_flags =~ /a/) {
  55       $self->log('verbose', "...and is authentication-capable...\n");
  56       return 1;
  57     } else {
  58       $self->log('verbose', "...but is not authentication-capable (%s).\n",$subkey->usage_flags);
  59     }
  60   }
  61   return 0;
  62 }
  63
  64 sub query{
  65   my $self=shift;
  66   my %opts=@_;
  67
  68   my $uid=$opts{uid} || croak "uid argument is mandatory";
  69   my $fpr=$opts{fpr};
  70   my $key=$opts{key};
  71
  72   my $gpgquery = defined($fpr) ?  '0x'.$fpr : '='.$uid;
  73
  74   my $ret= { valid_keys => [],
  75              subvalid_keys => [] };
  76
  77   # setup variables
  78   my $lastloop = 0;
  79   my $foundvalid = 0;
  80
  81   if ($self->{kspolicy} eq 'always') {
  82     if (defined $fpr) {
  83       $self->fetch_fpr($fpr);
  84     } else {
  85       $self->fetch_uid($uid);
  86     }
  87     $lastloop = 1;
  88   } elsif ($self->{kspolicy} eq 'never') {
  89     $lastloop = 1;
  90   }
  91
  92   while (1) {
  93     foreach my $gpgkey ($self->{gnupg}->get_public_keys($gpgquery)) {
  94       my $validity = '-';
  95       foreach my $tryuid ($gpgkey->user_ids) {
  96         if ($tryuid->as_string eq $uid) {
  97           $validity = $tryuid->validity;
  98         }
  99       }
 100       # treat primary keys just like subkeys:
 101       foreach my $subkey ($gpgkey, @{$gpgkey->subkeys}) {
 102           if ((!defined($key) && (!defined($fpr))) ||
 103               (defined($key) && $self->keycomp($key, $subkey)) ||
 104               (defined($fpr) && ($subkey->fingerprint->as_hex_string eq $fpr))) {
 105             $self->log('verbose', "key 0x%s matches...\n",$subkey->hex_id);
 106             if ($self->test_capable($subkey) ) {
 107               if ($validity =~ /^[fu]$/) {
 108                 $foundvalid = 1;
 109                 $self->log('verbose', "...and is fully valid!\n");
 110                 push(@{$ret->{valid_keys}},
 111                      { fingerprint => $subkey->fingerprint, val => $validity });
 112                 last unless($self->{findall});
 113               } else {
 114                 $self->log('verbose', "...but is not fully valid (%s).\n",$validity);
 115                 push(@{$ret->{subvalid_keys}},
 116                      {fingerprint => $subkey->fingerprint, val => $validity }) if $lastloop;
 117               }
 118             }
 119           }
 120         }
 121         last if ($foundvalid);
 122       }
 123       if ($lastloop || $foundvalid) {
 124         last;
 125       } else {
 126         if (!$foundvalid) {
 127           if (defined $fpr) {
 128             $self->fetch_fpr($fpr);
 129           } else {
 130             $self->fetch_uid($uid);
 131           }
 132         }
 133         $lastloop = 1;
 134       }
 135     }
 136
 137   return $ret;
 138
 139 }
 140
 141 sub keycomp {
 142   my $self=shift;
 143   my $rsakey = shift;
 144   my $gpgkey = shift;
 145
 146   if ($gpgkey->algo_num != 1) {
 147     my $self->log('verbose', "Monkeysphere only does RSA keys.  This key is algorithm #%d\n", $gpgkey->algo_num);
 148     } else {
 149       if ($rsakey->{exponent}->bcmp($gpgkey->pubkey_data->[1]) == 0 &&
 150           $rsakey->{modulus}->bcmp($gpgkey->pubkey_data->[0]) == 0) {
 151         return 1;
 152       }
 153     }
 154     return 0;
 155   }
 156
 157 1;