#
# X.509v3 Certificate Viewer
#
# (c) 2004 Michael Schlenker <mic42@users.sourcerforge.net>
#
# License: like tcllib
#
#
# This implements an incomplete certificate viewer for
# X.509v3 Certificates stored in the PEM Format used by openssl.
#
#
#
package require base64
package require asn
package require textutil
#
# Some (incomplete) OID -> Name mappings from RFC 3279, 3280 and the X.500
#
#
# attribute names under OID 2.5.4.x
set attributeType {
objectClass
aliasedEntryName
knowledgeInformation
commonName
surname
serialNumber
countryName
localityName
stateOrProvinceName
streetAddress
organizationName
organizationUnitName
title
description
searchGuide
businessCategory
postalAddress
postalCode
postOfficeBox
physicalDeliveryOfficeName
telephoneNumber
telexNumber
teletexTerminalIdentifier
facsimileTelephoneNumber
x121Address
internationalISDNNumber
registeredAddress
destinationIndicator
preferredDeliveryMethod
presentationAddress
supportedApplicationContext
member
owner
roleOccupant
seeAlso
userPassword
userCertificate
cAcertificate
authorityRevocationList
certificateRevocationList
crossCertificatePair
name
givenName
initials
generationQualifier
uniqueIdentifier
dnQualifier
enhancedSearchGuide
protocolInformation
distinguishedName
uniqueMember
houseIdentifier
supportedAlgorithms
deltaRevocationList
dmdName
clearance
defaultDirQop
attributeIntegrityInfo
attributeCertificate
attributeCertificateRevocationList
confKeyInfo
aACertificate
attributeDescriptorCertificate
attributeAuthorityRevocationList
family-information
pseudonym
communicationsService
communicationsNetwork
certificationPracticeStmt
certificatePolicy
pkiPath
privPolicy
role
}
array set algorithms {
{1 2 840 113549 2} md2
{1 2 840 113549 5} md5
{1 3 14 3 2 26} sha1
{1 2 840 10040 4 1} dsa
{1 2 840 10040 4 3} dsa-with-sha1
{1 2 840 113549 1 1} "pkcs-1 oid arc"
{1 2 840 113549 1 1 1} rsa
{1 2 840 113549 1 1 2} md2-with-rsa
{1 2 840 113549 1 1 4} md5-with-rsa
{1 2 840 113549 1 1 5} sha1-with-rsa
{1 2 840 10046 2 1} Diffie-Hellman
}
#####################################################################
#
# Actual Parsing Code starts here
#
#####################################################################
proc load_cert {filename} {
set fd [open $filename]
set data [read $fd]
close $fd
set lines [split $data \n]
set hlines 0
set total 0
set headers ""
set head_banner ""
set foot_banner ""
set first 0
foreach line $lines {
incr total
if {[regexp {^-----(.*?)-----$} $line -> banner]} {
if {$first} {
set foot_banner $banner
incr total -1
break
} else {
set first 1
set head_banner $banner
incr hlines
}
}
if {[regexp {^(.*):(.*)$} $line -> tag value]} {
lappend headers [list $tag $value]
incr hlines
}
}
set block [join [lrange $lines $hlines [expr {$total-1}]]]
set asnblock [base64::decode $block]
return [list $head_banner $headers $asnblock $foot_banner]
}
proc parse_cert {asnblock} {
puts "Parsing Certificate..."
asn::asnGetSequence asnblock certificate
asn::asnGetSequence certificate TBSCertificate
parse_TBSCertificate $TBSCertificate
asn::asnGetSequence certificate AlgorithmIdentifier
parse_AlgorithmIdentifier $AlgorithmIdentifier
asn::asnGetBitString certificate Signature
set len [string length $Signature]
if {($len % 8)==0} {
binary scan [binary format B* $Signature] H* sig
puts "Signature ($len bits):"
puts [textutil::adjust $sig -strictlength 1 -length 67]"
} else {
puts "Signature ($len bits):"
puts [textutil::adjust $Signature -strictlength 1 -length 67]
}
}
proc parse_AlgorithmIdentifier {asnblock} {
asn::asnGetObjectIdentifier asnblock oid
set name [map_oid_to_name $oid]
# skipping the parameter for now
return [list $name $oid]
}
proc parse_TBSCertificate {asnblock} {
puts [string repeat - 72 ]
set check [string index $asnblock 0]
if {![catch {asn::asnGetContext check tag}]} {
asn::asnGetContext asnblock context
asn::asnGetInteger asnblock version
} else {
set version 0
}
set versionID [list v1 v2 v3]
puts [format "Certificate Version :\t%s" [lindex $versionID $version]]
# homegrown getInteger for the 20octet ints in serial number
asn::asnGetByte asnblock tag
asn::asnGetLength asnblock len
asn::asnGetBytes asnblock $len ser
binary scan $ser H* serialNumber
puts [format "Certificate Serial Number :\t%s" $serialNumber]
asn::asnGetSequence asnblock Algorithm
foreach {name oid} [parse_AlgorithmIdentifier $Algorithm] {break}
puts [format "Certificate Signature Algorithm:\t%s <urn:oid:%s>" $name [join $oid .]]
startbanner Issuer
asn::asnGetSequence asnblock Issuer
parse_RelativeDistinguishedName $Issuer
endbanner
asn::asnGetSequence asnblock Validity
parse_Validity $Validity
startbanner Subject
asn::asnGetSequence asnblock Subject
parse_RelativeDistinguishedName $Subject
endbanner
asn::asnGetSequence asnblock SubjectPublicKeyInfo
parse_SubjectPublicKeyInfo $SubjectPublicKeyInfo
while {[string length $asnblock]} {
asn::asnGetContext asnblock context
switch -exact -- $context {
0 { error "Context Tag for Version Number found in wrong place"}
1 {
puts "Issuer Unique Identifier:"
asn::asnGetBitstring asnblock IssuerUniqueIdentifier
puts $IssuerUniqueIdentifier
}
2 {
puts "Subject Unique Identifier:"
asn::asnGetBitstring asnblock SubjectUniqueIdentifier
puts $SubjectUniqueIdentifier
}
3 {
asn::asnGetSequence asnblock Extension
parse_Extension $Extension
}
}
}
}
proc parse_Extension {asnblock} {
startbanner Extension
asn::asnGetSequence asnblock extension
asn::asnGetObjectIdentifier extension oid
puts "Extension OID: $oid"
binary scan [string index $extension 0] c c
if {$c == 0x01} {
asn::asnGetBoolean extension critical
puts "Is Critical: [expr {$critical ? "yes" : "no"}]"
}
asn::asnGetOctetString extension value
puts "Extension Value:"
binary scan $value H* bin
puts $bin
endbanner
}
proc parse_SubjectPublicKeyInfo {asnblock} {
startbanner "SubjectPublicKey"
asn::asnGetSequence asnblock Algorithm
foreach {name oid} [parse_AlgorithmIdentifier $Algorithm] {break}
puts [format "PublicKey Algorithm:\t%s <urn:oid:%s>" $name [join $oid .]]
asn::asnGetBitString asnblock publicKey
set len [string length $publicKey]
if {($len % 8)==0} {
binary scan [binary format B* $publicKey] H* key
puts "Key ($len bits):"
puts [textutil::adjust $key -strictlength 1 -length 67 ]
} else {
puts "Key ($len bits):"
puts [textutil::adjust $publicKey -strictlength 1 -length 67]
}
endbanner
}
proc parse_Validity {asnblock} {
startbanner Validity
asn::asnGetUTCTime asnblock notBefore
puts "Valid not before: $notBefore"
asn::asnGetUTCTime asnblock notAfter
puts "Valid not after: $notAfter"
endbanner
}
proc parse_RelativeDistinguishedName {asnblock} {
while {[string length $asnblock]} {
asn::asnGetSet asnblock AttributeValueAssertion
asn::asnGetSequence AttributeValueAssertion valblock
asn::asnGetObjectIdentifier valblock oid
set name [map_oid_to_name $oid]
set poid [join $oid .]
set tagbyte [string index $valblock 0]
binary scan $tagbyte c* dectag
set value ""
if {$dectag == 19} {
asn::asnGetPrintableString valblock value
}
puts "$name <urn:oid:$poid> => $value"
}
}
#################################################################################
#
# Extra ASN.1 BER/DER Decoders not yet supported in tcllib asn v0.1
#
#################################################################################
proc asn::asnGetBoolean {data_var bool_var} {
upvar $data_var data $bool_var bool
asnGetByte data tag
if {$tag != 0x01} {
binary scan $tag H2 tag_hex
return -code error "Expected Boolean (0x01), but got $tag_hex"
}
asnGetLength data length
asnGetByte data byte
set bool [expr {$byte == 0 ? 0 : 1}]
}
proc asn::asnGetUTCTime {data_var utc_var} {
upvar $data_var data $utc_var utc
asnGetByte data tag
if {$tag != 0x17} {
binary scan $tag H2 tag_hex
return -code error "Expected UTCTime (0x17), but got $tag_hex"
}
asnGetLength data length
asnGetBytes data $length bytes
set bytes [encoding convertfrom ascii $bytes]
binary scan $bytes a* utc
}
proc asn::asnGetBitString {data_var bitstring_var} {
upvar $data_var data $bitstring_var bitstring
asnGetByte data tag
if {$tag != 0x03} {
binary scan $tag H2 tag_hex
return -code error "Expected Bit String (0x03), but got $tag_hex"
}
asnGetLength data length
asnGetByte data offset
incr length -1
asnGetBytes data $length bytes
binary scan $bytes B* bits
set bits [string range $bits 0 end-$offset]
set bitstring $bits
}
proc asn::asnGetObjectIdentifier {data_var oid_var} {
upvar $data_var data $oid_var oid
asnGetByte data tag
if {$tag != 0x06} {
binary scan $tag H2 tag_hex
return -code error "Expected Object Identifier (0x06), but got $tag_hex"
}
asnGetLength data length
asnGetByte data val
set oid [expr {$val / 40}]
lappend oid [expr {$val % 40}]
incr length -1
set bytes [list]
set incomplete 0
while {$length} {
asnGetByte data octet
incr length -1
if {$octet < 128} {
set oidval $octet
set mult 128
foreach byte $bytes {
if {$byte != {}} {
incr oidval [expr {$mult*$byte}]
set mult [expr {$mult*128}]
}
}
lappend oid $oidval
set bytes [list]
set incomplete 0
} else {
set byte [expr {$octet-128}]
set bytes [concat [list $byte] $bytes]
set incomplete 1
}
}
if {$incomplete} {
error "OID Data is incomplete, not enough octets."
}
}
proc ::asn::asnGetContext {data_var contextNumber_var} {
upvar $data_var data $contextNumber_var contextNumber
asnGetByte data tag
asnGetLength data length
if {($tag & 0xE0) != 0x0A0} {
binary scan $tag H2 tag_hex
return -code error "Expected Context (0xa0), but got $tag_hex"
}
set contextNumber [expr {$tag & 0x1F}]
return
}
proc ::asn::asnGetPrintableString {data_var print_var} {
upvar $data_var data $print_var print
asnGetByte data tag
if {$tag != 0x13} {
binary scan $tag H2 tag_hex
return -code error "Expected Printable String (0x13), but got $tag_hex"
}
asnGetLength data length
asnGetBytes data $length string
set print [encoding convertfrom ascii $string]
}
###########################################################################
#
# Some OID support routines
#
###########################################################################
proc is_oid_prefix {oid1 oid2} {
foreach key1 $oid1 key2 [lrange $oid2 0 [expr {[llength $oid1]-1}]] {
if {$key1 != $key2} {return 0}
if {$key1 == ""} {return 1}
}
return 1
}
proc map_oid_to_name {oid} {
global attributeType algorithms
set name "unknown OID"
if {[is_oid_prefix {2 5 4} $oid]} {
set key [lindex $oid 3]
set name [lindex $attributeType $key]
}
if {[is_oid_prefix {2 5 29 14} $oid]} {
}
if {[is_oid_prefix {1 2} $oid]} {
if {[info exists algorithms($oid)]} {
set name $algorithms($oid)
}
}
return $name
}
proc startbanner {text} {
set len [expr {(70-[string length $text])/2}]
puts "[string repeat = $len] $text \
[string repeat = [expr {69-$len-[string length $text]}]]"
}
proc endbanner {} {
puts [string repeat = 72]
}
# Main code
#
#
#
#
set file [lindex $argv 0]
puts "Loading and parsing $file"
foreach {header headers asndata footer} [load_cert $file] {break}
puts "Header: $header"
foreach h $headers {
puts "Header lines: $h"
}
puts "[string length $asndata] octets of ASN.1 Data"
puts "Footer: $footer"
puts "[string repeat - 72]"
parse_cert $asndataUsage:cert.tcl example.pem(an example .pem file can be found in the tcllib examples dir, with the smtpd examples)
SV (2006-01-19) Produces an error with 8.4.5 on WinXP (ASN 0.1 or ASN 0.5)
Loading and parsing G:\cvsroot\tcllib\examples\smtpd\server-public.pem Header: BEGIN CERTIFICATE 942 octets of ASN.1 Data Footer: END CERTIFICATE ---------------------------------------------------------------------- Parsing Certificate... ---------------------------------------------------------------------- Certificate Version : v1 Certificate Serial Number : 020102 Expected Sequence (0x30), but got 02 while executing "asn::asnGetSequence asnblock Algorithm" (procedure "parse_TBSCertificate" line 18) invoked from within "parse_TBSCertificate $TBSCertificate" (procedure "parse_cert" line 5) invoked from within "parse_cert $asndata" (file "H:\tcl_sources\X509v3_Cert_Viewer.tcl" line 493)
schlenk (2006-01-19) I don't have an 8.4.5 installed currently, but i will take a look. I'm currently updating and expanding the asn module, to make examples like this much shorter and easier.
anonymous (2006-08-30) same problem under 8.4.13 (activestate win32 tcllib 1.8)
CL observes the same symptom with Tcl 8.4.4, tcllib 1.8-1, under Debian Linux.
schlenk I hope i find the time to rewrite the example for the new tcllib release this fall, so it can be included with in the example dir.
This section breaks it.
if {![catch {asn::asnGetContext check tag}]} {
asn::asnGetContext asnblock context
asn::asnGetInteger asnblock version
} else {
set version 0
}Just useasn::asnGetContext asnblock context asn::asnGetInteger asnblock version