diff options
Diffstat (limited to 'pki/base/tps/lib/perl/PKI/TPS')
32 files changed, 6726 insertions, 0 deletions
diff --git a/pki/base/tps/lib/perl/PKI/TPS/AdminAuthPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/AdminAuthPanel.pm new file mode 100755 index 000000000..caaf6c65f --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/AdminAuthPanel.pm @@ -0,0 +1,93 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::AdminAuthPanel; +$PKI::TPS::AdminAuthPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(8); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("AdminAuthPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("AdminAuthPanel: update"); + $::config->put("preop.adminauth.done", "true"); + $::config->commit(); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("AdminAuthPanel: display"); + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.adminauth.done"); +} + + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/AdminPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/AdminPanel.pm new file mode 100755 index 000000000..6d1707483 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/AdminPanel.pm @@ -0,0 +1,215 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use URI::URL; +use URI::Escape; + +package PKI::TPS::AdminPanel; +$PKI::TPS::AdminPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(14); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("AdminPanel: validate"); + return 1; +} + + +sub update +{ + my ($q) = @_; + &PKI::TPS::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::TPS::Wizard::debug_log("AdminPanel: preop.ca.url=$cainfo"); + if ($cainfo eq "" || $cainfo =~ /:$/) { + $cainfo = $::config->get("config.sdomainEEURL"); + &PKI::TPS::Wizard::debug_log("AdminPanel: config.sdomainEEURL=$cainfo"); + } + &PKI::TPS::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 = "TPS-" . $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::TPS::Wizard::debug_log("req = " . $content); + + $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; + $content = $1; + + # create user in internal database + &PKI::TPS::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::TPS::Wizard::debug_log("AdminPanel: admincert " . $admincert); + + my $ldap_host = $::config->get("preop.database.host"); + my $ldap_port = $::config->get("preop.database.port"); + my $basedn = $::config->get("preop.database.basedn"); + my $binddn = $::config->get("preop.database.binddn"); +# my $bindpwd = $::config->get("tokendb.bindPass"); + my $bindpwd = `grep \"tokendbBindPass:\" \"$instanceDir/conf/password.conf\" | cut -c17-`; + $bindpwd =~ s/\n$//g; + + my $tmp = "/tmp/addAgents-$$.ldif"; + + my $flavor = "pki"; + $flavor =~ s/\n//g; + + my $ldapmodify_path = "/usr/bin/ldapmodify"; + + $admincert =~ s/\//\\\//g; + system("sed -e 's/\$TOKENDB_ROOT/$basedn/' " . + "-e 's/\$TOKENDB_AGENT_PWD/$password/' " . + "-e 's/\$TOKENDB_AGENT_CERT/$admincert/' " . + "/usr/share/$flavor/tps/scripts/addAgents.ldif > $tmp"); + system("$ldapmodify_path -x -h '$ldap_host' -p '$ldap_port' -D '$binddn' " . + "-w '$bindpwd' -a " . + "-f '$tmp'"); + system("rm $tmp"); + + my $reqid = $response->{Requests}->{Request}->{Id}; + $::config->put("preop.admincert.requestId.0", $reqid); + my $sn = $response->{Requests}->{Request}->{serialno}; + $::config->put("preop.admincert.serialno.0", $sn); + $::config->put("preop.adminpanel.done", "true"); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("AdminPanel: display"); + $::symbol{admin_uid} = "admin"; + $::symbol{admin_name} = "TPS 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; +} + +sub is_panel_done +{ + return $::config->get("preop.adminpanel.done"); +} + + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/AgentAuthPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/AgentAuthPanel.pm new file mode 100755 index 000000000..a5130caa1 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/AgentAuthPanel.pm @@ -0,0 +1,91 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::AgentAuthPanel; +$PKI::TPS::AgentAuthPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(7); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("AgentAuthPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("AgentAuthPanel: update"); + $::config->put("preop.agentauth.done", "true"); + $::config->commit(); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("AgentAuthPanel: display"); + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.agentauth.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/AuthDBPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/AuthDBPanel.pm new file mode 100755 index 000000000..be24f665a --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/AuthDBPanel.pm @@ -0,0 +1,158 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::AuthDBPanel; +$PKI::TPS::AuthDBPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(7); + $self->{"getName"} = &PKI::TPS::Common::r("Authentication Directory"); + $self->{"vmfile"} = "authdbpanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub is_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub has_sub_panel +{ + my ($q) = @_; + return 0; +} + +sub validate +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("AuthDBPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("AuthDBPanel: update"); + + my $host = $q->param('host'); + my $port = $q->param('port'); + my $basedn = $q->param('basedn'); + + &PKI::TPS::Wizard::debug_log("AuthDBPanel: host=" . $host); + &PKI::TPS::Wizard::debug_log("AuthDBPanel: port=" . $port); + &PKI::TPS::Wizard::debug_log("AuthDBPanel: basedn=" . $basedn); + + if (!($port =~ /^[0-9]+$/)) { + &PKI::TPS::Wizard::debug_log("AuthDBPanel: bad port " . $port); + $::symbol{errorString} = "Bad Port"; + return 0; + } + + # try to do a ldapsearch + my $tmp = "/tmp/file$$"; + my $ldapsearch_path = "/usr/bin/ldapsearch"; + + &PKI::TPS::Wizard::debug_log("AuthDBPanel: invoking $ldapsearch_path"); + my $status = system("$ldapsearch_path -x -h '$host' " . + "-p '$port' -b '$basedn' -s base 'objectclass=*' > $tmp 2>&1"); + if ($status eq "0") { + &PKI::TPS::Wizard::debug_log("AuthDBPanel: auth database looks ok"); + } else { + my $reason = `cat $tmp`; + &PKI::TPS::Wizard::debug_log("AuthDBPanel: failed to connect " . $reason); + $::symbol{errorString} = "Failed to Connect"; + return 0; + } + system("rm $tmp"); + + # save values to CS.cfg + $::config->put("auth.instance.0.baseDN", $basedn); + $::config->put("auth.instance.0.hostport", $host . ":" . $port); + $::config->put("preop.authdb.done", "true"); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("AuthDBPanel: display"); + + my $machineName = $::config->get("service.machineName"); + my $instanceId = $::config->get("service.instanceID"); + + my $basedn = $::config->get("auth.instance.0.baseDN"); + if ($basedn =~ /\[/) { + $basedn = $machineName; + $basedn =~ s/^[^.]+\.//; + if ($basedn eq "") { + $basedn = "dc=" . $machineName; + } else { + $basedn =~ s/\./,dc=/g; + $basedn = "dc=" . $basedn; + } + } + my $host = ""; + my $port = ""; + my $hostport = $::config->get("auth.instance.0.hostport"); + if ($hostport =~ /\[/) { + $host = "localhost"; + $port = "389"; + } else { + my ($hostx, $portx) = split(/:/, $hostport); + $host = $hostx; + $port = $portx; + } + + $::symbol{hostname} = $host; + $::symbol{portStr} = $port; + $::symbol{basedn} = $basedn; + + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.authdb.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/BasePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/BasePanel.pm new file mode 100755 index 000000000..eecf99ff5 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/BasePanel.pm @@ -0,0 +1,39 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::BasePanel; +$PKI::TPS::BasePanel::VERSION = '1.00'; + +sub new { + my ($class) = @_; + my $self = {}; + bless $self, $class; + return $self; +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/CAInfoPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/CAInfoPanel.pm new file mode 100755 index 000000000..2b9fc1861 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/CAInfoPanel.pm @@ -0,0 +1,315 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use URI::URL; + +package PKI::TPS::CAInfoPanel; +$PKI::TPS::CAInfoPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::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"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(4); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("CAInfoPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("CAInfoPanel: update"); + + my $count = defined($q->param('urls')) ? $q->param('urls') : ""; + if ($count eq "") { + $::symbol{errorString} = "No CA information provided. CA, TKS and optionally DRM must be installed prior to TPS installation"; + return 0; + } + &PKI::TPS::Wizard::debug_log("CAInfoPanel: update - got urls = $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/) { + # this is for pkisilent + my $info = new URI::URL($count); + $host = defined($info->host) ? $info->host : ""; + if ($host eq "") { + $::symbol{errorString} = "No CA host provided."; + return 0; + } + + $https_ee_port = defined($info->port) ? $info->port : ""; + if ($https_ee_port eq "") { + $::symbol{errorString} = "No CA EE port provided."; + return 0; + } + + $domain_xml = get_domain_xml($host, $https_ee_port); + if ($domain_xml eq "") { + $::symbol{errorString} = "missing security domain. CA, TKS and optionally DRM must be installed prior to TPS 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} = "secure CA admin or agent port information not provided by security domain."; + return 0; + } + } else { + $host = defined($::config->get("preop.securitydomain.ca$count.host")) ? + $::config->get("preop.securitydomain.ca$count.host") : ""; + $https_ee_port = defined($::config->get("preop.securitydomain.ca$count.secureport")) ? + $::config->get("preop.securitydomain.ca$count.secureport") : ""; + $https_agent_port = defined($::config->get("preop.securitydomain.ca$count.secureagentport")) ? + $::config->get("preop.securitydomain.ca$count.secureagentport") : ""; + $https_admin_port = defined($::config->get("preop.securitydomain.ca$count.secureadminport")) ? + $::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, TKS and optionally DRM must be installed prior to TPS installation"; + return 0; + } + + &PKI::TPS::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::TPS::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::TPS::Wizard::debug_log("CAInfoPanel: ca= $caCert"); + } + if ($caCert eq "") { + &PKI::TPS::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::TPS::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++; + } + } + + $::config->put("preop.cainfo.done", "true"); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("CAInfoPanel: display"); + + $::symbol{urls} = []; +# unshift(@{$::symbol{urls}}, "External CA"); + my $count = 0; + my $first = 1; + my $list = ""; + while (1) { + my $host = ""; + $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 TPS 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; +} + +sub is_panel_done +{ + return $::config->get("preop.cainfo.done"); +} + + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/CertInfo.pm b/pki/base/tps/lib/perl/PKI/TPS/CertInfo.pm new file mode 100755 index 000000000..da5377d4f --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/CertInfo.pm @@ -0,0 +1,132 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::CertInfo; +$PKI::TPS::CertInfo::VERSION = '1.00'; + +sub new { + my ($class, $name, $dn, $tag) = @_; + my $self = {}; + + &PKI::TPS::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::TPS::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::TPS::Wizard::debug_log("CertInfo: get_user_friendly_name"); + return $self->{name}; +} + +sub get_cert_tag +{ + my ($self) = @_; + &PKI::TPS::Wizard::debug_log("CertInfo: get_cert_tag"); + return $self->{tag}; +} + +sub get_dn +{ + my ($self) = @_; + &PKI::TPS::Wizard::debug_log("CertInfo: get_cert_dn"); + return $self->{dn}; +} + +sub use_default_key +{ + my ($self) = @_; + &PKI::TPS::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::TPS::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-tps"; + } +} + +sub get_key_option +{ + my ($self) = @_; + &PKI::TPS::Wizard::debug_log("CertInfo: get_key_option"); + my $option = $::config->get("preop.cert.$self->{tag}.keysize.select"); + + if ($option ne "") { + &PKI::TPS::Wizard::debug_log("CertInfo: get_key_option from config = $option"); + return $option; + } else { + &PKI::TPS::Wizard::debug_log("CertInfo: get_key_option not from config"); + return "default"; + } +} + +sub get_custom_keysize +{ + my ($self) = @_; + &PKI::TPS::Wizard::debug_log("CertInfo: get_custom_keysize"); + my $size = $::config->get("preop.cert.$self->{tag}.keysize.customsize"); + &PKI::TPS::Wizard::debug_log("CertInfo: get_custom_keysize for preop.cert.$self->{tag}.keysize.customsize is $size"); + if ($size ne "") { + &PKI::TPS::Wizard::debug_log("CertInfo: get_custom_keysize from config is $size"); + return $size; + } else { + &PKI::TPS::Wizard::debug_log("CertInfo: get_custom_keysize not from config"); + return 2048; + } +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/CertPrettyPrintPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/CertPrettyPrintPanel.pm new file mode 100755 index 000000000..200ef8d74 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/CertPrettyPrintPanel.pm @@ -0,0 +1,91 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::CertPrettyPrintPanel; +$PKI::TPS::CertPrettyPrintPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(13); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("CertPrettyPrintPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("CertPrettyPrintPanel: update"); + $::config->put("preop.certprettyprint.done", "true"); + $::config->commit(); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("CertPrettyPrintPanel: display"); + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.certprettyprint.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/CertRequestPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/CertRequestPanel.pm new file mode 100755 index 000000000..fb5d9ccda --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/CertRequestPanel.pm @@ -0,0 +1,306 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use PKI::TPS::ReqCertInfo; +use FileHandle; + +package PKI::TPS::CertRequestPanel; +$PKI::TPS::CertRequestPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::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"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(13); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("CertRequestPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::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::TPS::Wizard::debug_log("CertRequestPanel: update: useExternalCA is on"); + } else { + &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: useExternalCA is off"); + &PKI::TPS::Wizard::debug_log("CertRequestPanel: update auto enrollment should have been done, no more action needed"); + return 1; + } + + &PKI::TPS::Wizard::debug_log("CertRequestPanel: update External CA selected, retrieve/process user input"); + + my $tokenname = $::config->get("preop.module.token"); + &PKI::TPS::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::TPS::Wizard::certtags) { + if ($certtag eq "subsystem") { + &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: subsystem cert is pre-generated by the security domain"); + return 1; + } + &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: for certag= $certtag"); + my $ccert = $::config->get("preop.cert.$certtag.cert"); + if ($ccert ne "") { + &PKI::TPS::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::TPS::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::TPS::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::TPS::Wizard::debug_log("CertRequestPanel: update: no certchain included for certtag $certtag"); + } + + my $cert = $q->param($certtag); + if ($cert ne "") { + &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: $certtag cert is $cert"); + my $nickname = $::config->get("preop.cert.$certtag.nickname"); + if ($nickname eq "") { + $nickname = "TPS ".$certtag." cert"; + $::config->put("preop.cert.$certtag.nickname", $nickname); + &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: $certtag cert nickname not found in CS.cfg, generating one= $nickname"); + } + #remove existing one + &PKI::TPS::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::TPS::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::TPS::Wizard::debug_log("CertRequestPanel: update putting cert in CS.cfg: $certa"); + + $::config->put("preop.cert.$certtag.cert", $certa); + + &PKI::TPS::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::TPS::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::TPS::Wizard::debug_log("CertRequestPanel: update: no cert"); + } + } + +DONE: + $::config->put("preop.certrequest.done", "true"); + $::config->commit(); + my $tmp = `rm $instanceDir/conf/.pwfile`; + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("CertRequestPanel: display"); + + my $domain_name = $::config->get("preop.securitydomain.name"); + if ($domain_name eq "") { + $domain_name = "TPS Domain"; + } + my $machine_name = $::config->get("service.machineName"); + my $instance_id = $::config->get("service.instanceID"); + + my $i = 0; + foreach my $certtag (@PKI::TPS::Wizard::certtags) { + my $cert_dn = $::config->get("preop.cert.".$certtag.".dn"); + if ($cert_dn eq "") { + if ($certtag eq "subsystem") { + $cert_dn = "CN=TPS 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::TPS::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; +} + +sub is_panel_done +{ + return $::config->get("preop.certrequest.done"); +} + + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/Common.pm b/pki/base/tps/lib/perl/PKI/TPS/Common.pm new file mode 100755 index 000000000..d8686b6f1 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/Common.pm @@ -0,0 +1,49 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +package PKI::TPS::Common; + +use strict; +use warnings; +use Exporter; + +use vars qw(@ISA @EXPORT @EXPORT_OK); +@ISA = qw(Exporter Autoloader); +@EXPORT = qw(r yes no); + +$PKI::TPS::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/tps/lib/perl/PKI/TPS/Config.pm b/pki/base/tps/lib/perl/PKI/TPS/Config.pm new file mode 100755 index 000000000..7195dccd9 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/Config.pm @@ -0,0 +1,169 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +package PKI::TPS::Config; + +use strict; +use warnings; +use Exporter; + +$PKI::TPS::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::TPS::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::TPS::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/tps/lib/perl/PKI/TPS/ConfigHSMLoginPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/ConfigHSMLoginPanel.pm new file mode 100755 index 000000000..5d36d3da3 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/ConfigHSMLoginPanel.pm @@ -0,0 +1,112 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::ConfigHSMLoginPanel; +$PKI::TPS::ConfigHSMLoginPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(9); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("ConfigHSMLoginPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel: update"); + my $uTokName = $q->param('uTokName'); + my $uPasswd = $q->param('__uPasswd'); + +# &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel: update tokname= $uTokName pwd =$uPasswd"); + + $::pwdconf->put($uTokName, $uPasswd); + $::pwdconf->commit(); + + $::config->put("preop.confighsmlogin.done", "true"); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + use Data::Dumper; + $Data::Dumper::Indent = 1; +# &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel -> dump of q= ". Dumper($q)); + $::symbol{SecToken} = $q->param('SecToken'); +# &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel -> display has ".$q->param('SecToken')); + + &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel -> display retrieving $q->param('SecToken') "); + my $pwd = $::pwdconf->get( $q->param('SecToken')); + if ($pwd ne "") { + &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel -> display retrieved pwd from pwdconf"); + } + + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.confighsmlogin.done"); +} + + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/ConfigHSMPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/ConfigHSMPanel.pm new file mode 100755 index 000000000..06697a8c7 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/ConfigHSMPanel.pm @@ -0,0 +1,78 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::ConfigHSMPanel; +$PKI::TPS::ConfigHSMPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&PKI::TPS::Common::no; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(12); + $self->{"getName"} = &PKI::TPS::Common::r("ConfigHSMLogin"); + $self->{"vmfile"} = "config_hsm.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub validate +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("ConfigHSMPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("ConfigHSMPanel: update"); + $::config->put("preop.confighsm.done", "true"); + $::config->commit(); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("ConfigHSMPanel: display"); + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.confighsm.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/DRMInfoPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/DRMInfoPanel.pm new file mode 100755 index 000000000..1ccef670d --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/DRMInfoPanel.pm @@ -0,0 +1,180 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use URI::URL; + +package PKI::TPS::DRMInfoPanel; +$PKI::TPS::DRMInfoPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(6); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("DRMInfoPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("DRMInfoPanel: update"); + + my $choice = $q->param('choice'); + $::config->put("preop.krainfo.keygen", $choice); + + if ($choice eq "keygen") { + my $count = defined($q->param('urls')) ? $q->param('urls') : ""; + if ($count eq "") { + $::symbol{errorString} = "no DRM information provided. CA, TKS and DRM must be installed prior to TPS installation"; + return 0; + } + &PKI::TPS::Wizard::debug_log("DRMInfoPanel: update - got urls = $count"); + + my $instanceID = $::config->get("service.instanceID"); + my $host = ""; + my $https_agent_port = ""; + my $https_admin_port = ""; + + if ($count =~ /http/) { + # this is for pkisilent + my $info = new URI::URL($count); + $host = defined($info->host) ? $info->host : ""; + $https_agent_port = defined($info->port) ? $info->port : ""; + $https_admin_port = defined($q->param('adminport'))? $q->param('adminport') : ""; + } else { + $host = defined($::config->get("preop.securitydomain.kra$count.host")) ? + $::config->get("preop.securitydomain.kra$count.host") : ""; + $https_agent_port = defined($::config->get("preop.securitydomain.kra$count.secureagentport")) ? + $::config->get("preop.securitydomain.kra$count.secureagentport") : ""; + $https_admin_port = defined($::config->get("preop.securitydomain.kra$count.secureadminport")) ? + $::config->get("preop.securitydomain.kra$count.secureadminport") : ""; + } + + + if (($host eq "") || ($https_agent_port eq "")) { + $::symbol{errorString} = "no DRM found. CA, TKS and DRM must be installed prior to TPS installation"; + return 0; + } + + if ($https_admin_port eq "") { + if ($count =~ /http/) { + $::symbol{errorString} = "DRM admin port not provided by the security domain."; + } else { + $::symbol{errorString} = "DRM admin port not provided."; + } + return 0; + } + + my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname"); + $::config->put("preop.krainfo.select", "https://$host:$https_admin_port"); + $::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"); + $::config->put("op.enroll.soKey.keyGen.encryption.serverKeygen.enable", "true"); + $::config->put("op.enroll.soKeyTemporary.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("op.enroll.userKey.keyGen.encryption.recovery.destroyed.scheme", "GenerateNewKey"); + $::config->put("op.enroll.userKeyTemporary.keyGen.encryption.recovery.onHold.scheme", "GenerateNewKey"); + $::config->put("conn.drm1.clientNickname", ""); + $::config->put("conn.drm1.hostport", ""); + $::config->put("op.enroll.soKey.keyGen.encryption.serverKeygen.enable", "false"); + $::config->put("op.enroll.soKeyTemporary.keyGen.encryption.serverKeygen.enable", "false"); + $::config->put("op.enroll.soKey.keyGen.encryption.recovery.destroyed.scheme", "GenerateNewKey"); + $::config->put("op.enroll.soKeyTemporary.keyGen.encryption.recovery.onHold.scheme", "GenerateNewKey"); + } + $::config->put("preop.drminfo.done", "true"); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("DRMInfoPanel: display"); + + $::symbol{urls} = []; + my $count = 0; + while (1) { + my $host = ""; + $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; +} + +sub is_panel_done +{ + return $::config->get("preop.drminfo.done"); +} + + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/DatabasePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/DatabasePanel.pm new file mode 100755 index 000000000..a95b79589 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/DatabasePanel.pm @@ -0,0 +1,220 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::DatabasePanel; +$PKI::TPS::DatabasePanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(8); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("DatabasePanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("DatabasePanel: update"); + my $instDir = $::config->get("service.instanceDir"); + + my $host = $q->param('host'); + my $port = $q->param('port'); + my $basedn = $q->param('basedn'); + my $database = $q->param('database'); + my $binddn = $q->param('binddn'); + my $bindpwd = $q->param('__bindpwd'); + + # save values to CS.cfg + $::config->put("preop.database.host", $host); + $::config->put("preop.database.port", $port); + $::config->put("preop.database.basedn", $basedn); + $::config->put("preop.database.database", $database); + $::config->put("preop.database.binddn", $binddn); + $::config->put("tokendb.activityBaseDN", "ou=Activities," . $basedn); + $::config->put("tokendb.baseDN", "ou=Tokens," . $basedn); + $::config->put("tokendb.certBaseDN", "ou=Certificates," . $basedn); + $::config->put("tokendb.hostport", $host . ":" . $port); + $::config->put("tokendb.userBaseDN", $basedn); + + $::config->put("auth.instance.1.hostport", $host . ":" . $port); + $::config->put("auth.instance.1.baseDN", $basedn); + $::config->commit(); + +# $::config->put("tokendb.bindPass", $bindpwd); + if ($bindpwd ne "") { + open(PWD_CONF, ">>$instDir/conf/password.conf"); + print PWD_CONF "tokendbBindPass:$bindpwd\n"; + close (PWD_CONF); + } + + &PKI::TPS::Wizard::debug_log("DatabasePanel: host=$host port=$port basedn=$basedn"); + &PKI::TPS::Wizard::debug_log("DatabasePanel: database=$database binddn=$binddn"); + + my $rdn = $basedn; + $rdn =~ s/,.*//g; + my ($type, $value) = split(/=/, $rdn); + my $objectclass = "domain"; + if ($type eq "O" || $type eq "o") { + $objectclass = "organization"; + } elsif ($type eq "OU" || $type eq "ou") { + $objectclass = "organizationalUnit"; + } + + my $flavor = "pki"; + $flavor =~ s/\n//g; + + my $ldapmodify_path = "/usr/bin/ldapmodify"; + + # creating database + my $tmp = "/tmp/database-$$.ldif"; + system("sed -e 's/\$DATABASE/$database/' " . + "-e 's/\$BASEDN/$basedn/' " . + "-e 's/\$OBJECTCLASS/$objectclass/' " . + "-e 's/\$TYPE/$type/' " . + "-e 's/\$VALUE/$value/' " . + "/usr/share/$flavor/tps/scripts/database.ldif > $tmp"); + system("$ldapmodify_path -x -h '$host' -p '$port' -D '$binddn' " . + "-w '$bindpwd' -a " . + "-f '$tmp'"); + system("rm $tmp"); + + # add schema + system("$ldapmodify_path -x -h '$host' -p '$port' " . + "-D '$binddn' -w '$bindpwd' -a " . + "-f '/usr/share/$flavor/tps/scripts/schemaMods.ldif'"); + + # populdate database + $tmp = "/tmp/addTokens-$$.ldif"; + system("sed -e 's/\$TOKENDB_ROOT/$basedn/g' " . + "/usr/share/$flavor/tps/scripts/addTokens.ldif > $tmp"); + system("$ldapmodify_path -x -h '$host' -p '$port' -D '$binddn' " . + "-w '$bindpwd' -a " . + "-f '$tmp'"); + system("rm $tmp"); + + # add regular indexes + $tmp = "/tmp/addIndexes-$$.ldif"; + system("sed -e 's/userRoot/$database/g' " . + "/usr/share/$flavor/tps/scripts/addIndexes.ldif > $tmp"); + system("$ldapmodify_path -x -h '$host' -p '$port' -D '$binddn' " . + "-w '$bindpwd' -a " . + "-f '$tmp'"); + system("rm $tmp"); + + # add VLV indexes + $tmp = "/tmp/addVLVIndexes-$$.ldif"; + system("sed -e 's/userRoot/$database/g;s/\$TOKENDB_ROOT/$basedn/g' " . + "/usr/share/$flavor/tps/scripts/addVLVIndexes.ldif > $tmp"); + system("$ldapmodify_path -x -h '$host' -p '$port' -D '$binddn' " . + "-w '$bindpwd' -a " . + "-f '$tmp'"); + system("rm $tmp"); + + $::config->put("preop.database.done", "true"); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("DatabasePanel: display"); + + my $machineName = $::config->get("service.machineName"); + my $instanceId = $::config->get("service.instanceID"); + + my $host = $::config->get("preop.database.host") || ""; + $::symbol{hostname} = "localhost"; # default + if ($host ne "") { + $::symbol{hostname} = $host; + } + my $port = $::config->get("preop.database.port") || ""; + $::symbol{portStr} = "389"; + if ($port ne "") { + $::symbol{portStr} = $port; + } + my $basedn = $::config->get("preop.database.basedn") || ""; + $::symbol{basedn} = "dc=" . $machineName . "-" . $instanceId; + if ($basedn ne "") { + $::symbol{basedn} = $basedn; + } + my $database = $::config->get("preop.database.database") || ""; + $::symbol{database} = $machineName . "-" . $instanceId; + if ($database ne "") { + $::symbol{database} = $database; + } + my $binddn = $::config->get("preop.database.binddn") || ""; + $::symbol{binddn} = "cn=directory manager"; + if ($binddn ne "") { + $::symbol{binddn} = $binddn; + } + + $::symbol{bindpwd} = ""; + + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.database.done"); +} + + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/DisplayCertChain2Panel.pm b/pki/base/tps/lib/perl/PKI/TPS/DisplayCertChain2Panel.pm new file mode 100755 index 000000000..3a86ab0bd --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/DisplayCertChain2Panel.pm @@ -0,0 +1,186 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use FileHandle; + +package PKI::TPS::DisplayCertChain2Panel; +$PKI::TPS::DisplayCertChain2Panel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::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"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(7); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("DisplayCertChain2Panel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::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`; + + $::config->put("preop.displaycertchain2.done", "true"); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("DisplayCertChain2Panel: display"); + my $instanceDir = $::config->get("service.instanceDir"); + + my $found = -e "$instanceDir/conf/caCertChain2.txt"; + my $certpp = ""; + if ($found) { + &PKI::TPS::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::TPS::Wizard::debug_log("DisplayCertChain2Panel: display read CAchain2_pp.txt"); + $certpp =~ s/"//g; + &PKI::TPS::Wizard::debug_log("DisplayCertChain2Panel: certpp2= $certpp"); + } + +# $symbol{certchain} = [ "cert1", "cert2" ]; +# $symbol{certchain_size} = 2; + $::symbol{certchain} = "$certpp"; + $::symbol{certchain_size} = 1; + + &PKI::TPS::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; +} + +sub is_panel_done +{ + return $::config->get("preop.displaycertchain2.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/DisplayCertChainPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/DisplayCertChainPanel.pm new file mode 100755 index 000000000..91e07ed2b --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/DisplayCertChainPanel.pm @@ -0,0 +1,355 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use URI::URL; +use MIME::Base64; + +package PKI::TPS::DisplayCertChainPanel; +$PKI::TPS::DisplayCertChainPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(2); + $self->{"getName"} = &PKI::TPS::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::TPS::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::TPS::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 . "%2Ftps%2Fadmin%2Fconsole%2Fconfig%2Fwizard%3Fp%3D5%26subsystem%3DTPS"; + } else { + $::symbol{redirect} = $sdomainAdminURL . "/ca/admin/ca/securityDomainLogin?url=https%3A%2F%2F" . $machineName . "%3A" . $non_clientauth_securePort . "%2Ftps%2Fadmin%2Fconsole%2Fconfig%2Fwizard%3Fp%3D5%26subsystem%3DTPS"; + } + + get_domain_xml($sdomainAdminURL); + + $::config->put("preop.displaycertchain.done", "true"); + $::config->commit(); + + return 3; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: display"); + + # connect to the CA, and retrieve the CA certificate + &PKI::TPS::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::TPS::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::TPS::Wizard::debug_log("DisplayCertChainPanel: certpp= $certpp"); + # clean up temp db + $tmp = `certutil -d $instanceDir/alias/tmp -D -n "caCert"`; + } else { + &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: update no certchain found"); + } + + &PKI::TPS::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::TPS::Wizard::debug_log("content = " . $content); + + my $parser = XML::Simple->new(); + my $response = $parser->XMLin($content); + my $xml = $parser->XMLin($response->{'DomainInfo'}, + ForceArray => 1); + + &PKI::TPS::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::TPS::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::TPS::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::TPS::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->{'TPSList'}[0]->{'TPS'}}) { + &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: Found TPS '" . + $c->{'SubsystemName'}[0] . "'"); + $::config->put("preop.securitydomain.tps" . $count . ".subsystemname", + $c->{'SubsystemName'}[0]); + $::config->put("preop.securitydomain.tps" . $count . ".secureport", + $c->{'SecureAgentPort'}[0]); + $::config->put("preop.securitydomain.tps" . $count . ".non_clientauth_secure_port", + $c->{'SecurePort'}[0]); + $::config->put("preop.securitydomain.tps" . $count . ".unsecureport", + $c->{'UnSecurePort'}[0]); + $::config->put("preop.securitydomain.tps" . $count . ".host", + $c->{'Host'}[0]); + $count++; + } + $::config->commit(); +} + +sub is_panel_done +{ + return $::config->get("preop.displaycertchain.done"); +} + + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/DonePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/DonePanel.pm new file mode 100755 index 000000000..6166b54cc --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/DonePanel.pm @@ -0,0 +1,437 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use URI::URL; +use XML::Simple; + +package PKI::TPS::DonePanel; +$PKI::TPS::DonePanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(16); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("DonePanel: validate"); + return 1; +} +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("DonePanel: update"); + return 1; +} + +sub register_tps +{ + my ($sdom, $url, $uri, $xname) = @_; + + &PKI::TPS::Wizard::debug_log("DonePanel: register_tps at $url"); + &PKI::TPS::Wizard::debug_log("DonePanel: subsystem $xname uri=$uri"); + + my $url_info = new URI::URL($url); + my $sdom_info = new URI::URL($sdom); + + # register TPS to Security Domain + # submit request to CA + &PKI::TPS::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::TPS::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 = "TPS-" . $machineName . "-" . $securePort; + my $name = "Token Processing 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::TPS::Wizard::debug_log("ReqCertInfo: update got token name = $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; + + if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { + $hw = ""; + $tk = ""; + } else { + $hw = "-h $tokenname"; + $tk = $tokenname.":"; + } + + 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`; + my $tmp = `rm $instDir/conf/.pwfile`; + $certificate =~ s/-----BEGIN CERTIFICATE-----//g; + $certificate =~ s/-----END CERTIFICATE-----//g; + $certificate =~ s/\n$//g; + + + &PKI::TPS::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::TPS::Wizard::debug_log("req = " . $content); + $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; + $content = $1; + + if (defined $content) { + &PKI::TPS::Wizard::debug_log("DonePanel: result " . $content); + } else { + &PKI::TPS::Wizard::debug_log("DonePanel: result undefined"); + } +} + +sub get_kra_transport_cert +{ + my ($sdom) = @_; + + my $sdom_info = new URI::URL($sdom); + + # register TPS to Security Domain + # submit request to CA + &PKI::TPS::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::TPS::Wizard::debug_log("DonePanel: TransportCert " . $transportCert); + + return $transportCert; +} + +sub send_kra_transport_cert +{ + my ($sdom, $certificate) = @_; + + my $sdom_info = new URI::URL($sdom); + + # register TPS to Security Domain + # submit request to CA + &PKI::TPS::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::TPS::Wizard::debug_log("DonePanel: Response from TKS " . $content); +} + +sub display +{ + my ($q) = @_; + # $symbol{systemType} = "tps"; + # $symbol{host} = "chico"; + # $symbol{port} = "443"; + &PKI::TPS::Wizard::debug_log("DonePanel: display"); + + my $status = defined($::config->get("preop.done.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 TPS's server certificate to the subsystems + my $sdom = $::config->get("config.sdomainEEURL"); + my $cainfo = $::config->get("preop.cainfo.select"); + $cainfo =~ s/.* - //g; + ®ister_tps($sdom, $cainfo, "/ca/admin/ca/registerUser", "CA"); + my $tksinfo = $::config->get("preop.tksinfo.select"); + ®ister_tps($sdom, $tksinfo, "/tks/admin/tks/registerUser", "TKS"); + + my $keygen = $::config->get("conn.tks1.serverKeygen"); + if ($keygen ne "false") { + &PKI::TPS::Wizard::debug_log("DonePanel: KRA available"); + my $krainfo = $::config->get("preop.krainfo.select"); + ®ister_tps($sdom, $krainfo, "/kra/admin/kra/registerUser", "KRA"); + my $transportCert = &get_kra_transport_cert($sdom); + &send_kra_transport_cert($sdom, $transportCert); + } else { + &PKI::TPS::Wizard::debug_log("DonePanel: No KRA setup"); + } + + # Give Object Signing capability to audit_signing cert + open FILE, ">$instDir/conf/.pwfile"; + system( "chmod 00660 $instDir/conf/.pwfile" ); + $token_pwd =~ s/\n//g; + print FILE $token_pwd; + close FILE; + my $hw; + if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { + $hw = ""; + } else { + $hw = "-h $tokenname"; + } + my $auditSigningNickname = $::config->get("preop.cert.audit_signing.nickname"); + my $tmp = `/usr/bin/certutil -d "$instDir/alias" -M $hw -f "$instDir/conf/.pwfile" -n "$auditSigningNickname" -t "u,u,Pu"`; + $tmp = `rm $instDir/conf/.pwfile`; + + $::config->put("preop.done.status", "done"); + $::config->put("tps.configured", "true"); + $::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::TPS::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-tpsd"; + 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" ); + + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.donepanel.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/GlobalVar.pm b/pki/base/tps/lib/perl/PKI/TPS/GlobalVar.pm new file mode 100755 index 000000000..73e7b831a --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/GlobalVar.pm @@ -0,0 +1,41 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; + +package PKI::TPS::GlobalVar; +$PKI::TPS::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/tps/lib/perl/PKI/TPS/ImportAdminCertPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/ImportAdminCertPanel.pm new file mode 100755 index 000000000..468fbab2c --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/ImportAdminCertPanel.pm @@ -0,0 +1,151 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use URI::URL; + +package PKI::TPS::ImportAdminCertPanel; +$PKI::TPS::ImportAdminCertPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(15); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("ImportAdminCertPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::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=" . "TPSList" . "&" . + "type=" . "TPS" . "&" . + "host=" . $machineName . "&" . + "name=" . $name . "&" . + "sport=" . $securePort . "&" . + "dm=false"; # domain manager or not + + my $sd_host = $sdom_url->host; + my $sd_agent_port = $sdom_url->port; + my $cmd = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$subCertNickName\" -r \"/ca/agent/ca/updateDomainXML\" -e \"$params\" $sd_host:$sd_agent_port`; + + # Fetch the "updated" security domain and display it + &PKI::TPS::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"); + $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::TPS::Wizard::debug_log($content); + + $::config->put("preop.importadmincert.done", "true"); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::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; +} + +sub is_panel_done +{ + return $::config->get("preop.importadmincert.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/Login.pm b/pki/base/tps/lib/perl/PKI/TPS/Login.pm new file mode 100755 index 000000000..01aa01f42 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/Login.pm @@ -0,0 +1,466 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +# wizard - +# Fedora Certificate System - Token Processing 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 RHCS::TPS::Wizard +# PerlSetEnv RHCS_DOCROOT /u/sparkins/t/cs_tip/certsystem/prj/common/ui +# <Location /wizard> +# SetHandler perl-script +# PerlHandler RHCS::TPS::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::TPS::GlobalVar; +use PKI::TPS::WelcomePanel; +use PKI::TPS::SecurityDomainPanel; +use PKI::TPS::DisplayCertChainPanel; +use PKI::TPS::SubsystemTypePanel; +use PKI::TPS::CAInfoPanel; +use PKI::TPS::TKSInfoPanel; +use PKI::TPS::DRMInfoPanel; +use PKI::TPS::DisplayCertChain2Panel; +use PKI::TPS::AdminAuthPanel; +use PKI::TPS::AgentAuthPanel; +use PKI::TPS::AuthDBPanel; +use PKI::TPS::DatabasePanel; +use PKI::TPS::ModulePanel; +use PKI::TPS::SizePanel; +use PKI::TPS::NamePanel; +use PKI::TPS::ConfigHSMLoginPanel; +use PKI::TPS::CertRequestPanel; +use PKI::TPS::AdminPanel; +use PKI::TPS::ImportAdminCertPanel; +use PKI::TPS::LoginPanel; +use PKI::TPS::DonePanel; +use PKI::TPS::Config; + +use PKI::TPS::Common qw(yes no r); + +package PKI::TPS::Login; +$PKI::TPS::Login::VERSION = '1.00'; + +# read configuration file +my $flavor = "pki"; +$flavor =~ s/\n//g; + +my $pkiroot = $ENV{PKI_ROOT}; + +my $config = PKI::TPS::Config->new(); +$config->load_file("$pkiroot/conf/CS.cfg"); +# read password cache file +my $pwdconf = PKI::TPS::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("TPS wizard: starting up"); + +my $docroot = $ENV{PKI_DOCROOT}; + +if (! $docroot) { + &debug_log("TPS wizard: ERROR: PKI_DOCROOT is null"); + return 0; +} + +our $parser = new Template::Velocity($docroot); +our $symbol; +our @certtags; + +makepanels(); + +&debug_log("TPS 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::TPS::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("TPS wizard: update returns status '" . + $status . "'"); + if ($status == $STATUS_REDIRECT) { + return $STATUS_REDIRECT; + } + + } + + &debug_log("TPS wizard: about to find out about sub panel"); + if ($status eq "1") { + if ($currentpanel->{hasSubPanel} && &{$currentpanel->{hasSubPanel}}($q)) { + &debug_log("TPS wizard: has sub panel"); + $panelnum = $panelnum + 2; + } elsif ($currentpanel->{isSubPanel} && &{$currentpanel->{isSubPanel}}($q)) { + &debug_log("TPS wizard: is sub panel"); + $panelnum = $panelnum - 1; + } else { + &debug_log("TPS 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("TPS 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("TPS wizard: update returns status '" . + $status . "'"); + if ($status == $STATUS_REDIRECT) { + return $STATUS_REDIRECT; + } + + } + } + + &debug_log("TPS 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} = "tps/admin/console/config/".$currentpanel->{vmfile}; + + #wizard.vm: + $symbol{name} = "Token Processing System"; + $symbol{title} = $currentpanel->{getName}(); + if ($panelnum == 0) { + $symbol{firstpanel} = "1"; + } else { + $symbol{firstpanel} = "0"; + } + if ($panelnum == 17) { + $symbol{lastpanel} = "1"; + } else { + $symbol{lastpanel} = "0"; + } + $symbol{p} = $panelnum; + $symbol{subpanelno} = $panelnum+1; + $symbol{csstate} = "1"; + +# $symbol{urls} = [ "cert1", "cert2" ]; #createsubsystem +# $symbol{urls_size} = 2; +# $symbol{instanceId} = "tps"; +# $symbol{errorString} = ""; + + #modulepanel +# $symbol{certs} = [ ]; +# $symbol{reqscerts} = [ ]; + $symbol{ppcerts} = [ ]; + + return $STATUS_OK; +} + + + +sub dbg { + my $msg = shift; + $::symbol{dbg} .= "$msg\n"; +} + +sub handler { + my $r = shift; + + *::symbol = \%symbol; + *::s = \$s; + *::config = \$config; + *::pwdconf = \$pwdconf; + + &debug_log("TPS 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("TPS 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("TPS wizard: http parameter name='" . $pn . "' value='(sensitive)'"); + } else { + &debug_log("TPS 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("TPS wizard: before argparsing"); + if ($#ARGV == -1) { + $Data::Dumper::Maxdepth = 7; + $startfile = "tps/admin/console/config/login.vm"; + } + + &debug_log("TPS 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("TPS 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("TPS wizard: executing file $startfile"); + foreach $q (sort keys %symbol) { + &debug_log("TPS 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::TPS::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::TPS::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/tps/lib/perl/PKI/TPS/LoginPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/LoginPanel.pm new file mode 100755 index 000000000..d6592d46e --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/LoginPanel.pm @@ -0,0 +1,98 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::LoginPanel; +$PKI::TPS::LoginPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(0); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("WelcomePanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("WelcomePanel: update"); + $::config->put("preop.loginpanel.done", "true"); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log($ENV{'SERVER_PORT'}); + &PKI::TPS::Wizard::debug_log("Debug=" . $::config->get("logging.debug.enable")); + &PKI::TPS::Wizard::debug_log("WelcomePanel: display"); + $::symbol{wizardname} = "TPS Configuration Wizard"; + $::symbol{systemname} = "TPS"; + $::symbol{fullsystemname} = "Token Processing System"; + + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.loginpanel.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/ModulePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/ModulePanel.pm new file mode 100755 index 000000000..5e7089812 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/ModulePanel.pm @@ -0,0 +1,278 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use PKI::TPS::Modutil; + +package PKI::TPS::ModulePanel; +$PKI::TPS::ModulePanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +our $modutil; + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(9); + $self->{"getName"} = &PKI::TPS::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::TPS::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::TPS::Wizard::debug_log("ModulePanel -> update no selection found"); + $::symbol{errorString} = "No selection found"; + return 0; + } elsif ($defTok ne $select) { + &PKI::TPS::Wizard::debug_log("ModulePanel -> update changing defTok to $select"); + $::config->put("preop.module.token", $select); + } else { + # this is not an error...just information + &PKI::TPS::Wizard::debug_log("ModulePanel -> update defTok not changed"); + } + + $::config->put("preop.ModulePanel.done", "true"); + + $::config->commit(); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::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::TPS::Wizard::debug_log("ModulePanel -> getTokens"); + +#$Data::Dumper::Indent = 0; +#PKI::TPS::Wizard::dbg("in gettokens. modutil = ".Dumper($modutil)); + my @tokens; + my $mod = $modutil->getmodule($modulename); + foreach my $tokenname (keys %{$mod->{tokens}}) { + #PKI::TPS::Wizard::dbg("found token $tokenname"); + if ($tokenname ne "NSS Generic Crypto Services") { + my $token = $modutil->gettoken($tokenname); + my $t = new PKI::TPS::GlobalVar( + getNickName => sub { return $tokenname; }, + isLoggedIn => sub { return isLoggedIn($tokenname); }, + isPresent => sub { return 1; }, + ); + push @tokens, $t; + } else { + &PKI::TPS::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 = defined($::pwdconf->get($tokenname)) ? $::pwdconf->get($tokenname) : ""; + if ($pwd ne "") { + &PKI::TPS::Wizard::debug_log("ModulePanel -> isLoggedIn retrieved pwd from pwdconf"); + return 1; + } + &PKI::TPS::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::TPS::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::TPS::Wizard::debug_log("ModulePanel -> getModules"); + $count = $::config->get("preop.configModules.count"); + &PKI::TPS::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::TPS::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::TPS::Wizard::debug_log("ModulePanel -> getModules: got module $cn from config"); + + my $module = $modutil->getmodule($cn); + my $file = $module->{detail}->{"Library file"}; + &PKI::TPS::Wizard::debug_log("ModulePanel -> getModules Library file = $file"); + my $found = 0; + if (defined $file) { + $found = ($file =~ /Internal ONLY module/) || -e $file; + } + + my $name = $module->{detail}->{Name}; +# PKI::TPS::Wizard::dbg("name: $name"); + + $supportedModules[$i] = new PKI::TPS::GlobalVar( + getImagePath => sub { return $img; }, + getUserFriendlyName => sub { return $pn; }, + isFound => sub { return $found; }, + getTokens => sub { return getTokens($name); }, + ); + + # login to tokens + &PKI::TPS::Wizard::debug_log("Ready to login to tokens for $name"); + my $mod = $modutil->getmodule($name); + foreach my $tokenname (keys %{$mod->{tokens}}) { + &PKI::TPS::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::TPS::Wizard::debug_log("ModulePanel -> getModules: found module $modname supported"); + # does not belong to "others" + } else { + &PKI::TPS::Wizard::debug_log("ModulePanel -> getModules: found module $modname unsupported"); + #add the module to "others" list + my $m = $modutil->getmodule($modname); + my $mod = new PKI::TPS::GlobalVar( + getImagePath => sub { return ""; }, + getUserFriendlyName => sub { return $m->{modulename}; }, + isFound => sub { return 1; }, + getTokens => sub { return getTokens($m->{detail}->{Name});} + ); + + push @otherModules, $mod; + + &PKI::TPS::Wizard::debug_log("ModulePanel -> getModules: module $modname added to otherModules list"); + } + } + + $::symbol{sms} = \@supportedModules; + $::symbol{oms} = \@otherModules; +# PKI::TPS::Wizard::dbg("oms: ". Dumper([@otherModules])); +# PKI::TPS::Wizard::dbg("sms: ". Dumper([@supportedModules])); + + &PKI::TPS::Wizard::debug_log("ModulePanel -> set sms, oms"); +} + +sub is_panel_done +{ + return $::config->get("preop.ModulePanel.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/Modutil.pm b/pki/base/tps/lib/perl/PKI/TPS/Modutil.pm new file mode 100755 index 000000000..49c248c2e --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/Modutil.pm @@ -0,0 +1,263 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + + +package PKI::TPS::Modutil; + + +sub new { + my $class = shift; + my ($dir) = @_; + + if (! $dir) { die "no module directory provided\n"; } + + my $self = {}; + + $self->{dir} = $dir; + $self->{modules} = makemodules($self); + + bless $self, $class; + return $self; +} + +sub exists { + my $self = shift; + + return -e "$self->{dir}/secmod.db"; +} + +sub create { + my $self = shift; + + my $mods = `modutil -force -dbdir '$self->{dir}' -nocertdb -create`; + return $mods; +} + +use Data::Dumper; + +sub makemodules { + my $self = shift; + my $modules = {}; + + my $mods = `modutil -force -dbdir '$self->{dir}' -nocertdb -list`; + #my $mods = join "",<::DATA>; + + #print "raw mods = $mods"; + + my (@modules) = ( + $mods =~ / + ^ #beginning of a line + \s+ #some spaces + \d+\.\s* #some digits + (.*?) #lots of text + ((?=^\s*\d+)|(?=------)) #if we would next match some spaces and digits + /msxg ); + + @modules = grep /.+/ms, @modules; + + foreach $module (@modules) { + #print "Module #$i:$module --\n"; + $module = "modulename:$module"; + my ($moduleheader, $rest) = ( + $module =~ / + (.*status: .*?\n) # moduleheader + (\s*slot:.*) # slot + (?=\n(\n|$)) #empty line + /msxg ); + #print "moduleheader: $moduleheader\n"; + my $m = makehash($moduleheader); + $modules->{$m->{modulename}} = $m; + $m->{tokens} = {}; + + my @tokens = split "\n\n", $rest; + + + +# get summary slot info with: -list + foreach my $token (@tokens) { + #print "slottext: $slot\n"; + my $slh = makehash($token); + $m->{tokens}->{$slh->{token}} = $slh; + } + +# get detailed slot info with: -list "modulename" + + my $moduledetail = `modutil -force -dbdir '$self->{dir}' -nocertdb -list "$m->{modulename}" 2> /dev/null`; + my @details= split "\n\n", $moduledetail; + while ($details[0] !~ /.*Name:.*/) { + shift @details; + }; + + $m->{detail} = makehash(shift @details); + foreach $d (@details) { + my $sdh = makehash($d); + my $tokenname = $sdh->{"Token Name"}; + $tokenname =~ s/\s+$//; # remove trailing spaces + if ($tokenname) { + $m->{tokens}->{$tokenname}->{detail} = $sdh; + } + } + $i++; + + } + return $modules; +} + +# input: a multi-list string with nv/pairs +# return a hashtable reference +sub makehash { + my $str = shift; + my $ht = { }; + my @lines = split "\n", $str; + my $line; +LINE: + foreach $line (@lines) { + if ($line =~ /Using database directory/) { next LINE; } + if ($line =~ /--------------/) { next LINE; } + my ($name, $value) = ($line =~ /^\s*(.*?):\s*(.*?)\s*$/); + if ($name) { + #print "name:$name\n"; + #print "value:$value\n"; + $ht->{$name} = $value; + } + } + return $ht; +} + +sub getmodules { + my $self = shift; + #print "modules: ".$self->{modules}. "\n"; + #print "keys: ".(join ",",keys %{$self->{modules}})."\n"; + return keys %{$self->{modules}}; +} + +sub getmodule { + my $self = shift; + my $modulename = shift; + + #print Dumper($self->{modules}); + return $self->{modules}->{$modulename}; +} + + +sub gettokens { + my $self = shift; + my $module = shift; + + return keys %{$module->{tokens}}; +} + +sub gettoken { + my $self = shift; + my $token= shift; + foreach my $m (values %{$self->{modules}}) { + foreach $t (values %{$m->{tokens}}) { + #print join ",", keys %{$t}; + #print Dumper($t->{detail}); + if ($t->{detail}->{"Token Name"} eq $token) { + return $t; + } + } + } +} + + + +package main; + +sub ::test { + +# initialize + my $modutil = new PKI::TPS::Modutil("."); + +#make database if it doesn't exist + if (! $modutil->exists()) { + $modutil->create(); + } + +#get an array of module names + my @mods = $modutil->getmodules(); + + print "Found ".@mods." pkcs#11 modules\n"; + +#for each module... + foreach my $modname (@mods) { + my $module = $modutil->getmodule($modname); + + print "Module: $modname\n"; + print "Library: ".$module->{detail}->{"Library file"}."\n"; + print "Other keys: ".(join ",", keys %{$module->{detail}})."\n"; + +#find all the tokens in a module, e.g. each partition for a lunasa + foreach my $tokenname ($modutil->gettokens($module)) { + print " token: $tokenname\n"; + my $token = $modutil->gettoken($tokenname); + +#dump out the information we have on the token + foreach my $key (keys %{$token}) { + print " token keys/values: $key: ".$token->{$key}."\n"; + } + my @detailkeys = (keys %{$token->{detail}}) ; + print " token detail keys:". (join ",", @detailkeys)."\n"; + print " token detail Manufacturer:". $token->{detail}->{Manufacturer}."\n"; + print "\n"; + } + print "\n"; + } + +} + +# this is where 'main' starts + +if ($ARGV[0] eq "--test") { + ::test(); +} + +1; + +__DATA__ +Listing of PKCS #11 Modules +----------------------------------------------------------- + 1. NSS Internal PKCS #11 Module + slots: 2 slots attached + status: loaded + + slot: NSS Internal Cryptographic Services + token: NSS Generic Crypto Services + + slot: NSS User Private Key and Certificate Services + token: NSS Certificate DB + + 2. lunasa + library name: /usr/lunasa/lib/libCryptoki2.so + slots: 2 slots attached + status: loaded + + slot: LunaNet Slot + token: lunasa1-ca + + slot: LunaNet Slot + token: lunasa2-ca +----------------------------------------------------------- + + diff --git a/pki/base/tps/lib/perl/PKI/TPS/NamePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/NamePanel.pm new file mode 100755 index 000000000..3513327a7 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/NamePanel.pm @@ -0,0 +1,605 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use FileHandle; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use PKI::TPS::CertInfo; +use URI::URL; +use URI::Escape; + +package PKI::TPS::NamePanel; +$PKI::TPS::NamePanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::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"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(12); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("NamePanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("NamePanel: update"); + my $instanceDir = $::config->get("service.instanceDir"); + + my $count = $q->param('urls'); + + &PKI::TPS::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::TPS::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::TPS::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::TPS::Wizard::certtags) { + &PKI::TPS::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::TPS::Wizard::debug_log("NamePanel: update nickname for $certtag set to $nickname"); + &PKI::TPS::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 = "TPS ".$certtag." cert"; + &PKI::TPS::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::TPS::Wizard::debug_log("NamePanel: update do not generate new keys"); + goto GEN_CERT; + } + &PKI::TPS::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::TPS::Wizard::debug_log("NamePanel: retrieving $tokenname from pwdconf"); + my $token_pwd = $::pwdconf->get($tokenname); + &PKI::TPS::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::TPS::Wizard::debug_log("NamePanel: update got keysize from config= $keysize changing to 256, the only supported ECC strength"); + $keysize = 256; + } + } + + &PKI::TPS::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::TPS::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::TPS::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::TPS::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::TPS::Wizard::debug_log("NamePanel: update External CA selected"); + if ($cert eq "") { + &PKI::TPS::Wizard::debug_log("NamePanel: update no cert found...need manual enrollment"); + } + } else { + if ($cert eq "") { + &PKI::TPS::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::TPS::Wizard::debug_log("NamePanel: update found existing request: $cert_request"); + } else { + &PKI::TPS::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::TPS::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::TPS::Wizard::debug_log("NamePanel: profileId=" . $profile_id); + my $requestor_name = "TPS-" . $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::TPS::Wizard::debug_log("debug_req = " . $debug_req); + my $content = `$req`; + &PKI::TPS::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::TPS::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::TPS::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::TPS::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::TPS::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::TPS::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 = "TPS ".$certtag." cert"; + &PKI::TPS::Wizard::debug_log("NamePanel: update nickname not found for $certtag -- try $nickname"); + } + + if ($certtag ne "sslserver") { + &PKI::TPS::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::TPS::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::TPS::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::TPS::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::TPS::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::TPS::Wizard::debug_log("NamePanel: update: done importing cert: $tk$nickname"); + $tmp = `rm $cert_fn`; + } + } + + # set selftest variables (always use the "latest" subsystem nickname) + my $selftestNickname = $::config->get( "preop.cert.subsystem.nickname" ); + my $selftestNickname_sslserver = $::config->get( "preop.cert.sslserver.nickname" ); + my $selftestNickname_audit_signing = $::config->get( "preop.cert.audit_signing.nickname" ); + if ($hw ne "") { + $::config->put( "selftests.plugin.TPSPresence.nickname", + "$tk$selftestNickname" ); + $::config->put( "selftests.plugin.TPSValidity.nickname", + "$tk$selftestNickname" ); + + $::config->put( "tps.cert.sslserver.nickname", + "$tk$selftestNickname_sslserver" ); + $::config->put( "tps.cert.subsystem.nickname", + "$tk$selftestNickname" ); + $::config->put( "tps.cert.audit_signing.nickname", + "$tk$selftestNickname_audit_signing" ); + } else { + $::config->put( "selftests.plugin.TPSPresence.nickname", + "$selftestNickname" ); + $::config->put( "selftests.plugin.TPSValidity.nickname", + "$selftestNickname" ); + + $::config->put( "tps.cert.sslserver.nickname", + "$selftestNickname_sslserver" ); + $::config->put( "tps.cert.subsystem.nickname", + "$selftestNickname" ); + $::config->put( "tps.cert.audit_signing.nickname", + "$selftestNickname_audit_signing" ); + } + $::config->commit(); + +DONE: + $::config->put("preop.namepanel.done", "true"); + $::config->commit(); + + &PKI::TPS::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::TPS::Wizard::debug_log("NamePanel: display"); + + my $domain_name = $::config->get("preop.securitydomain.name"); + if ($domain_name eq "") { + $domain_name = "TPS Domain"; + } + my $machine_name = $::config->get("service.machineName"); + my $instance_id = $::config->get("service.instanceID"); + + my $i = 0; + foreach my $certtag (@PKI::TPS::Wizard::certtags) { + &PKI::TPS::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=TPS Subsystem, " . + "OU=" . $instance_id . ", " . + "O=" . $domain_name; + } elsif ($certtag eq "sslserver") { + $cert_dn ="CN=" . $machine_name . ", " . + "OU=" . $instance_id . ", " . + "O=" . $domain_name; + } else { + &PKI::TPS::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::TPS::CertInfo($name, + $cert_dn, $certtag); + $::symbol{certs}[$i++] = $cert; + } + + &PKI::TPS::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; +} + +sub is_panel_done +{ + return $::config->get("preop.namepanel.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/ReqCertInfo.pm b/pki/base/tps/lib/perl/PKI/TPS/ReqCertInfo.pm new file mode 100755 index 000000000..f2faee2c7 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/ReqCertInfo.pm @@ -0,0 +1,234 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::ReqCertInfo; +$PKI::TPS::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::TPS::Wizard::debug_log("ReqCertInfo: start new"); + &PKI::TPS::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::TPS::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::TPS::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::TPS::Wizard::debug_log("ReqCertInfo: get_request"); + # first, try to see if request has been made before +# my $req = readFile( "/var/lib/pki-tps/conf/$self->{tag}_cert_request.txt"); + + my $req = $::config->get("preop.cert.$self->{tag}.certreq"); + + $req = wrap_lines($req); + + if ($req ne "") { + &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_request found existing request"); + return $cert_req_header."\n".$req."\n".$cert_req_footer;; + } else { + &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_request existing request not found"); + } + + return $req; +} + +sub get_cert +{ + my ($self) = @_; + &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert"); +# see if there is an existing cert +# my $cert = readFile("/var/lib/pki-tps/conf/".$self->{tag}."_cert.txt"); + my $cert = $::config->get("preop.cert.$self->{tag}.cert"); + + $cert = wrap_lines($cert); + if ($cert ne "") { + &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert found existing cert"); + return $cert_header."\n".$cert."\n".$cert_footer;; + } else { + &PKI::TPS::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::TPS::Wizard::debug_log("ReqCertInfo: get_cert_pp"); + my $instanceDir = $::config->get("service.instanceDir"); + + my $hw; + my $tokenname = $::config->get("preop.module.token"); + &PKI::TPS::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 = "TPS ".$self->{tag}." cert"; + &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert_pp nickname not found for $self->{tag} -- try $nickname"); + } + my $certpp=""; +# my $found = -e "/var/lib/pki-tps/conf/$self->{tag}_cert.txt"; + my $cert = $::config->get("preop.cert.$self->{tag}.cert"); + + if ($cert ne "") { + &PKI::TPS::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::TPS::Wizard::debug_log("ReqCertInfo: get_cert_pp pp=$certpp"); + $tmp =`rm $instanceDir/conf/$self->{tag}_cert_pp.txt`; + } else { + &PKI::TPS::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::TPS::Wizard::debug_log("ReqCertInfo: get_cert_tag"); + return $self->{tag}; +} + +sub get_dn +{ + my ($self) = @_; + &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert_dn"); + return $self->{dn}; +} + +sub use_default_key +{ + my ($self) = @_; + &PKI::TPS::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::TPS::Wizard::debug_log("ReqCertInfo: use_default_key from config = $select returning 0"); + return 0; + } + } + + &PKI::TPS::Wizard::debug_log("ReqCertInfo: use_default_key returning 1"); + return 1; +} + +sub get_custom_keysize +{ + my ($self) = @_; + &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_custom_keysize"); + my $keysize = $::config->get("preop.cert.$self->{tag}.keysize.customsize"); + if ($keysize ne "") { + &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_custom_keysize from config = $keysize"); + return $keysize; + } else { + &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_custom_keysize not from config"); + } + return 2048; +} + + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/SecurityDomainPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/SecurityDomainPanel.pm new file mode 100755 index 000000000..123e95b41 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/SecurityDomainPanel.pm @@ -0,0 +1,204 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use URI::URL; +use XML::Simple; +use Data::Dumper; + +package PKI::TPS::SecurityDomainPanel; +$PKI::TPS::SecurityDomainPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(1); + $self->{"getName"} = &PKI::TPS::Common::r("Security Domain"); + $self->{"vmfile"} = "securitydomainpanel.vm"; + $self->{"update"} = \&update; + $self->{"panelvars"} = \&display; + bless $self,$class; + return $self; +} + +sub validate +{ + my ($q) = @_; + &PKI::TPS::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::TPS::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 = "<security_domain_instance_name> "; + 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::TPS::Wizard::debug_log("SecurityPanel: update"); + my $sdomainURL = $q->param("sdomainURL"); + + if ($sdomainURL eq "") { + &PKI::TPS::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::TPS::Wizard::debug_log("SecurityPanel: sdomainURL not found"); + $::symbol{errorString} = "Security Domain HTTPS Admin URL not found"; + return 0; + } + + # save urls in CS.cfg + &PKI::TPS::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->put("preop.securitydomain.done", "true"); + $::config->commit(); + + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.securitydomain.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/SizePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/SizePanel.pm new file mode 100755 index 000000000..8ac49b68d --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/SizePanel.pm @@ -0,0 +1,249 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use PKI::TPS::CertInfo; + +package PKI::TPS::SizePanel; +$PKI::TPS::SizePanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(11); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("SizePanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("SizePanel: update"); + + my $instanceDir = $::config->get("service.instanceDir"); + my $done = $::config->get("preop.SizePanel.done"); + my $genKeyPair = $q->param('generateKeyPair') || ""; + &PKI::TPS::Wizard::debug_log("SizePanel: update generateKeyPair value=$genKeyPair"); + if ($done eq "true") { + if ($genKeyPair eq "") { + &PKI::TPS::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::TPS::Wizard::certtags) { + my $select = $q->param($certtag.'_choice'); + my $keytype = $q->param($certtag.'_keytype'); + my $size = $q->param($certtag.'_custom_size'); + + &PKI::TPS::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::TPS::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::TPS::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::TPS::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::TPS::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::TPS::Wizard::debug_log("SizePanel: display"); + + my $done = $::config->get("preop.SizePanel.done"); + &PKI::TPS::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 = "TPS Domain"; + } + + my $machine_name = $::config->get("service.machineName"); + my $instance_id = $::config->get("service.instanceID"); + + my $i = 0; + foreach my $certtag (@PKI::TPS::Wizard::certtags) { + my $cert_dn = $::config->get("preop.cert.".$certtag.".dn"); + if ($cert_dn eq "") { + if ($certtag eq "subsystem") { + $cert_dn = "CN=TPS 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::TPS::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::TPS::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; +} + +sub is_panel_done +{ + return $::config->get("preop.SizePanel.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/SubsystemTypePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/SubsystemTypePanel.pm new file mode 100755 index 000000000..793849332 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/SubsystemTypePanel.pm @@ -0,0 +1,147 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::SubsystemTypePanel; +$PKI::TPS::SubsystemTypePanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(3); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("SubsystemTypePanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("SubsystemTypePanel: update"); + $::symbol{systemname} = "Token Processing "; + $::symbol{subsystemName} = "Token Processing System"; + $::symbol{fullsystemname} = "Token Processing System "; + $::symbol{machineName} = "localhost"; + $::symbol{http_port} = "7888"; + $::symbol{https_port} = "7889"; + $::symbol{non_clientauth_https_port} = "7890"; + $::symbol{check_clonesubsystem} = " "; + $::symbol{check_newsubsystem} = " "; + $::symbol{disableClone} = 1; + + my $subsystemName = $q->param('subsystemName'); + $::config->put("preop.subsystem.name", $subsystemName); + $::config->put("preop.subsystemtype.done", "true"); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("SubsystemTypePanel: display"); + $::symbol{systemname} = "Token Processing "; + $::symbol{subsystemName} = "Token Processing System"; + $::symbol{fullsystemname} = "Token Processing System "; + + 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.tps$count.host") || ""; + if ($host eq "") { + goto DONE; + } + my $port = $::config->get("preop.securitydomain.tps$count.non_clientauth_secure_port"); + my $name = $::config->get("preop.securitydomain.tps$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; +} + +sub is_panel_done +{ + return $::config->get("preop.subsystemtype.done"); +} + + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/TKSInfoPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/TKSInfoPanel.pm new file mode 100755 index 000000000..720093ac5 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/TKSInfoPanel.pm @@ -0,0 +1,159 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; +use URI::URL; + +package PKI::TPS::TKSInfoPanel; +$PKI::TPS::TKSInfoPanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(5); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("TKSInfoPanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("TKSInfoPanel: update"); + + my $count = defined($q->param('urls')) ? $q->param('urls') : ""; + if ($count eq "") { + $::symbol{errorString} = "no TKS info provided. CA, TKS and optionally DRM must be installed prior to TPS installation"; + return 0; + } + &PKI::TPS::Wizard::debug_log("TKSInfoPanel: update - got urls = $count"); + + my $instanceID = $::config->get("service.instanceID"); + my $host = ""; + my $https_agent_port = ""; + my $https_admin_port = ""; + + if ($count =~ /http/) { + # this is for pkisilent + my $info = new URI::URL($count); + $host = defined($info->host) ? $info->host : ""; + $https_agent_port = defined($info->port) ? $info->port : ""; + $https_admin_port = defined($q->param('adminport')) ? $q->param('adminport') : ""; + } else { + $host = defined($::config->get("preop.securitydomain.tks$count.host")) ? + $::config->get("preop.securitydomain.tks$count.host") : ""; + $https_admin_port = defined($::config->get("preop.securitydomain.tks$count.secureadminport")) ? + $::config->get("preop.securitydomain.tks$count.secureadminport") : ""; + $https_agent_port = defined($::config->get("preop.securitydomain.tks$count.secureagentport")) ? + $::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 TPS installation"; + return 0; + } + + if ($https_admin_port eq "") { + if ($count =~ /http/) { + $::symbol{errorString} = "TKS admin port must be provided"; + } else { + $::symbol{errorString} = "TKS admin port not provided by security domain."; + } + return 0; + } + + my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname"); + $::config->put("preop.tksinfo.select", "https://$host:$https_admin_port"); + $::config->put("conn.tks1.clientNickname", $subsystemCertNickName); + $::config->put("conn.tks1.hostport", $host . ":" . $https_agent_port); + $::config->put("preop.tksinfo.done", "true"); + $::config->commit(); + + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("TKSInfoPanel: display"); + $::symbol{urls} = []; + my $count = 0; + while (1) { + my $host = ""; + $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 TPS installation"; + return 0; + } + + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.tksinfo.done"); +} + + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/WelcomePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/WelcomePanel.pm new file mode 100755 index 000000000..a1c77e7cd --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/WelcomePanel.pm @@ -0,0 +1,96 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +use strict; +use warnings; +use PKI::TPS::GlobalVar; +use PKI::TPS::Common; + +package PKI::TPS::WelcomePanel; +$PKI::TPS::WelcomePanel::VERSION = '1.00'; + +use PKI::TPS::BasePanel; +our @ISA = qw(PKI::TPS::BasePanel); + +sub new { + my $class = shift; + my $self = {}; + + $self->{"isSubPanel"} = \&is_sub_panel; + $self->{"hasSubPanel"} = \&has_sub_panel; + $self->{"isPanelDone"} = \&is_panel_done; + $self->{"getPanelNo"} = &PKI::TPS::Common::r(0); + $self->{"getName"} = &PKI::TPS::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::TPS::Wizard::debug_log("WelcomePanel: validate"); + return 1; +} + +sub update +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("WelcomePanel: update"); + $::config->put("preop.welcome.done", "true"); + $::config->commit(); + return 1; +} + +sub display +{ + my ($q) = @_; + &PKI::TPS::Wizard::debug_log("XXX " . $::config->get("logging.debug.enable")); + &PKI::TPS::Wizard::debug_log("WelcomePanel: display"); + $::symbol{wizardname} = "TPS Configuration Wizard"; + $::symbol{systemname} = "TPS"; + $::symbol{fullsystemname} = "Token Processing System"; + + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.welcome.done"); +} + +1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/wizard.pm b/pki/base/tps/lib/perl/PKI/TPS/wizard.pm new file mode 100755 index 000000000..db8b26526 --- /dev/null +++ b/pki/base/tps/lib/perl/PKI/TPS/wizard.pm @@ -0,0 +1,509 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This library is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public +# License as published by the Free Software Foundation; +# version 2.1 of the License. +# +# This library is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this library; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, +# Boston, MA 02110-1301 USA +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# + +# wizard - +# Fedora Certificate System - Token Processing 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 RHCS::TPS::Wizard +# PerlSetEnv RHCS_DOCROOT /u/sparkins/t/cs_tip/certsystem/prj/common/ui +# <Location /wizard> +# SetHandler perl-script +# PerlHandler RHCS::TPS::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::TPS::GlobalVar; +use PKI::TPS::WelcomePanel; +use PKI::TPS::SecurityDomainPanel; +use PKI::TPS::DisplayCertChainPanel; +use PKI::TPS::SubsystemTypePanel; +use PKI::TPS::CAInfoPanel; +use PKI::TPS::TKSInfoPanel; +use PKI::TPS::DRMInfoPanel; +use PKI::TPS::DisplayCertChain2Panel; +use PKI::TPS::AdminAuthPanel; +use PKI::TPS::AgentAuthPanel; +use PKI::TPS::AuthDBPanel; +use PKI::TPS::DatabasePanel; +use PKI::TPS::ModulePanel; +use PKI::TPS::SizePanel; +use PKI::TPS::NamePanel; +use PKI::TPS::ConfigHSMLoginPanel; +use PKI::TPS::CertRequestPanel; +use PKI::TPS::AdminPanel; +use PKI::TPS::ImportAdminCertPanel; +use PKI::TPS::DonePanel; +use PKI::TPS::Config; + +use PKI::TPS::Common qw(yes no r); + +package PKI::TPS::Wizard; +$PKI::TPS::Wizard::VERSION = '1.00'; + +# read configuration file +my $flavor = "pki"; +$flavor =~ s/\n//g; + +my $pkiroot = $ENV{PKI_ROOT}; + +my $config = PKI::TPS::Config->new(); +$config->load_file("$pkiroot/conf/CS.cfg"); +# read password cache file +my $pwdconf = PKI::TPS::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 $STATUS_OK = 0; # Apache 2 needs this to be zero +my $STATUS_ERROR = 2; +my $STATUS_REDIRECT = 3; + +&debug_log("TPS wizard: starting up"); + +my $docroot = $ENV{PKI_DOCROOT}; + +if (! $docroot) { + &debug_log("TPS wizard: ERROR: PKI_DOCROOT is null"); + return 0; +} + +our $parser = new Template::Velocity($docroot); +our $symbol; +our @certtags; + +makepanels(); + +&debug_log("TPS 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::TPS::WelcomePanel(); + my $securitydomain = new PKI::TPS::SecurityDomainPanel(); + my $displaycertchain = new PKI::TPS::DisplayCertChainPanel(); + my $subsystem = new PKI::TPS::SubsystemTypePanel(); + my $cainfopanel = new PKI::TPS::CAInfoPanel(); +# my $displaycertchain2 = new PKI::TPS::DisplayCertChain2Panel(); + my $tksinfopanel = new PKI::TPS::TKSInfoPanel(); + my $drminfopanel = new PKI::TPS::DRMInfoPanel(); + my $authdbpanel = new PKI::TPS::AuthDBPanel(); + my $databasepanel = new PKI::TPS::DatabasePanel(); + my $modulepanel = new PKI::TPS::ModulePanel(); + my $confighsmloginpanel = new PKI::TPS::ConfigHSMLoginPanel(); + my $sizepanel = new PKI::TPS::SizePanel(); + my $namepanel = new PKI::TPS::NamePanel(); + my $certrequestpanel = new PKI::TPS::CertRequestPanel(); + my $adminpanel = new PKI::TPS::AdminPanel(); + my $importadmincertpanel = new PKI::TPS::ImportAdminCertPanel(); + my $donepanel = new PKI::TPS::DonePanel(); + + $symbol{panels} = [ + $welcome, # com.netscape.cms.servlet.csadmin.WelcomePanel + $modulepanel, # com.netscape.cms.servlet.csadmin.ModulePanel + $confighsmloginpanel, # com.netscape.cms.servlet.csadmin.ConfigHSMLoginPanel + $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 + $tksinfopanel, # com.netscape.cms.servlet.csadmin.TKSInfoPanel + $drminfopanel, # com.netscape.cms.servlet.csadmin.DRMInfoPanel + $authdbpanel, # com.netscape.cms.servlet.csadmin.DatabasePanel + $databasepanel, # com.netscape.cms.servlet.csadmin.DatabasePanel + $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("TPS wizard: update returns status '" . + $status . "'"); + if ($status == $STATUS_REDIRECT) { + return $STATUS_REDIRECT; + } + + } + + &debug_log("TPS wizard: about to find out about sub panel"); + if ($status eq "1") { + if ($currentpanel->{hasSubPanel} && &{$currentpanel->{hasSubPanel}}($q)) { + &debug_log("TPS wizard: has sub panel"); + $panelnum = $panelnum + 2; + } elsif ($currentpanel->{isSubPanel} && &{$currentpanel->{isSubPanel}}($q)) { + &debug_log("TPS wizard: is sub panel"); + $panelnum = $panelnum - 1; + } else { + &debug_log("TPS 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("TPS 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("TPS wizard: update returns status '" . + $status . "'"); + if ($status == $STATUS_REDIRECT) { + return $STATUS_REDIRECT; + } + + } + } + + &debug_log("TPS 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} = "tps/admin/console/config/".$currentpanel->{vmfile}; + + #wizard.vm: + $symbol{name} = "Token Processing System"; + $symbol{title} = $currentpanel->{getName}(); + if ($panelnum == 0) { + $symbol{firstpanel} = "1"; + } else { + $symbol{firstpanel} = "0"; + } + if ($panelnum == 16) { + $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} = "tps"; +# $symbol{errorString} = ""; + + #modulepanel +# $symbol{certs} = [ ]; +# $symbol{reqscerts} = [ ]; + $symbol{ppcerts} = [ ]; + + return $STATUS_OK; +} + + + +sub dbg { + my $msg = shift; + $::symbol{dbg} .= "$msg\n"; +} + +sub handler { + my $r = shift; + + *::symbol = \%symbol; + *::s = \$s; + *::config = \$config; + *::pwdconf = \$pwdconf; + + &debug_log("TPS wizard: in handler"); + if ($#ARGV == -1) { + $r->send_http_header('text/html'); + } + + 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("TPS 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("TPS wizard: http parameter name='" . $pn . "' value='(sensitive)'"); + } else { + &debug_log("TPS 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("TPS wizard: before argparsing"); + if ($#ARGV == -1) { + $Data::Dumper::Maxdepth = 7; + $startfile = "tps/admin/console/config/wizard.vm"; + } + + &debug_log("TPS 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("TPS 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("TPS wizard: executing file $startfile"); + foreach $q (sort keys %symbol) { + &debug_log("TPS 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"); + } + } + + print "$result\n"; + return $STATUS_OK; +} + +sub escape_xml +{ + my ($v) = @_; + $v =~ s/\"/"/g; + $v =~ s/\'/'/g; + $v =~ s/\&/&/g; + $v =~ s/</</g; + $v =~ s/>/>/g; + return $v; +} + +sub get_xml +{ + my ($s, $v) = @_; + + my $result; + if (ref($v) eq "HASH") { + foreach my $xkey (keys %$v) { + $result .= "<" . $xkey . ">"; + $result .= &get_xml($xkey, $v{$xkey}); + # $result .= "-" . ref($xkey); + $result .= "</" . $xkey . ">"; + } + } elsif (ref($v) eq "PKI::TPS::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::TPS::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; |