From 621d9e5c413e561293d7484b93882d985b3fe15f Mon Sep 17 00:00:00 2001 From: Endi Sukma Dewata Date: Sat, 24 Mar 2012 02:27:47 -0500 Subject: Removed unnecessary pki folder. Previously the source code was located inside a pki folder. This folder was created during svn migration and is no longer needed. This folder has now been removed and the contents have been moved up one level. Ticket #131 --- base/tps/lib/perl/PKI/Base/Conf.pm | 130 +++ base/tps/lib/perl/PKI/Base/Registry.pm | 55 + base/tps/lib/perl/PKI/Service/Op.pm | 127 +++ base/tps/lib/perl/PKI/TPS/AdminAuthPanel.pm | 93 ++ base/tps/lib/perl/PKI/TPS/AdminPanel.pm | 234 +++++ base/tps/lib/perl/PKI/TPS/AgentAuthPanel.pm | 91 ++ base/tps/lib/perl/PKI/TPS/AuthDBPanel.pm | 172 ++++ base/tps/lib/perl/PKI/TPS/BasePanel.pm | 39 + base/tps/lib/perl/PKI/TPS/CAInfoPanel.pm | 315 ++++++ base/tps/lib/perl/PKI/TPS/CertInfo.pm | 132 +++ base/tps/lib/perl/PKI/TPS/CertPrettyPrintPanel.pm | 91 ++ base/tps/lib/perl/PKI/TPS/CertRequestPanel.pm | 306 ++++++ base/tps/lib/perl/PKI/TPS/Common.pm | 148 +++ base/tps/lib/perl/PKI/TPS/Config.pm | 169 ++++ base/tps/lib/perl/PKI/TPS/ConfigHSMLoginPanel.pm | 112 +++ base/tps/lib/perl/PKI/TPS/ConfigHSMPanel.pm | 78 ++ base/tps/lib/perl/PKI/TPS/DRMInfoPanel.pm | 180 ++++ base/tps/lib/perl/PKI/TPS/DatabasePanel.pm | 277 ++++++ .../tps/lib/perl/PKI/TPS/DisplayCertChain2Panel.pm | 186 ++++ base/tps/lib/perl/PKI/TPS/DisplayCertChainPanel.pm | 355 +++++++ base/tps/lib/perl/PKI/TPS/DonePanel.pm | 437 ++++++++ base/tps/lib/perl/PKI/TPS/GlobalVar.pm | 41 + base/tps/lib/perl/PKI/TPS/ImportAdminCertPanel.pm | 163 +++ base/tps/lib/perl/PKI/TPS/Login.pm | 466 +++++++++ base/tps/lib/perl/PKI/TPS/LoginPanel.pm | 98 ++ base/tps/lib/perl/PKI/TPS/ModulePanel.pm | 278 ++++++ base/tps/lib/perl/PKI/TPS/Modutil.pm | 263 +++++ base/tps/lib/perl/PKI/TPS/NamePanel.pm | 611 ++++++++++++ base/tps/lib/perl/PKI/TPS/ReqCertInfo.pm | 234 +++++ base/tps/lib/perl/PKI/TPS/SecurityDomainPanel.pm | 204 ++++ base/tps/lib/perl/PKI/TPS/SizePanel.pm | 249 +++++ base/tps/lib/perl/PKI/TPS/SubsystemTypePanel.pm | 147 +++ base/tps/lib/perl/PKI/TPS/TKSInfoPanel.pm | 159 +++ base/tps/lib/perl/PKI/TPS/WelcomePanel.pm | 96 ++ base/tps/lib/perl/PKI/TPS/wizard.pm | 509 ++++++++++ base/tps/lib/perl/Template/Velocity.pm | 1052 ++++++++++++++++++++ 36 files changed, 8297 insertions(+) create mode 100755 base/tps/lib/perl/PKI/Base/Conf.pm create mode 100755 base/tps/lib/perl/PKI/Base/Registry.pm create mode 100755 base/tps/lib/perl/PKI/Service/Op.pm create mode 100755 base/tps/lib/perl/PKI/TPS/AdminAuthPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/AdminPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/AgentAuthPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/AuthDBPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/BasePanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/CAInfoPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/CertInfo.pm create mode 100755 base/tps/lib/perl/PKI/TPS/CertPrettyPrintPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/CertRequestPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/Common.pm create mode 100755 base/tps/lib/perl/PKI/TPS/Config.pm create mode 100755 base/tps/lib/perl/PKI/TPS/ConfigHSMLoginPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/ConfigHSMPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/DRMInfoPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/DatabasePanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/DisplayCertChain2Panel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/DisplayCertChainPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/DonePanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/GlobalVar.pm create mode 100755 base/tps/lib/perl/PKI/TPS/ImportAdminCertPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/Login.pm create mode 100755 base/tps/lib/perl/PKI/TPS/LoginPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/ModulePanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/Modutil.pm create mode 100755 base/tps/lib/perl/PKI/TPS/NamePanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/ReqCertInfo.pm create mode 100755 base/tps/lib/perl/PKI/TPS/SecurityDomainPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/SizePanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/SubsystemTypePanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/TKSInfoPanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/WelcomePanel.pm create mode 100755 base/tps/lib/perl/PKI/TPS/wizard.pm create mode 100755 base/tps/lib/perl/Template/Velocity.pm (limited to 'base/tps/lib/perl') diff --git a/base/tps/lib/perl/PKI/Base/Conf.pm b/base/tps/lib/perl/PKI/Base/Conf.pm new file mode 100755 index 000000000..895ab28a3 --- /dev/null +++ b/base/tps/lib/perl/PKI/Base/Conf.pm @@ -0,0 +1,130 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; version 2 of the License. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# +# +# +# + +package PKI::Base::Conf; + +use strict; +use warnings; +use Exporter; + +$PKI::Base::Conf::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 () { + 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 commit +{ + my ($self) = @_; + + # write stuff back to the file +# print $self->{filename} . "\n"; + my $hash = $self->{hash}; + my $suffix = time(); + + if (-e $self->{filename}) { + system("mv \"" . $self->{filename} . "\" \"" . + $self->{filename} . "." . $suffix . "\""); + } + + open(F, ">" . $self->{filename}); + foreach my $k (sort keys %{$hash}) { + print F "$k=$self->{hash}{$k}\n"; + } + close(F); + + if (-e $self->{filename} . "." . $suffix) { + system("rm \"" . $self->{filename} . "." . $suffix . "\""); + } +} + +sub commit_with_backup +{ + my ($self) = @_; + + # write stuff back to the file +# print $self->{filename} . "\n"; + my $hash = $self->{hash}; + my $suffix = time(); + system("mv \"" . $self->{filename} . "\" \"" . + $self->{filename} . "." . $suffix . "\""); + + open(F, ">" . $self->{filename}); + foreach my $k (sort keys %{$hash}) { + print F "$k=$self->{hash}{$k}\n"; + } + close(F); +} + +1; diff --git a/base/tps/lib/perl/PKI/Base/Registry.pm b/base/tps/lib/perl/PKI/Base/Registry.pm new file mode 100755 index 000000000..a4fb83f28 --- /dev/null +++ b/base/tps/lib/perl/PKI/Base/Registry.pm @@ -0,0 +1,55 @@ +#!/usr/bin/perl +# +# --- BEGIN COPYRIGHT BLOCK --- +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; version 2 of the License. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# +# +# +# +package PKI::Base::Registry; + +use PKI::Base::Conf; + +my $docroot; +my $cfg; +my $parser; + +BEGIN { + $docroot = $ENV{DOCUMENT_ROOT}; + $cfg = PKI::Base::Conf->new(); + $cfg->load_file("$docroot/../conf/CS.cfg"); + $parser = new Template::Velocity($docroot); + +} + +sub get_docroot { + my ($self) = @_; + return $docroot; +} + +sub get_parser { + my ($self) = @_; + return $parser; +} + +sub get_config { + my ($self) = @_; + return $cfg; +} + +1; diff --git a/base/tps/lib/perl/PKI/Service/Op.pm b/base/tps/lib/perl/PKI/Service/Op.pm new file mode 100755 index 000000000..9e2a63d4f --- /dev/null +++ b/base/tps/lib/perl/PKI/Service/Op.pm @@ -0,0 +1,127 @@ +# +# --- BEGIN COPYRIGHT BLOCK --- +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; version 2 of the License. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# +# Copyright (C) 2007 Red Hat, Inc. +# All rights reserved. +# --- END COPYRIGHT BLOCK --- +# +# +# +# + +package PKI::Service::Op; + +sub new { + my $self = {}; + bless ($self); + return $self; +} + +sub debug_log() +{ + my ($self, $cfg, $msg) = @_; + + my $date = `date`; + chomp($date); + open(DEBUG, ">>" . $cfg->get("logging.debug.filename")); + print DEBUG "$date - $msg\n"; + close(DEBUG); +} + +sub debug_params() +{ + my ($self, $cfg, $q) = @_; + + my $date = `date`; + chomp($date); + $self->debug_log($cfg, "$date - URL '" . $ENV{REQUEST_URI} . "'"); + my @names = $q->param(); + foreach my $k (@names) { + $self->debug_log($cfg, "$date - Param $k='" . $q->param($k) . "'"); + } +} + +sub process { + my ($self) = @_; +} + +sub escape_xml +{ + my ($v) = @_; + $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 .= ""; + } + } elsif (ref($v) eq "PKI::RA::GlobalVar") { + foreach my $xkey (keys %$v) { + $result .= "<" . $xkey . ">"; + $result .= &get_xml($xkey, $$v{$xkey}->()); + # $result .= "-" . ref($xkey); + $result .= ""; + } + } elsif (ref($v) eq "ARRAY") { + my $pos = 0; + foreach my $item (@$v) { + $result .= ""; + $result .= &get_xml("p" . $pos, $item); + # $result .= "-" . ref($item); + $result .= ""; + $pos++; + } + } else { + $result .= &escape_xml($v); + } + return $result; +} + +sub xml_output { + my ($self, $c) = @_; + + my $result = ""; + foreach $s (sort keys %$c) { + if ($s =~ /^__/) { + next; + } + $result .= "<" . $s . ">"; + my $v = $$c{$s}; + $result .= &get_xml($s, $v); + $result .= ""; + } + $result .= ""; + return "$result\n"; +} + +sub execute { + my ($self) = @_; + $self->process(); +} + +1; diff --git a/base/tps/lib/perl/PKI/TPS/AdminAuthPanel.pm b/base/tps/lib/perl/PKI/TPS/AdminAuthPanel.pm new file mode 100755 index 000000000..caaf6c65f --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/AdminPanel.pm b/base/tps/lib/perl/PKI/TPS/AdminPanel.pm new file mode 100755 index 000000000..d62d611be --- /dev/null +++ b/base/tps/lib/perl/PKI/TPS/AdminPanel.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; +use URI::URL; +use URI::Escape; +use Mozilla::LDAP::Conn; + +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 $certdir = "$instanceDir/alias"; + + 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\>)/; + $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 $hostport = $::config->get("auth.instance.1.hostport"); + my ($ldap_host, $ldap_port) = split(/:/, $hostport); + my $secureconn = $::config->get("auth.instance.1.ssl"); + 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 $conn = PKI::TPS::Common::make_connection( + {host => $ldap_host, port => $ldap_port, pswd => $bindpwd, bind => $binddn, cert => $certdir}, + $secureconn); + + if (!$conn) { + &PKI::TPS::Wizard::debug_log("AdminPanel: Failed to connect to the internal database"); + $::symbol{errorString} = "Failed to connect to the internal database"; + return 0; + }; + + my $msg; + $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"); + if (! &PKI::TPS::Common::import_ldif($conn, $tmp, \$msg)) { + &PKI::TPS::Wizard::debug_log("AdminPanel: $msg"); + $::symbol{errorString} = "Failed to add agents to database"; + $conn->close(); + return 0; + }; + if ($msg ne "") { + &PKI::TPS::Wizard::debug_log("AdminPanel: adding agents errors : $msg"); + } + 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/base/tps/lib/perl/PKI/TPS/AgentAuthPanel.pm b/base/tps/lib/perl/PKI/TPS/AgentAuthPanel.pm new file mode 100755 index 000000000..a5130caa1 --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/AuthDBPanel.pm b/base/tps/lib/perl/PKI/TPS/AuthDBPanel.pm new file mode 100755 index 000000000..2b189cd0c --- /dev/null +++ b/base/tps/lib/perl/PKI/TPS/AuthDBPanel.pm @@ -0,0 +1,172 @@ +#!/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 Mozilla::LDAP::Conn; + +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'); + my $secureconn = $q->param('secureConn') || "false"; + my $instDir = $::config->get("service.instanceDir"); + my $certdir = "$instDir/alias"; + + &PKI::TPS::Wizard::debug_log("AuthDBPanel: host=" . $host); + &PKI::TPS::Wizard::debug_log("AuthDBPanel: port=" . $port); + &PKI::TPS::Wizard::debug_log("AuthDBPanel: basedn=" . $basedn); + &PKI::TPS::Wizard::debug_log("AuthDBPanel: secureconn=" . $secureconn); + + if (!($port =~ /^[0-9]+$/)) { + &PKI::TPS::Wizard::debug_log("AuthDBPanel: bad port " . $port); + $::symbol{errorString} = "Bad Port"; + return 0; + } + + # try to make a connection + # we need to test the ldaps connection first because testing an ldaps port with ldap:// will hang the query! + my $msg; + + my $conn = &PKI::TPS::Common::test_and_make_connection({host => $host, port => $port, cert => $certdir}, $secureconn, \$msg); + if (! $conn) { + &PKI::TPS::Wizard::debug_log("AuthDBPanel: failed to connect to auth db: $msg"); + $::symbol{errorString} = $msg; + return 0; + }; + + my $entry = $conn->search($basedn, "base", "objectclass=*", 0); + if (! $entry) { + &PKI::TPS::Wizard::debug_log("AuthDBPanel: search for basedn failed: " . $conn->getErrorString()); + $::symbol{errorString} = "Search for base DN failed. Does the base DN exist?"; + $conn->close(); + return 0; + } + + &PKI::TPS::Wizard::debug_log("AuthDBPanel: auth database looks ok"); + + $conn->close(); + + # save values to CS.cfg + $::config->put("auth.instance.0.baseDN", $basedn); + $::config->put("auth.instance.0.hostport", $host . ":" . $port); + $::config->put("auth.instance.0.ssl", $secureconn); + $::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; + } + + my $secureconn = $::config->get("auth.instance.0.ssl") || "false"; + $::symbol{hostname} = $host; + $::symbol{portStr} = $port; + $::symbol{basedn} = $basedn; + $::symbol{secureconn}=$secureconn; + + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.authdb.done"); +} + +1; diff --git a/base/tps/lib/perl/PKI/TPS/BasePanel.pm b/base/tps/lib/perl/PKI/TPS/BasePanel.pm new file mode 100755 index 000000000..eecf99ff5 --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/CAInfoPanel.pm b/base/tps/lib/perl/PKI/TPS/CAInfoPanel.pm new file mode 100755 index 000000000..27d0a0048 --- /dev/null +++ b/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\>/) { + $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 -r \"/ca/admin/ca/getDomainXML\" $sd_host:$sd_admin_port`; + + $content =~ /(\.*\<\/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/base/tps/lib/perl/PKI/TPS/CertInfo.pm b/base/tps/lib/perl/PKI/TPS/CertInfo.pm new file mode 100755 index 000000000..da5377d4f --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/CertPrettyPrintPanel.pm b/base/tps/lib/perl/PKI/TPS/CertPrettyPrintPanel.pm new file mode 100755 index 000000000..200ef8d74 --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/CertRequestPanel.pm b/base/tps/lib/perl/PKI/TPS/CertRequestPanel.pm new file mode 100755 index 000000000..fb5d9ccda --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/Common.pm b/base/tps/lib/perl/PKI/TPS/Common.pm new file mode 100755 index 000000000..c66942599 --- /dev/null +++ b/base/tps/lib/perl/PKI/TPS/Common.pm @@ -0,0 +1,148 @@ +#!/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 Mozilla::LDAP::Conn; +use Mozilla::LDAP::LDIF; + +use vars qw(@ISA @EXPORT @EXPORT_OK); +@ISA = qw(Exporter Autoloader); +@EXPORT = qw(r yes no import_ldif test_and_make_connection make_connection); + +$PKI::TPS::Common::VERSION = '1.00'; + +sub yes { + return sub {1}; +} + +sub no { + return sub {0}; +} + +sub r { + my $a = shift; + return sub { $a; } +} + +# special function to add schema elements. This assumes the entry +# is ldif update format with changetype "modify" and operation "add" +# +sub add_schema_update +{ + my ($conn, $aentry, $err_ref) = @_; + + my $sentry = $conn->search($aentry->{dn}, "base", "(objectclass=*)", 0, ("*", "aci")); + if (!$sentry) { + $$err_ref .= "Error: trying to update entry that does not exist: " . $aentry->{dn} . "\n"; + return 0; + } + + my @addtypes = ("attributeTypes", "objectClasses"); + + foreach my $attr (@addtypes) { + my @vals = $aentry->getValues($attr); + push @vals, $vals[0]; # HACK! for some reason, first value always fails with server unwilling to perform + + foreach my $val (@vals) { + $sentry->addValue( $attr, $val ); + $conn->update($sentry); + my $rc = $conn->getErrorCode(); + if ( $rc != 0 ) { + my $string = $conn->getErrorString(); + $$err_ref .= "Error: updating entry " . $sentry->{dn} . " with value $val : $string\n"; + } else { + $$err_ref .= "Updated entry ". $sentry->{dn} . " with value $val : rc = $rc\n"; + } + } + } + return 1; +} + +sub import_ldif +{ + my ($conn, $ldif_file, $msg_ref, $schema) = @_; + + if (!open( MYLDIF, "$ldif_file" )) { + $$msg_ref = "Could not open $ldif_file: $!\n"; + return 0; + } + + my $in = new Mozilla::LDAP::LDIF(*MYLDIF); + while (my $entry = readOneEntry $in) { + if (defined($schema) && ($schema == 1)) { + add_schema_update($conn, $entry, $msg_ref); + } else { + if (!$conn->add($entry)) { + $$msg_ref .= "Error: could not add entry " . $entry->getDN() . ":" . $conn->getErrorString() . "\n"; + } + } + } + close( MYLDIF ); + return 1; +} + +# this subroutine checks if an ldaps connection is successful first +# and then if an ldap connection is successful. +# This prevents a hanging condition when someone tries to connect to a ldaps +# port using LDAP +# +# The arg hash is assumed to have the certdir (key == cert) defined. + +sub test_and_make_connection +{ + my ($arg_ref, $secureconn, $msg_ref) = @_; + my $conn = new Mozilla::LDAP::Conn($arg_ref); + if ($conn) { #ldaps succeeds + if ($secureconn eq "false") { + $$msg_ref = "SSL not selected, but this looks like an SSL port."; + return undef; + } + } else { #ldaps failed + if ($secureconn eq "true") { + $$msg_ref = "Failed to connect to LDAPS port"; + return undef; + } + delete $arg_ref->{cert}; + $conn = new Mozilla::LDAP::Conn($arg_ref); + if (!$conn) { # ldap failed + $$msg_ref = "Failed to connect to LDAP port:"; + return undef; + } + } + return $conn; +} + +sub make_connection +{ + my ($arg_ref, $secureconn) = @_; + if ($secureconn eq "false") { + delete $arg_ref->{cert}; + } + return new Mozilla::LDAP::Conn($arg_ref); +} + +1; diff --git a/base/tps/lib/perl/PKI/TPS/Config.pm b/base/tps/lib/perl/PKI/TPS/Config.pm new file mode 100755 index 000000000..7195dccd9 --- /dev/null +++ b/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 () { + 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/base/tps/lib/perl/PKI/TPS/ConfigHSMLoginPanel.pm b/base/tps/lib/perl/PKI/TPS/ConfigHSMLoginPanel.pm new file mode 100755 index 000000000..5d36d3da3 --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/ConfigHSMPanel.pm b/base/tps/lib/perl/PKI/TPS/ConfigHSMPanel.pm new file mode 100755 index 000000000..06697a8c7 --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/DRMInfoPanel.pm b/base/tps/lib/perl/PKI/TPS/DRMInfoPanel.pm new file mode 100755 index 000000000..1ccef670d --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/DatabasePanel.pm b/base/tps/lib/perl/PKI/TPS/DatabasePanel.pm new file mode 100755 index 000000000..d8fee06e8 --- /dev/null +++ b/base/tps/lib/perl/PKI/TPS/DatabasePanel.pm @@ -0,0 +1,277 @@ +#!/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 Mozilla::LDAP::Conn; + +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 $certdir = "$instDir/alias"; + + 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'); + my $secureconn = $q->param('secureConn') || "false"; + + &PKI::TPS::Wizard::debug_log("DatabasePanel: host=$host port=$port basedn=$basedn"); + &PKI::TPS::Wizard::debug_log("DatabasePanel: database=$database binddn=$binddn"); + &PKI::TPS::Wizard::debug_log("DatabasePanel: secureconn=$secureconn"); + + # try to make a connection + # we need to test the ldaps connection first because testing an ldaps port with ldap:// will hang the query! + my $msg; + my $conn = &PKI::TPS::Common::test_and_make_connection( + {host => $host, port => $port, cert => $certdir, bind => $binddn, pswd => $bindpwd}, + $secureconn, + \$msg); + + if (!$conn) { + &PKI::TPS::Wizard::debug_log("DatabasePanel: failed to connect to internal db: $msg"); + $::symbol{errorString} = $msg; + return 0; + } + + # 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("tokendb.ssl", $secureconn); + $::config->put("auth.instance.1.hostport", $host . ":" . $port); + $::config->put("auth.instance.1.baseDN", $basedn); + $::config->put("auth.instance.1.ssl", $secureconn); + $::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); + } + + 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; + + # 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"); + if (! &PKI::TPS::Common::import_ldif($conn, $tmp, \$msg)) { + &PKI::TPS::Wizard::debug_log("DatabasePanel: $msg"); + $::symbol{errorString} = "Failed to create database"; + $conn->close(); + return 0; + }; + if ($msg ne "") { + &PKI::TPS::Wizard::debug_log("DatabasePanel: database creation errors : $msg"); + $msg=""; + } + system("rm $tmp"); + + # add schema + if (! &PKI::TPS::Common::import_ldif($conn, "/usr/share/$flavor/tps/scripts/schemaMods.ldif", \$msg, 1)) { + &PKI::TPS::Wizard::debug_log("DatabasePanel: $msg"); + $::symbol{errorString} = "Failed to add schema"; + $conn->close(); + return 0; + }; + if ($msg ne "") { + &PKI::TPS::Wizard::debug_log("DatabasePanel: schema creation errors : $msg"); + $msg=""; + } + + # populate database + $tmp = "/tmp/addTokens-$$.ldif"; + system("sed -e 's/\$TOKENDB_ROOT/$basedn/g' " . + "/usr/share/$flavor/tps/scripts/addTokens.ldif > $tmp"); + if (! &PKI::TPS::Common::import_ldif($conn, $tmp, \$msg)) { + &PKI::TPS::Wizard::debug_log("DatabasePanel: $msg"); + $::symbol{errorString} = "Failed to populate database"; + $conn->close(); + return 0; + }; + if ($msg ne "") { + &PKI::TPS::Wizard::debug_log("DatabasePanel: database population errors : $msg"); + $msg=""; + } + 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"); + if (! &PKI::TPS::Common::import_ldif($conn, $tmp, \$msg)) { + &PKI::TPS::Wizard::debug_log("DatabasePanel: $msg"); + $::symbol{errorString} = "Failed to add indexes"; + $conn->close(); + return 0; + }; + if ($msg ne "") { + &PKI::TPS::Wizard::debug_log("DatabasePanel: adding index errors : $msg"); + $msg=""; + } + 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"); + if (! &PKI::TPS::Common::import_ldif($conn, $tmp, \$msg)) { + &PKI::TPS::Wizard::debug_log("DatabasePanel: $msg"); + $::symbol{errorString} = "Failed to add vlv indexes"; + $conn->close(); + return 0; + }; + if ($msg ne "") { + &PKI::TPS::Wizard::debug_log("DatabasePanel: adding VLV index errors : $msg"); + $msg=""; + } + system("rm $tmp"); + + $conn->close(); + + $::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; + } + + my $secureconn = $::config->get("auth.instance.1.ssl") || "false"; + $::symbol{secureconn} = $secureconn; + + $::symbol{bindpwd} = ""; + + return 1; +} + +sub is_panel_done +{ + return $::config->get("preop.database.done"); +} + + +1; diff --git a/base/tps/lib/perl/PKI/TPS/DisplayCertChain2Panel.pm b/base/tps/lib/perl/PKI/TPS/DisplayCertChain2Panel.pm new file mode 100755 index 000000000..3a86ab0bd --- /dev/null +++ b/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 "",; + 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/base/tps/lib/perl/PKI/TPS/DisplayCertChainPanel.pm b/base/tps/lib/perl/PKI/TPS/DisplayCertChainPanel.pm new file mode 100755 index 000000000..68b64a4b5 --- /dev/null +++ b/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 "",; + 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 -r \"/ca/admin/ca/getCertChain\" $sd_host:$sd_admin_port`; + + my $caCert = ""; + if ($cmd =~ /\(.*)\<\/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 -r \"/ca/admin/ca/getDomainXML\" $sd_host:$sd_admin_port`; + + $content =~ /(\.*\<\/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/base/tps/lib/perl/PKI/TPS/DonePanel.pm b/base/tps/lib/perl/PKI/TPS/DonePanel.pm new file mode 100755 index 000000000..3d897fca9 --- /dev/null +++ b/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\>)/; + $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 -r \"/kra/admin/kra/getTransportCert\" $host:$port > $tmpfile"); + } else { + system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -r \"/kra/admin/kra/getTransportCert\" $host:$port > $tmpfile"); + } + my $content = `cat $tmpfile`; + system("rm $tmpfile"); + + $content =~ /(\.*\<\/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 -r \"/tks/admin/tks/importTransportCert\" $host:$port > $tmpfile"); + } else { + system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -r \"/tks/admin/tks/importTransportCert\" $host:$port > $tmpfile"); + } + + my $content = `cat $tmpfile`; + system("rm $tmpfile"); + + $content =~ /(\.*\<\/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 () { + 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 () { + 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/base/tps/lib/perl/PKI/TPS/GlobalVar.pm b/base/tps/lib/perl/PKI/TPS/GlobalVar.pm new file mode 100755 index 000000000..73e7b831a --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/ImportAdminCertPanel.pm b/base/tps/lib/perl/PKI/TPS/ImportAdminCertPanel.pm new file mode 100755 index 000000000..dfec6ea80 --- /dev/null +++ b/base/tps/lib/perl/PKI/TPS/ImportAdminCertPanel.pm @@ -0,0 +1,163 @@ +#!/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 $tokenname = $::config->get("preop.module.token"); + my $token_pwd = $::pwdconf->get($tokenname); + 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; + if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { + $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`; + } else { + $cmd = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$token_pwd\" -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; + if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { + $content = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -r \"/ca/admin/ca/getDomainXML\" $sd_host:$sd_admin_port`; + } else { + $content = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -r \"/ca/admin/ca/getDomainXML\" $sd_host:$sd_admin_port`; + } + $content =~ /(\.*\<\/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/base/tps/lib/perl/PKI/TPS/Login.pm b/base/tps/lib/perl/PKI/TPS/Login.pm new file mode 100755 index 000000000..01aa01f42 --- /dev/null +++ b/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 +# +# SetHandler perl-script +# PerlHandler RHCS::TPS::Wizard +# Order deny,allow +# Allow from all +# + + +# 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 = ""; + foreach $s (sort keys %symbol) { + if ($s =~ /^__/) { + next; + } + $result .= "<" . $s . ">"; + my $v = $symbol{$s}; + $result .= &get_xml($s, $v); + $result .= ""; + } + $result .= ""; + } 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 .= ""; + } + } elsif (ref($v) eq "PKI::TPS::CertInfo") { + my $certinfo = $v; + $result .= ""; + $result .= "" . $certinfo->get_dn() .""; + $result .= "" . $certinfo->get_cert_tag() . ""; + $result .= "" . $certinfo->get_user_friendly_name() . + ""; + $result .= ""; + } elsif (ref($v) eq "PKI::TPS::ReqCertInfo") { + my $reqcertinfo = $v; + $result .= ""; + $result .= "" . $reqcertinfo->get_user_friendly_name() .""; + $result .= "" . $reqcertinfo->get_request() .""; + $result .= "" . $reqcertinfo->get_cert() .""; + $result .= "" . $reqcertinfo->get_cert_pp() .""; + $result .= "" . $reqcertinfo->get_cert_tag() .""; + $result .= "" . $reqcertinfo->get_cert_tag() .""; + $result .= ""; + } elsif (ref($v) eq "ARRAY") { + my $pos = 0; + foreach my $item (@$v) { + $result .= ""; + $result .= &get_xml("p" . $pos, $item); + # $result .= "-" . ref($item); + $result .= ""; + $pos++; + } + } else { + $result .= $v; + } + return $result; +} + +1; diff --git a/base/tps/lib/perl/PKI/TPS/LoginPanel.pm b/base/tps/lib/perl/PKI/TPS/LoginPanel.pm new file mode 100755 index 000000000..d6592d46e --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/ModulePanel.pm b/base/tps/lib/perl/PKI/TPS/ModulePanel.pm new file mode 100755 index 000000000..5e7089812 --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/Modutil.pm b/base/tps/lib/perl/PKI/TPS/Modutil.pm new file mode 100755 index 000000000..49c248c2e --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/NamePanel.pm b/base/tps/lib/perl/PKI/TPS/NamePanel.pm new file mode 100755 index 000000000..a474d80b9 --- /dev/null +++ b/base/tps/lib/perl/PKI/TPS/NamePanel.pm @@ -0,0 +1,611 @@ +#!/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\>)/; + $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 and audit logging 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" ); + + $::config->put( "logging.audit.signedAuditCertNickname", + "$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->put( "logging.audit.signedAuditCertNickname", + "$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 "",; + 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/base/tps/lib/perl/PKI/TPS/ReqCertInfo.pm b/base/tps/lib/perl/PKI/TPS/ReqCertInfo.pm new file mode 100755 index 000000000..f2faee2c7 --- /dev/null +++ b/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 "",; + 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/base/tps/lib/perl/PKI/TPS/SecurityDomainPanel.pm b/base/tps/lib/perl/PKI/TPS/SecurityDomainPanel.pm new file mode 100755 index 000000000..5301d1369 --- /dev/null +++ b/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 -r "/ca/admin/ca/getStatus" $hostname:$port`; + if( "$content" eq "" ) { + return 0; + } else { + $content =~ /(\.*\<\/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/base/tps/lib/perl/PKI/TPS/SizePanel.pm b/base/tps/lib/perl/PKI/TPS/SizePanel.pm new file mode 100755 index 000000000..8ac49b68d --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/SubsystemTypePanel.pm b/base/tps/lib/perl/PKI/TPS/SubsystemTypePanel.pm new file mode 100755 index 000000000..793849332 --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/TKSInfoPanel.pm b/base/tps/lib/perl/PKI/TPS/TKSInfoPanel.pm new file mode 100755 index 000000000..720093ac5 --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/WelcomePanel.pm b/base/tps/lib/perl/PKI/TPS/WelcomePanel.pm new file mode 100755 index 000000000..a1c77e7cd --- /dev/null +++ b/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/base/tps/lib/perl/PKI/TPS/wizard.pm b/base/tps/lib/perl/PKI/TPS/wizard.pm new file mode 100755 index 000000000..db8b26526 --- /dev/null +++ b/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 +# +# SetHandler perl-script +# PerlHandler RHCS::TPS::Wizard +# Order deny,allow +# Allow from all +# + + +# 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 + ]; +}; + +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 = ""; + foreach $s (sort keys %symbol) { + if ($s =~ /^__/) { + next; + } + $result .= "<" . $s . ">"; + my $v = $symbol{$s}; + $result .= &get_xml($s, $v); + $result .= ""; + } + $result .= ""; + } 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; + 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 .= ""; + } + } elsif (ref($v) eq "PKI::TPS::CertInfo") { + my $certinfo = $v; + $result .= ""; + $result .= "" . $certinfo->get_dn() .""; + $result .= "" . $certinfo->get_cert_tag() . ""; + $result .= "" . $certinfo->get_user_friendly_name() . + ""; + $result .= ""; + } elsif (ref($v) eq "PKI::TPS::ReqCertInfo") { + my $reqcertinfo = $v; + $result .= ""; + $result .= "" . $reqcertinfo->get_user_friendly_name() .""; + $result .= "" . $reqcertinfo->get_request() .""; + $result .= "" . $reqcertinfo->get_cert() .""; + $result .= "" . &escape_xml($reqcertinfo->get_cert_pp()) .""; + $result .= "" . $reqcertinfo->get_cert_tag() .""; + $result .= "" . $reqcertinfo->get_cert_tag() .""; + $result .= ""; + } elsif (ref($v) eq "ARRAY") { + my $pos = 0; + foreach my $item (@$v) { + $result .= ""; + $result .= &get_xml("p" . $pos, $item); + # $result .= "-" . ref($item); + $result .= ""; + $pos++; + } + } else { + $result .= &escape_xml($v); + } + return $result; +} + +1; diff --git a/base/tps/lib/perl/Template/Velocity.pm b/base/tps/lib/perl/Template/Velocity.pm new file mode 100755 index 000000000..ea5eb6d72 --- /dev/null +++ b/base/tps/lib/perl/Template/Velocity.pm @@ -0,0 +1,1052 @@ +#!/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; + +package Template::Velocity::Executor; +sub new; + +package Template::Velocity; + + +# The Template::Velocity package implements a Template execution +# engine similar to the Java Velocity package. + +use Parse::RecDescent; +use Data::Dumper; + + +$Template::Velocity::parser; + +our $docroot="docroot"; +our $parser; +my %parsetrees = (); +my $debugflag = 0; + + +#GRAMMAR defined here + +my $vmgrammar = q{ + + { + use Data::Dumper; + sub Dumper + { + $::debugdumper = undef; + if ($::debugflag && $::debugdumper ) { return Data::Dumper(@_); } + else {""}; + } + + } + + +# Template is the top-level object + template: section(s) /\Z/ + + section: blockdirective + | nonblockdirective + | plainline + + blockdirective: ifblock + | foreachblock + + plainline : /[ \t]*/ ...!'#' linecomp(s?) /\n*/ + + HASH: '#' + +# HMM - this doesn't handle multiple variables on one line? + linecomp: variable + | /[^\$\n]*/ + + nonblockdirective: '#' 'include' includeargs /\n*/ { $item[4] ; } + | '#' 'parse' parseargs /\n*/ { $item[4] ; } + | '#' 'set' setargs /\n*/ { $item[4] ; } + | + + + ifblock: ifdirective section(s) elseclause(?) enddirective + + +# this bubbles up the result of the expression inside the if() +# which is from the 'ifargs' rule + ifdirective: '#' 'if' ifargs /\n/ + + enddirective: '#' 'end' "\n" + + elseclause: elsedirective section(s) + + elsedirective: '#' 'else' "\n" + + foreachblock: foreachdirective section(s) enddirective + + foreachdirective: '#' 'foreach' foreachargs "\n" + + ifargs: '(' expression ')' + | + + foreachargs: '(' variablename 'in' variable ')' + | + + includeargs: '(' string ')' + | + + parseargs: '(' expression ')' + | + + + setargs: '(' assignment ')' + | + + +# expression evaluation + +# this goes roughly in order of precendence: +# == +# &&, || +# +, - +# * +# ! + +# does not properly distinguish between lvalues and rvalues + + + expression: boolean + | + + + assignment: variablename '=' boolean + + boolean: equality (boolean_operator equality)(?) + + boolean_operator: ( '&&' | '||' ) + + equality: summation (equality_operator summation)(?) + + + equality_operator: ( '==' | '!=' ) + + summation: product (summation_operator summation)(?) + + summation_operator: ( '+' | '-' ) + + +# must parenthesize operator '*' to get it to appear in the $item array + + product: negation ('*' product)(?) + +#XXX need to implement + negation: notoperator(?) factor + + notoperator: "!" + + factor: number + | string + | variable + + + +# These rules deal with variables +# handles $process +# $file.executablename +# $process.getpid() +# $person.getparent().getbrother().slap() +# $fred.getchildren() + +# You'd make a dependency on the 'variable' rule if you want the value +# of the variable. +# You'd make a dependency on the 'variablename' rule if you want the +# name of the variable. +# (There's no real difference here - the expression evaluation is +# in the variable() subroutine) + + variable: variablename { ["variable", $item[1][1] ]; } + + variablename: '$' identifier subfield(s?) + { + my $variableinfo = { + top => $item{identifier}, + fields => $item{'subfield(s?)'} + }; + $return = [ "variablename", \$variableinfo ]; + } + + subfield: '.' identifier arglist(?) + { + my $d; + my $a = $item{"arglist(?)"}; + my $args; + + #::debug "arglist = ".Dumper($a)."\n"; + if ($a) { + + my ($argcount, $al, $alpresent); + + #$args = @{$a}->[2]; + $args = $a->[0][2]; + #::debug "arglist args=".Dumper($args)."\n"; + $alpresent = $args; + $argcount = $#$args; + if ($alpresent && $argcount == -1) { + $args->[0] = [ ]; + } + } + + #::debug "arglist identifier=".$item{identifier}."\n"; + $return = [ "subfield", { + fieldname => $item{identifier}, + arglist => $args->[0], + } ]; + } + + arglist: '(' list(?) ')' + + list: expression (',' list)(s?) + + +# Basic data types +# identifiers, numbers and strings + + identifier: /[A-Za-z0-9_]+/ { $item[1]; } + + number: /\d+/ {$item[1]; } + + #XXX skip is all wrong here... should be in [] + string: '"' /[^"]*/ '"' { $return = ["string",$item[4]]; } + | "'" /[^']*/ "'" { $return = ["string",$item[4]]; } + + +# other literals + whitespace: /\s*/ + + +}; + + +# Get a parser object (transforming the built-in text grammar into RecDescent +# data structure). This object can be reused for parsing multiple velocity files +sub new +{ + #$::debugflag = 0; + my $class = shift; + $docroot = shift; + undef $::RD_HINT; + undef $::RD_WARN; + #$::RD_TRACE = 1; + $parser = new Parse::RecDescent($vmgrammar) or die "Bad Grammar\n"; + $Data::Dumper::Maxdepth = 1;; + my $self = {}; + $self->{parser} = $parser; + # ugly - :-( + $Template::Velocity::parser = $parser; + bless $self, $class; + return $self; +} + + +# Execute a template. Given a text string and a parser object, will return +# a parse tree, useful for feeding into the executor. +sub execute_string +{ + my $self = shift; + my $string = shift; + my $rule = shift; + if (! $rule ) { $rule = "template"; } + #print Dumper($self); + + my $parser = $self->{parser}; + my $parsetree = $parser->$rule($string); + my $executor = new Template::Velocity::Executor($parsetree, $parser ); + + my @value = $executor->run(); + #my @value = Template::Velocity::Executor::execute($parsetree, $parser); + my $value = shift @value; + return $value; +} + + +sub execute_file +{ + + my $self = shift; + my $filename = shift; + + my $rule; + my $tree = $parsetrees{$filename}; + + if (! $tree) { + $rule = "template"; + open my $fh, "<$docroot/$filename" or return undef; + my $string = join "",<$fh>; + close $fh; + $tree = $parser->$rule($string); + $parsetrees{$filename} = $tree; + } + + my $executor = new Template::Velocity::Executor($tree, $parser ); + + my @value = $executor->run(); + my $value = shift @value; + return $value; + + +} + + + + + + + + +sub Dumper +{ + return ""; + if ($::debugflag && $::debugdumper) { + return Data::Dumper->Dump([@_]); + } + else {""}; +} + + + + +# This autoaction returns an array of each parse element +# The net result is a parse tree +# I couldn't use because I wanted to preserve +# the order of the elements, and returns a +# hashtable, not an array + +$::RD_AUTOACTION = q{ + [@item]; +}; + +# debug flags set here + + + + + + +######### EXECUTE FUNCTIONS + + +# These functions deal with executing the velocity parse tree +{ + package Template::Velocity::Executor::Rules; + use Data::Dumper; + + # this imports symbols from these other packages, so + # we don't have to always use the fully-qualified names + *exe_all = \&Template::Velocity::Executor::exe_all; + *exe_optional = \&Template::Velocity::Executor::exe_optional; + *execute = \&Template::Velocity::Executor::execute; + *debug = \&Template::Velocity::Executor::debug; + *indent = \&Template::Velocity::Executor::indent; + *deindent = \&Template::Velocity::Executor::deindent; +#XXX probably should be $, not & + *docroot = \&Template::Velocity::docroot; + + sub Dumper + { + return ""; + if ($::debugflag && $::debugdumper) { return Dumper(@_); } + else {""}; + } + + #template: section(s) /\Z/ + sub template { + my $f = "template"; + my @item = exe_all(@_); + debug ("$::level $f - sections should be an array of text: .".Dumper($item[2])."\n"); + my $sections = $item[2]; + debug ("sections is a: ".(ref $sections)." - it should be an array\n"); + my $r= ( join "", @{$item[2]}); + return $r; + } + + + #linecomp: variable + # | /[^\$\n]*/ + sub linecomp { + my $item; + debug ("linecomp: _[2] = '".$_[2]."'\n"); + if ($_[2]) { + debug ("linecomp: inside if\n"); + $item = $_[1].$_[2]; + } else { + debug ("linecomp: inside else{\n"); + ($item) = exe_all($_[1]); + debug ("linecomp: end of else}\n"); + debug ("linecomp: item =\n".Dumper($item)."\n"); + } + debug ("linecomp: returning $item\n"); + return $item; + } + + # plainline : /[ \t]*/ ...!'#' linecomp(s?) /\n+/ + sub plainline { + my @item = exe_all(@_); + debug ("$::level in plainline - linecomps should be an array of text: .".Dumper($item[4])."\n"); + my $r = join "", @{$item[4]}; + debug ("$::level in plainline - joined as: $r\n"); + $r = $item[2] . $r. $item[5]; + debug ("$::level in plainline - returning : $r\n"); + return $r; + } + + sub expression { + debug ("$::level expression = ".Dumper($_[1])."\n"); + my ($item) = exe_all($_[1]); + debug ("$::level expression returning $item\n"); + return $item; + } + + #foreachblock: foreachdirective section(s) enddirective + sub foreachblock { + my $f = "foreachblock"; + debug ("$::level $f started!\n"); + my ($directive) = exe_all($_[1]); + debug ("$::level $f directive = \n".Dumper($directive)."\n"); + my ($variable, $list) = @{$directive}; + my $variablename = $$variable->{top}; + debug ("$::level $f variable = $variablename\n"); + debug ("$::level $f list = \n".Dumper($list)."\n"); + + my $result = ""; + foreach my $q (@{$list}) { + debug ("$::level $f q=$q\n"); + $::symbol{$variablename} = $q; + debug ("$::level $f setting variable $variablename = $q\n"); + + my ($sections) = exe_all($_[2]); + debug ("$::level $f sections was: ".Dumper($sections)."\n"); + $result .= join "",@{$sections}; + } + return $result; + } + + #foreachdirective: '#' 'foreach' foreachargs "\n" + sub foreachdirective { + my ($item) = exe_all($_[3]); + return $item; + } + + #foreachargs: '(' variablename 'in' expression ')' + sub foreachargs { + my $f = "foreachargs"; + my ($variable, $list) = exe_all($_[2], $_[4]); + debug ("$::level $f variable = \n".Dumper($variable)."\n"); + debug ("$::level $f list = \n".Dumper($list)."\n"); + return [$variable, $list]; + } + + # XXX if block should only execute section(s) if if arg is positve) + # likewise for else + #ifblock: ifdirective section(s) elseclause(?) enddirective + sub ifblock { + my $f = "ifblock"; + my @item = exe_all(@_); + debug ("$::level $f - sections should be an array of text: .".Dumper($item[2])."\n"); + my $sections = $item[2]; + my $else = $item[3]; + debug ("$::level $f sections is a: ".(ref $sections)." - it should be an array\n"); + debug ("$::level item1: if expression = ".$item[1]."\n"); + debug ("$::level $f elseclause is a: ".(ref $else)." - it should be an scalar\n"); + my $r= ( + $item[1]>0 ? # if expression + (join "", @{$item[2]}) : + ($item[3] ? join "",@{$item[3]} : "") + ); + # this is not quite right ... elseclause returns a scalar (it joins the sections) + # so why do I have to join again here? possibly because it's a '?' + return $r; + } + + #elseclause: elsedirective section(s) + sub elseclause { + my $f = "elseclause"; + my ($sections) = exe_all($_[2]); + debug ("$::level $f sections is a: ".(ref $sections)." - it should be an array\n"); + my $return = join "", @{$sections}; + debug ("$::level $f returning: $return\n"); + return $return; + } + + sub ifargs { + debug ("$::level ifargs [2] = ".Dumper($_[2])."\n"); + my ($item) = exe_all($_[2]); + debug ("$::level item = ".Dumper($item)."\n"); + my $r = $item>0 ? 1 : 0; + debug ("$::level ifargs returning $r\n"); + return $r; + } + + #ifdirective: '#' 'if' ifargs /\n/ + sub ifdirective { + my ($item) = exe_all($_[4]); + my $r = $item>0 ? 1 : 0; + debug ("$::level ifdirective returning $r\n"); + return $r; + } + + #boolean: equality (boolean_operator equality)(?) + sub boolean { + my $f = "boolean"; + my ($equality, $alt) = ( execute($_[1]), $_[2]); + my $r = $equality; + if (scalar @$alt) { + my ($op, $equality2) = exe_optional($alt, 1,2); + + if ($op eq '&&') { + $r = $equality && $equality2; + } + if ($op eq '||') { + $r = $equality || $equality2; + } + } + + return $r; + } + + + #summation: product (summation_operator summation)(?) + sub summation { + #my @item = exe_all(@_); + my $f = "summation"; + my ($product, $alt) = ( execute($_[1]), $_[2]); + debug("$::level $f - product = $product, alternation = $alt\n"); + debug("$::level $f - alternation = \n".Dumper($alt)."\n"); + + if (scalar @$alt) { + if (0) { + debug("$::level $f - alt1= \n".Dumper($alt->[0][1])."\n"); + debug("$::level $f - alt2= \n".Dumper($alt->[0][2])."\n"); + my ($operator, $summation) = ( execute($alt->[0][1]), execute($alt->[0][2]),); + } + my ($operator, $summation) = exe_optional($alt, 1,2); + + if ($operator eq '+') { return $product + $summation; + } else { return $product - $summation; } + } else { + return $product; + } + } + + + + #equality: summation (equality_operator summation)(?) + sub equality { + my $f = "equality"; + my ($summation, $alt) = ( execute($_[1]), $_[2] ); + + if (scalar @$alt) { + my ($operator, $summation2) = exe_optional($alt, 1,2); + + # string comparison used, so (0.0) is NOT equal to (0) + if ($operator eq '==') { return ($summation eq $summation2) ? 1:0; } + else { return ($summation eq $summation2) ? 0:1; } + } else { + return $summation; + } + } + + + sub product { + my $f = "product"; + my ($negation, $alt) = ( execute($_[1]), $_[2]); + debug("$::level $f negation = $negation, alternation = $alt\n"); + debug("$::level $f - alternation = ".Dumper($alt)."\n"); + + if (scalar @$alt) { + if (0) { + debug("$::level $f - alt1= \n".Dumper($alt->[0][1])."\n"); + debug("$::level $f - alt2= \n".Dumper($alt->[0][2])."\n"); + my ($operator, $product) = ( execute($alt->[0][1]), execute($alt->[0][2]),); + } + my ($operator, $product) = exe_optional($alt,1,2); + return ($negation * $product); + } else { + return $negation; + } + } + + sub factor { + my ($value) = exe_all($_[1]); + return $value; + } + + #negation: notoperator(?) factor + sub negation { + debug ("$::level in negation... input = ".(join ",",@_)."\n"); + #my @item = exe_all(@_); + my ($alt, $value) = ( $_[1], execute($_[2]) ); + debug ("$::level negation: alternation= $alt\n"); + debug ("$::level negation: value = $value\n"); + my $operator = execute($alt->[0][1]); + + my $r; + if ($operator && $operator eq '!') { + if ($value ) { $r = 0; } + else { $r = 1; } + debug ("$::level negation: inverting\n"); + } else { + debug ("$::level negation: not inverting\n"); + $r = $value; + } + debug ("$::level negation: returning $r\n"); + return $r; + } + + #setargs: '(' assignment ')' + sub setargs { + my $f = "setargs"; + my ($args) = exe_all($_[3]); + debug("$::level $f args = \n".Dumper($args)."\n"); + my ($variable, $value) = @{$args}; + debug("$::level $f variable type =".(ref $variable)."\n"); + debug("$::level $f variable = \n".Dumper($variable)."\n"); + my $symbolname = $$variable->{top}; + debug("$::level $f setting variable '$symbolname' = $value\n"); + $::symbol{$symbolname} = $value; + return ""; + } + + #assignment: variablename '=' boolean + sub assignment { + my $f = "assignment"; + my ($variable, $value) = exe_all($_[1],$_[3]); + debug("$::level $f variable = \n".Dumper($variable)."\n"); + my $r = [ $variable, $value ]; + debug("$::level $f returning: \n".Dumper($r)."\n"); + return $r; + } + + #includeargs: '(' string ')' + sub includeargs { + my $f = "includeargs"; + my ($filename ) = execute($_[2]); + + debug("including file: $filename\n"); + open my $fh, "<$docroot/$filename" or return "filenotfound $docroot/$filename!\n"; + my $file = join "", <$fh>; + close FILE; + + return $file; + } + + sub parseargs { + my $f = "parseargs"; + my ($filename ) = execute($_[2]); + + debug("parsing file: $filename\n"); + + #open my $fh, "<$docroot/$filename" or return "filenotfound $docroot/$filename!\n"; + #my $file = join "", <$fh>; + #close FILE; + + #my $parsetree = $Template::Velocity::parser->template($file); + #my @value = execute($parsetree); + #my $value = shift @value; + + my @value = Template::Velocity::execute_file(undef,$filename); + my $value = shift @value; + + return $value; + } + +# variables + +# variables +# this rule converts a variable name/identifier into its value +# $main.subfield(argument1,argument2).subfield2(arg1,arg2) +# There are two data structures at work here. +# 1. the data structure specifying the variable name to be queried +# this represents $a.b.c(100,9,5,4) +#{ +# 'top' => 'a' +# 'fields' => [ +# { 'fieldname' => 'b', 'arglist' => undef }, +# { 'fieldname' => 'c', 'arglist' => [ '100', 9, 5, '4', ], } +# ], +#} +# 2. Data structure specifying the symbol table + +# return value could be: +# a scalar: either a string/number value or reference to an array of values +# an array + + sub variable { +# look up the root object in the symbol table + my $f = "variable"; + debug("$::level $f: input\n".Dumper(\@_)."\n"); + my $var = $_[1]; + debug("$::level $f var=\n".Dumper($var)."\n"); +# $$var works with # 27: '#set (\$a=1+3)\n\$a\n' +#0 REF(0x8fa0510) +# -> HASH(0x8fa1454) +# 'fields' => ARRAY(0x8fa8c08) +# empty array +# 'top' => 'a' + +# $var works with # 25: '$employee.add(100,4+5,2+3,4,4,5,6)' +#DB<2> x $var +#0 HASH(0x9c7a340) +# 'fields' => ARRAY(0xa06e7d8) +# 0 ARRAY(0xa06e9ac) +# 0 'subfield' +# 1 HASH(0xa06e880) +# 'arglist' => ARRAY(0xa074184) + + my $top = $$var->{top}; # name of the root object + debug("$::level $f top=\n".Dumper($top)."\n"); + my $fields = $$var->{fields}; # array of the subidentifiers + my $val = ""; + + debug("$::level $f - top_id = $top\n"); + debug("$::level $f : var: \n".Dumper($var)."\n"); + debug("$::level $f - fields = \n".Dumper($fields)."\n"); + + + debug("$::level $f : top = ".$top."\n"); + if (! defined $::symbol{$top} ) { +# XXX + debug ("symbol table = ",(join ",",sort keys %::symbol)."\n"); + debug ("undefined variable: $top\n"); + return 0; + } + debug("$::level $f symbol table: \n".Dumper(\%::symbol)."\n"); + $val = $::symbol{$top}; + debug("$::level $f val before: \n".Dumper($val)."\n"); + + debug("$::level $f - fields = \n".Dumper($fields)."\n"); + my $pass = 1; + foreach my $field (@$fields) { + my $args; + + my ($fieldname, $values); + { + debug("$::level $f pass $pass \@_=\n".Dumper(\@_)."\n"); + debug("$::level $f before strip field = \n".Dumper($field)."\n"); +#shift @$fn; # 'subfield' string +#$fn = $fn->[0]; +#$fn = [ (@{$fn}) ]; +#shift @$fn; + debug("$::level $f after strip fn = \n".Dumper($field)."\n"); + + $fieldname = $field->[1]->{fieldname}; + debug("$::level $f processing field: $fieldname\n"); + $args= $field->[1]->{arglist}; + + +# convert the argument list (which could be expressions, other +# variables, etc) into raw values + if ($args) { + debug("$::level $f executing $fieldname with args:\n".Dumper($args)."\n"); + ($values) = execute($args); + debug("$::level $f returned values:\n".Dumper($values)."\n"); + } + } + + debug("$::level $f after execute, \@_=\n".Dumper(\@_)."\n"); + +#call the function + if (ref $val) { + debug("$::level $f : inside loop(before) {\n".Dumper($val)."\n"); + debug("$::level $f : inside loop(before) {\n".Dumper($val)."\n"); + if ($args) { + debug("$::level $f: function call\n"); +#$val = $$val->$fieldname ($args); # method call + my $func = $val->{$fieldname}; # method call + debug("$::level $f: $fieldname func=\n ".Dumper($func)."\n"); + no strict; + $val = &$func($val, @$values); + debug("$::level $f: $fieldname result=$val\n"); + debug("$::level $f: $fieldname result=\n".Dumper($val)."\n"); + + } else { + &::debug("$::level $f: plain field access\n"); + if (ref $val eq "REF") { + $val = $$val->{$fieldname}; # field access + } else { + $val = $val->{$fieldname}; # field access + } + } + debug("$::level $f } inside loop(after val retrieval) val=\n".Dumper($val)."\n"); + } + $pass++; + + } + + return $val; + } + + #$return = [ "variablename", \$variableinfo ]; + sub variablename { + my $f = "variablename"; + debug("$::level $f: input\n".Dumper(\@_)."\n"); + my $var = $_[1]; + return $var; + } + + #arglist: '(' list(?) ')' + sub arglist { + my ($list) = exe_all($_[2]); + debug("$::level list: ".Dumper($list)."\n"); + if ($list) { + my $ll = $list->[0]; + debug("$::level ll \n".Dumper($ll)."\n"); + debug("$::level \$\$list: \n"); + return $ll; + } + return undef; + } + + #list: expression (',' list)(s?) + sub list { + my ($expr, $alt) = ( execute($_[1]), $_[2] ); + + if (scalar @$alt) { + my ($list) = exe_optional($alt, 2); + + debug("$::level list: expr: $expr\n"); + debug("$::level list: list: $list\n:"); + debug("$::level list ".Dumper($list)."\n"); + my $r = [ $expr, (@$list) ]; + return $r; + } + debug("$::level returning simple expression: $expr\n:"); + return [$expr]; + } + + + + sub _default { + debug ("$::level default rule {\n"); + indent(); + debug ("$::level parsing parameters\n"); + my @item = exe_all(@_); + debug ("$::level default rule - last item in array is: ".$item[$#item]."\n"); + my $r = join "",@item[1..$#item]; + debug ("$::level default rule - returning: $r\n"); + deindent(); + debug ("$::level }\n"); + return $r; + + } + + +} + + +package Template::Velocity::Executor; + +use Data::Dumper; + + + +sub new +{ + my $class = shift; + + my $parsetree = shift; + my $parser = shift; + + my $self = {}; + $self->{parser} = $parser; + $self->{parsetree} = $parsetree; + bless $self, $class; + return $self; +} + + +sub run { + my $self = shift; + + return (execute($self->{parsetree})); +} + + + +my $level = " "; + +sub debug { + if ($::debugflag) { + print @_; + } +} + +# This basically all works calling execute($parsetree). +# Execute will look the Parsetree, which is built by a special autoaction +# +# It will call top-down, into functions called 'Executor::XXX', (where XXX is +# the name of the production) +# +# Additional trees, representing child productions, will be passed in +# as arguments to the Executor::XXX function. These arguments be processed +# before the Executor::XXX function can proceed. +# +# If no such function is present, Executor:_default will be run +# +# To process the arguments, use this in the Executor function: +# my @item = exe(@_); +# Which will give you an @item array similar to that in the RD rules, one +# exception being that productions which return arrays are flattened into +# the @item array. (bad idea?) +# + + + +# executes a parsetree (gotten as a result of calling recdescent $parser->rule() +# and returns the string value of the result. + +sub Dumper { + ""; +} + +sub execute { + my $result; + my $tree = shift; # a reference to a tree is passed in + debug "$level execute: {\n"; + indent(); + debug ("$level tree = \n".Dumper($tree)."\n"); + +# there are 3 possible things this tree could be: + +# 1 a scalar .. in which case this rule represents a literal, and the +# the literal is just returned +# +# 2 an array of the form (array, ...) - in which case this is the result of a production +# which returned an array of trees. This happens +# if you specify (s), (?), etc, in a production. +# 3 an array of the form (scalar, ...) - in which case this refers to a subrule +# + +# case 1... + my $type = ref $tree; + if ($type) { + debug "\n$level tree type: ".(ref $tree)." \n"; + } else { + debug "\n$level tree type: scalar \n"; + } + if ($type ne "ARRAY") { + debug "$level returning literal: '$tree'\n"; + deindent(); + debug "$level }\n\n"; + return $tree; + } + + my @result; + +# if this tree is the result of a auto-generated rule (e.g. alternation) +# then tree[0] is not a name.. it is an array. just call the default action with +# the arguments + + my $rule = @{$tree}->[0]; # rule name is first + + if ($rule && ref $rule eq "ARRAY") { # case 2 + debug "$level element[0] is an array (case 2) \n"; + debug "$level contents of input: \n".Dumper(\@{$tree})."\n"; + #@result = exe(@{$rule}); + debug "$level running exe on the array..\n"; + # not sure about this... + @result = (exe_all(@{$tree})); + debug "$level contents of output: \n".Dumper(\@result)."\n"; + #shift @result; # get rid of function name + $result = \@result; + + } else { # case 3 + my @args = @{$tree}; + + debug "$level rule is a function to execute (case 3): '$rule'\n"; + indent(); + my $qr = "Template::Velocity::Executor::Rules::$rule"; + if (defined &$qr) { + no strict ; + $result = (&$qr(@args)); + } else { + debug "$level no function defined for: '$rule' - calling default action\n"; + $result = Template::Velocity::Executor::Rules::_default(@args); + } + } + deindent(); + debug "$level function: $rule returned=\n".Dumper($result)."\n"; + + debug "$level }\n"; + return $result; + + } + +# these hold and set the current indent level. It's only used for nested debug messages +sub indent { + if (!$debugflag) { return; } + $level .= " "; + $Data::Dumper::Pad = $level." "; +} +sub deindent { + if (!$debugflag) { return; } + $level = substr ($level,0,-2); + $Data::Dumper::Pad = $level." "; +} + + +sub exe_optional { + my @r; + my $f = shift; + foreach my $q (@_) { + debug("$level: getting arg# $q\n"); + push @r, execute($f->[0][$q]); + } + return @r; +} + +# exe: for each argument, run the 'execute' function +# + +sub exe_all { + my $d = $Data::Dumper::Maxdepth; + $Data::Dumper::Maxdepth = 9; + debug "\n$level exe_all (".$_[0].") arguments: {\n".Dumper(\@_)." \n"; + my @r; + indent(); + + foreach my $i (@_) { + push @r, execute($i); + } + deindent(); + debug "$level exe_all: returning: \n".Dumper(\@r)."$level}\n\n"; + $Data::Dumper::Maxdepth = $d; + return @r; +} + + + + + +#package RHCS::TPS::GlobalVar; + +#sub new { my $self = {}; bless $self; return $self; } + + +1; + -- cgit