Upload Local Certificates and Keys

Problem this snippet solves:

An script that uploads to a BIG-IP certificates and keys stored locally in PEM file format.

Code :

#!/usr/bin/perl
#----------------------------------------------------------------------------
# The contents of this file are subject to the iControl Public License
# Version 4.5 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.f5.com/.
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
# the License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is iControl Code and related documentation
# distributed by F5.
#
# The Initial Developer of the Original Code is F5 Networks,
# Inc. Seattle, WA, USA. Portions created by F5 are Copyright (C) 1996-2010 F5 Networks,
# Inc. All Rights Reserved.  iControl (TM) is a registered trademark of F5 Networks, Inc.
#
# Alternatively, the contents of this file may be used under the terms
# of the GNU General Public License (the "GPL"), in which case the
# provisions of GPL are applicable instead of those above.  If you wish
# to allow use of your version of this file only under the terms of the
# GPL and not to allow others to use your version of this file under the
# License, indicate your decision by deleting the provisions above and
# replace them with the notice and other provisions required by the GPL.
# If you do not delete the provisions above, a recipient may use your
# version of this file under either the License or the GPL.
#----------------------------------------------------------------------------

use strict;
use warnings;

use SOAP::Lite;
use MIME::Base64;
use Getopt::Long;
use FileHandle;

# https://devcentral.f5.com/s/wiki/iControl.Perl-SOAP-Lite-TypeCast-package.ashx
# Must be in lib path (use PERL5LIB env or 'use lib')
#
use iControlTypeCast;


=head1 NAME

bigip_cert_upload - Upload local PEM-encoded certificate and/or key to a BIG-IP using SOAP iControl

=head1 SYNOPSIS

 bigip_cert_upload  cert:[:id]|key:[:id] [ ...]
                   [-u ] [-p ] [-m ] [--[no]overwrite]
                   [--help]

=head1 DESCRIPTION

Upload PEM encoded certificate and/or keys to a BIG-IP using iControl SOAP.  More than one
certificate and/or key may be uploaded.  The targets for upload are identified as the
literal 'cert:' or 'key:' followed by the file name.  The file name may optionally be followed
by a colon (:), then the BIG-IP object identifier for the target.  If it is omitted, then the
filename is used after trimming any of ".crt", ".key", ".crt.pem", ".key.pem" or ".pem".
If a certificate and key have the same object identifier then they will be
associated on the BIG-IP.

The iControl connection is initiated against the provided I.  It assumes
https over port 443.  If no I is provided, the user B is assumed.  If no
I is provided, then you will be prompted for it (without stty echo).

The I must be one of: DEFAULT, WEBSERVER, EM, IQUERY, IQUERY_BIG3D.  These map directly
to the ManagementModeType.  See https://devcentral.f5.com/s/wiki/iControl.Management__KeyCertificate__ManagementModeType.ashx.
If no mode is provided, the mode is "DEFAULT".

If I<--overwrite> is provided, then an existing certificate and/or key on the system
matching the identifier of an uploaded certificate and/or key will be overwritten.
The default is to not overwrite.  This may be made explicit using I<--nooverwrite>.

=head1 EXAMPLE

 bigip_cert_upload 10.1.20.1 cert:www.example.com.crt cert:www.f5.com.crt:f5
                   key:www.example.com.key -p 'sUp3r.S#CRET' --overwrite

=cut

my $username  = "admin";
my $password;
my $mode      = "DEFAULT";
my $overwrite = 0;


GetOptions(
    "user:s"            => \$username,
    "passwd:s"          => \$password,
    "mode:s"            => \$mode,
    "overwrite!"        => \$overwrite,
    "help"              => \my $needs_help,
) or die Syntax();

die Syntax()                    if $needs_help;

my $bigip_mgmt_ip = shift       or die Syntax();

validate_ip( $bigip_mgmt_ip )   or die "Invalid target IP [$bigip_mgmt_ip]\n";

my @arg_targets = @ARGV         or die Syntax();

