Crypt/Monkeysphere/MSVA/MarginalUI.pm

   1 #----------------------------------------------------------------------
   2 # Monkeysphere Validation Agent, Perl version
   3 # Marginal User Interface for reasonable prompting
   4 # Copyright © 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net>,
   5 #                  Matthew James Goins <mjgoins@openflows.com>,
   6 #                  Jameson Graef Rollins <jrollins@finestructure.net>,
   7 #                  Elliot Winard <enw@caveteen.com>
   8 #
   9 # This program is free software: you can redistribute it and/or modify
  10 # it under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation, either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # This program is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21 #
  22 #----------------------------------------------------------------------
  23
  24 { package Crypt::Monkeysphere::MSVA::MarginalUI;
  25
  26   use strict;
  27   use warnings;
  28
  29   use IO::File;
  30   use Module::Load::Conditional;
  31
  32   sub ask_the_user {
  33     my $self = shift;
  34     my $gnupg = shift;
  35     my $uid = shift;
  36     my $fprs = shift;
  37     my $clientpids = shift;
  38     my $logger = shift;
  39     my @subvalid_key_fprs = @{$fprs};
  40
  41     $logger->log('debug', "%d subvalid_key_fprs\n", $#subvalid_key_fprs+1);
  42
  43     if (! Module::Load::Conditional::can_load('modules' => { 'Gtk2' => undef })) {
  44       $logger->log('info', "Gtk2 Perl module is unavailable, so no marginal UI presented\n");
  45       return 0;
  46     }
  47
  48
  49     foreach my $keyfpr (@subvalid_key_fprs) {
  50       my $fprx = sprintf('0x%.40s', $keyfpr->{fpr}->as_hex_string);
  51       $logger->log('debug', "checking on %s\n", $fprx);
  52       foreach my $gpgkey ($gnupg->get_public_keys_with_sigs($fprx)) {
  53         $logger->log('debug', "found key %.40s\n", $gpgkey->fingerprint->as_hex_string);
  54
  55         # FIXME: if there are multiple keys in the OpenPGP WoT
  56         # with the same key material and the same User ID
  57         # attached, we'll be throwing multiple prompts per query
  58         # (until the user selects one or cancels them all).
  59         # That's a mess, but i'm not sure what the better thing
  60         # to do is.
  61         foreach my $user_id ($gpgkey->user_ids) {
  62           $logger->log('debug', "found EE User ID %s\n", $user_id->as_string);
  63           my @valid_certifiers = ();
  64           my @marginal_certifiers = ();
  65           if ($user_id->as_string eq $uid) {
  66             # get a list of the certifiers of the relevant User ID for the key
  67             foreach my $cert (@{$user_id->signatures}) {
  68               if ($cert->hex_id =~ /^([A-Fa-f0-9]{16})$/) {
  69                 my $certid = $1;
  70                 $logger->log('debug', "found certifier 0x%.16s\n", $certid);
  71                 if ($cert->is_valid()) {
  72                   foreach my $certifier ($gnupg->get_public_keys(sprintf('0x%.40s!', $certid))) {
  73                     my $valid_cuid = 0;
  74                     my $marginal = undef;
  75                     foreach my $cuid ($certifier->user_ids) {
  76                       # grab the first full or ultimate user ID on
  77                       # this certifier's key:
  78                       if ($cuid->validity =~ /^[fu]$/) {
  79                         push(@valid_certifiers, { key_id => $cert->hex_id,
  80                                                   user_id => $cuid->as_string,
  81                                                 } );
  82                         $valid_cuid = 1;
  83                         last;
  84                       } elsif ($cuid->validity =~ /^[m]$/) {
  85                         $marginal = { key_id => $cert->hex_id,
  86                                       user_id => $cuid->as_string,
  87                                     };
  88                       }
  89                     }
  90                     push(@marginal_certifiers, $marginal)
  91                       if (! $valid_cuid && defined $marginal);
  92                   }
  93                 }
  94               } else {
  95                 $logger->log('error', "certifier ID does not fit expected pattern '%s'\n", $cert->hex_id);
  96               }
  97             }
  98           }
  99           # else ## do we care at all about other User IDs on this key?
 100
 101           # We now know the list of fully/ultimately-valid
 102           # certifiers, and a separate list of marginally-valid
 103           # certifiers.
 104           if ($#valid_certifiers < 0) {
 105             $logger->log('info', "No valid certifiers, so no marginal UI\n");
 106           } else {
 107             my $certifier_list = join("\n", map { sprintf("%s [%s]",
 108                                                           $_->{user_id},
 109                                                           $_->{key_id},
 110                                                          ) } @valid_certifiers);
 111             my $msg = sprintf("The matching key for \"%s\" is not %svalid.
 112
 113 The certificate is certified by:
 114
 115 %s
 116
 117 Would you like to temporarily accept this certificate for this peer?",
 118                               $uid,
 119                               ('m' eq $keyfpr->{val} ? 'fully ' : ''),
 120                               $certifier_list,
 121                              );
 122             my $tip = sprintf("Peer's User ID: %s
 123 Peer's OpenPGP key fingerprint: 0x%.40s
 124 GnuPG calculated validity for the peer: %s",
 125                               $uid,
 126                               $keyfpr->{fpr}->as_hex_string,
 127                               $keyfpr->{val},
 128                              );
 129             # FIXME: what about revoked certifications?
 130             # FIXME: what about expired certifications?
 131             # FIXME: what about certifications ostensibly made in the future?
 132
 133             my @clienttext;
 134             foreach my $clientpid (@{$clientpids}) {
 135               my $cmd = '<unknown>';
 136               # FIXME: not very portable
 137               my $procfh;
 138               $procfh = IO::File::->new(sprintf('/proc/%d/cmdline', $clientpid));
 139               if (defined $procfh) {
 140                 $cmd = <$procfh>;
 141                 $procfh->close;
 142                 # FIXME: maybe there's a better way to display this textually
 143                 # that doesn't conflate spaces with argument delimiters?
 144                 $cmd = join(' ', split(/\0/, $cmd));
 145               }
 146               push @clienttext, sprintf("Process %d (%s)", $clientpid, $cmd);
 147             }
 148             if ($#clienttext >= 0) {
 149               $tip = sprintf("%s\n\nRequested by:\n%s\n", $tip, join("\n", @clienttext));
 150             }
 151             $logger->log('info', "%s\n", $msg);
 152             $logger->log('verbose', "%s\n", $tip);
 153
 154             my $resp = prompt($uid, $msg, $tip);
 155             if ($resp) {
 156               return $resp;
 157             }
 158           }
 159           # FIXME: not doing anything with @marginal_certifiers
 160           # -- that'd be yet more queries to gpg :(
 161         }
 162       }
 163     }
 164     return 0;
 165   }
 166
 167   sub prompt {
 168     my $peer = shift;
 169     my $labeltxt = shift;
 170     my $tip = shift;
 171
 172     require Gtk2;
 173     Gtk2->init();
 174     # create a new dialog with some buttons - one stock, one not.
 175     my $dialog = Gtk2::Dialog->new(sprintf('Monkeysphere validation agent [%s]', $peer),
 176                                    undef,
 177                                    [],
 178                                    'gtk-no' => 'cancel',
 179                                    'gtk-yes' => 'ok');
 180
 181
 182
 183     my $label = Gtk2::Label->new($labeltxt);
 184     # make the text in the dialog box selectable
 185     $label->set('selectable', 1);
 186     $label->show();
 187     my $button = Gtk2::Button->new_with_label($peer);
 188     $button->show();
 189     my $tipshowing = 0;
 190
 191     my $tooltips = Gtk2::Tooltips->new();
 192     $tooltips->set_tip($label, $tip);
 193     $dialog->get_content_area()->add($button);
 194     $dialog->get_content_area()->add($label);
 195
 196     my ($width, $height) = $dialog->get_size();
 197     $button->signal_connect('clicked',
 198                             sub {
 199  # FIXME: for some reason, $label->set_text($labeltxt."\n\n".$tip) throws this error:
 200  # Insecure dependency in eval_sv() while running with -T switch at Crypt/Monkeysphere/MSVA/MarginalUI.pm line 180.
 201  # the workaround here (remove, destroy, re-create) seems to work, though.
 202                               $dialog->get_content_area()->remove($label);
 203                               $label->destroy();
 204                               $tipshowing = ! $tipshowing;
 205                               if (!$tipshowing) {
 206                                 $label = Gtk2::Label->new($labeltxt);
 207                                 $tooltips->set_tip($label, $tip);
 208                                 $dialog->resize($width, $height);
 209                               } else {
 210                                 $label = Gtk2::Label->new($tip."\n\n".$labeltxt);
 211                               }
 212                               $label->set('selectable', 1);
 213                               $label->show();
 214                               $dialog->get_content_area()->add($label);
 215                             });
 216
 217     my $resp = 0;
 218
 219     my $icon_file = '/usr/share/pixmaps/monkeysphere-icon.png';
 220
 221     $dialog->set_default_icon_from_file($icon_file)
 222       if (-r $icon_file);
 223     $dialog->set_default_response('cancel');
 224     # set initial kbd input focus on "No" also:
 225     ($dialog->get_action_area()->get_children())[1]->grab_focus();
 226
 227     my $response = $dialog->run();
 228     if ($response eq 'ok') {
 229       $resp = 1;
 230     }
 231
 232     # we'll let the fact that the process is about to terminate
 233     # destroy the window.  so lazy!
 234
 235     return $resp;
 236   }
 237
 238   1;
 239 }