diff options
Diffstat (limited to 'pki/base/ra/lib/perl/PKI/RA')
32 files changed, 5974 insertions, 0 deletions
diff --git a/pki/base/ra/lib/perl/PKI/RA/AdminAuthPanel.pm b/pki/base/ra/lib/perl/PKI/RA/AdminAuthPanel.pm new file mode 100755 index 000000000..4c30859c1 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/AdminAuthPanel.pm @@ -0,0 +1,86 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +package PKI::RA::AdminAuthPanel; +$PKI::RA::AdminAuthPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(8); + $self->{"getName"} = &PKI::RA::Common::r("Admin Authentication"); + $self->{"vmfile"} = "adminauthenticatepanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("AdminAuthPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("AdminAuthPanel: update"); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("AdminAuthPanel: display"); + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/AdminPanel.pm b/pki/base/ra/lib/perl/PKI/RA/AdminPanel.pm new file mode 100755 index 000000000..5ec8852e7 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/AdminPanel.pm @@ -0,0 +1,261 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use URI::URL; +use URI::Escape; +use DBI; + +package PKI::RA::AdminPanel; +$PKI::RA::AdminPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(14); + $self->{"getName"} = &PKI::RA::Common::r("Administrator"); + $self->{"vmfile"} = "adminpanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("AdminPanel: validate"); + return 1; +} + + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("AdminPanel: update"); + + my $uid = $q->param("uid"); + my $name = $q->param("name"); + my $email = $q->param("email"); + my $password = $q->param("__pwd"); + my $password_again = $q->param("__admin_password_again"); + + my $cert_request = $q->param("cert_request"); + my $subject = $q->param("subject"); + my $profile_id = $q->param("profileId"); + my $cert_request_type = $q->param("cert_request_type"); + + $cert_request =~ s/%0D%0A//g; # remove carraige return + + # submit request to CA +# my $cainfo = $::config->get("preop.cainfo.select"); + + # Admin Certificate should be obtained from the ca selected in the + # name panel. If name panel use External CA, the admin certificate + # will be issued by the security domain CA. + my $cainfo = $::config->get("preop.ca.url"); + &PKI::RA::Wizard::debug_log("AdminPanel: preop.ca.url=$cainfo"); + if ($cainfo eq "" || $cainfo =~ /:$/) { + $cainfo = $::config->get("config.sdomainURL"); + &PKI::RA::Wizard::debug_log("AdminPanel: config.sdomainURL=$cainfo"); + } + &PKI::RA::Wizard::debug_log("AdminPanel: Connecting to CA: $cainfo"); + my $cainfo_url = new URI::URL($cainfo); + my $sdom = $::config->get("config.sdomainURL"); + my $sdom_url = new URI::URL($sdom); + + my $machineName = $::config->get("service.machineName"); + my $securePort = $::config->get("service.securePort"); + my $session_id = $::config->get("preop.sessionID"); + + my $tokenname = $::config->get("preop.module.token"); + my $token_pwd = $::pwdconf->get($tokenname); + my $nickname = $::config->get("preop.cert.sslserver.nickname"); + my $instanceID = $::config->get("service.instanceID"); + my $instanceDir = $::config->get("service.instanceDir"); + my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; + $db_password =~ s/\n$//g; + + my $requestor_name = "RA-" . $machineName . "-" . $securePort; + + my $params = "profileId=" . $profile_id . "&" . + "requestor_name=" . $requestor_name . "&" . + "cert_request_type=" . $cert_request_type . "&" . + "subject=" . $subject . "&" . + "cert_request=" . + URI::Escape::uri_escape("$cert_request") . "&" . + "xmlOutput=true" . "&" . + "sessionID=" . $session_id . "&" . + "auth_hostname=" . $sdom_url->host . "&" . + "auth_port=" . $sdom_url->port; + + my $host = $cainfo_url->host; + my $port = $cainfo_url->port; + my $content = ""; + my $tmpfile = "/tmp/admin-$$"; + if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { + system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$port > $tmpfile"); + $content = `cat $tmpfile`; + } else { + system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -n \"$nickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$port > $tmpfile"); + $content = `cat $tmpfile`; + } + system("rm $tmpfile"); + &PKI::RA::Wizard::debug_log("req = " . $content); + + $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; + $content = $1; + + # create user in internal database + &PKI::RA::Wizard::debug_log("AdminPanel: Creating user in internal database"); + # use scripts/addAgents.ldif + + my $parser = XML::Simple->new(); + my $response = $parser->XMLin($content); + my $admincert = $response->{Requests}->{Request}->{b64}; + &PKI::RA::Wizard::debug_log("AdminPanel: admincert " . $admincert); + + $host = $::config->get("preop.database.host"); + $port = $::config->get("preop.database.port"); + my $basedn = $::config->get("preop.database.basedn"); + my $binddn = $::config->get("preop.database.binddn"); +# my $bindpwd = $::config->get("tokendb.bindPass"); + my $bindpwd = `grep \"tokendbBindPass:\" \"$instanceDir/conf/password.conf\" | cut -c17-`; + $bindpwd =~ s/\n$//g; + + my $tmp = "/tmp/addAgents-$$.ldif"; + + my $flavor = `pkiflavor`; + $flavor =~ s/\n//g; + + my $mozldap_path = "/usr/lib/mozldap"; + my $arch = `pkiarch`; + $arch =~ s/\n//g; + if ($arch eq "x86_64") { + $mozldap_path = "/usr/lib64/mozldap"; + } elsif ($arch eq "sparcv9") { + $mozldap_path = "/usr/lib/sparcv9/mozldap6"; + } + +# $admincert =~ s/\//\\\//g; + + # create local database + my $dbh = DBI->connect( + "dbi:SQLite:dbname=$instanceDir/conf/dbfile","",""); + my $insert = "insert into users (" . + "uid" . "," . + "name" . "," . + "password" . "," . + "email" . "," . + "certificate" . + ") values (" . + $dbh->quote($uid) . "," . + $dbh->quote($name) . "," . + $dbh->quote($password) . "," . + $dbh->quote($email) . "," . + $dbh->quote($admincert) . + ")"; + $dbh->do($insert); + $insert = "insert into roles (" . + "uid" . "," . + "gid" . + ") values (" . + $dbh->quote($uid) . "," . + $dbh->quote("administrators") . + ")"; + $dbh->do($insert); + $insert = "insert into roles (" . + "uid" . "," . + "gid" . + ") values (" . + $dbh->quote($uid) . "," . + $dbh->quote("agents") . + ")"; + $dbh->do($insert); + $dbh->disconnect(); + + +# system("sed -e 's/\$TOKENDB_ROOT/$basedn/' " . +# "-e 's/\$TOKENDB_AGENT_CERT/$admincert/' " . +# "/usr/share/$flavor/tps/scripts/addAgents.ldif > $tmp"); +# system("$mozldap_path/ldapmodify -h '$host' -p '$port' -D '$binddn' " . +# "-w '$bindpwd' -a " . +# "-f '$tmp'"); + system("rm $tmp"); + + my $reqid = $response->{Requests}->{Request}->{Id}; + $::config->put("preop.admincert.requestId.0", $reqid); + my $sn = $response->{Requests}->{Request}->{serialno}; + $::config->put("preop.admincert.serialno.0", $sn); + + # update email address + $::config->put("request.agent.create_request.1.mailTo", $email); + $::config->put("request.scep.create_request.1.mailTo", $email); + $::config->put("request.server.create_request.1.mailTo", $email); + $::config->put("request.user.create_request.1.mailTo", $email); + + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("AdminPanel: display"); + $::symbol{admin_uid} = "admin"; + $::symbol{admin_name} = "RA Administrator"; + $::symbol{admin_email} = ""; + $::symbol{admin_pwd} = ""; + $::symbol{admin_pwd_again} = ""; + $::symbol{import} = "true"; + my $domain_name = $::config->get("preop.securitydomain.name"); + $::symbol{securityDomain} = $domain_name; + + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/AgentAuthPanel.pm b/pki/base/ra/lib/perl/PKI/RA/AgentAuthPanel.pm new file mode 100755 index 000000000..257b925ae --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/AgentAuthPanel.pm @@ -0,0 +1,86 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +package PKI::RA::AgentAuthPanel; +$PKI::RA::AgentAuthPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(7); + $self->{"getName"} = &PKI::RA::Common::r("Agent Authentication"); + $self->{"vmfile"} = "agentauthenticatepanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("AgentAuthPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("AgentAuthPanel: update"); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("AgentAuthPanel: display"); + return 1; +} + + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/AuthDBPanel.pm b/pki/base/ra/lib/perl/PKI/RA/AuthDBPanel.pm new file mode 100755 index 000000000..9442035a6 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/AuthDBPanel.pm @@ -0,0 +1,159 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +package PKI::RA::AuthDBPanel; +$PKI::RA::AuthDBPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(7); + $self->{"getName"} = &PKI::RA::Common::r("Authentication Directory"); + $self->{"vmfile"} = "authdbpanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("AuthDBPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("AuthDBPanel: update"); + + my $host = $q->param('host'); + my $port = $q->param('port'); + my $basedn = $q->param('basedn'); + + &PKI::RA::Wizard::debug_log("AuthDBPanel: host=" . $host); + &PKI::RA::Wizard::debug_log("AuthDBPanel: port=" . $port); + &PKI::RA::Wizard::debug_log("AuthDBPanel: basedn=" . $basedn); + + if (!($port =~ /^[0-9]+$/)) { + &PKI::RA::Wizard::debug_log("AuthDBPanel: bad port " . $port); + $::symbol{errorString} = "Bad Port"; + return 0; + } + + # try to do a ldapsearch + my $tmp = "/tmp/file$$"; + my $mozldap_path = "/usr/lib/mozldap"; + my $arch = `pkiarch`; + $arch =~ s/\n//g; + if ($arch eq "x86_64") { + $mozldap_path = "/usr/lib64/mozldap"; + } elsif ($arch eq "sparcv9") { + $mozldap_path = "/usr/lib/sparcv9/mozldap6"; + } + &PKI::RA::Wizard::debug_log("AuthDBPanel: invoking $mozldap_path/ldapsearch"); + my $status = system("$mozldap_path/ldapsearch -h '$host' " . + "-p '$port' -b '$basedn' -s base 'objectclass=*' > $tmp 2>&1"); + if ($status eq "0") { + &PKI::RA::Wizard::debug_log("AuthDBPanel: auth database looks ok"); + } else { + my $reason = `cat $tmp`; + &PKI::RA::Wizard::debug_log("AuthDBPanel: failed to connect " . $reason); + $::symbol{errorString} = "Failed to Connect"; + return 0; + } + system("rm $tmp"); + + # save values to CS.cfg + $::config->put("auth.instance.0.baseDN", $basedn); + $::config->put("auth.instance.0.hostport", $host . ":" . $port); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("AuthDBPanel: display"); + + my $machineName = $::config->get("service.machineName"); + my $instanceId = $::config->get("service.instanceID"); + + my $basedn = $::config->get("auth.instance.0.baseDN"); + if ($basedn =~ /\[/) { + $basedn = $machineName; + $basedn =~ s/^[^.]+\.//; + if ($basedn eq "") { + $basedn = "dc=" . $machineName; + } else { + $basedn =~ s/\./,dc=/g; + $basedn = "dc=" . $basedn; + } + } + my $host = ""; + my $port = ""; + my $hostport = $::config->get("auth.instance.0.hostport"); + if ($hostport =~ /\[/) { + $host = "localhost"; + $port = "389"; + } else { + my ($hostx, $portx) = split(/:/, $hostport); + $host = $hostx; + $port = $portx; + } + + $::symbol{hostname} = $host; + $::symbol{portStr} = $port; + $::symbol{basedn} = $basedn; + + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/BasePanel.pm b/pki/base/ra/lib/perl/PKI/RA/BasePanel.pm new file mode 100755 index 000000000..09b1d4b74 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/BasePanel.pm @@ -0,0 +1,40 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +package PKI::RA::BasePanel; +$PKI::RA::BasePanel::VERSION = '1.00'; + +sub new { + my ($class) = @_; + my $self = {}; + bless $self, $class; + return $self; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/CAInfoPanel.pm b/pki/base/ra/lib/perl/PKI/RA/CAInfoPanel.pm new file mode 100755 index 000000000..dbfc42eec --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/CAInfoPanel.pm @@ -0,0 +1,193 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use URI::URL; + +package PKI::RA::CAInfoPanel; +$PKI::RA::CAInfoPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +our $cert_header="-----BEGIN CERTIFICATE-----"; +our $cert_footer="-----END CERTIFICATE-----"; + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(4); + $self->{"getName"} = &PKI::RA::Common::r("CA Information"); + $self->{"vmfile"} = "cainfopanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("CAInfoPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("CAInfoPanel: update"); + + my $count = $q->param('urls'); + &PKI::RA::Wizard::debug_log("CAInfoPanel: update - got urls = $count"); + + &PKI::RA::Wizard::debug_log("CAInfoPanel: update - selected ca= $count"); + + my $instanceID = $::config->get("service.instanceID"); + my $host = ""; + my $port = ""; + + if ($count =~ /http/) { + my $info = new URI::URL($count); + $host = $info->host; + $port = $info->port; + } else { + $host = $::config->get("preop.securitydomain.ca$count.host"); + $port = $::config->get("preop.securitydomain.ca$count.secureport"); + } + if (($host eq "") || ($port eq "")) { + $::symbol{errorString} = "no CA found. CA, TKS and optionally DRM must be installed prior to RA installation"; + return 0; + } + + &PKI::RA::Wizard::debug_log("CAInfoPanel: update - host= $host, port= $port"); + + $::config->put("preop.cainfo.select", "https://$host:$port"); + my $serverCertNickName = $::config->get("preop.cert.sslserver.nickname"); + + my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname"); + $::config->put("conn.ca1.clientNickname", $subsystemCertNickName); + $::config->put("conn.ca1.hostport", $host . ":" . $port); + + $::config->commit(); + + # connect to the CA, and retrieve the CA certificate + &PKI::RA::Wizard::debug_log("CAInfoPanel: update connecting to CA and retrieve cert chain"); + my $instanceDir = $::config->get("service.instanceDir"); + my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; + $db_password =~ s/\n$//g; + my $tmpfile = "/tmp/ca-$$"; + system("/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$serverCertNickName\" -r \"/ca/ee/ca/getCertChain\" $host:$port > $tmpfile"); + my $cmd = `cat $tmpfile`; + system("rm $tmpfile"); + my $caCert; + if ($cmd =~ /\<ChainBase64\>(.*)\<\/ChainBase64\>/) { + $caCert = $1; + &PKI::RA::Wizard::debug_log("CAInfoPanel: ca= $caCert"); + } + if ($caCert eq "") { + &PKI::RA::Wizard::debug_log("CAInfoPanel: update no cert chain found"); + return 0; + } + open(F, ">$instanceDir/conf/caCertChain2.txt"); + print F $cert_header."\n".$caCert."\n".$cert_footer; + close(F); + + &PKI::RA::Wizard::debug_log("CAInfoPanel: update retrieve cert chain done"); + + #import cert chain + system("p7tool -d $instanceDir/alias -p $instanceDir/conf/chain2cert -a -i $instanceDir/conf/caCertChain2.txt -o $instanceDir/conf/CAchain2_pp.txt"); + my $r = $? >> 8; + my $failed = $? & 127; + if (($r > 0) && ($r < 10) && !$failed) { + my $i = 0; + while ($i ne $r) { + my $tmp = `certutil -d $instanceDir/alias -D -n "Trusted CA c2cert$i"`; + $tmp = `certutil -d $instanceDir/alias -A -f $instanceDir/conf/.pwfile -n "Trusted CA c2cert$i" -t "CT,C,C" -i $instanceDir/conf/chain2cert$i.der`; + $i++; + } + } + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("CAInfoPanel: display"); + + $::symbol{urls} = []; +# unshift(@{$::symbol{urls}}, "External CA"); + my $count = 0; + my $first = 1; + my $list = ""; + while (1) { + my $host = $::config->get("preop.securitydomain.ca$count.host"); + if ($host eq "") { + goto DONE; + } + my $port = $::config->get("preop.securitydomain.ca$count.secureport"); + my $name = $::config->get("preop.securitydomain.ca$count.subsystemname"); + my $item = $name . " - https://" . $host . ":" . $port; +# my $item = "https://" . $host . ":" . $port; +# unshift(@{$::symbol{urls}}, $item); + $::symbol{urls}[$count++] = $item; + if ($first eq 1) { + $list = $item; + $first = 0; + } else { + $list = $list.",".$item; + } + } +DONE: +# $list = $list.",External CA"; + $::config->put("preop.ca.list", $list); + + $::symbol{urls_size} = $count; + if ($count eq 0) { + $::symbol{errorString} = "no CA found. CA, TKS, and optionally DRM must be installed prior to RA installation"; + return 0; + } + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/CertInfo.pm b/pki/base/ra/lib/perl/PKI/RA/CertInfo.pm new file mode 100755 index 000000000..3f525b962 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/CertInfo.pm @@ -0,0 +1,133 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +package PKI::RA::CertInfo; +$PKI::RA::CertInfo::VERSION = '1.00'; + +sub new { + my ($class, $name, $dn, $tag) = @_; + my $self = {}; + + &PKI::RA::Wizard::debug_log("CertInfo: start new"); + $self->{"getUserFriendlyName"} = \&get_user_friendly_name; + $self->{"getCertTag"} = \&get_cert_tag; + $self->{"getDN"} = \&get_dn; + $self->{"getNickname"} = \&get_nickname; + $self->{"useDefaultKey"} = \&use_default_key; + $self->{"getCustomKeysize"} = \&get_custom_keysize; + $self->{"keyOption"} = \&get_key_option; + &PKI::RA::Wizard::debug_log("CertInfo: end new"); + + $self->{name} = $name; + $self->{dn} = $dn; + $self->{tag} = $tag; + + bless $self, $class; + return $self; +} + +sub get_user_friendly_name +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("CertInfo: get_user_friendly_name"); + return $self->{name}; +} + +sub get_cert_tag +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("CertInfo: get_cert_tag"); + return $self->{tag}; +} + +sub get_dn +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("CertInfo: get_cert_dn"); + return $self->{dn}; +} + +sub use_default_key +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("CertInfo: use_default_key"); + my $option = $::config->get("preop.cert.$self->{tag}.keysize.select"); + if (($option ne "") && ($option ne "default")) { + return 0; + } + return 1; +} + +sub get_nickname +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("CertInfo: get_nickname"); + my $nickname = $::config->get("preop.cert.$self->{tag}.nickname"); + + my $flavor = `pkiflavor`; + $flavor =~ s/\n//g; + + if ($nickname ne "") { + return $nickname; + } else { + return $self->{tag}."cert cert-$flavor-tps"; + } +} + +sub get_key_option +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("CertInfo: get_key_option"); + my $option = $::config->get("preop.cert.$self->{tag}.keysize.select"); + + if ($option ne "") { + &PKI::RA::Wizard::debug_log("CertInfo: get_key_option from config = $option"); + return $option; + } else { + &PKI::RA::Wizard::debug_log("CertInfo: get_key_option not from config"); + return "default"; + } +} + +sub get_custom_keysize +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("CertInfo: get_custom_keysize"); + my $size = $::config->get("preop.cert.$self->{tag}.keysize.customsize"); + &PKI::RA::Wizard::debug_log("CertInfo: get_custom_keysize for preop.cert.$self->{tag}.keysize.customsize is $size"); + if ($size ne "") { + &PKI::RA::Wizard::debug_log("CertInfo: get_custom_keysize from config is $size"); + return $size; + } else { + &PKI::RA::Wizard::debug_log("CertInfo: get_custom_keysize not from config"); + return 2048; + } +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/CertPrettyPrintPanel.pm b/pki/base/ra/lib/perl/PKI/RA/CertPrettyPrintPanel.pm new file mode 100755 index 000000000..c7eee3884 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/CertPrettyPrintPanel.pm @@ -0,0 +1,85 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +package PKI::RA::CertPrettyPrintPanel; +$PKI::RA::CertPrettyPrintPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(13); + $self->{"getName"} = &PKI::RA::Common::r("Certificates"); + $self->{"vmfile"} = "certprettyprintpanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("CertPrettyPrintPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("CertPrettyPrintPanel: update"); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("CertPrettyPrintPanel: display"); + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/CertRequestPanel.pm b/pki/base/ra/lib/perl/PKI/RA/CertRequestPanel.pm new file mode 100755 index 000000000..63e57c4fa --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/CertRequestPanel.pm @@ -0,0 +1,300 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use PKI::RA::ReqCertInfo; +use FileHandle; + +package PKI::RA::CertRequestPanel; +$PKI::RA::CertRequestPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +our $cert_req_header="-----BEGIN NEW CERTIFICATE REQUEST-----"; +our $cert_req_footer="-----END NEW CERTIFICATE REQUEST-----"; +our $cert_header="-----BEGIN CERTIFICATE-----"; +our $cert_footer="-----END CERTIFICATE-----"; + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(13); + $self->{"getName"} = &PKI::RA::Common::r("Certificate Requests"); + $self->{"vmfile"} = "certrequestpanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("CertRequestPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("CertRequestPanel: update"); + + my $i = 0; + + my $instanceDir = $::config->get("service.instanceDir"); + + my $useExternalCA = $::config->get("preop.certenroll.useExternalCA"); + if ($useExternalCA eq "on") { + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: useExternalCA is on"); + } else { + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: useExternalCA is off"); + &PKI::RA::Wizard::debug_log("CertRequestPanel: update auto enrollment should have been done, no more action needed"); + return 1; + } + + &PKI::RA::Wizard::debug_log("CertRequestPanel: update External CA selected, retrieve/process user input"); + + my $tokenname = $::config->get("preop.module.token"); + &PKI::RA::Wizard::debug_log("CertRequestPanel: update got token name = $tokenname"); + my $token_pwd = $::pwdconf->get($tokenname); + $token_pwd =~ s/\n//g; + open FILE, ">$instanceDir/conf/.pwfile"; + print FILE $token_pwd; + close FILE; + + my $hw; + my $tk; + + if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { + $hw = ""; + $tk = ""; + } else { + $hw = "-h $tokenname"; + $tk = $tokenname.":"; + } + + foreach my $certtag (@PKI::RA::Wizard::certtags) { + if ($certtag eq "subsystem") { + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: subsystem cert is pre-generated by the security domain"); + return 1; + } + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: for certag= $certtag"); + my $ccert = $::config->get("preop.cert.$certtag.cert"); + if ($ccert ne "") { + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: cert already exists in CS.cfg, go to next"); + next; + } + my $certchain = $q->param($certtag.'_cc'); + if ($certchain ne "") { + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: $certtag certchain is $certchain"); + my $cc_fn = "$instanceDir/conf/caCertChain.txt"; + my $tmp = `echo "$certchain" > $cc_fn`; + # remove existing one + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: try to delete existing certchain, if any....ok if it fails"); +# XXX remove should not be done lightly... + $tmp = `p7tool -d $instanceDir/alias -p $instanceDir/conf/chain1cert -a -i $cc_fn -o $instanceDir/conf/CAchain_pp.txt`; + my $r = $? >> 8; + my $failed = $? & 127; + if (($r > 0) && ($r < 10) && !$failed) { + my $i = 0; + while ($i ne $r) { + $tmp = `certutil -d $instanceDir/alias -D -n "Trusted CA $certtag cert$i"`; + $tmp = `certutil -d $instanceDir/alias -A -f $instanceDir/conf/.pwfile -n "Trusted CA $certtag cert$i" -t "CT,C,C" -i $instanceDir/conf/chain1cert$i.der`; +# $tmp = `rm $cc_fn`; + $i++ + } + } + } else { + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: no certchain included for certtag $certtag"); + } + + my $cert = $q->param($certtag); + if ($cert ne "") { + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: $certtag cert is $cert"); + my $nickname = $::config->get("preop.cert.$certtag.nickname"); + if ($nickname eq "") { + $nickname = "RA ".$certtag." cert"; + $::config->put("preop.cert.$certtag.nickname", $nickname); + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: $certtag cert nickname not found in CS.cfg, generating one= $nickname"); + } + #remove existing one + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: try to delete existing cert $nickname, if any....ok if it fails"); +#XXX remove should not be done lightly... + my $tmp = `certutil -d $instanceDir/alias -D -n "$nickname"`; + $tmp = `certutil -d $instanceDir/alias -D $hw -f $instanceDir/conf/.pwfile -n "$tk$nickname"`; + #now import the cert + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: try to import cert"); + my $cert_fn = "$instanceDir/conf/$certtag"."_cert.txt"; + $tmp = `echo "$cert" > $cert_fn`; + +# $cert = extract_cert_from_file_sans_header_and_footer($cert_fn); + my $certa =""; + my $save_line = 0; + my @cert_a = split "\n", $cert; + foreach my $line (@cert_a) { + chomp( $line ); + $line =~ s/\r//g; + if ($line eq $cert_header) { + $save_line = 1; + } elsif( $line eq $cert_footer ) { + $save_line = 0; + last; + } elsif( $save_line == 1 ) { + $certa .= "$line"; + } + } + + &PKI::RA::Wizard::debug_log("CertRequestPanel: update putting cert in CS.cfg: $certa"); + + $::config->put("preop.cert.$certtag.cert", $certa); + + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: about to certutil -d $instanceDir/alias $hw -A -f $instanceDir/conf/.pwfile -n $nickname -t u,u,u -a -i $cert_fn"); + $tmp = `certutil -d $instanceDir/alias $hw -A -f $instanceDir/conf/.pwfile -n "$nickname" -t "u,u,u" -a -i $cert_fn`; + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: done certutil: $tmp"); + $tmp = `rm $cert_fn`; + + # changed the cert, need to change nickname too, if necessary + if ($hw ne "") { + $::config->put("preop.cert.$certtag.nickname", "$tk$nickname"); + if ($certtag eq "subsystem") { + $::config->put("conn.ca1.clientNickname","$tk$nickname"); + $::config->put("conn.drm1.clientNickname","$tk$nickname"); + $::config->put("conn.tks1.clientNickname","$tk$nickname"); + } + } + + } else { + &PKI::RA::Wizard::debug_log("CertRequestPanel: update: no cert"); + } + } + +DONE: + $::config->commit(); + my $tmp = `rm $instanceDir/conf/.pwfile`; + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("CertRequestPanel: display"); + + my $domain_name = $::config->get("preop.securitydomain.name"); + if ($domain_name eq "") { + $domain_name = "RA Domain"; + } + my $machine_name = $::config->get("service.machineName"); + my $instance_id = $::config->get("service.instanceID"); + + my $i = 0; + foreach my $certtag (@PKI::RA::Wizard::certtags) { + my $cert_dn = $::config->get("preop.cert.".$certtag.".dn"); + if ($cert_dn eq "") { + if ($certtag eq "subsystem") { + $cert_dn = "CN=RA Subsystem, " . + "OU=" . $instance_id . ", " . + "O=" . $domain_name; + } elsif ($certtag eq "sslserver") { + $cert_dn ="CN=" . $machine_name . ", " . + "OU=" . $instance_id . ", " . + "O=" . $domain_name; + } else { + $cert_dn = $certtag; + } + } + + my $name = $::config->get("preop.cert.".$certtag.".userfriendlyname"); + if ($name eq "") { + $name = $certtag."Cert ".$instance_id; + } + + my $reqcert = new PKI::RA::ReqCertInfo($name, + $cert_dn, $certtag); + $::symbol{reqscerts}[$i++] = $reqcert; + } + + $::symbol{errorString} = ""; + $::symbol{showApplyButton} = "true"; + + return 1; +} + +# arg0 message containing certificate +# return certificate sans header and footer +# -- all in a one-liner +sub extract_cert_from_file_sans_header_and_footer +{ + my $filename = $_[0]; + my $save_line = 0; + + my $fd = new FileHandle; + + my $cert = ""; + + $fd->open( "<$filename" ) or die "Could not open '$filename'!\n"; + + while( <$fd> ) + { + my $line = $_; + chomp( $line ); + $line =~ s/^M//g; + + if( $line eq $cert_header ) { + $save_line = 1; + } elsif( $line eq $cert_footer ) { + $save_line = 0; + last; + } elsif( $save_line == 1 ) { + $cert .= "$line"; + } + } + + $fd->close(); + + return $cert; +} + + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/Common.pm b/pki/base/ra/lib/perl/PKI/RA/Common.pm new file mode 100755 index 000000000..40b0bd6b2 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/Common.pm @@ -0,0 +1,50 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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::RA::Common; + +use strict; +use warnings; +use Exporter; + +use vars qw(@ISA @EXPORT @EXPORT_OK); +@ISA = qw(Exporter Autoloader); +@EXPORT = qw(r yes no); + +$PKI::RA::Common::VERSION = '1.00'; + +sub yes { + return sub {1}; +} + +sub no { + return sub {0}; +} + +sub r { + my $a = shift; + return sub { $a; } +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/Config.pm b/pki/base/ra/lib/perl/PKI/RA/Config.pm new file mode 100755 index 000000000..317b9d91a --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/Config.pm @@ -0,0 +1,162 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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::RA::Config; + +use strict; +use warnings; +use Exporter; + +$PKI::RA::Config::VERSION = '1.00'; + +####################################################### +# Configuration Store +####################################################### +sub new { + my $class = shift; + my $self = {}; + my %hash = (); + $self->{filename} = ""; + $self->{hash} = \%hash; + bless $self,$class; + return $self; +} + +sub load_file +{ + my ($self, $filename) = @_; + + $self->{filename} = $filename; + if (-e $filename) { + open(CF, "<$filename"); + if (defined fileno CF) { + while (<CF>) { + if (/^#/) { + # comments + } elsif (/([^=]+)=(.*)$/) { + # print "$1 = $2\n"; + $self->{hash}{$1} = $2; + } else { + # preserve comments + } + } + } + close(CF); + } +} + +sub get_filename +{ + my ($self) = @_; + return $self->{filename}; +} + +sub get +{ + my ($self, $n) = @_; + return $self->{hash}{$n}; +} + +sub put +{ + my ($self, $n, $v) = @_; + $self->{hash}{$n} = $v; +} + +sub deleteSubstore +{ + my ($self, $n) = @_; + foreach my $xkey (keys %{$self->{hash}}) { + if ($xkey =~ /^\Q$n\E/) { + delete $self->{hash}{$xkey}; + } + } +} + +sub commit +{ + my ($self) = @_; + + # write stuff back to the file +# print $self->{filename} . "\n"; + my $hash = $self->{hash}; + my $suffix = time(); + + if (-e $self->{filename}) { + system("mv \"" . $self->{filename} . "\" \"" . + $self->{filename} . "." . $suffix . "\""); + } + + open(F, ">" . $self->{filename}); + foreach my $k (sort keys %{$hash}) { + print F "$k=$self->{hash}{$k}\n"; + } + close(F); + + if (-e $self->{filename} . "." . $suffix) { + system("rm \"" . $self->{filename} . "." . $suffix . "\""); + } +} + +sub commit_with_backup +{ + my ($self) = @_; + + # write stuff back to the file +# print $self->{filename} . "\n"; + my $hash = $self->{hash}; + my $suffix = time(); + system("mv \"" . $self->{filename} . "\" \"" . + $self->{filename} . "." . $suffix . "\""); + + open(F, ">" . $self->{filename}); + foreach my $k (sort keys %{$hash}) { + print F "$k=$self->{hash}{$k}\n"; + } + close(F); +} + +1; + +####################################################### +# Test Program +####################################################### +#my $config = PKI::RA::Config->new(); +#$config->load_file("/tmp/CS.cfg"); +#print $config->get("tokendb.indexAdminTemplate") . "\n"; +#$config->put("tokendb.indexAdminTemplate", "Testing"); +#print $config->get("tokendb.indexAdminTemplate") . "\n"; +#$config->commit(); + +1; + +####################################################### +# Test Program +####################################################### +#my $config = PKI::RA::Config->new(); +#$config->load_file("/tmp/CS.cfg"); +#print $config->get("tokendb.indexAdminTemplate") . "\n"; +#$config->put("tokendb.indexAdminTemplate", "Testing"); +#print $config->get("tokendb.indexAdminTemplate") . "\n"; +#$config->commit(); diff --git a/pki/base/ra/lib/perl/PKI/RA/ConfigHSMLoginPanel.pm b/pki/base/ra/lib/perl/PKI/RA/ConfigHSMLoginPanel.pm new file mode 100755 index 000000000..87e85dc5c --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/ConfigHSMLoginPanel.pm @@ -0,0 +1,104 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +package PKI::RA::ConfigHSMLoginPanel; +$PKI::RA::ConfigHSMLoginPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(9); + $self->{"getName"} = &PKI::RA::Common::r("Security Modules Login"); + $self->{"vmfile"} = "config_hsmloginpanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 1; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel: update"); + my $uTokName = $q->param('uTokName'); + my $uPasswd = $q->param('__uPasswd'); + +# &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel: update tokname= $uTokName pwd =$uPasswd"); + + $::pwdconf->put($uTokName, $uPasswd); + $::pwdconf->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + use Data::Dumper; + $Data::Dumper::Indent = 1; +# &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel -> dump of q= ". Dumper($q)); + $::symbol{SecToken} = $q->param('SecToken'); +# &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel -> display has ".$q->param('SecToken')); + + &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel -> display retrieving $q->param('SecToken') "); + my $pwd = $::pwdconf->get( $q->param('SecToken')); + if ($pwd ne "") { + &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel -> display retrieved pwd from pwdconf"); + } + + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/ConfigHSMPanel.pm b/pki/base/ra/lib/perl/PKI/RA/ConfigHSMPanel.pm new file mode 100755 index 000000000..ed39cec0f --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/ConfigHSMPanel.pm @@ -0,0 +1,72 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +package PKI::RA::ConfigHSMPanel; +$PKI::RA::ConfigHSMPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&PKI::RA::Common::no; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(12); + $self->{"getName"} = &PKI::RA::Common::r("ConfigHSMLogin"); + $self->{"vmfile"} = "config_hsm.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("ConfigHSMPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("ConfigHSMPanel: update"); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("ConfigHSMPanel: display"); + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/DRMInfoPanel.pm b/pki/base/ra/lib/perl/PKI/RA/DRMInfoPanel.pm new file mode 100755 index 000000000..707a45dc1 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/DRMInfoPanel.pm @@ -0,0 +1,140 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use URI::URL; + +package PKI::RA::DRMInfoPanel; +$PKI::RA::DRMInfoPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(6); + $self->{"getName"} = &PKI::RA::Common::r("DRM Information"); + $self->{"vmfile"} = "drminfopanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DRMInfoPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DRMInfoPanel: update"); + + my $choice = $q->param('choice'); + $::config->put("preop.krainfo.keygen", $choice); + + if ($choice eq "keygen") { + my $count = $q->param('urls'); + my $instanceID = $::config->get("service.instanceID"); + my $host = ""; + my $port = ""; + if ($count =~ /http/) { + my $info = new URI::URL($count); + $host = $info->host; + $port = $info->port; + } else { + $host = $::config->get("preop.securitydomain.kra$count.host"); + $port = $::config->get("preop.securitydomain.kra$count.secureport"); + } + if (($host eq "") || ($port eq "")) { + $::symbol{errorString} = "no DRM found. CA, TKS and DRM must be installed prior to RA installation"; + return 0; + } + + $::config->put("preop.krainfo.select", "https://$host:$port"); + my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname"); + $::config->put("conn.drm1.clientNickname", $subsystemCertNickName); + $::config->put("conn.drm1.hostport", $host . ":" . $port); + $::config->put("conn.tks1.serverKeygen", "true"); + $::config->put("op.enroll.userKey.keyGen.encryption.serverKeygen.enable", "true"); + $::config->put("op.enroll.userKeyTemporary.keyGen.encryption.serverKeygen.enable", "true"); + } else { + # no keygen + $::config->put("conn.tks1.serverKeygen", "false"); + $::config->put("op.enroll.userKey.keyGen.encryption.serverKeygen.enable", "false"); + $::config->put("op.enroll.userKeyTemporary.keyGen.encryption.serverKeygen.enable", "false"); + $::config->put("conn.drm1.clientNickname", ""); + $::config->put("conn.drm1.hostport", ""); + } + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DRMInfoPanel: display"); + + $::symbol{urls} = []; + my $count = 0; + while (1) { + my $host = $::config->get("preop.securitydomain.kra$count.host"); + if ($host eq "") { + goto DONE; + } + my $port = $::config->get("preop.securitydomain.kra$count.secureport"); + my $name = $::config->get("preop.securitydomain.kra$count.subsystemname"); + $::symbol{urls}[$count++] = $name . " - https://" . $host . ":" . $port; + } +DONE: + $::symbol{urls_size} = $count; + + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/DatabasePanel.pm b/pki/base/ra/lib/perl/PKI/RA/DatabasePanel.pm new file mode 100755 index 000000000..fe37de723 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/DatabasePanel.pm @@ -0,0 +1,109 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +use DBI; +package PKI::RA::DatabasePanel; +$PKI::RA::DatabasePanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(8); + $self->{"getName"} = &PKI::RA::Common::r("Internal Database"); + $self->{"vmfile"} = "databasepanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DatabasePanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DatabasePanel: update"); + my $instDir = $::config->get("service.instanceDir"); + + # create local database + my $dbh = DBI->connect( + "dbi:SQLite:dbname=$instDir/conf/dbfile","",""); + + # create database lockfile + system("touch $instDir/conf/dblock"); + + open(F, "/usr/share/pki/ra/scripts/schema.sql"); + while (<F>) { + if (!($_ =~ /^#/)) { + $dbh->do($_); + } + } + close(F); + + $dbh->disconnect(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DatabasePanel: display"); + + my $machineName = $::config->get("service.machineName"); + my $instanceId = $::config->get("service.instanceID"); + + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/DisplayCertChain2Panel.pm b/pki/base/ra/lib/perl/PKI/RA/DisplayCertChain2Panel.pm new file mode 100755 index 000000000..5d209e065 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/DisplayCertChain2Panel.pm @@ -0,0 +1,179 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use FileHandle; + +package PKI::RA::DisplayCertChain2Panel; +$PKI::RA::DisplayCertChain2Panel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +our $cert_header="-----BEGIN CERTIFICATE-----"; +our $cert_footer="-----END CERTIFICATE-----"; + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(7); + $self->{"getName"} = &PKI::RA::Common::r("Display Certificate Chain"); + $self->{"vmfile"} = "displaycertchain2panel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub readFile +{ + my $fn = $_[0]; + open FILE, "< $fn" or return ""; + my $content = join "",<FILE>; + close FILE; + + return $content; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: update"); + + my $instanceDir = $::config->get("service.instanceDir"); + +# my $caCert = readFile("$instanceDir/conf/caCertChain2.txt"); + my $caCert = extract_cert_from_file_sans_header_and_footer("$instanceDir/conf/caCertChain2.txt"); + + #store in config + $::config->put("preop.ca.certchain", $caCert); + $::config->commit(); + # import it into the security database + my $tmp = `p7tool -d $instanceDir/alias -p $instanceDir/conf/chain2cert -a -i $instanceDir/conf/caCertChain2.txt -o $instanceDir/conf/CAchain2_pp.txt`; + my $r = $? >> 8; + my $failed = $? & 127; + if (($r > 0) && ($r < 10) && !$failed) { + my $i = 0; + while ($i ne $r) { + $tmp = `certutil -d $instanceDir/alias -D -n "Trusted CA c2cert$i"`; + $tmp = `certutil -d $instanceDir/alias -A -f $instanceDir/conf/.pwfile -n "Trusted CA c2cert$i" -t "CT,C,C" -i $instanceDir/conf/chain2cert$i.der`; + $i++ + } + } + + # clean up +# my $tmp = `rm $instanceDir/conf/caCertChain2.txt`; +# $tmp = `rm $instanceDir/conf/CAchain2_pp.txt`; + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: display"); + my $instanceDir = $::config->get("service.instanceDir"); + + my $found = -e "$instanceDir/conf/caCertChain2.txt"; + my $certpp = ""; + if ($found) { + &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: display found caCertChain2.txt"); + my $tmp = `p7tool -d $instanceDir/alias -p $instanceDir/conf/chain2cert -a -i $instanceDir/conf/caCertChain2.txt -o $instanceDir/conf/CAchain2_pp.txt`; + + $certpp = readFile("$instanceDir/conf/CAchain2_pp.txt"); + &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: display read CAchain2_pp.txt"); + $certpp =~ s/"//g; + &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: certpp2= $certpp"); + } + +# $symbol{certchain} = [ "cert1", "cert2" ]; +# $symbol{certchain_size} = 2; + $::symbol{certchain} = "$certpp"; + $::symbol{certchain_size} = 1; + + &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: display done"); + return 1; +} + +# return certificate sans header and footer +# -- all in a one-liner +sub extract_cert_from_file_sans_header_and_footer +{ + my $filename = $_[0]; + my $save_line = 0; + + my $fd = new FileHandle; + + my $cert = ""; + + $fd->open( "<$filename" ) or die "Could not open '$filename'!\n"; + + while( <$fd> ) + { + my $line = $_; + chomp( $line ); + $line =~ s/^M//g; + + if( $line eq $cert_header ) { + $save_line = 1; + } elsif( $line eq $cert_footer ) { + $save_line = 0; + last; + } elsif( $save_line == 1 ) { + $cert .= "$line"; + } + } + + $fd->close(); + + return $cert; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/DisplayCertChainPanel.pm b/pki/base/ra/lib/perl/PKI/RA/DisplayCertChainPanel.pm new file mode 100755 index 000000000..7748cf457 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/DisplayCertChainPanel.pm @@ -0,0 +1,290 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use URI::URL; +use MIME::Base64; + +package PKI::RA::DisplayCertChainPanel; +$PKI::RA::DisplayCertChainPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(2); + $self->{"getName"} = &PKI::RA::Common::r("Display Certificate Chain"); + $self->{"vmfile"} = "displaycertchainpanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 1; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: validate"); + return 1; +} + +sub readFile +{ + my $fn = $_[0]; + open FILE, "< $fn" or return ""; + my $content = join "",<FILE>; + close FILE; + + return $content; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: update"); + + my $instanceDir = $::config->get("service.instanceDir"); + + my $caCert = readFile("$instanceDir/conf/caCert.txt"); + + #store in config + $::config->put("preop.ca.certchain", $caCert); + $::config->commit(); + + # import it into the security database +# my $cmd1 = `/usr/bin/AtoB $instanceDir/conf/caCert.txt $instanceDir/conf/caCert.der`; + my $cmd2 = `/usr/bin/certutil -A -d \"$instanceDir/alias\" -t \"CT,CT,CT\" -n \"caCert\" -i $instanceDir/conf/caCert.der`; + + # clean up + my $tmp = `rm $instanceDir/conf/caCert.txt`; + $tmp = `rm $instanceDir/conf/caCert.der`; + $tmp = `rm $instanceDir/conf/caCert_pp.txt`; + + # complete the SeucrityDomain task + my $sdomainURL = $::config->get("config.sdomainURL"); + if ($sdomainURL eq "") { + return 2; + } + + my $machineName = $::config->get("service.machineName"); + my $securePort = $::config->get("service.securePort"); + my $unsecurePort = $::config->get("service.unsecurePort"); + + # check if url is accessible + # redirect to the security domain authentication + if ($ENV{'SERVER_PORT'} eq $unsecurePort) { + $::symbol{redirect} = $sdomainURL . "/ca/ee/ca/securityDomainLogin?url=http%3A%2F%2F" . $machineName . "%3A" . $unsecurePort . "%2Fra%2Fadmin%2Fconsole%2Fconfig%2Fwizard%3Fp%3D3%26subsystem%3DRA"; + } else { + $::symbol{redirect} = $sdomainURL . "/ca/ee/ca/securityDomainLogin?url=https%3A%2F%2F" . $machineName . "%3A" . $securePort . "%2Fra%2Fadmin%2Fconsole%2Fconfig%2Fwizard%3Fp%3D3%26subsystem%3DRA"; + } + + get_domain_xml($sdomainURL); + + + return 3; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: display"); + + # connect to the CA, and retrieve the CA certificate + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: update connecting to CA and retrieve cert chain"); + my $instanceID = $::config->get("service.instanceID"); + my $instanceDir = $::config->get("service.instanceDir"); + my $sdomainURL = $::config->get("config.sdomainURL"); + if ($sdomainURL eq "") { + return 2; + } + + my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; + $db_password =~ s/\n$//g; + + my $url_info = new URI::URL($sdomainURL); + my $host = $url_info->host; + my $port = $url_info->port; + my $nickname = $::config->get("preop.cert.sslserver.nickname"); + my $cmd = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"/ca/ee/ca/getCertChain\" $host:$port`; + + my $caCert; + if ($cmd =~ /\<ChainBase64\>(.*)\<\/ChainBase64\>/) { + $caCert = $1; + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: ca= $caCert"); + } + + my $certpp; + if ($caCert ne "") { + open(F, ">$instanceDir/conf/caCert.txt"); + print F $caCert; + close(F); + + # test to see if tmp directory exists, if not, create + my $found = -e "$instanceDir/conf/tmp"; + if (! $found) { + my $tmp = `mkdir $instanceDir/conf/tmp`; + } + + # import it into a temporary security database +# my $cmd1 = `/usr/bin/AtoB $instanceDir/conf/caCert.txt $instanceDir/conf/caCert.der`; + # my $cmd1 = `/usr/bin/openssl base64 -d -A -in $instanceDir/conf/caCert.txt -out $instanceDir/conf/caCert.der`; + + my $txt = `cat $instanceDir/conf/caCert.txt`; + open(OUT, ">$instanceDir/conf/caCert.der"); + print OUT MIME::Base64::decode($txt); + close(OUT); + + my $cmd2 = `/usr/bin/certutil -A -d \"$instanceDir/conf/tmp\" -t \"CT,CT,CT\" -n \"caCert\" -i $instanceDir/conf/caCert.der`; + + # get pretty print from temp db + my $tmp = `certutil -d $instanceDir/conf/tmp -n "caCert" -L > $instanceDir/conf/caCert_pp.txt`; + $certpp = readFile("$instanceDir/conf/caCert_pp.txt"); + $certpp =~ s/"//g; + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: certpp= $certpp"); + # clean up temp db + $tmp = `certutil -d $instanceDir/alias/tmp -D -n "caCert"`; + } else { + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: update no certchain found"); + } + + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: display certchain=$caCert"); + +# $symbol{certchain} = [ "cert1", "cert2" ]; +# $symbol{certchain_size} = 2; + $::symbol{certchain} = "$certpp"; +# This certchain_size does not matter + $::symbol{certchain_size} = 1; + + return 1; +} +sub get_domain_xml +{ + my ($sdomainURL) = @_; + + my $sdom_info = new URI::URL($sdomainURL); + # get the domain xml + # e. g. - https://water.sfbay.redhat.com:9443/ca/ee/ca/getDomainXML + + my $nickname = $::config->get("preop.cert.sslserver.nickname"); + my $instanceID = $::config->get("service.instanceID"); + my $instanceDir = $::config->get("service.instanceDir"); + my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; + $db_password =~ s/\n$//g; + + my $host = $sdom_info->host; + my $port = $sdom_info->port; + my $content = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"/ca/ee/ca/getDomainXML\" $host:$port`; + + $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; + $content = $1; + + &PKI::RA::Wizard::debug_log("content = " . $content); + + my $parser = XML::Simple->new(); + my $response = $parser->XMLin($content); + my $xml = $parser->XMLin($response->{'DomainInfo'}, + ForceArray => 1); + + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: security domain '" . + $xml->{'Name'}[0] . "'"); + $::config->put("preop.securitydomain.name", $xml->{'Name'}[0]); + + # parse xml and store information in CS.cfg + my $count = 0; + $count = 0; + foreach my $c (@{$xml->{'CAList'}[0]->{'CA'}}) { + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: Found CA '" . + $c->{'SubsystemName'}[0] . "'"); + $::config->put("preop.securitydomain.ca" . $count . ".subsystemname", + $c->{'SubsystemName'}[0]); + $::config->put("preop.securitydomain.ca" . $count . ".secureport", + $c->{'SecurePort'}[0]); + $::config->put("preop.securitydomain.ca" . $count . ".host", + $c->{'Host'}[0]); + $count++; + } + + $count = 0; + foreach my $c (@{$xml->{'TKSList'}[0]->{'TKS'}}) { + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: Found TKS '" . + $c->{'SubsystemName'}[0] . "'"); + $::config->put("preop.securitydomain.tks" . $count . ".subsystemname", + $c->{'SubsystemName'}[0]); + $::config->put("preop.securitydomain.tks" . $count . ".secureport", + $c->{'SecurePort'}[0]); + $::config->put("preop.securitydomain.tks" . $count . ".host", + $c->{'Host'}[0]); + $count++; + } + + $count = 0; + foreach my $c (@{$xml->{'KRAList'}[0]->{'KRA'}}) { + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: Found KRA '" . + $c->{'SubsystemName'}[0] . "'"); + $::config->put("preop.securitydomain.kra" . $count . ".subsystemname", + $c->{'SubsystemName'}[0]); + $::config->put("preop.securitydomain.kra" . $count . ".secureport", + $c->{'SecurePort'}[0]); + $::config->put("preop.securitydomain.kra" . $count . ".host", + $c->{'Host'}[0]); + $count++; + } + + $count = 0; + foreach my $c (@{$xml->{'RAList'}[0]->{'RA'}}) { + &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: Found RA '" . + $c->{'SubsystemName'}[0] . "'"); + $::config->put("preop.securitydomain.ra" . $count . ".subsystemname", + $c->{'SubsystemName'}[0]); + $::config->put("preop.securitydomain.ra" . $count . ".secureport", + $c->{'SecurePort'}[0]); + $::config->put("preop.securitydomain.ra" . $count . ".host", + $c->{'Host'}[0]); + $count++; + } + $::config->commit(); +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/DonePanel.pm b/pki/base/ra/lib/perl/PKI/RA/DonePanel.pm new file mode 100755 index 000000000..3e8b02f1a --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/DonePanel.pm @@ -0,0 +1,339 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use URI::URL; +use XML::Simple; + +package PKI::RA::DonePanel; +$PKI::RA::DonePanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(16); + $self->{"getName"} = &PKI::RA::Common::r("Done"); + $self->{"vmfile"} = "donepanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DonePanel: validate"); + return 1; +} +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("DonePanel: update"); + return 1; +} + +sub register_ra +{ + my ($sdom, $url, $uri, $xname) = @_; + + &PKI::RA::Wizard::debug_log("DonePanel: register_ra at $url"); + &PKI::RA::Wizard::debug_log("DonePanel: subsystem $xname uri=$uri"); + + my $url_info = new URI::URL($url); + my $sdom_info = new URI::URL($sdom); + + # register RA to Security Domain + # submit request to CA + &PKI::RA::Wizard::debug_log("DonePanel: Connecting to Security Domain"); + + my $machineName = $::config->get("service.machineName"); + my $securePort = $::config->get("service.securePort"); + my $session_id = $::config->get("preop.sessionID"); + + &PKI::RA::Wizard::debug_log("DonePanel: Security Domain Info " . $url); + + my $uid = "RA-" . $machineName . "-" . $securePort; + my $name = "Registration Authority Subsystem"; + + my $instDir = $::config->get("service.instanceDir"); + my $nickname = $::config->get("preop.cert.sslserver.nickname"); + + my $hw; + my $tk; + my $tokenname = $::config->get("preop.module.token"); + &PKI::RA::Wizard::debug_log("ReqCertInfo: update got token name = $tokenname"); + + if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { + $hw = ""; + $tk = ""; + } else { + $hw = "-h $tokenname"; + $tk = $tokenname.":"; + } + + my $token_pwd = $::pwdconf->get($tokenname); + open FILE, ">$instDir/conf/.pwfile"; + $token_pwd =~ s/\n//g; + print FILE $token_pwd; + close FILE; + + my $subsystemNickname = $::config->get("preop.cert.subsystem.nickname"); + my $certificate = `/usr/bin/certutil -d "$instDir/alias" -L $hw -f "$instDir/conf/.pwfile" -n "$subsystemNickname" -a`; + $certificate =~ s/-----BEGIN CERTIFICATE-----//g; + $certificate =~ s/-----END CERTIFICATE-----//g; + $certificate =~ s/\n$//g; + + + &PKI::RA::Wizard::debug_log("DonePanel: Connecting"); + + my $instanceID = $::config->get("service.instanceID"); + my $instanceDir = $::config->get("service.instanceDir"); + my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; + $db_password =~ s/\n$//g; + + my $params = "uid=" . $uid . "&" . + "name=" . $name . "&" . + "certificate=" . + URI::Escape::uri_escape("$certificate") . "&" . + "xmlOutput=true" . "&" . + "sessionID=" . $session_id . "&" . + "auth_hostname=" . $sdom_info->host . "&" . + "auth_port=" . $sdom_info->port; + + my $host = $url_info->host; + my $port = $url_info->port; + my $tmpfile = "/tmp/donepanel-$$"; + if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { + system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"$uri\" $host:$port > $tmpfile"); + } else { + system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -n \"$nickname\" -r \"$uri\" $host:$port > $tmpfile"); + } + my $content = `cat $tmpfile`; + system("rm $tmpfile"); + + &PKI::RA::Wizard::debug_log("req = " . $content); + $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; + $content = $1; + + &PKI::RA::Wizard::debug_log("DonePanel: result " . $content); + my $tmp = `rm $instDir/conf/.pwfile`; +} + +sub get_kra_transport_cert +{ + my ($sdom) = @_; + + my $sdom_info = new URI::URL($sdom); + + # register RA to Security Domain + # submit request to CA + &PKI::RA::Wizard::debug_log("DonePanel: Connecting to KRA"); + + my $krainfo = $::config->get("preop.krainfo.select"); + my $krainfo_url = new URI::URL($krainfo); + + my $machineName = $::config->get("service.machineName"); + my $securePort = $::config->get("service.securePort"); + my $session_id = $::config->get("preop.sessionID"); + + my $nickname = $::config->get("preop.cert.sslserver.nickname"); + my $tokenname = $::config->get("preop.module.token"); + my $token_pwd = $::pwdconf->get($tokenname); + my $instanceID = $::config->get("service.instanceID"); + my $instanceDir = $::config->get("service.instanceDir"); + my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; + $db_password =~ s/\n$//g; + + my $params = "sessionID=" . $session_id . "&" . + "auth_hostname=" . $sdom_info->host . "&" . + "auth_port=" . $sdom_info->port; + + my $host = $krainfo_url->host; + my $port = $krainfo_url->port; + my $tmpfile = "/tmp/donepanel-$$"; + if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { + system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"/kra/admin/kra/getTransportCert\" $host:$port > $tmpfile"); + } else { + system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -n \"$nickname\" -r \"/kra/admin/kra/getTransportCert\" $host:$port > $tmpfile"); + } + my $content = `cat $tmpfile`; + system("rm $tmpfile"); + + $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; + $content = $1; + + my $parser = XML::Simple->new(); + my $response = $parser->XMLin($content); + my $transportCert = $response->{TransportCert}; + + &PKI::RA::Wizard::debug_log("DonePanel: TransportCert " . $transportCert); + + return $transportCert; +} + +sub send_kra_transport_cert +{ + my ($sdom, $certificate) = @_; + + my $sdom_info = new URI::URL($sdom); + + # register RA to Security Domain + # submit request to CA + &PKI::RA::Wizard::debug_log("DonePanel: Connecting to TKS"); + my $tksinfo = $::config->get("preop.tksinfo.select"); + my $tksinfo_url = new URI::URL($tksinfo); + + my $machineName = $::config->get("service.machineName"); + my $securePort = $::config->get("service.securePort"); + my $session_id = $::config->get("preop.sessionID"); + + my $nickname = $::config->get("preop.cert.sslserver.nickname"); + my $tokenname = $::config->get("preop.module.token"); + my $token_pwd = $::pwdconf->get($tokenname); + my $instanceID = $::config->get("service.instanceID"); + my $instanceDir = $::config->get("service.instanceDir"); + my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; + $db_password =~ s/\n$//g; + + my $name = "transportCert-" . $machineName . "-" . $securePort; + my $params = "name=" . $name . "&" . + "certificate=" . + URI::Escape::uri_escape("$certificate") . "&" . + "xmlOutput=true" . "&" . + "sessionID=" . $session_id . "&" . + "auth_hostname=" . $sdom_info->host . "&" . + "auth_port=" . $sdom_info->port; + + my $host = $tksinfo_url->host; + my $port = $tksinfo_url->port; + my $tmpfile = "/tmp/donepanel-$$"; + if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { + system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"/tks/admin/tks/importTransportCert\" $host:$port > $tmpfile"); + } else { + system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -n \"$nickname\" -r \"/tks/admin/tks/importTransportCert\" $host:$port > $tmpfile"); + } + + my $content = `cat $tmpfile`; + system("rm $tmpfile"); + + $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; + $content = $1; + + &PKI::RA::Wizard::debug_log("DonePanel: Response from TKS " . $content); +} + +sub display +{ + my ($q) = @_; + # $symbol{systemType} = "ra"; + # $symbol{host} = "chico"; + # $symbol{port} = "443"; + &PKI::RA::Wizard::debug_log("DonePanel: display"); + + my $status = $::config->get("preop.done.status"); + if ($status eq "done") { + return 1; + } + + my $instDir = $::config->get("service.instanceDir"); + my $tokenname = $::config->get("preop.module.token"); + my $token_pwd = $::pwdconf->get($tokenname); + my $nickname = $::config->get("preop.cert.sslserver.nickname"); + if (($tokenname ne "") && ($tokenname ne "NSS Certificate DB")) { + open(PWD_CONF, ">>$instDir/conf/password.conf"); + print PWD_CONF "$tokenname:$token_pwd\n"; + close (PWD_CONF); + } + + # Add this RA's server certificate to the subsystems + my $sdom = $::config->get("config.sdomainURL"); + my $cainfo = $::config->get("preop.cainfo.select"); + $cainfo =~ s/.* - //g; + ®ister_ra($sdom, $cainfo, $::config->get("conn.ca1.servlet.addagent"), "CA"); + + $::config->put("preop.done.status", "done"); + $::config->commit(); + + # update nss.conf + open(TMP_NSS_CONF, ">$instDir/conf/nss.conf.tmp"); + open(NSS_CONF, "<$instDir/conf/nss.conf"); + while (<NSS_CONF>) { + if (/NSSVerifyClient none/) { + print TMP_NSS_CONF "NSSVerifyClient optional\n"; + } else { + if ((/^NSSNickname/) && ($tokenname ne "") && ($tokenname ne "NSS Certificate DB")) { + print TMP_NSS_CONF "NSSNickname \"$nickname\"\n"; + } else { + print TMP_NSS_CONF $_; + } + } + } + close(NSS_CONF); + close(TMP_NSS_CONF); + + system("mv $instDir/conf/nss.conf.tmp $instDir/conf/nss.conf"); + + &PKI::RA::Wizard::debug_log("DonePanel: Connecting to Security Domain"); + + my $machineName = $::config->get("service.machineName"); + my $securePort = $::config->get("service.securePort"); + my $unsecurePort = $::config->get("service.unsecurePort"); + my $instanceID = $::config->get("service.instanceID"); + + $::symbol{host} = $machineName; + $::symbol{port} = $securePort; + $::symbol{unsecurePort} = $unsecurePort; + $::symbol{instanceId} = $instanceID; + + $::config->deleteSubstore("preop."); + $::config->commit(); + + system("rm $instDir/conf/*.txt $instDir/conf/*.der"); + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/GlobalVar.pm b/pki/base/ra/lib/perl/PKI/RA/GlobalVar.pm new file mode 100755 index 000000000..bf7fae600 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/GlobalVar.pm @@ -0,0 +1,42 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; + +package PKI::RA::GlobalVar; +$PKI::RA::GlobalVar::VERSION = '1.00'; + +sub new { + my $class = shift; + my $self = {}; + my %args = (@_); + foreach my $q (keys %args) { + $self->{$q} = $args{$q}; + } + bless $self,$class; + return $self; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/ImportAdminCertPanel.pm b/pki/base/ra/lib/perl/PKI/RA/ImportAdminCertPanel.pm new file mode 100755 index 000000000..7ee15e596 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/ImportAdminCertPanel.pm @@ -0,0 +1,131 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use URI::URL; + +package PKI::RA::ImportAdminCertPanel; +$PKI::RA::ImportAdminCertPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(15); + $self->{"getName"} = &PKI::RA::Common::r("Import Administrator Certificate"); + $self->{"vmfile"} = "importadmincertpanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("ImportAdminCertPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("ImportAdminCertPanel: update"); + + # register to Security Domain + my $sdom = $::config->get("config.sdomainURL"); + my $sdom_url = new URI::URL($sdom); + + # + # we need to authenticate to the security domain with the subsystem + # certificate + # + my $machineName = $::config->get("service.machineName"); + my $instanceID = $::config->get("service.instanceID"); + my $instanceDir = $::config->get("service.instanceDir"); + my $securePort = $::config->get("service.securePort"); + my $subsystemName = $::config->get("preop.subsystem.name"); + my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; + my $name = $subsystemName; + my $subCertNickName = $::config->get("preop.cert.subsystem.nickname"); + + $db_password =~ s/\n$//g; + + my $params = "list=" . "RAList" . "&" . + "type=" . "RA" . "&" . + "host=" . $machineName . "&" . + "name=" . $name . "&" . + "sport=" . $securePort . "&" . + "dm=false"; # domain manager or not + + my $cmd = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$subCertNickName\" -r \"/ca/agent/ca/updateDomainXML?$params\" $sdom_url->host:$sdom_url->port`; + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("ImportAdminCertPanel: display"); + +# my $cainfo = $::config->get("preop.cainfo.select"); + my $cainfo = "https://".$::config->get("conn.ca1.hostport"); + + my $cainfo_url = new URI::URL($cainfo); + my $serialNumber = $::config->get("preop.admincert.serialno.0"); + + $::symbol{info} = ""; + $::symbol{errorString} = ""; + $::symbol{import} = "true"; + $::symbol{ca} = "false"; + $::symbol{caType} = "ca"; + $::symbol{caHost} = $cainfo_url->host; + $::symbol{caPort} = $cainfo_url->port; + $::symbol{serialNumber} = $serialNumber; + + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/Login.pm b/pki/base/ra/lib/perl/PKI/RA/Login.pm new file mode 100755 index 000000000..e16cb133f --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/Login.pm @@ -0,0 +1,439 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +# wizard - +# Fedora Certificate System - Registration Authority System configuration wizard + + +# This script is run as a 'mod_perl' CGI. Configure mod_perl by adding +# the following to /etc/httpd/conf.d/perl.conf +# +# PerlModule ModPerl::Registry +# PerlModule Apache::compat +# PerlModule PKI::RA::Wizard +# PerlSetEnv PKI_DOCROOT /u/sparkins/t/cs_tip/certsystem/prj/common/ui +# <Location /wizard> +# SetHandler perl-script +# PerlHandler PKI::RA::Wizard +# Order deny,allow +# Allow from all +# </Location> + + +# Note: The Velocity parser is not very helpful when it comes to +# errors right now. Here are some common errors, and what they mean: +# +# ERROR: +# [Mon Apr 03 13:57:33 2006] [error] [client 172.16.24.26] +# Can't use string ("0") as an ARRAY ref while "strict refs" +# in use at /usr/lib/perl5/site_perl/5.8.5/Template/Velocity.pm +# line 423.\n, referer: http://chico/wizard?p=2 +# MEANING +# This probably means that your *.vm file refers to an array +# variable in a foreach statement that is not defined +# Check your foreach array variables. + +use warnings; +use ModPerl::Registry; +use Template::Velocity; +use Getopt::Std; +use Data::Dumper; +use CGI::Carp qw(fatalsToBrowser); +use CGI; +use APR::Const -compile => qw(:error SUCCESS); +use PKI::RA::GlobalVar; +use PKI::RA::WelcomePanel; +use PKI::RA::SecurityDomainPanel; +use PKI::RA::DisplayCertChainPanel; +use PKI::RA::SubsystemTypePanel; +use PKI::RA::CAInfoPanel; +use PKI::RA::TKSInfoPanel; +use PKI::RA::DRMInfoPanel; +use PKI::RA::DisplayCertChain2Panel; +use PKI::RA::AdminAuthPanel; +use PKI::RA::AgentAuthPanel; +use PKI::RA::AuthDBPanel; +use PKI::RA::DatabasePanel; +use PKI::RA::ModulePanel; +use PKI::RA::SizePanel; +use PKI::RA::NamePanel; +use PKI::RA::ConfigHSMLoginPanel; +use PKI::RA::CertRequestPanel; +use PKI::RA::AdminPanel; +use PKI::RA::ImportAdminCertPanel; +use PKI::RA::LoginPanel; +use PKI::RA::DonePanel; +use PKI::RA::Config; + +use PKI::RA::Common qw(yes no r); + +package PKI::RA::Login; +$PKI::RA::Login::VERSION = '1.00'; + +# read configuration file +my $flavor = `pkiflavor`; +$flavor =~ s/\n//g; + +my $pkiroot = $ENV{PKI_ROOT}; + +my $config = PKI::RA::Config->new(); +$config->load_file("$pkiroot/conf/CS.cfg"); +# read password cache file +my $pwdconf = PKI::RA::Config->new(); +$pwdconf->load_file("$pkiroot/conf/pwcache.conf"); + +# create cfg debug log +open(DEBUG, ">>" . $config->get("service.instanceDir") . + "/logs/debug"); + +# apache server + +our $debug; + +my $STATUS_OK = 1; +my $STATUS_ERROR = 2; +my $STATUS_REDIRECT = 3; + +&debug_log("RA wizard: starting up"); + +my $docroot = $ENV{PKI_DOCROOT}; + +if (! $docroot) { + &debug_log("RA wizard: ERROR: PKI_DOCROOT is null"); + return 0; +} + +our $parser = new Template::Velocity($docroot); +our $symbol; +our @certtags; + +makepanels(); + +&debug_log("RA wizard: start up complete"); + +1; + +sub debug_log +{ + my ($msg) = @_; + my $date = `date`; + chomp($date); + print DEBUG "$date - $msg\n"; +} + + # initializes entries in parser's global symbol table for panels +sub makepanels +{ + #REAL PANELS BELOW + my $login = new PKI::RA::LoginPanel(); + + $symbol{panels} = [ + $login, # com.netscape.cms.servlet.csadmin.WelcomePanel + ]; +}; + +sub render_panel +{ + my ($panelnum, $q) = @_; + + $symbol{errorString} = ""; + + my $currentpanel; + + if ($q->param('op') && $q->param('op') eq "next") { + $currentpanel = $symbol{panels}[$panelnum]; + # validate variables for panel + if ($currentpanel->{validate}) { + $currentpanel->{validate}($q); + } + # execute current panel + my $status = "0"; + + if ($currentpanel->{update}) { + $status = $currentpanel->{update}($q); + &debug_log("RA wizard: update returns status '" . + $status . "'"); + if ($status == $STATUS_REDIRECT) { + return $STATUS_REDIRECT; + } + + } + + &debug_log("RA wizard: about to find out about sub panel"); + if ($status eq "1") { + if ($currentpanel->{hasSubPanel} && &{$currentpanel->{hasSubPanel}}($q)) { + &debug_log("RA wizard: has sub panel"); + $panelnum = $panelnum + 2; + } elsif ($currentpanel->{isSubPanel} && &{$currentpanel->{isSubPanel}}($q)) { + &debug_log("RA wizard: is sub panel"); + $panelnum = $panelnum - 1; + } else { + &debug_log("RA wizard: no sub panel and is not subpanel"); + $panelnum = $panelnum + 1; + } + } + } elsif ($q->param('op') && $q->param('op') eq "back") { + $panelnum = $panelnum - 1; + #check if this a subpanel, if so, go back to it's parent. + #only handles one-deep at this point + my $panel = $symbol{panels}[$panelnum]; + if (&{$panel->{isSubPanel}}($q)) { + $panelnum = $panelnum - 1; + } + } elsif ($q->param('op') && $q->param('op') eq "apply") { + &debug_log("RA wizard: update : apply button pressed"); + $currentpanel = $symbol{panels}[$panelnum]; + # validate variables for panel + if ($currentpanel->{validate}) { + $currentpanel->{validate}($q); + } + # execute current panel + if ($currentpanel->{update}) { + my $status = $currentpanel->{update}($q); + &debug_log("RA wizard: update returns status '" . + $status . "'"); + if ($status == $STATUS_REDIRECT) { + return $STATUS_REDIRECT; + } + + } + } + + &debug_log("RA wizard: after looking into about sub panel"); + + # advance to next panel + $currentpanel = $symbol{panels}[$panelnum]; + + # initialize symbol table values + $symbol{showApplyButton} = "false"; + + # fill in variables for new panel + if ($currentpanel->{panelvars}) { + $Data::Dumper::Indent = 1; + &debug_log("q=".Dumper($q)); + $currentpanel->{panelvars}($q); + } + + $symbol{panel} = "ra/admin/console/config/".$currentpanel->{vmfile}; + + #wizard.vm: + $symbol{name} = "Registration Authority System"; + $symbol{title} = $currentpanel->{getName}(); + if ($panelnum == 0) { + $symbol{firstpanel} = "1"; + } else { + $symbol{firstpanel} = "0"; + } + if ($panelnum == 17) { + $symbol{lastpanel} = "1"; + } else { + $symbol{lastpanel} = "0"; + } + $symbol{p} = $panelnum; + $symbol{subpanelno} = $panelnum+1; + $symbol{csstate} = "1"; + +# $symbol{urls} = [ "cert1", "cert2" ]; #createsubsystem +# $symbol{urls_size} = 2; +# $symbol{instanceId} = "tps"; +# $symbol{errorString} = ""; + + #modulepanel +# $symbol{certs} = [ ]; +# $symbol{reqscerts} = [ ]; + $symbol{ppcerts} = [ ]; + + return $STATUS_OK; +} + + + +sub dbg { + my $msg = shift; + $::symbol{dbg} .= "$msg\n"; +} + +sub handler { + my $r = shift; + + *::symbol = \%symbol; + *::s = \$s; + *::config = \$config; + *::pwdconf = \$pwdconf; + + &debug_log("RA wizard: in handler"); + if ($#ARGV == -1) { + $r->send_http_header('text/html'); + } + + my $q = new CGI; + + # check cookie + my $pin = $q->param('pin'); + if (defined($pin)) { + my $cookie = $q->cookie( + -name=>'pin', + -value=> $pin, + -expires=>'+1y', + -path=>'/'); + print $q->redirect(-location => "wizard", -cookie => $cookie); + return; + } + + # output http parameters + &debug_log("RA wizard: uri='" . $ENV{REQUEST_URI} . "'"); + my @pnames = $q->param(); + foreach $pn (@pnames) { + if ($pn =~ /^__/) { + &debug_log("RA wizard: http parameter name='" . $pn . "' value='(sensitive)'"); + } else { + &debug_log("RA wizard: http parameter name='" . $pn . "' value='" . $q->param($pn) . "'"); + } + } + + my $panelnum = $q->param('p'); + if (!defined($panelnum) || $panelnum eq "") { + # Apache fails to pick up the p parameter after + # redirecting from the security domain. This is + # a quick hack to solve the issue. + if ($ENV{'QUERY_STRING'} ne "") { + $ENV{'QUERY_STRING'} =~ /p=([0-9]+)&/; + $panelnum = $1; + } + } + + use subs qw(debug); + *debug = \&Template::Velocity::Executor::debug; + + $::symbol{dbg} = ""; + + &debug_log("RA wizard: before argparsing"); + if ($#ARGV == -1) { + $Data::Dumper::Maxdepth = 7; + $startfile = "ra/admin/console/config/login.vm"; + } + + &debug_log("RA wizard: setting up test objects"); + + #initialize from config file + my $certlist = $::config->get("preop.cert.list"); + if ($certlist eq "") { + $certlist = "sslserver,subsystem"; + } + @certtags = split(/,/, $certlist); + $numtags = @certtags; + if ($numtags eq 0) { + @certtags = ("sslserver", "subsystem"); + } + &debug_log("RA wizard: found $numtags certtags"); + + if (! $panelnum) { + $panelnum = 0; + } + + my $status = render_panel($panelnum, $q); + if ($status == 3) { + $r->header_out(Location => $symbol{redirect}); + $r->status(301); + $r->send_http_header(); + return; + } + + use Data::Dumper; + &debug_log("RA wizard: executing file $startfile"); + foreach $q (sort keys %symbol) { + &debug_log("RA wizard:/config/wizard?p=9&SecToken=NSS%20Generic%20Crypto%20Services sym{$q}=".$symbol{$q}); + } + + my $result; + if ($q->param("xml") eq "true") { + $r->send_http_header('text/xml'); + $result = "<xml>"; + foreach $s (sort keys %symbol) { + if ($s =~ /^__/) { + next; + } + $result .= "<" . $s . ">"; + my $v = $symbol{$s}; + $result .= &get_xml($s, $v); + $result .= "</" . $s . ">"; + } + $result .= "</xml>"; + } else { + $result = $parser->execute_file($startfile); + if (!defined $result) { + die("Couldn't execute template file: $docroot/$startfile"); + } + } + + print "$result\n"; + return $STATUS_OK; +} + +sub get_xml +{ + my ($s, $v) = @_; + + my $result; + if (ref($v) eq "HASH") { + foreach my $xkey (keys %$v) { + $result .= "<" . $xkey . ">"; + $result .= &get_xml($xkey, $v{$xkey}); + # $result .= "-" . ref($xkey); + $result .= "</" . $xkey . ">"; + } + } elsif (ref($v) eq "PKI::RA::CertInfo") { + my $certinfo = $v; + $result .= "<certinfo>"; + $result .= "<dn>" . $certinfo->get_dn() ."</dn>"; + $result .= "<tag>" . $certinfo->get_cert_tag() . "</tag>"; + $result .= "<friendly>" . $certinfo->get_user_friendly_name() . + "</friendly>"; + $result .= "</certinfo>"; + } elsif (ref($v) eq "PKI::RA::ReqCertInfo") { + my $reqcertinfo = $v; + $result .= "<reqcertinfo>"; + $result .= "<name>" . $reqcertinfo->get_user_friendly_name() ."</name>"; + $result .= "<req>" . $reqcertinfo->get_request() ."</req>"; + $result .= "<cert>" . $reqcertinfo->get_cert() ."</cert>"; + $result .= "<certpp>" . $reqcertinfo->get_cert_pp() ."</certpp>"; + $result .= "<tag>" . $reqcertinfo->get_cert_tag() ."</tag>"; + $result .= "<dn>" . $reqcertinfo->get_cert_tag() ."</dn>"; + $result .= "</reqcertinfo>"; + } elsif (ref($v) eq "ARRAY") { + my $pos = 0; + foreach my $item (@$v) { + $result .= "<element>"; + $result .= &get_xml("p" . $pos, $item); + # $result .= "-" . ref($item); + $result .= "</element>"; + $pos++; + } + } else { + $result .= $v; + } + return $result; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/LoginPanel.pm b/pki/base/ra/lib/perl/PKI/RA/LoginPanel.pm new file mode 100755 index 000000000..211127401 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/LoginPanel.pm @@ -0,0 +1,91 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +package PKI::RA::LoginPanel; +$PKI::RA::LoginPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(0); + $self->{"getName"} = &PKI::RA::Common::r("Welcome"); + $self->{"vmfile"} = "login.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("WelcomePanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("WelcomePanel: update"); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log($ENV{'SERVER_PORT'}); + &PKI::RA::Wizard::debug_log("Debug=" . $::config->get("logging.debug.enable")); + &PKI::RA::Wizard::debug_log("WelcomePanel: display"); + $::symbol{wizardname} = "RA Configuration Wizard"; + $::symbol{systemname} = "RA"; + $::symbol{fullsystemname} = "Registration Authority"; + + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/ModulePanel.pm b/pki/base/ra/lib/perl/PKI/RA/ModulePanel.pm new file mode 100755 index 000000000..955c054bf --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/ModulePanel.pm @@ -0,0 +1,273 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use PKI::RA::Modutil; + +package PKI::RA::ModulePanel; +$PKI::RA::ModulePanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +our $modutil; + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(9); + $self->{"getName"} = &PKI::RA::Common::r("Security Modules"); + $self->{"vmfile"} = "modulepanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + + my $flavor = `pkiflavor`; + $flavor =~ s/\n//g; + + my $pkiroot = $ENV{PKI_ROOT}; + $modutil = new PKI::RA::Modutil("$pkiroot/alias"); + + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 1; +} + +sub validate +{ + my ($q) = @_; + return 1; +} + +sub update +{ + my ($q) = @_; + my $defTok = $::config->get("preop.module.token"); + my $select = $q->param('choice'); + if ($select eq "") { + &PKI::RA::Wizard::debug_log("ModulePanel -> update no selection found"); + $::symbol{errorString} = "No selection found"; + return 0; + } elsif ($defTok ne $select) { + &PKI::RA::Wizard::debug_log("ModulePanel -> update changing defTok to $select"); + $::config->put("preop.module.token", $select); + $::config->put("preop.ModulePanel.done", "true"); + } else { + # this is not an error...just information + &PKI::RA::Wizard::debug_log("ModulePanel -> update defTok not changed"); + } + + $::config->commit(); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("ModulePanel -> display"); + getModules(); + my $defTok = $::config->get("preop.module.token"); + + $::symbol{defTok} = $defTok; + + return 1; +} + +use Data::Dumper; +sub getTokens { + my $modulename = shift; + + &PKI::RA::Wizard::debug_log("ModulePanel -> getTokens"); + +#$Data::Dumper::Indent = 0; +#PKI::RA::Wizard::dbg("in gettokens. modutil = ".Dumper($modutil)); + my @tokens; + my $mod = $modutil->getmodule($modulename); + foreach my $tokenname (keys %{$mod->{tokens}}) { + #PKI::RA::Wizard::dbg("found token $tokenname"); + if ($tokenname ne "NSS Generic Crypto Services") { + my $token = $modutil->gettoken($tokenname); + my $t = new PKI::RA::GlobalVar( + getNickName => sub { return $tokenname; }, + isLoggedIn => sub { return isLoggedIn($tokenname); }, + isPresent => sub { return 1; }, + ); + push @tokens, $t; + } else { + &PKI::RA::Wizard::debug_log("ModulePanel -> getTokens token NSS Generic Crypto Services not available for key generation"); + + } + } + + return \@tokens; +} + +# if password is found, then it's considered "logged in" +# otherwise it is "not logged in" +sub Login { + my $tokenname = $_[0]; + my $pwd = $::pwdconf->get($tokenname); + if ($pwd ne "") { + &PKI::RA::Wizard::debug_log("ModulePanel -> isLoggedIn retrieved pwd from pwdconf"); + return 1; + } + &PKI::RA::Wizard::debug_log("ModulePanel -> isLoggedIn pwd not found from pwdconf for token: $tokenname"); + + if ($tokenname eq "NSS Certificate DB") { + my $instanceDir = $::config->get("service.instanceDir"); + &PKI::RA::Wizard::debug_log("ModulePanel -> isLoggedIn get internal password for $tokenname"); + # these are referred as "internal" in password.conf + $pwd = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; + $pwd =~ s/\n//g; + $::pwdconf->put($tokenname, $pwd); + $::pwdconf->commit(); + + return 1; + } + return 0; +} + +sub isLoggedIn { + my $tokenname = $_[0]; + return &Login($tokenname); +} + +sub getModules { + my $count; + my $i; + my @supportedModules; + + &PKI::RA::Wizard::debug_log("ModulePanel -> getModules"); + $count = $::config->get("preop.configModules.count"); + &PKI::RA::Wizard::debug_log("ModulePanel -> getModules count =$count"); + + my @modules = $modutil->getmodules(); + # $::symbol{steve} = join ",Module:", @modules; + # $::symbol{steve}.= "\n"; + + my $x = " + preop.configModules.count=3 + preop.configModules.module0.commonName=NSS Internal PKCS #11 Module + preop.configModules.module0.imagePath=../img/mozilla.png + preop.configModules.module0.userFriendlyName=NSS Internal PKCS #11 Module + preop.configModules.module1.commonName=nfast + preop.configModules.module1.imagePath=../img/ncipher.png + preop.configModules.module1.userFriendlyName=nCipher's nFast Token Hardware Module + preop.configModules.module2.commonName=lunasa + preop.configModules.module2.imagePath=../img/safenet.png + preop.configModules.module2.userFriendlyName=SafeNet's LunaSA Token Hardware Module + "; + + my %supmodules; + for ($i=0; $i <$count; $i++) { + my $cn; + my $pn; + my $img; +# &PKI::RA::Wizard::debug_log("ModulePanel -> getModules look for cn=","preop.configModules.module" , $i , ".commonName"); + $cn = $::config->get("preop.configModules.module$i.commonName"); + $supmodules{$cn} = 1; + + $pn = $::config->get("preop.configModules.module$i.userFriendlyName"); + $img = $::config->get("preop.configModules.module$i.imagePath"); + &PKI::RA::Wizard::debug_log("ModulePanel -> getModules: got module $cn from config"); + + my $module = $modutil->getmodule($cn); + my $file = $module->{detail}->{"Library file"}; + &PKI::RA::Wizard::debug_log("ModulePanel -> getModules Library file = $file"); + my $found = 0; + if ($file) { + $found = ($file =~ /Internal ONLY module/) || -e $file; + } + + my $name = $module->{detail}->{Name}; +# PKI::RA::Wizard::dbg("name: $name"); + + $supportedModules[$i] = new PKI::RA::GlobalVar( + getImagePath => sub { return $img; }, + getUserFriendlyName => sub { return $pn; }, + isFound => sub { return $found; }, + getTokens => sub { return getTokens($name); }, + ); + + # login to tokens + &PKI::RA::Wizard::debug_log("Ready to login to tokens for $name"); + my $mod = $modutil->getmodule($name); + foreach my $tokenname (keys %{$mod->{tokens}}) { + &PKI::RA::Wizard::debug_log("Logging in Module $name Token " . $tokenname); + &Login($tokenname); + } + + } + + my @otherModules; + #compile the "others" modules + + foreach my $modname (@modules) { + #is this modname in the supported modules list? + if ($supmodules{$modname}) { + &PKI::RA::Wizard::debug_log("ModulePanel -> getModules: found module $modname supported"); + # does not belong to "others" + } else { + &PKI::RA::Wizard::debug_log("ModulePanel -> getModules: found module $modname unsupported"); + #add the module to "others" list + my $m = $modutil->getmodule($modname); + my $mod = new PKI::RA::GlobalVar( + getImagePath => sub { return ""; }, + getUserFriendlyName => sub { return $m->{modulename}; }, + isFound => sub { return 1; }, + getTokens => sub { return getTokens($m->{detail}->{Name});} + ); + + push @otherModules, $mod; + + &PKI::RA::Wizard::debug_log("ModulePanel -> getModules: module $modname added to otherModules list"); + } + } + + $::symbol{sms} = \@supportedModules; + $::symbol{oms} = \@otherModules; +# PKI::RA::Wizard::dbg("oms: ". Dumper([@otherModules])); +# PKI::RA::Wizard::dbg("sms: ". Dumper([@supportedModules])); + + &PKI::RA::Wizard::debug_log("ModulePanel -> set sms, oms"); +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/Modutil.pm b/pki/base/ra/lib/perl/PKI/RA/Modutil.pm new file mode 100755 index 000000000..861e88c99 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/Modutil.pm @@ -0,0 +1,261 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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::RA::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; + 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; + +sub ::test { + +# initialize + my $modutil = new PKI::RA::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 +----------------------------------------------------------- + + diff --git a/pki/base/ra/lib/perl/PKI/RA/NamePanel.pm b/pki/base/ra/lib/perl/PKI/RA/NamePanel.pm new file mode 100755 index 000000000..49517b2d8 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/NamePanel.pm @@ -0,0 +1,535 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use FileHandle; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use PKI::RA::CertInfo; +use URI::URL; +use URI::Escape; + +package PKI::RA::NamePanel; +$PKI::RA::NamePanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); +our $cert_req_header="-----BEGIN NEW CERTIFICATE REQUEST-----"; +our $cert_req_footer="-----END NEW CERTIFICATE REQUEST-----"; +our $cert_header="-----BEGIN CERTIFICATE-----"; +our $cert_footer="-----END CERTIFICATE-----"; + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(12); + $self->{"getName"} = &PKI::RA::Common::r("Subject Names"); + $self->{"vmfile"} = "namepanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("NamePanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("NamePanel: update"); + my $instanceDir = $::config->get("service.instanceDir"); + + my $count = $q->param('urls'); + + &PKI::RA::Wizard::debug_log("NamePanel: update - selected ca= $count"); + + my $host = ""; + my $port = ""; + + my $useExternalCA = "off"; + if ($count =~ /http/) { + my $info = new URI::URL($count); + $host = $info->host; + $port = $info->port; + } else { + $host = $::config->get("preop.securitydomain.ca$count.host"); + if ($host eq "") { + $useExternalCA = "on"; + } else { + $port = $::config->get("preop.securitydomain.ca$count.secureport"); + &PKI::RA::Wizard::debug_log("NamePanel: update - host= $host, port= $port"); + } + } + $::config->put("preop.certenroll.useExternalCA", $useExternalCA); + + $::config->put("preop.ca.url", "https://" . $host . ":" . $port); + + my $tokenname = $::config->get("preop.module.token"); + &PKI::RA::Wizard::debug_log("NamePanel: update got token name = $tokenname"); + my $hw; + my $tk; + + if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { + $hw = ""; + $tk = ""; + } else { + $hw = "-h $tokenname"; + $tk = $tokenname.":"; + } + + # is nickname changed because of token (hardware) selection? + my $changed = "false"; + foreach my $certtag (@PKI::RA::Wizard::certtags) { + &PKI::RA::Wizard::debug_log("NamePanel: update begins for certag= $certtag"); + my $cert_dn = $q->param($certtag); + $::config->put("preop.cert.".$certtag.".dn", $cert_dn); + $::config->commit(); + + my $cert_request = $::config->get("preop.cert.$certtag.certreq"); + if ($cert_request ne "") { + &PKI::RA::Wizard::debug_log("NamePanel: update do not generate new keys"); + goto GEN_CERT; + } + &PKI::RA::Wizard::debug_log("NamePanel: update generate new keys"); + + # =====generate requests======== + # getting new request should void old cert + my $sslnickname = $::config->get("preop.cert.sslserver.nickname"); + my $nickname = $::config->get("preop.cert.$certtag.nickname"); + if ($nickname eq "") { + $nickname = "RA ".$certtag." cert"; + &PKI::RA::Wizard::debug_log("NamePanel: update nickname not found for $certtag -- try $nickname"); + } + + my $file= "$instanceDir/conf/".$certtag."_cert.txt"; + my $tmp = `rm $file`; + + &PKI::RA::Wizard::debug_log("NamePanel: retrieving $tokenname from pwdconf"); + my $token_pwd = $::pwdconf->get($tokenname); + &PKI::RA::Wizard::debug_log("NamePanel: creating pwfile"); + open FILE, ">$instanceDir/conf/.pwfile"; + $token_pwd =~ s/\n//g; + print FILE $token_pwd; + close FILE; + + my $keytype = $::config->get("preop.cert.$certtag.keytype"); + if ($keytype eq "") { + $keytype = "rsa"; + } + + my $select = $::config->get("preop.cert.$certtag.keysize.select"); + + my $keysize; + + if ($keytype eq "rsa") { + $keysize = 2048; + } elsif ($keytype eq "ecc") { + $keysize = 256; + } + + if (($select eq "") || ($select eq "default")) { + my $size = $::config->get("preop.cert.$certtag.keysize.size"); + if ($size ne "") { + $keysize = $size; + } + } else { + my $size = $::config->get("preop.cert.$certtag.keysize.customsize"); + if ($size ne "") { + $keysize = $size; + } + if (($keytype eq "ecc") && ($keysize ne 256)) { + &PKI::RA::Wizard::debug_log("NamePanel: update got keysize from config= $keysize changing to 256, the only supported ECC strength"); + $keysize = 256; + } + } + + &PKI::RA::Wizard::debug_log("NamePanel: update got key type $keytype"); + my $req; + my $filename = "/tmp/random.$$"; + `dd if\=/dev/urandom of\=\"$filename\" count\=256 bs\=1`; + if ($keytype eq "rsa") { + #XXX temporary + &PKI::RA::Wizard::debug_log("NamePanel: update "."certutil -R -s $cert_dn -k $keytype -g $keysize -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -a -z $filename"); + my $tmpfile = "/tmp/req$$"; + system("certutil -R -s \"$cert_dn\" -k $keytype -g $keysize -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -a -z $filename > $tmpfile"); + $req = `cat $tmpfile`; + system("rm $tmpfile"); + } elsif ($keytype eq "ecc") { + #only support curve nistp256 for now + my $tmpfile = "/tmp/req$$"; + system("certutil -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -R -s \"$cert_dn\" -k ec -q nistp256 -a -z $filename> $tmpfile"); + $req = `cat $tmpfile`; + system("rm $tmpfile"); + } else { + &PKI::RA::Wizard::debug_log("NamePanel: update unsupported keytype $keytype"); + } + system("rm $filename"); + + my $save_line = 0; + my @req_a = split "\n", $req; + foreach my $line (@req_a) { + chomp( $line ); + $line =~ s/
//g; + if ($line eq $cert_req_header) { + $save_line = 1; + } elsif( $line eq $cert_req_footer ) { + $save_line = 0; + last; + } elsif( $save_line == 1 ) { + $cert_request .= "$line"; + } + } + &PKI::RA::Wizard::debug_log("NamePanel: update putting cert_request in CS.cfg: $cert_request"); + $::config->put("preop.cert.$certtag.certreq", $cert_request); + $::config->commit(); + +GEN_CERT: +# =====request for certs======== +# see if there is an existing cert + + my $cert = $::config->get("preop.cert.$certtag.cert"); + my $sdom = $::config->get("config.sdomainURL"); + my $sdom_url = new URI::URL($sdom); + + if (($useExternalCA eq "on") && ($certtag ne "subsystem")) { + &PKI::RA::Wizard::debug_log("NamePanel: update External CA selected"); + if ($cert eq "") { + &PKI::RA::Wizard::debug_log("NamePanel: update no cert found...need manual enrollment"); + } + } else { + if ($cert eq "") { + &PKI::RA::Wizard::debug_log("NamePanel: update External CA not selected...need automatic enrollment"); + + my $machineName = $::config->get("service.machineName"); + my $securePort = $::config->get("service.securePort"); + my $session_id = $::config->get("preop.sessionID"); + + if ($cert_request ne "") { + &PKI::RA::Wizard::debug_log("NamePanel: update found existing request: $cert_request"); + } else { + &PKI::RA::Wizard::debug_log("NamePanel: update existing request not found"); + #something is wrong...no request, no cert + goto DONE; + return $cert; + } + + my $instanceID = $::config->get("service.instanceID"); + my $instanceDir = $::config->get("service.instanceDir"); + my $db_password = ""; + &PKI::RA::Wizard::debug_log("NamePanel: greping password"); + + my $tmpfile = "/tmp/grep$$"; + system ("grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10- > $tmpfile"); + $db_password = `cat $tmpfile`; + $db_password =~ s/\n$//g; + system("rm $tmpfile"); + + my $profile_id = $::config->get("preop.cert.$certtag.profile"); + &PKI::RA::Wizard::debug_log("NamePanel: profileId=" . $profile_id); + my $requestor_name = "RA-" . $machineName . "-" . $securePort; + my $params = "profileId=" . $profile_id . "&" . + "cert_request_type=" . "pkcs10" . "&" . + "requestor_name=" . $requestor_name . "&" . + "cert_request=" . + URI::Escape::uri_escape("$cert_request") . "&" . + "xmlOutput=true" . "&" . + "sessionID=" . $session_id . "&" . + "auth_hostname=" . $sdom_url->host . "&" . + "auth_port=" . $sdom_url->port; + + if ($certtag eq "subsystem") { + $host = $sdom_url->host; + $port = $sdom_url->port; + } + if ($changed eq "true") { +$req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$port"; + } else { +$req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$port"; + } + + &PKI::RA::Wizard::debug_log("req = " . $req); + system("$req > $tmpfile"); + my $content = `cat $tmpfile`; + system("rm $tmpfile"); + &PKI::RA::Wizard::debug_log("content = " . $content); + + $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; + $content = $1; + + + my $parser = XML::Simple->new(); + &PKI::RA::Wizard::debug_log("NamePanel: response content= " . $content); + my $response = $parser->XMLin($content); + my $status = $response->{Status}; + if ($status ne "0") { + my $error = $response->{Error}; + &PKI::RA::Wizard::debug_log("NamePanel: Error = $error"); + $::symbol{errorString} = "CA response: $error. Please also check previous related panels."; + return 0; + } + $cert = $response->{Requests}->{Request}->{b64}; + &PKI::RA::Wizard::debug_log("NamePanel: new cert generated= " . $cert); + +# my $reqid = $response->{Requests}->{Request}->{Id}; +# $::config->put("preop.admincert.requestId.0", $reqid); +# my $sn = $response->{Requests}->{Request}->{serialno}; +# $::config->put("preop.admincert.serialno.0", $sn); +# $::config->commit(); + + &PKI::RA::Wizard::debug_log("NamePanel: update putting cert in CS.cfg: $cert"); + $::config->put("preop.cert.$certtag.cert", $cert); + $::config->commit(); + + } else { + # cert is not null + &PKI::RA::Wizard::debug_log("NamePanel: update External CA not selected. Cert found...no need for enrollment"); + } + +# write cert to file so certutil can import + my $cert_fn = "$instanceDir/conf/".$certtag."_cert.txt"; + open FILE, "> $cert_fn"; + print FILE $cert_header."\n".$cert."\n".$cert_footer; + close FILE; + + # import cert, whether it was imported before or not + my $nickname = $::config->get("preop.cert.$certtag.nickname"); + if ($nickname eq "") { + #XXX + $nickname = "RA ".$certtag." cert"; + &PKI::RA::Wizard::debug_log("NamePanel: update nickname not found for $certtag -- try $nickname"); + } + &PKI::RA::Wizard::debug_log("NamePanel: update: try to delete existing cert $nickname, if any....ok if it fails"); + $tmp = `certutil -d $instanceDir/alias -D -n "$nickname"`; + $tmp = `certutil -d $instanceDir/alias -D $hw -f $instanceDir/conf/.pwfile -n "$tk$nickname"`; + + &PKI::RA::Wizard::debug_log("NamePanel: update: try to import cert from $cert_fn"); + $tmp = `certutil -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -A -n "$nickname" -t "u,u,u" -a -i $cert_fn`; + # changed the cert, need to change nickname too, if necessary + if ($hw ne "") { + if ($certtag eq "sslserver") { + if ($changed eq "false") { + $::config->put("preop.cert.$certtag.nickname", "$tk$nickname"); + } + $changed = "true"; + } + if ($certtag eq "subsystem") { + &PKI::RA::Wizard::debug_log("NamePanel: update: sslnickname changed"); + $::config->put("preop.cert.$certtag.nickname", "$tk$nickname"); + $::config->put("conn.ca1.clientNickname", "$tk$nickname"); + $::config->put("conn.drm1.clientNickname", "$tk$nickname"); + $::config->put("conn.tks1.clientNickname", "$tk$nickname"); + } + $::config->commit(); + } + + &PKI::RA::Wizard::debug_log("NamePanel: update: done importing cert: $tk$nickname"); + $tmp = `rm $cert_fn`; + } + } + +DONE: + &PKI::RA::Wizard::debug_log("NamePanel: removing pwfile"); + my $tmp = `rm $instanceDir/conf/.pwfile`; + return 1; +} + +sub readFile +{ + my $fn = $_[0]; + open FILE, "< $fn" or return ""; + my $content = join "",<FILE>; + close FILE; + + return $content; +} + +use Data::Dumper; + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("NamePanel: display"); + + my $domain_name = $::config->get("preop.securitydomain.name"); + if ($domain_name eq "") { + $domain_name = "RA Domain"; + } + my $machine_name = $::config->get("service.machineName"); + my $instance_id = $::config->get("service.instanceID"); + + my $i = 0; + foreach my $certtag (@PKI::RA::Wizard::certtags) { + &PKI::RA::Wizard::debug_log("NamePanel: display certtag=$certtag"); + my $cert_dn = $::config->get("preop.cert.".$certtag.".dn"); + if ($cert_dn eq "") { + if ($certtag eq "subsystem") { + $cert_dn = "CN=RA Subsystem, " . + "OU=" . $instance_id . ", " . + "O=" . $domain_name; + } elsif ($certtag eq "sslserver") { + $cert_dn ="CN=" . $machine_name . ", " . + "OU=" . $instance_id . ", " . + "O=" . $domain_name; + } else { + &PKI::RA::Wizard::debug_log("NamePanel: display other certtag=$certtag"); + $cert_dn = $certtag; + } + $::config->put("preop.cert.".$certtag.".dn", $cert_dn); + $::config->commit(); + } else { + if (!($cert_dn =~ /O=/)) { + $cert_dn .= ", O=" . $domain_name; + $::config->put("preop.cert.".$certtag.".dn", $cert_dn); + $::config->commit(); + } + } + + my $name = $::config->get("preop.cert.".$certtag.".userfriendlyname"); + if ($name eq "") { + $name = $certtag."Cert ".$instance_id; + $::config->put("preop.cert.".$certtag.".userfriendlyname", $name); + $::config->commit(); + } + + my $cert = new PKI::RA::CertInfo($name, + $cert_dn, $certtag); + $::symbol{certs}[$i++] = $cert; + } + + &PKI::RA::Wizard::debug_log("NamePanel: getting CA info"); + $::symbol{urls} = []; + my $count = 0; + + while (1) { + my $host = $::config->get("preop.securitydomain.ca$count.host"); + if ($host eq "") { + goto DONE; + } + my $port = $::config->get("preop.securitydomain.ca$count.secureport"); + my $name = $::config->get("preop.securitydomain.ca$count.subsystemname"); + my $item = $name . " - https://" . $host . ":" . $port; + $::symbol{urls}[$count++] = $item; + + } +DONE: + + $::symbol{urls}[$count++] = "External CA"; + $::symbol{urls_size} = $count+1; + + return 1; +} + + +# arg0 filename containing certificate request +# return certificate request plus header and footer +sub extract_cert_req_from_file +{ + my $save_line = 0; + + my $filename = $_[0]; + + my $fd = new FileHandle; + + my $cert_request = ""; + + $fd->open( "<$filename" ) or die "Could not open '$filename'!\n"; + + while( <$fd> ) + { + my $line = $_; + chomp( $line ); + + if( $line eq $cert_req_header ) { + $save_line = 1; + $cert_request .= "$line\n"; + } elsif( $line eq $cert_req_footer ) { + $cert_request .= "$line\n"; + $save_line = 0; + last; + } elsif( $save_line == 1 ) { + $cert_request .= "$line\n"; + } + } + + $fd->close(); + + return $cert_request; +} + +# arg0 message containing certificate request +# return certificate request sans header and footer +sub extract_cert_req_from_file_sans_header_and_footer +{ + my $filename = $_[0]; + my $save_line = 0; + + my $fd = new FileHandle; + + my $cert_request = ""; + + $fd->open( "<$filename" ) or die "Could not open '$filename'!\n"; + + while( <$fd> ) + { + my $line = $_; + chomp( $line ); + + if( $line eq $cert_req_header ) { + $save_line = 1; + } elsif( $line eq $cert_req_footer ) { + $save_line = 0; + last; + } elsif( $save_line == 1 ) { + $cert_request .= "$line\n"; + } + } + + $fd->close(); + + return $cert_request; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/ReqCertInfo.pm b/pki/base/ra/lib/perl/PKI/RA/ReqCertInfo.pm new file mode 100755 index 000000000..c52d8230a --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/ReqCertInfo.pm @@ -0,0 +1,234 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +package PKI::RA::ReqCertInfo; +$PKI::RA::ReqCertInfo::VERSION = '1.00'; + +our $cert_req_header="-----BEGIN NEW CERTIFICATE REQUEST-----"; +our $cert_req_footer="-----END NEW CERTIFICATE REQUEST-----"; +our $cert_header="-----BEGIN CERTIFICATE-----"; +our $cert_footer="-----END CERTIFICATE-----"; + +sub new { + my ($class, $name, $dn, $tag) = @_; + my $self = {}; + &PKI::RA::Wizard::debug_log("ReqCertInfo: start new"); + &PKI::RA::Wizard::debug_log("ReqCertInfo: creating name: $name, dn: $dn, tag: $tag"); + + $self->{"getUserFriendlyName"} = \&get_user_friendly_name; + $self->{"getCertTag"} = \&get_cert_tag; + $self->{"getCert"} = \&get_cert; + $self->{"getCertpp"} = \&get_cert_pp; + $self->{"getRequest"} = \&get_request; + $self->{"getDN"} = \&get_dn; + $self->{"useDefaultKey"} = \&use_default_key; + $self->{"getCustomKeysize"} = \&get_custom_keysize; + &PKI::RA::Wizard::debug_log("ReqCertInfo: end new"); + + $self->{name} = $name; + $self->{dn} = $dn; + $self->{tag} = $tag; + + bless $self, $class; + return $self; +} + +sub get_user_friendly_name +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_user_friendly_name"); + return $self->{name}; +} + +sub readFile +{ + my $fn = $_[0]; + open FILE, "< $fn" or return ""; + my $content = join "",<FILE>; + close FILE; + + return $content; +} + +sub wrap_lines +{ + my $lines = shift; + my $temp ; + foreach my $line (split "\n", $lines) { + if (length $line > 59) { + $line =~ s/(.{0,60})/$1\n/g; + } + # get rid of a line that is just an empty newline + $line =~ s/^\n$//gms; + $temp .= $line; + } + # collapse multiple newlines into one + $temp =~ s/\n+/\n/gms; + $temp =~ s/\n$//gms; + $temp; + +} + +sub get_request +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_request"); + # first, try to see if request has been made before +# my $req = readFile( "/var/lib/fpki-tps/conf/$self->{tag}_cert_request.txt"); + + my $req = $::config->get("preop.cert.$self->{tag}.certreq"); + + $req = wrap_lines($req); + + if ($req ne "") { + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_request found existing request"); + return $cert_req_header."\n".$req."\n".$cert_req_footer;; + } else { + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_request existing request not found"); + } + + return $req; +} + +sub get_cert +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert"); +# see if there is an existing cert +# my $cert = readFile("/var/lib/fpki-tps/conf/".$self->{tag}."_cert.txt"); + my $cert = $::config->get("preop.cert.$self->{tag}.cert"); + + $cert = wrap_lines($cert); + if ($cert ne "") { + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert found existing cert"); + return $cert_header."\n".$cert."\n".$cert_footer;; + } else { + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert existing cert not found"); + } + if ($cert eq "") { + $cert = "...paste certificate here..."; + } + + + return $cert; +} + +sub get_cert_pp +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_pp"); + my $instanceDir = $::config->get("service.instanceDir"); + + my $hw; + my $tokenname = $::config->get("preop.module.token"); + &PKI::RA::Wizard::debug_log("ReqCertInfo: update got token name = $tokenname"); + + if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { + $hw = ""; + } else { + $hw = "-h $tokenname"; + } + + my $token_pwd = $::pwdconf->get($tokenname); + open FILE, ">$instanceDir/conf/.pwfile"; + $token_pwd =~ s/\n//g; + print FILE $token_pwd; + close FILE; + + my $nickname = $::config->get("preop.cert.$self->{tag}.nickname"); + if ($nickname eq "") { +#XXX + $nickname = "RA ".$self->{tag}." cert"; + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_pp nickname not found for $self->{tag} -- try $nickname"); + } + my $certpp=""; +# my $found = -e "/var/lib/fpki-tps/conf/$self->{tag}_cert.txt"; + my $cert = $::config->get("preop.cert.$self->{tag}.cert"); + + if ($cert ne "") { + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_pp found request, ready to get prettyprint"); + my $tmp = `certutil -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -n "$nickname" -L > $instanceDir/conf/$self->{tag}_cert_pp.txt`; + $certpp = readFile("$instanceDir/conf/$self->{tag}_cert_pp.txt"); + $certpp =~ s/"//g; + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_pp pp=$certpp"); + $tmp =`rm $instanceDir/conf/$self->{tag}_cert_pp.txt`; + } else { + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_pp cert not found, will not get prettyprint"); + } + my $tmp = `rm $instanceDir/conf/.pwfile`; + + return $certpp; +} + +sub get_cert_tag +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_tag"); + return $self->{tag}; +} + +sub get_dn +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_dn"); + return $self->{dn}; +} + +sub use_default_key +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("ReqCertInfo: use_default_key"); + my $select = $::config->get("preop.cert.$self->{tag}.keysize.select"); + if ($select ne "") { + if ($select eq "custom") { + &PKI::RA::Wizard::debug_log("ReqCertInfo: use_default_key from config = $select returning 0"); + return 0; + } + } + + &PKI::RA::Wizard::debug_log("ReqCertInfo: use_default_key returning 1"); + return 1; +} + +sub get_custom_keysize +{ + my ($self) = @_; + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_custom_keysize"); + my $keysize = $::config->get("preop.cert.$self->{tag}.keysize.customsize"); + if ($keysize ne "") { + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_custom_keysize from config = $keysize"); + return $keysize; + } else { + &PKI::RA::Wizard::debug_log("ReqCertInfo: get_custom_keysize not from config"); + } + return 2048; +} + + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/SecurityDomainPanel.pm b/pki/base/ra/lib/perl/PKI/RA/SecurityDomainPanel.pm new file mode 100755 index 000000000..0736ca155 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/SecurityDomainPanel.pm @@ -0,0 +1,107 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use XML::Simple; +use Data::Dumper; + +package PKI::RA::SecurityDomainPanel; +$PKI::RA::SecurityDomainPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(1); + $self->{"getName"} = &PKI::RA::Common::r("Security Domain"); + $self->{"vmfile"} = "securitydomainpanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("SecurityPanel: validate"); + + return 1; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("SecurityPanel: display"); + $::symbol{panelname} = "Security Domain"; + $::symbol{sdomainName} = "Security Domain"; + my $hostname = $::config->get("service.machineName"); + $::symbol{sdomainURL} = "https://" . $hostname . ":9443"; + + return 1; +} + + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("SecurityPanel: update"); + my $sdomainURL = $q->param("sdomainURL"); + + if ($sdomainURL eq "") { + &PKI::RA::Wizard::debug_log("SecurityPanel: sdomainURL not found"); + $::symbol{errorString} = "Security Domain URL not found"; + return 0; + } + + # save url in CS.cfg + &PKI::RA::Wizard::debug_log("SecurityPanel: sdomainURL=" . $sdomainURL); + $::config->put("config.sdomainURL", $sdomainURL); + $::config->commit(); + + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/SizePanel.pm b/pki/base/ra/lib/perl/PKI/RA/SizePanel.pm new file mode 100755 index 000000000..c5ad6ca49 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/SizePanel.pm @@ -0,0 +1,237 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use PKI::RA::CertInfo; + +package PKI::RA::SizePanel; +$PKI::RA::SizePanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(11); + $self->{"getName"} = &PKI::RA::Common::r("Key Pairs"); + $self->{"vmfile"} = "sizepanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("SizePanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("SizePanel: update"); + + my $instanceDir = $::config->get("service.instanceDir"); + my $done = $::config->get("preop.SizePanel.done"); + my $genKeyPair = $q->param('generateKeyPair'); + &PKI::RA::Wizard::debug_log("SizePanel: update generateKeyPair value=$genKeyPair"); + if ($done eq "true") { + if ($genKeyPair eq "") { + &PKI::RA::Wizard::debug_log("SizePanel: update generateKeyPair value not found, turn to off"); + $genKeyPair = "off"; + } + } else { + # firstime should always generate keys + $genKeyPair = "on"; + } + + foreach my $certtag (@PKI::RA::Wizard::certtags) { + my $select = $q->param($certtag.'_choice'); + my $keytype = $q->param($certtag.'_keytype'); + my $size = $q->param($certtag.'_custom_size'); + + &PKI::RA::Wizard::debug_log("SizePanel: update $certtag _choice=$select $certtag _keytype=$keytype customsize= $size"); + + $::config->put("preop.keysize.select", $select); + $::config->put("preop.cert.".$certtag.".keysize.select", $select); + + if (! isSupportedSize($keytype, $size)) { + &PKI::RA::Wizard::debug_log("SizePanel: update size $size not supported"); + return 0; + } + $::config->put("preop.cert.".$certtag.".keysize.customsize", $size); + $::config->put("preop.cert.".$certtag.".keytype", $keytype); + + if ($select eq "default") { + my $defaultSize = getDefaultSize($keytype); + &PKI::RA::Wizard::debug_log("SizePanel: update in default, defaultsize = $defaultSize"); + $::config->put("preop.keysize.customsize", $defaultSize); + $::config->put("preop.keysize.size", $defaultSize); + $::config->put("preop.cert.".$certtag.".keysize.size", $defaultSize); + + } elsif ($select eq "custom") { + &PKI::RA::Wizard::debug_log("SizePanel: update in custom, customsize = $size"); + $::config->put("preop.keysize.size", $size); + $::config->put("preop.cert.".$certtag.".keysize.size", $size); + } + + if ($genKeyPair eq "on") { + $::config->put("preop.cert.".$certtag.".certreq", ""); + $::config->put("preop.cert.".$certtag.".cert", ""); + } + } +#XXX should have better error checking to work better + $done = $::config->put("preop.SizePanel.done", "true"); + $::config->commit(); + + return 1; +} + +sub getDefaultSize { + my $keytype = $_[0]; + + if ($keytype eq "ecc") { + return 256; + } elsif ($keytype eq "rsa") { + return 2048; + } + + $::symbol{errorString} = "Unsupported keytype $keytype"; + return 0; +} + +sub isSupportedSize { + my $keytype = $_[0]; + my $size = $_[1]; + + if (($keytype eq "ecc") && ($size ne "256")) { + &PKI::RA::Wizard::debug_log("SizePanel: isSupportedSize ECC only supports size 256"); + $::symbol{errorString} = "Unsupported Size $size. ECC only supports size 256"; + return 0; + } + + if (($size eq "256") || ($size eq "512") || ($size eq "1024") || + ($size eq "2048") || ($size eq "4096")) { + return 1; + } + # wrong size + $::symbol{errorString} = "Unsupported Size $size. RSA only supports sizes 256, 512, 1024, 2048, and 4096"; + return 0; +} + +sub display +{ + my ($q) = @_; + + &PKI::RA::Wizard::debug_log("SizePanel: display"); + + my $done = $::config->get("preop.SizePanel.done"); + &PKI::RA::Wizard::debug_log("SizePanel: display is panel done? $done"); + if ($done eq "true") { + $::symbol{firsttime} = "false"; + } else { + $::symbol{firsttime} = "true"; + } + + my $domain_name = $::config->get("preop.securitydomain.name"); + if ($domain_name eq "") { + $domain_name = "RA Domain"; + } + + my $machine_name = $::config->get("service.machineName"); + my $instance_id = $::config->get("service.instanceID"); + + my $i = 0; + foreach my $certtag (@PKI::RA::Wizard::certtags) { + my $cert_dn = $::config->get("preop.cert.".$certtag.".dn"); + if ($cert_dn eq "") { + if ($certtag eq "subsystem") { + $cert_dn = "CN=RA Subsystem, " . + "OU=" . $instance_id . ", " . + "O=" . $domain_name; + } elsif ($certtag eq "sslserver") { + $cert_dn ="CN=" . $machine_name . ", " . + "OU=" . $instance_id . ", " . + "O=" . $domain_name; + } else { + $cert_dn = $certtag; + } + } + my $name = $::config->get("preop.cert.".$certtag.".userfriendlyname"); + if ($name eq "") { + $name = $certtag."Cert ".$instance_id; + } + my $cert = new PKI::RA::CertInfo($name, + $cert_dn, $certtag); + $::symbol{certs}[$i++] = $cert; + } + + #for "common key settings" + my $select = $::config->get("preop.keysize.select"); + if ($select ne "") { + &PKI::RA::Wizard::debug_log("SizePanel: display keysize select= $select"); + $::symbol{select} = $select; + } else { + $::symbol{select} = "default"; + } + my $default_size = $::config->get("preop.keysize.size"); + if ($default_size eq "") { + $::symbol{default_keysize} = 2048; + } else { + $::symbol{default_keysize} = $default_size; + } + my $custom_size = $::config->get("preop.keysize.customsize"); + if ($custom_size eq "") { + $::symbol{custom_size} = 2048; + } else { + $::symbol{custom_size} = $default_size; + } + + + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/SubsystemTypePanel.pm b/pki/base/ra/lib/perl/PKI/RA/SubsystemTypePanel.pm new file mode 100755 index 000000000..4f98bee61 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/SubsystemTypePanel.pm @@ -0,0 +1,137 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +package PKI::RA::SubsystemTypePanel; +$PKI::RA::SubsystemTypePanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(3); + $self->{"getName"} = &PKI::RA::Common::r("Subsystem Type"); + $self->{"vmfile"} = "createsubsystempanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("SubsystemTypePanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("SubsystemTypePanel: update"); + $::symbol{systemname} = "Registration Authority "; + $::symbol{subsystemName} = "Registration Authority"; + $::symbol{fullsystemname} = "Registration Authority"; + $::symbol{machineName} = "localhost"; + $::symbol{https_port} = "7889"; + $::symbol{check_clonesubsystem} = " "; + $::symbol{check_newsubsystem} = " "; + $::symbol{disableClone} = 1; + + my $subsystemName = $q->param('subsystemName'); + $::config->put("preop.subsystem.name", $subsystemName); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("SubsystemTypePanel: display"); + $::symbol{systemname} = "Registration Authority "; + $::symbol{subsystemName} = "Registration Authority"; + $::symbol{fullsystemname} = "Registration Authority "; + + my $machineName = $::config->get("service.machineName"); + my $securePort = $::config->get("service.securePort"); + my $unsecurePort = $::config->get("service.unsecurePort"); + + + $::symbol{machineName} = $machineName; + $::symbol{https_port} = $securePort; + $::symbol{check_clonesubsystem} = ""; + $::symbol{check_newsubsystem} = "checked "; + + my $session_id = $q->param("session_id"); + $::config->put("preop.sessionID", $session_id); + $::config->commit(); + + $::symbol{urls} = []; + my $count = 0; + while (1) { + my $host = $::config->get("preop.securitydomain.ra$count.host"); + if ($host eq "") { + goto DONE; + } + my $port = $::config->get("preop.securitydomain.ra$count.secureport"); + my $name = $::config->get("preop.securitydomain.ra$count.subsystemname"); + unshift(@{$::symbol{urls}}, "https://" . $host . ":" . $port); + $count++; + } +DONE: + $::symbol{urls_size} = $count; + +# if ($count == 0) { + $::symbol{disableClone} = 1; +# } + + # XXX - how to deal with urls + return 1; +} + + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/TKSInfoPanel.pm b/pki/base/ra/lib/perl/PKI/RA/TKSInfoPanel.pm new file mode 100755 index 000000000..a219e74c3 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/TKSInfoPanel.pm @@ -0,0 +1,134 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; +use URI::URL; + +package PKI::RA::TKSInfoPanel; +$PKI::RA::TKSInfoPanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(5); + $self->{"getName"} = &PKI::RA::Common::r("TKS Information"); + $self->{"vmfile"} = "tksinfopanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("TKSInfoPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("TKSInfoPanel: update"); + + my $count = $q->param('urls'); + + my $instanceID = $::config->get("service.instanceID"); + + my $host = ""; + my $port = ""; + if ($count =~ /http/) { + my $info = new URI::URL($count); + $host = $info->host; + $port = $info->port; + if (($host eq "") || ($port eq "")) { + $::symbol{errorString} = "no TKS found. CA, TKS and optionally DRM must be installed prior to RA installation"; + return 0; + } + $::config->put("preop.tksinfo.select", $count); + } else { + $host = $::config->get("preop.securitydomain.tks$count.host"); + $port = $::config->get("preop.securitydomain.tks$count.secureport"); + if (($host eq "") || ($port eq "")) { + $::symbol{errorString} = "no TKS found. CA, TKS and optionally DRM must be installed prior to RA installation"; + return 0; + } + $::config->put("preop.tksinfo.select", "https://$host:$port"); + } + my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname"); + $::config->put("conn.tks1.clientNickname", $subsystemCertNickName); + $::config->put("conn.tks1.hostport", $host . ":" . $port); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("TKSInfoPanel: display"); + $::symbol{urls} = []; + my $count = 0; + while (1) { + my $host = $::config->get("preop.securitydomain.tks$count.host"); + if ($host eq "") { + goto DONE; + } + my $port = $::config->get("preop.securitydomain.tks$count.secureport"); + my $name = $::config->get("preop.securitydomain.tks$count.subsystemname"); + $::symbol{urls}[$count++] = $name . " - https://" . $host . ":" . $port; + } +DONE: + $::symbol{urls_size} = $count; + if ($count eq 0) { + $::symbol{errorString} = "no TKS found. CA, TKS and optionally DRM must be installed prior to RA installation"; + return 0; + } + + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/WelcomePanel.pm b/pki/base/ra/lib/perl/PKI/RA/WelcomePanel.pm new file mode 100755 index 000000000..43935530c --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/WelcomePanel.pm @@ -0,0 +1,90 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +use strict; +use warnings; +use PKI::RA::GlobalVar; +use PKI::RA::Common; + +package PKI::RA::WelcomePanel; +$PKI::RA::WelcomePanel::VERSION = '1.00'; + +use PKI::RA::BasePanel; +our @ISA = qw(PKI::RA::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&PKI::RA::Common::no; + $self->{"getPanelNo"} = &PKI::RA::Common::r(0); + $self->{"getName"} = &PKI::RA::Common::r("Welcome"); + $self->{"vmfile"} = "welcomepanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("WelcomePanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("WelcomePanel: update"); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::RA::Wizard::debug_log("XXX " . $::config->get("logging.debug.enable")); + &PKI::RA::Wizard::debug_log("WelcomePanel: display"); + $::symbol{wizardname} = "RA Configuration Wizard"; + $::symbol{systemname} = "RA"; + $::symbol{fullsystemname} = "Registration Authority"; + + return 1; +} + +1; diff --git a/pki/base/ra/lib/perl/PKI/RA/wizard.pm b/pki/base/ra/lib/perl/PKI/RA/wizard.pm new file mode 100755 index 000000000..c17143ce0 --- /dev/null +++ b/pki/base/ra/lib/perl/PKI/RA/wizard.pm @@ -0,0 +1,475 @@ +#!/usr/bin/pkiperl +# +# --- BEGIN COPYRIGHT BLOCK --- +# 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; version 2 of the License. +# +# 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, 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 --- +# +# +# +# + +# wizard - +# Fedora Certificate System - Registration Authority System configuration wizard + + +# This script is run as a 'mod_perl' CGI. Configure mod_perl by adding +# the following to /etc/httpd/conf.d/perl.conf +# +# PerlModule ModPerl::Registry +# PerlModule Apache::compat +# PerlModule PKI::RA::Wizard +# PerlSetEnv PKI_DOCROOT /u/sparkins/t/cs_tip/certsystem/prj/common/ui +# <Location /wizard> +# SetHandler perl-script +# PerlHandler PKI::RA::Wizard +# Order deny,allow +# Allow from all +# </Location> + + +# Note: The Velocity parser is not very helpful when it comes to +# errors right now. Here are some common errors, and what they mean: +# +# ERROR: +# [Mon Apr 03 13:57:33 2006] [error] [client 172.16.24.26] +# Can't use string ("0") as an ARRAY ref while "strict refs" +# in use at /usr/lib/perl5/site_perl/5.8.5/Template/Velocity.pm +# line 423.\n, referer: http://chico/wizard?p=2 +# MEANING +# This probably means that your *.vm file refers to an array +# variable in a foreach statement that is not defined +# Check your foreach array variables. + +use warnings; +use ModPerl::Registry; +use Template::Velocity; +use Getopt::Std; +use Data::Dumper; +use CGI::Carp qw(fatalsToBrowser); +use CGI; +use APR::Const -compile => qw(:error SUCCESS); +use PKI::RA::GlobalVar; +use PKI::RA::WelcomePanel; +use PKI::RA::SecurityDomainPanel; +use PKI::RA::DisplayCertChainPanel; +use PKI::RA::SubsystemTypePanel; +use PKI::RA::CAInfoPanel; +use PKI::RA::DisplayCertChain2Panel; +use PKI::RA::AdminAuthPanel; +use PKI::RA::AgentAuthPanel; +use PKI::RA::AuthDBPanel; +use PKI::RA::DatabasePanel; +use PKI::RA::ModulePanel; +use PKI::RA::SizePanel; +use PKI::RA::NamePanel; +use PKI::RA::ConfigHSMLoginPanel; +use PKI::RA::CertRequestPanel; +use PKI::RA::AdminPanel; +use PKI::RA::ImportAdminCertPanel; +use PKI::RA::DonePanel; +use PKI::RA::Config; + +use PKI::RA::Common qw(yes no r); + +package PKI::RA::Wizard; +$PKI::RA::Wizard::VERSION = '1.00'; + +# read configuration file +my $flavor = `pkiflavor`; +$flavor =~ s/\n//g; + +my $pkiroot = $ENV{PKI_ROOT}; + +my $config = PKI::RA::Config->new(); +$config->load_file("$pkiroot/conf/CS.cfg"); +# read password cache file +my $pwdconf = PKI::RA::Config->new(); +$pwdconf->load_file("$pkiroot/conf/pwcache.conf"); + +# create cfg debug log +my $logfile = $config->get("service.instanceDir") . "/logs/debug"; +system( "touch $logfile" ); +system( "chmod 00660 $logfile" ); +open(DEBUG, ">>" . $logfile); + +# apache server + +our $debug; + +my $HTTP_OK = 0; + +my $STATUS_OK = 0; # Apache 2 needs this to be zero +my $STATUS_ERROR = 2; +my $STATUS_REDIRECT = 3; + +&debug_log("RA wizard: starting up"); + +my $docroot = $ENV{PKI_DOCROOT}; + +if (! $docroot) { + &debug_log("RA wizard: ERROR: PKI_DOCROOT is null"); + return 0; +} + +our $parser = new Template::Velocity($docroot); +our $symbol; +our @certtags; + +makepanels(); + +&debug_log("RA wizard: start up complete"); + +1; + +sub debug_log +{ + my ($msg) = @_; + my $date = `date`; + chomp($date); + print DEBUG "$date - $msg\n"; +} + + # initializes entries in parser's global symbol table for panels +sub makepanels +{ + #REAL PANELS BELOW + my $welcome = new PKI::RA::WelcomePanel(); + my $securitydomain = new PKI::RA::SecurityDomainPanel(); + my $displaycertchain = new PKI::RA::DisplayCertChainPanel(); + my $subsystem = new PKI::RA::SubsystemTypePanel(); + my $cainfopanel = new PKI::RA::CAInfoPanel(); +# my $displaycertchain2 = new PKI::RA::DisplayCertChain2Panel(); + my $databasepanel = new PKI::RA::DatabasePanel(); + my $modulepanel = new PKI::RA::ModulePanel(); + my $confighsmloginpanel = new PKI::RA::ConfigHSMLoginPanel(); + my $sizepanel = new PKI::RA::SizePanel(); + my $namepanel = new PKI::RA::NamePanel(); + my $certrequestpanel = new PKI::RA::CertRequestPanel(); + my $adminpanel = new PKI::RA::AdminPanel(); + my $importadmincertpanel = new PKI::RA::ImportAdminCertPanel(); + my $donepanel = new PKI::RA::DonePanel(); + + $symbol{panels} = [ + $welcome, # com.netscape.cms.servlet.csadmin.WelcomePanel + $securitydomain, # com.netscape.cms.servlet.csadmin.SecurityDomainPanel + $displaycertchain, # com.netscape.cms.servlet.csadmin.DisplayCertChainPanel + $subsystem, # com.netscape.cms.servlet.csadmin.CreateSubsystemPanel + $cainfopanel, # com.netscape.cms.servlet.csadmin.CAInfoPanel +# $displaycertchain2, # com.netscape.cms.servlet.csadmin.DisplayCertChain2Panel + $databasepanel, # com.netscape.cms.servlet.csadmin.DatabasePanel + $modulepanel, # com.netscape.cms.servlet.csadmin.ModulePanel + $confighsmloginpanel, # com.netscape.cms.servlet.csadmin.ConfigHSMLoginPanel + $sizepanel, # com.netscape.cms.servlet.csadmin.SizePanel + $namepanel, # com.netscape.cms.servlet.csadmin.NamePanel + $certrequestpanel, # com.netscape.cms.servlet.csadmin.CertRequestPanel + $adminpanel, # com.netscape.cms.servlet.csadmin.AdminPanel + $importadmincertpanel, # com.netscape.cms.servlet.csadmin.ImportAdminCertPanel + $donepanel, # com.netscape.cms.servlet.csadmin.DonePanel</param-value> + ]; +}; + +sub render_panel +{ + my ($panelnum, $q) = @_; + + $symbol{errorString} = ""; + + my $currentpanel; + + if ($q->param('op') && $q->param('op') eq "next") { + $currentpanel = $symbol{panels}[$panelnum]; + # validate variables for panel + if ($currentpanel->{validate}) { + $currentpanel->{validate}($q); + } + # execute current panel + my $status = "0"; + + if ($currentpanel->{update}) { + $status = $currentpanel->{update}($q); + &debug_log("RA wizard: update returns status '" . + $status . "'"); + if ($status == $STATUS_REDIRECT) { + return $STATUS_REDIRECT; + } + + } + + &debug_log("RA wizard: about to find out about sub panel"); + if ($status eq "1") { + if ($currentpanel->{hasSubPanel} && &{$currentpanel->{hasSubPanel}}($q)) { + &debug_log("RA wizard: has sub panel"); + $panelnum = $panelnum + 2; + } elsif ($currentpanel->{isSubPanel} && &{$currentpanel->{isSubPanel}}($q)) { + &debug_log("RA wizard: is sub panel"); + $panelnum = $panelnum - 1; + } else { + &debug_log("RA wizard: no sub panel and is not subpanel"); + $panelnum = $panelnum + 1; + } + } + } elsif ($q->param('op') && $q->param('op') eq "back") { + $panelnum = $panelnum - 1; + #check if this a subpanel, if so, go back to it's parent. + #only handles one-deep at this point + my $panel = $symbol{panels}[$panelnum]; + if (&{$panel->{isSubPanel}}($q)) { + $panelnum = $panelnum - 1; + } + } elsif ($q->param('op') && $q->param('op') eq "apply") { + &debug_log("RA wizard: update : apply button pressed"); + $currentpanel = $symbol{panels}[$panelnum]; + # validate variables for panel + if ($currentpanel->{validate}) { + $currentpanel->{validate}($q); + } + # execute current panel + if ($currentpanel->{update}) { + my $status = $currentpanel->{update}($q); + &debug_log("RA wizard: update returns status '" . + $status . "'"); + if ($status == $STATUS_REDIRECT) { + return $STATUS_REDIRECT; + } + + } + } + + &debug_log("RA wizard: after looking into about sub panel"); + + # advance to next panel + $currentpanel = $symbol{panels}[$panelnum]; + + # initialize symbol table values + $symbol{showApplyButton} = "false"; + + # fill in variables for new panel + if ($currentpanel->{panelvars}) { + $Data::Dumper::Indent = 1; + &debug_log("q=".Dumper($q)); + $currentpanel->{panelvars}($q); + } + + $symbol{panel} = "ra/admin/console/config/".$currentpanel->{vmfile}; + + #wizard.vm: + $symbol{name} = "Registration Authority"; + $symbol{title} = $currentpanel->{getName}(); + if ($panelnum == 0) { + $symbol{firstpanel} = "1"; + } else { + $symbol{firstpanel} = "0"; + } + if ($panelnum == 13) { + $symbol{lastpanel} = "1"; + } else { + $symbol{lastpanel} = "0"; + } + $symbol{p} = $panelnum; + $symbol{subpanelno} = $panelnum+1; + $symbol{productversion} = "7.3.0"; + $symbol{csstate} = "1"; + +# $symbol{urls} = [ "cert1", "cert2" ]; #createsubsystem +# $symbol{urls_size} = 2; +# $symbol{instanceId} = "ra"; +# $symbol{errorString} = ""; + + #modulepanel +# $symbol{certs} = [ ]; +# $symbol{reqscerts} = [ ]; + $symbol{ppcerts} = [ ]; + + return $STATUS_OK; +} + + + +sub dbg { + my $msg = shift; + $::symbol{dbg} .= "$msg\n"; +} + +sub handler { + my $r = shift; + + *::symbol = \%symbol; + *::s = \$s; + *::config = \$config; + *::pwdconf = \$pwdconf; + + &debug_log("RA wizard: in handler"); + + my $q = new CGI; + + # check cookie + my $cookie = $q->cookie('pin'); + my $pin = $::config->get("preop.pin"); + if ($cookie ne $pin) { + print $q->redirect("login"); + return; + } + + # output http parameters + &debug_log("RA wizard: uri='" . $ENV{REQUEST_URI} . "'"); + my @pnames = $q->param(); + foreach $pn (@pnames) { + if ($pn =~ /^__/) { + &debug_log("RA wizard: http parameter name='" . $pn . "' value='(sensitive)'"); + } else { + &debug_log("RA wizard: http parameter name='" . $pn . "' value='" . $q->param($pn) . "'"); + } + } + + my $panelnum = $q->param('p'); + if (!defined($panelnum) || $panelnum eq "") { + # Apache fails to pick up the p parameter after + # redirecting from the security domain. This is + # a quick hack to solve the issue. + if ($ENV{'QUERY_STRING'} ne "") { + $ENV{'QUERY_STRING'} =~ /p=([0-9]+)&/; + $panelnum = $1; + } + } + + use subs qw(debug); + *debug = \&Template::Velocity::Executor::debug; + + $::symbol{dbg} = ""; + + &debug_log("RA wizard: before argparsing"); + if ($#ARGV == -1) { + $Data::Dumper::Maxdepth = 7; + $startfile = "ra/admin/console/config/wizard.vm"; + } + + &debug_log("RA wizard: setting up test objects"); + + #initialize from config file + my $certlist = $::config->get("preop.cert.list"); + if ($certlist eq "") { + $certlist = "sslserver,subsystem"; + } + @certtags = split(/,/, $certlist); + $numtags = @certtags; + if ($numtags eq 0) { + @certtags = ("sslserver", "subsystem"); + } + &debug_log("RA wizard: found $numtags certtags"); + + if (! $panelnum) { + $panelnum = 0; + } + + my $status = render_panel($panelnum, $q); + if ($status == 3) { + $r->header_out(Location => $symbol{redirect}); + $r->status(301); + $r->send_http_header(); + return; + } + + use Data::Dumper; + &debug_log("RA wizard: executing file $startfile"); + foreach $q (sort keys %symbol) { + &debug_log("RA wizard:/config/wizard?p=9&SecToken=NSS%20Generic%20Crypto%20Services sym{$q}=".$symbol{$q}); + } + + my $result; + if ($q->param("xml") eq "true") { + $r->send_http_header('text/xml'); + $result = "<xml>"; + foreach $s (sort keys %symbol) { + if ($s =~ /^__/) { + next; + } + $result .= "<" . $s . ">"; + my $v = $symbol{$s}; + $result .= &get_xml($s, $v); + $result .= "</" . $s . ">"; + } + $result .= "</xml>"; + } else { + $result = $parser->execute_file($startfile); + if (!defined $result) { + die("Couldn't execute template file: $docroot/$startfile"); + } + } + + $r->send_http_header('text/html'); + print "$result\n"; + + return $HTTP_OK; +} + +sub escape_xml +{ + my ($v) = @_; + $v =~ s/\"/"/g; + $v =~ s/\'/'/g; + $v =~ s/\&/&/g; + $v =~ s/</</g; + $v =~ s/>/>/g; + return $v; +} + +sub get_xml +{ + my ($s, $v) = @_; + + my $result; + if (ref($v) eq "HASH") { + foreach my $xkey (keys %$v) { + $result .= "<" . $xkey . ">"; + $result .= &get_xml($xkey, $v{$xkey}); + # $result .= "-" . ref($xkey); + $result .= "</" . $xkey . ">"; + } + } elsif (ref($v) eq "PKI::RA::CertInfo") { + my $certinfo = $v; + $result .= "<certinfo>"; + $result .= "<dn>" . $certinfo->get_dn() ."</dn>"; + $result .= "<tag>" . $certinfo->get_cert_tag() . "</tag>"; + $result .= "<friendly>" . $certinfo->get_user_friendly_name() . + "</friendly>"; + $result .= "</certinfo>"; + } elsif (ref($v) eq "PKI::RA::ReqCertInfo") { + my $reqcertinfo = $v; + $result .= "<reqcertinfo>"; + $result .= "<name>" . $reqcertinfo->get_user_friendly_name() ."</name>"; + $result .= "<req>" . $reqcertinfo->get_request() ."</req>"; + $result .= "<cert>" . $reqcertinfo->get_cert() ."</cert>"; + $result .= "<certpp>" . &escape_xml($reqcertinfo->get_cert_pp()) ."</certpp>"; + $result .= "<tag>" . $reqcertinfo->get_cert_tag() ."</tag>"; + $result .= "<dn>" . $reqcertinfo->get_cert_tag() ."</dn>"; + $result .= "</reqcertinfo>"; + } elsif (ref($v) eq "ARRAY") { + my $pos = 0; + foreach my $item (@$v) { + $result .= "<element>"; + $result .= &get_xml("p" . $pos, $item); + # $result .= "-" . ref($item); + $result .= "</element>"; + $pos++; + } + } else { + $result .= &escape_xml($v); + } + return $result; +} + +1; |