validate_mode( $mode )          or die "Invalid mode [$mode]\n";

# indexed by $target_id, values are hashref by "key" and "cert", values are value of files (that is,
# the PEM blob)
my %targets = process_targets( @arg_targets );

$password = get_password_by_prompting()   unless defined $password;


my $soap_requestor = initiate_soap_requestor( $bigip_mgmt_ip, $username, $password );

foreach my $target_id (keys %targets) {
    if (exists $targets{$target_id}{cert}) {
        eval {
            upload_certificate( $soap_requestor, $target_id, $targets{$target_id}{cert}, $mode, $overwrite )
                if exists $targets{$target_id}{cert};
        };

        if ($@) { warn "Failed to upload certificate with target id [$target_id]: $@"; }
        else    { print "Successfully uploaded certificate with target id [$target_id]\n"; }
    }

    if (exists $targets{$target_id}{key}) {
        eval {
            upload_key( $soap_requestor, $target_id, $targets{$target_id}{key}, $mode, $overwrite )
                if exists $targets{$target_id}{key};
        };

        if ($@) { warn "Failed to upload key with target id [$target_id]: $@"; }
        else    { print "Successfully uploaded key with target id [$target_id]\n"; }
    }
}


###
#  Obligatory SOAP::Lite definition for HTTP Basic Challenge.  Lamentably,
#  this means we must treate $username and $password as globals here, but such is
#  the nature of SOAP::Lite's interface
#####
sub SOAP::Transport::HTTP::Client::get_basic_credentials {
    return "$username" => "$password";
}



########
#
# $b = validate_ip( $ip );
#
# Return true if $ip is a valid IPv4 address; false otherwise
#
########
sub validate_ip {
    my $octet = qr/25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9]/o;
    return shift =~ /^($octet\.){3}$octet$/;
}


########
#
# $b = validate_mode( $mode );
#
# Return true if $mode is DEFAULT, WEBSERVER, EM, IQUERY or IQUERY_BIG3D.  Return
# false otherwise.
#
########
sub validate_mode {
    my $mode = shift;

    return $mode eq "DEFAULT" || $mode eq "WEBSERVER" || $mode eq "EM" ||
           $mode eq "IQUERY"  || $mode eq "IQUERY_BIG3D";
}


########
#
# %t = process_targets( @targets );
#
# Given a series of @targets of the format ":[:]" (where  is
# "cert" or "key",  is a filename, and I is the target identifier -- and
# is optional -- create a hash indexed by target id (which is the filename less
# a trailing token of ".pem", ".crt", ".key", ".crt.pem" or ".key.pem", if the
# target id is not explicitly specified).  The value of the hash is also a hashref
# indexed by "cert" and "key".  One or the other may be absent if there is no
# cert or key with the given target id.  The second-order value is the contents
# of the file.
#
# If the format of a member of @target is invalid or if the file named provided does
# not exist or is not readable, then die() with an appropiate error.  If the file
# contents do not contain a PEM preamble and trailer, or if it contains characters
# outside the base-64 encoding set, it will also die() with an appropriate error.
#
########
sub process_targets {
    my %targets;

    foreach my $specifier (@_) {
        if ($specifier =~ /^(cert|key):(.+?)(:([^:]+))?$/) {
            my ($type, $file, $id) = ($1, $2, $4);

            my $fh = new FileHandle $file
                or die "Failed to open file [$file] for reading: $!\n";

            my $contents = join( "", (<$fh>) );

            close $fh;

            unless ($contents =~ /^-----BEGIN (CERTIFICATE|PRIVATE KEY)-----[A-Za-z0-9=\+\/\r\n]+-----END (CERTIFICATE|PRIVATE KEY)-----$/ms) {
                die "The file [$file] does not appear to contain a valid PEM encoded $type\n";
            }

            if (!defined $id) {
                $id = $file;

                $id =~ s/\.pem$//;
                $id =~ s/(\.crt)|(\.key)$//;
            }

            $targets{$id}{$type} = $contents;
        }
        else {
            die "Target specifier [$specifier] is not properly formatted\n";
        }
    }

    return %targets;
}


