On Thu, 24 Feb 2000, Mike Hoegeman wrote:
> Andy Moskoff wrote:
>
> andy, you rule. send me a copy..
>
> -mike
>
Sure. Its attached. Remember -- its still pretty basic and may
have some bugs (in fact, it probably does). The only thing I ask
is that you send me any changes you make (diff -c or the whole
thing). I decided to keep the tcl code very basic as I didn't
know what version people were building their expectk with.
---------------------------------------------------------------------------
Andy Moskoff e-mail: [EMAIL PROTECTED]
Senior Software Engineer
Symark Software
-----BEGIN GEEK CODE BLOCK-----
Version: 3.12
GCS d- s: a+ C UL+++ P++ L++ E--- W N++ o-- K- w---
O- M- V- PS PE Y PGP- t++ 5- X+ R- tv b+ DI++ D
G-- e++ h+ r y+
------END GEEK CODE BLOCK------
#!/bin/sh
#\
exec expectk -f "$0" ${1+"$@"}
# Copyright (c) 2000 Symark Software. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in
# the documentation and/or other materials provided with the
# distribution.
#
# 3. All advertising materials mentioning features or use of this
# software must display the following acknowledgment:
# "This product includes software developed by Symark Software
# for use in the OpenSSL Toolkit. (http://www.symark.com/)"
#
# 4. Redistributions of any form whatsoever must retain the following
# acknowledgment:
# "This product includes software developed by Symark Software
# for use in the OpenSSL Toolkit (http://www.symark.com/)"
#
# THIS SOFTWARE IS PROVIDED BY SYMARK SOFTWARE ``AS IS'' AND ANY
# EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL SYMARK SOFTWARE OR
# ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
# OF THE POSSIBILITY OF SUCH DAMAGE.
#
# Show error to user
#
proc showerror { msg reason } {
catch {destroy .dialog}
tk_dialog .dialog "Certificate Utility Error" \
"$msg: \n$reason" error 0 OK
}
#
# Show informational message
#
proc showinfo { msg } {
catch {destroy .dialog}
tk_dialog .dialog "Certificate Utility Message" $msg info 0 OK
}
#
# Procedure to create panel for new certificate requests
#
proc newreq { w m } {
global tkca_newreq
global tkca
# Set the following values then generate the request
# Country Name (2 letter code) [AU]:
# State or Province Name (full name) [Some-State]:
# Locality Name (eg, city) []:
# Organization Name (eg, company) [Internet Widgits Pty Ltd]:
# Organizational Unit Name (eg, section) []:
# Common Name (eg, YOUR name) []:
# Email Address []:
# Remove existing window if any...
catch "destroy [winfo children $w]"
catch "destroy [winfo children $m]"
# Enable Pass Phrase Option
.main.menubar.options.menu entryconfigure 0 -state normal
set tkca(passphrase) 1
# Set defaults
set tkca(title) "Generate a Certificate Request"
set tkca_newreq(cc) US
set tkca_newreq(st) California
set tkca_newreq(ln) "Westlake Village"
set tkca_newreq(org) "Symark Software"
set tkca_newreq(ou) Engineering
set tkca_newreq(cn) Symark
set tkca_newreq(email) [EMAIL PROTECTED]
set tkca_newreq(passphrase) {}
set tkca_newreq(newreq) newreq.pem
set tkca_newreq(days) 10
# New request panel
label $w.l_cc -text "Country Code"
entry $w.e_cc -width 3 -textvariable tkca_newreq(cc)
label $w.l_st -text "State or Province Name"
entry $w.e_st -width 25 -textvariable tkca_newreq(st)
label $w.l_ln -text "Locality Name"
entry $w.e_ln -width 25 -textvariable tkca_newreq(ln)
label $w.l_org -text "Organization Name"
entry $w.e_org -width 25 -textvariable tkca_newreq(org)
label $w.l_ou -text "Organization Unit"
entry $w.e_ou -width 25 -textvariable tkca_newreq(ou)
label $w.l_cn -text "Common Name"
entry $w.e_cn -width 25 -textvariable tkca_newreq(cn)
label $w.l_email -text "Email Address"
entry $w.e_email -width 25 -textvariable tkca_newreq(email)
label $w.l_pass -text "Pass Phrase"
entry $w.e_pass -width 20 -show "#" -textvariable tkca_newreq(passphrase)
label $w.l_newreq -text "Put certificate request in"
entry $w.e_newreq -width 35 -textvariable tkca_newreq(newreq)
label $w.l_days -text "No. of days certificate valid"
entry $w.e_days -width 4 -textvariable tkca_newreq(days)
button $m.ok -text "OK" -default active -command mknewreq
pack $m.ok -pady 5
grid $w.l_cc $w.e_cc -sticky w
grid $w.l_st $w.e_st -sticky w
grid $w.l_ln $w.e_ln -sticky w
grid $w.l_org $w.e_org -sticky w
grid $w.l_ou $w.e_ou -sticky w
grid $w.l_cn $w.e_cn -sticky w
grid $w.l_email $w.e_email -sticky w
grid $w.l_pass $w.e_pass -sticky w
grid $w.l_newreq $w.e_newreq -sticky w
grid $w.l_days $w.e_days -sticky w
}
#
# Procedure to make new certificate request
#
proc mknewreq { args } {
global tkca
global tkca_newreq
# Don't use the pass phrase if specified
if { $tkca(passphrase) == 0 } {
if [catch {
spawn $tkca(openssldir)/openssl req -new -nodes -keyout \
$tkca_newreq(newreq) -out $tkca_newreq(newreq) \
-days $tkca_newreq(days)
} reason] {
showerror "Failed to create new certificate" $reason
return
}
} else {
if [catch {
spawn $tkca(openssldir)/openssl req -new -keyout \
$tkca_newreq(newreq) -out $tkca_newreq(newreq) \
-days $tkca_newreq(days)
} reason] {
showerror "Failed to create new certificate" $reason
return
}
# Supply a pass phrase
expect "Enter PEM pass phrase"
exp_send "$tkca_newreq(passphrase)\r"
expect "Verifying password - Enter PEM pass phrase"
exp_send "$tkca_newreq(passphrase)\r"
}
expect "Country Name"
exp_send "$tkca_newreq(cc)\r"
expect "State or Province Name"
exp_send "$tkca_newreq(st)\r"
expect "Locality Name"
exp_send "$tkca_newreq(ln)\r"
expect "Organization Name"
exp_send "$tkca_newreq(org)\r"
expect "Organizational Unit Name"
exp_send "$tkca_newreq(ou)\r"
expect "Common Name"
exp_send "$tkca_newreq(cn)\r"
expect "Email Address"
exp_send "$tkca_newreq(email)\r"
exp_send "\r"
expect "challenge password"
exp_send "\r"
expect "optional company name"
exp_send "\r"
showinfo "Certificate Sign Request Created"
}
#
# Procedure to create panel for new certificate authority
#
proc newca { w m } {
global tkca_newca
global tkca
# Set the following values then generate the CA
# Country Name (2 letter code) [AU]:
# State or Province Name (full name) [Some-State]:
# Locality Name (eg, city) []:
# Organization Name (eg, company) [Internet Widgits Pty Ltd]:
# Organizational Unit Name (eg, section) []:
# Common Name (eg, YOUR name) []:
# Email Address []:
# Remove existing window if any...
catch "destroy [winfo children $w]"
catch "destroy [winfo children $m]"
# Disable Pass Phrase Option
.main.menubar.options.menu entryconfigure 0 -state disabled
set tkca(passphrase) 1
# Set defaults
set tkca(title) "Create a Certificate Authority"
set tkca_newca(cc) US
set tkca_newca(st) California
set tkca_newca(ln) "Westlake Village"
set tkca_newca(org) "Symark Software"
set tkca_newca(ou) Engineering
set tkca_newca(cn) Symark
set tkca_newca(email) [EMAIL PROTECTED]
set tkca_newca(cadir) [pwd]/demoCA
set tkca_newca(days) 180
set tkca_newca(passphrase) {}
set tkca_newca(certs) $tkca_newca(cadir)/certs
set tkca_newca(crl) $tkca_newca(cadir)/crl
set tkca_newca(newcerts) $tkca_newca(cadir)/newcerts
set tkca_newca(private) $tkca_newca(cadir)/private
set tkca_newca(serial) $tkca_newca(cadir)/serial
set tkca_newca(index) $tkca_newca(cadir)/index.txt
set tkca_newca(certfile) $tkca_newca(cadir)/cacert.pem
set tkca_newca(keyfile) $tkca_newca(cadir)/private/cakey.pem
# Panel to generate CA
label $w.l_cc -text "Country Code"
entry $w.e_cc -width 3 -textvariable tkca_newca(cc)
label $w.l_st -text "State or Province Name"
entry $w.e_st -width 25 -textvariable tkca_newca(st)
label $w.l_ln -text "Locality Name"
entry $w.e_ln -width 25 -textvariable tkca_newca(ln)
label $w.l_org -text "Organization Name"
entry $w.e_org -width 25 -textvariable tkca_newca(org)
label $w.l_ou -text "Organization Unit"
entry $w.e_ou -width 25 -textvariable tkca_newca(ou)
label $w.l_cn -text "Common Name"
entry $w.e_cn -width 25 -textvariable tkca_newca(cn)
label $w.l_email -text "Email Address"
entry $w.e_email -width 25 -textvariable tkca_newca(email)
label $w.l_pass -text "Pass Phrase"
entry $w.e_pass -width 20 -show "#" -textvariable tkca_newca(passphrase)
label $w.l_cadir -text "CA directory"
entry $w.e_cadir -width 35 -textvariable tkca_newca(cadir)
label $w.l_days -text "No. of days certificate valid"
entry $w.e_days -width 4 -textvariable tkca_newca(days)
button $m.ok -text "OK" -default active -command mknewca
pack $m.ok -pady 5
grid $w.l_cc $w.e_cc -sticky w
grid $w.l_st $w.e_st -sticky w
grid $w.l_ln $w.e_ln -sticky w
grid $w.l_org $w.e_org -sticky w
grid $w.l_ou $w.e_ou -sticky w
grid $w.l_cn $w.e_cn -sticky w
grid $w.l_email $w.e_email -sticky w
grid $w.l_pass $w.e_pass -sticky w
grid $w.l_cadir $w.e_cadir -sticky w
grid $w.l_days $w.e_days -sticky w
}
#
# Procedure to create panel to make a certificate authority
#
proc mknewca { args } {
global tkca
global tkca_newca
# Make directory hierarchy
file mkdir $tkca_newca(cadir)
file mkdir $tkca_newca(certs)
file mkdir $tkca_newca(crl)
file mkdir $tkca_newca(newcerts)
file mkdir $tkca_newca(private)
exec echo "01" > $tkca_newca(serial)
exec touch $tkca_newca(index)
if [catch {
spawn $tkca(openssldir)/openssl req -new -x509 -keyout \
$tkca_newca(keyfile) -out $tkca_newca(certfile) \
-days $tkca_newca(days)
} reason] {
showerror "Failed to create certificate authority" $reason
return
}
expect "Enter PEM pass phrase"
exp_send "$tkca_newca(passphrase)\r"
expect "Verifying password - Enter PEM pass phrase"
exp_send "$tkca_newca(passphrase)\r"
expect "Country Name"
exp_send "$tkca_newca(cc)\r"
expect "State or Province Name"
exp_send "$tkca_newca(st)\r"
expect "Locality Name"
exp_send "$tkca_newca(ln)\r"
expect "Organization Name"
exp_send "$tkca_newca(org)\r"
expect "Organizational Unit Name"
exp_send "$tkca_newca(ou)\r"
expect "Common Name"
exp_send "$tkca_newca(cn)\r"
expect "Email Address"
exp_send "$tkca_newca(email)\r"
exp_send "\r"
showinfo "Certificate Authority Created"
}
#
# Procedure to create panel for signing a certificate
#
proc sign { w m } {
global tkca_sign
global tkca
# Remove existing window if any...
catch "destroy [winfo children $w]"
catch "destroy [winfo children $m]"
# Set defaults
set tkca(title) "Sign a Certificate Request"
set tkca_sign(req) newreq.pem
set tkca_sign(sign) newcert.pem
# Sign certificate panel
label $w.l_req -text "Get certificate request in"
entry $w.e_req -width 35 -textvariable tkca_sign(req)
label $w.l_sign -text "Put signed certificate in"
entry $w.e_sign -width 35 -textvariable tkca_sign(sign)
label $w.l_pass -text "CA pass phrase"
entry $w.e_pass -width 20 -show "#" -textvariable tkca_sign(passphrase)
button $m.ok -text "OK" -default active -command mksign
pack $m.ok -pady 5
grid $w.l_req $w.e_req -sticky w
grid $w.l_sign $w.e_sign -sticky w
grid $w.l_pass $w.e_pass -sticky w
}
#
# Procedure to create panel for revoking a certificate
#
proc revoke { w m } {
global tkca_revoke
global tkca
# Remove existing window if any...
catch "destroy [winfo children $w]"
catch "destroy [winfo children $m]"
# Set defaults
set tkca(title) "Revoke a Certificate"
set tkca_revoke(certf) newcert.pem
set tkca_revoke(serialno) {}
set tkca_revoke(passphrase) {}
# Sign certificate panel
label $w.l_certf -text "Certificate File"
entry $w.e_certf -width 25 -textvariable tkca_revoke(certf)
#label $w.l_or -text " or "
#label $w.l_serialno -text "Serial Number"
#entry $w.e_serialno -width 20 -textvariable tkca_revoke(serialno)
label $w.l_pass -text "CA pass phrase"
entry $w.e_pass -width 20 -show "#" -textvariable tkca_revoke(passphrase)
button $m.ok -text "OK" -default active -command mkrevoke
pack $m.ok -pady 5
grid $w.l_certf $w.e_certf -sticky w
#grid $w.l_serialno $w.e_serialno -sticky w
grid $w.l_pass $w.e_pass -sticky w
}
#
# Procedure to revoke a certificate
#
proc mkrevoke { args } {
global tkca_revoke
global tkca
if [catch {
spawn $tkca(openssldir)/openssl ca -revoke $tkca_revoke(certf)
} reason] {
showerror "Failed to revoke certificate" $reason
return
}
expect "Enter PEM pass phrase"
exp_send "$tkca_revoke(passphrase)\r"
expect "Data Base Updated"
exp_send "\r"
}
#
# Procedure to sign a certificate
#
proc mksign { args } {
global tkca
global tkca_sign
if [catch {
spawn $tkca(openssldir)/openssl ca -policy policy_anything \
-out $tkca_sign(sign) -infiles $tkca_sign(req)
} reason] {
showerror "Failed to sign certificate" $reason
return
}
expect "Enter PEM pass phrase"
exp_send "$tkca_sign(passphrase)\r"
expect "Sign the certificate?"
exp_send "y\r"
expect "certificate requests certified"
exp_send "y\r"
expect "Data Base Updated"
exp_send "\r"
showinfo "Certificate Request Signed"
}
#
# Procedure to show the active CA's database (index.txt)
#
proc show_db { args } {
}
#
# Hash a Certificate. NOTE: This is used to generate a hash value
# so that the CA certificate can be located by directory path rather
# than only by a file path. Typically, the hash value is linked to the
# certificate file in the certificate directory.
#
proc certhash { w m } {
global tkca_hash
global tkca
# Remove existing window if any...
catch "destroy [winfo children $w]"
catch "destroy [winfo children $m]"
# Set defaults
set tkca(title) "Generate Certificate Hash Value"
set tkca_hash(certf) newcert.pem
set tkca_hash(link) {}
# Hash certificate panel
label $w.l_certf -text "Certificate file path"
entry $w.e_certf -width 35 -textvariable tkca_hash(certf)
label $w.l_link -text "Link directory path"
entry $w.e_link -width 35 -textvariable tkca_hash(link)
button $m.ok -text "OK" -default active -command mkcerthash
pack $m.ok -pady 5
grid $w.l_certf $w.e_certf -sticky w
grid $w.l_link $w.e_link -sticky w
}
#
# Procedure to sign a certificate. NOTE: This procedure works only for
# self-signed certificates, i.e., a root certicate authority.
#
proc mkcerthash { args } {
global tkca
global tkca_hash
if [catch {
exec $tkca(openssldir)/openssl x509 -noout -hash < $tkca_hash(certf)
} hashvalue] {
showerror "Failed to hash certificate file" $hashvalue
return
}
# Set the serial number. From Richard Levitte (OpenSSL developer):
# The file name has to be in the format {hash}.{s/n}, where {s/n} is the
# certificate serial number. Most often, that is simply 0. I haven't
# quite understood yet how it would ever get any other number there, at
# least automagically...
set sn 0
# Check if file already exists
if {![file exists $tkca_hash(link)/$hashvalue.$sn]} {
# Make the link
if [catch {
exec ln -s $tkca_hash(certf) $tkca_hash(link)/$hashvalue.$sn
} reason] {
showerror "Cannot make symbolic link" $reason
return
}
showinfo "Certificate Hash Created"
} else {
showerror "Certificate Already Hashed And Linked" \
$tkca_hash(link)/$hashvalue.$sn
}
}
#
# View panel
#
proc view { w m } {
global tkca_view
global tkca
# Remove existing window if any...
catch "destroy [winfo children $w]"
catch "destroy [winfo children $m]"
# Set defaults
set tkca(title) "View Certificate"
set tkca_view(certf) newcert.pem
# Hash certificate panel
label $w.l_certf -text "Certificate file path"
entry $w.e_certf -width 35 -textvariable tkca_view(certf)
button $m.ok -text "OK" -default active -command {mkview .view}
pack $m.ok -pady 5
grid $w.l_certf $w.e_certf -sticky w
}
proc mkview { w } {
global tkca
global tkca_view
# Check if file exists
if {![file exists $tkca_view(certf)]} {
showerror "Certificate file does not exist" $tkca_view(certf)
return
}
# Get data from file
if [catch {
exec $tkca(openssldir)/openssl x509 -noout -text -in $tkca_view(certf)
} data] {
showerror "Failed to read certificate file" $data
return
}
catch "destroy $w"
toplevel $w
wm title $w "X.509 Certificate in $tkca_view(certf)"
text $w.text -width 80 -height 24 -yscroll "$w.yscroll set" \
-xscroll "$w.xscroll set"
scrollbar $w.yscroll -command "$w.text yview" -orient vertical
scrollbar $w.xscroll -command "$w.text xview" -orient horizontal
grid $w.text $w.yscroll -sticky news
grid $w.xscroll -sticky ew
grid rowconfigure $w 0 -weight 1
grid columnconfigure $w 0 -weight 1
$w.text insert 0.0 $data
$w.text configure -state disabled
}
#
# Main
#
proc main { args } {
global tcl_platform
global auto_path
global tkca_newca
global tkca
global env
lappend auto_path .
# Don't map window to screen yet
wm withdraw .
# Initialize local values
log_user 0
set env(OPENSSL_CONF) /usr/local/src/openssl-0.9.4/apps/openssl.cnf
append env(PATH) :/usr/local/src/openssl-0.9.4/apps
set tkca(openssldir) /usr/local/src/openssl-0.9.4/apps
# Create the main menu
frame .main -relief groove -borderwidth 1
pack .main -side top -fill both -expand true
# Create a menubar
frame .main.menubar -relief groove -borderwidth 1
pack .main.menubar -side top -fill x
# Create a title
label .main.title -textvariable tkca(title) -relief groove -borderwidth 1
pack .main.title -side top -fill x
# Create a form area
frame .main.form -relief groove -borderwidth 1
pack .main.form -side top -fill both -expand true
# Create button action area
frame .main.actions -relief groove -borderwidth 1
pack .main.actions -side bottom -fill x
# Create "File" pulldown
menubutton .main.menubar.file -text "File" -menu .main.menubar.file.menu -under 0
menu .main.menubar.file.menu -tearoff 0
pack .main.menubar.file -side left -fill x
# Create "Options" pulldown
menubutton .main.menubar.options -text "Options" -menu .main.menubar.options.menu
-under 0
menu .main.menubar.options.menu -tearoff 0
pack .main.menubar.options -side left -fill x
# Create "Help" pulldown
menubutton .main.menubar.help -text "Help" -menu .main.menubar.help.menu -under 0
menu .main.menubar.help.menu -tearoff 0
pack .main.menubar.help -side right -fill x
# Add items to "File" pulldown menu
.main.menubar.file.menu add command -label "New CA" -under 0 \
-command {newca .main.form .main.actions}
.main.menubar.file.menu add command -label "New Request" -under 6 \
-command {newreq .main.form .main.actions}
.main.menubar.file.menu add command -label "Sign Request" -under 0 \
-command {sign .main.form .main.actions}
.main.menubar.file.menu add command -label "Revoke Certificate" -under 2 \
-command {revoke .main.form .main.actions}
.main.menubar.file.menu add command -label "Hash Certificate" -under 0 \
-command {certhash .main.form .main.actions}
.main.menubar.file.menu add command -label "View Certificate" -under 0 \
-command {view .main.form .main.actions}
.main.menubar.file.menu add command -label "Show CA Database" -under 8 \
-command {show_db}
.main.menubar.file.menu add separator
.main.menubar.file.menu add command -label "Exit" -under 0 -command {destroy .}
# Add items to "Options" pulldown menu
set tkca(passphrase) 1
.main.menubar.options.menu add checkbutton -label "Use Pass Phrase" \
-variable tkca(passphrase) -onvalue 1 -offvalue 0 -under 0
# Add items to "Help" pulldown menu
.main.menubar.help.menu add command -label "Concepts..." -under 0
.main.menubar.help.menu add command -label "Reference..." -under 6
# Map main window
wm deiconify .
raise .
focus -force .
wm geometry . 450x350+50+50
wm title . "Certificate Authority Utility"
}
main
