An small viewer for X509v3 Certificates as they are used by [SSL]. It is an example how to use the [ASN].1 BER/DER decoder package from [Tcllib]. The code is far from complete and the OID to name maps are especially incomplete. This code parses only a subset of the Certificates specified in [RFC] 3280. # # X.509v3 Certificate Viewer # # (c) 2004 Michael Schlenker # # 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 " $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 " $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 => $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 $asndata Usage: 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 use asn::asnGetContext asnblock context asn::asnGetInteger asnblock version ---- !!!!!! %| [Category Example] | [Category Security] | [Category File] |% !!!!!!