########
#
# $passwd = get_password_by_prompting();
#
# Prompt for a password, disabling stty echo on input.  Generally, the stty
# suppression will only work on a standard Unix terminal.  Use Term::ReadKey
# if you want something more portable.
#
########
sub get_password_by_prompting {
    print "Enter password: ";
    system( "stty", "-echo" ) == 0
        or do {
            warn "Cannot disable terminal echo so password will be visible when typed!\n";
            print "Enter password: ";
        };

    my $password = ;
    chomp $password;

    system( "stty", "echo" ) == 0
        or die "Failed to re-enable terminal echo\n";   # probably won't actually be visible...

    return $password;
}


########
#
# $s = initiate_soap_requestor( $remote_ip, $username, $passwd );
#
# Create a SOAP::Lite request object intended to connect to $remote_ip
# using $username and $passwd as credentials, and return the object, if successful.
# On failure, die() with an appropriate error
#
########
sub initiate_soap_requestor {
    my ($remote_ip, $username, $password) = @_;

    my $soap_requestor = SOAP::Lite
      ->uri  ( "urn:iControl:Management/KeyCertificate" )
      ->proxy( "https://$remote_ip/iControl/iControlPortal.cgi" );

    eval {
        $soap_requestor->transport->http_request->header(
            'Authorization' => 'Basic ' . MIME::Base64::encode( "$username:$password", "" )
        );
    };

    die "SOAP Request Creation failure: $@\n"   if $@;

    return $soap_requestor;
}


########
#
# upload_certificate( $soap_requestor, $target_id, $pem_blob, $mode, $overwrite );
#
# Attempt to upload the $pem_blob using the certificate_import_from_pem
# iControl method, issued from the $soap_requestor.  If there is a
# failure, die(), setting $@ to an error string describing the failure.
#
########
sub upload_certificate {
    my ($soap_requestor, $target_id, $pem_blob, $mode, $overwrite) = @_;

    # we *could* upload all certificates at once, but it would be more difficult to determine
    # and report failures
    #
    my $soap_response = $soap_requestor->certificate_import_from_pem(
                            SOAP::Data->name( mode      => "MANAGEMENT_MODE_$mode"   ),
                            SOAP::Data->name( cert_ids  => [$target_id]              ),
                            SOAP::Data->name( pem_data  => [$pem_blob]               ),
                            SOAP::Data->name( overwrite => $overwrite                ),
                        );

    if ($soap_response->fault) {
        die "Failed to retrieve response: ${ \$soap_response->faultcode }: ${ \$soap_response->faultstring }\n";
    }
}



########
#
# upload_key( $soap_requestor, $target_id, $pem_blob, $mode, $overwrite );
#
# Attempt to upload the $pem_blob using the key_import_from_pem
# iControl method, issued from the $soap_requestor.  If there is a
# failure, die(), setting $@ to an error string describing the failure.
#
########
sub upload_key {
    my ($soap_requestor, $target_id, $pem_blob, $mode, $overwrite) = @_;

    my $soap_response = $soap_requestor->key_import_from_pem(
                            SOAP::Data->name( mode      => "MANAGEMENT_MODE_$mode"   ),
                            SOAP::Data->name( key_ids   => [$target_id]              ),
                            SOAP::Data->name( pem_data  => [$pem_blob]               ),
                            SOAP::Data->name( overwrite => $overwrite                ),
                        );

    if ($soap_response->fault) {
        die "Failed to retrieve response: ${ \$soap_response->faultcode }: ${ \$soap_response->faultstring }\n";
    }
}


sub Syntax {
    my $a = $0;
       $a =~ s|^.*/||;
    return "$a  cert:[:id]|key:[:id] [ ...]\n" .
           "             [-u ] [-p ] [-m ] [--[no]overwrite]\n" .
           "             [--help]\n";
}