diff options
Diffstat (limited to 'base/ra/lib/perl')
46 files changed, 0 insertions, 9761 deletions
diff --git a/base/ra/lib/perl/PKI/Base/CertStore.pm b/base/ra/lib/perl/PKI/Base/CertStore.pm deleted file mode 100644 index 1a31ff971..000000000 --- a/base/ra/lib/perl/PKI/Base/CertStore.pm +++ /dev/null @@ -1,151 +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::CertStore; - -use DBI; -use PKI::Base::TimeTool; - -####################################### -# Constructs a cert store -####################################### -sub new { - my $self = {}; - bless ($self); - return $self; -} - -####################################### -# Opens this store -####################################### -sub open { - my ($self, $cfg) = @_; - $self->{cfg} = $cfg; - my $dbfile = $cfg->get("database.dbfile"); - $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$dbfile","",""); -} - -sub read_certificate { - my ($self, $serialno) = @_; - my $dbh = $self->{dbh}; - my $select = "select * from certificates " . - "where serialno=" . $dbh->quote($serialno); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - return $ref; -} - -sub map_certificate { - my ($self, $certificate) = @_; - my $dbh = $self->{dbh}; - my $select = "select * from certificates " . - "where " . - "certificate=" . $dbh->quote($certificate); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - return $ref; -} - -sub read_certificate_by_approver { - my ($self, $uid, $serialno) = @_; - my $dbh = $self->{dbh}; - my $select = "select * from certificates " . - "where approved_by=". $dbh->quote($uid). - "AND serialno=" . $dbh->quote($serialno); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - return $ref; -} - -sub list_certs_by_approver { - my ($self, $uid, $startpos, $maxcount) = @_; - my $dbh = $self->{dbh}; - my $select = "select *,approved_by from certificates " . - "where " . - "approved_by=". $dbh->quote($uid). - " limit $startpos, $maxcount"; - - my $sth = $dbh->prepare($select); - $sth->execute(); - my @certs; - while (my $ref = $sth->fetchrow_hashref()) { - push(@certs, $ref); - } - $sth->finish(); - return @certs; - - -} - -sub add_certificate { - my ($self, $serialno, $csr, $subject_dn, $certificate, $reqid, $approved_by) = @_; - my $dbh = $self->{dbh}; - - my $timet = PKI::Base::TimeTool->new(); - my $now = $timet->get_time(); - - # sqlite is not thread safe, do our own lock here - my $cmd = "insert into certificates (" . - "subject_dn" . "," . - "certificate" . "," . - "csr" . "," . - "serialno" . "," . - "rid" . "," . - "approved_by" . "," . - "created_at" . - ") values (" . - $dbh->quote($subject_dn) . "," . - $dbh->quote($certificate) . "," . - $dbh->quote($csr) . "," . - $dbh->quote($serialno) . "," . - $dbh->quote($reqid) . "," . - $dbh->quote($approved_by) . "," . - $dbh->quote($now) . - ")"; -REDO_ADD_CERT: - eval { - $dbh->do($cmd); - }; - if ($dbh->err == 5) { - sleep(1); - goto REDO_ADD_CERT; - } - -} - -####################################### -# Closes this store -####################################### -sub close { - my ($self) = @_; - my $dbh = $self->{dbh}; - $dbh->disconnect(); -} - -1; diff --git a/base/ra/lib/perl/PKI/Base/Conf.pm b/base/ra/lib/perl/PKI/Base/Conf.pm deleted file mode 100755 index 895ab28a3..000000000 --- a/base/ra/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/base/ra/lib/perl/PKI/Base/PinStore.pm b/base/ra/lib/perl/PKI/Base/PinStore.pm deleted file mode 100644 index 437d259ff..000000000 --- a/base/ra/lib/perl/PKI/Base/PinStore.pm +++ /dev/null @@ -1,180 +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::PinStore; - -use DBI; -use PKI::Base::TimeTool; - -####################################### -# Constructs a request queue -####################################### -sub new { - my $self = {}; - bless ($self); - return $self; -} - -####################################### -# Opens request queue -####################################### -sub open { - my ($self, $cfg) = @_; - $self->{cfg} = $cfg; - my $dbfile = $cfg->get("database.dbfile"); - $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$dbfile","",""); -} - -####################################### -# Creates a new request -####################################### -sub generate_random -{ - my $low = $_[0]; - my $high = $_[1]; - - my $number = 0; - - if( $low >= $high || $low < 0 || $high < 0 ) { - return -1; - } - - $number = int( rand( $high -$low +1 ) ) + $low; - - return $number; -} - - -# arg0 length of string -# return random string -sub generate_random_string() -{ - my $length_of_randomstring=shift; # the length of the string - - my @chars=( 'a'..'z','A'..'Z','0'..'9' ); - my $random_string; - - foreach( 1..$length_of_randomstring ) { - $random_string .= $chars[rand @chars]; - } - - return $random_string; -} - -sub create_pin { - my ($self, $key, $rid, $created_by) = @_; - my $dbh = $self->{dbh}; - - my $pin = &generate_random_string(10); - my $timet = PKI::Base::TimeTool->new(); - my $now = $timet->get_time(); - - # delete previous pin - my $delete = "delete from pins where key=" . $dbh->quote($key); - $dbh->do($delete); - - my $insert = "insert into pins (" . - "key" . "," . - "pin" . "," . - "rid" . "," . - "created_by" . "," . - "created_at" . - ") values (" . - $dbh->quote($key) . "," . - $dbh->quote($pin) . "," . - $dbh->quote($rid) . "," . - $dbh->quote($created_by) . "," . - $dbh->quote($now) . - ")"; -REDO_CREATE_PIN: - eval { - $dbh->do($insert); - }; - if ($dbh->err == 5) { - sleep(1); - goto REDO_CREATE_PIN; - } - - my $rid = $dbh->func('last_insert_rowid'); - -# my $ref = $self->read_pin($rid); - - return $pin; -} - -####################################### -# Matches pin -####################################### -sub match { - my ($self, $key, $pin) = @_; - my $dbh = $self->{dbh}; - my $select = "select * from pins " . - "where " . - "key=" . $dbh->quote($key) . " AND " . - "pin=" . $dbh->quote($pin); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - if (defined($ref)) { - return 1; - } else { - return 0; - } -} - -sub read_pin { - my ($self, $key) = @_; - my $dbh = $self->{dbh}; - my $select = "select * from pins " . - "where " . - "key=" . $dbh->quote($key); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - return $ref; -} - -####################################### -# Deletes pin -####################################### -sub delete { - my ($self, $key) = @_; - my $dbh = $self->{dbh}; - my $cmd = "delete from pins " . - "where " . - "key=" . $dbh->quote($key); - $dbh->do($cmd); -} - -####################################### -# Closes request queue -####################################### -sub close { - my ($self) = @_; - my $dbh = $self->{dbh}; - $dbh->disconnect(); -} - -1; diff --git a/base/ra/lib/perl/PKI/Base/Registry.pm b/base/ra/lib/perl/PKI/Base/Registry.pm deleted file mode 100644 index a4fb83f28..000000000 --- a/base/ra/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/base/ra/lib/perl/PKI/Base/TimeTool.pm b/base/ra/lib/perl/PKI/Base/TimeTool.pm deleted file mode 100755 index 11f4be208..000000000 --- a/base/ra/lib/perl/PKI/Base/TimeTool.pm +++ /dev/null @@ -1,54 +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::TimeTool; - -use Time::Local; - -use DBI; -use PKI::Base::TimeTool; - -####################################### -# Constructs a request queue -####################################### -sub new { - my $self = {}; - bless ($self); - return $self; -} - -sub get_time() -{ - my ($self) = @_; - my ($sec, $min, $hr, $mday, $mnth, $y, $wd, $yd, $ds) = localtime(); - my $r_year = 1900 + $y; - my $r_mnth; - my $r_day; - $r_day = $mday; - $mnth = $mnth + 1; - $r_mnth = $mnth; - return "$r_year-$r_mnth-$r_day $hr:$min:$sec"; -} - - -1; diff --git a/base/ra/lib/perl/PKI/Base/UserStore.pm b/base/ra/lib/perl/PKI/Base/UserStore.pm deleted file mode 100644 index c05683792..000000000 --- a/base/ra/lib/perl/PKI/Base/UserStore.pm +++ /dev/null @@ -1,343 +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::UserStore; - -use DBI; -use PKI::Base::TimeTool; - -####################################### -# Constructs a request queue -####################################### -sub new { - my $self = {}; - bless ($self); - return $self; -} - -####################################### -# Opens this store -####################################### -sub open { - my ($self, $cfg) = @_; - $self->{cfg} = $cfg; - my $dbfile = $cfg->get("database.dbfile"); - $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$dbfile","",""); - my $timeout = $self->{dbh}->func("busy_timeout"); - $self->{dbh}->func($timeout * 10, "busy_timeout"); -} - -####################################### -# Maps user -####################################### -sub map_user { - my ($self, $certificate) = @_; - my $dbh = $self->{dbh}; - my $select = "select * from users " . - "where " . - "certificate=" . $dbh->quote($certificate); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - return $ref; -} - -####################################### -# Gets roles of the given user -####################################### -sub get_roles { - my ($self, $uid) = @_; - my $dbh = $self->{dbh}; - my $select = "select * from roles " . - "where " . - "uid=" . $dbh->quote($uid); - my @roles; - my $sth = $dbh->prepare($select); - $sth->execute(); - while (my $ref = $sth->fetchrow_hashref()) { - push(@roles, $ref->{'gid'}); - } - $sth->finish(); - return @roles; -} - - -####################################### -# Reads a user -####################################### -sub read_group { - my ($self, $gid) = @_; - my $dbh = $self->{dbh}; - my $select = "select * from groups " . - "where gid=" . $dbh->quote($gid); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - return $ref; -} - -sub read_user { - my ($self, $uid) = @_; - my $dbh = $self->{dbh}; - my $select = "select * from users " . - "where uid=" . $dbh->quote($uid); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - return $ref; -} - -sub set_user { - my ($self, $uid, $name, $value) = @_; - my $dbh = $self->{dbh}; - - my $timet = PKI::Base::TimeTool->new(); - my $now = $timet->get_time(); - my $update = "update users set " . - $name . "=" . $dbh->quote($value) . "," . - "updated_at=" . $dbh->quote($now) . " " . - "where uid=" . $dbh->quote($uid); - $dbh->do($update); - - my $select = "select * from users " . - "where uid=" . $dbh->quote($uid); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - - return $ref; -} - -####################################### -# Lists all members in the given group -####################################### -sub list_all_members { - my ($self, $gid) = @_; - my $dbh = $self->{dbh}; - my $select = "select * from roles where " . - "gid=" . $dbh->quote($gid) . " " . - "order by uid desc "; - my $sth = $dbh->prepare($select); - $sth->execute(); - my @reqs; - while (my $ref = $sth->fetchrow_hashref()) { - push(@reqs, $ref); - } - $sth->finish(); - return @reqs; -} - -####################################### -# Lists -####################################### -sub list_all_non_members { - my ($self, $gid) = @_; - my $dbh = $self->{dbh}; - # find members of the given group - my $select1 = "select * from roles where " . - "gid=" . $dbh->quote($gid); - my $sth1 = $dbh->prepare($select1); - $sth1->execute(); - my $filter = ""; - while (my $ref1 = $sth1->fetchrow_hashref()) { - if ($filter eq "") { - $filter = "uid<>" . $dbh->quote($ref1->{'uid'}); - } else { - $filter = $filter . " AND " . "uid<>" . $dbh->quote($ref1->{'uid'}); - } - } - $sth1->finish(); - - my $select; - if ($filter eq "") { - $select = "select * from users " . - "order by uid desc "; - } else { - $select = "select * from users where (" . - $filter . ") " . - "order by uid desc "; - } - my $sth = $dbh->prepare($select); - $sth->execute(); - my @reqs; - while (my $ref = $sth->fetchrow_hashref()) { - push(@reqs, $ref); - } - $sth->finish(); - return @reqs; -} - -sub delete_user { - my ($self, $userid) = @_; - my $dbh = $self->{dbh}; - - my $cmd = "delete from roles where uid=" . $dbh->quote($userid); - $dbh->do($cmd); - $cmd = "delete from users where uid=" . $dbh->quote($userid); - $dbh->do($cmd); -} - -sub add_user_to_group { - my ($self, $gid, $userid) = @_; - my $dbh = $self->{dbh}; - - my $timet = PKI::Base::TimeTool->new(); - my $now = $timet->get_time(); - - my $cmd = "insert into roles (" . - "gid" . "," . - "uid" . - ") values (" . - $dbh->quote($gid) . "," . - $dbh->quote($userid) . - ")"; - $dbh->do($cmd); -} - -sub delete_user_from_group { - my ($self, $gid, $userid) = @_; - my $dbh = $self->{dbh}; - - my $timet = PKI::Base::TimeTool->new(); - my $now = $timet->get_time(); - - my $cmd = "delete from roles where " . - "gid=" . $dbh->quote($gid) . " AND " . - "uid=" . $dbh->quote($userid); - $dbh->do($cmd); -} - -sub add_user { - my ($self, $userid, $name, $email, $certificate) = @_; - my $dbh = $self->{dbh}; - - my $timet = PKI::Base::TimeTool->new(); - my $now = $timet->get_time(); - - my $cmd = "insert into users (" . - "uid" . "," . - "name" . "," . - "email" . "," . - "certificate" . "," . - "created_at" . - ") values (" . - $dbh->quote($userid) . "," . - $dbh->quote($name) . "," . - $dbh->quote($email) . "," . - $dbh->quote($certificate) . "," . - $dbh->quote($now) . - ")"; -REDO_ADD_USER: - eval { - $dbh->do($cmd); - }; - if ($dbh->err == 5) { - sleep(1); - goto REDO_ADD_USER; - } -} - -sub add_group { - my ($self, $gid, $name) = @_; - my $dbh = $self->{dbh}; - - my $timet = PKI::Base::TimeTool->new(); - my $now = $timet->get_time(); - - my $cmd = "insert into groups (" . - "gid" . "," . - "name" . "," . - "created_at" . - ") values (" . - $dbh->quote($gid) . "," . - $dbh->quote($name) . "," . - $dbh->quote($now) . - ")"; -REDO_ADD_GROUP: - eval { - $dbh->do($cmd); - }; - if ($dbh->err == 5) { - sleep(1); - goto REDO_ADD_GROUP; - } -} - -sub delete_group { - my ($self, $gid) = @_; - my $dbh = $self->{dbh}; - - my $timet = PKI::Base::TimeTool->new(); - my $now = $timet->get_time(); - - my $cmd = "delete from roles where gid=" . $dbh->quote($gid); - $dbh->do($cmd); - $cmd = "delete from groups where gid=" . $dbh->quote($gid); - $dbh->do($cmd); -} - -sub list_users { - my ($self, $startpos, $maxcount) = @_; - my $dbh = $self->{dbh}; - my $select = "select * from users " . - "order by uid desc " . - "limit $startpos, $maxcount"; - my $sth = $dbh->prepare($select); - $sth->execute(); - my @reqs; - while (my $ref = $sth->fetchrow_hashref()) { - push(@reqs, $ref); - } - $sth->finish(); - return @reqs; -} - -sub list_groups { - my ($self, $startpos, $maxcount) = @_; - my $dbh = $self->{dbh}; - my $select = "select * from groups " . - "order by gid desc " . - "limit $startpos, $maxcount"; - my $sth = $dbh->prepare($select); - $sth->execute(); - my @reqs; - while (my $ref = $sth->fetchrow_hashref()) { - push(@reqs, $ref); - } - $sth->finish(); - return @reqs; -} -####################################### -# Closes this store -####################################### -sub close { - my ($self) = @_; - my $dbh = $self->{dbh}; - $dbh->disconnect(); -} - -1; diff --git a/base/ra/lib/perl/PKI/Base/Util.pm b/base/ra/lib/perl/PKI/Base/Util.pm deleted file mode 100755 index f01062e42..000000000 --- a/base/ra/lib/perl/PKI/Base/Util.pm +++ /dev/null @@ -1,155 +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::Util; - -use Time::Local; - -use DBI; -use HTML::Entities; - -####################################### -# Constructs a util -####################################### -sub new { - my $self = {}; - bless ($self); - return $self; -} - -sub get_val() -{ - my ($self, $s) = @_; - return $s; -} - -sub get_integer_val() -{ - my ($self, $s) = @_; - return $s; -} - -sub get_string_val() -{ - my ($self, $s) = @_; - return $s; -} - -sub get_alphanum_val() -{ - my ($self, $s) = @_; - $s =~ s/[^A-Za-z0-9 ]*//g; - return $s; -} - -sub normalize_csr() -{ - my ($self, $s) = @_; - $s =~ s/-----BEGIN CERTIFICATE REQUEST-----//g; - $s =~ s/-----END CERTIFICATE REQUEST-----//g; - $s =~ s/-----BEGIN NEW CERTIFICATE REQUEST-----//g; - $s =~ s/-----END NEW CERTIFICATE REQUEST-----//g; - $s =~ s/\s//g; - return $s; -} - -sub breakline() -{ - my ($self, $s, $maxlen) = @_; - - my $new_s; - my $i = 0; - foreach my $c (split(//, $s)) { - if ($i == $maxlen) { - $i = 0; - $new_s = $new_s . "<br/>"; - } - $new_s = $new_s . $c; - $i++; - } - return $new_s; -} - -sub nv_to_hash() -{ - my ($self, $s) = @_; - my %hash; - my @pairs = split(/;/, $s); - foreach $pair (@pairs) { - my $i = index('=', $pair); - my $n = substr($pair, 0, $i-1); - my $v = substr($pair, $i); - $hash{$n} = $v; - } - return \%hash; -} - -sub nv_to_str() -{ - my ($self, $hash) = @_; - my $s = ""; - foreach $k (keys %$hash) { - if ($s eq "") { - $s = $k . "=" . $$hash{$k}; - } else { - $s = $s . ";" . $k . "=" . $$hash{$k}; - } - } - return $s; -} - -sub test() -{ - my %h; - $h{'x'} = 'y'; - $h{'z'} = 'y'; - my $o = PKI::Base::NameValueUtil->new(); - print $o->to_str(\%h) . "\n"; - print $o->to_str($o->to_hash("5=1;c=2")) . "\n"; -} - -sub html_encode() -{ - my ($self, $s) = @_; - return HTML::Entities::encode($s); -} - -sub html_encode_and_break() -{ - my ($self, $s, $maxlen) = @_; - my $new_s = ''; - my $i = 0; - foreach my $c (split(//, $s)) { - if ($i == $maxlen) { - $i = 0; - $new_s = $new_s . '***'; - } - $new_s = $new_s . $c; - $i++; - } - $s = HTML::Entities::encode($new_s); - $s =~ s/\*\*\*/<br\/>/g; - return $s; -} - -1; diff --git a/base/ra/lib/perl/PKI/Conn/CA.pm b/base/ra/lib/perl/PKI/Conn/CA.pm deleted file mode 100644 index f3c8834ed..000000000 --- a/base/ra/lib/perl/PKI/Conn/CA.pm +++ /dev/null @@ -1,390 +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::Conn::CA; - -use URI::URL; -use URI::Escape; -use XML::Simple; -use Data::Dumper; -use DBI; -use PKI::Base::TimeTool; -use PKI::Base::CertStore; -use PKI::Base::Util; -use PKI::Request::Queue; - -####################################### -# Constructs a request queue -####################################### -sub new { - my $self = {}; - bless ($self); - return $self; -} - -####################################### -# Opens request queue -####################################### -sub open { - my ($self, $cfg) = @_; - $self->{cfg} = $cfg; - my $certstore = PKI::Base::CertStore->new(); - $certstore->open($cfg); - $self->{certstore} = $certstore; -} - -####################################### -# Enrolls -####################################### -sub enroll { - my ($self, $rid, $con_id, $profile_id, $cert_request_type, $cert_request) = @_; - - my $cfg = $self->{cfg}; - my $instdir = $cfg->get("service.instanceDir"); - my $db_password; - - my $nickname = $cfg->get("conn." . $con_id . ".clientNickname"); - my $cahostport = $cfg->get("conn." . $con_id . ".hostport"); - my ($host, $port) = split(/:/, $cahostport); - - if ($nickname =~ /(.*):(.*)/) { - $db_password = `grep \"$1:\" \"$instdir/conf/password.conf\" | awk -F: '{print \$2}'`; - } else { - $db_password = `grep \"internal:\" \"$instdir/conf/password.conf\" | cut -c10-`; - } - $db_password =~ s/\n$//g; - - my $queue = PKI::Request::Queue->new(); - $queue->open($cfg); - my $req = $queue->read_request($rid); - if ($req->{'subject_dn'} ne "unavailable") { - $subject = $req->{'subject_dn'}; - } - - my $tmpfile = "/tmp/tmp-$rid-$$"; - my $params = "profileId=" . $profile_id . "&" . - "requestor_name=" . - URI::Escape::uri_escape("$requestor_name") . "&" . - "cert_request_type=" . $cert_request_type . "&" . - "subject=" . - URI::Escape::uri_escape("$subject") . "&" . - "cert_request=" . - URI::Escape::uri_escape("$cert_request") . "&" . - "xmlOutput=true"; - - system("/usr/bin/sslget -e \"$params\" -d \"$instdir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$port > $tmpfile"); - - my $content = `cat $tmpfile`; - if ($content eq "") { - $queue->set_request($rid, "errorString", "CA Connection Error"); - $queue->set_request($rid, "status", "ERROR"); - $queue->close(); - - $queue->close(); - return ""; - } - - $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; - $content = $1; - $content =~ s/\n//g; - - my $xmlparser = XML::Simple->new(); - my $response = $xmlparser->XMLin($content); - - my $status = $response->{Status}; - if ($status ne "0") { - my $errorString = $response->{Error}; - - $queue->set_request($rid, "errorString", "CA: ".$errorString); - $queue->set_request($rid, "status", "ERROR"); - - $queue->close(); - return ""; - } - - #reset to 0 in case of re-approval - $queue->set_request($rid, "errorString", "0"); - my $req = $queue->read_request($rid); - my $approved_by = $req->{'processed_by'}; - my $serialno = $response->{Requests}->{Request}->{serialno}; - $queue->set_request($rid, "serialno", $serialno); - my $subject_dn = $response->{Requests}->{Request}->{SubjectDN}; - $queue->set_request($rid, "subject_dn", $subject_dn); - my $cert = $response->{Requests}->{Request}->{b64}; - $queue->close(); - - my $util = PKI::Base::Util->new(); - my $csr = $cert_request; - $csr = $util->normalize_csr($csr); - - $self->{certstore}->add_certificate($serialno, $csr, $subject_dn, $cert, $rid, $approved_by); - - system("rm $tmpfile"); - - return $cert; -} - -sub get_http_content -{ - my ($self, $filename) = @_; - my $data = ""; - my $count = `grep -a Content-Length $filename | cut -d' ' -f2`; - chomp($count); - my $file_size = -s $filename; - my $offset = $file_size - $count; - - open(FP, "<$filename"); - binmode(FP); - seek(FP, $offset-1, 0); - read(FP, $data, $count); - close(FP); - return $data; -} - -####################################### -# Revoke -####################################### -sub revoke { - my ($self, $rid, $con_id, $serialno, $reason) = @_; - - my $cfg = $self->{cfg}; - my $instdir = $cfg->get("service.instanceDir"); - my $db_password; - - my $nickname = $cfg->get("conn." . $con_id . ".clientNickname"); - my $cahostport = $cfg->get("conn." . $con_id . ".hostagentport"); - - if ($nickname =~ /(.*):(.*)/) { - $db_password = `grep \"$1:\" \"$instdir/conf/password.conf\" | awk -F: '{print \$2}'`; - } else { - $db_password = `grep \"internal:\" \"$instdir/conf/password.conf\" | cut -c10-`; - } - $db_password =~ s/\n$//g; - - my $tmpfile = "/tmp/tmp-revoke-$serialno-$$"; - my ($host, $port) = split(/:/, $cahostport); - my $params = "op=" . "revoke" . "&" . - "revocationReason=" .$reason . "&" . - "revokeAll=(certRecordId=" ."0x".$serialno . ")&" . - "totalRecordCount=" ."1" . "&" . - "xml=true"; - system("/usr/bin/sslget -e \"$params\" -d \"$instdir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"/ca/agent/ca/doRevoke\" $host:$port > $tmpfile"); - - my $content = `cat $tmpfile`; - my $queue = PKI::Request::Queue->new(); - $queue->open($cfg); - if ($content eq "") { - $queue->set_request($rid, "errorString", "CA Connection Error"); -# $queue->set_request($rid, "status", "ERROR"); - $queue->close(); - - $queue->close(); - return ""; - } - $content =~ s/\000//; - $content =~ /(\<xml\>.*\<\/xml\>)/s; - $content = $1; - $content =~ s/\n//g; - - my $req = $queue->read_request($rid); - - my $xmlparser = XML::Simple->new(NormalizeSpace => 2); - my $response = $xmlparser->XMLin($content); - - my $errorString = $response->{fixed}->{errorDetails}; - my $revoked = $response->{header}->{revoked}; - - if ($revoked ne "yes") { - $queue->set_request($rid, "errorString", "CA:".$errorString); - } else { - $queue->set_request($rid, "errorString", "0"); - } - system("rm $tmpfile"); - - $queue->close(); - return; -} - -####################################### -# Get Certificate Status -####################################### -sub getCertStatus { - my ($self, $con_id, $serialno) = @_; - - my $cfg = $self->{cfg}; - my $instdir = $cfg->get("service.instanceDir"); - my $db_password; - - my $nickname = $cfg->get("conn." . $con_id . ".clientNickname"); - my $cahostport = $cfg->get("conn." . $con_id . ".hostport"); - my ($host, $port) = split(/:/, $cahostport); - - if ($nickname =~ /(.*):(.*)/) { - $db_password = `grep \"$1:\" \"$instdir/conf/password.conf\" | awk -F: '{print \$2}'`; - } else { - $db_password = `grep \"internal:\" \"$instdir/conf/password.conf\" | cut -c10-`; - } - $db_password =~ s/\n$//g; - - - my $tmpfile = "/tmp/tmp-$serialno-$$"; - my $params = "serialNumber=" . "0x".$serialno . "&" . - "xml=true"; - system("/usr/bin/sslget -e \"$params\" -d \"$instdir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"/ca/ee/ca/displayBySerial\" $host:$port > $tmpfile"); - - my $content = `cat $tmpfile`; - system("rm $tmpfile"); - if ($content eq "") { - return "CA: Connection Error"; - system("rm $tmpfile"); - } - - $content =~ /(\<xml\>.*\<\/xml\>)/s; - $content = $1; - $content =~ s/\n//g; - - my $xmlparser = XML::Simple->new(NormalizeSpace => 2); - my $response = $xmlparser->XMLin($content); - - my $errorString = $response->{fixed}->{errorDetails}; - my $revokeReason = $response->{header}->{revocationReason}; - - if ($revokeReason eq "") { - if ($errorString eq "") { - return "not revoked"; - } else { - return "CA:".$errorString; - } - } else { - return "revoked:".$revokeReason; - } -} - -####################################### -# SCEP -####################################### -sub scep_get_ca_cert { - my ($self, $con_id, $operation, $message) = @_; - - my $cfg = $self->{cfg}; - my $instdir = $cfg->get("service.instanceDir"); - my $db_password; - - my $nickname = $cfg->get("conn." . $con_id . ".clientNickname"); - my $cahostport = $cfg->get("conn." . $con_id . ".hostport"); - my ($host, $port) = split(/:/, $cahostport); - - if ($nickname =~ /(.*):(.*)/) { - $db_password = `grep \"$1:\" \"$instdir/conf/password.conf\" | awk -F: '{print \$2}'`; - } else { - $db_password = `grep \"internal:\" \"$instdir/conf/password.conf\" | cut -c10-`; - } - $db_password =~ s/\n$//g; - - my $tmpfile = "/tmp/tmp-$$"; - my $params = "operation=" . $operation . "&" . - "message=" . $message; - system("/usr/bin/sslget -e \"$params\" -d \"$instdir/alias\" -p \"$db_password\" -n \"$nickname\" -r \"/ca/ee/ca/pkiclient\" $host:$port > $tmpfile"); - - - my $content = $self->get_http_content($tmpfile); - - system("rm $tmpfile"); - - return $content; -} - -# decode PKI Message -sub scep_decode { - my ($self, $con_id, $operation, $message) = @_; - - my $cfg = $self->{cfg}; - my $instdir = $cfg->get("service.instanceDir"); - my $db_password; - - my $nickname = $cfg->get("conn." . $con_id . ".clientNickname"); - my $cahostport = $cfg->get("conn." . $con_id . ".hostport"); - my ($host, $port) = split(/:/, $cahostport); - - if ($nickname =~ /(.*):(.*)/) { - $db_password = `grep \"$1:\" \"$instdir/conf/password.conf\" | awk -F: '{print \$2}'`; - } else { - $db_password = `grep \"internal:\" \"$instdir/conf/password.conf\" | cut -c10-`; - } - $db_password =~ s/\n$//g; - - my $tmpfile = "/tmp/tmp-$$"; - my $params = "operation=" . $operation . "&" . - "message=" . $message . "&" . - "decode=true"; - system("/usr/bin/sslget -e \"$params\" -d \"$instdir/alias\" -p \"$db_password\" -n \"$nickname\" -r \"/ca/ee/ca/pkiclient\" $host:$port > $tmpfile"); - - - my $content = $self->get_http_content($tmpfile); - - system("rm $tmpfile"); - - return $content; -} - -sub scep_pki_message { - my ($self, $con_id, $operation, $message) = @_; - - my $cfg = $self->{cfg}; - my $instdir = $cfg->get("service.instanceDir"); - my $db_password; - - my $nickname = $cfg->get("conn." . $con_id . ".clientNickname"); - my $cahostport = $cfg->get("conn." . $con_id . ".hostport"); - my ($host, $port) = split(/:/, $cahostport); - - if ($nickname =~ /(.*):(.*)/) { - $db_password = `grep \"$1:\" \"$instdir/conf/password.conf\" | awk -F: '{print \$2}'`; - } else { - $db_password = `grep \"internal:\" \"$instdir/conf/password.conf\" | cut -c10-`; - } - $db_password =~ s/\n$//g; - - my $tmpfile = "/tmp/tmp-$$"; - my $params = "operation=" . $operation . "&" . - "message=" . $message; - system("/usr/bin/sslget -e \"$params\" -d \"$instdir/alias\" -p \"$db_password\" -n \"$nickname\" -r \"/ca/ee/ca/pkiclient\" $host:$port > $tmpfile"); - - - my $content = $self->get_http_content($tmpfile); - - system("rm $tmpfile"); - - return $content; -} - - -####################################### -# Closes connection -####################################### -sub close { - my ($self) = @_; - $self->{certstore}->close(); -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/AdminAuthPanel.pm b/base/ra/lib/perl/PKI/RA/AdminAuthPanel.pm deleted file mode 100755 index 656dc2d5e..000000000 --- a/base/ra/lib/perl/PKI/RA/AdminAuthPanel.pm +++ /dev/null @@ -1,86 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; - -package PKI::RA::AdminAuthPanel; -$PKI::RA::AdminAuthPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(8); - $self->{"getName"} = &PKI::RA::Common::r("Admin Authentication"); - $self->{"vmfile"} = "adminauthenticatepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("AdminAuthPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("AdminAuthPanel: update"); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("AdminAuthPanel: display"); - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/AdminPanel.pm b/base/ra/lib/perl/PKI/RA/AdminPanel.pm deleted file mode 100755 index a5538ef54..000000000 --- a/base/ra/lib/perl/PKI/RA/AdminPanel.pm +++ /dev/null @@ -1,227 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use URI::URL; -use URI::Escape; -use DBI; - -package PKI::RA::AdminPanel; -$PKI::RA::AdminPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(14); - $self->{"getName"} = &PKI::RA::Common::r("Administrator"); - $self->{"vmfile"} = "adminpanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("AdminPanel: validate"); - return 1; -} - - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("AdminPanel: update"); - - my $uid = $q->param("uid"); - my $name = $q->param("name"); - my $email = $q->param("email"); - my $password = $q->param("__pwd"); - my $password_again = $q->param("__admin_password_again"); - - my $cert_request = $q->param("cert_request"); - my $subject = $q->param("subject"); - my $profile_id = $q->param("profileId"); - my $cert_request_type = $q->param("cert_request_type"); - - $cert_request =~ s/%0D%0A//g; # remove carraige return - - # submit request to CA - - # Admin Certificate should be obtained from the ca selected in the - # name panel. If name panel use External CA, the admin certificate - # will be issued by the security domain CA. - my $cainfo = $::config->get("preop.ca.url"); - &PKI::RA::Wizard::debug_log("AdminPanel: preop.ca.url=$cainfo"); - if ($cainfo eq "" || $cainfo =~ /:$/) { - $cainfo = $::config->get("config.sdomainEEURL"); - &PKI::RA::Wizard::debug_log("AdminPanel: config.sdomainEEURL=$cainfo"); - } - &PKI::RA::Wizard::debug_log("AdminPanel: Connecting to CA: $cainfo"); - my $cainfo_url = new URI::URL($cainfo); - my $sdom = $::config->get("config.sdomainEEURL"); - my $sdom_url = new URI::URL($sdom); - - my $machineName = $::config->get("service.machineName"); - my $securePort = $::config->get("service.securePort"); - my $session_id = $::config->get("preop.sessionID"); - - my $tokenname = $::config->get("preop.module.token"); - my $token_pwd = $::pwdconf->get($tokenname); - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - - my $requestor_name = "RA-" . $machineName . "-" . $securePort; - - my $params = "profileId=" . $profile_id . "&" . - "requestor_name=" . $requestor_name . "&" . - "cert_request_type=" . $cert_request_type . "&" . - "subject=" . $subject . "&" . - "cert_request=" . - URI::Escape::uri_escape("$cert_request") . "&" . - "xmlOutput=true" . "&" . - "sessionID=" . $session_id . "&" . - "auth_hostname=" . $sdom_url->host . "&" . - "auth_port=" . $sdom_url->port; - - my $ca_host = $cainfo_url->host; - my $https_ee_port = $cainfo_url->port; - my $content = ""; - my $tmpfile = "/tmp/admin-$$"; - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"/ca/ee/ca/profileSubmit\" $ca_host:$https_ee_port > $tmpfile"); - $content = `cat $tmpfile`; - } else { - system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -n \"$nickname\" -r \"/ca/ee/ca/profileSubmit\" $ca_host:$https_ee_port > $tmpfile"); - $content = `cat $tmpfile`; - } - system("rm $tmpfile"); - &PKI::RA::Wizard::debug_log("req = " . $content); - - $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; - $content = $1; - - # create user in internal database - &PKI::RA::Wizard::debug_log("AdminPanel: Creating user in internal database"); - # use scripts/addAgents.ldif - - my $parser = XML::Simple->new(); - my $response = $parser->XMLin($content); - my $admincert = $response->{Requests}->{Request}->{b64}; - &PKI::RA::Wizard::debug_log("AdminPanel: admincert " . $admincert); - - # create local database - my $dbh = DBI->connect( - "dbi:SQLite:dbname=$instanceDir/conf/dbfile","",""); - my $insert = "insert into users (" . - "uid" . "," . - "name" . "," . - "password" . "," . - "email" . "," . - "certificate" . - ") values (" . - $dbh->quote($uid) . "," . - $dbh->quote($name) . "," . - $dbh->quote($password) . "," . - $dbh->quote($email) . "," . - $dbh->quote($admincert) . - ")"; - $dbh->do($insert); - $insert = "insert into roles (" . - "uid" . "," . - "gid" . - ") values (" . - $dbh->quote($uid) . "," . - $dbh->quote("administrators") . - ")"; - $dbh->do($insert); - $insert = "insert into roles (" . - "uid" . "," . - "gid" . - ") values (" . - $dbh->quote($uid) . "," . - $dbh->quote("agents") . - ")"; - $dbh->do($insert); - $dbh->disconnect(); - - my $reqid = $response->{Requests}->{Request}->{Id}; - $::config->put("preop.admincert.requestId.0", $reqid); - my $sn = $response->{Requests}->{Request}->{serialno}; - $::config->put("preop.admincert.serialno.0", $sn); - - # update email address - $::config->put("request.agent.create_request.1.mailTo", $email); - $::config->put("request.scep.create_request.1.mailTo", $email); - $::config->put("request.server.create_request.1.mailTo", $email); - $::config->put("request.user.create_request.1.mailTo", $email); - - $::config->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("AdminPanel: display"); - $::symbol{admin_uid} = "admin"; - $::symbol{admin_name} = "RA Administrator"; - $::symbol{admin_email} = ""; - $::symbol{admin_pwd} = ""; - $::symbol{admin_pwd_again} = ""; - $::symbol{import} = "true"; - my $domain_name = $::config->get("preop.securitydomain.name"); - $::symbol{securityDomain} = $domain_name; - - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/AgentAuthPanel.pm b/base/ra/lib/perl/PKI/RA/AgentAuthPanel.pm deleted file mode 100755 index 1ada5ad54..000000000 --- a/base/ra/lib/perl/PKI/RA/AgentAuthPanel.pm +++ /dev/null @@ -1,86 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; - -package PKI::RA::AgentAuthPanel; -$PKI::RA::AgentAuthPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(7); - $self->{"getName"} = &PKI::RA::Common::r("Agent Authentication"); - $self->{"vmfile"} = "agentauthenticatepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("AgentAuthPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("AgentAuthPanel: update"); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("AgentAuthPanel: display"); - return 1; -} - - -1; diff --git a/base/ra/lib/perl/PKI/RA/BasePanel.pm b/base/ra/lib/perl/PKI/RA/BasePanel.pm deleted file mode 100755 index 5cb4d7697..000000000 --- a/base/ra/lib/perl/PKI/RA/BasePanel.pm +++ /dev/null @@ -1,40 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; - -package PKI::RA::BasePanel; -$PKI::RA::BasePanel::VERSION = '1.00'; - -sub new { - my ($class) = @_; - my $self = {}; - bless $self, $class; - return $self; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/CAInfoPanel.pm b/base/ra/lib/perl/PKI/RA/CAInfoPanel.pm deleted file mode 100755 index 4cc65e5cf..000000000 --- a/base/ra/lib/perl/PKI/RA/CAInfoPanel.pm +++ /dev/null @@ -1,289 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use URI::URL; - -package PKI::RA::CAInfoPanel; -$PKI::RA::CAInfoPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -our $cert_header="-----BEGIN CERTIFICATE-----"; -our $cert_footer="-----END CERTIFICATE-----"; - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(4); - $self->{"getName"} = &PKI::RA::Common::r("CA Information"); - $self->{"vmfile"} = "cainfopanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("CAInfoPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("CAInfoPanel: update"); - - my $count = $q->param('urls'); - &PKI::RA::Wizard::debug_log("CAInfoPanel: update - got urls = $count"); - - &PKI::RA::Wizard::debug_log("CAInfoPanel: update - selected ca= $count"); - - my $instanceID = $::config->get("service.instanceID"); - my $host = ""; - my $https_ee_port = ""; - my $https_agent_port = ""; - my $https_admin_port = ""; - my $domain_xml = ""; - - if ($count =~ /http/) { - my $info = new URI::URL($count); - $host = $info->host; - $https_ee_port = $info->port; - $domain_xml = get_domain_xml($host, $https_ee_port); - if ($domain_xml eq "") { - $::symbol{errorString} = "missing security domain. CA must be installed prior to RA installation"; - return 0; - } - - $https_agent_port = get_secure_agent_port_from_domain_xml($domain_xml, $host, $https_ee_port); - $https_admin_port = get_secure_admin_port_from_domain_xml($domain_xml, $host, $https_ee_port); - - if(($https_admin_port eq "") || ($https_agent_port eq "")) { - $::symbol{errorString} = "missing secure CA admin or agent port. CA must be installed prior to RA installation"; - return 0; - } - } else { - $host = $::config->get("preop.securitydomain.ca$count.host"); - $https_ee_port = $::config->get("preop.securitydomain.ca$count.secureport"); - $https_agent_port = $::config->get("preop.securitydomain.ca$count.secureagentport"); - $https_admin_port = $::config->get("preop.securitydomain.ca$count.secureadminport"); - } - - if (($host eq "") || ($https_ee_port eq "") || ($https_admin_port eq "") || ($https_agent_port eq "")) { - $::symbol{errorString} = "no CA found. CA must be installed prior to RA installation"; - return 0; - } - - &PKI::RA::Wizard::debug_log("CAInfoPanel: update - host= $host, https_ee_port= $https_ee_port"); - - $::config->put("preop.cainfo.select", "https://$host:$https_admin_port"); - my $serverCertNickName = $::config->get("preop.cert.sslserver.nickname"); - - my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname"); - $::config->put("conn.ca1.clientNickname", $subsystemCertNickName); - $::config->put("conn.ca1.hostport", $host . ":" . $https_ee_port); - $::config->put("conn.ca1.hostagentport", $host . ":" . $https_agent_port); - $::config->put("conn.ca1.hostadminport", $host . ":" . $https_admin_port); - - $::config->commit(); - - # connect to the CA, and retrieve the CA certificate - &PKI::RA::Wizard::debug_log("CAInfoPanel: update connecting to CA and retrieve cert chain"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - my $tmpfile = "/tmp/ca-$$"; - system("/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$serverCertNickName\" -r \"/ca/ee/ca/getCertChain\" $host:$https_ee_port > $tmpfile"); - my $cmd = `cat $tmpfile`; - system("rm $tmpfile"); - my $caCert; - if ($cmd =~ /\<ChainBase64\>(.*)\<\/ChainBase64\>/) { - $caCert = $1; - &PKI::RA::Wizard::debug_log("CAInfoPanel: ca= $caCert"); - } - if ($caCert eq "") { - &PKI::RA::Wizard::debug_log("CAInfoPanel: update no cert chain found"); - return 0; - } - open(F, ">$instanceDir/conf/caCertChain2.txt"); - print F $cert_header."\n".$caCert."\n".$cert_footer; - close(F); - - &PKI::RA::Wizard::debug_log("CAInfoPanel: update retrieve cert chain done"); - - #import cert chain - system("p7tool -d $instanceDir/alias -p $instanceDir/conf/chain2cert -a -i $instanceDir/conf/caCertChain2.txt -o $instanceDir/conf/CAchain2_pp.txt"); - my $r = $? >> 8; - my $failed = $? & 127; - if (($r > 0) && ($r < 10) && !$failed) { - my $i = 0; - while ($i ne $r) { - my $tmp = `certutil -d $instanceDir/alias -D -n "Trusted CA c2cert$i"`; - $tmp = `certutil -d $instanceDir/alias -A -f $instanceDir/conf/.pwfile -n "Trusted CA c2cert$i" -t "CT,C,C" -i $instanceDir/conf/chain2cert$i.der`; - $i++; - } - } - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("CAInfoPanel: display"); - - $::symbol{urls} = []; -# unshift(@{$::symbol{urls}}, "External CA"); - my $count = 0; - my $first = 1; - my $list = ""; - while (1) { - my $host = $::config->get("preop.securitydomain.ca$count.host"); - if ($host eq "") { - goto DONE; - } - my $https_ee_port = $::config->get("preop.securitydomain.ca$count.secureport"); - my $name = $::config->get("preop.securitydomain.ca$count.subsystemname"); - my $item = $name . " - https://" . $host . ":" . $https_ee_port; -# my $item = "https://" . $host . ":" . $https_ee_port; -# unshift(@{$::symbol{urls}}, $item); - $::symbol{urls}[$count++] = $item; - if ($first eq 1) { - $list = $item; - $first = 0; - } else { - $list = $list.",".$item; - } - } -DONE: -# $list = $list.",External CA"; - $::config->put("preop.ca.list", $list); - - $::symbol{urls_size} = $count; - if ($count eq 0) { - $::symbol{errorString} = "no CA found. CA, TKS, and optionally DRM must be installed prior to RA installation"; - return 0; - } - return 1; -} - -sub get_domain_xml -{ - my $host = $1; - my $https_ee_port = $2; - - # get the domain xml - # e. g. - https://water.sfbay.redhat.com:9445/ca/admin/ca/getDomainXML - - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - - my $sd_host = $::config->get("securitydomain.host"); - my $sd_admin_port = $::config->get("securitydomain.httpsadminport"); - my $content = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -r \"/ca/admin/ca/getDomainXML\" $sd_host:$sd_admin_port`; - - $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; - $content = $1; - return $content; -} - -sub get_secure_admin_port_from_domain_xml -{ - my $content = $1; - my $host = $2; - my $https_ee_port = $3; - - # Retrieve the secure admin port corresponding - # to the selected host and secure ee port. - my $parser = XML::Simple->new(); - my $response = $parser->XMLin($content); - my $xml = $parser->XMLin( $response->{'DomainInfo'}, - ForceArray => 1 ); - my $https_admin_port = ""; - my $count = 0; - foreach my $c (@{$xml->{'CAList'}[0]->{'CA'}}) { - if( ( $host eq $c->{'Host'}[0] ) && - ( $https_ee_port eq $c->{'SecurePort'}[0] ) ) { - $https_admin_port = https_$c->{'SecureAdminPort'}[0]; - } - - $count++; - } - - return $https_admin_port; -} - -sub get_secure_agent_port_from_domain_xml -{ - my $content = $1; - my $host = $2; - my $https_ee_port = $3; - - # Retrieve the secure agent port corresponding - # to the selected host and secure ee port. - my $parser = XML::Simple->new(); - my $response = $parser->XMLin($content); - my $xml = $parser->XMLin( $response->{'DomainInfo'}, - ForceArray => 1 ); - my $https_agent_port = ""; - my $count = 0; - foreach my $c (@{$xml->{'CAList'}[0]->{'CA'}}) { - if( ( $host eq $c->{'Host'}[0] ) && - ( $https_ee_port eq $c->{'SecurePort'}[0] ) ) { - $https_agent_port = https_$c->{'SecureAgentPort'}[0]; - } - - $count++; - } - - return $https_agent_port; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/CertInfo.pm b/base/ra/lib/perl/PKI/RA/CertInfo.pm deleted file mode 100755 index d1a8c3817..000000000 --- a/base/ra/lib/perl/PKI/RA/CertInfo.pm +++ /dev/null @@ -1,133 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; - -package PKI::RA::CertInfo; -$PKI::RA::CertInfo::VERSION = '1.00'; - -sub new { - my ($class, $name, $dn, $tag) = @_; - my $self = {}; - - &PKI::RA::Wizard::debug_log("CertInfo: start new"); - $self->{"getUserFriendlyName"} = \&get_user_friendly_name; - $self->{"getCertTag"} = \&get_cert_tag; - $self->{"getDN"} = \&get_dn; - $self->{"getNickname"} = \&get_nickname; - $self->{"useDefaultKey"} = \&use_default_key; - $self->{"getCustomKeysize"} = \&get_custom_keysize; - $self->{"keyOption"} = \&get_key_option; - &PKI::RA::Wizard::debug_log("CertInfo: end new"); - - $self->{name} = $name; - $self->{dn} = $dn; - $self->{tag} = $tag; - - bless $self, $class; - return $self; -} - -sub get_user_friendly_name -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("CertInfo: get_user_friendly_name"); - return $self->{name}; -} - -sub get_cert_tag -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("CertInfo: get_cert_tag"); - return $self->{tag}; -} - -sub get_dn -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("CertInfo: get_cert_dn"); - return $self->{dn}; -} - -sub use_default_key -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("CertInfo: use_default_key"); - my $option = $::config->get("preop.cert.$self->{tag}.keysize.select"); - if (($option ne "") && ($option ne "default")) { - return 0; - } - return 1; -} - -sub get_nickname -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("CertInfo: get_nickname"); - my $nickname = $::config->get("preop.cert.$self->{tag}.nickname"); - - my $flavor = "pki"; - $flavor =~ s/\n//g; - - if ($nickname ne "") { - return $nickname; - } else { - return $self->{tag}."cert cert-$flavor-ra"; - } -} - -sub get_key_option -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("CertInfo: get_key_option"); - my $option = $::config->get("preop.cert.$self->{tag}.keysize.select"); - - if ($option ne "") { - &PKI::RA::Wizard::debug_log("CertInfo: get_key_option from config = $option"); - return $option; - } else { - &PKI::RA::Wizard::debug_log("CertInfo: get_key_option not from config"); - return "default"; - } -} - -sub get_custom_keysize -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("CertInfo: get_custom_keysize"); - my $size = $::config->get("preop.cert.$self->{tag}.keysize.customsize"); - &PKI::RA::Wizard::debug_log("CertInfo: get_custom_keysize for preop.cert.$self->{tag}.keysize.customsize is $size"); - if ($size ne "") { - &PKI::RA::Wizard::debug_log("CertInfo: get_custom_keysize from config is $size"); - return $size; - } else { - &PKI::RA::Wizard::debug_log("CertInfo: get_custom_keysize not from config"); - return 2048; - } -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/CertPrettyPrintPanel.pm b/base/ra/lib/perl/PKI/RA/CertPrettyPrintPanel.pm deleted file mode 100755 index cf58d2327..000000000 --- a/base/ra/lib/perl/PKI/RA/CertPrettyPrintPanel.pm +++ /dev/null @@ -1,85 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; - -package PKI::RA::CertPrettyPrintPanel; -$PKI::RA::CertPrettyPrintPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(13); - $self->{"getName"} = &PKI::RA::Common::r("Certificates"); - $self->{"vmfile"} = "certprettyprintpanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("CertPrettyPrintPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("CertPrettyPrintPanel: update"); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("CertPrettyPrintPanel: display"); - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/CertRequestPanel.pm b/base/ra/lib/perl/PKI/RA/CertRequestPanel.pm deleted file mode 100755 index 51eb1d400..000000000 --- a/base/ra/lib/perl/PKI/RA/CertRequestPanel.pm +++ /dev/null @@ -1,301 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use PKI::RA::ReqCertInfo; -use FileHandle; - -package PKI::RA::CertRequestPanel; -$PKI::RA::CertRequestPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -our $cert_req_header="-----BEGIN NEW CERTIFICATE REQUEST-----"; -our $cert_req_footer="-----END NEW CERTIFICATE REQUEST-----"; -our $cert_header="-----BEGIN CERTIFICATE-----"; -our $cert_footer="-----END CERTIFICATE-----"; - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(13); - $self->{"getName"} = &PKI::RA::Common::r("Certificate Requests"); - $self->{"vmfile"} = "certrequestpanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("CertRequestPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("CertRequestPanel: update"); - - my $i = 0; - - my $instanceDir = $::config->get("service.instanceDir"); - - my $useExternalCA = $::config->get("preop.certenroll.useExternalCA"); - if ($useExternalCA eq "on") { - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: useExternalCA is on"); - } else { - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: useExternalCA is off"); - &PKI::RA::Wizard::debug_log("CertRequestPanel: update auto enrollment should have been done, no more action needed"); - return 1; - } - - &PKI::RA::Wizard::debug_log("CertRequestPanel: update External CA selected, retrieve/process user input"); - - my $tokenname = $::config->get("preop.module.token"); - &PKI::RA::Wizard::debug_log("CertRequestPanel: update got token name = $tokenname"); - my $token_pwd = $::pwdconf->get($tokenname); - $token_pwd =~ s/\n//g; - open FILE, ">$instanceDir/conf/.pwfile"; - system( "chmod 00660 $instanceDir/conf/.pwfile" ); - print FILE $token_pwd; - close FILE; - - my $hw; - my $tk; - - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - $hw = ""; - $tk = ""; - } else { - $hw = "-h $tokenname"; - $tk = $tokenname.":"; - } - - foreach my $certtag (@PKI::RA::Wizard::certtags) { - if ($certtag eq "subsystem") { - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: subsystem cert is pre-generated by the security domain"); - return 1; - } - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: for certag= $certtag"); - my $ccert = $::config->get("preop.cert.$certtag.cert"); - if ($ccert ne "") { - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: cert already exists in CS.cfg, go to next"); - next; - } - my $certchain = $q->param($certtag.'_cc'); - if ($certchain ne "") { - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: $certtag certchain is $certchain"); - my $cc_fn = "$instanceDir/conf/caCertChain.txt"; - my $tmp = `echo "$certchain" > $cc_fn`; - # remove existing one - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: try to delete existing certchain, if any....ok if it fails"); -# XXX remove should not be done lightly... - $tmp = `p7tool -d $instanceDir/alias -p $instanceDir/conf/chain1cert -a -i $cc_fn -o $instanceDir/conf/CAchain_pp.txt`; - my $r = $? >> 8; - my $failed = $? & 127; - if (($r > 0) && ($r < 10) && !$failed) { - my $i = 0; - while ($i ne $r) { - $tmp = `certutil -d $instanceDir/alias -D -n "Trusted CA $certtag cert$i"`; - $tmp = `certutil -d $instanceDir/alias -A -f $instanceDir/conf/.pwfile -n "Trusted CA $certtag cert$i" -t "CT,C,C" -i $instanceDir/conf/chain1cert$i.der`; -# $tmp = `rm $cc_fn`; - $i++ - } - } - } else { - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: no certchain included for certtag $certtag"); - } - - my $cert = $q->param($certtag); - if ($cert ne "") { - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: $certtag cert is $cert"); - my $nickname = $::config->get("preop.cert.$certtag.nickname"); - if ($nickname eq "") { - $nickname = "RA ".$certtag." cert"; - $::config->put("preop.cert.$certtag.nickname", $nickname); - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: $certtag cert nickname not found in CS.cfg, generating one= $nickname"); - } - #remove existing one - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: try to delete existing cert $nickname, if any....ok if it fails"); -#XXX remove should not be done lightly... - my $tmp = `certutil -d $instanceDir/alias -D -n "$nickname"`; - $tmp = `certutil -d $instanceDir/alias -D $hw -f $instanceDir/conf/.pwfile -n "$tk$nickname"`; - #now import the cert - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: try to import cert"); - my $cert_fn = "$instanceDir/conf/$certtag"."_cert.txt"; - $tmp = `echo "$cert" > $cert_fn`; - -# $cert = extract_cert_from_file_sans_header_and_footer($cert_fn); - my $certa =""; - my $save_line = 0; - my @cert_a = split "\n", $cert; - foreach my $line (@cert_a) { - chomp( $line ); - $line =~ s/\r//g; - if ($line eq $cert_header) { - $save_line = 1; - } elsif( $line eq $cert_footer ) { - $save_line = 0; - last; - } elsif( $save_line == 1 ) { - $certa .= "$line"; - } - } - - &PKI::RA::Wizard::debug_log("CertRequestPanel: update putting cert in CS.cfg: $certa"); - - $::config->put("preop.cert.$certtag.cert", $certa); - - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: about to certutil -d $instanceDir/alias $hw -A -f $instanceDir/conf/.pwfile -n $nickname -t u,u,u -a -i $cert_fn"); - $tmp = `certutil -d $instanceDir/alias $hw -A -f $instanceDir/conf/.pwfile -n "$nickname" -t "u,u,u" -a -i $cert_fn`; - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: done certutil: $tmp"); - $tmp = `rm $cert_fn`; - - # changed the cert, need to change nickname too, if necessary - if ($hw ne "") { - $::config->put("preop.cert.$certtag.nickname", "$tk$nickname"); - if ($certtag eq "subsystem") { - $::config->put("conn.ca1.clientNickname","$tk$nickname"); - $::config->put("conn.drm1.clientNickname","$tk$nickname"); - $::config->put("conn.tks1.clientNickname","$tk$nickname"); - } - } - - } else { - &PKI::RA::Wizard::debug_log("CertRequestPanel: update: no cert"); - } - } - -DONE: - $::config->commit(); - my $tmp = `rm $instanceDir/conf/.pwfile`; - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("CertRequestPanel: display"); - - my $domain_name = $::config->get("preop.securitydomain.name"); - if ($domain_name eq "") { - $domain_name = "RA Domain"; - } - my $machine_name = $::config->get("service.machineName"); - my $instance_id = $::config->get("service.instanceID"); - - my $i = 0; - foreach my $certtag (@PKI::RA::Wizard::certtags) { - my $cert_dn = $::config->get("preop.cert.".$certtag.".dn"); - if ($cert_dn eq "") { - if ($certtag eq "subsystem") { - $cert_dn = "CN=RA Subsystem, " . - "OU=" . $instance_id . ", " . - "O=" . $domain_name; - } elsif ($certtag eq "sslserver") { - $cert_dn ="CN=" . $machine_name . ", " . - "OU=" . $instance_id . ", " . - "O=" . $domain_name; - } else { - $cert_dn = $certtag; - } - } - - my $name = $::config->get("preop.cert.".$certtag.".userfriendlyname"); - if ($name eq "") { - $name = $certtag."Cert ".$instance_id; - } - - my $reqcert = new PKI::RA::ReqCertInfo($name, - $cert_dn, $certtag); - $::symbol{reqscerts}[$i++] = $reqcert; - } - - $::symbol{errorString} = ""; - $::symbol{showApplyButton} = "true"; - - return 1; -} - -# arg0 message containing certificate -# return certificate sans header and footer -# -- all in a one-liner -sub extract_cert_from_file_sans_header_and_footer -{ - my $filename = $_[0]; - my $save_line = 0; - - my $fd = new FileHandle; - - my $cert = ""; - - $fd->open( "<$filename" ) or die "Could not open '$filename'!\n"; - - while( <$fd> ) - { - my $line = $_; - chomp( $line ); - $line =~ s/^M//g; - - if( $line eq $cert_header ) { - $save_line = 1; - } elsif( $line eq $cert_footer ) { - $save_line = 0; - last; - } elsif( $save_line == 1 ) { - $cert .= "$line"; - } - } - - $fd->close(); - - return $cert; -} - - -1; diff --git a/base/ra/lib/perl/PKI/RA/Common.pm b/base/ra/lib/perl/PKI/RA/Common.pm deleted file mode 100755 index 8deab8c6c..000000000 --- a/base/ra/lib/perl/PKI/RA/Common.pm +++ /dev/null @@ -1,50 +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::RA::Common; - -use strict; -use warnings; -use Exporter; - -use vars qw(@ISA @EXPORT @EXPORT_OK); -@ISA = qw(Exporter Autoloader); -@EXPORT = qw(r yes no); - -$PKI::RA::Common::VERSION = '1.00'; - -sub yes { - return sub {1}; -} - -sub no { - return sub {0}; -} - -sub r { - my $a = shift; - return sub { $a; } -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/Config.pm b/base/ra/lib/perl/PKI/RA/Config.pm deleted file mode 100755 index f1ace5b03..000000000 --- a/base/ra/lib/perl/PKI/RA/Config.pm +++ /dev/null @@ -1,170 +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::RA::Config; - -use strict; -use warnings; -use Exporter; - -$PKI::RA::Config::VERSION = '1.00'; - -####################################################### -# Configuration Store -####################################################### -sub new { - my $class = shift; - my $self = {}; - my %hash = (); - $self->{filename} = ""; - $self->{hash} = \%hash; - bless $self,$class; - return $self; -} - -sub load_file -{ - my ($self, $filename) = @_; - - $self->{filename} = $filename; - if (-e $filename) { - open(CF, "<$filename"); - if (defined fileno CF) { - while (<CF>) { - if (/^#/) { - # comments - } elsif (/([^=]+)=(.*)$/) { - # print "$1 = $2\n"; - $self->{hash}{$1} = $2; - } else { - # preserve comments - } - } - } - close(CF); - } -} - -sub get_filename -{ - my ($self) = @_; - return $self->{filename}; -} - -sub get -{ - my ($self, $n) = @_; - return $self->{hash}{$n}; -} - -sub put -{ - my ($self, $n, $v) = @_; - $self->{hash}{$n} = $v; -} - -sub deleteSubstore -{ - my ($self, $n) = @_; - foreach my $xkey (keys %{$self->{hash}}) { - if ($xkey =~ /^\Q$n\E/) { - delete $self->{hash}{$xkey}; - } - } -} - -sub commit -{ - my ($self) = @_; - - # write stuff back to the file -# print $self->{filename} . "\n"; - my $hash = $self->{hash}; - my $suffix = time(); - - if (-e $self->{filename}) { - # Create a copy of the original file which - # preserves the original file permissions - system("cp -p \"" . $self->{filename} . "\" \"" . - $self->{filename} . "." . $suffix . "\""); - } - - # Overwrite the contents of the original file - # to preserve the original file permissions - open(F, ">" . $self->{filename}); - foreach my $k (sort keys %{$hash}) { - print F "$k=$self->{hash}{$k}\n"; - } - close(F); - - if (-e $self->{filename} . "." . $suffix) { - system("rm \"" . $self->{filename} . "." . $suffix . "\""); - } -} - -sub commit_with_backup -{ - my ($self) = @_; - - # write stuff back to the file -# print $self->{filename} . "\n"; - my $hash = $self->{hash}; - my $suffix = time(); - # Create a copy of the original file which - # preserves the original file permissions - system("cp -p \"" . $self->{filename} . "\" \"" . - $self->{filename} . "." . $suffix . "\""); - - # Overwrite the contents of the original file - # to preserve the original file permissions - open(F, ">" . $self->{filename}); - foreach my $k (sort keys %{$hash}) { - print F "$k=$self->{hash}{$k}\n"; - } - close(F); -} - -1; - -####################################################### -# Test Program -####################################################### -#my $config = PKI::RA::Config->new(); -#$config->load_file("/tmp/CS.cfg"); -#print $config->get("tokendb.indexAdminTemplate") . "\n"; -#$config->put("tokendb.indexAdminTemplate", "Testing"); -#print $config->get("tokendb.indexAdminTemplate") . "\n"; -#$config->commit(); - -1; - -####################################################### -# Test Program -####################################################### -#my $config = PKI::RA::Config->new(); -#$config->load_file("/tmp/CS.cfg"); -#print $config->get("tokendb.indexAdminTemplate") . "\n"; -#$config->put("tokendb.indexAdminTemplate", "Testing"); -#print $config->get("tokendb.indexAdminTemplate") . "\n"; -#$config->commit(); diff --git a/base/ra/lib/perl/PKI/RA/ConfigHSMLoginPanel.pm b/base/ra/lib/perl/PKI/RA/ConfigHSMLoginPanel.pm deleted file mode 100755 index bf74890cc..000000000 --- a/base/ra/lib/perl/PKI/RA/ConfigHSMLoginPanel.pm +++ /dev/null @@ -1,104 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; - -package PKI::RA::ConfigHSMLoginPanel; -$PKI::RA::ConfigHSMLoginPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(9); - $self->{"getName"} = &PKI::RA::Common::r("Security Modules Login"); - $self->{"vmfile"} = "config_hsmloginpanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 1; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel: update"); - my $uTokName = $q->param('uTokName'); - my $uPasswd = $q->param('__uPasswd'); - -# &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel: update tokname= $uTokName pwd =$uPasswd"); - - $::pwdconf->put($uTokName, $uPasswd); - $::pwdconf->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - use Data::Dumper; - $Data::Dumper::Indent = 1; -# &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel -> dump of q= ". Dumper($q)); - $::symbol{SecToken} = $q->param('SecToken'); -# &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel -> display has ".$q->param('SecToken')); - - &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel -> display retrieving $q->param('SecToken') "); - my $pwd = $::pwdconf->get( $q->param('SecToken')); - if ($pwd ne "") { - &PKI::RA::Wizard::debug_log("ConfigHSMLoginPanel -> display retrieved pwd from pwdconf"); - } - - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/ConfigHSMPanel.pm b/base/ra/lib/perl/PKI/RA/ConfigHSMPanel.pm deleted file mode 100755 index 095ed5879..000000000 --- a/base/ra/lib/perl/PKI/RA/ConfigHSMPanel.pm +++ /dev/null @@ -1,72 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; - -package PKI::RA::ConfigHSMPanel; -$PKI::RA::ConfigHSMPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&PKI::RA::Common::no; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(12); - $self->{"getName"} = &PKI::RA::Common::r("ConfigHSMLogin"); - $self->{"vmfile"} = "config_hsm.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("ConfigHSMPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("ConfigHSMPanel: update"); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("ConfigHSMPanel: display"); - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/DRMInfoPanel.pm b/base/ra/lib/perl/PKI/RA/DRMInfoPanel.pm deleted file mode 100755 index fadd7727c..000000000 --- a/base/ra/lib/perl/PKI/RA/DRMInfoPanel.pm +++ /dev/null @@ -1,140 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use URI::URL; - -package PKI::RA::DRMInfoPanel; -$PKI::RA::DRMInfoPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(6); - $self->{"getName"} = &PKI::RA::Common::r("DRM Information"); - $self->{"vmfile"} = "drminfopanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DRMInfoPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DRMInfoPanel: update"); - - my $choice = $q->param('choice'); - $::config->put("preop.krainfo.keygen", $choice); - - if ($choice eq "keygen") { - my $count = $q->param('urls'); - my $instanceID = $::config->get("service.instanceID"); - my $host = ""; - my $https_agent_port = ""; - if ($count =~ /http/) { - my $info = new URI::URL($count); - $host = $info->host; - $https_agent_port = $info->port; - } else { - $host = $::config->get("preop.securitydomain.kra$count.host"); - $https_agent_port = $::config->get("preop.securitydomain.kra$count.secureagentport"); - } - if (($host eq "") || ($https_agent_port eq "")) { - $::symbol{errorString} = "no DRM found. CA, TKS and DRM must be installed prior to RA installation"; - return 0; - } - - $::config->put("preop.krainfo.select", "https://$host:$https_agent_port"); - my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname"); - $::config->put("conn.drm1.clientNickname", $subsystemCertNickName); - $::config->put("conn.drm1.hostport", $host . ":" . $https_agent_port); - $::config->put("conn.tks1.serverKeygen", "true"); - $::config->put("op.enroll.userKey.keyGen.encryption.serverKeygen.enable", "true"); - $::config->put("op.enroll.userKeyTemporary.keyGen.encryption.serverKeygen.enable", "true"); - } else { - # no keygen - $::config->put("conn.tks1.serverKeygen", "false"); - $::config->put("op.enroll.userKey.keyGen.encryption.serverKeygen.enable", "false"); - $::config->put("op.enroll.userKeyTemporary.keyGen.encryption.serverKeygen.enable", "false"); - $::config->put("conn.drm1.clientNickname", ""); - $::config->put("conn.drm1.hostport", ""); - } - $::config->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DRMInfoPanel: display"); - - $::symbol{urls} = []; - my $count = 0; - while (1) { - my $host = $::config->get("preop.securitydomain.kra$count.host"); - if ($host eq "") { - goto DONE; - } - my $https_agent_port = $::config->get("preop.securitydomain.kra$count.secureagentport"); - my $name = $::config->get("preop.securitydomain.kra$count.subsystemname"); - $::symbol{urls}[$count++] = $name . " - https://" . $host . ":" . $https_agent_port; - } -DONE: - $::symbol{urls_size} = $count; - - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/DatabasePanel.pm b/base/ra/lib/perl/PKI/RA/DatabasePanel.pm deleted file mode 100755 index e469e51f8..000000000 --- a/base/ra/lib/perl/PKI/RA/DatabasePanel.pm +++ /dev/null @@ -1,109 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; - -use DBI; -package PKI::RA::DatabasePanel; -$PKI::RA::DatabasePanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(8); - $self->{"getName"} = &PKI::RA::Common::r("Internal Database"); - $self->{"vmfile"} = "databasepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DatabasePanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DatabasePanel: update"); - my $instDir = $::config->get("service.instanceDir"); - - # create local database - my $dbh = DBI->connect( - "dbi:SQLite:dbname=$instDir/conf/dbfile","",""); - - # create database lockfile - system("touch $instDir/conf/dblock"); - - open(F, "/usr/share/pki/ra/scripts/schema.sql"); - while (<F>) { - if (!($_ =~ /^#/)) { - $dbh->do($_); - } - } - close(F); - - $dbh->disconnect(); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DatabasePanel: display"); - - my $machineName = $::config->get("service.machineName"); - my $instanceId = $::config->get("service.instanceID"); - - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/DisplayCertChain2Panel.pm b/base/ra/lib/perl/PKI/RA/DisplayCertChain2Panel.pm deleted file mode 100755 index 46c8a2902..000000000 --- a/base/ra/lib/perl/PKI/RA/DisplayCertChain2Panel.pm +++ /dev/null @@ -1,179 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use FileHandle; - -package PKI::RA::DisplayCertChain2Panel; -$PKI::RA::DisplayCertChain2Panel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -our $cert_header="-----BEGIN CERTIFICATE-----"; -our $cert_footer="-----END CERTIFICATE-----"; - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(7); - $self->{"getName"} = &PKI::RA::Common::r("Display Certificate Chain"); - $self->{"vmfile"} = "displaycertchain2panel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub readFile -{ - my $fn = $_[0]; - open FILE, "< $fn" or return ""; - my $content = join "",<FILE>; - close FILE; - - return $content; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: update"); - - my $instanceDir = $::config->get("service.instanceDir"); - -# my $caCert = readFile("$instanceDir/conf/caCertChain2.txt"); - my $caCert = extract_cert_from_file_sans_header_and_footer("$instanceDir/conf/caCertChain2.txt"); - - #store in config - $::config->put("preop.ca.certchain", $caCert); - $::config->commit(); - # import it into the security database - my $tmp = `p7tool -d $instanceDir/alias -p $instanceDir/conf/chain2cert -a -i $instanceDir/conf/caCertChain2.txt -o $instanceDir/conf/CAchain2_pp.txt`; - my $r = $? >> 8; - my $failed = $? & 127; - if (($r > 0) && ($r < 10) && !$failed) { - my $i = 0; - while ($i ne $r) { - $tmp = `certutil -d $instanceDir/alias -D -n "Trusted CA c2cert$i"`; - $tmp = `certutil -d $instanceDir/alias -A -f $instanceDir/conf/.pwfile -n "Trusted CA c2cert$i" -t "CT,C,C" -i $instanceDir/conf/chain2cert$i.der`; - $i++ - } - } - - # clean up -# my $tmp = `rm $instanceDir/conf/caCertChain2.txt`; -# $tmp = `rm $instanceDir/conf/CAchain2_pp.txt`; - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: display"); - my $instanceDir = $::config->get("service.instanceDir"); - - my $found = -e "$instanceDir/conf/caCertChain2.txt"; - my $certpp = ""; - if ($found) { - &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: display found caCertChain2.txt"); - my $tmp = `p7tool -d $instanceDir/alias -p $instanceDir/conf/chain2cert -a -i $instanceDir/conf/caCertChain2.txt -o $instanceDir/conf/CAchain2_pp.txt`; - - $certpp = readFile("$instanceDir/conf/CAchain2_pp.txt"); - &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: display read CAchain2_pp.txt"); - $certpp =~ s/"//g; - &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: certpp2= $certpp"); - } - -# $symbol{certchain} = [ "cert1", "cert2" ]; -# $symbol{certchain_size} = 2; - $::symbol{certchain} = "$certpp"; - $::symbol{certchain_size} = 1; - - &PKI::RA::Wizard::debug_log("DisplayCertChain2Panel: display done"); - return 1; -} - -# return certificate sans header and footer -# -- all in a one-liner -sub extract_cert_from_file_sans_header_and_footer -{ - my $filename = $_[0]; - my $save_line = 0; - - my $fd = new FileHandle; - - my $cert = ""; - - $fd->open( "<$filename" ) or die "Could not open '$filename'!\n"; - - while( <$fd> ) - { - my $line = $_; - chomp( $line ); - $line =~ s/^M//g; - - if( $line eq $cert_header ) { - $save_line = 1; - } elsif( $line eq $cert_footer ) { - $save_line = 0; - last; - } elsif( $save_line == 1 ) { - $cert .= "$line"; - } - } - - $fd->close(); - - return $cert; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/DisplayCertChainPanel.pm b/base/ra/lib/perl/PKI/RA/DisplayCertChainPanel.pm deleted file mode 100755 index dd991a917..000000000 --- a/base/ra/lib/perl/PKI/RA/DisplayCertChainPanel.pm +++ /dev/null @@ -1,348 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use URI::URL; -use MIME::Base64; - -package PKI::RA::DisplayCertChainPanel; -$PKI::RA::DisplayCertChainPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(2); - $self->{"getName"} = &PKI::RA::Common::r("Display Certificate Chain"); - $self->{"vmfile"} = "displaycertchainpanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 1; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: validate"); - return 1; -} - -sub readFile -{ - my $fn = $_[0]; - open FILE, "< $fn" or return ""; - my $content = join "",<FILE>; - close FILE; - - return $content; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: update"); - - my $instanceDir = $::config->get("service.instanceDir"); - - my $caCert = readFile("$instanceDir/conf/caCert.txt"); - - #store in config - $::config->put("preop.ca.certchain", $caCert); - $::config->commit(); - - # import it into the security database -# my $cmd1 = `/usr/bin/AtoB $instanceDir/conf/caCert.txt $instanceDir/conf/caCert.der`; - my $cmd2 = `/usr/bin/certutil -A -d \"$instanceDir/alias\" -t \"CT,CT,CT\" -n \"caCert\" -i $instanceDir/conf/caCert.der`; - - # clean up - my $tmp = `rm $instanceDir/conf/caCert.txt`; - $tmp = `rm $instanceDir/conf/caCert.der`; - $tmp = `rm $instanceDir/conf/caCert_pp.txt`; - - # complete the SecurityDomain task - my $sdomainAdminURL = $::config->get("config.sdomainAdminURL"); - if ($sdomainAdminURL eq "") { - return 2; - } - - my $machineName = $::config->get("service.machineName"); - my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort"); - my $unsecurePort = $::config->get("service.unsecurePort"); - - # check if url is accessible - # redirect to the security domain authentication - if ($ENV{'SERVER_PORT'} eq $unsecurePort) { - $::symbol{redirect} = $sdomainAdminURL . "/ca/admin/ca/securityDomainLogin?url=http%3A%2F%2F" . $machineName . "%3A" . $unsecurePort . "%2Fra%2Fadmin%2Fconsole%2Fconfig%2Fwizard%3Fp%3D3%26subsystem%3DRA"; - } else { - $::symbol{redirect} = $sdomainAdminURL . "/ca/admin/ca/securityDomainLogin?url=https%3A%2F%2F" . $machineName . "%3A" . $non_clientauth_securePort . "%2Fra%2Fadmin%2Fconsole%2Fconfig%2Fwizard%3Fp%3D3%26subsystem%3DRA"; - } - - get_domain_xml($sdomainAdminURL); - - - return 3; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: display"); - - # connect to the CA, and retrieve the CA certificate - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: update connecting to CA and retrieve cert chain"); - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $sdomainAdminURL = $::config->get("config.sdomainAdminURL"); - if ($sdomainAdminURL eq "") { - return 2; - } - - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - - my $url_info = new URI::URL($sdomainAdminURL); - my $sd_host = $url_info->host; - my $sd_admin_port = $url_info->port; - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $cmd = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -r \"/ca/admin/ca/getCertChain\" $sd_host:$sd_admin_port`; - - my $caCert = ""; - if ($cmd =~ /\<ChainBase64\>(.*)\<\/ChainBase64\>/) { - $caCert = $1; - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: ca= $caCert"); - } - - my $certpp = ""; - if ($caCert ne "") { - open(F, ">$instanceDir/conf/caCert.txt"); - print F $caCert; - close(F); - - # test to see if tmp directory exists, if not, create - my $found = -e "$instanceDir/conf/tmp"; - if (! $found) { - my $tmp = `mkdir $instanceDir/conf/tmp`; - } - - # import it into a temporary security database -# my $cmd1 = `/usr/bin/AtoB $instanceDir/conf/caCert.txt $instanceDir/conf/caCert.der`; - # my $cmd1 = `/usr/bin/openssl base64 -d -A -in $instanceDir/conf/caCert.txt -out $instanceDir/conf/caCert.der`; - - my $txt = `cat $instanceDir/conf/caCert.txt`; - open(OUT, ">$instanceDir/conf/caCert.der"); - print OUT MIME::Base64::decode($txt); - close(OUT); - - my $cmd2 = `/usr/bin/certutil -A -d \"$instanceDir/conf/tmp\" -t \"CT,CT,CT\" -n \"caCert\" -i $instanceDir/conf/caCert.der`; - - # get pretty print from temp db - my $tmp = `certutil -d $instanceDir/conf/tmp -n "caCert" -L > $instanceDir/conf/caCert_pp.txt`; - $certpp = readFile("$instanceDir/conf/caCert_pp.txt"); - $certpp =~ s/"//g; - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: certpp= $certpp"); - # clean up temp db - $tmp = `certutil -d $instanceDir/alias/tmp -D -n "caCert"`; - } else { - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: update no certchain found"); - } - - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: display certchain=$caCert"); - -# $symbol{certchain} = [ "cert1", "cert2" ]; -# $symbol{certchain_size} = 2; - $::symbol{certchain} = "$certpp"; -# This certchain_size does not matter - $::symbol{certchain_size} = 1; - - return 1; -} - -sub get_domain_xml -{ - my ($sdomainAdminURL) = @_; - - my $sdom_info = new URI::URL($sdomainAdminURL); - # get the domain xml - # e. g. - https://water.sfbay.redhat.com:9445/ca/admin/ca/getDomainXML - - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - - my $sd_host = $sdom_info->host; - my $sd_admin_port = $sdom_info->port; - my $content = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -r \"/ca/admin/ca/getDomainXML\" $sd_host:$sd_admin_port`; - - $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; - $content = $1; - - &PKI::RA::Wizard::debug_log("content = " . $content); - - my $parser = XML::Simple->new(); - my $response = $parser->XMLin($content); - my $xml = $parser->XMLin($response->{'DomainInfo'}, - ForceArray => 1); - - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: security domain '" . - $xml->{'Name'}[0] . "'"); - $::config->put("preop.securitydomain.name", $xml->{'Name'}[0]); - $::config->put("securitydomain.name", $xml->{'Name'}[0]); - - # parse xml and store information in CS.cfg - my $count = 0; - $count = 0; - foreach my $c (@{$xml->{'CAList'}[0]->{'CA'}}) { - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: Found CA '" . - $c->{'SubsystemName'}[0] . "'"); - $::config->put("preop.securitydomain.ca" . $count . ".subsystemname", - $c->{'SubsystemName'}[0]); - $::config->put("preop.securitydomain.ca" . $count . ".secureport", - $c->{'SecurePort'}[0]); - $::config->put("preop.securitydomain.ca" . $count . ".secureagentport", - $c->{'SecureAgentPort'}[0]); - $::config->put("preop.securitydomain.ca" . $count . ".secureadminport", - $c->{'SecureAdminPort'}[0]); - $::config->put("preop.securitydomain.ca" . $count . ".unsecureport", - $c->{'UnSecurePort'}[0]); - $::config->put("preop.securitydomain.ca" . $count . ".host", - $c->{'Host'}[0]); - - # The user previously specified the CA Security Domain's - # SSL Admin URL in the "Security Domain Panel"; - # now retrieve this specified CA Security Domain's - # non-SSL EE, SSL Agent, and SSL EE URLs: - if( $sd_admin_port eq $c->{'SecureAdminPort'}[0] ) { - # Build the URLs - my $http_ee_port = "https://" - . $c->{'Host'}[0] - . ":" - . $c->{'UnSecurePort'}[0]; - my $https_agent_port = "https://" - . $c->{'Host'}[0] - . ":" - . $c->{'SecureAgentPort'}[0]; - my $https_ee_port = "https://" - . $c->{'Host'}[0] - . ":" - . $c->{'SecurePort'}[0]; - - # Store the URLs - $::config->put( "config.sdomainHttpURL", $http_ee_port ); - $::config->put( "config.sdomainAgentURL", $https_agent_port ); - $::config->put( "config.sdomainEEURL", $https_ee_port ); - - # Store additional values necessary for 'pkiremove' . . . - $::config->put( "securitydomain.httpport", - $c->{'UnSecurePort'}[0] ); - $::config->put( "securitydomain.httpsagentport", - $c->{'SecureAgentPort'}[0] ); - $::config->put( "securitydomain.httpseeport", - $c->{'SecurePort'}[0] ); - } - - $count++; - } - - $count = 0; - foreach my $c (@{$xml->{'TKSList'}[0]->{'TKS'}}) { - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: Found TKS '" . - $c->{'SubsystemName'}[0] . "'"); - $::config->put("preop.securitydomain.tks" . $count . ".subsystemname", - $c->{'SubsystemName'}[0]); - $::config->put("preop.securitydomain.tks" . $count . ".secureport", - $c->{'SecurePort'}[0]); - $::config->put("preop.securitydomain.tks" . $count . ".secureagentport", - $c->{'SecureAgentPort'}[0]); - $::config->put("preop.securitydomain.tks" . $count . ".secureadminport", - $c->{'SecureAdminPort'}[0]); - $::config->put("preop.securitydomain.tks" . $count . ".unsecureport", - $c->{'UnSecurePort'}[0]); - $::config->put("preop.securitydomain.tks" . $count . ".host", - $c->{'Host'}[0]); - $count++; - } - - $count = 0; - foreach my $c (@{$xml->{'KRAList'}[0]->{'KRA'}}) { - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: Found KRA '" . - $c->{'SubsystemName'}[0] . "'"); - $::config->put("preop.securitydomain.kra" . $count . ".subsystemname", - $c->{'SubsystemName'}[0]); - $::config->put("preop.securitydomain.kra" . $count . ".secureport", - $c->{'SecurePort'}[0]); - $::config->put("preop.securitydomain.kra" . $count . ".secureagentport", - $c->{'SecureAgentPort'}[0]); - $::config->put("preop.securitydomain.kra" . $count . ".secureadminport", - $c->{'SecureAdminPort'}[0]); - $::config->put("preop.securitydomain.kra" . $count . ".unsecureport", - $c->{'UnSecurePort'}[0]); - $::config->put("preop.securitydomain.kra" . $count . ".host", - $c->{'Host'}[0]); - $count++; - } - - $count = 0; - foreach my $c (@{$xml->{'RAList'}[0]->{'RA'}}) { - &PKI::RA::Wizard::debug_log("DisplayCertChainPanel: Found RA '" . - $c->{'SubsystemName'}[0] . "'"); - $::config->put("preop.securitydomain.ra" . $count . ".subsystemname", - $c->{'SubsystemName'}[0]); - $::config->put("preop.securitydomain.ra" . $count . ".secureport", - $c->{'SecureAgentPort'}[0]); - $::config->put("preop.securitydomain.ra" . $count . ".non_clientauth_secure_port", - $c->{'SecurePort'}[0]); - $::config->put("preop.securitydomain.ra" . $count . ".unsecureport", - $c->{'UnSecurePort'}[0]); - $::config->put("preop.securitydomain.ra" . $count . ".host", - $c->{'Host'}[0]); - $count++; - } - $::config->commit(); -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/DonePanel.pm b/base/ra/lib/perl/PKI/RA/DonePanel.pm deleted file mode 100755 index cf5f75df0..000000000 --- a/base/ra/lib/perl/PKI/RA/DonePanel.pm +++ /dev/null @@ -1,399 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use URI::URL; -use XML::Simple; - -package PKI::RA::DonePanel; -$PKI::RA::DonePanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(16); - $self->{"getName"} = &PKI::RA::Common::r("Done"); - $self->{"vmfile"} = "donepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DonePanel: validate"); - return 1; -} -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("DonePanel: update"); - return 1; -} - -sub register_ra -{ - my ($sdom, $url, $uri, $xname) = @_; - - &PKI::RA::Wizard::debug_log("DonePanel: register_ra at $url"); - &PKI::RA::Wizard::debug_log("DonePanel: subsystem $xname uri=$uri"); - - my $url_info = new URI::URL($url); - my $sdom_info = new URI::URL($sdom); - - # register RA to Security Domain - # submit request to CA - &PKI::RA::Wizard::debug_log("DonePanel: Connecting to Security Domain"); - - my $machineName = $::config->get("service.machineName"); - my $unsecurePort = $::config->get("service.unsecurePort"); - my $securePort = $::config->get("service.securePort"); - my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort"); - my $session_id = $::config->get("preop.sessionID"); - - &PKI::RA::Wizard::debug_log("DonePanel: Security Domain Info " . $url); - - # add service.securityDomainPort to the config file in case pkiremove - # needs to remove system reference from the security domain - $::config->put("service.securityDomainPort", $securePort); - $::config->commit(); - - my $uid = "RA-" . $machineName . "-" . $securePort; - my $name = "Registration Authority Subsystem"; - - my $instDir = $::config->get("service.instanceDir"); - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - - my $hw; - my $tk; - my $tokenname = $::config->get("preop.module.token"); - &PKI::RA::Wizard::debug_log("ReqCertInfo: update got token name = $tokenname"); - - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - $hw = ""; - $tk = ""; - } else { - $hw = "-h $tokenname"; - $tk = $tokenname.":"; - } - - my $token_pwd = $::pwdconf->get($tokenname); - open FILE, ">$instDir/conf/.pwfile"; - system( "chmod 00660 $instDir/conf/.pwfile" ); - $token_pwd =~ s/\n//g; - print FILE $token_pwd; - close FILE; - - my $subsystemNickname = $::config->get("preop.cert.subsystem.nickname"); - my $certificate = `/usr/bin/certutil -d "$instDir/alias" -L $hw -f "$instDir/conf/.pwfile" -n "$subsystemNickname" -a`; - $certificate =~ s/-----BEGIN CERTIFICATE-----//g; - $certificate =~ s/-----END CERTIFICATE-----//g; - $certificate =~ s/\n$//g; - - - &PKI::RA::Wizard::debug_log("DonePanel: Connecting"); - - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - - my $params = "uid=" . $uid . "&" . - "name=" . $name . "&" . - "certificate=" . - URI::Escape::uri_escape("$certificate") . "&" . - "xmlOutput=true" . "&" . - "sessionID=" . $session_id . "&" . - "auth_hostname=" . $sdom_info->host . "&" . - "auth_port=" . $sdom_info->port; - - my $host = $url_info->host; - my $port = $url_info->port; - my $tmpfile = "/tmp/donepanel-$$"; - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$nickname\" -r \"$uri\" $host:$port > $tmpfile"); - } else { - system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -n \"$nickname\" -r \"$uri\" $host:$port > $tmpfile"); - } - my $content = `cat $tmpfile`; - system("rm $tmpfile"); - - &PKI::RA::Wizard::debug_log("req = " . $content); - $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; - $content = $1; - - &PKI::RA::Wizard::debug_log("DonePanel: result " . $content); - my $tmp = `rm $instDir/conf/.pwfile`; -} - -sub get_kra_transport_cert -{ - my ($sdom) = @_; - - my $sdom_info = new URI::URL($sdom); - - # register RA to Security Domain - # submit request to CA - &PKI::RA::Wizard::debug_log("DonePanel: Connecting to KRA"); - - my $krainfo = $::config->get("preop.krainfo.select"); - my $krainfo_url = new URI::URL($krainfo); - - my $machineName = $::config->get("service.machineName"); - my $unsecurePort = $::config->get("service.unsecurePort"); - my $securePort = $::config->get("service.securePort"); - my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort"); - my $session_id = $::config->get("preop.sessionID"); - - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $tokenname = $::config->get("preop.module.token"); - my $token_pwd = $::pwdconf->get($tokenname); - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - - my $params = "sessionID=" . $session_id . "&" . - "auth_hostname=" . $sdom_info->host . "&" . - "auth_port=" . $sdom_info->port; - - my $host = $krainfo_url->host; - my $port = $krainfo_url->port; - my $tmpfile = "/tmp/donepanel-$$"; - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -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::RA::Wizard::debug_log("DonePanel: TransportCert " . $transportCert); - - return $transportCert; -} - -sub send_kra_transport_cert -{ - my ($sdom, $certificate) = @_; - - my $sdom_info = new URI::URL($sdom); - - # register RA to Security Domain - # submit request to CA - &PKI::RA::Wizard::debug_log("DonePanel: Connecting to TKS"); - my $tksinfo = $::config->get("preop.tksinfo.select"); - my $tksinfo_url = new URI::URL($tksinfo); - - my $machineName = $::config->get("service.machineName"); - my $unsecurePort = $::config->get("service.unsecurePort"); - my $securePort = $::config->get("service.securePort"); - my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort"); - my $session_id = $::config->get("preop.sessionID"); - - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $tokenname = $::config->get("preop.module.token"); - my $token_pwd = $::pwdconf->get($tokenname); - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - - my $name = "transportCert-" . $machineName . "-" . $securePort; - my $params = "name=" . $name . "&" . - "certificate=" . - URI::Escape::uri_escape("$certificate") . "&" . - "xmlOutput=true" . "&" . - "sessionID=" . $session_id . "&" . - "auth_hostname=" . $sdom_info->host . "&" . - "auth_port=" . $sdom_info->port; - - my $host = $tksinfo_url->host; - my $port = $tksinfo_url->port; - my $tmpfile = "/tmp/donepanel-$$"; - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - system("/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -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::RA::Wizard::debug_log("DonePanel: Response from TKS " . $content); -} - -sub display -{ - my ($q) = @_; - # $symbol{systemType} = "ra"; - # $symbol{host} = "chico"; - # $symbol{port} = "443"; - &PKI::RA::Wizard::debug_log("DonePanel: display"); - - my $status = $::config->get("preop.done.status"); - if ($status eq "done") { - return 1; - } - - my $instDir = $::config->get("service.instanceDir"); - my $tokenname = $::config->get("preop.module.token"); - my $token_pwd = $::pwdconf->get($tokenname); - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - if (($tokenname ne "") && ($tokenname ne "NSS Certificate DB")) { - open(PWD_CONF, ">>$instDir/conf/password.conf"); - print PWD_CONF "$tokenname:$token_pwd\n"; - close (PWD_CONF); - } - - # Add this RA's server certificate to the subsystems - my $sdom = $::config->get("config.sdomainEEURL"); - my $cainfo = $::config->get("preop.cainfo.select"); - $cainfo =~ s/.* - //g; - ®ister_ra($sdom, $cainfo, $::config->get("conn.ca1.servlet.addagent"), "CA"); - - $::config->put("preop.done.status", "done"); - $::config->commit(); - - # update httpd.conf - open(TMP_HTTPD_CONF, ">$instDir/conf/httpd.conf.tmp"); - system( "chmod 00660 $instDir/conf/httpd.conf.tmp" ); - open(HTTPD_CONF, "<$instDir/conf/httpd.conf"); - while (<HTTPD_CONF>) { - if (/^#\[ErrorDocument_404\]/) { - print TMP_HTTPD_CONF "ErrorDocument 404 /404.html\n"; - } elsif (/^#\[ErrorDocument_500\]/) { - print TMP_HTTPD_CONF "ErrorDocument 500 /500.html\n"; - } else { - print TMP_HTTPD_CONF $_; - } - } - close(HTTPD_CONF); - close(TMP_HTTPD_CONF); - - # Create a copy of the original file which - # preserves the original file permissions - system( "cp -p $instDir/conf/httpd.conf.tmp $instDir/conf/httpd.conf" ); - - # Remove the original file only if the backup copy was successful - if( -e "$instDir/conf/httpd.conf" ) { - system( "rm $instDir/conf/httpd.conf.tmp" ); - } - - # update nss.conf - open(TMP_NSS_CONF, ">$instDir/conf/nss.conf.tmp"); - system( "chmod 00660 $instDir/conf/nss.conf.tmp" ); - open(NSS_CONF, "<$instDir/conf/nss.conf"); - while (<NSS_CONF>) { - if (/^NSSNickname/) { - print TMP_NSS_CONF "NSSNickname \"$nickname\"\n"; - } else { - print TMP_NSS_CONF $_; - } - } - close(NSS_CONF); - close(TMP_NSS_CONF); - - # Create a copy of the original file which - # preserves the original file permissions - system( "cp -p $instDir/conf/nss.conf.tmp $instDir/conf/nss.conf" ); - - # Remove the original file only if the backup copy was successful - if( -e "$instDir/conf/nss.conf" ) { - system( "rm $instDir/conf/nss.conf.tmp" ); - } - - &PKI::RA::Wizard::debug_log("DonePanel: Connecting to Security Domain"); - - my $machineName = $::config->get("service.machineName"); - my $unsecurePort = $::config->get("service.unsecurePort"); - my $securePort = $::config->get("service.securePort"); - my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort"); - my $instanceID = $::config->get("service.instanceID"); - - my $initDaemon = "pki-rad"; - my $restartCommand = ""; - if( $^O eq "linux" ) { - $restartCommand = "systemctl restart $initDaemon\@$instanceID.service"; - } else { - ## default case: e. g. - ( $^O eq "solaris" ) - $restartCommand = "/etc/init.d/$initDaemon restart $instanceID"; - } - - $::symbol{host} = $machineName; - $::symbol{unsecurePort} = $unsecurePort; - $::symbol{port} = $securePort; - $::symbol{non_clientauth_port} = $non_clientauth_securePort; - $::symbol{restartCommand} = $restartCommand; - $::symbol{instanceID} = $instanceID; - - $::config->deleteSubstore("preop."); - $::config->commit(); - - ## Create an empty file that designates the fact that although - ## this server instance has been configured, it has NOT yet - ## been restarted! - my $restart_server = "$instDir/conf/restart_server_after_configuration"; - system( "touch $restart_server" ); - system( "chmod 00660 $restart_server" ); - - system("rm $instDir/conf/*.txt $instDir/conf/*.der"); - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/GlobalVar.pm b/base/ra/lib/perl/PKI/RA/GlobalVar.pm deleted file mode 100755 index 388a41349..000000000 --- a/base/ra/lib/perl/PKI/RA/GlobalVar.pm +++ /dev/null @@ -1,42 +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 --- -# -# -# -# - -use strict; -use warnings; - -package PKI::RA::GlobalVar; -$PKI::RA::GlobalVar::VERSION = '1.00'; - -sub new { - my $class = shift; - my $self = {}; - my %args = (@_); - foreach my $q (keys %args) { - $self->{$q} = $args{$q}; - } - bless $self,$class; - return $self; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/ImportAdminCertPanel.pm b/base/ra/lib/perl/PKI/RA/ImportAdminCertPanel.pm deleted file mode 100755 index 9f9bef94a..000000000 --- a/base/ra/lib/perl/PKI/RA/ImportAdminCertPanel.pm +++ /dev/null @@ -1,142 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use URI::URL; - -package PKI::RA::ImportAdminCertPanel; -$PKI::RA::ImportAdminCertPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(15); - $self->{"getName"} = &PKI::RA::Common::r("Import Administrator Certificate"); - $self->{"vmfile"} = "importadmincertpanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("ImportAdminCertPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("ImportAdminCertPanel: update"); - - # register to Security Domain - my $sdom = $::config->get("config.sdomainAgentURL"); - my $sdom_url = new URI::URL($sdom); - - # - # we need to authenticate to the security domain with the subsystem - # certificate - # - my $machineName = $::config->get("service.machineName"); - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $securePort = $::config->get("service.securePort"); - my $subsystemName = $::config->get("preop.subsystem.name"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - my $name = $subsystemName; - my $subCertNickName = $::config->get("preop.cert.subsystem.nickname"); - - $db_password =~ s/\n$//g; - - my $params = "list=" . "RAList" . "&" . - "type=" . "RA" . "&" . - "host=" . $machineName . "&" . - "name=" . $name . "&" . - "sport=" . $securePort . "&" . - "dm=false"; # domain manager or not - - my $cmd = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$subCertNickName\" -r \"/ca/agent/ca/updateDomainXML?$params\" $sdom_url->host:$sdom_url->port`; - - # Fetch the "updated" security domain and display it - &PKI::RA::Wizard::debug_log("ImportAdminCertPanel: Dump contents of updated Security Domain . . ."); - my $sdomainAdminURL = $::config->get("config.sdomainAdminURL"); - my $sdom_info = new URI::URL($sdomainAdminURL); - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $sd_host = $sdom_info->host; - my $sd_admin_port = $sdom_info->port; - my $content = `/usr/bin/sslget -d \"$instanceDir/alias\" -p \"$db_password\" -v -r \"/ca/admin/ca/getDomainXML\" $sd_host:$sd_admin_port`; - $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; - $content = $1; - &PKI::RA::Wizard::debug_log($content); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("ImportAdminCertPanel: display"); - - my $cainfo = $::config->get("preop.cainfo.select"); - - my $cainfo_url = new URI::URL($cainfo); - my $serialNumber = $::config->get("preop.admincert.serialno.0"); - - $::symbol{info} = ""; - $::symbol{errorString} = ""; - $::symbol{import} = "true"; - $::symbol{ca} = "false"; - $::symbol{caType} = "ca"; - $::symbol{caHost} = $cainfo_url->host; - $::symbol{caPort} = $cainfo_url->port; - $::symbol{serialNumber} = $serialNumber; - - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/Login.pm b/base/ra/lib/perl/PKI/RA/Login.pm deleted file mode 100755 index d248e5481..000000000 --- a/base/ra/lib/perl/PKI/RA/Login.pm +++ /dev/null @@ -1,466 +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 --- -# -# -# -# - -# wizard - -# Fedora Certificate System - Registration Authority System configuration wizard - - -# This script is run as a 'mod_perl' CGI. Configure mod_perl by adding -# the following to /etc/httpd/conf.d/perl.conf -# -# PerlModule ModPerl::Registry -# PerlModule Apache::compat -# PerlModule PKI::RA::Wizard -# PerlSetEnv PKI_DOCROOT /u/sparkins/t/cs_tip/certsystem/prj/common/ui -# <Location /wizard> -# SetHandler perl-script -# PerlHandler PKI::RA::Wizard -# Order deny,allow -# Allow from all -# </Location> - - -# Note: The Velocity parser is not very helpful when it comes to -# errors right now. Here are some common errors, and what they mean: -# -# ERROR: -# [Mon Apr 03 13:57:33 2006] [error] [client 172.16.24.26] -# Can't use string ("0") as an ARRAY ref while "strict refs" -# in use at /usr/lib/perl5/site_perl/5.8.5/Template/Velocity.pm -# line 423.\n, referer: http://chico/wizard?p=2 -# MEANING -# This probably means that your *.vm file refers to an array -# variable in a foreach statement that is not defined -# Check your foreach array variables. - -use warnings; -use ModPerl::Registry; -use Template::Velocity; -use Getopt::Std; -use Data::Dumper; -use CGI::Carp qw(fatalsToBrowser); -use CGI; -use APR::Const -compile => qw(:error SUCCESS); -use PKI::RA::GlobalVar; -use PKI::RA::WelcomePanel; -use PKI::RA::SecurityDomainPanel; -use PKI::RA::DisplayCertChainPanel; -use PKI::RA::SubsystemTypePanel; -use PKI::RA::CAInfoPanel; -use PKI::RA::TKSInfoPanel; -use PKI::RA::DRMInfoPanel; -use PKI::RA::DisplayCertChain2Panel; -use PKI::RA::AdminAuthPanel; -use PKI::RA::AgentAuthPanel; -use PKI::RA::DatabasePanel; -use PKI::RA::ModulePanel; -use PKI::RA::SizePanel; -use PKI::RA::NamePanel; -use PKI::RA::ConfigHSMLoginPanel; -use PKI::RA::CertRequestPanel; -use PKI::RA::AdminPanel; -use PKI::RA::ImportAdminCertPanel; -use PKI::RA::LoginPanel; -use PKI::RA::DonePanel; -use PKI::RA::Config; - -use PKI::RA::Common qw(yes no r); - -package PKI::RA::Login; -$PKI::RA::Login::VERSION = '1.00'; - -# read configuration file -my $flavor = "pki"; -$flavor =~ s/\n//g; - -my $pkiroot = $ENV{PKI_ROOT}; - -my $config = PKI::RA::Config->new(); -$config->load_file("$pkiroot/conf/CS.cfg"); -# read password cache file -my $pwdconf = PKI::RA::Config->new(); -$pwdconf->load_file("$pkiroot/conf/pwcache.conf"); -# SELinux disallows performing a "chmod" on this file -if( $^O ne "linux" ) { - system( "chmod 00660 $pkiroot/conf/pwcache.conf" ); -} - -# create cfg debug log -my $logfile = $config->get("service.instanceDir") . "/logs/debug"; -open( DEBUG, ">>" . $logfile ) || -warn( "Could not open '" . $logfile . "': $!" ); - -# apache server - -our $debug; - -my $STATUS_OK = 1; -my $STATUS_ERROR = 2; -my $STATUS_REDIRECT = 3; - -&debug_log("RA wizard: starting up"); - -my $docroot = $ENV{PKI_DOCROOT}; - -if (! $docroot) { - &debug_log("RA wizard: ERROR: PKI_DOCROOT is null"); - return 0; -} - -our $parser = new Template::Velocity($docroot); -our $symbol; -our @certtags; - -makepanels(); - -&debug_log("RA wizard: start up complete"); - -1; - -sub debug_log -{ - my ($msg) = @_; - my $date = `date`; - chomp($date); - if( -w $logfile ) { - print DEBUG "$date - $msg\n"; - } -} - - # initializes entries in parser's global symbol table for panels -sub makepanels -{ - #REAL PANELS BELOW - my $login = new PKI::RA::LoginPanel(); - - $symbol{panels} = [ - $login, # com.netscape.cms.servlet.csadmin.WelcomePanel - ]; -}; - -sub render_panel -{ - my ($panelnum, $q) = @_; - - $symbol{errorString} = ""; - - my $currentpanel; - - if ($q->param('op') && $q->param('op') eq "next") { - $currentpanel = $symbol{panels}[$panelnum]; - # validate variables for panel - if ($currentpanel->{validate}) { - $currentpanel->{validate}($q); - } - # execute current panel - my $status = "0"; - - if ($currentpanel->{update}) { - $status = $currentpanel->{update}($q); - &debug_log("RA wizard: update returns status '" . - $status . "'"); - if ($status == $STATUS_REDIRECT) { - return $STATUS_REDIRECT; - } - - } - - &debug_log("RA wizard: about to find out about sub panel"); - if ($status eq "1") { - if ($currentpanel->{hasSubPanel} && &{$currentpanel->{hasSubPanel}}($q)) { - &debug_log("RA wizard: has sub panel"); - $panelnum = $panelnum + 2; - } elsif ($currentpanel->{isSubPanel} && &{$currentpanel->{isSubPanel}}($q)) { - &debug_log("RA wizard: is sub panel"); - $panelnum = $panelnum - 1; - } else { - &debug_log("RA wizard: no sub panel and is not subpanel"); - $panelnum = $panelnum + 1; - } - } - } elsif ($q->param('op') && $q->param('op') eq "back") { - $panelnum = $panelnum - 1; - #check if this a subpanel, if so, go back to it's parent. - #only handles one-deep at this point - my $panel = $symbol{panels}[$panelnum]; - if (&{$panel->{isSubPanel}}($q)) { - $panelnum = $panelnum - 1; - } - } elsif ($q->param('op') && $q->param('op') eq "apply") { - &debug_log("RA wizard: update : apply button pressed"); - $currentpanel = $symbol{panels}[$panelnum]; - # validate variables for panel - if ($currentpanel->{validate}) { - $currentpanel->{validate}($q); - } - # execute current panel - if ($currentpanel->{update}) { - my $status = $currentpanel->{update}($q); - &debug_log("RA wizard: update returns status '" . - $status . "'"); - if ($status == $STATUS_REDIRECT) { - return $STATUS_REDIRECT; - } - - } - } - - &debug_log("RA wizard: after looking into about sub panel"); - - # advance to next panel - $currentpanel = $symbol{panels}[$panelnum]; - - # initialize symbol table values - $symbol{showApplyButton} = "false"; - - # fill in variables for new panel - if ($currentpanel->{panelvars}) { - $Data::Dumper::Indent = 1; - # The '&debug_log("q=".Dumper($q));' call must be commented out to fix - # Bugzilla Bug #249923: Incorrect file permissions on - # various files and/or directories - # &debug_log("q=".Dumper($q)); - $currentpanel->{panelvars}($q); - } - - $symbol{panel} = "ra/admin/console/config/".$currentpanel->{vmfile}; - - #wizard.vm: - $symbol{name} = "Registration Authority System"; - $symbol{title} = $currentpanel->{getName}(); - if ($panelnum == 0) { - $symbol{firstpanel} = "1"; - } else { - $symbol{firstpanel} = "0"; - } - if ($panelnum == 17) { - $symbol{lastpanel} = "1"; - } else { - $symbol{lastpanel} = "0"; - } - $symbol{p} = $panelnum; - $symbol{subpanelno} = $panelnum+1; - $symbol{csstate} = "1"; - -# $symbol{urls} = [ "cert1", "cert2" ]; #createsubsystem -# $symbol{urls_size} = 2; -# $symbol{instanceId} = "ra"; -# $symbol{errorString} = ""; - - #modulepanel -# $symbol{certs} = [ ]; -# $symbol{reqscerts} = [ ]; - $symbol{ppcerts} = [ ]; - - return $STATUS_OK; -} - - - -sub dbg { - my $msg = shift; - $::symbol{dbg} .= "$msg\n"; -} - -sub handler { - my $r = shift; - - *::symbol = \%symbol; - *::s = \$s; - *::config = \$config; - *::pwdconf = \$pwdconf; - - &debug_log("RA wizard: in handler"); - if ($#ARGV == -1) { - $r->send_http_header('text/html'); - } - - my $q = new CGI; - - # check cookie - my $pin = $q->param('pin'); - if (defined($pin)) { - my $cookie = $q->cookie( - -name=>'pin', - -value=> $pin, - -expires=>'+1y', - -path=>'/'); - print $q->redirect(-location => "wizard", -cookie => $cookie); - return; - } - - # output http parameters - &debug_log("RA wizard: uri='" . $ENV{REQUEST_URI} . "'"); - my @pnames = $q->param(); - foreach $pn (@pnames) { - # added this facility so that password can be hidden, - # all sensitive parameters should be prefixed with - # __ (double underscores); however, in the event that - # a security parameter slips through, we perform multiple - # additional checks to insure that it is NOT displayed - if( $pn =~ /^__/ || - $pn =~ /password$/ || - $pn =~ /passwd$/ || - $pn =~ /pwd$/ || - $pn =~ /admin_password_again/i || - $pn =~ /directoryManagerPwd/i || - $pn =~ /bindpassword/i || - $pn =~ /bindpwd/i || - $pn =~ /passwd/i || - $pn =~ /password/i || - $pn =~ /pin/i || - $pn =~ /pwd/i || - $pn =~ /pwdagain/i || - $pn =~ /uPasswd/i ) { - &debug_log("RA wizard: http parameter name='" . $pn . "' value='(sensitive)'"); - } else { - &debug_log("RA wizard: http parameter name='" . $pn . "' value='" . $q->param($pn) . "'"); - } - } - - my $panelnum = $q->param('p'); - if (!defined($panelnum) || $panelnum eq "") { - # Apache fails to pick up the p parameter after - # redirecting from the security domain. This is - # a quick hack to solve the issue. - if ($ENV{'QUERY_STRING'} ne "") { - $ENV{'QUERY_STRING'} =~ /p=([0-9]+)&/; - $panelnum = $1; - } - } - - use subs qw(debug); - *debug = \&Template::Velocity::Executor::debug; - - $::symbol{dbg} = ""; - - &debug_log("RA wizard: before argparsing"); - if ($#ARGV == -1) { - $Data::Dumper::Maxdepth = 7; - $startfile = "ra/admin/console/config/login.vm"; - } - - &debug_log("RA wizard: setting up test objects"); - - #initialize from config file - my $certlist = $::config->get("preop.cert.list"); - if ($certlist eq "") { - $certlist = "sslserver,subsystem"; - } - @certtags = split(/,/, $certlist); - $numtags = @certtags; - if ($numtags eq 0) { - @certtags = ("sslserver", "subsystem"); - } - &debug_log("RA wizard: found $numtags certtags"); - - if (! $panelnum) { - $panelnum = 0; - } - - my $status = render_panel($panelnum, $q); - if ($status == 3) { - $r->header_out(Location => $symbol{redirect}); - $r->status(301); - $r->send_http_header(); - return; - } - - use Data::Dumper; - &debug_log("RA wizard: executing file $startfile"); - foreach $q (sort keys %symbol) { - &debug_log("RA wizard:/config/wizard?p=9&SecToken=NSS%20Generic%20Crypto%20Services sym{$q}=".$symbol{$q}); - } - - my $result; - if ($q->param("xml") eq "true") { - $r->send_http_header('text/xml'); - $result = "<xml>"; - foreach $s (sort keys %symbol) { - if ($s =~ /^__/) { - next; - } - $result .= "<" . $s . ">"; - my $v = $symbol{$s}; - $result .= &get_xml($s, $v); - $result .= "</" . $s . ">"; - } - $result .= "</xml>"; - } else { - $result = $parser->execute_file($startfile); - if (!defined $result) { - die("Couldn't execute template file: $docroot/$startfile"); - } - } - - print "$result\n"; - return $STATUS_OK; -} - -sub get_xml -{ - my ($s, $v) = @_; - - my $result; - if (ref($v) eq "HASH") { - foreach my $xkey (keys %$v) { - $result .= "<" . $xkey . ">"; - $result .= &get_xml($xkey, $v{$xkey}); - # $result .= "-" . ref($xkey); - $result .= "</" . $xkey . ">"; - } - } elsif (ref($v) eq "PKI::RA::CertInfo") { - my $certinfo = $v; - $result .= "<certinfo>"; - $result .= "<dn>" . $certinfo->get_dn() ."</dn>"; - $result .= "<tag>" . $certinfo->get_cert_tag() . "</tag>"; - $result .= "<friendly>" . $certinfo->get_user_friendly_name() . - "</friendly>"; - $result .= "</certinfo>"; - } elsif (ref($v) eq "PKI::RA::ReqCertInfo") { - my $reqcertinfo = $v; - $result .= "<reqcertinfo>"; - $result .= "<name>" . $reqcertinfo->get_user_friendly_name() ."</name>"; - $result .= "<req>" . $reqcertinfo->get_request() ."</req>"; - $result .= "<cert>" . $reqcertinfo->get_cert() ."</cert>"; - $result .= "<certpp>" . $reqcertinfo->get_cert_pp() ."</certpp>"; - $result .= "<tag>" . $reqcertinfo->get_cert_tag() ."</tag>"; - $result .= "<dn>" . $reqcertinfo->get_cert_tag() ."</dn>"; - $result .= "</reqcertinfo>"; - } elsif (ref($v) eq "ARRAY") { - my $pos = 0; - foreach my $item (@$v) { - $result .= "<element>"; - $result .= &get_xml("p" . $pos, $item); - # $result .= "-" . ref($item); - $result .= "</element>"; - $pos++; - } - } else { - $result .= $v; - } - return $result; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/LoginPanel.pm b/base/ra/lib/perl/PKI/RA/LoginPanel.pm deleted file mode 100755 index 66f40acfe..000000000 --- a/base/ra/lib/perl/PKI/RA/LoginPanel.pm +++ /dev/null @@ -1,91 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; - -package PKI::RA::LoginPanel; -$PKI::RA::LoginPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(0); - $self->{"getName"} = &PKI::RA::Common::r("Welcome"); - $self->{"vmfile"} = "login.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("WelcomePanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("WelcomePanel: update"); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log($ENV{'SERVER_PORT'}); - &PKI::RA::Wizard::debug_log("Debug=" . $::config->get("logging.debug.enable")); - &PKI::RA::Wizard::debug_log("WelcomePanel: display"); - $::symbol{wizardname} = "RA Configuration Wizard"; - $::symbol{systemname} = "RA"; - $::symbol{fullsystemname} = "Registration Authority"; - - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/ModulePanel.pm b/base/ra/lib/perl/PKI/RA/ModulePanel.pm deleted file mode 100755 index 87ce056bc..000000000 --- a/base/ra/lib/perl/PKI/RA/ModulePanel.pm +++ /dev/null @@ -1,273 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use PKI::RA::Modutil; - -package PKI::RA::ModulePanel; -$PKI::RA::ModulePanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -our $modutil; - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(9); - $self->{"getName"} = &PKI::RA::Common::r("Security Modules"); - $self->{"vmfile"} = "modulepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - - my $flavor = "pki"; - $flavor =~ s/\n//g; - - my $pkiroot = $ENV{PKI_ROOT}; - $modutil = new PKI::RA::Modutil("$pkiroot/alias"); - - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 1; -} - -sub validate -{ - my ($q) = @_; - return 1; -} - -sub update -{ - my ($q) = @_; - my $defTok = $::config->get("preop.module.token"); - my $select = $q->param('choice'); - if ($select eq "") { - &PKI::RA::Wizard::debug_log("ModulePanel -> update no selection found"); - $::symbol{errorString} = "No selection found"; - return 0; - } elsif ($defTok ne $select) { - &PKI::RA::Wizard::debug_log("ModulePanel -> update changing defTok to $select"); - $::config->put("preop.module.token", $select); - $::config->put("preop.ModulePanel.done", "true"); - } else { - # this is not an error...just information - &PKI::RA::Wizard::debug_log("ModulePanel -> update defTok not changed"); - } - - $::config->commit(); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("ModulePanel -> display"); - getModules(); - my $defTok = $::config->get("preop.module.token"); - - $::symbol{defTok} = $defTok; - - return 1; -} - -use Data::Dumper; -sub getTokens { - my $modulename = shift; - - &PKI::RA::Wizard::debug_log("ModulePanel -> getTokens"); - -#$Data::Dumper::Indent = 0; -#PKI::RA::Wizard::dbg("in gettokens. modutil = ".Dumper($modutil)); - my @tokens; - my $mod = $modutil->getmodule($modulename); - foreach my $tokenname (keys %{$mod->{tokens}}) { - #PKI::RA::Wizard::dbg("found token $tokenname"); - if ($tokenname ne "NSS Generic Crypto Services") { - my $token = $modutil->gettoken($tokenname); - my $t = new PKI::RA::GlobalVar( - getNickName => sub { return $tokenname; }, - isLoggedIn => sub { return isLoggedIn($tokenname); }, - isPresent => sub { return 1; }, - ); - push @tokens, $t; - } else { - &PKI::RA::Wizard::debug_log("ModulePanel -> getTokens token NSS Generic Crypto Services not available for key generation"); - - } - } - - return \@tokens; -} - -# if password is found, then it's considered "logged in" -# otherwise it is "not logged in" -sub Login { - my $tokenname = $_[0]; - my $pwd = $::pwdconf->get($tokenname); - if ($pwd ne "") { - &PKI::RA::Wizard::debug_log("ModulePanel -> isLoggedIn retrieved pwd from pwdconf"); - return 1; - } - &PKI::RA::Wizard::debug_log("ModulePanel -> isLoggedIn pwd not found from pwdconf for token: $tokenname"); - - if ($tokenname eq "NSS Certificate DB") { - my $instanceDir = $::config->get("service.instanceDir"); - &PKI::RA::Wizard::debug_log("ModulePanel -> isLoggedIn get internal password for $tokenname"); - # these are referred as "internal" in password.conf - $pwd = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $pwd =~ s/\n//g; - $::pwdconf->put($tokenname, $pwd); - $::pwdconf->commit(); - - return 1; - } - return 0; -} - -sub isLoggedIn { - my $tokenname = $_[0]; - return &Login($tokenname); -} - -sub getModules { - my $count; - my $i; - my @supportedModules; - - &PKI::RA::Wizard::debug_log("ModulePanel -> getModules"); - $count = $::config->get("preop.configModules.count"); - &PKI::RA::Wizard::debug_log("ModulePanel -> getModules count =$count"); - - my @modules = $modutil->getmodules(); - # $::symbol{steve} = join ",Module:", @modules; - # $::symbol{steve}.= "\n"; - - my $x = " - preop.configModules.count=3 - preop.configModules.module0.commonName=NSS Internal PKCS #11 Module - preop.configModules.module0.imagePath=../img/mozilla.png - preop.configModules.module0.userFriendlyName=NSS Internal PKCS #11 Module - preop.configModules.module1.commonName=nfast - preop.configModules.module1.imagePath=../img/ncipher.png - preop.configModules.module1.userFriendlyName=nCipher's nFast Token Hardware Module - preop.configModules.module2.commonName=lunasa - preop.configModules.module2.imagePath=../img/safenet.png - preop.configModules.module2.userFriendlyName=SafeNet's LunaSA Token Hardware Module - "; - - my %supmodules; - for ($i=0; $i <$count; $i++) { - my $cn; - my $pn; - my $img; -# &PKI::RA::Wizard::debug_log("ModulePanel -> getModules look for cn=","preop.configModules.module" , $i , ".commonName"); - $cn = $::config->get("preop.configModules.module$i.commonName"); - $supmodules{$cn} = 1; - - $pn = $::config->get("preop.configModules.module$i.userFriendlyName"); - $img = $::config->get("preop.configModules.module$i.imagePath"); - &PKI::RA::Wizard::debug_log("ModulePanel -> getModules: got module $cn from config"); - - my $module = $modutil->getmodule($cn); - my $file = $module->{detail}->{"Library file"}; - &PKI::RA::Wizard::debug_log("ModulePanel -> getModules Library file = $file"); - my $found = 0; - if ($file) { - $found = ($file =~ /Internal ONLY module/) || -e $file; - } - - my $name = $module->{detail}->{Name}; -# PKI::RA::Wizard::dbg("name: $name"); - - $supportedModules[$i] = new PKI::RA::GlobalVar( - getImagePath => sub { return $img; }, - getUserFriendlyName => sub { return $pn; }, - isFound => sub { return $found; }, - getTokens => sub { return getTokens($name); }, - ); - - # login to tokens - &PKI::RA::Wizard::debug_log("Ready to login to tokens for $name"); - my $mod = $modutil->getmodule($name); - foreach my $tokenname (keys %{$mod->{tokens}}) { - &PKI::RA::Wizard::debug_log("Logging in Module $name Token " . $tokenname); - &Login($tokenname); - } - - } - - my @otherModules; - #compile the "others" modules - - foreach my $modname (@modules) { - #is this modname in the supported modules list? - if ($supmodules{$modname}) { - &PKI::RA::Wizard::debug_log("ModulePanel -> getModules: found module $modname supported"); - # does not belong to "others" - } else { - &PKI::RA::Wizard::debug_log("ModulePanel -> getModules: found module $modname unsupported"); - #add the module to "others" list - my $m = $modutil->getmodule($modname); - my $mod = new PKI::RA::GlobalVar( - getImagePath => sub { return ""; }, - getUserFriendlyName => sub { return $m->{modulename}; }, - isFound => sub { return 1; }, - getTokens => sub { return getTokens($m->{detail}->{Name});} - ); - - push @otherModules, $mod; - - &PKI::RA::Wizard::debug_log("ModulePanel -> getModules: module $modname added to otherModules list"); - } - } - - $::symbol{sms} = \@supportedModules; - $::symbol{oms} = \@otherModules; -# PKI::RA::Wizard::dbg("oms: ". Dumper([@otherModules])); -# PKI::RA::Wizard::dbg("sms: ". Dumper([@supportedModules])); - - &PKI::RA::Wizard::debug_log("ModulePanel -> set sms, oms"); -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/Modutil.pm b/base/ra/lib/perl/PKI/RA/Modutil.pm deleted file mode 100755 index 82c66e87d..000000000 --- a/base/ra/lib/perl/PKI/RA/Modutil.pm +++ /dev/null @@ -1,262 +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::RA::Modutil; - - -sub new { - my $class = shift; - my ($dir) = @_; - - if (! $dir) { die "no module directory provided\n"; } - - my $self = {}; - - $self->{dir} = $dir; - $self->{modules} = makemodules($self); - - bless $self, $class; - return $self; -} - -sub exists { - my $self = shift; - - return -e "$self->{dir}/secmod.db"; -} - -sub create { - my $self = shift; - - my $mods = `modutil -force -dbdir '$self->{dir}' -nocertdb -create`; - return $mods; -} - -use Data::Dumper; - -sub makemodules { - my $self = shift; - my $modules = {}; - - my $mods = `modutil -force -dbdir '$self->{dir}' -nocertdb -list`; - #my $mods = join "",<::DATA>; - - #print "raw mods = $mods"; - - my (@modules) = ( - $mods =~ / - ^ #beginning of a line - \s+ #some spaces - \d+\.\s* #some digits - (.*?) #lots of text - ((?=^\s*\d+)|(?=------)) #if we would next match some spaces and digits - /msxg ); - - @modules = grep /.+/ms, @modules; - - foreach $module (@modules) { - #print "Module #$i:$module --\n"; - $module = "modulename:$module"; - my ($moduleheader, $rest) = ( - $module =~ / - (.*status: .*?\n) # moduleheader - (\s*slot:.*) # slot - (?=\n(\n|$)) #empty line - /msxg ); - #print "moduleheader: $moduleheader\n"; - my $m = makehash($moduleheader); - $modules->{$m->{modulename}} = $m; - $m->{tokens} = {}; - - my @tokens = split "\n\n", $rest; - - - -# get summary slot info with: -list - foreach my $token (@tokens) { - #print "slottext: $slot\n"; - my $slh = makehash($token); - $m->{tokens}->{$slh->{token}} = $slh; - } - -# get detailed slot info with: -list "modulename" - - my $moduledetail = `modutil -force -dbdir '$self->{dir}' -nocertdb -list "$m->{modulename}" 2> /dev/null`; - my @details= split "\n\n", $moduledetail; - while ($details[0] !~ /.*Name:.*/) { - shift @details; - }; - $m->{detail} = makehash(shift @details); - foreach $d (@details) { - my $sdh = makehash($d); - my $tokenname = $sdh->{"Token Name"}; - $tokenname =~ s/\s+$//; # remove trailing spaces - if ($tokenname) { - $m->{tokens}->{$tokenname}->{detail} = $sdh; - } - } - $i++; - - } - return $modules; -} - -# input: a multi-list string with nv/pairs -# return a hashtable reference -sub makehash { - my $str = shift; - my $ht = { }; - my @lines = split "\n", $str; - my $line; -LINE: - foreach $line (@lines) { - if ($line =~ /Using database directory/) { next LINE; } - if ($line =~ /--------------/) { next LINE; } - my ($name, $value) = ($line =~ /^\s*(.*?):\s*(.*?)\s*$/); - if ($name) { - #print "name:$name\n"; - #print "value:$value\n"; - $ht->{$name} = $value; - } - } - return $ht; -} - -sub getmodules { - my $self = shift; - #print "modules: ".$self->{modules}. "\n"; - #print "keys: ".(join ",",keys %{$self->{modules}})."\n"; - return keys %{$self->{modules}}; -} - -sub getmodule { - my $self = shift; - my $modulename = shift; - - #print Dumper($self->{modules}); - return $self->{modules}->{$modulename}; -} - - -sub gettokens { - my $self = shift; - my $module = shift; - - return keys %{$module->{tokens}}; -} - -sub gettoken { - my $self = shift; - my $token= shift; - foreach my $m (values %{$self->{modules}}) { - foreach $t (values %{$m->{tokens}}) { - #print join ",", keys %{$t}; - #print Dumper($t->{detail}); - if ($t->{detail}->{"Token Name"} eq $token) { - return $t; - } - } - } -} - - - -package main; - -sub ::test { - -# initialize - my $modutil = new PKI::RA::Modutil("."); - -#make database if it doesn't exist - if (! $modutil->exists()) { - $modutil->create(); - } - -#get an array of module names - my @mods = $modutil->getmodules(); - - print "Found ".@mods." pkcs#11 modules\n"; - -#for each module... - foreach my $modname (@mods) { - my $module = $modutil->getmodule($modname); - - print "Module: $modname\n"; - print "Library: ".$module->{detail}->{"Library file"}."\n"; - print "Other keys: ".(join ",", keys %{$module->{detail}})."\n"; - -#find all the tokens in a module, e.g. each partition for a lunasa - foreach my $tokenname ($modutil->gettokens($module)) { - print " token: $tokenname\n"; - my $token = $modutil->gettoken($tokenname); - -#dump out the information we have on the token - foreach my $key (keys %{$token}) { - print " token keys/values: $key: ".$token->{$key}."\n"; - } - my @detailkeys = (keys %{$token->{detail}}) ; - print " token detail keys:". (join ",", @detailkeys)."\n"; - print " token detail Manufacturer:". $token->{detail}->{Manufacturer}."\n"; - print "\n"; - } - print "\n"; - } - -} - -# this is where 'main' starts - -if ($ARGV[0] eq "--test") { - ::test(); -} - -1; - -__DATA__ -Listing of PKCS #11 Modules ------------------------------------------------------------ - 1. NSS Internal PKCS #11 Module - slots: 2 slots attached - status: loaded - - slot: NSS Internal Cryptographic Services - token: NSS Generic Crypto Services - - slot: NSS User Private Key and Certificate Services - token: NSS Certificate DB - - 2. lunasa - library name: /usr/lunasa/lib/libCryptoki2.so - slots: 2 slots attached - status: loaded - - slot: LunaNet Slot - token: lunasa1-ca - - slot: LunaNet Slot - token: lunasa2-ca ------------------------------------------------------------ - - diff --git a/base/ra/lib/perl/PKI/RA/NamePanel.pm b/base/ra/lib/perl/PKI/RA/NamePanel.pm deleted file mode 100755 index c30715aa2..000000000 --- a/base/ra/lib/perl/PKI/RA/NamePanel.pm +++ /dev/null @@ -1,570 +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 --- -# -# -# -# - -use strict; -use warnings; -use FileHandle; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use PKI::RA::CertInfo; -use URI::URL; -use URI::Escape; - -package PKI::RA::NamePanel; -$PKI::RA::NamePanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); -our $cert_req_header="-----BEGIN NEW CERTIFICATE REQUEST-----"; -our $cert_req_footer="-----END NEW CERTIFICATE REQUEST-----"; -our $cert_header="-----BEGIN CERTIFICATE-----"; -our $cert_footer="-----END CERTIFICATE-----"; - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(12); - $self->{"getName"} = &PKI::RA::Common::r("Subject Names"); - $self->{"vmfile"} = "namepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("NamePanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("NamePanel: update"); - my $instanceDir = $::config->get("service.instanceDir"); - - my $count = $q->param('urls'); - - &PKI::RA::Wizard::debug_log("NamePanel: update - selected ca= $count"); - - my $host = ""; - my $https_ee_port = ""; - - my $useExternalCA = "off"; - if ($count =~ /http/) { - my $info = new URI::URL($count); - $host = $info->host; - $https_ee_port = $info->port; - } else { - $host = $::config->get("preop.securitydomain.ca$count.host"); - if ($host eq "") { - $useExternalCA = "on"; - } else { - $https_ee_port = $::config->get("preop.securitydomain.ca$count.secureport"); - &PKI::RA::Wizard::debug_log("NamePanel: update - host= $host, https_ee_port= $https_ee_port"); - } - } - $::config->put("preop.certenroll.useExternalCA", $useExternalCA); - - $::config->put("preop.ca.url", "https://" . $host . ":" . $https_ee_port); - - my $tokenname = $::config->get("preop.module.token"); - &PKI::RA::Wizard::debug_log("NamePanel: update got token name = $tokenname"); - my $hw; - my $tk; - - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - $hw = ""; - $tk = ""; - } else { - $hw = "-h $tokenname"; - $tk = $tokenname.":"; - } - - # is nickname changed because of token (hardware) selection? - my $changed = "false"; - foreach my $certtag (@PKI::RA::Wizard::certtags) { - &PKI::RA::Wizard::debug_log("NamePanel: update begins for certag= $certtag"); - my $cert_dn = $q->param($certtag); - $::config->put("preop.cert.".$certtag.".dn", $cert_dn); - $::config->commit(); - - my $sslnickname = $::config->get("preop.cert.sslserver.nickname"); - my $nickname = $q->param($certtag . "_nick"); - if ($nickname ne "") { - &PKI::RA::Wizard::debug_log("NamePanel: update nickname for $certtag set to $nickname"); - &PKI::RA::Wizard::debug_log("NamePanel: update nickname for $certtag being updated in config file"); - $::config->put("preop.cert.".$certtag.".nickname", $nickname); - $::config->commit(); - } else { - $nickname = $::config->get("preop.cert.$certtag.nickname"); - if ($nickname eq "") { - $nickname = "RA ".$certtag." cert"; - &PKI::RA::Wizard::debug_log("NamePanel: update nickname not found for $certtag -- try $nickname"); - } - } - - my $cert_request = $::config->get("preop.cert.$certtag.certreq"); - if ($cert_request ne "") { - &PKI::RA::Wizard::debug_log("NamePanel: update do not generate new keys"); - goto GEN_CERT; - } - &PKI::RA::Wizard::debug_log("NamePanel: update generate new keys"); - - # =====generate requests======== - # getting new request should void old cert - - my $file= "$instanceDir/conf/".$certtag."_cert.txt"; - my $tmp = `rm $file`; - - &PKI::RA::Wizard::debug_log("NamePanel: retrieving $tokenname from pwdconf"); - my $token_pwd = $::pwdconf->get($tokenname); - &PKI::RA::Wizard::debug_log("NamePanel: creating pwfile"); - open FILE, ">$instanceDir/conf/.pwfile"; - system( "chmod 00660 $instanceDir/conf/.pwfile" ); - $token_pwd =~ s/\n//g; - print FILE $token_pwd; - close FILE; - - my $keytype = $::config->get("preop.cert.$certtag.keytype"); - if ($keytype eq "") { - $keytype = "rsa"; - } - - my $select = $::config->get("preop.cert.$certtag.keysize.select"); - - my $keysize; - - if ($keytype eq "rsa") { - $keysize = 2048; - } elsif ($keytype eq "ecc") { - $keysize = 256; - } - - if (($select eq "") || ($select eq "default")) { - my $size = $::config->get("preop.cert.$certtag.keysize.size"); - if ($size ne "") { - $keysize = $size; - } - } else { - my $size = $::config->get("preop.cert.$certtag.keysize.customsize"); - if ($size ne "") { - $keysize = $size; - } - if (($keytype eq "ecc") && ($keysize ne 256)) { - &PKI::RA::Wizard::debug_log("NamePanel: update got keysize from config= $keysize changing to 256, the only supported ECC strength"); - $keysize = 256; - } - } - - &PKI::RA::Wizard::debug_log("NamePanel: update got key type $keytype"); - my $req; - my $debug_req; - my $filename = "/tmp/random.$$"; - `dd if\=/dev/urandom of\=\"$filename\" count\=256 bs\=1`; - if ($keytype eq "rsa") { - #XXX temporary - &PKI::RA::Wizard::debug_log("NamePanel: update "."certutil -R -s $cert_dn -k $keytype -g $keysize -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -a -z $filename"); - my $tmpfile = "/tmp/req$$"; - system("certutil -R -s \"$cert_dn\" -k $keytype -g $keysize -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -a -z $filename > $tmpfile"); - $req = `cat $tmpfile`; - system("rm $tmpfile"); - } elsif ($keytype eq "ecc") { - #only support curve nistp256 for now - my $tmpfile = "/tmp/req$$"; - system("certutil -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -R -s \"$cert_dn\" -k ec -q nistp256 -a -z $filename> $tmpfile"); - $req = `cat $tmpfile`; - system("rm $tmpfile"); - } else { - &PKI::RA::Wizard::debug_log("NamePanel: update unsupported keytype $keytype"); - } - system("rm $filename"); - - my $save_line = 0; - my @req_a = split "\n", $req; - foreach my $line (@req_a) { - chomp( $line ); - $line =~ s/
//g; - if ($line eq $cert_req_header) { - $save_line = 1; - } elsif( $line eq $cert_req_footer ) { - $save_line = 0; - last; - } elsif( $save_line == 1 ) { - $cert_request .= "$line"; - } - } - &PKI::RA::Wizard::debug_log("NamePanel: update putting cert_request in CS.cfg: $cert_request"); - $::config->put("preop.cert.$certtag.certreq", $cert_request); - $::config->commit(); - -GEN_CERT: -# =====request for certs======== -# see if there is an existing cert - - my $cert = $::config->get("preop.cert.$certtag.cert"); - my $sdom = $::config->get("config.sdomainEEURL"); - my $sdom_url = new URI::URL($sdom); - - if (($useExternalCA eq "on") && ($certtag ne "subsystem")) { - &PKI::RA::Wizard::debug_log("NamePanel: update External CA selected"); - if ($cert eq "") { - &PKI::RA::Wizard::debug_log("NamePanel: update no cert found...need manual enrollment"); - } - } else { - if ($cert eq "") { - &PKI::RA::Wizard::debug_log("NamePanel: update External CA not selected...need automatic enrollment"); - - my $machineName = $::config->get("service.machineName"); - my $securePort = $::config->get("service.securePort"); - my $session_id = $::config->get("preop.sessionID"); - - if ($cert_request ne "") { - &PKI::RA::Wizard::debug_log("NamePanel: update found existing request: $cert_request"); - } else { - &PKI::RA::Wizard::debug_log("NamePanel: update existing request not found"); - #something is wrong...no request, no cert - goto DONE; - return $cert; - } - - my $instanceID = $::config->get("service.instanceID"); - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = ""; - &PKI::RA::Wizard::debug_log("NamePanel: greping password"); - - my $tmpfile = "/tmp/grep$$"; - system ("grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10- > $tmpfile"); - $db_password = `cat $tmpfile`; - $db_password =~ s/\n$//g; - system("rm $tmpfile"); - - my $profile_id = $::config->get("preop.cert.$certtag.profile"); - &PKI::RA::Wizard::debug_log("NamePanel: profileId=" . $profile_id); - my $requestor_name = "RA-" . $machineName . "-" . $securePort; - my $params = "profileId=" . $profile_id . "&" . - "cert_request_type=" . "pkcs10" . "&" . - "requestor_name=" . $requestor_name . "&" . - "cert_request=" . - URI::Escape::uri_escape("$cert_request") . "&" . - "xmlOutput=true" . "&" . - "sessionID=" . $session_id . "&" . - "auth_hostname=" . $sdom_url->host . "&" . - "auth_port=" . $sdom_url->port; - - if ($certtag eq "subsystem") { - $host = $sdom_url->host; - $https_ee_port = $sdom_url->port; - } - if ($changed eq "true") { -$req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$token_pwd\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$https_ee_port"; -$debug_req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"(sensitive)\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$https_ee_port"; - } else { -$req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"$db_password\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$https_ee_port"; -$debug_req = "/usr/bin/sslget -e \"$params\" -d \"$instanceDir/alias\" -p \"(sensitive)\" -v -n \"$sslnickname\" -r \"/ca/ee/ca/profileSubmit\" $host:$https_ee_port"; - } - - &PKI::RA::Wizard::debug_log("debug_req = " . $debug_req); - my $content = `$req`; - &PKI::RA::Wizard::debug_log("content = " . $content); - - $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; - $content = $1; - - if ($content eq "") { - $::symbol{errorString} = "CA returned no response. Please check that the CA is available and also check the host's firewall settings."; - return 0; - } - - my $parser = XML::Simple->new(); - &PKI::RA::Wizard::debug_log("NamePanel: response content= " . $content); - my $response = $parser->XMLin($content); - my $status = $response->{Status}; - if ($status ne "0") { - my $error = $response->{Error}; - &PKI::RA::Wizard::debug_log("NamePanel: Error = $error"); - $::symbol{errorString} = "CA response: $error. Please check previous related panels." . " Please check that the CA is available and also check the host's firewall settings."; - return 0; - } - $cert = $response->{Requests}->{Request}->{b64}; - &PKI::RA::Wizard::debug_log("NamePanel: new cert generated= " . $cert); - -# my $reqid = $response->{Requests}->{Request}->{Id}; -# $::config->put("preop.admincert.requestId.0", $reqid); -# my $sn = $response->{Requests}->{Request}->{serialno}; -# $::config->put("preop.admincert.serialno.0", $sn); -# $::config->commit(); - - &PKI::RA::Wizard::debug_log("NamePanel: update putting cert in CS.cfg: $cert"); - $::config->put("preop.cert.$certtag.cert", $cert); - $::config->commit(); - - } else { - # cert is not null - &PKI::RA::Wizard::debug_log("NamePanel: update External CA not selected. Cert found...no need for enrollment"); - } - -# write cert to file so certutil can import - my $cert_fn = "$instanceDir/conf/".$certtag."_cert.txt"; - open FILE, "> $cert_fn"; - print FILE $cert_header."\n".$cert."\n".$cert_footer; - close FILE; - - # import cert, whether it was imported before or not - my $nickname = $::config->get("preop.cert.$certtag.nickname"); - if ($nickname eq "") { - #XXX - $nickname = "RA ".$certtag." cert"; - &PKI::RA::Wizard::debug_log("NamePanel: update nickname not found for $certtag -- try $nickname"); - } - - if ($certtag ne "sslserver") { - &PKI::RA::Wizard::debug_log("NamePanel: update: try to delete existing cert $nickname, if any....ok if it fails"); - $tmp = `certutil -d $instanceDir/alias -D -n "$nickname"`; - $tmp = `certutil -d $instanceDir/alias -D $hw -f $instanceDir/conf/.pwfile -n "$tk$nickname"`; - } else { - &PKI::RA::Wizard::debug_log("NamePanel: update: try to delete existing cert $sslnickname, if any....ok if it fails"); - $tmp = `certutil -d $instanceDir/alias -D -n "$sslnickname"`; - $tmp = `certutil -d $instanceDir/alias -D $hw -f $instanceDir/conf/.pwfile -n "$tk$sslnickname"`; - } - - &PKI::RA::Wizard::debug_log("NamePanel: update: try to import cert from $cert_fn"); - $tmp = `certutil -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -A -n "$nickname" -t "u,u,u" -a -i $cert_fn`; - # changed the cert, need to change nickname too, if necessary - if ($hw ne "") { - if ($certtag eq "sslserver") { - if ($changed eq "false") { - $::config->put("preop.cert.$certtag.nickname", "$tk$nickname"); - } - $changed = "true"; - } elsif ($certtag eq "subsystem") { - &PKI::RA::Wizard::debug_log("NamePanel: update: subsystem nickname 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->put( "ra.cert.subsystem.nickname", "$tk$nickname"); - } else { - &PKI::RA::Wizard::debug_log("NamePanel: update: $certtag nickname changed"); - $::config->put("preop.cert.$certtag.nickname", "$tk$nickname"); - } - $::config->commit(); - } else { - if ($certtag eq "subsystem") { - # setting these just in case the subsystem nickname changed. - &PKI::RA::Wizard::debug_log("NamePanel: update: setting in case the subsystem nickname changed"); - $::config->put("conn.ca1.clientNickname", "$nickname"); - $::config->put("conn.drm1.clientNickname", "$nickname"); - $::config->put("conn.tks1.clientNickname", "$nickname"); - $::config->put("ra.cert.subsystem.nickname", "$nickname"); - } - $::config->commit(); - } - - &PKI::RA::Wizard::debug_log("NamePanel: update: done importing cert: $tk$nickname"); - $tmp = `rm $cert_fn`; - } - } - -DONE: - &PKI::RA::Wizard::debug_log("NamePanel: removing pwfile"); - my $tmp = `rm $instanceDir/conf/.pwfile`; - return 1; -} - -sub readFile -{ - my $fn = $_[0]; - open FILE, "< $fn" or return ""; - my $content = join "",<FILE>; - close FILE; - - return $content; -} - -use Data::Dumper; - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("NamePanel: display"); - - my $domain_name = $::config->get("preop.securitydomain.name"); - if ($domain_name eq "") { - $domain_name = "RA Domain"; - } - my $machine_name = $::config->get("service.machineName"); - my $instance_id = $::config->get("service.instanceID"); - - my $i = 0; - foreach my $certtag (@PKI::RA::Wizard::certtags) { - &PKI::RA::Wizard::debug_log("NamePanel: display certtag=$certtag"); - my $cert_dn = $::config->get("preop.cert.".$certtag.".dn"); - if ($cert_dn eq "") { - if ($certtag eq "subsystem") { - $cert_dn = "CN=RA Subsystem, " . - "OU=" . $instance_id . ", " . - "O=" . $domain_name; - } elsif ($certtag eq "sslserver") { - $cert_dn ="CN=" . $machine_name . ", " . - "OU=" . $instance_id . ", " . - "O=" . $domain_name; - } else { - &PKI::RA::Wizard::debug_log("NamePanel: display other certtag=$certtag"); - $cert_dn = $certtag; - } - $::config->put("preop.cert.".$certtag.".dn", $cert_dn); - $::config->commit(); - } else { - if (!($cert_dn =~ /O=/)) { - $cert_dn .= ", O=" . $domain_name; - $::config->put("preop.cert.".$certtag.".dn", $cert_dn); - $::config->commit(); - } - } - - my $name = $::config->get("preop.cert.".$certtag.".userfriendlyname"); - if ($name eq "") { - $name = $certtag."Cert ".$instance_id; - $::config->put("preop.cert.".$certtag.".userfriendlyname", $name); - $::config->commit(); - } - - my $cert = new PKI::RA::CertInfo($name, - $cert_dn, $certtag); - $::symbol{certs}[$i++] = $cert; - } - - &PKI::RA::Wizard::debug_log("NamePanel: getting CA info"); - $::symbol{urls} = []; - my $count = 0; - - while (1) { - my $host = $::config->get("preop.securitydomain.ca$count.host"); - if ($host eq "") { - goto DONE; - } - my $https_ee_port = $::config->get("preop.securitydomain.ca$count.secureport"); - my $name = $::config->get("preop.securitydomain.ca$count.subsystemname"); - my $item = $name . " - https://" . $host . ":" . $https_ee_port; - $::symbol{urls}[$count++] = $item; - - } -DONE: - - $::symbol{urls}[$count++] = "External CA"; - $::symbol{urls_size} = $count+1; - - return 1; -} - - -# arg0 filename containing certificate request -# return certificate request plus header and footer -sub extract_cert_req_from_file -{ - my $save_line = 0; - - my $filename = $_[0]; - - my $fd = new FileHandle; - - my $cert_request = ""; - - $fd->open( "<$filename" ) or die "Could not open '$filename'!\n"; - - while( <$fd> ) - { - my $line = $_; - chomp( $line ); - - if( $line eq $cert_req_header ) { - $save_line = 1; - $cert_request .= "$line\n"; - } elsif( $line eq $cert_req_footer ) { - $cert_request .= "$line\n"; - $save_line = 0; - last; - } elsif( $save_line == 1 ) { - $cert_request .= "$line\n"; - } - } - - $fd->close(); - - return $cert_request; -} - -# arg0 message containing certificate request -# return certificate request sans header and footer -sub extract_cert_req_from_file_sans_header_and_footer -{ - my $filename = $_[0]; - my $save_line = 0; - - my $fd = new FileHandle; - - my $cert_request = ""; - - $fd->open( "<$filename" ) or die "Could not open '$filename'!\n"; - - while( <$fd> ) - { - my $line = $_; - chomp( $line ); - - if( $line eq $cert_req_header ) { - $save_line = 1; - } elsif( $line eq $cert_req_footer ) { - $save_line = 0; - last; - } elsif( $save_line == 1 ) { - $cert_request .= "$line\n"; - } - } - - $fd->close(); - - return $cert_request; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/ReqCertInfo.pm b/base/ra/lib/perl/PKI/RA/ReqCertInfo.pm deleted file mode 100755 index 51c22cd24..000000000 --- a/base/ra/lib/perl/PKI/RA/ReqCertInfo.pm +++ /dev/null @@ -1,235 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; - -package PKI::RA::ReqCertInfo; -$PKI::RA::ReqCertInfo::VERSION = '1.00'; - -our $cert_req_header="-----BEGIN NEW CERTIFICATE REQUEST-----"; -our $cert_req_footer="-----END NEW CERTIFICATE REQUEST-----"; -our $cert_header="-----BEGIN CERTIFICATE-----"; -our $cert_footer="-----END CERTIFICATE-----"; - -sub new { - my ($class, $name, $dn, $tag) = @_; - my $self = {}; - &PKI::RA::Wizard::debug_log("ReqCertInfo: start new"); - &PKI::RA::Wizard::debug_log("ReqCertInfo: creating name: $name, dn: $dn, tag: $tag"); - - $self->{"getUserFriendlyName"} = \&get_user_friendly_name; - $self->{"getCertTag"} = \&get_cert_tag; - $self->{"getCert"} = \&get_cert; - $self->{"getCertpp"} = \&get_cert_pp; - $self->{"getRequest"} = \&get_request; - $self->{"getDN"} = \&get_dn; - $self->{"useDefaultKey"} = \&use_default_key; - $self->{"getCustomKeysize"} = \&get_custom_keysize; - &PKI::RA::Wizard::debug_log("ReqCertInfo: end new"); - - $self->{name} = $name; - $self->{dn} = $dn; - $self->{tag} = $tag; - - bless $self, $class; - return $self; -} - -sub get_user_friendly_name -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_user_friendly_name"); - return $self->{name}; -} - -sub readFile -{ - my $fn = $_[0]; - open FILE, "< $fn" or return ""; - my $content = join "",<FILE>; - close FILE; - - return $content; -} - -sub wrap_lines -{ - my $lines = shift; - my $temp ; - foreach my $line (split "\n", $lines) { - if (length $line > 59) { - $line =~ s/(.{0,60})/$1\n/g; - } - # get rid of a line that is just an empty newline - $line =~ s/^\n$//gms; - $temp .= $line; - } - # collapse multiple newlines into one - $temp =~ s/\n+/\n/gms; - $temp =~ s/\n$//gms; - $temp; - -} - -sub get_request -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_request"); - # first, try to see if request has been made before -# my $req = readFile( "/var/lib/pki-ra/conf/$self->{tag}_cert_request.txt"); - - my $req = $::config->get("preop.cert.$self->{tag}.certreq"); - - $req = wrap_lines($req); - - if ($req ne "") { - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_request found existing request"); - return $cert_req_header."\n".$req."\n".$cert_req_footer;; - } else { - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_request existing request not found"); - } - - return $req; -} - -sub get_cert -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert"); -# see if there is an existing cert -# my $cert = readFile("/var/lib/pki-ra/conf/".$self->{tag}."_cert.txt"); - my $cert = $::config->get("preop.cert.$self->{tag}.cert"); - - $cert = wrap_lines($cert); - if ($cert ne "") { - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert found existing cert"); - return $cert_header."\n".$cert."\n".$cert_footer;; - } else { - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert existing cert not found"); - } - if ($cert eq "") { - $cert = "...paste certificate here..."; - } - - - return $cert; -} - -sub get_cert_pp -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_pp"); - my $instanceDir = $::config->get("service.instanceDir"); - - my $hw; - my $tokenname = $::config->get("preop.module.token"); - &PKI::RA::Wizard::debug_log("ReqCertInfo: update got token name = $tokenname"); - - if (($tokenname eq "") || ($tokenname eq "NSS Certificate DB")) { - $hw = ""; - } else { - $hw = "-h $tokenname"; - } - - my $token_pwd = $::pwdconf->get($tokenname); - open FILE, ">$instanceDir/conf/.pwfile"; - system( "chmod 00660 $instanceDir/conf/.pwfile" ); - $token_pwd =~ s/\n//g; - print FILE $token_pwd; - close FILE; - - my $nickname = $::config->get("preop.cert.$self->{tag}.nickname"); - if ($nickname eq "") { -#XXX - $nickname = "RA ".$self->{tag}." cert"; - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_pp nickname not found for $self->{tag} -- try $nickname"); - } - my $certpp=""; -# my $found = -e "/var/lib/pki-ra/conf/$self->{tag}_cert.txt"; - my $cert = $::config->get("preop.cert.$self->{tag}.cert"); - - if ($cert ne "") { - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_pp found request, ready to get prettyprint"); - my $tmp = `certutil -d $instanceDir/alias $hw -f $instanceDir/conf/.pwfile -n "$nickname" -L > $instanceDir/conf/$self->{tag}_cert_pp.txt`; - $certpp = readFile("$instanceDir/conf/$self->{tag}_cert_pp.txt"); - $certpp =~ s/"//g; - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_pp pp=$certpp"); - $tmp =`rm $instanceDir/conf/$self->{tag}_cert_pp.txt`; - } else { - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_pp cert not found, will not get prettyprint"); - } - my $tmp = `rm $instanceDir/conf/.pwfile`; - - return $certpp; -} - -sub get_cert_tag -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_tag"); - return $self->{tag}; -} - -sub get_dn -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_cert_dn"); - return $self->{dn}; -} - -sub use_default_key -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("ReqCertInfo: use_default_key"); - my $select = $::config->get("preop.cert.$self->{tag}.keysize.select"); - if ($select ne "") { - if ($select eq "custom") { - &PKI::RA::Wizard::debug_log("ReqCertInfo: use_default_key from config = $select returning 0"); - return 0; - } - } - - &PKI::RA::Wizard::debug_log("ReqCertInfo: use_default_key returning 1"); - return 1; -} - -sub get_custom_keysize -{ - my ($self) = @_; - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_custom_keysize"); - my $keysize = $::config->get("preop.cert.$self->{tag}.keysize.customsize"); - if ($keysize ne "") { - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_custom_keysize from config = $keysize"); - return $keysize; - } else { - &PKI::RA::Wizard::debug_log("ReqCertInfo: get_custom_keysize not from config"); - } - return 2048; -} - - -1; diff --git a/base/ra/lib/perl/PKI/RA/SecurityDomainPanel.pm b/base/ra/lib/perl/PKI/RA/SecurityDomainPanel.pm deleted file mode 100755 index 3370b9d25..000000000 --- a/base/ra/lib/perl/PKI/RA/SecurityDomainPanel.pm +++ /dev/null @@ -1,199 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use URI::URL; -use XML::Simple; -use Data::Dumper; - -package PKI::RA::SecurityDomainPanel; -$PKI::RA::SecurityDomainPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(1); - $self->{"getName"} = &PKI::RA::Common::r("Security Domain"); - $self->{"vmfile"} = "securitydomainpanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("SecurityPanel: validate"); - - return 1; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub pingCS -{ - my( $instanceDir ) = $_[0]; - my( $db_password ) = $_[1]; - my( $nickname ) = $_[2]; - my( $hostname ) = $_[3]; - my( $port ) = $_[4]; - - my $content = `/usr/bin/sslget -d $instanceDir/alias -p $db_password -v -r "/ca/admin/ca/getStatus" $hostname:$port`; - if( "$content" eq "" ) { - return 0; - } else { - $content =~ /(\<XMLResponse\>.*\<\/XMLResponse\>)/; - $content = $1; - - my $parser = XML::Simple->new(); - my $response = $parser->XMLin($content); - my $state = $response->{State}; - - if( "$state" eq "1" ) { - return 1; - } else { - return 0; - } - } -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("SecurityPanel: display"); - $::symbol{panelname} = "Security Domain"; - $::symbol{sdomainName} = "Security Domain"; - - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $hostname = $::config->get("service.machineName"); - my $default_https_admin_port = 9445; - - # check to see if "default" security domain exists on local machine - my $status = pingCS( $instanceDir, - $db_password, - $nickname, - $hostname, - $default_https_admin_port ); - if( "$status" eq "1" ) { - # "default" security domain exists on local machine; - # fill "sdomainURL" in with "default" security domain - # as an initial "guess" - $::symbol{sdomainURL} = "https://" . $hostname . ":" - . $default_https_admin_port; - } else { - # "default" security domain does NOT exist on local machine; - # leave "sdomainURL" blank - $::symbol{sdomainURL} = ""; - } - - $::symbol{sdomainAdminURL} = "https://" . $hostname . ":" - . $default_https_admin_port; - - my $initDaemon = "pki-tomcatd"; - my $statusCommand = ""; - my $instanceID ="<security_domain_instance_name>"; - if( $^O eq "linux" ) { - $statusCommand = "systemctl status $initDaemon\@$instanceID.service"; - } else { - ## default case: e. g. - ( $^O eq "solaris" ) - $statusCommand = "/etc/init.d/$initDaemon status $instanceID"; - } - $::symbol{statusCommand} = $statusCommand; - $::symbol{instanceID} = $instanceID; - return 1; -} - - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("SecurityPanel: update"); - my $sdomainURL = $q->param("sdomainURL"); - - if ($sdomainURL eq "") { - &PKI::RA::Wizard::debug_log("SecurityPanel: sdomainURL has not been specified!"); - $::symbol{errorString} = "Security Domain HTTPS has not been specified!"; - return 0; - } - - my $sdomainURL_info = new URI::URL($sdomainURL); - - my $instanceDir = $::config->get("service.instanceDir"); - my $db_password = `grep \"internal:\" \"$instanceDir/conf/password.conf\" | cut -c10-`; - $db_password =~ s/\n$//g; - my $nickname = $::config->get("preop.cert.sslserver.nickname"); - my $hostname = $sdomainURL_info->host; - my $https_admin_port = $sdomainURL_info->port; - - # check to see if "default" security domain exists on local machine - my $status = pingCS( $instanceDir, - $db_password, - $nickname, - $hostname, - $https_admin_port ); - if( "$status" ne "1" ) { - # invalid security domain specified - &PKI::RA::Wizard::debug_log("SecurityPanel: sdomainURL not found"); - $::symbol{errorString} = "Security Domain HTTPS Admin URL not found"; - return 0; - } - - # save urls in CS.cfg - &PKI::RA::Wizard::debug_log("SecurityPanel: sdomainURL=" . $sdomainURL); - $::config->put("config.sdomainAdminURL", $sdomainURL); - - # Add values necessary for 'pkiremove' . . . - $::config->put("securitydomain.select", "existing"); - $::config->put("securitydomain.host", $sdomainURL_info->host); - $::config->put("securitydomain.httpsadminport", $sdomainURL_info->port); - $::config->commit(); - - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/SizePanel.pm b/base/ra/lib/perl/PKI/RA/SizePanel.pm deleted file mode 100755 index f55dc41e9..000000000 --- a/base/ra/lib/perl/PKI/RA/SizePanel.pm +++ /dev/null @@ -1,245 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use PKI::RA::CertInfo; - -package PKI::RA::SizePanel; -$PKI::RA::SizePanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(11); - $self->{"getName"} = &PKI::RA::Common::r("Key Pairs"); - $self->{"vmfile"} = "sizepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("SizePanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("SizePanel: update"); - - my $instanceDir = $::config->get("service.instanceDir"); - my $done = $::config->get("preop.SizePanel.done"); - my $genKeyPair = $q->param('generateKeyPair'); - &PKI::RA::Wizard::debug_log("SizePanel: update generateKeyPair value=$genKeyPair"); - if ($done eq "true") { - if ($genKeyPair eq "") { - &PKI::RA::Wizard::debug_log("SizePanel: update generateKeyPair value not found, turn to off"); - $genKeyPair = "off"; - } - } else { - # firstime should always generate keys - $genKeyPair = "on"; - } - - foreach my $certtag (@PKI::RA::Wizard::certtags) { - my $select = $q->param($certtag.'_choice'); - my $keytype = $q->param($certtag.'_keytype'); - my $size = $q->param($certtag.'_custom_size'); - - &PKI::RA::Wizard::debug_log("SizePanel: update $certtag _choice=$select $certtag _keytype=$keytype customsize= $size"); - - $::config->put("preop.keysize.select", $select); - $::config->put("preop.cert.".$certtag.".keysize.select", $select); - - if (! isSupportedSize($keytype, $size)) { - &PKI::RA::Wizard::debug_log("SizePanel: update size $size not supported"); - return 0; - } - $::config->put("preop.cert.".$certtag.".keysize.customsize", $size); - $::config->put("preop.cert.".$certtag.".keytype", $keytype); - - if ($select eq "default") { - my $defaultSize = getDefaultSize($keytype); - &PKI::RA::Wizard::debug_log("SizePanel: update in default, defaultsize = $defaultSize"); - $::config->put("preop.keysize.customsize", $defaultSize); - $::config->put("preop.keysize.size", $defaultSize); - $::config->put("preop.cert.".$certtag.".keysize.size", $defaultSize); - - } elsif ($select eq "custom") { - &PKI::RA::Wizard::debug_log("SizePanel: update in custom, customsize = $size"); - $::config->put("preop.keysize.size", $size); - $::config->put("preop.cert.".$certtag.".keysize.size", $size); - } - - if ($genKeyPair eq "on") { - $::config->put("preop.cert.".$certtag.".certreq", ""); - $::config->put("preop.cert.".$certtag.".cert", ""); - } - } -#XXX should have better error checking to work better - $done = $::config->put("preop.SizePanel.done", "true"); - $::config->commit(); - - return 1; -} - -sub getDefaultSize { - my $keytype = $_[0]; - - if ($keytype eq "ecc") { - return 256; - } elsif ($keytype eq "rsa") { - return 2048; - } - - $::symbol{errorString} = "Unsupported keytype $keytype"; - return 0; -} - -sub isSupportedSize { - my $keytype = $_[0]; - my $size = $_[1]; - - if (($keytype eq "ecc") && ($size ne "256")) { - &PKI::RA::Wizard::debug_log("SizePanel: isSupportedSize ECC only supports size 256"); - $::symbol{errorString} = "Unsupported Size $size. ECC only supports size 256"; - return 0; - } - - if (($size eq "256") || ($size eq "512") || ($size eq "1024") || - ($size eq "2048") || ($size eq "4096")) { - return 1; - } - # wrong size - $::symbol{errorString} = "Unsupported Size $size. RSA only supports sizes 256, 512, 1024, 2048, and 4096"; - return 0; -} - -sub display -{ - my ($q) = @_; - - &PKI::RA::Wizard::debug_log("SizePanel: display"); - - my $done = $::config->get("preop.SizePanel.done"); - &PKI::RA::Wizard::debug_log("SizePanel: display is panel done? $done"); - if ($done eq "true") { - $::symbol{firsttime} = "false"; - } else { - $::symbol{firsttime} = "true"; - } - - my $domain_name = $::config->get("preop.securitydomain.name"); - if ($domain_name eq "") { - $domain_name = "RA Domain"; - } - - my $machine_name = $::config->get("service.machineName"); - my $instance_id = $::config->get("service.instanceID"); - - my $i = 0; - foreach my $certtag (@PKI::RA::Wizard::certtags) { - my $cert_dn = $::config->get("preop.cert.".$certtag.".dn"); - if ($cert_dn eq "") { - if ($certtag eq "subsystem") { - $cert_dn = "CN=RA Subsystem, " . - "OU=" . $instance_id . ", " . - "O=" . $domain_name; - } elsif ($certtag eq "sslserver") { - $cert_dn ="CN=" . $machine_name . ", " . - "OU=" . $instance_id . ", " . - "O=" . $domain_name; - } else { - $cert_dn = $certtag; - } - } - my $name = $::config->get("preop.cert.".$certtag.".userfriendlyname"); - if ($name eq "") { - $name = $certtag."Cert ".$instance_id; - } - my $cert = new PKI::RA::CertInfo($name, - $cert_dn, $certtag); - $::symbol{certs}[$i++] = $cert; - } - - #for "common key settings" - my $select = $::config->get("preop.keysize.select"); - if (($select eq "") || ($select eq "default")) { - $::symbol{select} = "default"; - } else { - &PKI::RA::Wizard::debug_log("SizePanel: display keysize select= $select"); - $::symbol{select} = $select; - } - my $default_size = $::config->get("preop.keysize.size"); - if ($default_size eq "") { - $::symbol{default_keysize} = 2048; - } else { - $::symbol{default_keysize} = $default_size; - } - - my $default_ecc_size = $::config->get("preop.keysize.ecc.size"); - if ($default_ecc_size eq "") { - $::symbol{default_ecc_keysize} = 256; - } else { - $::symbol{default_ecc_keysize} = $default_ecc_size; - } - - my $custom_size = $::config->get("preop.keysize.customsize"); - if ($custom_size eq "") { - $::symbol{custom_size} = 2048; - } else { - $::symbol{custom_size} = $default_size; - } - - - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/SubsystemTypePanel.pm b/base/ra/lib/perl/PKI/RA/SubsystemTypePanel.pm deleted file mode 100755 index 3d946bca0..000000000 --- a/base/ra/lib/perl/PKI/RA/SubsystemTypePanel.pm +++ /dev/null @@ -1,142 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; - -package PKI::RA::SubsystemTypePanel; -$PKI::RA::SubsystemTypePanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(3); - $self->{"getName"} = &PKI::RA::Common::r("Subsystem Type"); - $self->{"vmfile"} = "createsubsystempanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("SubsystemTypePanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("SubsystemTypePanel: update"); - $::symbol{systemname} = "Registration Authority "; - $::symbol{subsystemName} = "Registration Authority"; - $::symbol{fullsystemname} = "Registration Authority"; - $::symbol{machineName} = "localhost"; - $::symbol{http_port} = "12888"; - $::symbol{https_port} = "12889"; - $::symbol{non_clientauth_https_port} = "12890"; - $::symbol{check_clonesubsystem} = " "; - $::symbol{check_newsubsystem} = " "; - $::symbol{disableClone} = 1; - - my $subsystemName = $q->param('subsystemName'); - $::config->put("preop.subsystem.name", $subsystemName); - $::config->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("SubsystemTypePanel: display"); - $::symbol{systemname} = "Registration Authority "; - $::symbol{subsystemName} = "Registration Authority"; - $::symbol{fullsystemname} = "Registration Authority "; - - my $machineName = $::config->get("service.machineName"); - my $unsecurePort = $::config->get("service.unsecurePort"); - my $securePort = $::config->get("service.securePort"); - my $non_clientauth_securePort = $::config->get("service.non_clientauth_securePort"); - - - $::symbol{machineName} = $machineName; - $::symbol{http_port} = $unsecurePort; - $::symbol{https_port} = $securePort; - $::symbol{non_clientauth_https_port} = $non_clientauth_securePort; - $::symbol{check_clonesubsystem} = ""; - $::symbol{check_newsubsystem} = "checked "; - - my $session_id = $q->param("session_id"); - $::config->put("preop.sessionID", $session_id); - $::config->commit(); - - $::symbol{urls} = []; - my $count = 0; - while (1) { - my $host = $::config->get("preop.securitydomain.ra$count.host"); - if ($host eq "") { - goto DONE; - } - my $port = $::config->get("preop.securitydomain.ra$count.non_clientauth_secure_port"); - my $name = $::config->get("preop.securitydomain.ra$count.subsystemname"); - unshift(@{$::symbol{urls}}, "https://" . $host . ":" . $port); - $count++; - } -DONE: - $::symbol{urls_size} = $count; - -# if ($count == 0) { - $::symbol{disableClone} = 1; -# } - - # XXX - how to deal with urls - return 1; -} - - -1; diff --git a/base/ra/lib/perl/PKI/RA/TKSInfoPanel.pm b/base/ra/lib/perl/PKI/RA/TKSInfoPanel.pm deleted file mode 100755 index ddf1124a9..000000000 --- a/base/ra/lib/perl/PKI/RA/TKSInfoPanel.pm +++ /dev/null @@ -1,134 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; -use URI::URL; - -package PKI::RA::TKSInfoPanel; -$PKI::RA::TKSInfoPanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(5); - $self->{"getName"} = &PKI::RA::Common::r("TKS Information"); - $self->{"vmfile"} = "tksinfopanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("TKSInfoPanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("TKSInfoPanel: update"); - - my $count = $q->param('urls'); - - my $instanceID = $::config->get("service.instanceID"); - - my $host = ""; - my $https_agent_port = ""; - if ($count =~ /http/) { - my $info = new URI::URL($count); - $host = $info->host; - $https_agent_port = $info->port; - if (($host eq "") || ($https_agent_port eq "")) { - $::symbol{errorString} = "no TKS found. CA, TKS and optionally DRM must be installed prior to RA installation"; - return 0; - } - $::config->put("preop.tksinfo.select", $count); - } else { - $host = $::config->get("preop.securitydomain.tks$count.host"); - $https_agent_port = $::config->get("preop.securitydomain.tks$count.secureagentport"); - if (($host eq "") || ($https_agent_port eq "")) { - $::symbol{errorString} = "no TKS found. CA, TKS and optionally DRM must be installed prior to RA installation"; - return 0; - } - $::config->put("preop.tksinfo.select", "https://$host:$https_agent_port"); - } - my $subsystemCertNickName = $::config->get("preop.cert.subsystem.nickname"); - $::config->put("conn.tks1.clientNickname", $subsystemCertNickName); - $::config->put("conn.tks1.hostport", $host . ":" . $https_agent_port); - $::config->commit(); - - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("TKSInfoPanel: display"); - $::symbol{urls} = []; - my $count = 0; - while (1) { - my $host = $::config->get("preop.securitydomain.tks$count.host"); - if ($host eq "") { - goto DONE; - } - my $https_agent_port = $::config->get("preop.securitydomain.tks$count.secureagentport"); - my $name = $::config->get("preop.securitydomain.tks$count.subsystemname"); - $::symbol{urls}[$count++] = $name . " - https://" . $host . ":" . $https_agent_port; - } -DONE: - $::symbol{urls_size} = $count; - if ($count eq 0) { - $::symbol{errorString} = "no TKS found. CA, TKS and optionally DRM must be installed prior to RA installation"; - return 0; - } - - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/WelcomePanel.pm b/base/ra/lib/perl/PKI/RA/WelcomePanel.pm deleted file mode 100755 index c88c138be..000000000 --- a/base/ra/lib/perl/PKI/RA/WelcomePanel.pm +++ /dev/null @@ -1,90 +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 --- -# -# -# -# - -use strict; -use warnings; -use PKI::RA::GlobalVar; -use PKI::RA::Common; - -package PKI::RA::WelcomePanel; -$PKI::RA::WelcomePanel::VERSION = '1.00'; - -use PKI::RA::BasePanel; -our @ISA = qw(PKI::RA::BasePanel); - -sub new { - my $class = shift; - my $self = {}; - - $self->{"isSubPanel"} = \&is_sub_panel; - $self->{"hasSubPanel"} = \&has_sub_panel; - $self->{"isPanelDone"} = \&PKI::RA::Common::no; - $self->{"getPanelNo"} = &PKI::RA::Common::r(0); - $self->{"getName"} = &PKI::RA::Common::r("Welcome"); - $self->{"vmfile"} = "welcomepanel.vm"; - $self->{"update"} = \&update; - $self->{"panelvars"} = \&display; - bless $self,$class; - return $self; -} - -sub is_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub has_sub_panel -{ - my ($q) = @_; - return 0; -} - -sub validate -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("WelcomePanel: validate"); - return 1; -} - -sub update -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("WelcomePanel: update"); - return 1; -} - -sub display -{ - my ($q) = @_; - &PKI::RA::Wizard::debug_log("XXX " . $::config->get("logging.debug.enable")); - &PKI::RA::Wizard::debug_log("WelcomePanel: display"); - $::symbol{wizardname} = "RA Configuration Wizard"; - $::symbol{systemname} = "RA"; - $::symbol{fullsystemname} = "Registration Authority"; - - return 1; -} - -1; diff --git a/base/ra/lib/perl/PKI/RA/wizard.pm b/base/ra/lib/perl/PKI/RA/wizard.pm deleted file mode 100755 index fe23d62bb..000000000 --- a/base/ra/lib/perl/PKI/RA/wizard.pm +++ /dev/null @@ -1,502 +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 --- -# -# -# -# - -# wizard - -# Fedora Certificate System - Registration Authority System configuration wizard - - -# This script is run as a 'mod_perl' CGI. Configure mod_perl by adding -# the following to /etc/httpd/conf.d/perl.conf -# -# PerlModule ModPerl::Registry -# PerlModule Apache::compat -# PerlModule PKI::RA::Wizard -# PerlSetEnv PKI_DOCROOT /u/sparkins/t/cs_tip/certsystem/prj/common/ui -# <Location /wizard> -# SetHandler perl-script -# PerlHandler PKI::RA::Wizard -# Order deny,allow -# Allow from all -# </Location> - - -# Note: The Velocity parser is not very helpful when it comes to -# errors right now. Here are some common errors, and what they mean: -# -# ERROR: -# [Mon Apr 03 13:57:33 2006] [error] [client 172.16.24.26] -# Can't use string ("0") as an ARRAY ref while "strict refs" -# in use at /usr/lib/perl5/site_perl/5.8.5/Template/Velocity.pm -# line 423.\n, referer: http://chico/wizard?p=2 -# MEANING -# This probably means that your *.vm file refers to an array -# variable in a foreach statement that is not defined -# Check your foreach array variables. - -use warnings; -use ModPerl::Registry; -use Template::Velocity; -use Getopt::Std; -use Data::Dumper; -use CGI::Carp qw(fatalsToBrowser); -use CGI; -use APR::Const -compile => qw(:error SUCCESS); -use PKI::RA::GlobalVar; -use PKI::RA::WelcomePanel; -use PKI::RA::SecurityDomainPanel; -use PKI::RA::DisplayCertChainPanel; -use PKI::RA::SubsystemTypePanel; -use PKI::RA::CAInfoPanel; -use PKI::RA::DisplayCertChain2Panel; -use PKI::RA::AdminAuthPanel; -use PKI::RA::AgentAuthPanel; -use PKI::RA::DatabasePanel; -use PKI::RA::ModulePanel; -use PKI::RA::SizePanel; -use PKI::RA::NamePanel; -use PKI::RA::ConfigHSMLoginPanel; -use PKI::RA::CertRequestPanel; -use PKI::RA::AdminPanel; -use PKI::RA::ImportAdminCertPanel; -use PKI::RA::DonePanel; -use PKI::RA::Config; - -use PKI::RA::Common qw(yes no r); - -package PKI::RA::Wizard; -$PKI::RA::Wizard::VERSION = '1.00'; - -# read configuration file -my $flavor = "pki"; -$flavor =~ s/\n//g; - -my $pkiroot = $ENV{PKI_ROOT}; - -my $config = PKI::RA::Config->new(); -$config->load_file("$pkiroot/conf/CS.cfg"); -# read password cache file -my $pwdconf = PKI::RA::Config->new(); -$pwdconf->load_file("$pkiroot/conf/pwcache.conf"); -# SELinux disallows performing a "chmod" on this file -if( $^O ne "linux" ) { - system( "chmod 00660 $pkiroot/conf/pwcache.conf" ); -} - -# create cfg debug log -my $logfile = $config->get("service.instanceDir") . "/logs/debug"; -system( "touch $logfile" ); -system( "chmod 00640 $logfile" ); -open( DEBUG, ">>" . $logfile ) || -warn( "Could not open '" . $logfile . "': $!" ); - -# apache server - -our $debug; - -my $HTTP_OK = 0; - -my $STATUS_OK = 0; # Apache 2 needs this to be zero -my $STATUS_ERROR = 2; -my $STATUS_REDIRECT = 3; - -&debug_log("RA wizard: starting up"); - -my $docroot = $ENV{PKI_DOCROOT}; - -if (! $docroot) { - &debug_log("RA wizard: ERROR: PKI_DOCROOT is null"); - return 0; -} - -our $parser = new Template::Velocity($docroot); -our $symbol; -our @certtags; - -makepanels(); - -&debug_log("RA wizard: start up complete"); - -1; - -sub debug_log -{ - my ($msg) = @_; - my $date = `date`; - chomp($date); - if( -w $logfile ) { - print DEBUG "$date - $msg\n"; - } -} - - # initializes entries in parser's global symbol table for panels -sub makepanels -{ - #REAL PANELS BELOW - my $welcome = new PKI::RA::WelcomePanel(); - my $securitydomain = new PKI::RA::SecurityDomainPanel(); - my $displaycertchain = new PKI::RA::DisplayCertChainPanel(); - my $subsystem = new PKI::RA::SubsystemTypePanel(); - my $cainfopanel = new PKI::RA::CAInfoPanel(); -# my $displaycertchain2 = new PKI::RA::DisplayCertChain2Panel(); - my $databasepanel = new PKI::RA::DatabasePanel(); - my $modulepanel = new PKI::RA::ModulePanel(); - my $confighsmloginpanel = new PKI::RA::ConfigHSMLoginPanel(); - my $sizepanel = new PKI::RA::SizePanel(); - my $namepanel = new PKI::RA::NamePanel(); - my $certrequestpanel = new PKI::RA::CertRequestPanel(); - my $adminpanel = new PKI::RA::AdminPanel(); - my $importadmincertpanel = new PKI::RA::ImportAdminCertPanel(); - my $donepanel = new PKI::RA::DonePanel(); - - $symbol{panels} = [ - $welcome, # com.netscape.cms.servlet.csadmin.WelcomePanel - $securitydomain, # com.netscape.cms.servlet.csadmin.SecurityDomainPanel - $displaycertchain, # com.netscape.cms.servlet.csadmin.DisplayCertChainPanel - $subsystem, # com.netscape.cms.servlet.csadmin.CreateSubsystemPanel - $cainfopanel, # com.netscape.cms.servlet.csadmin.CAInfoPanel -# $displaycertchain2, # com.netscape.cms.servlet.csadmin.DisplayCertChain2Panel - $databasepanel, # com.netscape.cms.servlet.csadmin.DatabasePanel - $modulepanel, # com.netscape.cms.servlet.csadmin.ModulePanel - $confighsmloginpanel, # com.netscape.cms.servlet.csadmin.ConfigHSMLoginPanel - $sizepanel, # com.netscape.cms.servlet.csadmin.SizePanel - $namepanel, # com.netscape.cms.servlet.csadmin.NamePanel - $certrequestpanel, # com.netscape.cms.servlet.csadmin.CertRequestPanel - $adminpanel, # com.netscape.cms.servlet.csadmin.AdminPanel - $importadmincertpanel, # com.netscape.cms.servlet.csadmin.ImportAdminCertPanel - $donepanel, # com.netscape.cms.servlet.csadmin.DonePanel</param-value> - ]; -}; - -sub render_panel -{ - my ($panelnum, $q) = @_; - - $symbol{errorString} = ""; - - my $currentpanel; - - if ($q->param('op') && $q->param('op') eq "next") { - $currentpanel = $symbol{panels}[$panelnum]; - # validate variables for panel - if ($currentpanel->{validate}) { - $currentpanel->{validate}($q); - } - # execute current panel - my $status = "0"; - - if ($currentpanel->{update}) { - $status = $currentpanel->{update}($q); - &debug_log("RA wizard: update returns status '" . - $status . "'"); - if ($status == $STATUS_REDIRECT) { - return $STATUS_REDIRECT; - } - - } - - &debug_log("RA wizard: about to find out about sub panel"); - if ($status eq "1") { - if ($currentpanel->{hasSubPanel} && &{$currentpanel->{hasSubPanel}}($q)) { - &debug_log("RA wizard: has sub panel"); - $panelnum = $panelnum + 2; - } elsif ($currentpanel->{isSubPanel} && &{$currentpanel->{isSubPanel}}($q)) { - &debug_log("RA wizard: is sub panel"); - $panelnum = $panelnum - 1; - } else { - &debug_log("RA wizard: no sub panel and is not subpanel"); - $panelnum = $panelnum + 1; - } - } - } elsif ($q->param('op') && $q->param('op') eq "back") { - $panelnum = $panelnum - 1; - #check if this a subpanel, if so, go back to it's parent. - #only handles one-deep at this point - my $panel = $symbol{panels}[$panelnum]; - if (&{$panel->{isSubPanel}}($q)) { - $panelnum = $panelnum - 1; - } - } elsif ($q->param('op') && $q->param('op') eq "apply") { - &debug_log("RA wizard: update : apply button pressed"); - $currentpanel = $symbol{panels}[$panelnum]; - # validate variables for panel - if ($currentpanel->{validate}) { - $currentpanel->{validate}($q); - } - # execute current panel - if ($currentpanel->{update}) { - my $status = $currentpanel->{update}($q); - &debug_log("RA wizard: update returns status '" . - $status . "'"); - if ($status == $STATUS_REDIRECT) { - return $STATUS_REDIRECT; - } - - } - } - - &debug_log("RA wizard: after looking into about sub panel"); - - # advance to next panel - $currentpanel = $symbol{panels}[$panelnum]; - - # initialize symbol table values - $symbol{showApplyButton} = "false"; - - # fill in variables for new panel - if ($currentpanel->{panelvars}) { - $Data::Dumper::Indent = 1; - # The '&debug_log("q=".Dumper($q));' call must be commented out to fix - # Bugzilla Bug #249923: Incorrect file permissions on - # various files and/or directories - # &debug_log("q=".Dumper($q)); - $currentpanel->{panelvars}($q); - } - - $symbol{panel} = "ra/admin/console/config/".$currentpanel->{vmfile}; - - #wizard.vm: - $symbol{name} = "Registration Authority"; - $symbol{title} = $currentpanel->{getName}(); - if ($panelnum == 0) { - $symbol{firstpanel} = "1"; - } else { - $symbol{firstpanel} = "0"; - } - if ($panelnum == 13) { - $symbol{lastpanel} = "1"; - } else { - $symbol{lastpanel} = "0"; - } - $symbol{p} = $panelnum; - $symbol{subpanelno} = $panelnum+1; - $symbol{productversion} = $::config->get("cms.product.version"); - $symbol{csstate} = "1"; - -# $symbol{urls} = [ "cert1", "cert2" ]; #createsubsystem -# $symbol{urls_size} = 2; -# $symbol{instanceId} = "ra"; -# $symbol{errorString} = ""; - - #modulepanel -# $symbol{certs} = [ ]; -# $symbol{reqscerts} = [ ]; - $symbol{ppcerts} = [ ]; - - return $STATUS_OK; -} - - - -sub dbg { - my $msg = shift; - $::symbol{dbg} .= "$msg\n"; -} - -sub handler { - my $r = shift; - - *::symbol = \%symbol; - *::s = \$s; - *::config = \$config; - *::pwdconf = \$pwdconf; - - &debug_log("RA wizard: in handler"); - - my $q = new CGI; - - # check cookie - my $cookie = $q->cookie('pin'); - my $pin = $::config->get("preop.pin"); - if ($cookie ne $pin) { - print $q->redirect("login"); - return; - } - - # output http parameters - &debug_log("RA wizard: uri='" . $ENV{REQUEST_URI} . "'"); - my @pnames = $q->param(); - foreach $pn (@pnames) { - # added this facility so that password can be hidden, - # all sensitive parameters should be prefixed with - # __ (double underscores); however, in the event that - # a security parameter slips through, we perform multiple - # additional checks to insure that it is NOT displayed - if( $pn =~ /^__/ || - $pn =~ /password$/ || - $pn =~ /passwd$/ || - $pn =~ /pwd$/ || - $pn =~ /admin_password_again/i || - $pn =~ /directoryManagerPwd/i || - $pn =~ /bindpassword/i || - $pn =~ /bindpwd/i || - $pn =~ /passwd/i || - $pn =~ /password/i || - $pn =~ /pin/i || - $pn =~ /pwd/i || - $pn =~ /pwdagain/i || - $pn =~ /uPasswd/i ) { - &debug_log("RA wizard: http parameter name='" . $pn . "' value='(sensitive)'"); - } else { - &debug_log("RA wizard: http parameter name='" . $pn . "' value='" . $q->param($pn) . "'"); - } - } - - my $panelnum = $q->param('p'); - if (!defined($panelnum) || $panelnum eq "") { - # Apache fails to pick up the p parameter after - # redirecting from the security domain. This is - # a quick hack to solve the issue. - if ($ENV{'QUERY_STRING'} ne "") { - $ENV{'QUERY_STRING'} =~ /p=([0-9]+)&/; - $panelnum = $1; - } - } - - use subs qw(debug); - *debug = \&Template::Velocity::Executor::debug; - - $::symbol{dbg} = ""; - - &debug_log("RA wizard: before argparsing"); - if ($#ARGV == -1) { - $Data::Dumper::Maxdepth = 7; - $startfile = "ra/admin/console/config/wizard.vm"; - } - - &debug_log("RA wizard: setting up test objects"); - - #initialize from config file - my $certlist = $::config->get("preop.cert.list"); - if ($certlist eq "") { - $certlist = "sslserver,subsystem"; - } - @certtags = split(/,/, $certlist); - $numtags = @certtags; - if ($numtags eq 0) { - @certtags = ("sslserver", "subsystem"); - } - &debug_log("RA wizard: found $numtags certtags"); - - if (! $panelnum) { - $panelnum = 0; - } - - my $status = render_panel($panelnum, $q); - if ($status == 3) { - $r->header_out(Location => $symbol{redirect}); - $r->status(301); - $r->send_http_header(); - return; - } - - use Data::Dumper; - &debug_log("RA wizard: executing file $startfile"); - foreach $q (sort keys %symbol) { - &debug_log("RA wizard:/config/wizard?p=9&SecToken=NSS%20Generic%20Crypto%20Services sym{$q}=".$symbol{$q}); - } - - my $result; - if ($q->param('xml') && $q->param('xml') eq "true") { - $r->send_http_header('text/xml'); - $result = "<xml>"; - foreach $s (sort keys %symbol) { - if ($s =~ /^__/) { - next; - } - $result .= "<" . $s . ">"; - my $v = $symbol{$s}; - $result .= &get_xml($s, $v); - $result .= "</" . $s . ">"; - } - $result .= "</xml>"; - } else { - $result = $parser->execute_file($startfile); - if (!defined $result) { - die("Couldn't execute template file: $docroot/$startfile"); - } - } - - $r->send_http_header('text/html'); - print "$result\n"; - - return $HTTP_OK; -} - -sub escape_xml -{ - my ($v) = @_; - $v =~ s/\"/"/g; - $v =~ s/\'/'/g; - $v =~ s/\&/&/g; - $v =~ s/</</g; - $v =~ s/>/>/g; - return $v; -} - -sub get_xml -{ - my ($s, $v) = @_; - - my $result; - if (ref($v) eq "HASH") { - foreach my $xkey (keys %$v) { - $result .= "<" . $xkey . ">"; - $result .= &get_xml($xkey, $v{$xkey}); - # $result .= "-" . ref($xkey); - $result .= "</" . $xkey . ">"; - } - } elsif (ref($v) eq "PKI::RA::CertInfo") { - my $certinfo = $v; - $result .= "<certinfo>"; - $result .= "<dn>" . $certinfo->get_dn() ."</dn>"; - $result .= "<tag>" . $certinfo->get_cert_tag() . "</tag>"; - $result .= "<friendly>" . $certinfo->get_user_friendly_name() . - "</friendly>"; - $result .= "</certinfo>"; - } elsif (ref($v) eq "PKI::RA::ReqCertInfo") { - my $reqcertinfo = $v; - $result .= "<reqcertinfo>"; - $result .= "<name>" . $reqcertinfo->get_user_friendly_name() ."</name>"; - $result .= "<req>" . $reqcertinfo->get_request() ."</req>"; - $result .= "<cert>" . $reqcertinfo->get_cert() ."</cert>"; - $result .= "<certpp>" . &escape_xml($reqcertinfo->get_cert_pp()) ."</certpp>"; - $result .= "<tag>" . $reqcertinfo->get_cert_tag() ."</tag>"; - $result .= "<dn>" . $reqcertinfo->get_cert_tag() ."</dn>"; - $result .= "</reqcertinfo>"; - } elsif (ref($v) eq "ARRAY") { - my $pos = 0; - foreach my $item (@$v) { - $result .= "<element>"; - $result .= &get_xml("p" . $pos, $item); - # $result .= "-" . ref($item); - $result .= "</element>"; - $pos++; - } - } else { - $result .= &escape_xml($v); - } - return $result; -} - -1; diff --git a/base/ra/lib/perl/PKI/Request/Plugin/AutoAssign.pm b/base/ra/lib/perl/PKI/Request/Plugin/AutoAssign.pm deleted file mode 100644 index 671f2418d..000000000 --- a/base/ra/lib/perl/PKI/Request/Plugin/AutoAssign.pm +++ /dev/null @@ -1,52 +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 --- -# -# -# -# - -####################################### -# This plugins assigns a request to a group. -####################################### -package PKI::Request::Plugin::AutoAssign; - -use DBI; -use PKI::Base::TimeTool; - -####################################### -# Instantiate this plugin -####################################### -sub new { - my $self = {}; - bless ($self); - return $self; -} - -####################################### -# Processes plugin -####################################### -sub process { - my ($self, $cfg, $queue, $prefix, $req) = @_; - - my $assignTo = $cfg->get($prefix . ".assignTo"); - $queue->set_request($req->{'rowid'}, "assigned_to", $assignTo); -} - -1; diff --git a/base/ra/lib/perl/PKI/Request/Plugin/CreatePin.pm b/base/ra/lib/perl/PKI/Request/Plugin/CreatePin.pm deleted file mode 100644 index b90096664..000000000 --- a/base/ra/lib/perl/PKI/Request/Plugin/CreatePin.pm +++ /dev/null @@ -1,75 +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 --- -# -# -# -# - -####################################### -# This plugins creates a one time pin. -####################################### -package PKI::Request::Plugin::CreatePin; - -use DBI; -use PKI::Base::TimeTool; -use PKI::Base::PinStore; - -####################################### -# Instantiates this plugin -####################################### -sub new { - my $self = {}; - bless ($self); - return $self; -} - -####################################### -# Processes plugin -####################################### -sub process { - my ($self, $cfg, $queue, $prefix, $req) = @_; - - my $pin_store = PKI::Base::PinStore->new(); - $pin_store->open($cfg); - - - my $pin_format = $cfg->get($prefix . ".pinFormat"); - - my $client_id = ""; - my $site_id = ""; - - my $data = $req->{'data'}; - foreach $nv (split(/;/, $data)) { - my ($n, $v) = split(/=/, $nv); - $pin_format =~ s/\$$n/$v/g; - } - my $created_by = "admin"; - my $pin = $pin_store->create_pin($pin_format, $req->{'rowid'}, $created_by); - - # save pin to output - $output = "pin=" . $pin; - $queue->set_request_output($req->{'rowid'}, $output); - - $req->{'output'} = $output; - - $pin_store->close(); -} - -1; diff --git a/base/ra/lib/perl/PKI/Request/Plugin/EmailNotification.pm b/base/ra/lib/perl/PKI/Request/Plugin/EmailNotification.pm deleted file mode 100644 index 95274bfa7..000000000 --- a/base/ra/lib/perl/PKI/Request/Plugin/EmailNotification.pm +++ /dev/null @@ -1,100 +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 --- -# -# -# -# - -####################################### -# This plugins mails a notification -# to an email specified in the request. -####################################### -package PKI::Request::Plugin::EmailNotification; - -use DBI; -use PKI::Base::TimeTool; - -####################################### -# Instantiate this plugin -####################################### -sub new { - my $self = {}; - bless ($self); - return $self; -} - -sub substitute { - my ($self, $cfg, $queue, $prefix, $req, $line) = @_; - - my $mail_to = $cfg->get($prefix . ".mailTo"); - - # if mail_to starts with $, retrieve value from request - if ($mail_to =~ /^\$/) { - $mail_to =~ s/\$//g; - $mail_to = $req->{$mail_to}; - } - my $machineName = $cfg->get("service.machineName"); - my $securePort = $cfg->get("service.securePort"); - my $unsecurePort = $cfg->get("service.unsecurePort"); - my $nonClientAuthSecurePort = $cfg->get("service.non_clientauth_securePort"); - my $subject_dn = $req->{'subject_dn'}; - - $line =~ s/\$mail_to/$mail_to/g; - $line =~ s/\$request_id/$req->{'rowid'}/g; - $line =~ s/\$machineName/$machineName/g; - $line =~ s/\$securePort/$securePort/g; - $line =~ s/\$unsecurePort/$unsecurePort/g; - $line =~ s/\$subject_dn/$subject_dn/g; - $line =~ s/\$nonClientAuthSecurePort/$nonClientAuthSecurePort/g; - return $line; -} - -####################################### -# Processes plugin -####################################### -sub process { - my ($self, $cfg, $queue, $prefix, $req) = @_; - my $queue = PKI::Request::Queue->new(); - $queue->open($cfg); - my $ref = $queue->read_request($req->{rowid}); - - my $req_err = $ref->{errorString}; - if ($req_err ne "0") { - return; - } - - my $mail_to = $cfg->get($prefix . ".mailTo"); - if ($mail_to eq "") { - return; - } - - my $template_dir = $cfg->get($prefix . ".templateDir"); - my $template_file = $cfg->get($prefix . ".templateFile"); - - open(SENDMAIL, "|/usr/sbin/sendmail -t"); - open(F,"$template_dir/$template_file"); - while (<F>) { - print SENDMAIL $self->substitute($cfg, $queue, $prefix, $ref, $_); - } - close(F); - close(SENDMAIL); -} - -1; diff --git a/base/ra/lib/perl/PKI/Request/Plugin/RequestToCA.pm b/base/ra/lib/perl/PKI/Request/Plugin/RequestToCA.pm deleted file mode 100644 index 1c5b7d6b2..000000000 --- a/base/ra/lib/perl/PKI/Request/Plugin/RequestToCA.pm +++ /dev/null @@ -1,89 +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 --- -# -# -# -# - -####################################### -# This plugins mails a notification -# to an email specified in the request. -####################################### -package PKI::Request::Plugin::RequestToCA; - -use DBI; -use PKI::Base::TimeTool; -use PKI::Conn::CA; - -####################################### -# Instantiate this plugin -####################################### -sub new { - my $self = {}; - bless ($self); - return $self; -} - -####################################### -# Processes plugin -####################################### -sub process { - my ($self, $cfg, $queue, $prefix, $req) = @_; - - my $ca = $cfg->get($prefix . ".ca"); - my $profile_id = $cfg->get($prefix . ".profileId"); - my $req_type = $cfg->get($prefix . ".reqType"); - - my $server_id = ""; - my $site_id = ""; - my $csr = ""; - my $csr_type = ""; - - my $data = $req->{'data'}; - foreach $nv (split(/;/, $data)) { - my ($n, $v) = split(/=/, $nv); - if ($n eq "server_id") { - $server_id = $v; - } - if ($n eq "site_id") { - $site_id = $v; - } - if ($n eq "csr") { - $csr = $v; - } - if ($n eq "csr_type") { - $csr_type = $v; - } - } - - if ($csr_type ne "") { - $req_type = $csr_type; - } - - my $ca_conn = PKI::Conn::CA->new(); - $ca_conn->open($cfg); - my $cert = $ca_conn->enroll($req->{'rowid'}, $ca, $profile_id, $req_type, $csr); - $queue->set_request($req->{'rowid'}, "output", $cert); - $req->{'output'} = $cert; - $ca_conn->close(); - -} - -1; diff --git a/base/ra/lib/perl/PKI/Request/Queue.pm b/base/ra/lib/perl/PKI/Request/Queue.pm deleted file mode 100644 index dc8418d22..000000000 --- a/base/ra/lib/perl/PKI/Request/Queue.pm +++ /dev/null @@ -1,387 +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::Request::Queue; - -use DBI; -use PKI::Base::TimeTool; - -####################################### -# Constructs a request queue -####################################### -sub new { - my $self = {}; - bless ($self); - return $self; -} - -####################################### -# Opens request queue -####################################### -sub open { - my ($self, $cfg) = @_; - $self->{cfg} = $cfg; - my $dbfile = $cfg->get("database.dbfile"); - $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$dbfile","",""); - my $timeout = $self->{dbh}->func("busy_timeout"); - $self->{dbh}->func($timeout * 10, "busy_timeout"); -} - -####################################### -# Creates a new request -####################################### -sub invoke_plugins { - my ($self, $prefix, $type, $ref) = @_; - - my $num_plugins = $self->{cfg}->get($prefix . ".num_plugins"); - for (my $i = 0; $i < $num_plugins; $i++) { - my $plugin = $self->{cfg}->get($prefix . "." . $i . ".plugin"); - eval("require $plugin"); - my $p = $plugin->new(); - $p->process($self->{cfg}, $self, $prefix . "." . $i, $ref); - } -} - -####################################### -# Creates a new request -####################################### -sub create_request { - my ($self, $type, $data, $meta_info, $created_by) = @_; - my $dbh = $self->{dbh}; - - my $timet = PKI::Base::TimeTool->new(); - my $now = $timet->get_time(); - - my $insert = "insert into requests (" . - "type" . "," . - "status" . "," . - "errorString" . "," . - "ip" . "," . - "data" . "," . - "serialno" . "," . - "subject_dn" . "," . - "meta_info" . "," . - "created_by" . "," . - "updated_at" . "," . - "created_at" . - ") values (" . - $dbh->quote($type) . "," . - $dbh->quote("OPEN") . "," . - $dbh->quote("0") . "," . - $dbh->quote($ENV{REMOTE_ADDR}) . "," . - $dbh->quote($data) . "," . - $dbh->quote("unavailable") . "," . - $dbh->quote("unavailable") . "," . - $dbh->quote($meta_info) . "," . - $dbh->quote($created_by) . "," . - $dbh->quote($now) . "," . - $dbh->quote($now) . - ")"; -REDO_CREATE_REQUEST: - eval { - $dbh->do($insert); - }; - if ($dbh->err == 5) { - sleep(1); - goto REDO_CREATE_REQUEST; - } - my $rid = $dbh->func('last_insert_rowid'); - - my $ref = $self->read_request($rid); - - # call plugins - my $prefix = "request." . $type . ".create_request"; - $self->invoke_plugins($prefix, $type, $ref); - - return $rid; -} - -####################################### -# Reads a request -####################################### -sub read_request { - my ($self, $reqid) = @_; - my $dbh = $self->{dbh}; - my $select = "select *,rowid from requests " . - "where rowid=" . $dbh->quote($reqid); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - return $ref; -} - -sub read_request_by_roles { - my ($self, $roles, $reqid) = @_; - my $dbh = $self->{dbh}; - - my $select; - if (grep /^administrators/, @$roles) { - # administrator see all requests - $select = "select *,rowid from requests " . - "where rowid=" . $dbh->quote($reqid); - } else { - my $filter = $self->get_role_filter($roles); - $select = "select *,rowid from requests where " . - "(" . $filter . ")" . " AND " . - "rowid=" . $dbh->quote($reqid); - } - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - return $ref; -} - -####################################### -# Sets request attributes -####################################### -sub set_request { - my ($self, $reqid, $name, $value) = @_; - my $dbh = $self->{dbh}; - - my $timet = PKI::Base::TimeTool->new(); - my $now = $timet->get_time(); - my $update = "update requests set " . - $name . "=" . $dbh->quote($value) . "," . - "updated_at=" . $dbh->quote($now) . " " . - "where rowid=" . $dbh->quote($reqid); -REDO_SET_REQUEST: - eval { - $dbh->do($update); - }; - if ($dbh->err == 5) { - sleep(1); - goto REDO_SET_REQUEST; - } - - my $select = "select *,rowid from requests " . - "where rowid=" . $dbh->quote($reqid); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - - return $ref; -} - -####################################### -# Sets output -####################################### -sub set_request_output { - my ($self, $reqid, $output) = @_; - - return $self->set_request($reqid, "output", $output); -} - -####################################### -# Approves a request -####################################### -sub approve_request { - my ($self, $reqid, $processed_by) = @_; - my $dbh = $self->{dbh}; - - # XXX - check assigned_to - - my $timet = PKI::Base::TimeTool->new(); - my $now = $timet->get_time(); - my $update = "update requests set " . - "processed_by=" . $dbh->quote($processed_by) . "," . - "status='APPROVED' " . "," . - "errorString='0' " . "," . - "updated_at=" . $dbh->quote($now) . " " . - "where rowid=" . $dbh->quote($reqid); -REDO_APPROVE_REQUEST: - eval { - $dbh->do($update); - }; - if ($dbh->err == 5) { - sleep(1); - goto REDO_APPROVE_REQUEST; - } - - my $select = "select *,rowid from requests " . - "where rowid=" . $dbh->quote($reqid); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - - # call plugins - my $prefix = "request." . $ref->{'type'} . ".approve_request"; - $self->invoke_plugins($prefix, $ref->{'type'}, $ref); - - my $select = "select *,rowid from requests " . - "where rowid=" . $dbh->quote($reqid); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - - return $ref; -} - -####################################### -# Rejects a request -####################################### -sub reject_request { - my ($self, $reqid, $processed_by) = @_; - my $dbh = $self->{dbh}; - - my $timet = PKI::Base::TimeTool->new(); - my $now = $timet->get_time(); - my $update = "update requests set " . - "processed_by=" . $dbh->quote($processed_by) . "," . - "status='REJECTED' " . "," . - "updated_at=" . $dbh->quote($now) . " " . - "where rowid=" . $dbh->quote($reqid); -REDO_REJECT_REQUEST: - eval { - $dbh->do($update); - }; - if ($dbh->err == 5) { - sleep(1); - goto REDO_REJECT_REQUEST; - } - - my $select = "select *,rowid from requests " . - "where rowid=" . $dbh->quote($reqid); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - - # call plugins - my $prefix = "request." . $ref->{'type'} . ".reject_request"; - $self->invoke_plugins($prefix, $ref->{'type'}, $ref); - - my $select = "select *,rowid from requests " . - "where rowid=" . $dbh->quote($reqid); - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - - return $ref; -} - -sub get_role_filter { - my ($self, $roles) = @_; - my $dbh = $self->{dbh}; - - my $filter = ""; - foreach $rr (@$roles) { - if ($filter eq "") { - $filter = "assigned_to=" . $dbh->quote($rr); - } else { - $filter = $filter . " OR " . "assigned_to=" . $dbh->quote($rr); - } - } - return $filter; -} - -####################################### -# Lists requests -####################################### -sub list_requests { - my ($self, $startpos, $maxcount) = @_; - my $dbh = $self->{dbh}; - my $select = "select *,rowid from requests " . - "order by rowid desc " . - "limit $startpos, $maxcount"; - my $sth = $dbh->prepare($select); - $sth->execute(); - my @reqs; - while (my $ref = $sth->fetchrow_hashref()) { - push(@reqs, $ref); - } - $sth->finish(); - return @reqs; -} - -sub count_requests_by_roles { - my ($self, $roles, $status) = @_; - my $dbh = $self->{dbh}; - - my $select; - - if (grep /^administrators$/, @$roles) { - # administrator sees everything - $select = "select count(*) from requests where " . - "status like '$status%' "; - } else { - # shows requests that are owned by the groups - my $filter = $self->get_role_filter($roles); - $select = "select count(*) from requests where " . - "status like '$status%' AND " . - "(" . $filter . ") "; - } - my $sth = $dbh->prepare($select); - $sth->execute(); - my $ref = $sth->fetchrow_hashref(); - $sth->finish(); - return $ref->{'count(*)'}; -} - -sub list_requests_by_roles { - my ($self, $roles, $status, $startpos, $maxcount) = @_; - my $dbh = $self->{dbh}; - - my $select; - -# if ($roles =~ /administrators/) { - if (grep /^administrators$/, @$roles) { - # administrator sees everything - $select = "select *,rowid from requests where " . - "status like '$status%' " . - "order by rowid desc " . - "limit $startpos, $maxcount"; - } else { - # shows requests that are owned by the groups - my $filter = $self->get_role_filter($roles); - $select = "select *,rowid from requests where " . - "status like '$status%' AND " . - "(" . $filter . ") " . - "order by rowid desc " . - "limit $startpos, $maxcount"; - } - my $sth = $dbh->prepare($select); - $sth->execute(); - my @reqs; - while (my $ref = $sth->fetchrow_hashref()) { - push(@reqs, $ref); - } - $sth->finish(); - return @reqs; -} - -####################################### -# Closes request queue -####################################### -sub close { - my ($self) = @_; - my $dbh = $self->{dbh}; - $dbh->disconnect(); -} - -1; diff --git a/base/ra/lib/perl/PKI/Service/Op.pm b/base/ra/lib/perl/PKI/Service/Op.pm deleted file mode 100644 index 602f1a29f..000000000 --- a/base/ra/lib/perl/PKI/Service/Op.pm +++ /dev/null @@ -1,290 +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; - -use PKI::Base::UserStore; -use PKI::Base::CertStore; - -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 get_client_certificate() -{ - my ($self) = @_; - - my $user_cert = $ENV{"SSL_CLIENT_CERT"}; - $user_cert =~ s/-----BEGIN CERTIFICATE-----//g; - $user_cert =~ s/-----END CERTIFICATE-----//g; - $user_cert =~ s/\n//g; - - return $user_cert; -} - -sub get_current_uid() -{ - my ($self, $cfg) = @_; - - my $user_cert = $self->get_client_certificate(); - - my $us = PKI::Base::UserStore->new(); - $us->open($cfg); - my $ref = $us->map_user($user_cert); - if (!defined($ref)) { - return ""; - } - $us->close(); - - return $ref->{'uid'}; -} - -sub get_csr_by_cert() -{ - my ($self, $cfg) = @_; - - my $user_cert = $self->get_client_certificate(); - my $cs = PKI::Base::CertStore->new(); - $cs->open($cfg); - my $ref = $cs->map_certificate($user_cert); - if (!defined($ref)) { - return ""; - } - $us->close(); - - return $ref->{'csr'}; -} - -sub get_cert_record() -{ - my ($self, $cfg) = @_; - -$self->debug_log( $cfg, "in get_cert_record"); - my $user_cert = $self->get_client_certificate(); - my $cs = PKI::Base::CertStore->new(); - $cs->open($cfg); - my $ref = $cs->map_certificate($user_cert); - if (!defined($ref)) { -$self->debug_log( $cfg, "in get_cert_record: map_certificate ref none"); - return ""; - } -$self->debug_log( $cfg, "in get_cert_record: got map_certificate ref"); - $cs->close(); - - return $ref; -} - -sub get_current_roles() -{ - my ($self, $cfg) = @_; - - my $uid = $self->get_current_uid($cfg); - my $us = PKI::Base::UserStore->new(); - $us->open($cfg); - my @roles = $us->get_roles($uid); - $us->close(); - - return @roles; -} - -sub get_roles_of() -{ - my ($self, $cfg, $uid) = @_; - - my $us = PKI::Base::UserStore->new(); - $us->open($cfg); - my @roles = $us->get_roles($uid); - $us->close(); - - return @roles; -} - -sub admin_auth() -{ - my ($self, $cfg) = @_; - - my $user_cert = $self->get_client_certificate(); - - # authentication - my $us = PKI::Base::UserStore->new(); - $us->open($cfg); - my $ref = $us->map_user($user_cert); - if (!defined($ref)) { - return 0; - } - my @roles = $us->get_roles($ref->{'uid'}); - $us->close(); - - # authorization - my $authorized_groups = $cfg->get("admin.authorized_groups"); - $self->debug_log( $cfg, "in admin_auth: authorized groups are: $authorized_groups"); - my @authorizedGroups = split(/,/, $authorized_groups); - my $authorized = 0; - foreach my $role (@roles) { - $self->debug_log( $cfg, "in admin_auth: user has group $role"); - if (grep /^$role$/, @authorizedGroups) { - $self->debug_log( $cfg, "in admin_auth: group matched"); - $authorized = 1; - } - } - if (!$authorized) { - $self->debug_log( $cfg, "in admin_auth: no group matched"); - return 0; - } - return 1; -} - -sub agent_auth() -{ - my ($self, $cfg) = @_; - - my $user_cert = $self->get_client_certificate(); - - # authentication - my $us = PKI::Base::UserStore->new(); - $us->open($cfg); - my $ref = $us->map_user($user_cert); - if (!defined($ref)) { - return 0; - } - my @roles = $us->get_roles($ref->{'uid'}); - my $j = join(",", @roles); - $self->debug_log( $cfg, "in agent_auth: $ref->{'uid'} has roles: $j"); - $us->close(); - - # authorization - my $authorized_groups = $cfg->get("agent.authorized_groups"); - $self->debug_log( $cfg, "in agent_auth: authorized groups are: $authorized_groups"); - my @authorizedGroups = split(/,/, $authorized_groups); - my $authorized = 0; - foreach $role (@roles) { - if (grep /^$role$/, @authorizedGroups) { - $self->debug_log( $cfg, "in agent_auth: group matched"); - $authorized = 1; - } - } - if (!$authorized) { - $self->debug_log( $cfg, "in agent_auth: no group matched"); - return 0; - } - return 1; -} - -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/base/ra/lib/perl/Template/Velocity.pm b/base/ra/lib/perl/Template/Velocity.pm deleted file mode 100755 index 848de65fd..000000000 --- a/base/ra/lib/perl/Template/Velocity.pm +++ /dev/null @@ -1,1099 +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 --- -# -# -# -# - -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; -use Thread::Semaphore; - - -$Template::Velocity::parser; - -our $docroot="docroot"; -our $parser; -my %parsetrees = (); -my $debugflag = 0; -my $semaphore; - - -#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"; - $semaphore = new Thread::Semaphore; - $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_with_context -{ - - my $self = shift; - my $filename = shift; - my $hash = shift; - - # This perl Velocity implementation uses global variable to - # store values that go to the template. This is not thread - # safe and should be fixed in near future. - # - # For this release, we just a lock to prevent the global - # variable (i.e. symbol) being changed by multiple threads - # at the same time. - - $semaphore->down; - my %c = %$hash; - foreach my $h (keys %c) { - $::symbol{$h} = $c{$h}; - } - - 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; - - $semaphore->up; - - 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 PKI::RA::GlobalVar; - -#sub new { my $self = {}; bless $self; return $self; } - - -1; - |