summaryrefslogtreecommitdiffstats
path: root/pki/base/ra/lib/perl/PKI/RA
diff options
context:
space:
mode:
Diffstat (limited to 'pki/base/ra/lib/perl/PKI/RA')
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/AdminAuthPanel.pm86
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/AdminPanel.pm227
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/AgentAuthPanel.pm86
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/BasePanel.pm40
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/CAInfoPanel.pm289
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/CertInfo.pm133
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/CertPrettyPrintPanel.pm85
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/CertRequestPanel.pm301
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/Common.pm50
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/Config.pm170
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/ConfigHSMLoginPanel.pm104
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/ConfigHSMPanel.pm72
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/DRMInfoPanel.pm140
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/DatabasePanel.pm109
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/DisplayCertChain2Panel.pm179
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/DisplayCertChainPanel.pm348
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/DonePanel.pm399
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/GlobalVar.pm42
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/ImportAdminCertPanel.pm142
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/Login.pm466
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/LoginPanel.pm91
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/ModulePanel.pm273
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/Modutil.pm262
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/NamePanel.pm567
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/ReqCertInfo.pm235
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/SecurityDomainPanel.pm199
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/SizePanel.pm245
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/SubsystemTypePanel.pm142
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/TKSInfoPanel.pm134
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/WelcomePanel.pm90
-rwxr-xr-xpki/base/ra/lib/perl/PKI/RA/wizard.pm502
31 files changed, 6208 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..656dc2d5e
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/AdminAuthPanel.pm
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+#
+# --- 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..a5538ef54
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/AdminPanel.pm
@@ -0,0 +1,227 @@
+#!/usr/bin/perl
+#
+# --- 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
+
+ # 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.sdomainEEURL");
+ &PKI::RA::Wizard::debug_log("AdminPanel: config.sdomainEEURL=$cainfo");
+ }
+ &PKI::RA::Wizard::debug_log("AdminPanel: Connecting to CA: $cainfo");
+ my $cainfo_url = new URI::URL($cainfo);
+ my $sdom = $::config->get("config.sdomainEEURL");
+ 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 $ca_host = $cainfo_url->host;
+ my $https_ee_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\" $ca_host:$https_ee_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\" $ca_host:$https_ee_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);
+
+ # 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();
+
+ 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..1ada5ad54
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/AgentAuthPanel.pm
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+#
+# --- 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/BasePanel.pm b/pki/base/ra/lib/perl/PKI/RA/BasePanel.pm
new file mode 100755
index 000000000..5cb4d7697
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/BasePanel.pm
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+#
+# --- 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..c8f2e43fd
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/CAInfoPanel.pm
@@ -0,0 +1,289 @@
+#!/usr/bin/perl
+#
+# --- 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 $https_ee_port = "";
+ my $https_agent_port = "";
+ my $https_admin_port = "";
+ my $domain_xml = "";
+
+ if ($count =~ /http/) {
+ my $info = new URI::URL($count);
+ $host = $info->host;
+ $https_ee_port = $info->port;
+ $domain_xml = get_domain_xml($host, $https_ee_port);
+ if ($domain_xml eq "") {
+ $::symbol{errorString} = "missing security domain. CA must be installed prior to RA installation";
+ return 0;
+ }
+
+ $https_agent_port = get_secure_agent_port_from_domain_xml($domain_xml, $host, $https_ee_port);
+ $https_admin_port = get_secure_admin_port_from_domain_xml($domain_xml, $host, $https_ee_port);
+
+ if(($https_admin_port eq "") || ($https_agent_port eq "")) {
+ $::symbol{errorString} = "missing secure CA admin or agent port. CA must be installed prior to RA installation";
+ return 0;
+ }
+ } else {
+ $host = $::config->get("preop.securitydomain.ca$count.host");
+ $https_ee_port = $::config->get("preop.securitydomain.ca$count.secureport");
+ $https_agent_port = $::config->get("preop.securitydomain.ca$count.secureagentport");
+ $https_admin_port = $::config->get("preop.securitydomain.ca$count.secureadminport");
+ }
+
+ if (($host eq "") || ($https_ee_port eq "") || ($https_admin_port eq "") || ($https_agent_port eq "")) {
+ $::symbol{errorString} = "no CA found. CA must be installed prior to RA installation";
+ return 0;
+ }
+
+ &PKI::RA::Wizard::debug_log("CAInfoPanel: update - host= $host, https_ee_port= $https_ee_port");
+
+ $::config->put("preop.cainfo.select", "https://$host:$https_admin_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 . ":" . $https_ee_port);
+ $::config->put("conn.ca1.hostagentport", $host . ":" . $https_agent_port);
+ $::config->put("conn.ca1.hostadminport", $host . ":" . $https_admin_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:$https_ee_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 $https_ee_port = $::config->get("preop.securitydomain.ca$count.secureport");
+ my $name = $::config->get("preop.securitydomain.ca$count.subsystemname");
+ my $item = $name . " - https://" . $host . ":" . $https_ee_port;
+# my $item = "https://" . $host . ":" . $https_ee_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;
+}
+
+sub get_domain_xml
+{
+ my $host = $1;
+ my $https_ee_port = $2;
+
+ # get the domain xml
+ # e. g. - https://water.sfbay.redhat.com:9445/ca/admin/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 $sd_host = $::config->get("securitydomain.host");
+ my $sd_admin_port = $::config->get("securitydomain.httpsadminport");
+ my $content = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"/ca/admin/ca/getDomainXML\" $sd_host:$sd_admin_port`;
+
+ $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/;
+ $content = $1;
+ return $content;
+}
+
+sub get_secure_admin_port_from_domain_xml
+{
+ my $content = $1;
+ my $host = $2;
+ my $https_ee_port = $3;
+
+ # Retrieve the secure admin port corresponding
+ # to the selected host and secure ee port.
+ my $parser = XML::Simple->new();
+ my $response = $parser->XMLin($content);
+ my $xml = $parser->XMLin( $response->{'DomainInfo'},
+ ForceArray => 1 );
+ my $https_admin_port = "";
+ my $count = 0;
+ foreach my $c (@{$xml->{'CAList'}[0]->{'CA'}}) {
+ if( ( $host eq $c->{'Host'}[0] ) &&
+ ( $https_ee_port eq $c->{'SecurePort'}[0] ) ) {
+ $https_admin_port = https_$c->{'SecureAdminPort'}[0];
+ }
+
+ $count++;
+ }
+
+ return $https_admin_port;
+}
+
+sub get_secure_agent_port_from_domain_xml
+{
+ my $content = $1;
+ my $host = $2;
+ my $https_ee_port = $3;
+
+ # Retrieve the secure agent port corresponding
+ # to the selected host and secure ee port.
+ my $parser = XML::Simple->new();
+ my $response = $parser->XMLin($content);
+ my $xml = $parser->XMLin( $response->{'DomainInfo'},
+ ForceArray => 1 );
+ my $https_agent_port = "";
+ my $count = 0;
+ foreach my $c (@{$xml->{'CAList'}[0]->{'CA'}}) {
+ if( ( $host eq $c->{'Host'}[0] ) &&
+ ( $https_ee_port eq $c->{'SecurePort'}[0] ) ) {
+ $https_agent_port = https_$c->{'SecureAgentPort'}[0];
+ }
+
+ $count++;
+ }
+
+ return $https_agent_port;
+}
+
+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..d1a8c3817
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/CertInfo.pm
@@ -0,0 +1,133 @@
+#!/usr/bin/perl
+#
+# --- 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 = "pki";
+ $flavor =~ s/\n//g;
+
+ if ($nickname ne "") {
+ return $nickname;
+ } else {
+ return $self->{tag}."cert cert-$flavor-ra";
+ }
+}
+
+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..cf58d2327
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/CertPrettyPrintPanel.pm
@@ -0,0 +1,85 @@
+#!/usr/bin/perl
+#
+# --- 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..51eb1d400
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/CertRequestPanel.pm
@@ -0,0 +1,301 @@
+#!/usr/bin/perl
+#
+# --- 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";
+ system( "chmod 00660 $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..8deab8c6c
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/Common.pm
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+#
+# --- 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..f1ace5b03
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/Config.pm
@@ -0,0 +1,170 @@
+#!/usr/bin/perl
+#
+# --- 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}) {
+ # Create a copy of the original file which
+ # preserves the original file permissions
+ system("cp -p \"" . $self->{filename} . "\" \"" .
+ $self->{filename} . "." . $suffix . "\"");
+ }
+
+ # Overwrite the contents of the original file
+ # to preserve the original file permissions
+ 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();
+ # Create a copy of the original file which
+ # preserves the original file permissions
+ system("cp -p \"" . $self->{filename} . "\" \"" .
+ $self->{filename} . "." . $suffix . "\"");
+
+ # Overwrite the contents of the original file
+ # to preserve the original file permissions
+ 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..bf74890cc
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/ConfigHSMLoginPanel.pm
@@ -0,0 +1,104 @@
+#!/usr/bin/perl
+#
+# --- 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..095ed5879
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/ConfigHSMPanel.pm
@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+#
+# --- 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..fadd7727c
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/DRMInfoPanel.pm
@@ -0,0 +1,140 @@
+#!/usr/bin/perl
+#
+# --- 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 $https_agent_port = "";
+ if ($count =~ /http/) {
+ my $info = new URI::URL($count);
+ $host = $info->host;
+ $https_agent_port = $info->port;
+ } else {
+ $host = $::config->get("preop.securitydomain.kra$count.host");
+ $https_agent_port = $::config->get("preop.securitydomain.kra$count.secureagentport");
+ }
+ if (($host eq "") || ($https_agent_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:$https_agent_port");
+ my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname");
+ $::config->put("conn.drm1.clientNickname", $subsystemCertNickName);
+ $::config->put("conn.drm1.hostport", $host . ":" . $https_agent_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 $https_agent_port = $::config->get("preop.securitydomain.kra$count.secureagentport");
+ my $name = $::config->get("preop.securitydomain.kra$count.subsystemname");
+ $::symbol{urls}[$count++] = $name . " - https://" . $host . ":" . $https_agent_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..e469e51f8
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/DatabasePanel.pm
@@ -0,0 +1,109 @@
+#!/usr/bin/perl
+#
+# --- 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..46c8a2902
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/DisplayCertChain2Panel.pm
@@ -0,0 +1,179 @@
+#!/usr/bin/perl
+#
+# --- 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..7789aaaba
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/DisplayCertChainPanel.pm
@@ -0,0 +1,348 @@
+#!/usr/bin/perl
+#
+# --- 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 SecurityDomain task
+ my $sdomainAdminURL = $::config->get("config.sdomainAdminURL");
+ if ($sdomainAdminURL eq "") {
+ return 2;
+ }
+
+ my $machineName = $::config->get("service.machineName");
+ my $non_clientauth_securePort = $::config->get("service.non_clientauth_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} = $sdomainAdminURL . "/ca/admin/ca/securityDomainLogin?url=http%3A%2F%2F" . $machineName . "%3A" . $unsecurePort . "%2Fra%2Fadmin%2Fconsole%2Fconfig%2Fwizard%3Fp%3D3%26subsystem%3DRA";
+ } else {
+ $::symbol{redirect} = $sdomainAdminURL . "/ca/admin/ca/securityDomainLogin?url=https%3A%2F%2F" . $machineName . "%3A" . $non_clientauth_securePort . "%2Fra%2Fadmin%2Fconsole%2Fconfig%2Fwizard%3Fp%3D3%26subsystem%3DRA";
+ }
+
+ get_domain_xml($sdomainAdminURL);
+
+
+ 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 $sdomainAdminURL = $::config->get("config.sdomainAdminURL");
+ if ($sdomainAdminURL 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($sdomainAdminURL);
+ my $sd_host = $url_info->host;
+ my $sd_admin_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/admin/ca/getCertChain\" $sd_host:$sd_admin_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 ($sdomainAdminURL) = @_;
+
+ my $sdom_info = new URI::URL($sdomainAdminURL);
+ # get the domain xml
+ # e. g. - https://water.sfbay.redhat.com:9445/ca/admin/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 $sd_host = $sdom_info->host;
+ my $sd_admin_port = $sdom_info->port;
+ my $content = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"/ca/admin/ca/getDomainXML\" $sd_host:$sd_admin_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]);
+ $::config->put("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 . ".secureagentport",
+ $c->{'SecureAgentPort'}[0]);
+ $::config->put("preop.securitydomain.ca" . $count . ".secureadminport",
+ $c->{'SecureAdminPort'}[0]);
+ $::config->put("preop.securitydomain.ca" . $count . ".unsecureport",
+ $c->{'UnSecurePort'}[0]);
+ $::config->put("preop.securitydomain.ca" . $count . ".host",
+ $c->{'Host'}[0]);
+
+ # The user previously specified the CA Security Domain's
+ # SSL Admin URL in the "Security Domain Panel";
+ # now retrieve this specified CA Security Domain's
+ # non-SSL EE, SSL Agent, and SSL EE URLs:
+ if( $sd_admin_port eq $c->{'SecureAdminPort'}[0] ) {
+ # Build the URLs
+ my $http_ee_port = "https://"
+ . $c->{'Host'}[0]
+ . ":"
+ . $c->{'UnSecurePort'}[0];
+ my $https_agent_port = "https://"
+ . $c->{'Host'}[0]
+ . ":"
+ . $c->{'SecureAgentPort'}[0];
+ my $https_ee_port = "https://"
+ . $c->{'Host'}[0]
+ . ":"
+ . $c->{'SecurePort'}[0];
+
+ # Store the URLs
+ $::config->put( "config.sdomainHttpURL", $http_ee_port );
+ $::config->put( "config.sdomainAgentURL", $https_agent_port );
+ $::config->put( "config.sdomainEEURL", $https_ee_port );
+
+ # Store additional values necessary for 'pkiremove' . . .
+ $::config->put( "securitydomain.httpport",
+ $c->{'UnSecurePort'}[0] );
+ $::config->put( "securitydomain.httpsagentport",
+ $c->{'SecureAgentPort'}[0] );
+ $::config->put( "securitydomain.httpseeport",
+ $c->{'SecurePort'}[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 . ".secureagentport",
+ $c->{'SecureAgentPort'}[0]);
+ $::config->put("preop.securitydomain.tks" . $count . ".secureadminport",
+ $c->{'SecureAdminPort'}[0]);
+ $::config->put("preop.securitydomain.tks" . $count . ".unsecureport",
+ $c->{'UnSecurePort'}[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 . ".secureagentport",
+ $c->{'SecureAgentPort'}[0]);
+ $::config->put("preop.securitydomain.kra" . $count . ".secureadminport",
+ $c->{'SecureAdminPort'}[0]);
+ $::config->put("preop.securitydomain.kra" . $count . ".unsecureport",
+ $c->{'UnSecurePort'}[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->{'SecureAgentPort'}[0]);
+ $::config->put("preop.securitydomain.ra" . $count . ".non_clientauth_secure_port",
+ $c->{'SecurePort'}[0]);
+ $::config->put("preop.securitydomain.ra" . $count . ".unsecureport",
+ $c->{'UnSecurePort'}[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..99a2e1798
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/DonePanel.pm
@@ -0,0 +1,399 @@
+#!/usr/bin/perl
+#
+# --- 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 $unsecurePort = $::config->get("service.unsecurePort");
+ my $securePort = $::config->get("service.securePort");
+ my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort");
+ my $session_id = $::config->get("preop.sessionID");
+
+ &PKI::RA::Wizard::debug_log("DonePanel: Security Domain Info " . $url);
+
+ # add service.securityDomainPort to the config file in case pkiremove
+ # needs to remove system reference from the security domain
+ $::config->put("service.securityDomainPort", $securePort);
+ $::config->commit();
+
+ 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";
+ system( "chmod 00660 $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 $unsecurePort = $::config->get("service.unsecurePort");
+ my $securePort = $::config->get("service.securePort");
+ my $non_clientauth_securePort = $::config->get("service.non_clientauth_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 $unsecurePort = $::config->get("service.unsecurePort");
+ my $securePort = $::config->get("service.securePort");
+ my $non_clientauth_securePort = $::config->get("service.non_clientauth_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.sdomainEEURL");
+ my $cainfo = $::config->get("preop.cainfo.select");
+ $cainfo =~ s/.* - //g;
+ &register_ra($sdom, $cainfo, $::config->get("conn.ca1.servlet.addagent"), "CA");
+
+ $::config->put("preop.done.status", "done");
+ $::config->commit();
+
+ # update httpd.conf
+ open(TMP_HTTPD_CONF, ">$instDir/conf/httpd.conf.tmp");
+ system( "chmod 00660 $instDir/conf/httpd.conf.tmp" );
+ open(HTTPD_CONF, "<$instDir/conf/httpd.conf");
+ while (<HTTPD_CONF>) {
+ if (/^#\[ErrorDocument_404\]/) {
+ print TMP_HTTPD_CONF "ErrorDocument 404 /404.html\n";
+ } elsif (/^#\[ErrorDocument_500\]/) {
+ print TMP_HTTPD_CONF "ErrorDocument 500 /500.html\n";
+ } else {
+ print TMP_HTTPD_CONF $_;
+ }
+ }
+ close(HTTPD_CONF);
+ close(TMP_HTTPD_CONF);
+
+ # Create a copy of the original file which
+ # preserves the original file permissions
+ system( "cp -p $instDir/conf/httpd.conf.tmp $instDir/conf/httpd.conf" );
+
+ # Remove the original file only if the backup copy was successful
+ if( -e "$instDir/conf/httpd.conf" ) {
+ system( "rm $instDir/conf/httpd.conf.tmp" );
+ }
+
+ # update nss.conf
+ open(TMP_NSS_CONF, ">$instDir/conf/nss.conf.tmp");
+ system( "chmod 00660 $instDir/conf/nss.conf.tmp" );
+ open(NSS_CONF, "<$instDir/conf/nss.conf");
+ while (<NSS_CONF>) {
+ if (/^NSSNickname/) {
+ print TMP_NSS_CONF "NSSNickname \"$nickname\"\n";
+ } else {
+ print TMP_NSS_CONF $_;
+ }
+ }
+ close(NSS_CONF);
+ close(TMP_NSS_CONF);
+
+ # Create a copy of the original file which
+ # preserves the original file permissions
+ system( "cp -p $instDir/conf/nss.conf.tmp $instDir/conf/nss.conf" );
+
+ # Remove the original file only if the backup copy was successful
+ if( -e "$instDir/conf/nss.conf" ) {
+ system( "rm $instDir/conf/nss.conf.tmp" );
+ }
+
+ &PKI::RA::Wizard::debug_log("DonePanel: Connecting to Security Domain");
+
+ my $machineName = $::config->get("service.machineName");
+ my $unsecurePort = $::config->get("service.unsecurePort");
+ my $securePort = $::config->get("service.securePort");
+ my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort");
+ my $instanceID = $::config->get("service.instanceID");
+
+ my $initDaemon = "pki-rad";
+ my $initCommand = "";
+ if( $^O eq "linux" ) {
+ $initCommand = "/sbin/service $initDaemon";
+ } else {
+ ## default case: e. g. - ( $^O eq "solaris" )
+ $initCommand = "/etc/init.d/$initDaemon";
+ }
+
+ $::symbol{host} = $machineName;
+ $::symbol{unsecurePort} = $unsecurePort;
+ $::symbol{port} = $securePort;
+ $::symbol{non_clientauth_port} = $non_clientauth_securePort;
+ $::symbol{initCommand} = $initCommand;
+ $::symbol{instanceID} = $instanceID;
+
+ $::config->deleteSubstore("preop.");
+ $::config->commit();
+
+ ## Create an empty file that designates the fact that although
+ ## this server instance has been configured, it has NOT yet
+ ## been restarted!
+ my $restart_server = "$instDir/conf/restart_server_after_configuration";
+ system( "touch $restart_server" );
+ system( "chmod 00660 $restart_server" );
+
+ 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..388a41349
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/GlobalVar.pm
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+#
+# --- 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..ea05a8ccd
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/ImportAdminCertPanel.pm
@@ -0,0 +1,142 @@
+#!/usr/bin/perl
+#
+# --- 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.sdomainAgentURL");
+ 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`;
+
+ # Fetch the "updated" security domain and display it
+ &PKI::RA::Wizard::debug_log("ImportAdminCertPanel: Dump contents of updated Security Domain . . .");
+ my $sdomainAdminURL = $::config->get("config.sdomainAdminURL");
+ my $sdom_info = new URI::URL($sdomainAdminURL);
+ my $nickname = $::config->get("preop.cert.sslserver.nickname");
+ my $sd_host = $sdom_info->host;
+ my $sd_admin_port = $sdom_info->port;
+ my $content = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"/ca/admin/ca/getDomainXML\" $sd_host:$sd_admin_port`;
+ $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/;
+ $content = $1;
+ &PKI::RA::Wizard::debug_log($content);
+
+ return 1;
+}
+
+sub display
+{
+ my ($q) = @_;
+ &PKI::RA::Wizard::debug_log("ImportAdminCertPanel: display");
+
+ my $cainfo = $::config->get("preop.cainfo.select");
+
+ 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..d248e5481
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/Login.pm
@@ -0,0 +1,466 @@
+#!/usr/bin/perl
+#
+# --- 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::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 = "pki";
+$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");
+# SELinux disallows performing a "chmod" on this file
+if( $^O ne "linux" ) {
+ system( "chmod 00660 $pkiroot/conf/pwcache.conf" );
+}
+
+# create cfg debug log
+my $logfile = $config->get("service.instanceDir") . "/logs/debug";
+open( DEBUG, ">>" . $logfile ) ||
+warn( "Could not open '" . $logfile . "': $!" );
+
+# 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);
+ if( -w $logfile ) {
+ 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;
+ # The '&debug_log("q=".Dumper($q));' call must be commented out to fix
+ # Bugzilla Bug #249923: Incorrect file permissions on
+ # various files and/or directories
+ # &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} = "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");
+ 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) {
+ # added this facility so that password can be hidden,
+ # all sensitive parameters should be prefixed with
+ # __ (double underscores); however, in the event that
+ # a security parameter slips through, we perform multiple
+ # additional checks to insure that it is NOT displayed
+ if( $pn =~ /^__/ ||
+ $pn =~ /password$/ ||
+ $pn =~ /passwd$/ ||
+ $pn =~ /pwd$/ ||
+ $pn =~ /admin_password_again/i ||
+ $pn =~ /directoryManagerPwd/i ||
+ $pn =~ /bindpassword/i ||
+ $pn =~ /bindpwd/i ||
+ $pn =~ /passwd/i ||
+ $pn =~ /password/i ||
+ $pn =~ /pin/i ||
+ $pn =~ /pwd/i ||
+ $pn =~ /pwdagain/i ||
+ $pn =~ /uPasswd/i ) {
+ &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..66f40acfe
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/LoginPanel.pm
@@ -0,0 +1,91 @@
+#!/usr/bin/perl
+#
+# --- 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..87ce056bc
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/ModulePanel.pm
@@ -0,0 +1,273 @@
+#!/usr/bin/perl
+#
+# --- 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 = "pki";
+ $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..82c66e87d
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/Modutil.pm
@@ -0,0 +1,262 @@
+#!/usr/bin/perl
+#
+# --- 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;
+ while ($details[0] !~ /.*Name:.*/) {
+ shift @details;
+ };
+ $m->{detail} = makehash(shift @details);
+ foreach $d (@details) {
+ my $sdh = makehash($d);
+ my $tokenname = $sdh->{"Token Name"};
+ $tokenname =~ s/\s+$//; # remove trailing spaces
+ if ($tokenname) {
+ $m->{tokens}->{$tokenname}->{detail} = $sdh;
+ }
+ }
+ $i++;
+
+ }
+ return $modules;
+}
+
+# input: a multi-list string with nv/pairs
+# return a hashtable reference
+sub makehash {
+ my $str = shift;
+ my $ht = { };
+ my @lines = split "\n", $str;
+ my $line;
+LINE:
+ foreach $line (@lines) {
+ if ($line =~ /Using database directory/) { next LINE; }
+ if ($line =~ /--------------/) { next LINE; }
+ my ($name, $value) = ($line =~ /^\s*(.*?):\s*(.*?)\s*$/);
+ if ($name) {
+ #print "name:$name\n";
+ #print "value:$value\n";
+ $ht->{$name} = $value;
+ }
+ }
+ return $ht;
+}
+
+sub getmodules {
+ my $self = shift;
+ #print "modules: ".$self->{modules}. "\n";
+ #print "keys: ".(join ",",keys %{$self->{modules}})."\n";
+ return keys %{$self->{modules}};
+}
+
+sub getmodule {
+ my $self = shift;
+ my $modulename = shift;
+
+ #print Dumper($self->{modules});
+ return $self->{modules}->{$modulename};
+}
+
+
+sub gettokens {
+ my $self = shift;
+ my $module = shift;
+
+ return keys %{$module->{tokens}};
+}
+
+sub gettoken {
+ my $self = shift;
+ my $token= shift;
+ foreach my $m (values %{$self->{modules}}) {
+ foreach $t (values %{$m->{tokens}}) {
+ #print join ",", keys %{$t};
+ #print Dumper($t->{detail});
+ if ($t->{detail}->{"Token Name"} eq $token) {
+ return $t;
+ }
+ }
+ }
+}
+
+
+
+package main;
+
+sub ::test {
+
+# initialize
+ my $modutil = new PKI::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..124d2f4b8
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/NamePanel.pm
@@ -0,0 +1,567 @@
+#!/usr/bin/perl
+#
+# --- 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 $https_ee_port = "";
+
+ my $useExternalCA = "off";
+ if ($count =~ /http/) {
+ my $info = new URI::URL($count);
+ $host = $info->host;
+ $https_ee_port = $info->port;
+ } else {
+ $host = $::config->get("preop.securitydomain.ca$count.host");
+ if ($host eq "") {
+ $useExternalCA = "on";
+ } else {
+ $https_ee_port = $::config->get("preop.securitydomain.ca$count.secureport");
+ &PKI::RA::Wizard::debug_log("NamePanel: update - host= $host, https_ee_port= $https_ee_port");
+ }
+ }
+ $::config->put("preop.certenroll.useExternalCA", $useExternalCA);
+
+ $::config->put("preop.ca.url", "https://" . $host . ":" . $https_ee_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 $sslnickname = $::config->get("preop.cert.sslserver.nickname");
+ my $nickname = $q->param($certtag . "_nick");
+ if ($nickname ne "") {
+ &PKI::RA::Wizard::debug_log("NamePanel: update nickname for $certtag set to $nickname");
+ &PKI::RA::Wizard::debug_log("NamePanel: update nickname for $certtag being updated in config file");
+ $::config->put("preop.cert.".$certtag.".nickname", $nickname);
+ $::config->commit();
+ } else {
+ $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 $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 $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";
+ system( "chmod 00660 $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 $debug_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.sdomainEEURL");
+ 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;
+ $https_ee_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:$https_ee_port";
+$debug_req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"(sensitive)\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$https_ee_port";
+ } else {
+$req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$https_ee_port";
+$debug_req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"(sensitive)\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$https_ee_port";
+ }
+
+ &PKI::RA::Wizard::debug_log("debug_req = " . $debug_req);
+ my $content = `$req`;
+ &PKI::RA::Wizard::debug_log("content = " . $content);
+
+ $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/;
+ $content = $1;
+
+ if ($content eq "") {
+ $::symbol{errorString} = "CA returned no response. Please check that the CA is available and also check the host's firewall settings.";
+ return 0;
+ }
+
+ 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 check previous related panels." . " Please check that the CA is available and also check the host's firewall settings.";
+ 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");
+ }
+
+ if ($certtag ne "sslserver") {
+ &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"`;
+ } else {
+ &PKI::RA::Wizard::debug_log("NamePanel: update: try to delete existing cert $sslnickname, if any....ok if it fails");
+ $tmp = `certutil -d $instanceDir/alias -D -n "$sslnickname"`;
+ $tmp = `certutil -d $instanceDir/alias -D $hw -f $instanceDir/conf/.pwfile -n "$tk$sslnickname"`;
+ }
+
+ &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();
+ } else {
+ if ($certtag eq "subsystem") {
+ # setting these just in case the subsystem nickname changed.
+ &PKI::RA::Wizard::debug_log("NamePanel: update: setting in case the subsystem nickname changed");
+ $::config->put("conn.ca1.clientNickname", "$nickname");
+ $::config->put("conn.drm1.clientNickname", "$nickname");
+ $::config->put("conn.tks1.clientNickname", "$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 $https_ee_port = $::config->get("preop.securitydomain.ca$count.secureport");
+ my $name = $::config->get("preop.securitydomain.ca$count.subsystemname");
+ my $item = $name . " - https://" . $host . ":" . $https_ee_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..51c22cd24
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/ReqCertInfo.pm
@@ -0,0 +1,235 @@
+#!/usr/bin/perl
+#
+# --- 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/pki-ra/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/pki-ra/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";
+ system( "chmod 00660 $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/pki-ra/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..8094fabd5
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/SecurityDomainPanel.pm
@@ -0,0 +1,199 @@
+#!/usr/bin/perl
+#
+# --- 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;
+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 pingCS
+{
+ my( $instanceDir ) = $_[0];
+ my( $db_password ) = $_[1];
+ my( $nickname ) = $_[2];
+ my( $hostname ) = $_[3];
+ my( $port ) = $_[4];
+
+ my $content = `/usr/bin/sslget -d $instanceDir/alias -p $db_password -v -n \"$nickname\" -r "/ca/admin/ca/getStatus" $hostname:$port`;
+ if( "$content" eq "" ) {
+ return 0;
+ } else {
+ $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/;
+ $content = $1;
+
+ my $parser = XML::Simple->new();
+ my $response = $parser->XMLin($content);
+ my $state = $response->{State};
+
+ if( "$state" eq "1" ) {
+ return 1;
+ } else {
+ return 0;
+ }
+ }
+}
+
+sub display
+{
+ my ($q) = @_;
+ &PKI::RA::Wizard::debug_log("SecurityPanel: display");
+ $::symbol{panelname} = "Security Domain";
+ $::symbol{sdomainName} = "Security Domain";
+
+ my $instanceDir = $::config->get("service.instanceDir");
+ my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`;
+ $db_password =~ s/\n$//g;
+ my $nickname = $::config->get("preop.cert.sslserver.nickname");
+ my $hostname = $::config->get("service.machineName");
+ my $default_https_admin_port = 9445;
+
+ # check to see if "default" security domain exists on local machine
+ my $status = pingCS( $instanceDir,
+ $db_password,
+ $nickname,
+ $hostname,
+ $default_https_admin_port );
+ if( "$status" eq "1" ) {
+ # "default" security domain exists on local machine;
+ # fill "sdomainURL" in with "default" security domain
+ # as an initial "guess"
+ $::symbol{sdomainURL} = "https://" . $hostname . ":"
+ . $default_https_admin_port;
+ } else {
+ # "default" security domain does NOT exist on local machine;
+ # leave "sdomainURL" blank
+ $::symbol{sdomainURL} = "";
+ }
+
+ $::symbol{sdomainAdminURL} = "https://" . $hostname . ":"
+ . $default_https_admin_port;
+
+ my $initDaemon = "pki-cad";
+ my $initCommand = "";
+ my $instanceID ="&lt;security_domain_instance_name&gt; ";
+ if( $^O eq "linux" ) {
+ $initCommand = "/sbin/service $initDaemon";
+ } else {
+ ## default case: e. g. - ( $^O eq "solaris" )
+ $initCommand = "/etc/init.d/$initDaemon";
+ }
+ $::symbol{initCommand} = $initCommand;
+ $::symbol{instanceID} = $instanceID;
+ 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 has not been specified!");
+ $::symbol{errorString} = "Security Domain HTTPS has not been specified!";
+ return 0;
+ }
+
+ my $sdomainURL_info = new URI::URL($sdomainURL);
+
+ my $instanceDir = $::config->get("service.instanceDir");
+ my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`;
+ $db_password =~ s/\n$//g;
+ my $nickname = $::config->get("preop.cert.sslserver.nickname");
+ my $hostname = $sdomainURL_info->host;
+ my $https_admin_port = $sdomainURL_info->port;
+
+ # check to see if "default" security domain exists on local machine
+ my $status = pingCS( $instanceDir,
+ $db_password,
+ $nickname,
+ $hostname,
+ $https_admin_port );
+ if( "$status" ne "1" ) {
+ # invalid security domain specified
+ &PKI::RA::Wizard::debug_log("SecurityPanel: sdomainURL not found");
+ $::symbol{errorString} = "Security Domain HTTPS Admin URL not found";
+ return 0;
+ }
+
+ # save urls in CS.cfg
+ &PKI::RA::Wizard::debug_log("SecurityPanel: sdomainURL=" . $sdomainURL);
+ $::config->put("config.sdomainAdminURL", $sdomainURL);
+
+ # Add values necessary for 'pkiremove' . . .
+ $::config->put("securitydomain.select", "existing");
+ $::config->put("securitydomain.host", $sdomainURL_info->host);
+ $::config->put("securitydomain.httpsadminport", $sdomainURL_info->port);
+ $::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..f55dc41e9
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/SizePanel.pm
@@ -0,0 +1,245 @@
+#!/usr/bin/perl
+#
+# --- 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 eq "") || ($select eq "default")) {
+ $::symbol{select} = "default";
+ } else {
+ &PKI::RA::Wizard::debug_log("SizePanel: display keysize select= $select");
+ $::symbol{select} = $select;
+ }
+ my $default_size = $::config->get("preop.keysize.size");
+ if ($default_size eq "") {
+ $::symbol{default_keysize} = 2048;
+ } else {
+ $::symbol{default_keysize} = $default_size;
+ }
+
+ my $default_ecc_size = $::config->get("preop.keysize.ecc.size");
+ if ($default_ecc_size eq "") {
+ $::symbol{default_ecc_keysize} = 256;
+ } else {
+ $::symbol{default_ecc_keysize} = $default_ecc_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..3d946bca0
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/SubsystemTypePanel.pm
@@ -0,0 +1,142 @@
+#!/usr/bin/perl
+#
+# --- 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{http_port} = "12888";
+ $::symbol{https_port} = "12889";
+ $::symbol{non_clientauth_https_port} = "12890";
+ $::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 $unsecurePort = $::config->get("service.unsecurePort");
+ my $securePort = $::config->get("service.securePort");
+ my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort");
+
+
+ $::symbol{machineName} = $machineName;
+ $::symbol{http_port} = $unsecurePort;
+ $::symbol{https_port} = $securePort;
+ $::symbol{non_clientauth_https_port} = $non_clientauth_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.non_clientauth_secure_port");
+ 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..ddf1124a9
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/TKSInfoPanel.pm
@@ -0,0 +1,134 @@
+#!/usr/bin/perl
+#
+# --- 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 $https_agent_port = "";
+ if ($count =~ /http/) {
+ my $info = new URI::URL($count);
+ $host = $info->host;
+ $https_agent_port = $info->port;
+ if (($host eq "") || ($https_agent_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");
+ $https_agent_port = $::config->get("preop.securitydomain.tks$count.secureagentport");
+ if (($host eq "") || ($https_agent_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:$https_agent_port");
+ }
+ my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname");
+ $::config->put("conn.tks1.clientNickname", $subsystemCertNickName);
+ $::config->put("conn.tks1.hostport", $host . ":" . $https_agent_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 $https_agent_port = $::config->get("preop.securitydomain.tks$count.secureagentport");
+ my $name = $::config->get("preop.securitydomain.tks$count.subsystemname");
+ $::symbol{urls}[$count++] = $name . " - https://" . $host . ":" . $https_agent_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..c88c138be
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/WelcomePanel.pm
@@ -0,0 +1,90 @@
+#!/usr/bin/perl
+#
+# --- 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..5fe1e7536
--- /dev/null
+++ b/pki/base/ra/lib/perl/PKI/RA/wizard.pm
@@ -0,0 +1,502 @@
+#!/usr/bin/perl
+#
+# --- 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::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 = "pki";
+$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");
+# SELinux disallows performing a "chmod" on this file
+if( $^O ne "linux" ) {
+ system( "chmod 00660 $pkiroot/conf/pwcache.conf" );
+}
+
+# create cfg debug log
+my $logfile = $config->get("service.instanceDir") . "/logs/debug";
+system( "touch $logfile" );
+system( "chmod 00640 $logfile" );
+open( DEBUG, ">>" . $logfile ) ||
+warn( "Could not open '" . $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);
+ if( -w $logfile ) {
+ 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;
+ # The '&debug_log("q=".Dumper($q));' call must be commented out to fix
+ # Bugzilla Bug #249923: Incorrect file permissions on
+ # various files and/or directories
+ # &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} = $::config->get("preop.product.version");
+ $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) {
+ # added this facility so that password can be hidden,
+ # all sensitive parameters should be prefixed with
+ # __ (double underscores); however, in the event that
+ # a security parameter slips through, we perform multiple
+ # additional checks to insure that it is NOT displayed
+ if( $pn =~ /^__/ ||
+ $pn =~ /password$/ ||
+ $pn =~ /passwd$/ ||
+ $pn =~ /pwd$/ ||
+ $pn =~ /admin_password_again/i ||
+ $pn =~ /directoryManagerPwd/i ||
+ $pn =~ /bindpassword/i ||
+ $pn =~ /bindpwd/i ||
+ $pn =~ /passwd/i ||
+ $pn =~ /password/i ||
+ $pn =~ /pin/i ||
+ $pn =~ /pwd/i ||
+ $pn =~ /pwdagain/i ||
+ $pn =~ /uPasswd/i ) {
+ &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') && $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/\"/&quot;/g;
+ $v =~ s/\'/&apos;/g;
+ $v =~ s/\&/&amp;/g;
+ $v =~ s/</&lt;/g;
+ $v =~ s/>/&gt;/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;