#!/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-2010 Red Hat, Inc.
# All rights reserved.
# --- END COPYRIGHT BLOCK ---
#

use strict;
use warnings;

use Getopt::Long qw(GetOptions);

##############################################################
# This script is used to remove an existing PKI instance.
#
# To execute:
#
#   ./pkiremove -pki_instance_root=<pki_instance_root> # Instance root
#                                                      # directory destination
#
#               -pki_instance_name=<pki_instance_id>   # Unique PKI subsystem
#                                                      # instance name
#                                                      # (e. g. - pki-pki1)
#
#               [-token_pwd=<token pw>]                # Password of token containing
#                                                      # subsystem certificate
#
#               [-force]                               # Don't ask any
#                                                      # questions
#
##############################################################


##############################################################
# Execution Check
##############################################################

# Check to insure that this script's original
# invocation directory has not been deleted!
my $cwd = `/bin/pwd`;
chomp $cwd;
if (!$cwd) {
    emit("Cannot invoke '$0' from non-existent directory!\n", "error");
    exit 255;
}

##############################################################
# Environment Variables
##############################################################

# untaint called subroutines
if (($^O ne 'Windows_NT') && ($^O ne 'MSWin32')) {
    $> = $<;   # set effective user ID to real UID
    $) = $(;   # set effective group ID to real GID
    $ENV{'PATH'} = '/bin:/usr/bin';
    $ENV{'ENV'} = '' if !defined($ENV{'ENV'});
}


##############################################################
# Command-Line Variables
##############################################################

