diff options
Diffstat (limited to 'pki/base/tps/lib')
36 files changed, 0 insertions, 8297 deletions
diff --git a/pki/base/tps/lib/perl/PKI/Base/Conf.pm b/pki/base/tps/lib/perl/PKI/Base/Conf.pm deleted file mode 100755 index 895ab28a3..000000000 --- a/pki/base/tps/lib/perl/PKI/Base/Conf.pm +++ /dev/null @@ -1,130 +0,0 @@ -#!/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 (<CF>) { - if (/^#/) { - # comments - } elsif (/([^=]+)=(.*)$/) { - # print "$1 = $2\n"; - $self->{hash}{$1} = $2; - } else { - # preserve comments - } - } - } - close(CF); - } -} - -sub get_filename -{ - my ($self) = @_; - return $self->{filename}; -} - -sub get -{ - my ($self, $n) = @_; - return $self->{hash}{$n}; -} - -sub put -{ - my ($self, $n, $v) = @_; - $self->{hash}{$n} = $v; -} - -sub 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/pki/base/tps/lib/perl/PKI/Base/Registry.pm b/pki/base/tps/lib/perl/PKI/Base/Registry.pm deleted file mode 100755 index a4fb83f28..000000000 --- a/pki/base/tps/lib/perl/PKI/Base/Registry.pm +++ /dev/null @@ -1,55 +0,0 @@ -#!/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/pki/base/tps/lib/perl/PKI/Service/Op.pm b/pki/base/tps/lib/perl/PKI/Service/Op.pm deleted file mode 100755 index 9e2a63d4f..000000000 --- a/pki/base/tps/lib/perl/PKI/Service/Op.pm +++ /dev/null @@ -1,127 +0,0 @@ -# -# --- 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; - $v =~ s/>/>/g; - return $v; -} - -sub get_xml -{ - my ($s, $v) = @_; - - my $result; - if (ref($v) eq "HASH") { - foreach my $xkey (keys %$v) { - $result .= "<" . $xkey . ">"; - $result .= &get_xml($xkey, $v{$xkey}); - # $result .= "-" . ref($xkey); - $result .= "</" . $xkey . ">"; - } - } elsif (ref($v) eq "PKI::RA::GlobalVar") { - foreach my $xkey (keys %$v) { - $result .= "<" . $xkey . ">"; - $result .= &get_xml($xkey, $$v{$xkey}->()); - # $result .= "-" . ref($xkey); - $result .= "</" . $xkey . ">"; - } - } elsif (ref($v) eq "ARRAY") { - my $pos = 0; - foreach my $item (@$v) { - $result .= "<element>"; - $result .= &get_xml("p" . $pos, $item); - # $result .= "-" . ref($item); - $result .= "</element>"; - $pos++; - } - } else { - $result .= &escape_xml($v); - } - return $result; -} - -sub xml_output { - my ($self, $c) = @_; - - my $result = "<xml>"; - foreach $s (sort keys %$c) { - if ($s =~ /^__/) { - next; - } - $result .= "<" . $s . ">"; - my $v = $$c{$s}; - $result .= &get_xml($s, $v); - $result .= "</" . $s . ">"; - } - $result .= "</xml>"; - return "$result\n"; -} - -sub execute { - my ($self) = @_; - $self->process(); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/AdminAuthPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/AdminAuthPanel.pm deleted file mode 100755 index caaf6c65f..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/AdminAuthPanel.pm +++ /dev/null @@ -1,93 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; - -package PKI::TPS::AdminAuthPanel; -$PKI::TPS::AdminAuthPanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(8); - $self->{"getName"} = &PKI::TPS::Common::r("Admin Authentication"); - $self->{"vmfile"} = "adminauthenticatepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("AdminAuthPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("AdminAuthPanel: update"); - $::config->put("preop.adminauth.done", "true"); - $::config->commit(); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("AdminAuthPanel: display"); - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.adminauth.done"); -} - - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/AdminPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/AdminPanel.pm deleted file mode 100755 index d62d611be..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/AdminPanel.pm +++ /dev/null @@ -1,234 +0,0 @@ -#!/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\>.*\<\/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/pki/base/tps/lib/perl/PKI/TPS/AgentAuthPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/AgentAuthPanel.pm deleted file mode 100755 index a5130caa1..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/AgentAuthPanel.pm +++ /dev/null @@ -1,91 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; - -package PKI::TPS::AgentAuthPanel; -$PKI::TPS::AgentAuthPanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(7); - $self->{"getName"} = &PKI::TPS::Common::r("Agent Authentication"); - $self->{"vmfile"} = "agentauthenticatepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("AgentAuthPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("AgentAuthPanel: update"); - $::config->put("preop.agentauth.done", "true"); - $::config->commit(); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("AgentAuthPanel: display"); - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.agentauth.done"); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/AuthDBPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/AuthDBPanel.pm deleted file mode 100755 index 2b189cd0c..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/AuthDBPanel.pm +++ /dev/null @@ -1,172 +0,0 @@ -#!/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/pki/base/tps/lib/perl/PKI/TPS/BasePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/BasePanel.pm deleted file mode 100755 index eecf99ff5..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/BasePanel.pm +++ /dev/null @@ -1,39 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; - -package PKI::TPS::BasePanel; -$PKI::TPS::BasePanel::VERSION = '1.00'; - -sub new { - my ($class) = @_; - my $self = {}; - bless $self, $class; - return $self; -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/CAInfoPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/CAInfoPanel.pm deleted file mode 100755 index 27d0a0048..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/CAInfoPanel.pm +++ /dev/null @@ -1,315 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; -use URI::URL; - -package PKI::TPS::CAInfoPanel; -$PKI::TPS::CAInfoPanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -our $cert_header="-----BEGIN CERTIFICATE-----"; -our $cert_footer="-----END CERTIFICATE-----"; - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(4); - $self->{"getName"} = &PKI::TPS::Common::r("CA Information"); - $self->{"vmfile"} = "cainfopanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("CAInfoPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("CAInfoPanel: update"); - - my $count = defined($q->param('urls')) ? $q->param('urls') : ""; - if ($count eq "") { - $::symbol{errorString} = "No CA information provided. CA, TKS and optionally DRM must be installed prior to TPS installation"; - return 0; - } - &PKI::TPS::Wizard::debug_log("CAInfoPanel: update - got urls = $count"); - - my $instanceID = $::config->get("service.instanceID"); - my $host = ""; - my $https_ee_port = ""; - my $https_agent_port = ""; - my $https_admin_port = ""; - my $domain_xml = ""; - - if ($count =~ /http/) { - # this is for pkisilent - my $info = new URI::URL($count); - $host = defined($info->host) ? $info->host : ""; - if ($host eq "") { - $::symbol{errorString} = "No CA host provided."; - return 0; - } - - $https_ee_port = defined($info->port) ? $info->port : ""; - if ($https_ee_port eq "") { - $::symbol{errorString} = "No CA EE port provided."; - return 0; - } - - $domain_xml = get_domain_xml($host, $https_ee_port); - if ($domain_xml eq "") { - $::symbol{errorString} = "missing security domain. CA, TKS and optionally DRM must be installed prior to TPS installation"; - return 0; - } - - $https_agent_port = get_secure_agent_port_from_domain_xml($domain_xml, $host, $https_ee_port); - $https_admin_port = get_secure_admin_port_from_domain_xml($domain_xml, $host, $https_ee_port); - - if(($https_admin_port eq "") || ($https_agent_port eq "")) { - $::symbol{errorString} = "secure CA admin or agent port information not provided by security domain."; - return 0; - } - } else { - $host = defined($::config->get("preop.securitydomain.ca$count.host")) ? - $::config->get("preop.securitydomain.ca$count.host") : ""; - $https_ee_port = defined($::config->get("preop.securitydomain.ca$count.secureport")) ? - $::config->get("preop.securitydomain.ca$count.secureport") : ""; - $https_agent_port = defined($::config->get("preop.securitydomain.ca$count.secureagentport")) ? - $::config->get("preop.securitydomain.ca$count.secureagentport") : ""; - $https_admin_port = defined($::config->get("preop.securitydomain.ca$count.secureadminport")) ? - $::config->get("preop.securitydomain.ca$count.secureadminport") : ""; - } - - if (($host eq "") || ($https_ee_port eq "") || ($https_admin_port eq "") || ($https_agent_port eq "")) { - $::symbol{errorString} = "no CA found. CA, TKS and optionally DRM must be installed prior to TPS installation"; - return 0; - } - - &PKI::TPS::Wizard::debug_log("CAInfoPanel: update - host= $host, https_ee_port= $https_ee_port"); - - $::config->put("preop.cainfo.select", "https://$host:$https_admin_port"); - my $serverCertNickName = $::config->get("preop.cert.sslserver.nickname"); - - my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname"); - $::config->put("conn.ca1.clientNickname", $subsystemCertNickName); - $::config->put("conn.ca1.hostport", $host . ":" . $https_ee_port); - $::config->put("conn.ca1.hostagentport", $host . ":" . $https_agent_port); - $::config->put("conn.ca1.hostadminport", $host . ":" . $https_admin_port); - - $::config->commit(); - - # connect to the CA, and retrieve the CA certificate - &PKI::TPS::Wizard::debug_log("CAInfoPanel: update connecting to CA and retrieve cert chain"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - my $tmpfile = "/tmp/ca-$$"; - system("/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$serverCertNickName\" -r \"/ca/ee/ca/getCertChain\" $host:$https_ee_port > $tmpfile"); - my $cmd = `cat $tmpfile`; - system("rm $tmpfile"); - my $caCert; - if ($cmd =~ /\<ChainBase64\>(.*)\<\/ChainBase64\>/) { - $caCert = $1; - &PKI::TPS::Wizard::debug_log("CAInfoPanel: ca= $caCert"); - } - if ($caCert eq "") { - &PKI::TPS::Wizard::debug_log("CAInfoPanel: update no cert chain found"); - return 0; - } - open(F, ">$instanceDir/conf/caCertChain2.txt"); - print F $cert_header."\n".$caCert."\n".$cert_footer; - close(F); - - &PKI::TPS::Wizard::debug_log("CAInfoPanel: update retrieve cert chain done"); - - #import cert chain - system("p7tool -d $instanceDir/alias -p $instanceDir/conf/chain2cert -a -i $instanceDir/conf/caCertChain2.txt -o $instanceDir/conf/CAchain2_pp.txt"); - my $r = $? >> 8; - my $failed = $? & 127; - if (($r > 0) && ($r < 10) && !$failed) { - my $i = 0; - while ($i ne $r) { - my $tmp = `certutil -d $instanceDir/alias -D -n "Trusted CA c2cert$i"`; - $tmp = `certutil -d $instanceDir/alias -A -f $instanceDir/conf/.pwfile -n "Trusted CA c2cert$i" -t "CT,C,C" -i $instanceDir/conf/chain2cert$i.der`; - $i++; - } - } - - $::config->put("preop.cainfo.done", "true"); - $::config->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("CAInfoPanel: display"); - - $::symbol{urls} = []; -# unshift(@{$::symbol{urls}}, "External CA"); - my $count = 0; - my $first = 1; - my $list = ""; - while (1) { - my $host = ""; - $host = $::config->get("preop.securitydomain.ca$count.host"); - if ($host eq "") { - goto DONE; - } - my $https_ee_port = $::config->get("preop.securitydomain.ca$count.secureport"); - my $name = $::config->get("preop.securitydomain.ca$count.subsystemname"); - my $item = $name . " - https://" . $host . ":" . $https_ee_port; -# my $item = "https://" . $host . ":" . $https_ee_port; -# unshift(@{$::symbol{urls}}, $item); - $::symbol{urls}[$count++] = $item; - if ($first eq 1) { - $list = $item; - $first = 0; - } else { - $list = $list.",".$item; - } - } -DONE: -# $list = $list.",External CA"; - $::config->put("preop.ca.list", $list); - - $::symbol{urls_size} = $count; - if ($count eq 0) { - $::symbol{errorString} = "no CA found. CA, TKS, and optionally DRM must be installed prior to TPS installation"; - return 0; - } - return 1; -} - -sub get_domain_xml -{ - my $host = $1; - my $https_ee_port = $2; - - # get the domain xml - # e. g. - https://water.sfbay.redhat.com:9445/ca/admin/ca/getDomainXML - - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - - my $sd_host = $::config->get("securitydomain.host"); - my $sd_admin_port = $::config->get("securitydomain.httpsadminport"); - my $content = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -r \"/ca/admin/ca/getDomainXML\" $sd_host:$sd_admin_port`; - - $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; - $content = $1; - return $content; -} - -sub get_secure_admin_port_from_domain_xml -{ - my $content = $1; - my $host = $2; - my $https_ee_port = $3; - - # Retrieve the secure admin port corresponding - # to the selected host and secure ee port. - my $parser = XML::Simple->new(); - my $response = $parser->XMLin($content); - my $xml = $parser->XMLin( $response->{'DomainInfo'}, - ForceArray => 1 ); - my $https_admin_port = ""; - my $count = 0; - foreach my $c (@{$xml->{'CAList'}[0]->{'CA'}}) { - if( ( $host eq $c->{'Host'}[0] ) && - ( $https_ee_port eq $c->{'SecurePort'}[0] ) ) { - $https_admin_port = https_$c->{'SecureAdminPort'}[0]; - } - - $count++; - } - - return $https_admin_port; -} - -sub get_secure_agent_port_from_domain_xml -{ - my $content = $1; - my $host = $2; - my $https_ee_port = $3; - - # Retrieve the secure agent port corresponding - # to the selected host and secure ee port. - my $parser = XML::Simple->new(); - my $response = $parser->XMLin($content); - my $xml = $parser->XMLin( $response->{'DomainInfo'}, - ForceArray => 1 ); - my $https_agent_port = ""; - my $count = 0; - foreach my $c (@{$xml->{'CAList'}[0]->{'CA'}}) { - if( ( $host eq $c->{'Host'}[0] ) && - ( $https_ee_port eq $c->{'SecurePort'}[0] ) ) { - $https_agent_port = https_$c->{'SecureAgentPort'}[0]; - } - - $count++; - } - - return $https_agent_port; -} - -sub is_panel_done -{ - return $::config->get("preop.cainfo.done"); -} - - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/CertInfo.pm b/pki/base/tps/lib/perl/PKI/TPS/CertInfo.pm deleted file mode 100755 index da5377d4f..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/CertInfo.pm +++ /dev/null @@ -1,132 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; - -package PKI::TPS::CertInfo; -$PKI::TPS::CertInfo::VERSION = '1.00'; - -sub new { - my ($class, $name, $dn, $tag) = @_; - my $self = {}; - - &PKI::TPS::Wizard::debug_log("CertInfo: start new"); - $self->{"getUserFriendlyName"} = \&get_user_friendly_name; - $self->{"getCertTag"} = \&get_cert_tag; - $self->{"getDN"} = \&get_dn; - $self->{"getNickname"} = \&get_nickname; - $self->{"useDefaultKey"} = \&use_default_key; - $self->{"getCustomKeysize"} = \&get_custom_keysize; - $self->{"keyOption"} = \&get_key_option; - &PKI::TPS::Wizard::debug_log("CertInfo: end new"); - - $self->{name} = $name; - $self->{dn} = $dn; - $self->{tag} = $tag; - - bless $self, $class; - return $self; -} - -sub get_user_friendly_name -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("CertInfo: get_user_friendly_name"); - return $self->{name}; -} - -sub get_cert_tag -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("CertInfo: get_cert_tag"); - return $self->{tag}; -} - -sub get_dn -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("CertInfo: get_cert_dn"); - return $self->{dn}; -} - -sub use_default_key -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("CertInfo: use_default_key"); - my $option = $::config->get("preop.cert.$self->{tag}.keysize.select"); - if (($option ne "") && ($option ne "default")) { - return 0; - } - return 1; -} - -sub get_nickname -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("CertInfo: get_nickname"); - my $nickname = $::config->get("preop.cert.$self->{tag}.nickname"); - - my $flavor = "pki"; - $flavor =~ s/\n//g; - - if ($nickname ne "") { - return $nickname; - } else { - return $self->{tag}."cert cert-$flavor-tps"; - } -} - -sub get_key_option -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("CertInfo: get_key_option"); - my $option = $::config->get("preop.cert.$self->{tag}.keysize.select"); - - if ($option ne "") { - &PKI::TPS::Wizard::debug_log("CertInfo: get_key_option from config = $option"); - return $option; - } else { - &PKI::TPS::Wizard::debug_log("CertInfo: get_key_option not from config"); - return "default"; - } -} - -sub get_custom_keysize -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("CertInfo: get_custom_keysize"); - my $size = $::config->get("preop.cert.$self->{tag}.keysize.customsize"); - &PKI::TPS::Wizard::debug_log("CertInfo: get_custom_keysize for preop.cert.$self->{tag}.keysize.customsize is $size"); - if ($size ne "") { - &PKI::TPS::Wizard::debug_log("CertInfo: get_custom_keysize from config is $size"); - return $size; - } else { - &PKI::TPS::Wizard::debug_log("CertInfo: get_custom_keysize not from config"); - return 2048; - } -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/CertPrettyPrintPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/CertPrettyPrintPanel.pm deleted file mode 100755 index 200ef8d74..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/CertPrettyPrintPanel.pm +++ /dev/null @@ -1,91 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; - -package PKI::TPS::CertPrettyPrintPanel; -$PKI::TPS::CertPrettyPrintPanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(13); - $self->{"getName"} = &PKI::TPS::Common::r("Certificates"); - $self->{"vmfile"} = "certprettyprintpanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("CertPrettyPrintPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("CertPrettyPrintPanel: update"); - $::config->put("preop.certprettyprint.done", "true"); - $::config->commit(); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("CertPrettyPrintPanel: display"); - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.certprettyprint.done"); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/CertRequestPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/CertRequestPanel.pm deleted file mode 100755 index fb5d9ccda..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/CertRequestPanel.pm +++ /dev/null @@ -1,306 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; -use PKI::TPS::ReqCertInfo; -use FileHandle; - -package PKI::TPS::CertRequestPanel; -$PKI::TPS::CertRequestPanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -our $cert_req_header="-----BEGIN NEW CERTIFICATE REQUEST-----"; -our $cert_req_footer="-----END NEW CERTIFICATE REQUEST-----"; -our $cert_header="-----BEGIN CERTIFICATE-----"; -our $cert_footer="-----END CERTIFICATE-----"; - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(13); - $self->{"getName"} = &PKI::TPS::Common::r("Certificate Requests"); - $self->{"vmfile"} = "certrequestpanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("CertRequestPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update"); - - my $i = 0; - - my $instanceDir = $::config->get("service.instanceDir"); - - my $useExternalCA = $::config->get("preop.certenroll.useExternalCA"); - if ($useExternalCA eq "on") { - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: useExternalCA is on"); - } else { - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: useExternalCA is off"); - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update auto enrollment should have been done, no more action needed"); - return 1; - } - - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update External CA selected, retrieve/process user input"); - - my $tokenname = $::config->get("preop.module.token"); - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update got token name = $tokenname"); - my $token_pwd = $::pwdconf->get($tokenname); - $token_pwd =~ s/\n//g; - open FILE, ">$instanceDir/conf/.pwfile"; - system( "chmod 00660 $instanceDir/conf/.pwfile" ); - print FILE $token_pwd; - close FILE; - - my $hw; - my $tk; - - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - $hw = ""; - $tk = ""; - } else { - $hw = "-h $tokenname"; - $tk = $tokenname.":"; - } - - foreach my $certtag (@PKI::TPS::Wizard::certtags) { - if ($certtag eq "subsystem") { - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: subsystem cert is pre-generated by the security domain"); - return 1; - } - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: for certag= $certtag"); - my $ccert = $::config->get("preop.cert.$certtag.cert"); - if ($ccert ne "") { - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: cert already exists in CS.cfg, go to next"); - next; - } - my $certchain = $q->param($certtag.'_cc'); - if ($certchain ne "") { - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: $certtag certchain is $certchain"); - my $cc_fn = "$instanceDir/conf/caCertChain.txt"; - my $tmp = `echo "$certchain" > $cc_fn`; - # remove existing one - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: try to delete existing certchain, if any....ok if it fails"); -# XXX remove should not be done lightly... - $tmp = `p7tool -d $instanceDir/alias -p $instanceDir/conf/chain1cert -a -i $cc_fn -o $instanceDir/conf/CAchain_pp.txt`; - my $r = $? >> 8; - my $failed = $? & 127; - if (($r > 0) && ($r < 10) && !$failed) { - my $i = 0; - while ($i ne $r) { - $tmp = `certutil -d $instanceDir/alias -D -n "Trusted CA $certtag cert$i"`; - $tmp = `certutil -d $instanceDir/alias -A -f $instanceDir/conf/.pwfile -n "Trusted CA $certtag cert$i" -t "CT,C,C" -i $instanceDir/conf/chain1cert$i.der`; -# $tmp = `rm $cc_fn`; - $i++ - } - } - } else { - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: no certchain included for certtag $certtag"); - } - - my $cert = $q->param($certtag); - if ($cert ne "") { - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: $certtag cert is $cert"); - my $nickname = $::config->get("preop.cert.$certtag.nickname"); - if ($nickname eq "") { - $nickname = "TPS ".$certtag." cert"; - $::config->put("preop.cert.$certtag.nickname", $nickname); - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: $certtag cert nickname not found in CS.cfg, generating one= $nickname"); - } - #remove existing one - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: try to delete existing cert $nickname, if any....ok if it fails"); -#XXX remove should not be done lightly... - my $tmp = `certutil -d $instanceDir/alias -D -n "$nickname"`; - $tmp = `certutil -d $instanceDir/alias -D $hw -f $instanceDir/conf/.pwfile -n "$tk$nickname"`; - #now import the cert - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: try to import cert"); - my $cert_fn = "$instanceDir/conf/$certtag"."_cert.txt"; - $tmp = `echo "$cert" > $cert_fn`; - -# $cert = extract_cert_from_file_sans_header_and_footer($cert_fn); - my $certa =""; - my $save_line = 0; - my @cert_a = split "\n", $cert; - foreach my $line (@cert_a) { - chomp( $line ); - $line =~ s/\r//g; - if ($line eq $cert_header) { - $save_line = 1; - } elsif( $line eq $cert_footer ) { - $save_line = 0; - last; - } elsif( $save_line == 1 ) { - $certa .= "$line"; - } - } - - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update putting cert in CS.cfg: $certa"); - - $::config->put("preop.cert.$certtag.cert", $certa); - - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: about to certutil -d $instanceDir/alias $hw -A -f $instanceDir/conf/.pwfile -n $nickname -t u,u,u -a -i $cert_fn"); - $tmp = `certutil -d $instanceDir/alias $hw -A -f $instanceDir/conf/.pwfile -n "$nickname" -t "u,u,u" -a -i $cert_fn`; - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: done certutil: $tmp"); - $tmp = `rm $cert_fn`; - - # changed the cert, need to change nickname too, if necessary - if ($hw ne "") { - $::config->put("preop.cert.$certtag.nickname", "$tk$nickname"); - if ($certtag eq "subsystem") { - $::config->put("conn.ca1.clientNickname","$tk$nickname"); - $::config->put("conn.drm1.clientNickname","$tk$nickname"); - $::config->put("conn.tks1.clientNickname","$tk$nickname"); - } - } - - } else { - &PKI::TPS::Wizard::debug_log("CertRequestPanel: update: no cert"); - } - } - -DONE: - $::config->put("preop.certrequest.done", "true"); - $::config->commit(); - my $tmp = `rm $instanceDir/conf/.pwfile`; - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("CertRequestPanel: display"); - - my $domain_name = $::config->get("preop.securitydomain.name"); - if ($domain_name eq "") { - $domain_name = "TPS Domain"; - } - my $machine_name = $::config->get("service.machineName"); - my $instance_id = $::config->get("service.instanceID"); - - my $i = 0; - foreach my $certtag (@PKI::TPS::Wizard::certtags) { - my $cert_dn = $::config->get("preop.cert.".$certtag.".dn"); - if ($cert_dn eq "") { - if ($certtag eq "subsystem") { - $cert_dn = "CN=TPS Subsystem, " . - "OU=" . $instance_id . ", " . - "O=" . $domain_name; - } elsif ($certtag eq "sslserver") { - $cert_dn ="CN=" . $machine_name . ", " . - "OU=" . $instance_id . ", " . - "O=" . $domain_name; - } else { - $cert_dn = $certtag; - } - } - - my $name = $::config->get("preop.cert.".$certtag.".userfriendlyname"); - if ($name eq "") { - $name = $certtag."Cert ".$instance_id; - } - - my $reqcert = new PKI::TPS::ReqCertInfo($name, - $cert_dn, $certtag); - $::symbol{reqscerts}[$i++] = $reqcert; - } - - $::symbol{errorString} = ""; - $::symbol{showApplyButton} = "true"; - - return 1; -} - -# arg0 message containing certificate -# return certificate sans header and footer -# -- all in a one-liner -sub extract_cert_from_file_sans_header_and_footer -{ - my $filename = $_[0]; - my $save_line = 0; - - my $fd = new FileHandle; - - my $cert = ""; - - $fd->open( "<$filename" ) or die "Could not open '$filename'!\n"; - - while( <$fd> ) - { - my $line = $_; - chomp( $line ); - $line =~ s/^M//g; - - if( $line eq $cert_header ) { - $save_line = 1; - } elsif( $line eq $cert_footer ) { - $save_line = 0; - last; - } elsif( $save_line == 1 ) { - $cert .= "$line"; - } - } - - $fd->close(); - - return $cert; -} - -sub is_panel_done -{ - return $::config->get("preop.certrequest.done"); -} - - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/Common.pm b/pki/base/tps/lib/perl/PKI/TPS/Common.pm deleted file mode 100755 index c66942599..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/Common.pm +++ /dev/null @@ -1,148 +0,0 @@ -#!/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/pki/base/tps/lib/perl/PKI/TPS/Config.pm b/pki/base/tps/lib/perl/PKI/TPS/Config.pm deleted file mode 100755 index 7195dccd9..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/Config.pm +++ /dev/null @@ -1,169 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -package PKI::TPS::Config; - -use strict; -use warnings; -use Exporter; - -$PKI::TPS::Config::VERSION = '1.00'; - -####################################################### -# Configuration Store -####################################################### -sub new { - my $class = shift; - my $self = {}; - my %hash = (); - $self->{filename} = ""; - $self->{hash} = \%hash; - bless $self,$class; - return $self; -} - -sub load_file -{ - my ($self, $filename) = @_; - - $self->{filename} = $filename; - if (-e $filename) { - open(CF, "<$filename"); - if (defined fileno CF) { - while (<CF>) { - if (/^#/) { - # comments - } elsif (/([^=]+)=(.*)$/) { - # print "$1 = $2\n"; - $self->{hash}{$1} = $2; - } else { - # preserve comments - } - } - } - close(CF); - } -} - -sub get_filename -{ - my ($self) = @_; - return $self->{filename}; -} - -sub get -{ - my ($self, $n) = @_; - return $self->{hash}{$n}; -} - -sub put -{ - my ($self, $n, $v) = @_; - $self->{hash}{$n} = $v; -} - -sub deleteSubstore -{ - my ($self, $n) = @_; - foreach my $xkey (keys %{$self->{hash}}) { - if ($xkey =~ /^\Q$n\E/) { - delete $self->{hash}{$xkey}; - } - } -} - -sub commit -{ - my ($self) = @_; - - # write stuff back to the file -# print $self->{filename} . "\n"; - my $hash = $self->{hash}; - my $suffix = time(); - - if (-e $self->{filename}) { - # Create a copy of the original file which - # preserves the original file permissions - system("cp -p \"" . $self->{filename} . "\" \"" . - $self->{filename} . "." . $suffix . "\""); - } - - # Overwrite the contents of the original file - # to preserve the original file permissions - open(F, ">" . $self->{filename}); - foreach my $k (sort keys %{$hash}) { - print F "$k=$self->{hash}{$k}\n"; - } - close(F); - - if (-e $self->{filename} . "." . $suffix) { - system("rm \"" . $self->{filename} . "." . $suffix . "\""); - } -} - -sub commit_with_backup -{ - my ($self) = @_; - - # write stuff back to the file -# print $self->{filename} . "\n"; - my $hash = $self->{hash}; - my $suffix = time(); - # Create a copy of the original file which - # preserves the original file permissions - system("cp -p \"" . $self->{filename} . "\" \"" . - $self->{filename} . "." . $suffix . "\""); - - # Overwrite the contents of the original file - # to preserve the original file permissions - open(F, ">" . $self->{filename}); - foreach my $k (sort keys %{$hash}) { - print F "$k=$self->{hash}{$k}\n"; - } - close(F); -} - -1; - -####################################################### -# Test Program -####################################################### -#my $config = PKI::TPS::Config->new(); -#$config->load_file("/tmp/CS.cfg"); -#print $config->get("tokendb.indexAdminTemplate") . "\n"; -#$config->put("tokendb.indexAdminTemplate", "Testing"); -#print $config->get("tokendb.indexAdminTemplate") . "\n"; -#$config->commit(); - -1; - -####################################################### -# Test Program -####################################################### -#my $config = PKI::TPS::Config->new(); -#$config->load_file("/tmp/CS.cfg"); -#print $config->get("tokendb.indexAdminTemplate") . "\n"; -#$config->put("tokendb.indexAdminTemplate", "Testing"); -#print $config->get("tokendb.indexAdminTemplate") . "\n"; -#$config->commit(); diff --git a/pki/base/tps/lib/perl/PKI/TPS/ConfigHSMLoginPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/ConfigHSMLoginPanel.pm deleted file mode 100755 index 5d36d3da3..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/ConfigHSMLoginPanel.pm +++ /dev/null @@ -1,112 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; - -package PKI::TPS::ConfigHSMLoginPanel; -$PKI::TPS::ConfigHSMLoginPanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(9); - $self->{"getName"} = &PKI::TPS::Common::r("Security Modules Login"); - $self->{"vmfile"} = "config_hsmloginpanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 1; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel: update"); - my $uTokName = $q->param('uTokName'); - my $uPasswd = $q->param('__uPasswd'); - -# &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel: update tokname= $uTokName pwd =$uPasswd"); - - $::pwdconf->put($uTokName, $uPasswd); - $::pwdconf->commit(); - - $::config->put("preop.confighsmlogin.done", "true"); - $::config->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - use Data::Dumper; - $Data::Dumper::Indent = 1; -# &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel -> dump of q= ". Dumper($q)); - $::symbol{SecToken} = $q->param('SecToken'); -# &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel -> display has ".$q->param('SecToken')); - - &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel -> display retrieving $q->param('SecToken') "); - my $pwd = $::pwdconf->get( $q->param('SecToken')); - if ($pwd ne "") { - &PKI::TPS::Wizard::debug_log("ConfigHSMLoginPanel -> display retrieved pwd from pwdconf"); - } - - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.confighsmlogin.done"); -} - - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/ConfigHSMPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/ConfigHSMPanel.pm deleted file mode 100755 index 06697a8c7..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/ConfigHSMPanel.pm +++ /dev/null @@ -1,78 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; - -package PKI::TPS::ConfigHSMPanel; -$PKI::TPS::ConfigHSMPanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&PKI::TPS::Common::no; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(12); - $self->{"getName"} = &PKI::TPS::Common::r("ConfigHSMLogin"); - $self->{"vmfile"} = "config_hsm.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("ConfigHSMPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("ConfigHSMPanel: update"); - $::config->put("preop.confighsm.done", "true"); - $::config->commit(); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("ConfigHSMPanel: display"); - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.confighsm.done"); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/DRMInfoPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/DRMInfoPanel.pm deleted file mode 100755 index 1ccef670d..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/DRMInfoPanel.pm +++ /dev/null @@ -1,180 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; -use URI::URL; - -package PKI::TPS::DRMInfoPanel; -$PKI::TPS::DRMInfoPanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(6); - $self->{"getName"} = &PKI::TPS::Common::r("DRM Information"); - $self->{"vmfile"} = "drminfopanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("DRMInfoPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("DRMInfoPanel: update"); - - my $choice = $q->param('choice'); - $::config->put("preop.krainfo.keygen", $choice); - - if ($choice eq "keygen") { - my $count = defined($q->param('urls')) ? $q->param('urls') : ""; - if ($count eq "") { - $::symbol{errorString} = "no DRM information provided. CA, TKS and DRM must be installed prior to TPS installation"; - return 0; - } - &PKI::TPS::Wizard::debug_log("DRMInfoPanel: update - got urls = $count"); - - my $instanceID = $::config->get("service.instanceID"); - my $host = ""; - my $https_agent_port = ""; - my $https_admin_port = ""; - - if ($count =~ /http/) { - # this is for pkisilent - my $info = new URI::URL($count); - $host = defined($info->host) ? $info->host : ""; - $https_agent_port = defined($info->port) ? $info->port : ""; - $https_admin_port = defined($q->param('adminport'))? $q->param('adminport') : ""; - } else { - $host = defined($::config->get("preop.securitydomain.kra$count.host")) ? - $::config->get("preop.securitydomain.kra$count.host") : ""; - $https_agent_port = defined($::config->get("preop.securitydomain.kra$count.secureagentport")) ? - $::config->get("preop.securitydomain.kra$count.secureagentport") : ""; - $https_admin_port = defined($::config->get("preop.securitydomain.kra$count.secureadminport")) ? - $::config->get("preop.securitydomain.kra$count.secureadminport") : ""; - } - - - if (($host eq "") || ($https_agent_port eq "")) { - $::symbol{errorString} = "no DRM found. CA, TKS and DRM must be installed prior to TPS installation"; - return 0; - } - - if ($https_admin_port eq "") { - if ($count =~ /http/) { - $::symbol{errorString} = "DRM admin port not provided by the security domain."; - } else { - $::symbol{errorString} = "DRM admin port not provided."; - } - return 0; - } - - my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname"); - $::config->put("preop.krainfo.select", "https://$host:$https_admin_port"); - $::config->put("conn.drm1.clientNickname", $subsystemCertNickName); - $::config->put("conn.drm1.hostport", $host . ":" . $https_agent_port); - $::config->put("conn.tks1.serverKeygen", "true"); - $::config->put("op.enroll.userKey.keyGen.encryption.serverKeygen.enable", "true"); - $::config->put("op.enroll.userKeyTemporary.keyGen.encryption.serverKeygen.enable", "true"); - $::config->put("op.enroll.soKey.keyGen.encryption.serverKeygen.enable", "true"); - $::config->put("op.enroll.soKeyTemporary.keyGen.encryption.serverKeygen.enable", "true"); - } else { - # no keygen - $::config->put("conn.tks1.serverKeygen", "false"); - $::config->put("op.enroll.userKey.keyGen.encryption.serverKeygen.enable", "false"); - $::config->put("op.enroll.userKeyTemporary.keyGen.encryption.serverKeygen.enable", "false"); - $::config->put("op.enroll.userKey.keyGen.encryption.recovery.destroyed.scheme", "GenerateNewKey"); - $::config->put("op.enroll.userKeyTemporary.keyGen.encryption.recovery.onHold.scheme", "GenerateNewKey"); - $::config->put("conn.drm1.clientNickname", ""); - $::config->put("conn.drm1.hostport", ""); - $::config->put("op.enroll.soKey.keyGen.encryption.serverKeygen.enable", "false"); - $::config->put("op.enroll.soKeyTemporary.keyGen.encryption.serverKeygen.enable", "false"); - $::config->put("op.enroll.soKey.keyGen.encryption.recovery.destroyed.scheme", "GenerateNewKey"); - $::config->put("op.enroll.soKeyTemporary.keyGen.encryption.recovery.onHold.scheme", "GenerateNewKey"); - } - $::config->put("preop.drminfo.done", "true"); - $::config->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("DRMInfoPanel: display"); - - $::symbol{urls} = []; - my $count = 0; - while (1) { - my $host = ""; - $host = $::config->get("preop.securitydomain.kra$count.host"); - if ($host eq "") { - goto DONE; - } - my $https_agent_port = $::config->get("preop.securitydomain.kra$count.secureagentport"); - my $name = $::config->get("preop.securitydomain.kra$count.subsystemname"); - $::symbol{urls}[$count++] = $name . " - https://" . $host . ":" . $https_agent_port; - } -DONE: - $::symbol{urls_size} = $count; - - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.drminfo.done"); -} - - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/DatabasePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/DatabasePanel.pm deleted file mode 100755 index d8fee06e8..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/DatabasePanel.pm +++ /dev/null @@ -1,277 +0,0 @@ -#!/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/pki/base/tps/lib/perl/PKI/TPS/DisplayCertChain2Panel.pm b/pki/base/tps/lib/perl/PKI/TPS/DisplayCertChain2Panel.pm deleted file mode 100755 index 3a86ab0bd..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/DisplayCertChain2Panel.pm +++ /dev/null @@ -1,186 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; -use FileHandle; - -package PKI::TPS::DisplayCertChain2Panel; -$PKI::TPS::DisplayCertChain2Panel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -our $cert_header="-----BEGIN CERTIFICATE-----"; -our $cert_footer="-----END CERTIFICATE-----"; - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(7); - $self->{"getName"} = &PKI::TPS::Common::r("Display Certificate Chain"); - $self->{"vmfile"} = "displaycertchain2panel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub readFile -{ - my $fn = $_[0]; - open FILE, "< $fn" or return ""; - my $content = join "",<FILE>; - close FILE; - - return $content; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("DisplayCertChain2Panel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("DisplayCertChain2Panel: update"); - - my $instanceDir = $::config->get("service.instanceDir"); - -# my $caCert = readFile("$instanceDir/conf/caCertChain2.txt"); - my $caCert = extract_cert_from_file_sans_header_and_footer("$instanceDir/conf/caCertChain2.txt"); - - #store in config - $::config->put("preop.ca.certchain", $caCert); - $::config->commit(); - # import it into the security database - my $tmp = `p7tool -d $instanceDir/alias -p $instanceDir/conf/chain2cert -a -i $instanceDir/conf/caCertChain2.txt -o $instanceDir/conf/CAchain2_pp.txt`; - my $r = $? >> 8; - my $failed = $? & 127; - if (($r > 0) && ($r < 10) && !$failed) { - my $i = 0; - while ($i ne $r) { - $tmp = `certutil -d $instanceDir/alias -D -n "Trusted CA c2cert$i"`; - $tmp = `certutil -d $instanceDir/alias -A -f $instanceDir/conf/.pwfile -n "Trusted CA c2cert$i" -t "CT,C,C" -i $instanceDir/conf/chain2cert$i.der`; - $i++ - } - } - - # clean up -# my $tmp = `rm $instanceDir/conf/caCertChain2.txt`; -# $tmp = `rm $instanceDir/conf/CAchain2_pp.txt`; - - $::config->put("preop.displaycertchain2.done", "true"); - $::config->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("DisplayCertChain2Panel: display"); - my $instanceDir = $::config->get("service.instanceDir"); - - my $found = -e "$instanceDir/conf/caCertChain2.txt"; - my $certpp = ""; - if ($found) { - &PKI::TPS::Wizard::debug_log("DisplayCertChain2Panel: display found caCertChain2.txt"); - my $tmp = `p7tool -d $instanceDir/alias -p $instanceDir/conf/chain2cert -a -i $instanceDir/conf/caCertChain2.txt -o $instanceDir/conf/CAchain2_pp.txt`; - - $certpp = readFile("$instanceDir/conf/CAchain2_pp.txt"); - &PKI::TPS::Wizard::debug_log("DisplayCertChain2Panel: display read CAchain2_pp.txt"); - $certpp =~ s/"//g; - &PKI::TPS::Wizard::debug_log("DisplayCertChain2Panel: certpp2= $certpp"); - } - -# $symbol{certchain} = [ "cert1", "cert2" ]; -# $symbol{certchain_size} = 2; - $::symbol{certchain} = "$certpp"; - $::symbol{certchain_size} = 1; - - &PKI::TPS::Wizard::debug_log("DisplayCertChain2Panel: display done"); - return 1; -} - -# return certificate sans header and footer -# -- all in a one-liner -sub extract_cert_from_file_sans_header_and_footer -{ - my $filename = $_[0]; - my $save_line = 0; - - my $fd = new FileHandle; - - my $cert = ""; - - $fd->open( "<$filename" ) or die "Could not open '$filename'!\n"; - - while( <$fd> ) - { - my $line = $_; - chomp( $line ); - $line =~ s/^M//g; - - if( $line eq $cert_header ) { - $save_line = 1; - } elsif( $line eq $cert_footer ) { - $save_line = 0; - last; - } elsif( $save_line == 1 ) { - $cert .= "$line"; - } - } - - $fd->close(); - - return $cert; -} - -sub is_panel_done -{ - return $::config->get("preop.displaycertchain2.done"); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/DisplayCertChainPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/DisplayCertChainPanel.pm deleted file mode 100755 index 68b64a4b5..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/DisplayCertChainPanel.pm +++ /dev/null @@ -1,355 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; -use URI::URL; -use MIME::Base64; - -package PKI::TPS::DisplayCertChainPanel; -$PKI::TPS::DisplayCertChainPanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(2); - $self->{"getName"} = &PKI::TPS::Common::r("Display Certificate Chain"); - $self->{"vmfile"} = "displaycertchainpanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 1; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: validate"); - return 1; -} - -sub readFile -{ - my $fn = $_[0]; - open FILE, "< $fn" or return ""; - my $content = join "",<FILE>; - close FILE; - - return $content; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: update"); - - my $instanceDir = $::config->get("service.instanceDir"); - - my $caCert = readFile("$instanceDir/conf/caCert.txt"); - - #store in config - $::config->put("preop.ca.certchain", $caCert); - $::config->commit(); - - # import it into the security database -# my $cmd1 = `/usr/bin/AtoB $instanceDir/conf/caCert.txt $instanceDir/conf/caCert.der`; - my $cmd2 = `/usr/bin/certutil -A -d \"$instanceDir/alias\" -t \"CT,CT,CT\" -n \"caCert\" -i $instanceDir/conf/caCert.der`; - - # clean up - my $tmp = `rm $instanceDir/conf/caCert.txt`; - $tmp = `rm $instanceDir/conf/caCert.der`; - $tmp = `rm $instanceDir/conf/caCert_pp.txt`; - - # complete the SecurityDomain task - my $sdomainAdminURL = $::config->get("config.sdomainAdminURL"); - if ($sdomainAdminURL eq "") { - return 2; - } - - my $machineName = $::config->get("service.machineName"); - my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort"); - my $unsecurePort = $::config->get("service.unsecurePort"); - - # check if url is accessible - # redirect to the security domain authentication - if ($ENV{'SERVER_PORT'} eq $unsecurePort) { - $::symbol{redirect} = $sdomainAdminURL . "/ca/admin/ca/securityDomainLogin?url=http%3A%2F%2F" . $machineName . "%3A" . $unsecurePort . "%2Ftps%2Fadmin%2Fconsole%2Fconfig%2Fwizard%3Fp%3D5%26subsystem%3DTPS"; - } else { - $::symbol{redirect} = $sdomainAdminURL . "/ca/admin/ca/securityDomainLogin?url=https%3A%2F%2F" . $machineName . "%3A" . $non_clientauth_securePort . "%2Ftps%2Fadmin%2Fconsole%2Fconfig%2Fwizard%3Fp%3D5%26subsystem%3DTPS"; - } - - get_domain_xml($sdomainAdminURL); - - $::config->put("preop.displaycertchain.done", "true"); - $::config->commit(); - - return 3; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: display"); - - # connect to the CA, and retrieve the CA certificate - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: update connecting to CA and retrieve cert chain"); - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $sdomainAdminURL = $::config->get("config.sdomainAdminURL"); - if ($sdomainAdminURL eq "") { - return 2; - } - - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - - my $url_info = new URI::URL($sdomainAdminURL); - my $sd_host = $url_info->host; - my $sd_admin_port = $url_info->port; - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $cmd = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -r \"/ca/admin/ca/getCertChain\" $sd_host:$sd_admin_port`; - - my $caCert = ""; - if ($cmd =~ /\<ChainBase64\>(.*)\<\/ChainBase64\>/) { - $caCert = $1; - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: ca= $caCert"); - } - - my $certpp = ""; - if ($caCert ne "") { - open(F, ">$instanceDir/conf/caCert.txt"); - print F $caCert; - close(F); - - # test to see if tmp directory exists, if not, create - my $found = -e "$instanceDir/conf/tmp"; - if (! $found) { - my $tmp = `mkdir $instanceDir/conf/tmp`; - } - - # import it into a temporary security database -# my $cmd1 = `/usr/bin/AtoB $instanceDir/conf/caCert.txt $instanceDir/conf/caCert.der`; - # my $cmd1 = `/usr/bin/openssl base64 -d -A -in $instanceDir/conf/caCert.txt -out $instanceDir/conf/caCert.der`; - - my $txt = `cat $instanceDir/conf/caCert.txt`; - open(OUT, ">$instanceDir/conf/caCert.der"); - print OUT MIME::Base64::decode($txt); - close(OUT); - - my $cmd2 = `/usr/bin/certutil -A -d \"$instanceDir/conf/tmp\" -t \"CT,CT,CT\" -n \"caCert\" -i $instanceDir/conf/caCert.der`; - - # get pretty print from temp db - my $tmp = `certutil -d $instanceDir/conf/tmp -n "caCert" -L > $instanceDir/conf/caCert_pp.txt`; - $certpp = readFile("$instanceDir/conf/caCert_pp.txt"); - $certpp =~ s/"//g; - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: certpp= $certpp"); - # clean up temp db - $tmp = `certutil -d $instanceDir/alias/tmp -D -n "caCert"`; - } else { - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: update no certchain found"); - } - - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: display certchain=$caCert"); - -# $symbol{certchain} = [ "cert1", "cert2" ]; -# $symbol{certchain_size} = 2; - $::symbol{certchain} = "$certpp"; -# This certchain_size does not matter - $::symbol{certchain_size} = 1; - - return 1; -} - -sub get_domain_xml -{ - my ($sdomainAdminURL) = @_; - - my $sdom_info = new URI::URL($sdomainAdminURL); - # get the domain xml - # e. g. - https://water.sfbay.redhat.com:9445/ca/admin/ca/getDomainXML - - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - - my $sd_host = $sdom_info->host; - my $sd_admin_port = $sdom_info->port; - my $content = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -r \"/ca/admin/ca/getDomainXML\" $sd_host:$sd_admin_port`; - - $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; - $content = $1; - - &PKI::TPS::Wizard::debug_log("content = " . $content); - - my $parser = XML::Simple->new(); - my $response = $parser->XMLin($content); - my $xml = $parser->XMLin($response->{'DomainInfo'}, - ForceArray => 1); - - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: security domain '" . - $xml->{'Name'}[0] . "'"); - $::config->put("preop.securitydomain.name", $xml->{'Name'}[0]); - $::config->put("securitydomain.name", $xml->{'Name'}[0]); - - # parse xml and store information in CS.cfg - my $count = 0; - $count = 0; - foreach my $c (@{$xml->{'CAList'}[0]->{'CA'}}) { - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: Found CA '" . - $c->{'SubsystemName'}[0] . "'"); - $::config->put("preop.securitydomain.ca" . $count . ".subsystemname", - $c->{'SubsystemName'}[0]); - $::config->put("preop.securitydomain.ca" . $count . ".secureport", - $c->{'SecurePort'}[0]); - $::config->put("preop.securitydomain.ca" . $count . ".secureagentport", - $c->{'SecureAgentPort'}[0]); - $::config->put("preop.securitydomain.ca" . $count . ".secureadminport", - $c->{'SecureAdminPort'}[0]); - $::config->put("preop.securitydomain.ca" . $count . ".unsecureport", - $c->{'UnSecurePort'}[0]); - $::config->put("preop.securitydomain.ca" . $count . ".host", - $c->{'Host'}[0]); - - # The user previously specified the CA Security Domain's - # SSL Admin URL in the "Security Domain Panel"; - # now retrieve this specified CA Security Domain's - # non-SSL EE, SSL Agent, and SSL EE URLs: - if( $sd_admin_port eq $c->{'SecureAdminPort'}[0] ) { - # Build the URLs - my $http_ee_port = "https://" - . $c->{'Host'}[0] - . ":" - . $c->{'UnSecurePort'}[0]; - my $https_agent_port = "https://" - . $c->{'Host'}[0] - . ":" - . $c->{'SecureAgentPort'}[0]; - my $https_ee_port = "https://" - . $c->{'Host'}[0] - . ":" - . $c->{'SecurePort'}[0]; - - # Store the URLs - $::config->put( "config.sdomainHttpURL", $http_ee_port ); - $::config->put( "config.sdomainAgentURL", $https_agent_port ); - $::config->put( "config.sdomainEEURL", $https_ee_port ); - - # Store additional values necessary for 'pkiremove' . . . - $::config->put( "securitydomain.httpport", - $c->{'UnSecurePort'}[0] ); - $::config->put( "securitydomain.httpsagentport", - $c->{'SecureAgentPort'}[0] ); - $::config->put( "securitydomain.httpseeport", - $c->{'SecurePort'}[0] ); - } - - $count++; - } - - $count = 0; - foreach my $c (@{$xml->{'TKSList'}[0]->{'TKS'}}) { - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: Found TKS '" . - $c->{'SubsystemName'}[0] . "'"); - $::config->put("preop.securitydomain.tks" . $count . ".subsystemname", - $c->{'SubsystemName'}[0]); - $::config->put("preop.securitydomain.tks" . $count . ".secureport", - $c->{'SecurePort'}[0]); - $::config->put("preop.securitydomain.tks" . $count . ".secureagentport", - $c->{'SecureAgentPort'}[0]); - $::config->put("preop.securitydomain.tks" . $count . ".secureadminport", - $c->{'SecureAdminPort'}[0]); - $::config->put("preop.securitydomain.tks" . $count . ".unsecureport", - $c->{'UnSecurePort'}[0]); - $::config->put("preop.securitydomain.tks" . $count . ".host", - $c->{'Host'}[0]); - $count++; - } - - $count = 0; - foreach my $c (@{$xml->{'KRAList'}[0]->{'KRA'}}) { - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: Found KRA '" . - $c->{'SubsystemName'}[0] . "'"); - $::config->put("preop.securitydomain.kra" . $count . ".subsystemname", - $c->{'SubsystemName'}[0]); - $::config->put("preop.securitydomain.kra" . $count . ".secureport", - $c->{'SecurePort'}[0]); - $::config->put("preop.securitydomain.kra" . $count . ".secureagentport", - $c->{'SecureAgentPort'}[0]); - $::config->put("preop.securitydomain.kra" . $count . ".secureadminport", - $c->{'SecureAdminPort'}[0]); - $::config->put("preop.securitydomain.kra" . $count . ".unsecureport", - $c->{'UnSecurePort'}[0]); - $::config->put("preop.securitydomain.kra" . $count . ".host", - $c->{'Host'}[0]); - $count++; - } - - $count = 0; - foreach my $c (@{$xml->{'TPSList'}[0]->{'TPS'}}) { - &PKI::TPS::Wizard::debug_log("DisplayCertChainPanel: Found TPS '" . - $c->{'SubsystemName'}[0] . "'"); - $::config->put("preop.securitydomain.tps" . $count . ".subsystemname", - $c->{'SubsystemName'}[0]); - $::config->put("preop.securitydomain.tps" . $count . ".secureport", - $c->{'SecureAgentPort'}[0]); - $::config->put("preop.securitydomain.tps" . $count . ".non_clientauth_secure_port", - $c->{'SecurePort'}[0]); - $::config->put("preop.securitydomain.tps" . $count . ".unsecureport", - $c->{'UnSecurePort'}[0]); - $::config->put("preop.securitydomain.tps" . $count . ".host", - $c->{'Host'}[0]); - $count++; - } - $::config->commit(); -} - -sub is_panel_done -{ - return $::config->get("preop.displaycertchain.done"); -} - - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/DonePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/DonePanel.pm deleted file mode 100755 index 3d897fca9..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/DonePanel.pm +++ /dev/null @@ -1,437 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; -use URI::URL; -use XML::Simple; - -package PKI::TPS::DonePanel; -$PKI::TPS::DonePanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(16); - $self->{"getName"} = &PKI::TPS::Common::r("Done"); - $self->{"vmfile"} = "donepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("DonePanel: validate"); - return 1; -} -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("DonePanel: update"); - return 1; -} - -sub register_tps -{ - my ($sdom, $url, $uri, $xname) = @_; - - &PKI::TPS::Wizard::debug_log("DonePanel: register_tps at $url"); - &PKI::TPS::Wizard::debug_log("DonePanel: subsystem $xname uri=$uri"); - - my $url_info = new URI::URL($url); - my $sdom_info = new URI::URL($sdom); - - # register TPS to Security Domain - # submit request to CA - &PKI::TPS::Wizard::debug_log("DonePanel: Connecting to Security Domain"); - - my $machineName = $::config->get("service.machineName"); - my $unsecurePort = $::config->get("service.unsecurePort"); - my $securePort = $::config->get("service.securePort"); - my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort"); - my $session_id = $::config->get("preop.sessionID"); - - &PKI::TPS::Wizard::debug_log("DonePanel: Security Domain Info " . $url); - - # add service.securityDomainPort to the config file in case pkiremove - # needs to remove system reference from the security domain - $::config->put("service.securityDomainPort", $securePort); - $::config->commit(); - - my $uid = "TPS-" . $machineName . "-" . $securePort; - my $name = "Token Processing Subsystem"; - - my $instDir = $::config->get("service.instanceDir"); - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - - my $hw; - my $tk; - my $tokenname = $::config->get("preop.module.token"); - &PKI::TPS::Wizard::debug_log("ReqCertInfo: update got token name = $tokenname"); - - my $token_pwd = $::pwdconf->get($tokenname); - open FILE, ">$instDir/conf/.pwfile"; - system( "chmod 00660 $instDir/conf/.pwfile" ); - $token_pwd =~ s/\n//g; - print FILE $token_pwd; - close FILE; - - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - $hw = ""; - $tk = ""; - } else { - $hw = "-h $tokenname"; - $tk = $tokenname.":"; - } - - my $subsystemNickname = $::config->get("preop.cert.subsystem.nickname"); - - my $certificate = `/usr/bin/certutil -d "$instDir/alias" -L $hw -f "$instDir/conf/.pwfile" -n "$subsystemNickname" -a`; - my $tmp = `rm $instDir/conf/.pwfile`; - $certificate =~ s/-----BEGIN CERTIFICATE-----//g; - $certificate =~ s/-----END CERTIFICATE-----//g; - $certificate =~ s/\n$//g; - - - &PKI::TPS::Wizard::debug_log("DonePanel: Connecting"); - - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - - my $params = "uid=" . $uid . "&" . - "name=" . $name . "&" . - "certificate=" . - URI::Escape::uri_escape("$certificate") . "&" . - "xmlOutput=true" . "&" . - "sessionID=" . $session_id . "&" . - "auth_hostname=" . $sdom_info->host . "&" . - "auth_port=" . $sdom_info->port; - - my $host = $url_info->host; - my $port = $url_info->port; - my $tmpfile = "/tmp/donepanel-$$"; - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"$uri\" $host:$port > $tmpfile"); - } else { - system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -n \"$nickname\" -r \"$uri\" $host:$port > $tmpfile"); - } - my $content = `cat $tmpfile`; - system("rm $tmpfile"); - - &PKI::TPS::Wizard::debug_log("req = " . $content); - $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; - $content = $1; - - if (defined $content) { - &PKI::TPS::Wizard::debug_log("DonePanel: result " . $content); - } else { - &PKI::TPS::Wizard::debug_log("DonePanel: result undefined"); - } -} - -sub get_kra_transport_cert -{ - my ($sdom) = @_; - - my $sdom_info = new URI::URL($sdom); - - # register TPS to Security Domain - # submit request to CA - &PKI::TPS::Wizard::debug_log("DonePanel: Connecting to KRA"); - - my $krainfo = $::config->get("preop.krainfo.select"); - my $krainfo_url = new URI::URL($krainfo); - - my $machineName = $::config->get("service.machineName"); - my $unsecurePort = $::config->get("service.unsecurePort"); - my $securePort = $::config->get("service.securePort"); - my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort"); - my $session_id = $::config->get("preop.sessionID"); - - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $tokenname = $::config->get("preop.module.token"); - my $token_pwd = $::pwdconf->get($tokenname); - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - - my $params = "sessionID=" . $session_id . "&" . - "auth_hostname=" . $sdom_info->host . "&" . - "auth_port=" . $sdom_info->port; - - my $host = $krainfo_url->host; - my $port = $krainfo_url->port; - my $tmpfile = "/tmp/donepanel-$$"; - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -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\>.*\<\/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\>.*\<\/XMLResponse\>)/; - $content = $1; - - &PKI::TPS::Wizard::debug_log("DonePanel: Response from TKS " . $content); -} - -sub display -{ - my ($q) = @_; - # $symbol{systemType} = "tps"; - # $symbol{host} = "chico"; - # $symbol{port} = "443"; - &PKI::TPS::Wizard::debug_log("DonePanel: display"); - - my $status = defined($::config->get("preop.done.status"))? $::config->get("preop.done.status") : ""; - if ($status eq "done") { - return 1; - } - - my $instDir = $::config->get("service.instanceDir"); - my $tokenname = $::config->get("preop.module.token"); - my $token_pwd = $::pwdconf->get($tokenname); - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - if (($tokenname ne "") && ($tokenname ne "NSS Certificate DB")) { - open(PWD_CONF, ">>$instDir/conf/password.conf"); - print PWD_CONF "$tokenname:$token_pwd\n"; - close (PWD_CONF); - } - - # Add this TPS's server certificate to the subsystems - my $sdom = $::config->get("config.sdomainEEURL"); - my $cainfo = $::config->get("preop.cainfo.select"); - $cainfo =~ s/.* - //g; - ®ister_tps($sdom, $cainfo, "/ca/admin/ca/registerUser", "CA"); - my $tksinfo = $::config->get("preop.tksinfo.select"); - ®ister_tps($sdom, $tksinfo, "/tks/admin/tks/registerUser", "TKS"); - - my $keygen = $::config->get("conn.tks1.serverKeygen"); - if ($keygen ne "false") { - &PKI::TPS::Wizard::debug_log("DonePanel: KRA available"); - my $krainfo = $::config->get("preop.krainfo.select"); - ®ister_tps($sdom, $krainfo, "/kra/admin/kra/registerUser", "KRA"); - my $transportCert = &get_kra_transport_cert($sdom); - &send_kra_transport_cert($sdom, $transportCert); - } else { - &PKI::TPS::Wizard::debug_log("DonePanel: No KRA setup"); - } - - # Give Object Signing capability to audit_signing cert - open FILE, ">$instDir/conf/.pwfile"; - system( "chmod 00660 $instDir/conf/.pwfile" ); - $token_pwd =~ s/\n//g; - print FILE $token_pwd; - close FILE; - my $hw; - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - $hw = ""; - } else { - $hw = "-h $tokenname"; - } - my $auditSigningNickname = $::config->get("preop.cert.audit_signing.nickname"); - my $tmp = `/usr/bin/certutil -d "$instDir/alias" -M $hw -f "$instDir/conf/.pwfile" -n "$auditSigningNickname" -t "u,u,Pu"`; - $tmp = `rm $instDir/conf/.pwfile`; - - $::config->put("preop.done.status", "done"); - $::config->put("tps.configured", "true"); - $::config->commit(); - - # update httpd.conf - open(TMP_HTTPD_CONF, ">$instDir/conf/httpd.conf.tmp"); - system( "chmod 00660 $instDir/conf/httpd.conf.tmp" ); - open(HTTPD_CONF, "<$instDir/conf/httpd.conf"); - while (<HTTPD_CONF>) { - if (/^#\[ErrorDocument_404\]/) { - print TMP_HTTPD_CONF "ErrorDocument 404 /404.html\n"; - } elsif (/^#\[ErrorDocument_500\]/) { - print TMP_HTTPD_CONF "ErrorDocument 500 /500.html\n"; - } else { - print TMP_HTTPD_CONF $_; - } - } - close(HTTPD_CONF); - close(TMP_HTTPD_CONF); - - # Create a copy of the original file which - # preserves the original file permissions - system( "cp -p $instDir/conf/httpd.conf.tmp $instDir/conf/httpd.conf" ); - - # Remove the original file only if the backup copy was successful - if( -e "$instDir/conf/httpd.conf" ) { - system( "rm $instDir/conf/httpd.conf.tmp" ); - } - - # update nss.conf - open(TMP_NSS_CONF, ">$instDir/conf/nss.conf.tmp"); - system( "chmod 00660 $instDir/conf/nss.conf.tmp" ); - open(NSS_CONF, "<$instDir/conf/nss.conf"); - while (<NSS_CONF>) { - if (/^NSSNickname/) { - print TMP_NSS_CONF "NSSNickname \"$nickname\"\n"; - } else { - print TMP_NSS_CONF $_; - } - } - close(NSS_CONF); - close(TMP_NSS_CONF); - - # Create a copy of the original file which - # preserves the original file permissions - system( "cp -p $instDir/conf/nss.conf.tmp $instDir/conf/nss.conf" ); - - # Remove the original file only if the backup copy was successful - if( -e "$instDir/conf/nss.conf" ) { - system( "rm $instDir/conf/nss.conf.tmp" ); - } - - &PKI::TPS::Wizard::debug_log("DonePanel: Connecting to Security Domain"); - - my $machineName = $::config->get("service.machineName"); - my $unsecurePort = $::config->get("service.unsecurePort"); - my $securePort = $::config->get("service.securePort"); - my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort"); - my $instanceID = $::config->get("service.instanceID"); - - my $initDaemon = "pki-tpsd"; - my $initCommand = ""; - if( $^O eq "linux" ) { - $initCommand = "/sbin/service $initDaemon"; - } else { - ## default case: e. g. - ( $^O eq "solaris" ) - $initCommand = "/etc/init.d/$initDaemon"; - } - - $::symbol{host} = $machineName; - $::symbol{unsecurePort} = $unsecurePort; - $::symbol{port} = $securePort; - $::symbol{non_clientauth_port} = $non_clientauth_securePort; - $::symbol{initCommand} = $initCommand; - $::symbol{instanceID} = $instanceID; - - $::config->deleteSubstore("preop."); - $::config->commit(); - - ## Create an empty file that designates the fact that although - ## this server instance has been configured, it has NOT yet - ## been restarted! - my $restart_server = "$instDir/conf/restart_server_after_configuration"; - system( "touch $restart_server" ); - system( "chmod 00660 $restart_server" ); - - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.donepanel.done"); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/GlobalVar.pm b/pki/base/tps/lib/perl/PKI/TPS/GlobalVar.pm deleted file mode 100755 index 73e7b831a..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/GlobalVar.pm +++ /dev/null @@ -1,41 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; - -package PKI::TPS::GlobalVar; -$PKI::TPS::GlobalVar::VERSION = '1.00'; - -sub new { - my $class = shift; - my $self = {}; - my %args = (@_); - foreach my $q (keys %args) { - $self->{$q} = $args{$q}; - } - bless $self,$class; - return $self; -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/ImportAdminCertPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/ImportAdminCertPanel.pm deleted file mode 100755 index dfec6ea80..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/ImportAdminCertPanel.pm +++ /dev/null @@ -1,163 +0,0 @@ -#!/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\>.*\<\/XMLResponse\>)/; - $content = $1; - &PKI::TPS::Wizard::debug_log($content); - - $::config->put("preop.importadmincert.done", "true"); - $::config->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("ImportAdminCertPanel: display"); - - my $cainfo = $::config->get("preop.cainfo.select"); - - my $cainfo_url = new URI::URL($cainfo); - my $serialNumber = $::config->get("preop.admincert.serialno.0"); - - $::symbol{info} = ""; - $::symbol{errorString} = ""; - $::symbol{import} = "true"; - $::symbol{ca} = "false"; - $::symbol{caType} = "ca"; - $::symbol{caHost} = $cainfo_url->host; - $::symbol{caPort} = $cainfo_url->port; - $::symbol{serialNumber} = $serialNumber; - - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.importadmincert.done"); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/Login.pm b/pki/base/tps/lib/perl/PKI/TPS/Login.pm deleted file mode 100755 index 01aa01f42..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/Login.pm +++ /dev/null @@ -1,466 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -# wizard - -# Fedora Certificate System - Token Processing System configuration wizard - - -# This script is run as a 'mod_perl' CGI. Configure mod_perl by adding -# the following to /etc/httpd/conf.d/perl.conf -# -# PerlModule ModPerl::Registry -# PerlModule Apache::compat -# PerlModule RHCS::TPS::Wizard -# PerlSetEnv RHCS_DOCROOT /u/sparkins/t/cs_tip/certsystem/prj/common/ui -# <Location /wizard> -# SetHandler perl-script -# PerlHandler RHCS::TPS::Wizard -# Order deny,allow -# Allow from all -# </Location> - - -# Note: The Velocity parser is not very helpful when it comes to -# errors right now. Here are some common errors, and what they mean: -# -# ERROR: -# [Mon Apr 03 13:57:33 2006] [error] [client 172.16.24.26] -# Can't use string ("0") as an ARRAY ref while "strict refs" -# in use at /usr/lib/perl5/site_perl/5.8.5/Template/Velocity.pm -# line 423.\n, referer: http://chico/wizard?p=2 -# MEANING -# This probably means that your *.vm file refers to an array -# variable in a foreach statement that is not defined -# Check your foreach array variables. - -use warnings; -use ModPerl::Registry; -use Template::Velocity; -use Getopt::Std; -use Data::Dumper; -use CGI::Carp qw(fatalsToBrowser); -use CGI; -use APR::Const -compile => qw(:error SUCCESS); -use PKI::TPS::GlobalVar; -use PKI::TPS::WelcomePanel; -use PKI::TPS::SecurityDomainPanel; -use PKI::TPS::DisplayCertChainPanel; -use PKI::TPS::SubsystemTypePanel; -use PKI::TPS::CAInfoPanel; -use PKI::TPS::TKSInfoPanel; -use PKI::TPS::DRMInfoPanel; -use PKI::TPS::DisplayCertChain2Panel; -use PKI::TPS::AdminAuthPanel; -use PKI::TPS::AgentAuthPanel; -use PKI::TPS::AuthDBPanel; -use PKI::TPS::DatabasePanel; -use PKI::TPS::ModulePanel; -use PKI::TPS::SizePanel; -use PKI::TPS::NamePanel; -use PKI::TPS::ConfigHSMLoginPanel; -use PKI::TPS::CertRequestPanel; -use PKI::TPS::AdminPanel; -use PKI::TPS::ImportAdminCertPanel; -use PKI::TPS::LoginPanel; -use PKI::TPS::DonePanel; -use PKI::TPS::Config; - -use PKI::TPS::Common qw(yes no r); - -package PKI::TPS::Login; -$PKI::TPS::Login::VERSION = '1.00'; - -# read configuration file -my $flavor = "pki"; -$flavor =~ s/\n//g; - -my $pkiroot = $ENV{PKI_ROOT}; - -my $config = PKI::TPS::Config->new(); -$config->load_file("$pkiroot/conf/CS.cfg"); -# read password cache file -my $pwdconf = PKI::TPS::Config->new(); -$pwdconf->load_file("$pkiroot/conf/pwcache.conf"); -# SELinux disallows performing a "chmod" on this file -if( $^O ne "linux" ) { - system( "chmod 00660 $pkiroot/conf/pwcache.conf" ); -} - -# create cfg debug log -my $logfile = $config->get("service.instanceDir") . "/logs/debug"; -open( DEBUG, ">>" . $logfile ) || -warn( "Could not open '" . $logfile . "': $!" ); - -# apache server - -our $debug; - -my $STATUS_OK = 1; -my $STATUS_ERROR = 2; -my $STATUS_REDIRECT = 3; - -&debug_log("TPS wizard: starting up"); - -my $docroot = $ENV{PKI_DOCROOT}; - -if (! $docroot) { - &debug_log("TPS wizard: ERROR: PKI_DOCROOT is null"); - return 0; -} - -our $parser = new Template::Velocity($docroot); -our $symbol; -our @certtags; - -makepanels(); - -&debug_log("TPS wizard: start up complete"); - -1; - -sub debug_log -{ - my ($msg) = @_; - my $date = `date`; - chomp($date); - if( -w $logfile ) { - print DEBUG "$date - $msg\n"; - } -} - - # initializes entries in parser's global symbol table for panels -sub makepanels -{ - #REAL PANELS BELOW - my $login = new PKI::TPS::LoginPanel(); - - $symbol{panels} = [ - $login, # com.netscape.cms.servlet.csadmin.WelcomePanel - ]; -}; - -sub render_panel -{ - my ($panelnum, $q) = @_; - - $symbol{errorString} = ""; - - my $currentpanel; - - if ($q->param('op') && $q->param('op') eq "next") { - $currentpanel = $symbol{panels}[$panelnum]; - # validate variables for panel - if ($currentpanel->{validate}) { - $currentpanel->{validate}($q); - } - # execute current panel - my $status = "0"; - - if ($currentpanel->{update}) { - $status = $currentpanel->{update}($q); - &debug_log("TPS wizard: update returns status '" . - $status . "'"); - if ($status == $STATUS_REDIRECT) { - return $STATUS_REDIRECT; - } - - } - - &debug_log("TPS wizard: about to find out about sub panel"); - if ($status eq "1") { - if ($currentpanel->{hasSubPanel} && &{$currentpanel->{hasSubPanel}}($q)) { - &debug_log("TPS wizard: has sub panel"); - $panelnum = $panelnum + 2; - } elsif ($currentpanel->{isSubPanel} && &{$currentpanel->{isSubPanel}}($q)) { - &debug_log("TPS wizard: is sub panel"); - $panelnum = $panelnum - 1; - } else { - &debug_log("TPS wizard: no sub panel and is not subpanel"); - $panelnum = $panelnum + 1; - } - } - } elsif ($q->param('op') && $q->param('op') eq "back") { - $panelnum = $panelnum - 1; - #check if this a subpanel, if so, go back to it's parent. - #only handles one-deep at this point - my $panel = $symbol{panels}[$panelnum]; - if (&{$panel->{isSubPanel}}($q)) { - $panelnum = $panelnum - 1; - } - } elsif ($q->param('op') && $q->param('op') eq "apply") { - &debug_log("TPS wizard: update : apply button pressed"); - $currentpanel = $symbol{panels}[$panelnum]; - # validate variables for panel - if ($currentpanel->{validate}) { - $currentpanel->{validate}($q); - } - # execute current panel - if ($currentpanel->{update}) { - my $status = $currentpanel->{update}($q); - &debug_log("TPS wizard: update returns status '" . - $status . "'"); - if ($status == $STATUS_REDIRECT) { - return $STATUS_REDIRECT; - } - - } - } - - &debug_log("TPS wizard: after looking into about sub panel"); - - # advance to next panel - $currentpanel = $symbol{panels}[$panelnum]; - - # initialize symbol table values - $symbol{showApplyButton} = "false"; - - # fill in variables for new panel - if ($currentpanel->{panelvars}) { - $Data::Dumper::Indent = 1; - # The '&debug_log("q=".Dumper($q));' call must be commented out to fix - # Bugzilla Bug #249923: Incorrect file permissions on - # various files and/or directories - # &debug_log("q=".Dumper($q)); - $currentpanel->{panelvars}($q); - } - - $symbol{panel} = "tps/admin/console/config/".$currentpanel->{vmfile}; - - #wizard.vm: - $symbol{name} = "Token Processing System"; - $symbol{title} = $currentpanel->{getName}(); - if ($panelnum == 0) { - $symbol{firstpanel} = "1"; - } else { - $symbol{firstpanel} = "0"; - } - if ($panelnum == 17) { - $symbol{lastpanel} = "1"; - } else { - $symbol{lastpanel} = "0"; - } - $symbol{p} = $panelnum; - $symbol{subpanelno} = $panelnum+1; - $symbol{csstate} = "1"; - -# $symbol{urls} = [ "cert1", "cert2" ]; #createsubsystem -# $symbol{urls_size} = 2; -# $symbol{instanceId} = "tps"; -# $symbol{errorString} = ""; - - #modulepanel -# $symbol{certs} = [ ]; -# $symbol{reqscerts} = [ ]; - $symbol{ppcerts} = [ ]; - - return $STATUS_OK; -} - - - -sub dbg { - my $msg = shift; - $::symbol{dbg} .= "$msg\n"; -} - -sub handler { - my $r = shift; - - *::symbol = \%symbol; - *::s = \$s; - *::config = \$config; - *::pwdconf = \$pwdconf; - - &debug_log("TPS wizard: in handler"); - if ($#ARGV == -1) { - $r->send_http_header('text/html'); - } - - my $q = new CGI; - - # check cookie - my $pin = $q->param('pin'); - if (defined($pin)) { - my $cookie = $q->cookie( - -name=>'pin', - -value=> $pin, - -expires=>'+1y', - -path=>'/'); - print $q->redirect(-location => "wizard", -cookie => $cookie); - return; - } - - # output http parameters - &debug_log("TPS wizard: uri='" . $ENV{REQUEST_URI} . "'"); - my @pnames = $q->param(); - foreach $pn (@pnames) { - # added this facility so that password can be hidden, - # all sensitive parameters should be prefixed with - # __ (double underscores); however, in the event that - # a security parameter slips through, we perform multiple - # additional checks to insure that it is NOT displayed - if( $pn =~ /^__/ || - $pn =~ /password$/ || - $pn =~ /passwd$/ || - $pn =~ /pwd$/ || - $pn =~ /admin_password_again/i || - $pn =~ /directoryManagerPwd/i || - $pn =~ /bindpassword/i || - $pn =~ /bindpwd/i || - $pn =~ /passwd/i || - $pn =~ /password/i || - $pn =~ /pin/i || - $pn =~ /pwd/i || - $pn =~ /pwdagain/i || - $pn =~ /uPasswd/i ) { - &debug_log("TPS wizard: http parameter name='" . $pn . "' value='(sensitive)'"); - } else { - &debug_log("TPS wizard: http parameter name='" . $pn . "' value='" . $q->param($pn) . "'"); - } - } - - my $panelnum = $q->param('p'); - if (!defined($panelnum) || $panelnum eq "") { - # Apache fails to pick up the p parameter after - # redirecting from the security domain. This is - # a quick hack to solve the issue. - if ($ENV{'QUERY_STRING'} ne "") { - $ENV{'QUERY_STRING'} =~ /p=([0-9]+)&/; - $panelnum = $1; - } - } - - use subs qw(debug); - *debug = \&Template::Velocity::Executor::debug; - - $::symbol{dbg} = ""; - - &debug_log("TPS wizard: before argparsing"); - if ($#ARGV == -1) { - $Data::Dumper::Maxdepth = 7; - $startfile = "tps/admin/console/config/login.vm"; - } - - &debug_log("TPS wizard: setting up test objects"); - - #initialize from config file - my $certlist = $::config->get("preop.cert.list"); - if ($certlist eq "") { - $certlist = "sslserver,subsystem"; - } - @certtags = split(/,/, $certlist); - $numtags = @certtags; - if ($numtags eq 0) { - @certtags = ("sslserver", "subsystem"); - } - &debug_log("TPS wizard: found $numtags certtags"); - - if (! $panelnum) { - $panelnum = 0; - } - - my $status = render_panel($panelnum, $q); - if ($status == 3) { - $r->header_out(Location => $symbol{redirect}); - $r->status(301); - $r->send_http_header(); - return; - } - - use Data::Dumper; - &debug_log("TPS wizard: executing file $startfile"); - foreach $q (sort keys %symbol) { - &debug_log("TPS wizard:/config/wizard?p=9&SecToken=NSS%20Generic%20Crypto%20Services sym{$q}=".$symbol{$q}); - } - - my $result; - if ($q->param("xml") eq "true") { - $r->send_http_header('text/xml'); - $result = "<xml>"; - foreach $s (sort keys %symbol) { - if ($s =~ /^__/) { - next; - } - $result .= "<" . $s . ">"; - my $v = $symbol{$s}; - $result .= &get_xml($s, $v); - $result .= "</" . $s . ">"; - } - $result .= "</xml>"; - } else { - $result = $parser->execute_file($startfile); - if (!defined $result) { - die("Couldn't execute template file: $docroot/$startfile"); - } - } - - print "$result\n"; - return $STATUS_OK; -} - -sub get_xml -{ - my ($s, $v) = @_; - - my $result; - if (ref($v) eq "HASH") { - foreach my $xkey (keys %$v) { - $result .= "<" . $xkey . ">"; - $result .= &get_xml($xkey, $v{$xkey}); - # $result .= "-" . ref($xkey); - $result .= "</" . $xkey . ">"; - } - } elsif (ref($v) eq "PKI::TPS::CertInfo") { - my $certinfo = $v; - $result .= "<certinfo>"; - $result .= "<dn>" . $certinfo->get_dn() ."</dn>"; - $result .= "<tag>" . $certinfo->get_cert_tag() . "</tag>"; - $result .= "<friendly>" . $certinfo->get_user_friendly_name() . - "</friendly>"; - $result .= "</certinfo>"; - } elsif (ref($v) eq "PKI::TPS::ReqCertInfo") { - my $reqcertinfo = $v; - $result .= "<reqcertinfo>"; - $result .= "<name>" . $reqcertinfo->get_user_friendly_name() ."</name>"; - $result .= "<req>" . $reqcertinfo->get_request() ."</req>"; - $result .= "<cert>" . $reqcertinfo->get_cert() ."</cert>"; - $result .= "<certpp>" . $reqcertinfo->get_cert_pp() ."</certpp>"; - $result .= "<tag>" . $reqcertinfo->get_cert_tag() ."</tag>"; - $result .= "<dn>" . $reqcertinfo->get_cert_tag() ."</dn>"; - $result .= "</reqcertinfo>"; - } elsif (ref($v) eq "ARRAY") { - my $pos = 0; - foreach my $item (@$v) { - $result .= "<element>"; - $result .= &get_xml("p" . $pos, $item); - # $result .= "-" . ref($item); - $result .= "</element>"; - $pos++; - } - } else { - $result .= $v; - } - return $result; -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/LoginPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/LoginPanel.pm deleted file mode 100755 index d6592d46e..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/LoginPanel.pm +++ /dev/null @@ -1,98 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; - -package PKI::TPS::LoginPanel; -$PKI::TPS::LoginPanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(0); - $self->{"getName"} = &PKI::TPS::Common::r("Welcome"); - $self->{"vmfile"} = "login.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("WelcomePanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("WelcomePanel: update"); - $::config->put("preop.loginpanel.done", "true"); - $::config->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log($ENV{'SERVER_PORT'}); - &PKI::TPS::Wizard::debug_log("Debug=" . $::config->get("logging.debug.enable")); - &PKI::TPS::Wizard::debug_log("WelcomePanel: display"); - $::symbol{wizardname} = "TPS Configuration Wizard"; - $::symbol{systemname} = "TPS"; - $::symbol{fullsystemname} = "Token Processing System"; - - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.loginpanel.done"); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/ModulePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/ModulePanel.pm deleted file mode 100755 index 5e7089812..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/ModulePanel.pm +++ /dev/null @@ -1,278 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; -use PKI::TPS::Modutil; - -package PKI::TPS::ModulePanel; -$PKI::TPS::ModulePanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -our $modutil; - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(9); - $self->{"getName"} = &PKI::TPS::Common::r("Security Modules"); - $self->{"vmfile"} = "modulepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - - my $flavor = "pki"; - $flavor =~ s/\n//g; - - my $pkiroot = $ENV{PKI_ROOT}; - $modutil = new PKI::TPS::Modutil("$pkiroot/alias"); - - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 1; -} - -sub validate -{ - my ($q) = @_; - return 1; -} - -sub update -{ - my ($q) = @_; - my $defTok = $::config->get("preop.module.token"); - my $select = $q->param('choice'); - if ($select eq "") { - &PKI::TPS::Wizard::debug_log("ModulePanel -> update no selection found"); - $::symbol{errorString} = "No selection found"; - return 0; - } elsif ($defTok ne $select) { - &PKI::TPS::Wizard::debug_log("ModulePanel -> update changing defTok to $select"); - $::config->put("preop.module.token", $select); - } else { - # this is not an error...just information - &PKI::TPS::Wizard::debug_log("ModulePanel -> update defTok not changed"); - } - - $::config->put("preop.ModulePanel.done", "true"); - - $::config->commit(); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("ModulePanel -> display"); - getModules(); - my $defTok = $::config->get("preop.module.token"); - - $::symbol{defTok} = $defTok; - - return 1; -} - -use Data::Dumper; -sub getTokens { - my $modulename = shift; - - &PKI::TPS::Wizard::debug_log("ModulePanel -> getTokens"); - -#$Data::Dumper::Indent = 0; -#PKI::TPS::Wizard::dbg("in gettokens. modutil = ".Dumper($modutil)); - my @tokens; - my $mod = $modutil->getmodule($modulename); - foreach my $tokenname (keys %{$mod->{tokens}}) { - #PKI::TPS::Wizard::dbg("found token $tokenname"); - if ($tokenname ne "NSS Generic Crypto Services") { - my $token = $modutil->gettoken($tokenname); - my $t = new PKI::TPS::GlobalVar( - getNickName => sub { return $tokenname; }, - isLoggedIn => sub { return isLoggedIn($tokenname); }, - isPresent => sub { return 1; }, - ); - push @tokens, $t; - } else { - &PKI::TPS::Wizard::debug_log("ModulePanel -> getTokens token NSS Generic Crypto Services not available for key generation"); - - } - } - - return \@tokens; -} - -# if password is found, then it's considered "logged in" -# otherwise it is "not logged in" -sub Login { - my $tokenname = $_[0]; - my $pwd = defined($::pwdconf->get($tokenname)) ? $::pwdconf->get($tokenname) : ""; - if ($pwd ne "") { - &PKI::TPS::Wizard::debug_log("ModulePanel -> isLoggedIn retrieved pwd from pwdconf"); - return 1; - } - &PKI::TPS::Wizard::debug_log("ModulePanel -> isLoggedIn pwd not found from pwdconf for token: $tokenname"); - - if ($tokenname eq "NSS Certificate DB") { - my $instanceDir = $::config->get("service.instanceDir"); - &PKI::TPS::Wizard::debug_log("ModulePanel -> isLoggedIn get internal password for $tokenname"); - # these are referred as "internal" in password.conf - $pwd = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $pwd =~ s/\n//g; - $::pwdconf->put($tokenname, $pwd); - $::pwdconf->commit(); - - return 1; - } - return 0; -} - -sub isLoggedIn { - my $tokenname = $_[0]; - return &Login($tokenname); -} - -sub getModules { - my $count; - my $i; - my @supportedModules; - - &PKI::TPS::Wizard::debug_log("ModulePanel -> getModules"); - $count = $::config->get("preop.configModules.count"); - &PKI::TPS::Wizard::debug_log("ModulePanel -> getModules count =$count"); - - my @modules = $modutil->getmodules(); - # $::symbol{steve} = join ",Module:", @modules; - # $::symbol{steve}.= "\n"; - - my $x = " - preop.configModules.count=3 - preop.configModules.module0.commonName=NSS Internal PKCS #11 Module - preop.configModules.module0.imagePath=../img/mozilla.png - preop.configModules.module0.userFriendlyName=NSS Internal PKCS #11 Module - preop.configModules.module1.commonName=nfast - preop.configModules.module1.imagePath=../img/ncipher.png - preop.configModules.module1.userFriendlyName=nCipher's nFast Token Hardware Module - preop.configModules.module2.commonName=lunasa - preop.configModules.module2.imagePath=../img/safenet.png - preop.configModules.module2.userFriendlyName=SafeNet's LunaSA Token Hardware Module - "; - - my %supmodules; - for ($i=0; $i <$count; $i++) { - my $cn; - my $pn; - my $img; -# &PKI::TPS::Wizard::debug_log("ModulePanel -> getModules look for cn=","preop.configModules.module" , $i , ".commonName"); - $cn = $::config->get("preop.configModules.module$i.commonName"); - $supmodules{$cn} = 1; - - $pn = $::config->get("preop.configModules.module$i.userFriendlyName"); - $img = $::config->get("preop.configModules.module$i.imagePath"); - &PKI::TPS::Wizard::debug_log("ModulePanel -> getModules: got module $cn from config"); - - my $module = $modutil->getmodule($cn); - my $file = $module->{detail}->{"Library file"}; - &PKI::TPS::Wizard::debug_log("ModulePanel -> getModules Library file = $file"); - my $found = 0; - if (defined $file) { - $found = ($file =~ /Internal ONLY module/) || -e $file; - } - - my $name = $module->{detail}->{Name}; -# PKI::TPS::Wizard::dbg("name: $name"); - - $supportedModules[$i] = new PKI::TPS::GlobalVar( - getImagePath => sub { return $img; }, - getUserFriendlyName => sub { return $pn; }, - isFound => sub { return $found; }, - getTokens => sub { return getTokens($name); }, - ); - - # login to tokens - &PKI::TPS::Wizard::debug_log("Ready to login to tokens for $name"); - my $mod = $modutil->getmodule($name); - foreach my $tokenname (keys %{$mod->{tokens}}) { - &PKI::TPS::Wizard::debug_log("Logging in Module $name Token " . $tokenname); - &Login($tokenname); - } - - } - - my @otherModules; - #compile the "others" modules - - foreach my $modname (@modules) { - #is this modname in the supported modules list? - if ($supmodules{$modname}) { - &PKI::TPS::Wizard::debug_log("ModulePanel -> getModules: found module $modname supported"); - # does not belong to "others" - } else { - &PKI::TPS::Wizard::debug_log("ModulePanel -> getModules: found module $modname unsupported"); - #add the module to "others" list - my $m = $modutil->getmodule($modname); - my $mod = new PKI::TPS::GlobalVar( - getImagePath => sub { return ""; }, - getUserFriendlyName => sub { return $m->{modulename}; }, - isFound => sub { return 1; }, - getTokens => sub { return getTokens($m->{detail}->{Name});} - ); - - push @otherModules, $mod; - - &PKI::TPS::Wizard::debug_log("ModulePanel -> getModules: module $modname added to otherModules list"); - } - } - - $::symbol{sms} = \@supportedModules; - $::symbol{oms} = \@otherModules; -# PKI::TPS::Wizard::dbg("oms: ". Dumper([@otherModules])); -# PKI::TPS::Wizard::dbg("sms: ". Dumper([@supportedModules])); - - &PKI::TPS::Wizard::debug_log("ModulePanel -> set sms, oms"); -} - -sub is_panel_done -{ - return $::config->get("preop.ModulePanel.done"); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/Modutil.pm b/pki/base/tps/lib/perl/PKI/TPS/Modutil.pm deleted file mode 100755 index 49c248c2e..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/Modutil.pm +++ /dev/null @@ -1,263 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - - -package PKI::TPS::Modutil; - - -sub new { - my $class = shift; - my ($dir) = @_; - - if (! $dir) { die "no module directory provided\n"; } - - my $self = {}; - - $self->{dir} = $dir; - $self->{modules} = makemodules($self); - - bless $self, $class; - return $self; -} - -sub exists { - my $self = shift; - - return -e "$self->{dir}/secmod.db"; -} - -sub create { - my $self = shift; - - my $mods = `modutil -force -dbdir '$self->{dir}' -nocertdb -create`; - return $mods; -} - -use Data::Dumper; - -sub makemodules { - my $self = shift; - my $modules = {}; - - my $mods = `modutil -force -dbdir '$self->{dir}' -nocertdb -list`; - #my $mods = join "",<::DATA>; - - #print "raw mods = $mods"; - - my (@modules) = ( - $mods =~ / - ^ #beginning of a line - \s+ #some spaces - \d+\.\s* #some digits - (.*?) #lots of text - ((?=^\s*\d+)|(?=------)) #if we would next match some spaces and digits - /msxg ); - - @modules = grep /.+/ms, @modules; - - foreach $module (@modules) { - #print "Module #$i:$module --\n"; - $module = "modulename:$module"; - my ($moduleheader, $rest) = ( - $module =~ / - (.*status: .*?\n) # moduleheader - (\s*slot:.*) # slot - (?=\n(\n|$)) #empty line - /msxg ); - #print "moduleheader: $moduleheader\n"; - my $m = makehash($moduleheader); - $modules->{$m->{modulename}} = $m; - $m->{tokens} = {}; - - my @tokens = split "\n\n", $rest; - - - -# get summary slot info with: -list - foreach my $token (@tokens) { - #print "slottext: $slot\n"; - my $slh = makehash($token); - $m->{tokens}->{$slh->{token}} = $slh; - } - -# get detailed slot info with: -list "modulename" - - my $moduledetail = `modutil -force -dbdir '$self->{dir}' -nocertdb -list "$m->{modulename}" 2> /dev/null`; - my @details= split "\n\n", $moduledetail; - while ($details[0] !~ /.*Name:.*/) { - shift @details; - }; - - $m->{detail} = makehash(shift @details); - foreach $d (@details) { - my $sdh = makehash($d); - my $tokenname = $sdh->{"Token Name"}; - $tokenname =~ s/\s+$//; # remove trailing spaces - if ($tokenname) { - $m->{tokens}->{$tokenname}->{detail} = $sdh; - } - } - $i++; - - } - return $modules; -} - -# input: a multi-list string with nv/pairs -# return a hashtable reference -sub makehash { - my $str = shift; - my $ht = { }; - my @lines = split "\n", $str; - my $line; -LINE: - foreach $line (@lines) { - if ($line =~ /Using database directory/) { next LINE; } - if ($line =~ /--------------/) { next LINE; } - my ($name, $value) = ($line =~ /^\s*(.*?):\s*(.*?)\s*$/); - if ($name) { - #print "name:$name\n"; - #print "value:$value\n"; - $ht->{$name} = $value; - } - } - return $ht; -} - -sub getmodules { - my $self = shift; - #print "modules: ".$self->{modules}. "\n"; - #print "keys: ".(join ",",keys %{$self->{modules}})."\n"; - return keys %{$self->{modules}}; -} - -sub getmodule { - my $self = shift; - my $modulename = shift; - - #print Dumper($self->{modules}); - return $self->{modules}->{$modulename}; -} - - -sub gettokens { - my $self = shift; - my $module = shift; - - return keys %{$module->{tokens}}; -} - -sub gettoken { - my $self = shift; - my $token= shift; - foreach my $m (values %{$self->{modules}}) { - foreach $t (values %{$m->{tokens}}) { - #print join ",", keys %{$t}; - #print Dumper($t->{detail}); - if ($t->{detail}->{"Token Name"} eq $token) { - return $t; - } - } - } -} - - - -package main; - -sub ::test { - -# initialize - my $modutil = new PKI::TPS::Modutil("."); - -#make database if it doesn't exist - if (! $modutil->exists()) { - $modutil->create(); - } - -#get an array of module names - my @mods = $modutil->getmodules(); - - print "Found ".@mods." pkcs#11 modules\n"; - -#for each module... - foreach my $modname (@mods) { - my $module = $modutil->getmodule($modname); - - print "Module: $modname\n"; - print "Library: ".$module->{detail}->{"Library file"}."\n"; - print "Other keys: ".(join ",", keys %{$module->{detail}})."\n"; - -#find all the tokens in a module, e.g. each partition for a lunasa - foreach my $tokenname ($modutil->gettokens($module)) { - print " token: $tokenname\n"; - my $token = $modutil->gettoken($tokenname); - -#dump out the information we have on the token - foreach my $key (keys %{$token}) { - print " token keys/values: $key: ".$token->{$key}."\n"; - } - my @detailkeys = (keys %{$token->{detail}}) ; - print " token detail keys:". (join ",", @detailkeys)."\n"; - print " token detail Manufacturer:". $token->{detail}->{Manufacturer}."\n"; - print "\n"; - } - print "\n"; - } - -} - -# this is where 'main' starts - -if ($ARGV[0] eq "--test") { - ::test(); -} - -1; - -__DATA__ -Listing of PKCS #11 Modules ------------------------------------------------------------ - 1. NSS Internal PKCS #11 Module - slots: 2 slots attached - status: loaded - - slot: NSS Internal Cryptographic Services - token: NSS Generic Crypto Services - - slot: NSS User Private Key and Certificate Services - token: NSS Certificate DB - - 2. lunasa - library name: /usr/lunasa/lib/libCryptoki2.so - slots: 2 slots attached - status: loaded - - slot: LunaNet Slot - token: lunasa1-ca - - slot: LunaNet Slot - token: lunasa2-ca ------------------------------------------------------------ - - diff --git a/pki/base/tps/lib/perl/PKI/TPS/NamePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/NamePanel.pm deleted file mode 100755 index a474d80b9..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/NamePanel.pm +++ /dev/null @@ -1,611 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use FileHandle; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; -use PKI::TPS::CertInfo; -use URI::URL; -use URI::Escape; - -package PKI::TPS::NamePanel; -$PKI::TPS::NamePanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); -our $cert_req_header="-----BEGIN NEW CERTIFICATE REQUEST-----"; -our $cert_req_footer="-----END NEW CERTIFICATE REQUEST-----"; -our $cert_header="-----BEGIN CERTIFICATE-----"; -our $cert_footer="-----END CERTIFICATE-----"; - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(12); - $self->{"getName"} = &PKI::TPS::Common::r("Subject Names"); - $self->{"vmfile"} = "namepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("NamePanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("NamePanel: update"); - my $instanceDir = $::config->get("service.instanceDir"); - - my $count = $q->param('urls'); - - &PKI::TPS::Wizard::debug_log("NamePanel: update - selected ca= $count"); - - my $host = ""; - my $https_ee_port = ""; - - my $useExternalCA = "off"; - if ($count =~ /http/) { - my $info = new URI::URL($count); - $host = $info->host; - $https_ee_port = $info->port; - } else { - $host = $::config->get("preop.securitydomain.ca$count.host"); - if ($host eq "") { - $useExternalCA = "on"; - } else { - $https_ee_port = $::config->get("preop.securitydomain.ca$count.secureport"); - &PKI::TPS::Wizard::debug_log("NamePanel: update - host= $host, https_ee_port= $https_ee_port"); - } - } - $::config->put("preop.certenroll.useExternalCA", $useExternalCA); - - $::config->put("preop.ca.url", "https://" . $host . ":" . $https_ee_port); - - my $tokenname = $::config->get("preop.module.token"); - &PKI::TPS::Wizard::debug_log("NamePanel: update got token name = $tokenname"); - my $hw; - my $tk; - - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - $hw = ""; - $tk = ""; - } else { - $hw = "-h $tokenname"; - $tk = $tokenname.":"; - } - - # is nickname changed because of token (hardware) selection? - my $changed = "false"; - foreach my $certtag (@PKI::TPS::Wizard::certtags) { - &PKI::TPS::Wizard::debug_log("NamePanel: update begins for certag= $certtag"); - my $cert_dn = $q->param($certtag); - $::config->put("preop.cert.".$certtag.".dn", $cert_dn); - $::config->commit(); - - my $sslnickname = $::config->get("preop.cert.sslserver.nickname"); - my $nickname = $q->param($certtag . "_nick"); - if ($nickname ne "") { - &PKI::TPS::Wizard::debug_log("NamePanel: update nickname for $certtag set to $nickname"); - &PKI::TPS::Wizard::debug_log("NamePanel: update nickname for $certtag being updated in config file"); - $::config->put("preop.cert.".$certtag.".nickname", $nickname); - $::config->commit(); - } else { - $nickname = $::config->get("preop.cert.$certtag.nickname"); - if ($nickname eq "") { - $nickname = "TPS ".$certtag." cert"; - &PKI::TPS::Wizard::debug_log("NamePanel: update nickname not found for $certtag -- try $nickname"); - } - } - - my $cert_request = $::config->get("preop.cert.$certtag.certreq"); - if ($cert_request ne "") { - &PKI::TPS::Wizard::debug_log("NamePanel: update do not generate new keys"); - goto GEN_CERT; - } - &PKI::TPS::Wizard::debug_log("NamePanel: update generate new keys"); - - # =====generate requests======== - # getting new request should void old cert - my $file= "$instanceDir/conf/".$certtag."_cert.txt"; - my $tmp = `rm $file`; - - &PKI::TPS::Wizard::debug_log("NamePanel: retrieving $tokenname from pwdconf"); - my $token_pwd = $::pwdconf->get($tokenname); - &PKI::TPS::Wizard::debug_log("NamePanel: creating pwfile"); - open FILE, ">$instanceDir/conf/.pwfile"; - system( "chmod 00660 $instanceDir/conf/.pwfile" ); - $token_pwd =~ s/\n//g; - print FILE $token_pwd; - close FILE; - - my $keytype = $::config->get("preop.cert.$certtag.keytype"); - if ($keytype eq "") { - $keytype = "rsa"; - } - - my $select = $::config->get("preop.cert.$certtag.keysize.select"); - - my $keysize; - - if ($keytype eq "rsa") { - $keysize = 2048; - } elsif ($keytype eq "ecc") { - $keysize = 256; - } - - if (($select eq "") || ($select eq "default")) { - my $size = $::config->get("preop.cert.$certtag.keysize.size"); - if ($size ne "") { - $keysize = $size; - } - } else { - my $size = $::config->get("preop.cert.$certtag.keysize.customsize"); - if ($size ne "") { - $keysize = $size; - } - if (($keytype eq "ecc") && ($keysize ne 256)) { - &PKI::TPS::Wizard::debug_log("NamePanel: update got keysize from config= $keysize changing to 256, the only supported ECC strength"); - $keysize = 256; - } - } - - &PKI::TPS::Wizard::debug_log("NamePanel: update got key type $keytype"); - my $req; - my $debug_req; - my $filename = "/tmp/random.$$"; - `dd if\=/dev/urandom of\=\"$filename\" count\=256 bs\=1`; - if ($keytype eq "rsa") { - #XXX temporary - &PKI::TPS::Wizard::debug_log("NamePanel: update "."certutil -R -s $cert_dn -k $keytype -g $keysize -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -a -z $filename"); - my $tmpfile = "/tmp/req$$"; - system("certutil -R -s \"$cert_dn\" -k $keytype -g $keysize -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -a -z $filename > $tmpfile"); - $req = `cat $tmpfile`; - system("rm $tmpfile"); - } elsif ($keytype eq "ecc") { - #only support curve nistp256 for now - my $tmpfile = "/tmp/req$$"; - system("certutil -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -R -s \"$cert_dn\" -k ec -q nistp256 -a -z $filename> $tmpfile"); - $req = `cat $tmpfile`; - system("rm $tmpfile"); - } else { - &PKI::TPS::Wizard::debug_log("NamePanel: update unsupported keytype $keytype"); - } - system("rm $filename"); - - my $save_line = 0; - my @req_a = split "\n", $req; - foreach my $line (@req_a) { - chomp( $line ); - $line =~ s/
//g; - if ($line eq $cert_req_header) { - $save_line = 1; - } elsif( $line eq $cert_req_footer ) { - $save_line = 0; - last; - } elsif( $save_line == 1 ) { - $cert_request .= "$line"; - } - } - &PKI::TPS::Wizard::debug_log("NamePanel: update putting cert_request in CS.cfg: $cert_request"); - $::config->put("preop.cert.$certtag.certreq", $cert_request); - $::config->commit(); - -GEN_CERT: -# =====request for certs======== -# see if there is an existing cert - - my $cert = $::config->get("preop.cert.$certtag.cert"); - my $sdom = $::config->get("config.sdomainEEURL"); - my $sdom_url = new URI::URL($sdom); - - if (($useExternalCA eq "on") && ($certtag ne "subsystem")) { - &PKI::TPS::Wizard::debug_log("NamePanel: update External CA selected"); - if ($cert eq "") { - &PKI::TPS::Wizard::debug_log("NamePanel: update no cert found...need manual enrollment"); - } - } else { - if ($cert eq "") { - &PKI::TPS::Wizard::debug_log("NamePanel: update External CA not selected...need automatic enrollment"); - - my $machineName = $::config->get("service.machineName"); - my $securePort = $::config->get("service.securePort"); - my $session_id = $::config->get("preop.sessionID"); - - if ($cert_request ne "") { - &PKI::TPS::Wizard::debug_log("NamePanel: update found existing request: $cert_request"); - } else { - &PKI::TPS::Wizard::debug_log("NamePanel: update existing request not found"); - #something is wrong...no request, no cert - goto DONE; - return $cert; - } - - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = ""; - &PKI::TPS::Wizard::debug_log("NamePanel: greping password"); - - my $tmpfile = "/tmp/grep$$"; - system ("grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10- > $tmpfile"); - $db_password = `cat $tmpfile`; - $db_password =~ s/\n$//g; - system("rm $tmpfile"); - - my $profile_id = $::config->get("preop.cert.$certtag.profile"); - &PKI::TPS::Wizard::debug_log("NamePanel: profileId=" . $profile_id); - my $requestor_name = "TPS-" . $machineName . "-" . $securePort; - my $params = "profileId=" . $profile_id . "&" . - "cert_request_type=" . "pkcs10" . "&" . - "requestor_name=" . $requestor_name . "&" . - "cert_request=" . - URI::Escape::uri_escape("$cert_request") . "&" . - "xmlOutput=true" . "&" . - "sessionID=" . $session_id . "&" . - "auth_hostname=" . $sdom_url->host . "&" . - "auth_port=" . $sdom_url->port; - - if ($certtag eq "subsystem") { - $host = $sdom_url->host; - $https_ee_port = $sdom_url->port; - } - if ($changed eq "true") { -$req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$https_ee_port"; -$debug_req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"(sensitive)\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$https_ee_port"; - } else { -$req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$https_ee_port"; -$debug_req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"(sensitive)\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$https_ee_port"; - } - - &PKI::TPS::Wizard::debug_log("debug_req = " . $debug_req); - my $content = `$req`; - &PKI::TPS::Wizard::debug_log("content = " . $content); - - $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; - $content = $1; - - if ($content eq "") { - $::symbol{errorString} = "CA returned no response. Please check that the CA is available and also check the host's firewall settings."; - return 0; - } - - my $parser = XML::Simple->new(); - &PKI::TPS::Wizard::debug_log("NamePanel: response content= " . $content); - my $response = $parser->XMLin($content); - my $status = $response->{Status}; - if ($status ne "0") { - my $error = $response->{Error}; - &PKI::TPS::Wizard::debug_log("NamePanel: Error = $error"); - $::symbol{errorString} = "CA response: $error. Please check previous related panels." . " Please check that the CA is available and also check the host's firewall settings."; - return 0; - } - - $cert = $response->{Requests}->{Request}->{b64}; - &PKI::TPS::Wizard::debug_log("NamePanel: new cert generated= " . $cert); - -# my $reqid = $response->{Requests}->{Request}->{Id}; -# $::config->put("preop.admincert.requestId.0", $reqid); -# my $sn = $response->{Requests}->{Request}->{serialno}; -# $::config->put("preop.admincert.serialno.0", $sn); -# $::config->commit(); - - &PKI::TPS::Wizard::debug_log("NamePanel: update putting cert in CS.cfg: $cert"); - $::config->put("preop.cert.$certtag.cert", $cert); - $::config->commit(); - - } else { - # cert is not null - &PKI::TPS::Wizard::debug_log("NamePanel: update External CA not selected. Cert found...no need for enrollment"); - } - -# write cert to file so certutil can import - my $cert_fn = "$instanceDir/conf/".$certtag."_cert.txt"; - open FILE, "> $cert_fn"; - print FILE $cert_header."\n".$cert."\n".$cert_footer; - close FILE; - - # import cert, whether it was imported before or not - my $nickname = $::config->get("preop.cert.$certtag.nickname"); - if ($nickname eq "") { - #XXX - $nickname = "TPS ".$certtag." cert"; - &PKI::TPS::Wizard::debug_log("NamePanel: update nickname not found for $certtag -- try $nickname"); - } - - if ($certtag ne "sslserver") { - &PKI::TPS::Wizard::debug_log("NamePanel: update: try to delete existing cert $nickname, if any....ok if it fails"); - $tmp = `certutil -d $instanceDir/alias -D -n "$nickname"`; - $tmp = `certutil -d $instanceDir/alias -D $hw -f $instanceDir/conf/.pwfile -n "$tk$nickname"`; - } else { - &PKI::TPS::Wizard::debug_log("NamePanel: update: try to delete existing cert $sslnickname, if any....ok if it fails"); - $tmp = `certutil -d $instanceDir/alias -D -n "$sslnickname"`; - $tmp = `certutil -d $instanceDir/alias -D $hw -f $instanceDir/conf/.pwfile -n "$tk$sslnickname"`; - } - - &PKI::TPS::Wizard::debug_log("NamePanel: update: try to import cert from $cert_fn"); - $tmp = `certutil -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -A -n "$nickname" -t "u,u,u" -a -i $cert_fn`; - # changed the cert, need to change nickname too, if necessary - if ($hw ne "") { - if ($certtag eq "sslserver") { - if ($changed eq "false") { - $::config->put("preop.cert.$certtag.nickname", "$tk$nickname"); - } - $changed = "true"; - } - if ($certtag eq "subsystem") { - &PKI::TPS::Wizard::debug_log("NamePanel: update: sslnickname changed"); - $::config->put("preop.cert.$certtag.nickname", "$tk$nickname"); - $::config->put("conn.ca1.clientNickname", "$tk$nickname"); - $::config->put("conn.drm1.clientNickname", "$tk$nickname"); - $::config->put("conn.tks1.clientNickname", "$tk$nickname"); - } - $::config->commit(); - } else { - if ($certtag eq "subsystem") { - # setting these just in case the subsystem nickname changed. - &PKI::TPS::Wizard::debug_log("NamePanel: update: setting in case the subsystem nickname changed"); - $::config->put("conn.ca1.clientNickname", "$nickname"); - $::config->put("conn.drm1.clientNickname", "$nickname"); - $::config->put("conn.tks1.clientNickname", "$nickname"); - } - $::config->commit(); - } - - - &PKI::TPS::Wizard::debug_log("NamePanel: update: done importing cert: $tk$nickname"); - $tmp = `rm $cert_fn`; - } - } - - # set selftest 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 "",<FILE>; - close FILE; - - return $content; -} - -use Data::Dumper; - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("NamePanel: display"); - - my $domain_name = $::config->get("preop.securitydomain.name"); - if ($domain_name eq "") { - $domain_name = "TPS Domain"; - } - my $machine_name = $::config->get("service.machineName"); - my $instance_id = $::config->get("service.instanceID"); - - my $i = 0; - foreach my $certtag (@PKI::TPS::Wizard::certtags) { - &PKI::TPS::Wizard::debug_log("NamePanel: display certtag=$certtag"); - my $cert_dn = $::config->get("preop.cert.".$certtag.".dn"); - if ($cert_dn eq "") { - if ($certtag eq "subsystem") { - $cert_dn = "CN=TPS Subsystem, " . - "OU=" . $instance_id . ", " . - "O=" . $domain_name; - } elsif ($certtag eq "sslserver") { - $cert_dn ="CN=" . $machine_name . ", " . - "OU=" . $instance_id . ", " . - "O=" . $domain_name; - } else { - &PKI::TPS::Wizard::debug_log("NamePanel: display other certtag=$certtag"); - $cert_dn = $certtag; - } - $::config->put("preop.cert.".$certtag.".dn", $cert_dn); - $::config->commit(); - } else { - if (!($cert_dn =~ /O=/)) { - $cert_dn .= ", O=" . $domain_name; - $::config->put("preop.cert.".$certtag.".dn", $cert_dn); - $::config->commit(); - } - } - - my $name = $::config->get("preop.cert.".$certtag.".userfriendlyname"); - if ($name eq "") { - $name = $certtag."Cert ".$instance_id; - $::config->put("preop.cert.".$certtag.".userfriendlyname", $name); - $::config->commit(); - } - - my $cert = new PKI::TPS::CertInfo($name, - $cert_dn, $certtag); - $::symbol{certs}[$i++] = $cert; - } - - &PKI::TPS::Wizard::debug_log("NamePanel: getting CA info"); - $::symbol{urls} = []; - my $count = 0; - - while (1) { - my $host = $::config->get("preop.securitydomain.ca$count.host") || ""; - if ($host eq "") { - goto DONE; - } - my $https_ee_port = $::config->get("preop.securitydomain.ca$count.secureport"); - my $name = $::config->get("preop.securitydomain.ca$count.subsystemname"); - my $item = $name . " - https://" . $host . ":" . $https_ee_port; - $::symbol{urls}[$count++] = $item; - - } -DONE: - - $::symbol{urls}[$count++] = "External CA"; - $::symbol{urls_size} = $count+1; - - return 1; -} - - -# arg0 filename containing certificate request -# return certificate request plus header and footer -sub extract_cert_req_from_file -{ - my $save_line = 0; - - my $filename = $_[0]; - - my $fd = new FileHandle; - - my $cert_request = ""; - - $fd->open( "<$filename" ) or die "Could not open '$filename'!\n"; - - while( <$fd> ) - { - my $line = $_; - chomp( $line ); - - if( $line eq $cert_req_header ) { - $save_line = 1; - $cert_request .= "$line\n"; - } elsif( $line eq $cert_req_footer ) { - $cert_request .= "$line\n"; - $save_line = 0; - last; - } elsif( $save_line == 1 ) { - $cert_request .= "$line\n"; - } - } - - $fd->close(); - - return $cert_request; -} - -# arg0 message containing certificate request -# return certificate request sans header and footer -sub extract_cert_req_from_file_sans_header_and_footer -{ - my $filename = $_[0]; - my $save_line = 0; - - my $fd = new FileHandle; - - my $cert_request = ""; - - $fd->open( "<$filename" ) or die "Could not open '$filename'!\n"; - - while( <$fd> ) - { - my $line = $_; - chomp( $line ); - - if( $line eq $cert_req_header ) { - $save_line = 1; - } elsif( $line eq $cert_req_footer ) { - $save_line = 0; - last; - } elsif( $save_line == 1 ) { - $cert_request .= "$line\n"; - } - } - - $fd->close(); - - return $cert_request; -} - -sub is_panel_done -{ - return $::config->get("preop.namepanel.done"); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/ReqCertInfo.pm b/pki/base/tps/lib/perl/PKI/TPS/ReqCertInfo.pm deleted file mode 100755 index f2faee2c7..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/ReqCertInfo.pm +++ /dev/null @@ -1,234 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; - -package PKI::TPS::ReqCertInfo; -$PKI::TPS::ReqCertInfo::VERSION = '1.00'; - -our $cert_req_header="-----BEGIN NEW CERTIFICATE REQUEST-----"; -our $cert_req_footer="-----END NEW CERTIFICATE REQUEST-----"; -our $cert_header="-----BEGIN CERTIFICATE-----"; -our $cert_footer="-----END CERTIFICATE-----"; - -sub new { - my ($class, $name, $dn, $tag) = @_; - my $self = {}; - &PKI::TPS::Wizard::debug_log("ReqCertInfo: start new"); - &PKI::TPS::Wizard::debug_log("ReqCertInfo: creating name: $name, dn: $dn, tag: $tag"); - - $self->{"getUserFriendlyName"} = \&get_user_friendly_name; - $self->{"getCertTag"} = \&get_cert_tag; - $self->{"getCert"} = \&get_cert; - $self->{"getCertpp"} = \&get_cert_pp; - $self->{"getRequest"} = \&get_request; - $self->{"getDN"} = \&get_dn; - $self->{"useDefaultKey"} = \&use_default_key; - $self->{"getCustomKeysize"} = \&get_custom_keysize; - &PKI::TPS::Wizard::debug_log("ReqCertInfo: end new"); - - $self->{name} = $name; - $self->{dn} = $dn; - $self->{tag} = $tag; - - bless $self, $class; - return $self; -} - -sub get_user_friendly_name -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_user_friendly_name"); - return $self->{name}; -} - -sub readFile -{ - my $fn = $_[0]; - open FILE, "< $fn" or return ""; - my $content = join "",<FILE>; - close FILE; - - return $content; -} - -sub wrap_lines -{ - my $lines = shift; - my $temp ; - foreach my $line (split "\n", $lines) { - if (length $line > 59) { - $line =~ s/(.{0,60})/$1\n/g; - } - # get rid of a line that is just an empty newline - $line =~ s/^\n$//gms; - $temp .= $line; - } - # collapse multiple newlines into one - $temp =~ s/\n+/\n/gms; - $temp =~ s/\n$//gms; - $temp; - -} - -sub get_request -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_request"); - # first, try to see if request has been made before -# my $req = readFile( "/var/lib/pki-tps/conf/$self->{tag}_cert_request.txt"); - - my $req = $::config->get("preop.cert.$self->{tag}.certreq"); - - $req = wrap_lines($req); - - if ($req ne "") { - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_request found existing request"); - return $cert_req_header."\n".$req."\n".$cert_req_footer;; - } else { - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_request existing request not found"); - } - - return $req; -} - -sub get_cert -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert"); -# see if there is an existing cert -# my $cert = readFile("/var/lib/pki-tps/conf/".$self->{tag}."_cert.txt"); - my $cert = $::config->get("preop.cert.$self->{tag}.cert"); - - $cert = wrap_lines($cert); - if ($cert ne "") { - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert found existing cert"); - return $cert_header."\n".$cert."\n".$cert_footer;; - } else { - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert existing cert not found"); - } - if ($cert eq "") { - $cert = "...paste certificate here..."; - } - - - return $cert; -} - -sub get_cert_pp -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert_pp"); - my $instanceDir = $::config->get("service.instanceDir"); - - my $hw; - my $tokenname = $::config->get("preop.module.token"); - &PKI::TPS::Wizard::debug_log("ReqCertInfo: update got token name = $tokenname"); - - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - $hw = ""; - } else { - $hw = "-h $tokenname"; - } - - my $token_pwd = $::pwdconf->get($tokenname); - open FILE, ">$instanceDir/conf/.pwfile"; - system( "chmod 00660 $instanceDir/conf/.pwfile" ); - $token_pwd =~ s/\n//g; - print FILE $token_pwd; - close FILE; - - my $nickname = $::config->get("preop.cert.$self->{tag}.nickname"); - if ($nickname eq "") { -#XXX - $nickname = "TPS ".$self->{tag}." cert"; - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert_pp nickname not found for $self->{tag} -- try $nickname"); - } - my $certpp=""; -# my $found = -e "/var/lib/pki-tps/conf/$self->{tag}_cert.txt"; - my $cert = $::config->get("preop.cert.$self->{tag}.cert"); - - if ($cert ne "") { - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert_pp found request, ready to get prettyprint"); - my $tmp = `certutil -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -n "$nickname" -L > $instanceDir/conf/$self->{tag}_cert_pp.txt`; - $certpp = readFile("$instanceDir/conf/$self->{tag}_cert_pp.txt"); - $certpp =~ s/"//g; - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert_pp pp=$certpp"); - $tmp =`rm $instanceDir/conf/$self->{tag}_cert_pp.txt`; - } else { - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert_pp cert not found, will not get prettyprint"); - } - my $tmp = `rm $instanceDir/conf/.pwfile`; - - return $certpp; -} - -sub get_cert_tag -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert_tag"); - return $self->{tag}; -} - -sub get_dn -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_cert_dn"); - return $self->{dn}; -} - -sub use_default_key -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("ReqCertInfo: use_default_key"); - my $select = $::config->get("preop.cert.$self->{tag}.keysize.select"); - if ($select ne "") { - if ($select eq "custom") { - &PKI::TPS::Wizard::debug_log("ReqCertInfo: use_default_key from config = $select returning 0"); - return 0; - } - } - - &PKI::TPS::Wizard::debug_log("ReqCertInfo: use_default_key returning 1"); - return 1; -} - -sub get_custom_keysize -{ - my ($self) = @_; - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_custom_keysize"); - my $keysize = $::config->get("preop.cert.$self->{tag}.keysize.customsize"); - if ($keysize ne "") { - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_custom_keysize from config = $keysize"); - return $keysize; - } else { - &PKI::TPS::Wizard::debug_log("ReqCertInfo: get_custom_keysize not from config"); - } - return 2048; -} - - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/SecurityDomainPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/SecurityDomainPanel.pm deleted file mode 100755 index 5301d1369..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/SecurityDomainPanel.pm +++ /dev/null @@ -1,204 +0,0 @@ -#!/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\>.*\<\/XMLResponse\>)/; - $content = $1; - - my $parser = XML::Simple->new(); - my $response = $parser->XMLin($content); - my $state = $response->{State}; - - if( "$state" eq "1" ) { - return 1; - } else { - return 0; - } - } -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("SecurityPanel: display"); - $::symbol{panelname} = "Security Domain"; - $::symbol{sdomainName} = "Security Domain"; - - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $hostname = $::config->get("service.machineName"); - my $default_https_admin_port = 9445; - - # check to see if "default" security domain exists on local machine - my $status = pingCS( $instanceDir, - $db_password, - $nickname, - $hostname, - $default_https_admin_port ); - if( "$status" eq "1" ) { - # "default" security domain exists on local machine; - # fill "sdomainURL" in with "default" security domain - # as an initial "guess" - $::symbol{sdomainURL} = "https://" . $hostname . ":" - . $default_https_admin_port; - } else { - # "default" security domain does NOT exist on local machine; - # leave "sdomainURL" blank - $::symbol{sdomainURL} = ""; - } - - $::symbol{sdomainAdminURL} = "https://" . $hostname . ":" - . $default_https_admin_port; - - my $initDaemon = "pki-cad"; - my $initCommand = ""; - my $instanceID = "<security_domain_instance_name> "; - if( $^O eq "linux" ) { - $initCommand = "/sbin/service $initDaemon"; - } else { - ## default case: e. g. - ( $^O eq "solaris" ) - $initCommand = "/etc/init.d/$initDaemon"; - } - $::symbol{initCommand} = $initCommand; - $::symbol{instanceID} = $instanceID; - return 1; -} - - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("SecurityPanel: update"); - my $sdomainURL = $q->param("sdomainURL"); - - if ($sdomainURL eq "") { - &PKI::TPS::Wizard::debug_log("SecurityPanel: sdomainURL has not been specified!"); - $::symbol{errorString} = "Security Domain HTTPS has not been specified!"; - return 0; - } - - my $sdomainURL_info = new URI::URL($sdomainURL); - - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $hostname = $sdomainURL_info->host; - my $https_admin_port = $sdomainURL_info->port; - - # check to see if "default" security domain exists on local machine - my $status = pingCS( $instanceDir, - $db_password, - $nickname, - $hostname, - $https_admin_port ); - if( "$status" ne "1" ) { - # invalid security domain specified - &PKI::TPS::Wizard::debug_log("SecurityPanel: sdomainURL not found"); - $::symbol{errorString} = "Security Domain HTTPS Admin URL not found"; - return 0; - } - - # save urls in CS.cfg - &PKI::TPS::Wizard::debug_log("SecurityPanel: sdomainURL=" . $sdomainURL); - $::config->put("config.sdomainAdminURL", $sdomainURL); - - # Add values necessary for 'pkiremove' . . . - $::config->put("securitydomain.select", "existing"); - $::config->put("securitydomain.host", $sdomainURL_info->host); - $::config->put("securitydomain.httpsadminport", $sdomainURL_info->port); - $::config->put("preop.securitydomain.done", "true"); - $::config->commit(); - - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.securitydomain.done"); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/SizePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/SizePanel.pm deleted file mode 100755 index 8ac49b68d..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/SizePanel.pm +++ /dev/null @@ -1,249 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; -use PKI::TPS::CertInfo; - -package PKI::TPS::SizePanel; -$PKI::TPS::SizePanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(11); - $self->{"getName"} = &PKI::TPS::Common::r("Key Pairs"); - $self->{"vmfile"} = "sizepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("SizePanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("SizePanel: update"); - - my $instanceDir = $::config->get("service.instanceDir"); - my $done = $::config->get("preop.SizePanel.done"); - my $genKeyPair = $q->param('generateKeyPair') || ""; - &PKI::TPS::Wizard::debug_log("SizePanel: update generateKeyPair value=$genKeyPair"); - if ($done eq "true") { - if ($genKeyPair eq "") { - &PKI::TPS::Wizard::debug_log("SizePanel: update generateKeyPair value not found, turn to off"); - $genKeyPair = "off"; - } - } else { - # firstime should always generate keys - $genKeyPair = "on"; - } - - foreach my $certtag (@PKI::TPS::Wizard::certtags) { - my $select = $q->param($certtag.'_choice'); - my $keytype = $q->param($certtag.'_keytype'); - my $size = $q->param($certtag.'_custom_size'); - - &PKI::TPS::Wizard::debug_log("SizePanel: update $certtag _choice=$select $certtag _keytype=$keytype customsize= $size"); - - $::config->put("preop.keysize.select", $select); - $::config->put("preop.cert.".$certtag.".keysize.select", $select); - - if (! isSupportedSize($keytype, $size)) { - &PKI::TPS::Wizard::debug_log("SizePanel: update size $size not supported"); - return 0; - } - $::config->put("preop.cert.".$certtag.".keysize.customsize", $size); - $::config->put("preop.cert.".$certtag.".keytype", $keytype); - - if ($select eq "default") { - my $defaultSize = getDefaultSize($keytype); - &PKI::TPS::Wizard::debug_log("SizePanel: update in default, defaultsize = $defaultSize"); - $::config->put("preop.keysize.customsize", $defaultSize); - $::config->put("preop.keysize.size", $defaultSize); - $::config->put("preop.cert.".$certtag.".keysize.size", $defaultSize); - - } elsif ($select eq "custom") { - &PKI::TPS::Wizard::debug_log("SizePanel: update in custom, customsize = $size"); - $::config->put("preop.keysize.size", $size); - $::config->put("preop.cert.".$certtag.".keysize.size", $size); - } - - if ($genKeyPair eq "on") { - $::config->put("preop.cert.".$certtag.".certreq", ""); - $::config->put("preop.cert.".$certtag.".cert", ""); - } - } -#XXX should have better error checking to work better - $done = $::config->put("preop.SizePanel.done", "true"); - - $::config->commit(); - - return 1; -} - -sub getDefaultSize { - my $keytype = $_[0]; - - if ($keytype eq "ecc") { - return 256; - } elsif ($keytype eq "rsa") { - return 2048; - } - - $::symbol{errorString} = "Unsupported keytype $keytype"; - return 0; -} - -sub isSupportedSize { - my $keytype = $_[0]; - my $size = $_[1]; - - if (($keytype eq "ecc") && ($size ne "256")) { - &PKI::TPS::Wizard::debug_log("SizePanel: isSupportedSize ECC only supports size 256"); - $::symbol{errorString} = "Unsupported Size $size. ECC only supports size 256"; - return 0; - } - - if (($size eq "256") || ($size eq "512") || ($size eq "1024") || - ($size eq "2048") || ($size eq "4096")) { - return 1; - } - # wrong size - $::symbol{errorString} = "Unsupported Size $size. RSA only supports sizes 256, 512, 1024, 2048, and 4096"; - return 0; -} - -sub display -{ - my ($q) = @_; - - &PKI::TPS::Wizard::debug_log("SizePanel: display"); - - my $done = $::config->get("preop.SizePanel.done"); - &PKI::TPS::Wizard::debug_log("SizePanel: display is panel done? $done"); - if ($done eq "true") { - $::symbol{firsttime} = "false"; - } else { - $::symbol{firsttime} = "true"; - } - - my $domain_name = $::config->get("preop.securitydomain.name"); - if ($domain_name eq "") { - $domain_name = "TPS Domain"; - } - - my $machine_name = $::config->get("service.machineName"); - my $instance_id = $::config->get("service.instanceID"); - - my $i = 0; - foreach my $certtag (@PKI::TPS::Wizard::certtags) { - my $cert_dn = $::config->get("preop.cert.".$certtag.".dn"); - if ($cert_dn eq "") { - if ($certtag eq "subsystem") { - $cert_dn = "CN=TPS Subsystem, " . - "OU=" . $instance_id . ", " . - "O=" . $domain_name; - } elsif ($certtag eq "sslserver") { - $cert_dn ="CN=" . $machine_name . ", " . - "OU=" . $instance_id . ", " . - "O=" . $domain_name; - } else { - $cert_dn = $certtag; - } - } - my $name = $::config->get("preop.cert.".$certtag.".userfriendlyname"); - if ($name eq "") { - $name = $certtag."Cert ".$instance_id; - } - my $cert = new PKI::TPS::CertInfo($name, - $cert_dn, $certtag); - $::symbol{certs}[$i++] = $cert; - } - - #for "common key settings" - my $select = $::config->get("preop.keysize.select"); - if (($select eq "") || ($select eq "default")) { - $::symbol{select} = "default"; - } else { - &PKI::TPS::Wizard::debug_log("SizePanel: display keysize select= $select"); - $::symbol{select} = $select; - } - my $default_size = $::config->get("preop.keysize.size"); - if ($default_size eq "") { - $::symbol{default_keysize} = 2048; - } else { - $::symbol{default_keysize} = $default_size; - } - my $default_ecc_size = $::config->get("preop.keysize.ecc.size"); - if ($default_ecc_size eq "") { - $::symbol{default_ecc_keysize} = 256; - } else { - $::symbol{default_ecc_keysize} = $default_ecc_size; - } - - my $custom_size = $::config->get("preop.keysize.customsize"); - if ($custom_size eq "") { - $::symbol{custom_size} = 2048; - } else { - $::symbol{custom_size} = $default_size; - } - - - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.SizePanel.done"); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/SubsystemTypePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/SubsystemTypePanel.pm deleted file mode 100755 index 793849332..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/SubsystemTypePanel.pm +++ /dev/null @@ -1,147 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; - -package PKI::TPS::SubsystemTypePanel; -$PKI::TPS::SubsystemTypePanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(3); - $self->{"getName"} = &PKI::TPS::Common::r("Subsystem Type"); - $self->{"vmfile"} = "createsubsystempanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("SubsystemTypePanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("SubsystemTypePanel: update"); - $::symbol{systemname} = "Token Processing "; - $::symbol{subsystemName} = "Token Processing System"; - $::symbol{fullsystemname} = "Token Processing System "; - $::symbol{machineName} = "localhost"; - $::symbol{http_port} = "7888"; - $::symbol{https_port} = "7889"; - $::symbol{non_clientauth_https_port} = "7890"; - $::symbol{check_clonesubsystem} = " "; - $::symbol{check_newsubsystem} = " "; - $::symbol{disableClone} = 1; - - my $subsystemName = $q->param('subsystemName'); - $::config->put("preop.subsystem.name", $subsystemName); - $::config->put("preop.subsystemtype.done", "true"); - $::config->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("SubsystemTypePanel: display"); - $::symbol{systemname} = "Token Processing "; - $::symbol{subsystemName} = "Token Processing System"; - $::symbol{fullsystemname} = "Token Processing System "; - - my $machineName = $::config->get("service.machineName"); - my $unsecurePort = $::config->get("service.unsecurePort"); - my $securePort = $::config->get("service.securePort"); - my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort"); - - - $::symbol{machineName} = $machineName; - $::symbol{http_port} = $unsecurePort; - $::symbol{https_port} = $securePort; - $::symbol{non_clientauth_https_port} = $non_clientauth_securePort; - $::symbol{check_clonesubsystem} = ""; - $::symbol{check_newsubsystem} = "checked "; - - my $session_id = $q->param("session_id"); - $::config->put("preop.sessionID", $session_id); - $::config->commit(); - - $::symbol{urls} = []; - my $count = 0; - while (1) { - my $host = $::config->get("preop.securitydomain.tps$count.host") || ""; - if ($host eq "") { - goto DONE; - } - my $port = $::config->get("preop.securitydomain.tps$count.non_clientauth_secure_port"); - my $name = $::config->get("preop.securitydomain.tps$count.subsystemname"); - unshift(@{$::symbol{urls}}, "https://" . $host . ":" . $port); - $count++; - } -DONE: - $::symbol{urls_size} = $count; - -# if ($count == 0) { - $::symbol{disableClone} = 1; -# } - - # XXX - how to deal with urls - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.subsystemtype.done"); -} - - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/TKSInfoPanel.pm b/pki/base/tps/lib/perl/PKI/TPS/TKSInfoPanel.pm deleted file mode 100755 index 720093ac5..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/TKSInfoPanel.pm +++ /dev/null @@ -1,159 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; -use URI::URL; - -package PKI::TPS::TKSInfoPanel; -$PKI::TPS::TKSInfoPanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(5); - $self->{"getName"} = &PKI::TPS::Common::r("TKS Information"); - $self->{"vmfile"} = "tksinfopanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("TKSInfoPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("TKSInfoPanel: update"); - - my $count = defined($q->param('urls')) ? $q->param('urls') : ""; - if ($count eq "") { - $::symbol{errorString} = "no TKS info provided. CA, TKS and optionally DRM must be installed prior to TPS installation"; - return 0; - } - &PKI::TPS::Wizard::debug_log("TKSInfoPanel: update - got urls = $count"); - - my $instanceID = $::config->get("service.instanceID"); - my $host = ""; - my $https_agent_port = ""; - my $https_admin_port = ""; - - if ($count =~ /http/) { - # this is for pkisilent - my $info = new URI::URL($count); - $host = defined($info->host) ? $info->host : ""; - $https_agent_port = defined($info->port) ? $info->port : ""; - $https_admin_port = defined($q->param('adminport')) ? $q->param('adminport') : ""; - } else { - $host = defined($::config->get("preop.securitydomain.tks$count.host")) ? - $::config->get("preop.securitydomain.tks$count.host") : ""; - $https_admin_port = defined($::config->get("preop.securitydomain.tks$count.secureadminport")) ? - $::config->get("preop.securitydomain.tks$count.secureadminport") : ""; - $https_agent_port = defined($::config->get("preop.securitydomain.tks$count.secureagentport")) ? - $::config->get("preop.securitydomain.tks$count.secureagentport") : ""; - } - - if (($host eq "") || ($https_agent_port eq "")) { - $::symbol{errorString} = "no TKS found. CA, TKS and optionally DRM must be installed prior to TPS installation"; - return 0; - } - - if ($https_admin_port eq "") { - if ($count =~ /http/) { - $::symbol{errorString} = "TKS admin port must be provided"; - } else { - $::symbol{errorString} = "TKS admin port not provided by security domain."; - } - return 0; - } - - my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname"); - $::config->put("preop.tksinfo.select", "https://$host:$https_admin_port"); - $::config->put("conn.tks1.clientNickname", $subsystemCertNickName); - $::config->put("conn.tks1.hostport", $host . ":" . $https_agent_port); - $::config->put("preop.tksinfo.done", "true"); - $::config->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("TKSInfoPanel: display"); - $::symbol{urls} = []; - my $count = 0; - while (1) { - my $host = ""; - $host = $::config->get("preop.securitydomain.tks$count.host"); - if ($host eq "") { - goto DONE; - } - my $https_agent_port = $::config->get("preop.securitydomain.tks$count.secureagentport"); - my $name = $::config->get("preop.securitydomain.tks$count.subsystemname"); - $::symbol{urls}[$count++] = $name . " - https://" . $host . ":" . $https_agent_port; - } -DONE: - $::symbol{urls_size} = $count; - if ($count eq 0) { - $::symbol{errorString} = "no TKS found. CA, TKS and optionally DRM must be installed prior to TPS installation"; - return 0; - } - - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.tksinfo.done"); -} - - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/WelcomePanel.pm b/pki/base/tps/lib/perl/PKI/TPS/WelcomePanel.pm deleted file mode 100755 index a1c77e7cd..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/WelcomePanel.pm +++ /dev/null @@ -1,96 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -use strict; -use warnings; -use PKI::TPS::GlobalVar; -use PKI::TPS::Common; - -package PKI::TPS::WelcomePanel; -$PKI::TPS::WelcomePanel::VERSION = '1.00'; - -use PKI::TPS::BasePanel; -our @ISA = qw(PKI::TPS::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&is_panel_done; - $self->{"getPanelNo"} = &PKI::TPS::Common::r(0); - $self->{"getName"} = &PKI::TPS::Common::r("Welcome"); - $self->{"vmfile"} = "welcomepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("WelcomePanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("WelcomePanel: update"); - $::config->put("preop.welcome.done", "true"); - $::config->commit(); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::TPS::Wizard::debug_log("XXX " . $::config->get("logging.debug.enable")); - &PKI::TPS::Wizard::debug_log("WelcomePanel: display"); - $::symbol{wizardname} = "TPS Configuration Wizard"; - $::symbol{systemname} = "TPS"; - $::symbol{fullsystemname} = "Token Processing System"; - - return 1; -} - -sub is_panel_done -{ - return $::config->get("preop.welcome.done"); -} - -1; diff --git a/pki/base/tps/lib/perl/PKI/TPS/wizard.pm b/pki/base/tps/lib/perl/PKI/TPS/wizard.pm deleted file mode 100755 index db8b26526..000000000 --- a/pki/base/tps/lib/perl/PKI/TPS/wizard.pm +++ /dev/null @@ -1,509 +0,0 @@ -#!/usr/bin/perl -# -# --- BEGIN COPYRIGHT BLOCK --- -# This library is free software; you can redistribute it and/or -# modify it under the terms of the GNU Lesser General Public -# License as published by the Free Software Foundation; -# version 2.1 of the License. -# -# This library is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this library; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, -# Boston, MA 02110-1301 USA -# -# Copyright (C) 2007 Red Hat, Inc. -# All rights reserved. -# --- END COPYRIGHT BLOCK --- -# - -# wizard - -# Fedora Certificate System - Token Processing System configuration wizard - - -# This script is run as a 'mod_perl' CGI. Configure mod_perl by adding -# the following to /etc/httpd/conf.d/perl.conf -# -# PerlModule ModPerl::Registry -# PerlModule Apache::compat -# PerlModule RHCS::TPS::Wizard -# PerlSetEnv RHCS_DOCROOT /u/sparkins/t/cs_tip/certsystem/prj/common/ui -# <Location /wizard> -# SetHandler perl-script -# PerlHandler RHCS::TPS::Wizard -# Order deny,allow -# Allow from all -# </Location> - - -# Note: The Velocity parser is not very helpful when it comes to -# errors right now. Here are some common errors, and what they mean: -# -# ERROR: -# [Mon Apr 03 13:57:33 2006] [error] [client 172.16.24.26] -# Can't use string ("0") as an ARRAY ref while "strict refs" -# in use at /usr/lib/perl5/site_perl/5.8.5/Template/Velocity.pm -# line 423.\n, referer: http://chico/wizard?p=2 -# MEANING -# This probably means that your *.vm file refers to an array -# variable in a foreach statement that is not defined -# Check your foreach array variables. - -use warnings; -use ModPerl::Registry; -use Template::Velocity; -use Getopt::Std; -use Data::Dumper; -use CGI::Carp qw(fatalsToBrowser); -use CGI; -use APR::Const -compile => qw(:error SUCCESS); -use PKI::TPS::GlobalVar; -use PKI::TPS::WelcomePanel; -use PKI::TPS::SecurityDomainPanel; -use PKI::TPS::DisplayCertChainPanel; -use PKI::TPS::SubsystemTypePanel; -use PKI::TPS::CAInfoPanel; -use PKI::TPS::TKSInfoPanel; -use PKI::TPS::DRMInfoPanel; -use PKI::TPS::DisplayCertChain2Panel; -use PKI::TPS::AdminAuthPanel; -use PKI::TPS::AgentAuthPanel; -use PKI::TPS::AuthDBPanel; -use PKI::TPS::DatabasePanel; -use PKI::TPS::ModulePanel; -use PKI::TPS::SizePanel; -use PKI::TPS::NamePanel; -use PKI::TPS::ConfigHSMLoginPanel; -use PKI::TPS::CertRequestPanel; -use PKI::TPS::AdminPanel; -use PKI::TPS::ImportAdminCertPanel; -use PKI::TPS::DonePanel; -use PKI::TPS::Config; - -use PKI::TPS::Common qw(yes no r); - -package PKI::TPS::Wizard; -$PKI::TPS::Wizard::VERSION = '1.00'; - -# read configuration file -my $flavor = "pki"; -$flavor =~ s/\n//g; - -my $pkiroot = $ENV{PKI_ROOT}; - -my $config = PKI::TPS::Config->new(); -$config->load_file("$pkiroot/conf/CS.cfg"); -# read password cache file -my $pwdconf = PKI::TPS::Config->new(); -$pwdconf->load_file("$pkiroot/conf/pwcache.conf"); -# SELinux disallows performing a "chmod" on this file -if( $^O ne "linux" ) { - system( "chmod 00660 $pkiroot/conf/pwcache.conf" ); -} - -# create cfg debug log -my $logfile = $config->get("service.instanceDir") . "/logs/debug"; -system( "touch $logfile" ); -system( "chmod 00640 $logfile" ); -open( DEBUG, ">>" . $logfile ) || -warn( "Could not open '" . $logfile . "': $!" ); - -# apache server - -our $debug; - -my $STATUS_OK = 0; # Apache 2 needs this to be zero -my $STATUS_ERROR = 2; -my $STATUS_REDIRECT = 3; - -&debug_log("TPS wizard: starting up"); - -my $docroot = $ENV{PKI_DOCROOT}; - -if (! $docroot) { - &debug_log("TPS wizard: ERROR: PKI_DOCROOT is null"); - return 0; -} - -our $parser = new Template::Velocity($docroot); -our $symbol; -our @certtags; - -makepanels(); - -&debug_log("TPS wizard: start up complete"); - -1; - -sub debug_log -{ - my ($msg) = @_; - my $date = `date`; - chomp($date); - if( -w $logfile ) { - print DEBUG "$date - $msg\n"; - } -} - - # initializes entries in parser's global symbol table for panels -sub makepanels -{ - #REAL PANELS BELOW - my $welcome = new PKI::TPS::WelcomePanel(); - my $securitydomain = new PKI::TPS::SecurityDomainPanel(); - my $displaycertchain = new PKI::TPS::DisplayCertChainPanel(); - my $subsystem = new PKI::TPS::SubsystemTypePanel(); - my $cainfopanel = new PKI::TPS::CAInfoPanel(); -# my $displaycertchain2 = new PKI::TPS::DisplayCertChain2Panel(); - my $tksinfopanel = new PKI::TPS::TKSInfoPanel(); - my $drminfopanel = new PKI::TPS::DRMInfoPanel(); - my $authdbpanel = new PKI::TPS::AuthDBPanel(); - my $databasepanel = new PKI::TPS::DatabasePanel(); - my $modulepanel = new PKI::TPS::ModulePanel(); - my $confighsmloginpanel = new PKI::TPS::ConfigHSMLoginPanel(); - my $sizepanel = new PKI::TPS::SizePanel(); - my $namepanel = new PKI::TPS::NamePanel(); - my $certrequestpanel = new PKI::TPS::CertRequestPanel(); - my $adminpanel = new PKI::TPS::AdminPanel(); - my $importadmincertpanel = new PKI::TPS::ImportAdminCertPanel(); - my $donepanel = new PKI::TPS::DonePanel(); - - $symbol{panels} = [ - $welcome, # com.netscape.cms.servlet.csadmin.WelcomePanel - $modulepanel, # com.netscape.cms.servlet.csadmin.ModulePanel - $confighsmloginpanel, # com.netscape.cms.servlet.csadmin.ConfigHSMLoginPanel - $securitydomain, # com.netscape.cms.servlet.csadmin.SecurityDomainPanel - $displaycertchain, # com.netscape.cms.servlet.csadmin.DisplayCertChainPanel - $subsystem, # com.netscape.cms.servlet.csadmin.CreateSubsystemPanel - $cainfopanel, # com.netscape.cms.servlet.csadmin.CAInfoPanel -# $displaycertchain2, # com.netscape.cms.servlet.csadmin.DisplayCertChain2Panel - $tksinfopanel, # com.netscape.cms.servlet.csadmin.TKSInfoPanel - $drminfopanel, # com.netscape.cms.servlet.csadmin.DRMInfoPanel - $authdbpanel, # com.netscape.cms.servlet.csadmin.DatabasePanel - $databasepanel, # com.netscape.cms.servlet.csadmin.DatabasePanel - $sizepanel, # com.netscape.cms.servlet.csadmin.SizePanel - $namepanel, # com.netscape.cms.servlet.csadmin.NamePanel - $certrequestpanel, # com.netscape.cms.servlet.csadmin.CertRequestPanel - $adminpanel, # com.netscape.cms.servlet.csadmin.AdminPanel - $importadmincertpanel, # com.netscape.cms.servlet.csadmin.ImportAdminCertPanel - $donepanel, # com.netscape.cms.servlet.csadmin.DonePanel</param-value> - ]; -}; - -sub render_panel -{ - my ($panelnum, $q) = @_; - - $symbol{errorString} = ""; - - my $currentpanel; - - if ($q->param('op') && $q->param('op') eq "next") { - $currentpanel = $symbol{panels}[$panelnum]; - # validate variables for panel - if ($currentpanel->{validate}) { - $currentpanel->{validate}($q); - } - # execute current panel - my $status = "0"; - - if ($currentpanel->{update}) { - $status = $currentpanel->{update}($q); - &debug_log("TPS wizard: update returns status '" . - $status . "'"); - if ($status == $STATUS_REDIRECT) { - return $STATUS_REDIRECT; - } - - } - - &debug_log("TPS wizard: about to find out about sub panel"); - if ($status eq "1") { - if ($currentpanel->{hasSubPanel} && &{$currentpanel->{hasSubPanel}}($q)) { - &debug_log("TPS wizard: has sub panel"); - $panelnum = $panelnum + 2; - } elsif ($currentpanel->{isSubPanel} && &{$currentpanel->{isSubPanel}}($q)) { - &debug_log("TPS wizard: is sub panel"); - $panelnum = $panelnum - 1; - } else { - &debug_log("TPS wizard: no sub panel and is not subpanel"); - $panelnum = $panelnum + 1; - } - } - } elsif ($q->param('op') && $q->param('op') eq "back") { - $panelnum = $panelnum - 1; - #check if this a subpanel, if so, go back to it's parent. - #only handles one-deep at this point - my $panel = $symbol{panels}[$panelnum]; - if (&{$panel->{isSubPanel}}($q)) { - $panelnum = $panelnum - 1; - } - } elsif ($q->param('op') && $q->param('op') eq "apply") { - &debug_log("TPS wizard: update : apply button pressed"); - $currentpanel = $symbol{panels}[$panelnum]; - # validate variables for panel - if ($currentpanel->{validate}) { - $currentpanel->{validate}($q); - } - # execute current panel - if ($currentpanel->{update}) { - my $status = $currentpanel->{update}($q); - &debug_log("TPS wizard: update returns status '" . - $status . "'"); - if ($status == $STATUS_REDIRECT) { - return $STATUS_REDIRECT; - } - - } - } - - &debug_log("TPS wizard: after looking into about sub panel"); - - # advance to next panel - $currentpanel = $symbol{panels}[$panelnum]; - - # initialize symbol table values - $symbol{showApplyButton} = "false"; - - # fill in variables for new panel - if ($currentpanel->{panelvars}) { - $Data::Dumper::Indent = 1; - # The '&debug_log("q=".Dumper($q));' call must be commented out to fix - # Bugzilla Bug #249923: Incorrect file permissions on - # various files and/or directories - # &debug_log("q=".Dumper($q)); - $currentpanel->{panelvars}($q); - } - - $symbol{panel} = "tps/admin/console/config/".$currentpanel->{vmfile}; - - #wizard.vm: - $symbol{name} = "Token Processing System"; - $symbol{title} = $currentpanel->{getName}(); - if ($panelnum == 0) { - $symbol{firstpanel} = "1"; - } else { - $symbol{firstpanel} = "0"; - } - if ($panelnum == 16) { - $symbol{lastpanel} = "1"; - } else { - $symbol{lastpanel} = "0"; - } - $symbol{p} = $panelnum; - $symbol{subpanelno} = $panelnum+1; - $symbol{productversion} = $::config->get("preop.product.version"); - $symbol{csstate} = "1"; - -# $symbol{urls} = [ "cert1", "cert2" ]; #createsubsystem -# $symbol{urls_size} = 2; -# $symbol{instanceId} = "tps"; -# $symbol{errorString} = ""; - - #modulepanel -# $symbol{certs} = [ ]; -# $symbol{reqscerts} = [ ]; - $symbol{ppcerts} = [ ]; - - return $STATUS_OK; -} - - - -sub dbg { - my $msg = shift; - $::symbol{dbg} .= "$msg\n"; -} - -sub handler { - my $r = shift; - - *::symbol = \%symbol; - *::s = \$s; - *::config = \$config; - *::pwdconf = \$pwdconf; - - &debug_log("TPS wizard: in handler"); - if ($#ARGV == -1) { - $r->send_http_header('text/html'); - } - - my $q = new CGI; - - # check cookie - my $cookie = $q->cookie('pin'); - my $pin = $::config->get("preop.pin"); - if ($cookie ne $pin) { - print $q->redirect("login"); - return; - } - - # output http parameters - &debug_log("TPS wizard: uri='" . $ENV{REQUEST_URI} . "'"); - my @pnames = $q->param(); - foreach $pn (@pnames) { - # added this facility so that password can be hidden, - # all sensitive parameters should be prefixed with - # __ (double underscores); however, in the event that - # a security parameter slips through, we perform multiple - # additional checks to insure that it is NOT displayed - if( $pn =~ /^__/ || - $pn =~ /password$/ || - $pn =~ /passwd$/ || - $pn =~ /pwd$/ || - $pn =~ /admin_password_again/i || - $pn =~ /directoryManagerPwd/i || - $pn =~ /bindpassword/i || - $pn =~ /bindpwd/i || - $pn =~ /passwd/i || - $pn =~ /password/i || - $pn =~ /pin/i || - $pn =~ /pwd/i || - $pn =~ /pwdagain/i || - $pn =~ /uPasswd/i ) { - &debug_log("TPS wizard: http parameter name='" . $pn . "' value='(sensitive)'"); - } else { - &debug_log("TPS wizard: http parameter name='" . $pn . "' value='" . $q->param($pn) . "'"); - } - } - - my $panelnum = $q->param('p'); - if (!defined($panelnum) || $panelnum eq "") { - # Apache fails to pick up the p parameter after - # redirecting from the security domain. This is - # a quick hack to solve the issue. - if ($ENV{'QUERY_STRING'} ne "") { - $ENV{'QUERY_STRING'} =~ /p=([0-9]+)&/; - $panelnum = $1; - } - } - - use subs qw(debug); - *debug = \&Template::Velocity::Executor::debug; - - $::symbol{dbg} = ""; - - &debug_log("TPS wizard: before argparsing"); - if ($#ARGV == -1) { - $Data::Dumper::Maxdepth = 7; - $startfile = "tps/admin/console/config/wizard.vm"; - } - - &debug_log("TPS wizard: setting up test objects"); - - #initialize from config file - my $certlist = $::config->get("preop.cert.list"); - if ($certlist eq "") { - $certlist = "sslserver,subsystem"; - } - @certtags = split(/,/, $certlist); - $numtags = @certtags; - if ($numtags eq 0) { - @certtags = ("sslserver", "subsystem"); - } - &debug_log("TPS wizard: found $numtags certtags"); - - if (! $panelnum) { - $panelnum = 0; - } - - my $status = render_panel($panelnum, $q); - if ($status == 3) { - $r->header_out(Location => $symbol{redirect}); - $r->status(301); - $r->send_http_header(); - return; - } - - use Data::Dumper; - &debug_log("TPS wizard: executing file $startfile"); - foreach $q (sort keys %symbol) { - &debug_log("TPS wizard:/config/wizard?p=9&SecToken=NSS%20Generic%20Crypto%20Services sym{$q}=".$symbol{$q}); - } - - my $result; - if ($q->param('xml') && $q->param('xml') eq "true") { - $r->send_http_header('text/xml'); - $result = "<xml>"; - foreach $s (sort keys %symbol) { - if ($s =~ /^__/) { - next; - } - $result .= "<" . $s . ">"; - my $v = $symbol{$s}; - $result .= &get_xml($s, $v); - $result .= "</" . $s . ">"; - } - $result .= "</xml>"; - } else { - $result = $parser->execute_file($startfile); - if (!defined $result) { - die("Couldn't execute template file: $docroot/$startfile"); - } - } - - print "$result\n"; - return $STATUS_OK; -} - -sub escape_xml -{ - my ($v) = @_; - $v =~ s/\"/"/g; - $v =~ s/\'/'/g; - $v =~ s/\&/&/g; - $v =~ s/</</g; - $v =~ s/>/>/g; - return $v; -} - -sub get_xml -{ - my ($s, $v) = @_; - - my $result; - if (ref($v) eq "HASH") { - foreach my $xkey (keys %$v) { - $result .= "<" . $xkey . ">"; - $result .= &get_xml($xkey, $v{$xkey}); - # $result .= "-" . ref($xkey); - $result .= "</" . $xkey . ">"; - } - } elsif (ref($v) eq "PKI::TPS::CertInfo") { - my $certinfo = $v; - $result .= "<certinfo>"; - $result .= "<dn>" . $certinfo->get_dn() ."</dn>"; - $result .= "<tag>" . $certinfo->get_cert_tag() . "</tag>"; - $result .= "<friendly>" . $certinfo->get_user_friendly_name() . - "</friendly>"; - $result .= "</certinfo>"; - } elsif (ref($v) eq "PKI::TPS::ReqCertInfo") { - my $reqcertinfo = $v; - $result .= "<reqcertinfo>"; - $result .= "<name>" . $reqcertinfo->get_user_friendly_name() ."</name>"; - $result .= "<req>" . $reqcertinfo->get_request() ."</req>"; - $result .= "<cert>" . $reqcertinfo->get_cert() ."</cert>"; - $result .= "<certpp>" . &escape_xml($reqcertinfo->get_cert_pp()) ."</certpp>"; - $result .= "<tag>" . $reqcertinfo->get_cert_tag() ."</tag>"; - $result .= "<dn>" . $reqcertinfo->get_cert_tag() ."</dn>"; - $result .= "</reqcertinfo>"; - } elsif (ref($v) eq "ARRAY") { - my $pos = 0; - foreach my $item (@$v) { - $result .= "<element>"; - $result .= &get_xml("p" . $pos, $item); - # $result .= "-" . ref($item); - $result .= "</element>"; - $pos++; - } - } else { - $result .= &escape_xml($v); - } - return $result; -} - -1; diff --git a/pki/base/tps/lib/perl/Template/Velocity.pm b/pki/base/tps/lib/perl/Template/Velocity.pm deleted file mode 100755 index ea5eb6d72..000000000 --- a/pki/base/tps/lib/perl/Template/Velocity.pm +++ /dev/null @@ -1,1052 +0,0 @@ -#!/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: <skip:'[ \t]*'> section(s) /\Z/ - - section: blockdirective - | nonblockdirective - | plainline - - blockdirective: ifblock - | foreachblock - - plainline : <skip:''> /[ \t]*/ ...!'#' linecomp(s?) /\n*/ - - HASH: '#' - -# HMM - this doesn't handle multiple variables on one line? - linecomp: variable - | <skip:'[ \t]*'> /[^\$\n]*/ - - nonblockdirective: '#' 'include' <commit> includeargs /\n*/ { $item[4] ; } - | '#' 'parse' <commit> parseargs /\n*/ { $item[4] ; } - | '#' 'set' <commit> setargs /\n*/ { $item[4] ; } - | <error:unknown command $text> - - - 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' <skip:'[ \t]*'> ifargs /\n/ - - enddirective: <skip:'[ \t]*'> '#' 'end' "\n" - - elseclause: elsedirective section(s) - - elsedirective: '#' 'else' "\n" - - foreachblock: foreachdirective section(s) enddirective - - foreachdirective: '#' 'foreach' foreachargs "\n" - - ifargs: '(' expression ')' - | <error:Argument to if must be an expression: $text> - - foreachargs: '(' variablename 'in' variable ')' - | <error:Arguments to 'foreach' must be of form \$a in \$b: $text> - - includeargs: '(' string ')' - | <error:invalid argument to include: $text> - - parseargs: '(' expression ')' - | <error:invalid argument to parsearges: $text> - - - setargs: <skip:'[ \t]*'> '(' assignment ')' - | <error:Argument to set must be an assignment : $text> - - -# expression evaluation - -# this goes roughly in order of precendence: -# == -# &&, || -# +, - -# * -# ! - -# does not properly distinguish between lvalues and rvalues - - - expression: boolean - | <error> - - - 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: <skip:'[ \t]'> '"' <skip:""> /[^"]*/ '"' { $return = ["string",$item[4]]; } - | <skip:'[ \t]'> "'" <skip:""> /[^']*/ "'" { $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 <autotree> because I wanted to preserve -# the order of the elements, and <autotree> 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: <skip:'[ \t]*'> 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 - # | <skip:'[ \t]*'> /[^\$\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 : <skip:''> /[ \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' <skip:'[ \t]*'> 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: <skip:'[ \t]*'> '(' 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; - |