use Exporter ();
our (@EXPORT_OK,@ISA);
@ISA = qw(Exporter);
- @EXPORT_OK = qw( &msvalog &reviewcert );
+ @EXPORT_OK = qw( &reviewcert );
}
our @EXPORT_OK;
use Crypt::Monkeysphere::MSVA::MarginalUI;
+ use Crypt::Monkeysphere::MSVA::Logger;
use parent qw(HTTP::Server::Simple::CGI);
require Crypt::X509;
use Regexp::Common qw /net/;
my $default_keyserver = 'hkp://pool.sks-keyservers.net';
my $default_keyserver_policy = 'unlessvalid';
-# Net::Server log_level goes from 0 to 4
-# this is scaled to match.
- my %loglevels = (
- 'silent' => 0,
- 'quiet' => 0.25,
- 'fatal' => 0.5,
- 'error' => 1,
- 'info' => 2,
- 'verbose' => 3,
- 'debug' => 4,
- 'debug1' => 4,
- 'debug2' => 5,
- 'debug3' => 6,
- );
+ my $logger = Crypt::Monkeysphere::MSVA::Logger->new($ENV{MSVA_LOG_LEVEL});
+ sub logger {
+ return $logger;
+ }
my $rsa_decoder = Convert::ASN1->new;
$rsa_decoder->prepare(q<
}
>);
- sub msvalog {
- my $msglevel = shift;
-
- my $level = $loglevels{lc($ENV{MSVA_LOG_LEVEL})};
- $level = $loglevels{error} if (! defined $level);
-
- if ($loglevels{lc($msglevel)} <= $level) {
- printf STDERR @_;
- }
- };
-
- sub get_log_level {
- my $level = $loglevels{lc($ENV{MSVA_LOG_LEVEL})};
- $level = $loglevels{error} if (! defined $level);
- return $level;
- }
-
sub net_server {
return 'Net::Server::MSVA';
};
+ sub msvalog {
+ return $logger->log(@_);
+ };
+
sub new {
my $class = shift;
my $resp = Crypt::Monkeysphere::MSVA::MarginalUI->ask_the_user($gnupg,
$uid,
\@subvalid_key_fprs,
- getpidswithsocketinode($clientinfo->{inode}));
+ getpidswithsocketinode($clientinfo->{inode}),
+ $logger);
msvalog('info', "response: %s\n", $resp);
if ($resp) {
$ret->{valid} = JSON::true;
--- /dev/null
+#----------------------------------------------------------------------
+# Monkeysphere Validation Agent, Perl version
+# Marginal User Interface for reasonable prompting
+# Copyright © 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net>,
+# Matthew James Goins <mjgoins@openflows.com>,
+# Jameson Graef Rollins <jrollins@finestructure.net>,
+# Elliot Winard <enw@caveteen.com>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+#
+#----------------------------------------------------------------------
+
+{ package Crypt::Monkeysphere::MSVA::Logger;
+
+ use strict;
+ use warnings;
+
+ # Net::Server log_level goes from 0 to 4
+ # this is scaled to match.
+ my %loglevels = (
+ 'silent' => 0,
+ 'quiet' => 0.25,
+ 'fatal' => 0.5,
+ 'error' => 1,
+ 'info' => 2,
+ 'verbose' => 3,
+ 'debug' => 4,
+ 'debug1' => 4,
+ 'debug2' => 5,
+ 'debug3' => 6,
+ );
+
+ sub log {
+ my $self = shift;
+ my $msglevel = shift;
+
+ if ($loglevels{lc($msglevel)} <= $self->{loglevel}) {
+ printf STDERR @_;
+ }
+ };
+
+ sub get_log_level {
+ my $self = shift;
+
+ return $self->{loglevel};
+ }
+
+ # let the user test to see if we're noisier than this level
+ # directly:
+ sub is_logging_at {
+ my $self = shift;
+ my $qlevel = shift;
+
+ return ($loglevels{lc($qlevel)} <= $self->{loglevel});
+ }
+
+ sub new {
+ my $class = shift;
+ my $loglevel = shift;
+
+ my $self = {loglevel => $loglevels{lc($loglevel)}};
+ $self->{loglevel} = $loglevels{error}
+ if (!defined $self->{loglevel});
+
+ bless ($self, $class);
+ return $self;
+ }
+
+ 1;
+}
use strict;
use warnings;
- use Crypt::Monkeysphere::MSVA qw( msvalog );
use IO::File;
use Module::Load::Conditional;
my $uid = shift;
my $fprs = shift;
my $clientpids = shift;
+ my $logger = shift;
my @subvalid_key_fprs = @{$fprs};
- msvalog('debug', "%d subvalid_key_fprs\n", $#subvalid_key_fprs+1);
+ $logger->log('debug', "%d subvalid_key_fprs\n", $#subvalid_key_fprs+1);
if (! Module::Load::Conditional::can_load('modules' => { 'Gtk2' => undef })) {
- msvalog('info', "Gtk2 Perl module is unavailable, so no marginal UI presented\n");
+ $logger->log('info', "Gtk2 Perl module is unavailable, so no marginal UI presented\n");
return 0;
}
foreach my $keyfpr (@subvalid_key_fprs) {
my $fprx = sprintf('0x%.40s', $keyfpr->{fpr}->as_hex_string);
- msvalog('debug', "checking on %s\n", $fprx);
+ $logger->log('debug', "checking on %s\n", $fprx);
foreach my $gpgkey ($gnupg->get_public_keys_with_sigs($fprx)) {
- msvalog('debug', "found key %.40s\n", $gpgkey->fingerprint->as_hex_string);
+ $logger->log('debug', "found key %.40s\n", $gpgkey->fingerprint->as_hex_string);
# we're going to prompt the user here if we have any
# relevant certifiers:
my @valid_certifiers;
# That's a mess, but i'm not sure what the better thing
# to do is.
foreach my $user_id ($gpgkey->user_ids) {
- msvalog('debug', "found EE User ID %s\n", $user_id->as_string);
+ $logger->log('debug', "found EE User ID %s\n", $user_id->as_string);
if ($user_id->as_string eq $uid) {
# get a list of the certifiers of the relevant User ID for the key
foreach my $cert (@{$user_id->signatures}) {
if ($cert->hex_id =~ /^([A-Fa-f0-9]{16})$/) {
my $certid = $1;
- msvalog('debug', "found certifier 0x%.16s\n", $certid);
+ $logger->log('debug', "found certifier 0x%.16s\n", $certid);
if ($cert->is_valid()) {
foreach my $certifier ($gnupg->get_public_keys(sprintf('0x%.40s!', $certid))) {
my $valid_cuid = 0;
}
}
} else {
- msvalog('error', "certifier ID does not fit expected pattern '%s'\n", $cert->hex_id);
+ $logger->log('error', "certifier ID does not fit expected pattern '%s'\n", $cert->hex_id);
}
}
}
# certifiers, and a separate list of marginally-valid
# certifiers.
if ($#valid_certifiers < 0) {
- msvalog('info', "No valid certifiers, so no marginal UI\n");
+ $logger->log('info', "No valid certifiers, so no marginal UI\n");
} else {
my $certifier_list = join("\n", map { sprintf("%s [%s]",
$_->{user_id},
if ($#clienttext >= 0) {
$tip = sprintf("%s\n\nRequested by:\n%s\n", $tip, join("\n", @clienttext));
}
- msvalog('info', "%s\n", $msg);
- msvalog('verbose', "%s\n", $tip);
+ $logger->log('info', "%s\n", $msg);
+ $logger->log('verbose', "%s\n", $tip);
my $resp = prompt($uid, $msg, $tip);
if ($resp) {
my $server = Crypt::Monkeysphere::MSVA->new();
$server->run(host=>'localhost',
- log_level=> Crypt::Monkeysphere::MSVA::get_log_level(),
+ log_level=> $server->logger->get_log_level(),
user => POSIX::geteuid(), # explicitly choose regular user and group (avoids spew)
group => POSIX::getegid(),
msva=>$server);
projects / monkeysphere-validation-agent.git / commitdiff