diff options
Diffstat (limited to 'pki/base/tps/lib/perl/PKI/TPS/Modutil.pm')
| -rwxr-xr-x | pki/base/tps/lib/perl/PKI/TPS/Modutil.pm | 263 |
1 files changed, 263 insertions, 0 deletions
diff --git a/pki/base/tps/lib/perl/PKI/TPS/Modutil.pm b/pki/base/tps/lib/perl/PKI/TPS/Modutil.pm new file mode 100755 index 000000000..49c248c2e --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/Modutil.pm @@ -0,0 +1,263 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library 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 +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + + +package PKI::TPS::Modutil; + + +sub new { + my $class = shift; + my ($dir) = @_; + + if (! $dir) { die "no module directory provided\n"; } + + my $self = {}; + + $self->{dir} = $dir; + $self->{modules} = makemodules($self); + + bless $self, $class; + return $self; +} + +sub exists { + my $self = shift; + + return -e "$self->{dir}/secmod.db"; +} + +sub create { + my $self = shift; + + my $mods = `modutil -force -dbdir '$self->{dir}' -nocertdb -create`; + return $mods; +} + +use Data::Dumper; + +sub makemodules { + my $self = shift; + my $modules = {}; + + my $mods = `modutil -force -dbdir '$self->{dir}' -nocertdb -list`; + #my $mods = join "",<::DATA>; + + #print "raw mods = $mods"; + + my (@modules) = ( + $mods =~ / + ^ #beginning of a line + \s+ #some spaces + \d+\.\s* #some digits + (.*?) #lots of text + ((?=^\s*\d+)|(?=------)) #if we would next match some spaces and digits + /msxg ); + + @modules = grep /.+/ms, @modules; + + foreach $module (@modules) { + #print "Module #$i:$module --\n"; + $module = "modulename:$module"; + my ($moduleheader, $rest) = ( + $module =~ / + (.*status: .*?\n) # moduleheader + (\s*slot:.*) # slot + (?=\n(\n|$)) #empty line + /msxg ); + #print "moduleheader: $moduleheader\n"; + my $m = makehash($moduleheader); + $modules->{$m->{modulename}} = $m; + $m->{tokens} = {}; + + my @tokens = split "\n\n", $rest; + + + +# get summary slot info with: -list + foreach my $token (@tokens) { + #print "slottext: $slot\n"; + my $slh = makehash($token); + $m->{tokens}->{$slh->{token}} = $slh; + } + +# get detailed slot info with: -list "modulename" + + my $moduledetail = `modutil -force -dbdir '$self->{dir}' -nocertdb -list "$m->{modulename}" 2> /dev/null`; + my @details= split "\n\n", $moduledetail; + while ($details[0] !~ /.*Name:.*/) { + shift @details; + }; + + $m->{detail} = makehash(shift @details); + foreach $d (@details) { + my $sdh = makehash($d); + my $tokenname = $sdh->{"Token Name"}; + $tokenname =~ s/\s+$//; # remove trailing spaces + if ($tokenname) { + $m->{tokens}->{$tokenname}->{detail} = $sdh; + } + } + $i++; + + } + return $modules; +} + +# input: a multi-list string with nv/pairs +# return a hashtable reference +sub makehash { + my $str = shift; + my $ht = { }; + my @lines = split "\n", $str; + my $line; +LINE: + foreach $line (@lines) { + if ($line =~ /Using database directory/) { next LINE; } + if ($line =~ /--------------/) { next LINE; } + my ($name, $value) = ($line =~ /^\s*(.*?):\s*(.*?)\s*$/); + if ($name) { + #print "name:$name\n"; + #print "value:$value\n"; + $ht->{$name} = $value; + } + } + return $ht; +} + +sub getmodules { + my $self = shift; + #print "modules: ".$self->{modules}. "\n"; + #print "keys: ".(join ",",keys %{$self->{modules}})."\n"; + return keys %{$self->{modules}}; +} + +sub getmodule { + my $self = shift; + my $modulename = shift; + + #print Dumper($self->{modules}); + return $self->{modules}->{$modulename}; +} + + +sub gettokens { + my $self = shift; + my $module = shift; + + return keys %{$module->{tokens}}; +} + +sub gettoken { + my $self = shift; + my $token= shift; + foreach my $m (values %{$self->{modules}}) { + foreach $t (values %{$m->{tokens}}) { + #print join ",", keys %{$t}; + #print Dumper($t->{detail}); + if ($t->{detail}->{"Token Name"} eq $token) { + return $t; + } + } + } +} + + + +package main; + +sub ::test { + +# initialize + my $modutil = new PKI::TPS::Modutil("."); + +#make database if it doesn't exist + if (! $modutil->exists()) { + $modutil->create(); + } + +#get an array of module names + my @mods = $modutil->getmodules(); + + print "Found ".@mods." pkcs#11 modules\n"; + +#for each module... + foreach my $modname (@mods) { + my $module = $modutil->getmodule($modname); + + print "Module: $modname\n"; + print "Library: ".$module->{detail}->{"Library file"}."\n"; + print "Other keys: ".(join ",", keys %{$module->{detail}})."\n"; + +#find all the tokens in a module, e.g. each partition for a lunasa + foreach my $tokenname ($modutil->gettokens($module)) { + print " token: $tokenname\n"; + my $token = $modutil->gettoken($tokenname); + +#dump out the information we have on the token + foreach my $key (keys %{$token}) { + print " token keys/values: $key: ".$token->{$key}."\n"; + } + my @detailkeys = (keys %{$token->{detail}}) ; + print " token detail keys:". (join ",", @detailkeys)."\n"; + print " token detail Manufacturer:". $token->{detail}->{Manufacturer}."\n"; + print "\n"; + } + print "\n"; + } + +} + +# this is where 'main' starts + +if ($ARGV[0] eq "--test") { + ::test(); +} + +1; + +__DATA__ +Listing of PKCS #11 Modules +----------------------------------------------------------- + 1. NSS Internal PKCS #11 Module + slots: 2 slots attached + status: loaded + + slot: NSS Internal Cryptographic Services + token: NSS Generic Crypto Services + + slot: NSS User Private Key and Certificate Services + token: NSS Certificate DB + + 2. lunasa + library name: /usr/lunasa/lib/libCryptoki2.so + slots: 2 slots attached + status: loaded + + slot: LunaNet Slot + token: lunasa1-ca + + slot: LunaNet Slot + token: lunasa2-ca +----------------------------------------------------------- + + |