my $ARGS = ($#ARGV + 1);


##############################################################
# Shared Common Perl Data and Subroutines
##############################################################

use lib "/usr/share/pki/scripts";
use pkicommon;

# make -w happy by suppressing warnings of Global variables used only once
my $suppress = "";
$suppress = $default_file_permissions;

##############################################################
# Local Constants
##############################################################

my $semanage = "/usr/sbin/semanage";

##############################################################
# Local Data Structures
##############################################################


##############################################################
# Local Variables
##############################################################

my $pki_instance_root               = undef;
my $pki_instance_name               = undef;
my $force                           = 0;
my $token_pwd                       = "";

my $conf_file                       = undef;
my $pki_instance_path               = undef;
my $subsystem_type                  = undef;

# PKI init script variables
my $pki_registry_initscript         = undef;
my $pki_registry_initscript_command = undef;

# PKI registry variables
my $pki_registry_subsystem_path     = undef;

#systemd specific variables
my $use_systemd                        = 0;
my $pki_instance_systemd_service_name  = undef;

##############################################################
# Platform-Dependent Data Initialization
##############################################################

if ($^O eq "linux") {
    if (is_Fedora() && (fedora_release() >= 16)) {
        $use_systemd = 1;
    }
} else {
    emit("Unsupported platform '$^O'!\n", "error");
    exit 255;
}

##############################################################
# Local Data Initialization
##############################################################

##############################################################
# PKI Instance Removal Subroutines
##############################################################

# no args
# no return value
sub usage
{
    print STDOUT <<'EOF';
Usage:  pkiremove -pki_instance_root=<pki_instance_root> # Instance root
                                                         # directory
                                                         # destination
                  -pki_instance_name=<pki_instance_id>   # Unique PKI
                                                         # subsystem
                                                         # instance name
                                                         # (e. g. - pki-pki1)
                                                         #
[-token_pwd=<token password>] # Password for token containing subsystem cert.          

[-force]   # Don't ask any questions

[-verbose] # Display detailed information. May be specified multiple times,
           # each time increasing the verbosity level.

[-dry_run] # Do not perform any actions.
           # Just report what would have been done.

Example:  pkiremove -pki_instance_root=/var/lib -pki_instance_name=pki-tps

IMPORTANT:  Must be run as root!
IMPORTANT:  pkiremove should only be used to remove instances which were created
            using pkicreate.  Instances created using pkispawn should be removed
            using pkidestroy.
EOF
    return;
}

sub update_domain
{
    my $sport;
    my $ncsport;
    my $sechost;
    my $httpport;
    my $seceeport;
    my $secagentport;
    my $secadminport;
    my $adminsport;
    my $agentsport;
    my $secselect;
    my $subsystemnick;
    my $machinename;
    my $typeval;
    my $url;
    
    get_cs_cfg($conf_file, {"service.machineName"               => \$machinename,
                            "service.securityDomainPort"        => \$sport,
                            "service.non_clientauth_securePort" => \$ncsport,
                            "securitydomain.host"               => \$sechost,
                            "securitydomain.httpport"           => \$httpport,
                            "securitydomain.httpseeport"        => \$seceeport,
                            "securitydomain.httpsagentport"     => \$secagentport,
                            "securitydomain.httpsadminport"     => \$secadminport,
                            "securitydomain.select"             => \$secselect,
                            "pkicreate.admin_secure_port"       => \$adminsport,
                            "cs.type"                           => \$typeval,
                            "pkicreate.agent_secure_port"       => \$agentsport});

    my $subsystemnick_param = lc($typeval) . ".cert.subsystem.nickname";
    get_cs_cfg($conf_file, {$subsystemnick_param                => \$subsystemnick});

    # NOTE:  Don't check for the existence of $httpport, as this will
    #        be undefined for a Security Domain that has been migrated!
    if ((!defined($sechost))      ||
        (!defined($seceeport))    ||
        (!defined($secagentport)) ||
        (!defined($secadminport))) {
        print(STDOUT "No security domain defined.\nIf this is an unconfigured instance, then that is OK.\n" .
            "Otherwise, manually delete the entry from the security domain master.\n"); 
        return;
    }

    die "Subsystem nickname not defined" if (!defined($subsystemnick));
    if (!defined($adminsport)) {
        $adminsport = "";
    }
    
    if (!defined($agentsport)) {
        $agentsport = "";
    }

    if (!defined($ncsport)) {
        $ncsport = "";
    }

    (my $token_name, my $nick) = split(/:/, $subsystemnick, 2);
    if ((!defined($nick)) || ($nick eq "")) {
        $token_name = "internal";
    }
 
    if ($secselect ne "new") {
        # This is not a domain master, so we need to update the master
        print(STDOUT "Contacting the security domain master to update the security domain\n");
        my $listval = $subsystem_type . "List";
        my $urlheader = "https://" . $sechost . ":" . $seceeport; 
        my $urlagentheader = "https://" . $sechost . ":" . $secagentport; 
        my $urladminheader = "https://" . $sechost . ":" . $secadminport; 
        my $updateURL = "/ca/agent/ca/updateDomainXML";   

        if ($token_pwd eq "") {
            my $pwfile = $pki_instance_path . "/conf/password.conf";
            if (-r $pwfile) {
                open(DAT, $pwfile) or die "Could not open password.conf file to read token password.";
                my @pw_data=<DAT>;
                foreach my $line (@pw_data) {
                    chomp($line);
                    if (($typeval eq "CA")   ||
                        ($typeval eq "KRA")  ||
                        ($typeval eq "OCSP") ||
                        ($typeval eq "TKS")) {
                        (my $varname, my $valname) = split(/=/, $line);
                        if ($varname eq "hardware-$token_name") { $token_pwd = $valname; }
                        if ($varname eq "$token_name") { $token_pwd = $valname; }
                    } else {  # TPS, RA
                        (my $varname, my $valname) = split(/:/, $line);
                        if ($varname eq $token_name) { $token_pwd = $valname; }
                        if ($varname eq "hardware-$token_name") { $token_pwd = $valname; }
                    }
                }
                close($pwfile);
            }
        }

        while ($token_pwd eq "") {
            $token_pwd  = prompt( "No password found for $token_name. What is the password for this token?");
        }

        my $params = "name=$pki_instance_name" .
                     "&type=$typeval" .
                     "&list=$listval" .
                     "&host=$machinename" .
                     "&sport=$sport" .
                     "&ncsport=$ncsport" .
                     "&adminsport=$adminsport" .
                     "&agentsport=$agentsport" .
                     "&operation=remove";

        #update domainXML
        my $cmd = `/usr/bin/sslget -d \"$pki_instance_path/alias\" -p \"$token_pwd\" -v -n \"$subsystemnick\" -r \"$updateURL\" -e \"$params\" $sechost:$secagentport 2>&1`;
        $cmd =~ /\<Status\>(.*?)\<\/Status\>/;
        $cmd = $1;

        die ("Security Domain returns non-zero status for updateDomainXML.") if ($cmd ne "0");
   } 
}

sub remove_fcontext
{
    my ($fcontext, $fname, $ftype, $cmd_ref) = @_;
    emit(sprintf("remove_fcontext(%s)\n", join(", ", @_)), "debug");

    my $tmp = `$semanage fcontext -l -C |grep $fcontext |grep $fname |wc -l`;
    chomp $tmp;
    if ($tmp eq "0" ) {
        emit("File context $fcontext for $fname defined in policy, not deleted", "debug");
        return 0;
    } 

    if ($ftype eq "f") {
        $$cmd_ref .= "fcontext -d -t $fcontext -f -- $fname\n";
    } else {
        $$cmd_ref .= "fcontext -d -t $fcontext $fname\n";
    }
}

sub get_selinux_fcontexts
{
    my ($cmd_ref) = @_;
    my $setype                = "pki_" . $subsystem_type;
    my $default_instance_name = "pki-" . $subsystem_type;
    my $default_instance_root = "/var/lib";
    my $default_log_path      = "/var/log/" . $default_instance_name;
    my $default_conf_path     = "/etc/" . $default_instance_name;

    my $log_path              = "$pki_instance_path/logs";
    my $conf_path             = "$pki_instance_path/conf";
    my $ftype;
    my $java_component        = 0;

    if (($subsystem_type eq $CA)   ||
        ($subsystem_type eq $KRA)  ||
        ($subsystem_type eq $OCSP) ||
        ($subsystem_type eq $TKS)) {
        $java_component=1;
    }

    if (-l $log_path) {
        $log_path = readlink $log_path;
    };
 
    if (-l $conf_path) {
        $conf_path = readlink $conf_path;
    };

    # For backwards compatibility, support removal of instances
    # which use the legacy start/stop implementation
    if (entity_exists("$default_initscripts_path/$pki_instance_name")) {
        # remove context for "$default_initscripts_path/$pki_instance_name"
        if ($pki_instance_name ne $default_instance_name) {
            remove_fcontext($setype . "_script_exec_t", 
                              "/etc/rc\\.d/init\\.d/$pki_instance_name", "f", $cmd_ref);
        }
    }

    # remove context for $pki_instance_root/$pki_instance_name
    if (($pki_instance_name ne $default_instance_name) || ($pki_instance_root ne $default_instance_root)) {
        remove_fcontext($setype . "_var_lib_t", 
            "\"$pki_instance_root/$pki_instance_name(/.*)?\"", "a", $cmd_ref);
        if (! $java_component) {
            remove_fcontext($setype . "_exec_t",
                "\"${pki_instance_root}/{$pki_instance_name}/${pki_instance_name}\"", "a", $cmd_ref);
        }
    }

    # remove context for /var/run/$pki_instance_name.pid
    if (($java_component) && ($pki_instance_name ne $default_instance_name)) {
        remove_fcontext($setype . "_var_run_t", 
            "/var/run/$pki_instance_name" . '.pid', "f", $cmd_ref);
    }

    # remove context for $log_path
    if ($log_path ne $default_log_path) {
        remove_fcontext($setype . "_log_t",
            "\"$log_path(/.*)?\"", "a", $cmd_ref); 
    }

    # remove context for $conf_path
    if ($conf_path ne $default_conf_path) {
         remove_fcontext($setype . "_etc_rw_t",
             "\"$conf_path(/.*)?\"", "a", $cmd_ref);
    }

}


sub get_selinux_ports
{
    my ($cmd_ref) = @_;
    my $status;
    my $semanage = "/usr/sbin/semanage";
    my $secure_port;
    my $non_clientauth_secure_port;
    my $unsecure_port;
    my @ports = ();

    get_cs_cfg($conf_file, {"service.securePort"                => \$secure_port,
                            "service.non_clientauth_securePort" => \$non_clientauth_secure_port,
                            "service.unsecurePort"              => \$unsecure_port});

    if (($subsystem_type eq $CA)   ||
        ($subsystem_type eq $KRA)  ||
        ($subsystem_type eq $OCSP) ||
        ($subsystem_type eq $TKS)) {
        use XML::LibXML;
        my $parser = XML::LibXML->new();
        my $config = $parser->parse_file($pki_instance_path . "/conf/server.xml") 
            or die "Could not read XML from server.xml to determine ports.";
        
        my $root = $config->getDocumentElement;

        my $i = 0;
        foreach my $port ($root->findnodes('//@port')) {
            $ports[$i] = $port->getValue();
            $i++;
        }
    } else {  # TPS, RA
        my $i =0;
        if (defined $secure_port) {
            $ports[$i] = $secure_port;
            $i++;
        }
        if (defined $non_clientauth_secure_port) {
            $ports[$i] = $non_clientauth_secure_port;
            $i++;
        }
        if (defined $unsecure_port) {
            $ports[$i] = $unsecure_port;
            $i++;
        }
    }  

    print(STDOUT "\n");
    foreach my $port (@ports) {
        my $setype = "pki_" . $subsystem_type . "_port_t";
        my $tmp = `$semanage port -l -C |grep $setype |grep $port | wc -l`;
        chomp $tmp;
        if ($tmp eq "0") {
            emit("Port context $setype for $port defined in policy, not deleting", "debug");        
        } else {
            $$cmd_ref .= "port -d -t $setype -ptcp $port\n";
        }
    }
}


# Return 1 if success, 0 if failure
sub remove_instance
{
    my ($result, $confirm, $install_info);
    $confirm = "Y";
    $result = 1;

    print(STDOUT "PKI instance Deletion Utility cleaning up instance ...\n\n");

ASK_AGAIN:
    if (!$force) {
        $confirm  = prompt("You have elected to remove the instance "
                          . "installed in $pki_instance_path.\n"
                          . "Are you sure (Y/N)? ");
    }

    if ($confirm eq "N" || $confirm eq "n") {
       return 1;
    } elsif ($confirm ne "Y" && $confirm ne "y") {
       goto ASK_AGAIN;
    }

    $install_info = read_install_info_from_dir($pki_instance_path);
    if (!defined($install_info)) {
        emit("Can't remove instance, installation manifest does not exist!", "error");
        return $result;
    }

    eval { update_domain(); } if !$dry_run; # FIXME so update_domain shows what it would do
    warn "Error updating security domain: " . $@ if $@;

    if (($^O eq "linux") && (is_Fedora() || (is_RHEL() && (! is_RHEL4())))) {
        my $semanage_cmds = "";

        eval { get_selinux_ports(\$semanage_cmds); };
        warn "Error getting selinux ports: " . $@ if $@; 

        eval { get_selinux_fcontexts(\$semanage_cmds); };
        warn "Error getting selinux file contexts: " . $@ if $@;

        print STDOUT "Removing selinux contexts\n";
        if ($semanage_cmds ne "") {
            emit("Executing selinux commands in batch mode.\n", "debug");
            if (! $dry_run) {
                if (! run_command("$semanage -S targeted -i - " . '<< _EOF' . "\n$semanage_cmds\n" . '_EOF' . "\n")) {
                    emit("Error executing selinux batch commands\n", "error");
                }
            }
        } else {
            emit("No selinux contexts need to be removed.  No need to run semanage. \n");
        } 
    }

    $pki_registry_initscript = get_registry_initscript_name($subsystem_type);

    # Shutdown this instance
    if ($^O eq "linux") {
        if ($use_systemd) {
            $pki_instance_systemd_service_name =
                "${pki_registry_initscript}\@${pki_instance_name}.service";
            $pki_registry_initscript_command = 
                "/bin/systemctl stop $pki_instance_systemd_service_name";
        } else {
            if (entity_exists("$default_initscripts_path/$pki_instance_name")) {
                $pki_registry_initscript_command = "/sbin/service $pki_instance_name stop";
            } else {
                $pki_registry_initscript_command = 
                    "/sbin/service $pki_registry_initscript stop $pki_instance_name";
            }
        }
    } else {
        emit("Unsupported platform '$^O'!\n", "error");
        exit 255;
    }
    run_command($pki_registry_initscript_command);

    if (!$use_systemd) {
        # De-register this instance with "chkconfig"
        if ($^O eq "linux") {
            if (entity_exists("$default_initscripts_path/$pki_instance_name")) {
                # De-register this instance with '/sbin/chkconfig'
                print(STDOUT "Removing '$pki_instance_name' from chkconfig.\n");
                deregister_pki_instance_with_chkconfig($pki_instance_name);
            }
        }
    }

    print(STDOUT "\n");

    # Remove all installed files and directories.
    $result = 0 if !uninstall($install_info);

    if ($use_systemd) {
        run_command("/bin/systemctl --system daemon-reload");
    }

    print(STDOUT "\n");

    return $result;
}


##############################################################
# Main Program
##############################################################

# no args
# return 1 - success, or
# return 0 - failure
sub main
{
    chdir("/tmp");

    my $result = 0;

    print(STDOUT "PKI instance Deletion Utility ...\n\n");

    # On Linux/UNIX, insure that this script is being run as "root".
    $result = check_for_root_UID();
    if (!$result) {
        usage();
        exit 255;
    }

    # Check for a valid number of command-line arguments.
    if ($ARGS < 2) {
        emit("$0:  Insufficient arguments!", "error");
        usage();
        exit 255;
    }

    # Parse command-line arguments.
    $result = GetOptions("pki_instance_root=s" => \$pki_instance_root,
                         "pki_instance_name=s" => \$pki_instance_name,
                         "token_pwd=s"         => \$token_pwd,
                         "verbose+"            => \$verbose,
                         "dry_run"             => \$dry_run,
                         "force"               => \$force);

    # Always disallow root to be the pki_instance_root.
    if ($pki_instance_root eq "/") {
        emit("$0:  Don't even think about making root "
             . "the pki_instance_root!", "error");
        usage();
        exit 255;
    }

    $pki_instance_root = normalize_path($pki_instance_root);

    # Check for valid content of command-line arguments.
    if (!$pki_instance_root) {
        emit("$0:  Must have value for -pki_instance_root!", "error");
        usage();
        exit 255;
    }

    if (!$pki_instance_name) {
        emit("$0:  The instance ID of the PKI instance "
             . "to be removed is required!", "error");
        usage();
        exit 255;
    }

    $pki_instance_path = "${pki_instance_root}/${pki_instance_name}";

    if (!directory_exists($pki_instance_path)) {
        emit("$0:  Target directory $pki_instance_path "
             . "is not a legal directory.", "error");
        usage();
        exit 255;
    }

    # Capture uninstall information in a log file, always overwrite this file.
    # When removing an instance it's never a fatal error if the logfile
    # cannot be created.
    my $logfile = "/var/log/${pki_instance_name}-uninstall.log"; 
    open_logfile($logfile, $default_file_permissions);

    emit("Capturing installation information in $logfile.\n");

    if ($verbose) {
        emit("    verbose mode ENABLED (level=$verbose)\n");
    }

    if ($dry_run) {
        emit("    dry run mode ENABLED, system will not be modified, log to $logfile\n");
        print STDOUT "dry run mode ENABLED, system will not be modified\n";
    }

    emit("    pki_instance_root   $pki_instance_root\n");
    emit("    pki_instance_name   $pki_instance_name\n");
    emit("    pki_instance_path   $pki_instance_path\n");

    $conf_file = $pki_instance_path . "/conf/CS.cfg";
    $subsystem_type = get_cs_cfg($conf_file, "cs.type");
    if (!defined($subsystem_type)) {
        emit("Could not determine the subsystem type from the file \"$conf_file\"\n", "error");
        exit 1;
    }
    $subsystem_type =  lc($subsystem_type);

    # Remove the specified instance
    $result = remove_instance();
    if ($result != 1) {
        exit 255;
    }

    # Establish PKI subsystem-level registry
    $pki_registry_subsystem_path = "$pki_registry_path/$subsystem_type";

    # If empty, remove the PKI subsystem-level registry
    if (directory_exists($pki_registry_subsystem_path)) {
        if (is_directory_empty($pki_registry_subsystem_path)) {
            remove_directory($pki_registry_subsystem_path);
        }
    }

    # If empty, remove the PKI-level registry
    if (directory_exists($pki_registry_path)) {
        if (is_directory_empty($pki_registry_path)) {
            remove_directory($pki_registry_path);
        }
    }

    if ($dry_run) {
        print STDOUT "dry run mode ENABLED, system was not modified\n";
    }

    return $result;
}


##############################################################
# PKI Instance Removal
##############################################################

main();

exit 0;