21.12.2020 15:16
saipr 0 1600 Источник
imageЧасто приходится слышать, что скриптовому языку Tcl не хватает поддержки объектно-ориентированного стиля программирования. Сам я до последнего времени мало прибегал к объектно-ориентированному программированию (ООП), тем более в среде Tcl. Но за Tcl стало обидно. Я решил разобраться. И оказалось, что практически с момента появления Tcl, появилась и возможность объектно-ориентированного программирования в его среде. Всё «неудобство» заключалось в необходимости подключить пакет с поддержкой ООП. А таких пакетом было и есть несколько, как говорится на любой вкус. Это и Incr Tcl, Snit и XoTcl.

Программисты, привыкшие к языку C++, чувствуют себя как дома, программируя в среде Incr Tcl. Это было одним из первых широко используемых расширений для OOП на основе Tcl.

Пакет Snit в основном используется при построении Tk-виджетов, а XoTcl и его преемник nx предназначались для исследования динамического объектно-ориентированного программирования.

Обобщение опыта, полученного при использовании этих систем, позволило внедрить ООП в ядро Tcl начиная с версии 8.6. Так появился TclOO — Tcl Object Oriented.

Сразу отметим, что Tcl не просто поддерживает объектно-ориентированное программирование, а в полном смысле динамическое объектно-ориентированное программирование.

Разрабатывая приложения на Tcl/Tk, например удостоверяющий центр CAFL63, я не прибегал к ООП. И, как сейчас понимаю, зря. Где, где, а в УЦ объектов хватает. Это и запросы на сертификаты, это и сами сертификаты, списки отозванных сертификатов и много чего другого:



Начать было решено с рассмотрения сертификата x509.v3 с учетом российской специфики как объекта при ООП. Тем более, что имеется опыт разбора квалифицированного сертификата на Python. Именно на примере разбора и работы с сертификатом мы и покажем объектно-ориентированный стиль программирования в TclOO.

О DER и BER кодировках


Для доступа к сертификату будет создан класс certificate, в конструкторе которого при создании объекта конкретного сертификата будет проводится разбор его на составные части. Для этого нам потребуется в первую очередь пакет asn (package require asn), который поможет с разбором asn-структуры сертификата. К сожалению, этот пакет (кстати, в других скриптовых языках встречается аналогичная проблема) заточен на разбор asn-структур в DER-кодировке. Но сегодня еще встречаются сертификаты (и электронные подписи и много чего другого) в BER-кодировке. Но оказалось решить эту проблему можно достаточно просто, заменив процедуру ::asn::asnLength из пакета ASN на новую, которая будет подсчитывать длины тега как в DER, так и BER-кодировках:

package require asn
#Переименовываем оригинальную процедуру подсчета длины 
rename ::asn::asnGetLength ::asn::asnGetLength.orig
#Новая процедура подсчета длины
proc ::asn::asnGetLength {data_var length_var} {
    upvar 1 $data_var data  $length_var length
    asnGetByte data length
    if {$length == 0x080} {
#Поддержка BER-кодировки
	set lendata [string length $data]
	set tvl 1
	set length 0
	set data1 $data
	while {$tvl != 0} {
	    ::asn::asnGetByte data1 peek_tag 
	    ::asn::asnPeekByte data1 peek_tag1
	    if {$peek_tag == 0x00 && $peek_tag1 == 0x00} {
		incr tvl -1
		::asn::asnGetByte data1 tag 
		incr length 2
		continue
	    }
	    if {$peek_tag1 == 0x80} {
		incr tvl
		if {$tvl > 0} {
		    incr length 2
		}
		::asn::asnGetByte data1 tag 
	    } else {
		set l1 [string length $data1]
		::asn::asnGetLength data1 ll
		set l2 [string length $data1]
		set l3 [expr $l1 - $l2]
		incr length $l3
		incr length $ll
		incr length
		::asn::asnGetBytes data1 $ll strt
	    }
	}
	return
    }
    if {$length > 0x080} {
        set len_length [expr {$length & 0x7f}]  
        if {[string length $data] < $len_length} {
            return -code error 		"length information invalid, not enough octets left" 
        }
        asnGetBytes data $len_length lengthBytes
        switch $len_length {
            1 { binary scan $lengthBytes     cu length }
            2 { binary scan $lengthBytes     Su length }
            3 { binary scan \x00$lengthBytes Iu length }
            4 { binary scan $lengthBytes     Iu length }
            default {                
                binary scan $lengthBytes H* hexstr
		scan $hexstr %llx length
            }
        }
    }
    return
}

Что нам еще потребуется? Любая ASN-структура, особенно такая как сертификат X509.v3 содержит большое количество OID-ов, для которых могут существовать достаточно общепризнанные символьные обозначения. Значительная часть OID-ов, которые используются в сертификатах, присутствует в пакете pki. Мы его тоже будем использовать (package require pki). Естественно, что в этом пакете ничего не известно об OID-ах, которые используются в квалифицированных сертификатах и об OID-ах для российской криптографии. Их тоже целесообразно добавить в массив ::pki::oids:

set ::pki::oids(1.2.643.100.1)  "OGRN"
set ::pki::oids(1.2.643.100.5)  "OGRNIP"
set ::pki::oids(1.2.643.3.131.1.1) "INN"
set ::pki::oids(1.2.643.100.3) "SNILS"
#Для КПП ЕГАИС
set ::pki::oids(1.2.840.113549.1.9.2) "UN"
#set ::pki::oids(1.2.840.113549.1.9.2) "unstructuredName"
#Алгоритмы подписи
set ::pki::oids(1.2.643.2.2.3) "GOST R 34.10-2001 with GOST R 34.11-94"
set ::pki::oids(1.2.643.2.2.19) "GOST R 34.10-2001"
set ::pki::oids(1.2.643.7.1.1.1.1) "GOST R 34.10-2012-256"
set ::pki::oids(1.2.643.7.1.1.1.2) "GOST R 34.10-2012-512"
set ::pki::oids(1.2.643.7.1.1.3.2) "GOST R 34.10-2012-256 with GOSTR 34.11-2012-256"
set ::pki::oids(1.2.643.7.1.1.3.3) "GOST R 34.10-2012-512 with GOSTR 34.11-2012-512"
set ::pki::oids(1.2.643.100.113.1) "KC1 Class Sign Tool"
set ::pki::oids(1.2.643.100.113.2) "KC2 Class Sign Tool"
set ::pki::oids(2.5.4.42)  "givenName"

Для полноты не мешает также добавить символьное представление параметров подписи:

#Параметры подписи 
#Параметры подписи
set ::pki::oids((1.2.643.2.2.35.1)	"id-GostR3410-2001-CryptoPro-A-ParamSet"
set ::pki::oids(1.2.643.2.2.35.2)	"id-GostR3410-2001-CryptoPro-B-ParamSet"
set ::pki::oids(1.2.643.2.2.35.3)	"id-GostR3410-2001-CryptoPro-C-ParamSet"
set ::pki::oids(1.2.643.2.2.36.0)	"id-GostR3410-2001-CryptoPro-XchA-ParamSet"
set ::pki::oids(1.2.643.2.2.36.1)	"id-GostR3410-2001-CryptoPro-XchB-ParamSet"
set ::pki::oids(1.2.643.7.1.2.1.1.1)	"id-tc26-gost-3410-2012-256-paramSetA"
set ::pki::oids(1.2.643.7.1.2.1.1.2)	"id-tc26-gost-3410-2012-256-paramSetB"
set ::pki::oids(1.2.643.7.1.2.1.1.3)	"id-tc26-gost-3410-2012-256-paramSetC"
set ::pki::oids(1.2.643.7.1.2.1.1.4)	"id-tc26-gost-3410-2012-256-paramSetD"
set ::pki::oids(1.2.643.7.1.2.1.2.1)	"id-tc26-gost-3410-2012-512-paramSetA"
set ::pki::oids(1.2.643.7.1.2.1.2.2)	"id-tc26-gost-3410-2012-512-paramSetB"
set ::pki::oids(1.2.643.7.1.2.1.2.3)	"id-tc26-gost-3410-2012-512-paramSetC"


Создание класса


Объявление класса в TclOO мало чем отличается от объявления класса в других языках. Класс в TclOO также содержит область данных, конструктор, область объектно-ориентированных методов и деструктор. При этом область данных, конструктор и деструктор могут опускаться. Напомним, что конструктор вызывается при создание объекта (экземпляра объекта) заданного класса, а деструктор при его уничтожении. Конструктор (в отличии от деструктора), также как и методы, может иметь параметры. В нашем случае параметром для конструктора выступает сертификат в DER или PEM кодировке.

Области данных может предшествовать область наследуемых классов (superclass). Её будем рассматривать ниже. Но, для написания универсального класса certificate, эта область будет нами задействована.

В TclOO можно узнать какие классы в данный момент доступны в программе. Для этих целей служит команда следующего вида:

info class instances oo::class

В последующем, мы будем задействовать для наследования класс pubkey. Поэтому в нашем определении класса certificate присутствует проверка наличия класса pubkey и, если он присутствует, он объявляется как наследуемый (superclass pubkey).

Итак, ниже представлен класс для сертификата пока что с одним методом parse_cert, который возвращает список элементов сертификата:

Объявление класса certificate 

oo::class create certificate {
#Список доступных классов
    foreach cl  "[info class instances oo::class]" {
	if {$cl == "::pubkey" } {
#Если класс pubkey есть, то наследуем его. Это будет использовано в примере 3
	    superclass pubkey
	    break
	}
    }
#Переменные класса
#Доступны только в пределах класса
#Переменная для хранения разобранного сертификата. 
    variable ret
#Переменная для хранения расширений сертификата
    variable extcert
#Конструктор
    constructor {cert} {
	array set parsed_cert [::pki::_parse_pem $cert "-----BEGIN CERTIFICATE-----" "-----END CERTIFICATE-----"]
	set cert_seq $parsed_cert(data)
	array set ret [list]
#Полный сертификат der в hex
	binary scan $cert_seq H* ret(cert_full)
  # Decode X.509 certificate, which is an ASN.1 sequence
	::asn::asnGetSequence cert_seq wholething
	::asn::asnGetSequence wholething cert
#tbs - сертификат
	set ret(tbsCert) [::asn::asnSequence $cert]
	binary scan $ret(tbsCert) H* ret(tbsCert)
	::asn::asnPeekByte cert peek_tag
	if {$peek_tag != 0x02} {
    # Version number is optional, if missing assumed to be value of 0
	    ::asn::asnGetContext cert - asn_version
	    ::asn::asnGetInteger asn_version ret(version)
	    incr ret(version)
	} else {
	    set ret(version) 1
	}
	::asn::asnGetBigInteger cert ret(serial_number)
	::asn::asnGetSequence cert data_signature_algo_seq
	::asn::asnGetObjectIdentifier data_signature_algo_seq ret(data_signature_algo)
	::asn::asnGetSequence cert issuer
    set ret(issuer) $issuer
	::asn::asnGetSequence cert validity
	::asn::asnGetUTCTime validity ret(notBefore)
	::asn::asnGetUTCTime validity ret(notAfter)
	::asn::asnGetSequence cert subject
    set ret(subject) $subject
	::asn::asnGetSequence cert pubkeyinfo
	binary scan $pubkeyinfo H* ret(pubkeyinfo_hex)
	::asn::asnGetSequence pubkeyinfo pubkey_algoid
	::asn::asnGetObjectIdentifier pubkey_algoid ret(pubkey_algo)
	::asn::asnGetBitString pubkeyinfo pubkey
	set extensions_list [list]
	while {$cert != ""} {
	    ::asn::asnPeekByte cert peek_tag
	    switch -- [format {0x%02x} $peek_tag] {
    		"0x81" {
    			::asn::asnGetContext cert - issuerUniqueID
    		    }
    		"0x82" {
    			::asn::asnGetContext cert - subjectUniqueID
    		    }
    		"0xa1" {
    			::asn::asnGetContext cert - issuerUniqID
    		    }
    		"0xa2" {
    			::asn::asnGetContext cert - subjectUniqID
    		    }
    		"0xa3" {
    			::asn::asnGetContext cert - extensions_ctx
    			::asn::asnGetSequence extensions_ctx extensions
#Убираем перевод oid в текст
set ::pki::oids1 [array get ::pki::oids]
array unset ::pki::oids 
    			while {$extensions != ""} {
        		    ::asn::asnGetSequence extensions extension
		            ::asn::asnGetObjectIdentifier extension ext_oid
    			    ::asn::asnPeekByte extension peek_tag
    			    if {$peek_tag == 0x1} {
        			::asn::asnGetBoolean extension ext_critical
        		    } else {
        			set ext_critical false
        		    }
    			    ::asn::asnGetOctetString extension ext_value_seq
    			    set ext_oid [::pki::_oid_number_to_name $ext_oid]
    			    set ext_value [list $ext_critical]
    			    switch -- $ext_oid {
                        id-ce-basicConstraints {
            			    ::asn::asnGetSequence ext_value_seq ext_value_bin
            			    if {$ext_value_bin != ""} {
            				::asn::asnGetBoolean ext_value_bin allowCA
            			    } else {
            				set allowCA "false"
            			    }
        			    if {$ext_value_bin != ""} {
            				::asn::asnGetInteger ext_value_bin caDepth
            			    } else {
            				set caDepth -1
            			    }		
            			    lappend ext_value $allowCA $caDepth
                        }
                        default {
            			    binary scan $ext_value_seq H* ext_value_seq_hex
            			    lappend ext_value $ext_value_seq_hex
                        }
                    }
    			    lappend extensions_list $ext_oid $ext_value
    			}
#Возвращаем перевод oid-ов в текст
array set ::pki::oids $::pki::oids1
    		    }
	    }
	}
	set ret(extensions) $extensions_list
	array set extcert $extensions_list
	::asn::asnGetSequence wholething signature_algo_seq
	::asn::asnGetObjectIdentifier signature_algo_seq ret(signature_algo)
	::asn::asnGetBitString wholething ret(signature)
	set ret(serial_number) [::math::bignum::tostr $ret(serial_number)]
	set ret(signature) [binary format B* $ret(signature)]
	binary scan $ret(signature) H* ret(signature)
#Инициируем класс pubkeyinfo при наследовании - superclass
	if {[llength [self next]]} {
#Если есть наследуемый класс, то вызываем его конструктор
		next $ret(pubkeyinfo_hex)
	}
    }
    method parse_cert {} {
        return [array get ret]
    }
}


В области данных командой variable определяются данные/переменные объекта через, которые доступны во всех методах класса.

Метод method определяется точно так же, как процедура proc Tcl. Методы могут иметь произвольное количество параметров. Внутри метода можно определять свои данные командой 

my variable <идентификатор переменной>

Методы могут быть публичными (экспортируемыми) и приватными.

Экспортируемые методы методы видимы за пределами класса. По умолчанию экспортируются методы начинаются со строчной буквы. По умолчанию методы, чьи имена начинаются с прописной буквы считаются неэкспортируемыми (приватными) методами. Область видимости независимо от первого символа можно задать явно. Для указания того, что метод является публичным служит следующая команда:

export <идентификатор метода>

Для запрета экспорта метода используется следующая команда:

unexport <идентификатор метода>

Для вызова одного метода из другого метода внутри класса используется команда my:

my <идентификатор метода>

Для этой же цели можно использовать внутреннюю команда класса self, которая возвращает идентификатор текущего объекта:

[self] <идентификатор метода>

Ниже мы увидим всё это.

Для дальнейшей работы соберем весь рассмотренный код в файле classparsecert.tcl.

Содержимое файла classparsecert.tcl 

package require asn
#Переименовываем оригинальную процедуру подсчета длины 
rename ::asn::asnGetLength ::asn::asnGetLength.orig
#Новая процедура подсчета длины
proc ::asn::asnGetLength {data_var length_var} {
    upvar 1 $data_var data  $length_var length
    asnGetByte data length
    if {$length == 0x080} {
#Поддержка BER-кодировки
	set lendata [string length $data]
	set tvl 1
	set length 0
	set data1 $data
	while {$tvl != 0} {
	    ::asn::asnGetByte data1 peek_tag 
	    ::asn::asnPeekByte data1 peek_tag1
	    if {$peek_tag == 0x00 && $peek_tag1 == 0x00} {
		incr tvl -1
		::asn::asnGetByte data1 tag 
		incr length 2
		continue
	    }
	    if {$peek_tag1 == 0x80} {
		incr tvl
		if {$tvl > 0} {
		    incr length 2
		}
		::asn::asnGetByte data1 tag 
	    } else {
		set l1 [string length $data1]
		::asn::asnGetLength data1 ll
		set l2 [string length $data1]
		set l3 [expr $l1 - $l2]
		incr length $l3
		incr length $ll
		incr length
		::asn::asnGetBytes data1 $ll strt
	    }
	}
	return
    }
    if {$length > 0x080} {
        set len_length [expr {$length & 0x7f}]
        if {[string length $data] < $len_length} {
            return -code error 		"length information invalid, not enough octets left" 
        }
        asnGetBytes data $len_length lengthBytes
        switch $len_length {
            1 { binary scan $lengthBytes     cu length }
            2 { binary scan $lengthBytes     Su length }
            3 { binary scan \x00$lengthBytes Iu length }
            4 { binary scan $lengthBytes     Iu length }
            default {                
                binary scan $lengthBytes H* hexstr
		scan $hexstr %llx length
            }
        }
    }
    return
}
package require pki
set ::pki::oids(1.2.643.100.1)  "OGRN"
set ::pki::oids(1.2.643.100.5)  "OGRNIP"
set ::pki::oids(1.2.643.3.131.1.1) "INN"
set ::pki::oids(1.2.643.100.3) "SNILS"
#Для КПП ЕГАИС
set ::pki::oids(1.2.840.113549.1.9.2) "UN"
#set ::pki::oids(1.2.840.113549.1.9.2) "unstructuredName"
#Алгоритмы подписи
set ::pki::oids(1.2.643.2.2.3) "GOST R 34.10-2001 with GOST R 34.11-94"
set ::pki::oids(1.2.643.2.2.19) "GOST R 34.10-2001"
set ::pki::oids(1.2.643.7.1.1.1.1) "GOST R 34.10-2012-256"
set ::pki::oids(1.2.643.7.1.1.1.2) "GOST R 34.10-2012-512"
set ::pki::oids(1.2.643.7.1.1.3.2) "GOST R 34.10-2012-256 with GOSTR 34.11-2012-256"
set ::pki::oids(1.2.643.7.1.1.3.3) "GOST R 34.10-2012-512 with GOSTR 34.11-2012-512"
set ::pki::oids(1.2.643.100.113.1) "KC1 Class Sign Tool"
set ::pki::oids(1.2.643.100.113.2) "KC2 Class Sign Tool"
set ::pki::oids(2.5.4.42)  "givenName"
#Параметры подписи
set ::pki::oids((1.2.643.2.2.35.1)	"id-GostR3410-2001-CryptoPro-A-ParamSet"
set ::pki::oids(1.2.643.2.2.35.2)	"id-GostR3410-2001-CryptoPro-B-ParamSet"
set ::pki::oids(1.2.643.2.2.35.3)	"id-GostR3410-2001-CryptoPro-C-ParamSet"
set ::pki::oids(1.2.643.2.2.36.0)	"id-GostR3410-2001-CryptoPro-XchA-ParamSet"
set ::pki::oids(1.2.643.2.2.36.1)	"id-GostR3410-2001-CryptoPro-XchB-ParamSet"
set ::pki::oids(1.2.643.7.1.2.1.1.1)	"id-tc26-gost-3410-2012-256-paramSetA"
set ::pki::oids(1.2.643.7.1.2.1.1.2)	"id-tc26-gost-3410-2012-256-paramSetB"
set ::pki::oids(1.2.643.7.1.2.1.1.3)	"id-tc26-gost-3410-2012-256-paramSetC"
set ::pki::oids(1.2.643.7.1.2.1.1.4)	"id-tc26-gost-3410-2012-256-paramSetD"
set ::pki::oids(1.2.643.7.1.2.1.2.1)	"id-tc26-gost-3410-2012-512-paramSetA"
set ::pki::oids(1.2.643.7.1.2.1.2.2)	"id-tc26-gost-3410-2012-512-paramSetB"
set ::pki::oids(1.2.643.7.1.2.1.2.3)	"id-tc26-gost-3410-2012-512-paramSetC"
#Класс certificate
oo::class create certificate {
#Наследуем класс pubkey
#    superclass pubkey
#Переменные класса
#Доступны только в пределах класса
#Переменная для хранения разобранного сертификата. 
    variable ret
#Переменная для хранения расширений сертификата
variable extcert
#Конструктор
    constructor {cert} {
	array set parsed_cert [::pki::_parse_pem $cert "-----BEGIN CERTIFICATE-----" "-----END CERTIFICATE-----"]
	set cert_seq $parsed_cert(data)
	array set ret [list]
#Полный сертификат der в hex
	binary scan $cert_seq H* ret(cert_full)
  # Decode X.509 certificate, which is an ASN.1 sequence
	::asn::asnGetSequence cert_seq wholething
	::asn::asnGetSequence wholething cert
#tbs - сертификат
	set ret(tbsCert) [::asn::asnSequence $cert]
	binary scan $ret(tbsCert) H* ret(tbsCert)
	::asn::asnPeekByte cert peek_tag
	if {$peek_tag != 0x02} {
    # Version number is optional, if missing assumed to be value of 0
	    ::asn::asnGetContext cert - asn_version
	    ::asn::asnGetInteger asn_version ret(version)
	    incr ret(version)
	} else {
	    set ret(version) 1
	}
	::asn::asnGetBigInteger cert ret(serial_number)
	::asn::asnGetSequence cert data_signature_algo_seq
	::asn::asnGetObjectIdentifier data_signature_algo_seq ret(data_signature_algo)
	::asn::asnGetSequence cert issuer
    set ret(issuer) $issuer
	::asn::asnGetSequence cert validity
	::asn::asnGetUTCTime validity ret(notBefore)
	::asn::asnGetUTCTime validity ret(notAfter)
	::asn::asnGetSequence cert subject
    set ret(subject) $subject
	::asn::asnGetSequence cert pubkeyinfo
	binary scan $pubkeyinfo H* ret(pubkeyinfo_hex)
	::asn::asnGetSequence pubkeyinfo pubkey_algoid
	::asn::asnGetObjectIdentifier pubkey_algoid ret(pubkey_algo)
	::asn::asnGetBitString pubkeyinfo pubkey
	set extensions_list [list]
	while {$cert != ""} {
	    ::asn::asnPeekByte cert peek_tag
	    switch -- [format {0x%02x} $peek_tag] {
    		"0x81" {
    			::asn::asnGetContext cert - issuerUniqueID
    		    }
    		"0x82" {
    			::asn::asnGetContext cert - subjectUniqueID
    		    }
    		"0xa1" {
    			::asn::asnGetContext cert - issuerUniqID
    		    }
    		"0xa2" {
    			::asn::asnGetContext cert - subjectUniqID
    		    }
    		"0xa3" {
    			::asn::asnGetContext cert - extensions_ctx
    			::asn::asnGetSequence extensions_ctx extensions
#Убираем перевод oid в текст
set ::pki::oids1 [array get ::pki::oids]
array unset ::pki::oids 
    			while {$extensions != ""} {
        		    ::asn::asnGetSequence extensions extension
		            ::asn::asnGetObjectIdentifier extension ext_oid
    			    ::asn::asnPeekByte extension peek_tag
    			    if {$peek_tag == 0x1} {
        			::asn::asnGetBoolean extension ext_critical
        		    } else {
        			set ext_critical false
        		    }
    			    ::asn::asnGetOctetString extension ext_value_seq
    			    set ext_oid [::pki::_oid_number_to_name $ext_oid]
    			    set ext_value [list $ext_critical]
    			    switch -- $ext_oid {
                        id-ce-basicConstraints {
            			    ::asn::asnGetSequence ext_value_seq ext_value_bin
            			    if {$ext_value_bin != ""} {
            				::asn::asnGetBoolean ext_value_bin allowCA
            			    } else {
            				set allowCA "false"
            			    }
        			    if {$ext_value_bin != ""} {
            				::asn::asnGetInteger ext_value_bin caDepth
            			    } else {
            				set caDepth -1
            			    }           						
            			    lappend ext_value $allowCA $caDepth
                        }
                        default {
            			    binary scan $ext_value_seq H* ext_value_seq_hex
            			    lappend ext_value $ext_value_seq_hex
                        }
                    }
    			    lappend extensions_list $ext_oid $ext_value
    			}
#Возвращаем перевод oid-ов в текст
array set ::pki::oids $::pki::oids1
    		    }
	    }
	}
	set ret(extensions) $extensions_list
	array set extcert $extensions_list
	::asn::asnGetSequence wholething signature_algo_seq
	::asn::asnGetObjectIdentifier signature_algo_seq ret(signature_algo)
	::asn::asnGetBitString wholething ret(signature)
	set ret(serial_number) [::math::bignum::tostr $ret(serial_number)]
	set ret(signature) [binary format B* $ret(signature)]
	binary scan $ret(signature) H* ret(signature)
#Инициируем класс pubkeyinfo при наследовании - superclass
#	next $ret(pubkeyinfo_hex)
    }
    method parse_cert {} {
        return [array get ret]
    }
}


После того как был определен класс можно создавать конкретный объект (экземпляр объекта). Для этого может быть использована одна из следующих команд:

<имя класса> create <идентификатор экземпляра класса> [параметры для констуктура]

или

set <переменная для идентификатора экземпляра класса > <имя класса> new [параметры для констуктура]

В первом случае программист сам назначает идентификатор для создаваемого экземпляра объекта. Этот идентификатор фактически будет командой, через которую осуществляется доступ к объекту и его методам:

<идентификатор объекта>  <идентификатор метода> [<параметры>]

Во втором случае идентификатор создаваемого объекта назначается интерпретатором и возвращается как результат выполнения команды new для указанного класса. В этом случае идентификатор объекта будет браться из этой переменной.

Для уничтожения созданного объекта необходимо выполнить команду следующего вида:
<идентификатор объекта> destroy

Интересно сравнить с созданием объекта в Python. И что мы видим? Несущественную синтаксическую разницу.

Напишем небольшой пример example1.tcl использования этого класса:

#Загружаем описание класса
source ./classparsecert.tcl
#Загружаем сертификат
set file [lindex $argv 0]
if {$argc != 1 || ![file exists $file]} {
    puts "Usage: tclsh example1 <файл с сертификатом>"
    exit
}
puts "Loading file: $file"
set fd [open $file]
chan configure $fd -translation binary
set data [read $fd]
close $fd
if {[catch {certificate create cert1 $data} er1]} {
	puts "Файл не содержит СЕРТИФИКАТ"
	exit
}
array set cert_parse [cert1 parse_cert]
#parray cert_parse
puts "Распарсенный сертификат"
foreach ind [array names cert_parse] {
    puts "\tcert_parse($ind)"
}

Выполним пример:

$tclsh ./example1.tcl
Loading file: minenergo.cer
Распарсенный сертификат
        cert_parse(subject)
        cert_parse(pubkeyinfo_hex)
        cert_parse(extensions)
        cert_parse(issuer)
        cert_parse(data_signature_algo)
        cert_parse(cert_full)
        cert_parse(serial_number)
        cert_parse(signature)
        cert_parse(pubkey_algo)
        cert_parse(notAfter)
        cert_parse(signature_algo)
        cert_parse(notBefore)
        cert_parse(version)
        cert_parse(tbsCert)
$

О конструкторе Lego

У читателя, наверное, так и хочет сорваться с языка вопрос:- А причем здесь конструктор Lego? А вот при чем. Если, скажем в C++ класс объекта должен быть определен сразу, то в TclOO класс может собираться постепенно как модель в конструкторе. Более того одни части класса могут удаляться и заменяться другими и т.д. Более того, такой метод конструирования класса распространяется и на объекты, да на конкретные объекты.

Предположим, что необходимо вывести информацию и о владельце и об издателе сертификата. Для этого нам потребуется два публичных issur и subject и один приватный метод parse_dn для разбора отличительного имени (DN) издателя и владельца. Традиционно нам пришлось бы переписать класс certificate, добавив в него указанные методы. В TclOO можно поступить по другому. Можно просто в нужном месте программы выполнить оператор добавления в существующий класс новых членов.

Для добавления в класс новых членов в область данных используется команда (модуль конструктора) вида:

oo::define <идентификатор класса>  {
#Область данных класса
	variable <идентификатор переменной> … [<идентификатор переменной>]
	[ variable <идентификатор переменной> ]
}

Может быть несколько команд variable, каждая из которых определяет один или несколько элементов данных.

Аналогично добавляются методы:

oo::define <идентификатор класса>  {
#методы
	method <идентификатор метода 1>  {<параметры>} {
		<тело метода>
	}
	[
	…
	method <идентификатор метода N>  {<параметры>} {
		<тело метода>
	}
	]
}

Любой метод можно удалить в любое время с помощью команды deletemethod внутри сценария определения класса. Эта команды будет рассмотрена ниже при рассмотрении примера с отзывом сертификата.

Про видимость методов (публичные, приватные методы) мы уже говорили выше.
Отметим, что первоначально класс может создаваться абсолютно пустым:

oo::class create <Идентификатор класса>

с последующим наполнением его через команду:

oo::define <идентификатор класса>  {
…
}

Итак, добавляем новые методы в класс Certificate:

oo::define certificate {
    method issuer {} {
	return [ my parse_dn $ret(issuer)]
    }
    method subject {} {
	return [ my parse_dn $ret(subject)]
    }
    method parse_dn {asnblock} {
	set lret {}
      while {[string length $asnblock]} {
        asn::asnGetSet asnblock AttributeValueAssertion
        asn::asnGetSequence AttributeValueAssertion valblock
        asn::asnGetObjectIdentifier valblock oid
	set name [::pki::_oid_number_to_name $oid]
	::asn::asnGetString valblock  value
	lappend lret [string toupper $name]
	lappend lret $value
      }
	return $lret
    }
    unexport parse_dn
}

Теперь дополним наш пример кодом для распечатки информации об издателе и владельце:

...
puts "Сведения о владельце:"
foreach {oid value} [cert1 subject] {
    puts "\t$oid=$value"
}
puts "Сведения об издателе:"
foreach {oid value} [cert1 issuer] {
    puts "\t$oid=$value"
}
...

Таким образом мы получим второй пример.

Тестовый пример example2.tcl
source ./classparsecert.tcl
#Загружаем сертификат
set file [lindex $argv 0]
if {$argc != 1 || ![file exists $file]} {
puts «Usage: tclsh example1 <файл с сертификатом>»
exit
}
puts «Loading file: $file»
set fd [open $file]
chan configure $fd -translation binary
set data [read $fd]
close $fd
if {[catch {certificate create cert1 $data} er1]} {
puts «Файл не содержит СЕРТИФИКАТ»
exit
}
array set cert_parse [cert1 parse_cert]
#parray cert_parse
puts «Распарсенный сертификат»
foreach ind [array names cert_parse] {
puts "\tcert_parse($ind)"
}
#Добавляем новые методы
oo::define certificate {
method issuer {} {
return [ my parse_dn $ret(issuer)]
}
method subject {} {
return [ my parse_dn $ret(subject)]
}
method parse_dn {asnblock} {
set lret {}
while {[string length $asnblock]} {
asn::asnGetSet asnblock AttributeValueAssertion
asn::asnGetSequence AttributeValueAssertion valblock
asn::asnGetObjectIdentifier valblock oid
set name [::pki::_oid_number_to_name $oid]
::asn::asnGetString valblock value
lappend lret [string toupper $name]
lappend lret $value
}
return $lret
}
#Приватный метод
unexport parse_dn
}
#Применяем методы
puts «Сведения о владельце:»
foreach {oid value} [cert1 subject] {
puts "\t$oid=$value"
}
puts «Сведения об издателе:»
foreach {oid value} [cert1 issuer] {
puts "\t$oid=$value"
}

Попробуем выполнить этот пример:

$tclsh example2.tcl minenergo.cer  
Loading file: minenergo.cer
Распарсенный сертификат
        cert_parse(subject)
        . . . 
        cert_parse(tbsCert)
Сведения о владельце:
        EMAIL=xxxxxxxxxxx
        INN=xxxxxxxxxxx
        OGRN=............
. . .
        ST=77 г. Москва
        C=RU
        CN=Мин России
Сведения об издателе:
 . . .
        C=RU
        ST=77 Москва
        L=Москва
        CN=Тестовый удостоверяющий центр
$

О наследовании


Определяющей характеристикой объектно-ориентированных систем является поддержка наследования. Наследование относится к способности производного класса (также называемого подклассом ) наследовать область данных и методы из наследуемого класса (из супер класса).

При разборе сертификата, естественно, требуется получить и полную информацию о его публичном ключе. Предположим у нас уже есть класс pubkey, который на основе asn-структуры pubkeyinfo выдает полную информацию о публичном ключе, включая RSA, EC, GOST:

oo::class create pubkey {
#Внутренняя переменная класса для хранения asn-структуры pubkeyinfo
    variable infopk
    constructor {pubkinfo} {
	set infopk $pubkinfo
    }
    method infopubkey {} {
	array set retpk [list]
	set pubkeyinfo [binary format H* $infopk]
	::asn::asnGetSequence pubkeyinfo pubkey_algoid
	::asn::asnGetObjectIdentifier pubkey_algoid retpk(pubkey_algo)
	::asn::asnGetBitString pubkeyinfo pubkey
	set pubkey [binary format B* $pubkey]
	binary scan $pubkey H* retpk(pubkey)
	set retpk(pkcs11id_hex) [::sha1::sha1  $pubkey]
	if {"1 2 643" == [string range $retpk(pubkey_algo) 0 6]} {
#ГОСТ-ключ
    	    set retpk(type) gost
	    ::asn::asnGetSequence pubkey_algoid pubalgost
  #OID - параметра
	    ::asn::asnGetObjectIdentifier pubalgost retpk(paramkey)
	    set retpk(paramkey) [::pki::_oid_number_to_name $retpk(paramkey)]
	    if {$pubalgost != ""} {
  #OID - Функция хэша
		::asn::asnGetObjectIdentifier pubalgost retpk(hashkey)
	    } else {
		set retpk(hashkey) ""
	    }
	} elseif {"1 2 840 10045 2 1" == $retpk(pubkey_algo) } {
#EC-key
    	    set retpk(type) ec
	    ::asn::asnGetObjectIdentifier pubkey_algoid retpk(pubkey_algo_par)
	} elseif {"1 2 840 113549 1 1 1" == $retpk(pubkey_algo) }  {
#RSA- key
    	    set retpk(type) rsa
    		binary scan $pubkey H* retpk(pubkey)
    		::asn::asnGetSequence pubkey pubkey_parts
    		::asn::asnGetBigInteger pubkey_parts retpk(n)
    		::asn::asnGetBigInteger pubkey_parts retpk(e)
    		set retpk(n) [::math::bignum::tostr $retpk(n)]
    		set retpk(e) [::math::bignum::tostr $retpk(e)]
    		set retpk(l) [expr {int([::pki::_bits $retpk(n)] / 8.0000 + 0.5) * 8}]
	} else {
    	    set retpk(type) unknown
	}
	return [array get retpk]
    }
}

Сохраним этот класс в файле classpubkeyinfo.tcl.

Для того, чтобы наследовать метод infopubkey для объектов класса certificate, в определение класса certificate добавляется определение суперкласса, методы которого будут наследоваться:

superclass pubkey

Также добавляем в конструктор класса certificate вызов конструктора класса pubkey с передачей ему в качестве параметра asn-структуры pubkeyinfo:

next $ret(pubkeyinfo_hex)

Команда next вызывает одноименный метод (в данном случае constructor) из суперкласса, т.е. из класса pubkey. Конструктор в классе pubkey просто сохранит в переменной класса infopk asn-структуру публичного ключа. Этот код с соответствующей проверкой наличия в теле программы класса pubkey и его конструктора был включен при определении класса certificate.

Полный техт example3.tcl здесь. 

source ./classpubkeyinfo.tcl
source ./classparsecert_and_pk.tcl
set file [lindex $argv 0]
if {$argc != 1 || ![file exists $file]} {
    puts "Usage: tclsh example1 <файл с сертификатом>"
    exit
}
puts "Loading file: $file"
set fd [open $file]
chan configure $fd -translation binary
set data [read $fd]
close $fd
if {[catch {certificate create cert1 $data} er1]} {
puts "Файл не содержит сертификата"
exit
}
array set cert_parse [cert1 parse_cert]
puts "Распарсенный сертификат"
foreach ind [array names cert_parse] {
    puts "\tcert_parse($ind)"
}
#Добавляем новые методы
oo::define certificate {
    method issuer {} {
	return [ my parse_dn $ret(issuer)]
    }
    method subject {} {
	return [ my parse_dn $ret(subject)]
    }
    method parse_dn {asnblock} {
	set lret {}
      while {[string length $asnblock]} {
        asn::asnGetSet asnblock AttributeValueAssertion
        asn::asnGetSequence AttributeValueAssertion valblock
        asn::asnGetObjectIdentifier valblock oid
	set name [::pki::_oid_number_to_name $oid]
	::asn::asnGetString valblock  value
	lappend lret [string toupper $name]
	lappend lret $value
      }
	return $lret
    }
    unexport parse_dn
}
puts "Сведения о владельце:"
foreach {oid value} [cert1 subject] {
    puts "\t$oid=$value"
}
puts "Сведения об издателе:"
foreach {oid value} [cert1 issuer] {
    puts "\t$oid=$value"
}
puts "INFO PUB KEY"
foreach {oid value} [cert1 infopubkey] {
    puts "\t$oid=$value"
}
#Создаем объект pubkey
puts "КЛАСС INFO PUB KEY"
if {[catch {pubkey create pk1 $cert_parse(pubkeyinfo_hex)} er1]} {
puts "НЕ PUBKEYINFO"
exit
}
foreach {oid value} [pk1 infopubkey] {
    puts "\t$oid=$value"
}
puts "Публичные методы класса certificate"
puts "\t[info class methods certificate]"
puts "Все методы класса certificate, включая приватные"
puts "\t[info class methods certificate -private]"

Выполним пример example3.tcl:


$ tclsh example3.tcl minenergo.cer 
Loading file: minenergo.cer
Распарсенный сертификат
        cert_parse(subject)
        . . .
        cert_parse(tbsCert)
Сведения о владельце:
        . . .
        ST=77 г. Москва
        C=RU
        CN=Мин России
Сведения об издателе:
        C=RU
        ST=77 Москва
        . . .
        CN=Тестовый удостоверяющий центр
INFO PUB KEY
        pkcs11id_hex=842205ac57465fd853a158544f1ea1ba1de58569
        pubkey=04401dc81447918c7694a74dbe6bb4e4c10a63ca21d6b95a41ae20837deda4700f2404a0c1141d9b535b95707bb751791eb684bd09ce8f0c98d912dea947e4b8bbdb
        hashkey=1 2 643 7 1 1 2 2
        paramkey=id-GostR3410-2001-CryptoPro-XchA-ParamSet
        type=gost
        pubkey_algo=1 2 643 7 1 1 1 1
Публичные методы класса certificate
        subject parse_cert issuer
Все методы класса certificate, включая приватные
        parse_dn subject parse_cert issuer
 . . .
$

Отметим также, что TclOO допускает и множественное наследование, но это тема для отдельной публикации.

Информационная поддержка


В результатах выполнения примера мы видим перечень методов доступных в классе certificate.
Для получения списка методов используется следующая команда:


info class methods <идентификатор класса> [-private]

Если флаг "-private" не задан, то выдается список публичных методов. В противном случае, выдается весь перечень методов, включая приватные.

Проверить принадлежность объекта тому или иному классу можно командой:

info object clacc <идентификатор объекта>

В нашем примере объект cert1 принадлежит двум классам: certuficate и pubkey.

Если требуется узнать какие классы наследует тот или иной класс, достаточно выполнить команду:

info class superclasses <идентификатор класса>

А если требуется получить информацию о том, какими классами наследуется тот или иной класс, то достаточно выполнить следующую команду:

info class subclasses <идентификатор класса>

В нашем примере мы имеем:

$ 
. . .
Публичные методы класса certificate
        subject parse_cert issuer
Все методы класса certificate, включая приватные
        parse_dn subject parse_cert issuer
Принадлежность объекта cert1 классу certificate
        1
Принадлежность объекта cert1 классу pubkey
        1
Супер классы класса certificate
        ::pubkey
Супер классы класса pubkey
        ::oo::object
Подклассы класса certificate

Подклассы класса pubkey
        ::certificate
$

Подмешивание (mix in) методов в класс


Для расширения возможность класса, прежде всего с точки зрения его функциональности, помимо наследования можно использовать так называемый метод подмешивания (mix in).

Если мы хотим распечатать сертификат в текстовом виде, то нам потребуется разбор asn-структур расширений сертификата. Это и начначение ключа сертификата, это свойства квалифицированного сертификата и многое другое. Оформим разбор расширений сертификата в отдельный класс parseexts, в котором отсутствует констуктор и деструктор:

#Класс разбора расширений сертификата
oo::class create parseexts {
#Переменные с распарсенным сертификатом и его расширениями
#Область данных берется их класса, к которому будем плдмешивать
    variable ret
    variable extcert
#Подмешиваемые методы
    method issuerSignTool {} {
	set member {"Наименование СКЗИ УЦ" "Наименование УЦ" "Сертификат СКЗИ УЦ" "Сертификат УЦ"}
#Проверка наличия расширения
	if {![info exists extcert(1.2.643.100.112)]} {
	    return [list ]
	}
	set rr [list]
	set iss [binary format H* [lindex $extcert(1.2.643.100.112) 1]]
	::asn::asnGetSequence iss iss_pol
	for {set i 0} {[string length $iss_pol] > 0}  {incr i} {
	    ::asn::asnGetUTF8String iss_pol retist
	    lappend rr [lindex $member $i]
	    lappend rr $retist
	}
	return $rr
  }
    method subjectSignTool {} {
#Проверка наличия расширения
	if {![info exists extcert(1.2.643.100.111)]} {
	    return [list ]
	}
	set iss [binary format H* [lindex $extcert(1.2.643.100.111) 1]]
	lappend rr "User CKZI"
	::asn::asnGetUTF8String iss retsst
	lappend rr $retsst
	return $rr
    }
    method keyUsage {} {
    #keyUsage
	set critcert "No"
	array set ist [list]
#Проверка наличия расширения
	if {![info exists extcert(2.5.29.15)]} {
	    return [array get ist]
	}
    	set ku_hex [lindex $extcert(2.5.29.15) 1]
	if {[lindex $extcert(2.5.29.15) 0] == 1} {
    		set critcert "Yes"
	}
	set ku_options {"Digital signature" "Non-Repudiation" "Key encipherment" "Data encipherment" "Key agreement" "Certificate signature" "CRL signature" "Encipher Only" "Decipher Only" "Revocation list signature"}
	set ku [binary format H* $ku_hex]
	::asn::asnGetBitString ku ku_bin
	set retku {}
	for {set i 0} {$i < [string length $ku_bin]}  {incr i} {
	    if {[string range $ku_bin $i $i] > 0 } {
    		lappend retku [lindex $ku_options $i]
	    }
	}
	array set aku [list]
	set aku(keyUsage) $retku
	set aku(critcert) $critcert
	return [array get aku]
    }
}

Область данных подмешиваемого класса должна включать те данные, из класса к которому будет подмешиваться данный класс, которые будут использоваться в его методах.

Для подмешивания используется команда mixin:

mixin <идентификатор подмешиваемого класса>

Для нашего примера это будет выглядеть следующим образом:

oo::define certificate {
	mixin parseexts
}

Полный пример использования подмешивания example4.tcl находится здесь.

source ./classpubkeyinfo.tcl
source ./classparsecert.tcl
set file [lindex $argv 0]
if {$argc != 1 || ![file exists $file]} {
puts «Usage: tclsh example1 <файл с сертификатом>»
exit
}
puts «Loading file: $file»
set fd [open $file]
chan configure $fd -translation binary
set data [read $fd]
close $fd
if {[catch {certificate create cert1 $data} er1]} {
puts «Файл не содержит сертификата»
exit
}
array set cert_parse [cert1 parse_cert]
if {0} {
puts «Распарсенный сертификат»
foreach ind [array names cert_parse] {
puts "\tcert_parse($ind)"
}
}
#Добавляем новые методы
oo::define certificate {
method issuer {} {
return [ my parse_dn $ret(issuer)]
}
method subject {} {
return [ my parse_dn $ret(subject)]
}
method parse_dn {asnblock} {
set lret {}
while {[string length $asnblock]} {
asn::asnGetSet asnblock AttributeValueAssertion
asn::asnGetSequence AttributeValueAssertion valblock
asn::asnGetObjectIdentifier valblock oid
set name [::pki::_oid_number_to_name $oid]
::asn::asnGetString valblock value
lappend lret [string toupper $name]
lappend lret $value
}
return $lret
}
unexport parse_dn
}
puts «Сведения о владельце:»
foreach {oid value} [cert1 subject] {
puts "\t$oid=$value"
}
puts «Сведения об издателе:»
foreach {oid value} [cert1 issuer] {
puts "\t$oid=$value"
}
puts «INFO PUB KEY»
foreach {oid value} [cert1 infopubkey] {
puts "\t$oid=$value"
}
#Класс разбора расширений сертификата
oo::class create parseexts {
#Переменная с распарсенным сертификатом
variable ret
variable extcert
method issuerSignTool {} {
set member {«Наименование СКЗИ УЦ» «Наименование УЦ» «Сертификат СКЗИ УЦ» «Сертификат УЦ»}
#Проверка наличия расширения
if {![info exists extcert(1.2.643.100.112)]} {
return [list ]
}
set rr [list]
set iss [binary format H* [lindex $extcert(1.2.643.100.112) 1]]
::asn::asnGetSequence iss iss_pol
for {set i 0} {[string length $iss_pol] > 0} {incr i} {
::asn::asnGetUTF8String iss_pol retist
lappend rr [lindex $member $i]
lappend rr $retist
}
# unset extcert(1.2.643.100.112)
return $rr
}
method subjectSignTool {} {
#Проверка наличия расширения
if {![info exists extcert(1.2.643.100.111)]} {
return [list ]
}
set iss [binary format H* [lindex $extcert(1.2.643.100.111) 1]]
lappend rr «User CKZI»
::asn::asnGetUTF8String iss retsst
lappend rr $retsst
# unset extcert(1.2.643.100.111)
return $rr
}
method keyUsage {} {
#keyUsage
set critcert «No»
array set ist [list]
#Проверка наличия расширения
if {![info exists extcert(2.5.29.15)]} {
return [array get ist]
}
set ku_hex [lindex $extcert(2.5.29.15) 1]
if {[lindex $extcert(2.5.29.15) 0] == 1} {
set critcert «Yes»
}
set ku_options {«Digital signature» «Non-Repudiation» «Key encipherment» «Data encipherment» «Key agreement» «Certificate signature» «CRL signature» «Encipher Only» «Decipher Only» «Revocation list signature»}
set ku [binary format H* $ku_hex]
::asn::asnGetBitString ku ku_bin
set retku {}
for {set i 0} {$i < [string length $ku_bin]} {incr i} {
if {[string range $ku_bin $i $i] > 0 } {
lappend retku [lindex $ku_options $i]
}
}
array set aku [list]
set aku(keyUsage) $retku
set aku(critcert) $critcert
return [array get aku]
}
}
oo::define certificate {
mixin parseexts
}
puts «keyUsage»
foreach {oid value} [cert1 keyUsage] {
puts "\t$oid=$value"
}
puts «issuerSignTool»
foreach {oid value} [cert1 issuerSignTool] {
puts "\t$oid=$value"
}
puts «subjectSignTool»
foreach {oid value} [cert1 subjectSignTool] {
puts "\t$oid=$value"
}
puts «Публичные методы класса certificate»
puts "\t[info class methods certificate]"
puts «Все методы класса certificate, включая приватные»
puts "\t[info class methods certificate -private]"
puts «Принадлежность объекта cert1 классу certificate»
puts "\t[info object class cert1 certificate]"
puts «Принадлежность объекта cert1 классу pubkey»
puts "\t[info object class cert1 pubkey]"
puts «Супер классы класса certificate»
puts "\t[info class superclasses certificate]"
puts «Супер классы класса pubkey»
puts "\t[info class superclasses pubkey]"
puts «Подклассы класса certificate»
puts "\t[info class subclasses certificate]"
puts «Подклассы класса pubkey»
puts "\t[info class subclasses pubkey]"
puts «Mixin-ы класса certificate»
puts "\t[info class mixins certificate]"

Результат выполнения примера:

$tclsh example4.tcl cert.cer
. . .
Сведения об издателе:
. . .
        C=RU
        ST=77 Москва
        L=Москва
. . .
        CN=Тестовый удостоверяющий центр
INFO PUB KEY
        pkcs11id_hex=842205ac57465fd853a158544f1ea1ba1de58569
        pubkey=04401dc81447918c7694a74dbe6bb4e4c10a63ca21d6b95a41ae20837deda4700f2404a0c1141d9b535b95707bb751791eb684bd09ce8f0c98d912dea947e4b8bbdb
        hashkey=1 2 643 7 1 1 2 2
        paramkey=id-GostR3410-2001-CryptoPro-XchA-ParamSet
        type=gost
        pubkey_algo=1 2 643 7 1 1 1 1
keyUsage
        critcert=Yes
        keyUsage={Digital signature} Non-Repudiation {Key encipherment} {Data encipherment}
issuerSignTool
        Наименование СКЗИ УЦ="CSP" 
        Наименование УЦ="Удостоверяющий центр" версии 
        Сертификат СКЗИ УЦ=Сертификат соответствия №
        Сертификат УЦ=Сертификат соответствия № 
subjectSignTool
        User CKZI=CSP 
Публичные методы класса certificate
        subject parse_cert issuer
Все методы класса certificate, включая приватные
        parse_dn subject parse_cert issuer
Принадлежность объекта cert1 классу certificate
        1
Принадлежность объекта cert1 классу pubkey
        1
Супер классы класса certificate
        ::pubkey
Супер классы класса pubkey
        ::oo::object
Подклассы класса certificate

Подклассы класса pubkey
        ::certificate
Mixin-ы класса certificate
        ::parseexts

Добавление/переопределение методов у объектов


В принципе этого материала достаточно, чтобы начать использовать ООП в Tcl. Но мы упомянули и то, что в TcllOO можно динамически конструировать не только сам класс, то и экземпляры класса, т.е. объекты. На одной из таких возможностей хотелось бы остановится.

Для этого добавим в класс certificate еще один метод для подписания этим сертификатом некоторого документа:


#Метод для Подписания документа
oo::define certificate {
	method signDoc {doc} {
		set sign "Здесь должна находиться подпись документа  $doc"
#Счетчик подписанных документов
		my variable signedDoc
#Количество подписанных документов
		incr signedDoc
		return [list $signedDoc $sign]
	}
}

При вызове этого метода должно происходить подписание документа и увеличение счетчика подписанных документов на единицу. В качестве результата работы этого метода возвращается общее число подписанных на данный момент документов и сама подпись:

. . . 
set doc "Подпись1"
puts "Подписание документа $doc"
foreach {count sign} [cert1 signDoc $doc] {
    puts "\tПодписано документов на данный момент=$count"
    puts "\tПодпись документа=\"$sign\""
}
. . .

Результат будет выглядеть так:

. . .
Подписание документа Подпись1
        Подписано документов на данный момент=1
        Подпись документа="Здесь должна находиться подпись документа  Подпись1"
. . .

Сам алгорит подписи здесь не рассматривается, но его можно найти в утилите cryptoarmpkcs:

image

А теперь представим, что владелец сертификата убывает в отпуск. Он знает, что в отпуске он будет отдыхать и не в коем случае не будет работать с документами и тем более что-либо подписывать. Он хочет отозвать сертификат, а когда вернется восстановить его действие. Для этих целей служит следующая функция:

#Процедура отзыва сертификата
proc revoke {cert_obj} {
    oo::objdefine $cert_obj {
#Переопределяем метод подписи для конкретного объекта
        method signDoc {args} {
#Переменная accessCert хранит число несанкционированных попыток подписания
            my variable accessCert 
            set sign "Сертификат временно отозван. Не пытайтесь им подписывать!"
#Число попыток несанкционированного использования возрастает на 1
            incr accessCert
            return [list $accessCert $sign]
        }
        method unrevoke {} {
            my variable accessCert
#Вызов метод  unrevoke удалит метод подписи для конкретного объекта,
#восстанавливая тем самым действие  метода signDoc из класса и 
#удалит сам метод unrevoke
            oo::objdefine [self] { deletemethod signDoc unrevoke }
            if {![info exist accessCert]} {
                return 0
            }
            return $accessCert
        }
    }
}

Вызов этой функции определяет новый функционал методв signDoc для конкретного объекта. Для остальных объектов, как существующих и так и новых, сохраняется действие метода, определенного для класса. Также определяется новый метод unrevoke, вызов которого сотрудником по возвращению из отпуска приведет к восстановлению метода signDoc из класса certificate, путем удаления метода signDoc для объекта, а также удалит и сам метод unrevoke.

Полный текст примера example5.tcl находится здесь 
source ./classpubkeyinfo.tcl
source ./classparsecert.tcl
#Пример
set file [lindex $argv 0]
if {$argc != 1 || ![file exists $file]} {
    puts "File $file not exist"
    puts "Usage: tclsh example1 <файл с сертификатом>"
    exit
}
puts "Loading file: $file"
set fd [open $file]
chan configure $fd -translation binary
set data [read $fd]
close $fd
if {$data == "" } {
    puts "Bad file with certificate=$file"
    usage 1
    exit
}
if {[catch {certificate create cert1 $data} er1]} {
puts "НЕ СЕРТИФИКАТ"
exit
}
array set cert_parse [cert1 parse_cert]
#parray cert_parse
if {0} {
puts "Распарсенный сертификат"
foreach ind [array names cert_parse] {
    puts "\tcert_parse($ind)"
}
}
#Добавляем новые методы
oo::define certificate {
    method issuer {} {
	return [ my parse_dn $ret(issuer)]
    }
    method subject {} {
	return [ my parse_dn $ret(subject)]
    }
    method parse_dn {asnblock} {
	set lret {}
      while {[string length $asnblock]} {
        asn::asnGetSet asnblock AttributeValueAssertion
        asn::asnGetSequence AttributeValueAssertion valblock
        asn::asnGetObjectIdentifier valblock oid
	set name [::pki::_oid_number_to_name $oid]
	::asn::asnGetString valblock  value
	lappend lret [string toupper $name]
	lappend lret $value
      }
	return $lret
    }
    unexport parse_dn
}
puts "Сведения о владельце:"
foreach {oid value} [cert1 subject] {
    puts "\t$oid=$value"
}
puts "Сведения об издателе:"
foreach {oid value} [cert1 issuer] {
    puts "\t$oid=$value"
}
puts "INFO PUB KEY"
foreach {oid value} [cert1 infopubkey] {
    puts "\t$oid=$value"
}
#Метод для Подписания документа
oo::define certificate {
	method signDoc {doc} {
		set sign "Здесь должна находиться подпись документа  $doc"
#Счетчик подписанных документов
		my variable signedDoc
#Количество подписанных документов
		incr signedDoc
		return [list $signedDoc $sign]
	}
}
set doc "Подпись1"
puts "Подписание документа $doc"
foreach {count sign} [cert1 signDoc $doc] {
    puts "\tПодписано документов на данный момент=$count"
    puts "\tПодпись документа=\"$sign\""
}
set doc "Подпись2"
puts "Подписание документа $doc"
foreach {count sign} [cert1 signDoc $doc] {
    puts "\tПодписано документов на данный момент=$count"
    puts "\tПодпись документа=\"$sign\""
}
#Процедура отзыва сертификата
proc revoke {cert_obj} {
    oo::objdefine $cert_obj {
#Переопределяем метод подписи для конкретного объекта
        method signDoc {args} {
#Переменная accessCert хранит число несанкционированных попыток подписания
            my variable accessCert 
            set sign "Сертификат временно отозван. Не пытайтесь им подписывать!"
#Число попыток несанкционированного использования возрастает на 1
            incr accessCert
            return [list $accessCert $sign]
        }
        method unrevoke {} {
            my variable accessCert
#Вызов метод  unrevoke удалит метод подписи для конкретного объекта,
#восстанавливая тем самым действие  метода signDoc из класса и 
#удалит сам метод unrevoke
            oo::objdefine [self] { deletemethod signDoc unrevoke }
            if {![info exist accessCert]} {
                return 0
            }
            return $accessCert
        }
    }
}
#Клонируем объект
oo::copy cert1 cert11
#Отзыв сертификата
puts "Отзыв сертификата"
revoke cert1
foreach doc "Подпись3 подпись4" {
    puts "Попытка подписать документ $doc"
    foreach {count sign} [cert1 signDoc $doc] {
	puts "\tПопыток несанкционированного доступа=$count"
	puts "\tПодпись документа=\"$sign\""
    }
}
#Для клонированного объекта отзыв не действует
foreach doc "Подпись3к подпись4к" {
    puts "Попытка подписать документ $doc клонированным объектом"
    foreach {count sign} [cert11 signDoc $doc] {
    puts "\tПодписано документов на данный момент=$count"
    puts "\tПодпись документа=\"$sign\""
    }
}
#Восстанавливаем действие сертификата
foreach {count info} [cert1 unrevoke] {
    puts "Действие сертификата восстанвлено"
    puts "\tЗа время его отзыва было $count попытки несанкционированного досьупа"
}
foreach doc "\"Подпись после восстановления\"" {
    puts "Попытка подписать документ $doc"
    foreach {count sign} [cert1 signDoc $doc] {
	puts "\tПодписано документов на данный момент=$count"
	puts "\tПодпись документа=\"$sign\""
    }
}

Ниже приведен фрагмент выполнения примера example5.tcl:

. . . 
Подписание документа Подпись1
        Подписано документов на данный момент=1
        Подпись документа="Здесь должна находиться подпись документа  Подпись1"
Подписание документа Подпись2
        Подписано документов на данный момент=2
        Подпись документа="Здесь должна находиться подпись документа  Подпись2"
Отзыв сертификата
Попытка подписать документ Подпись3
        Попыток несанкционированного доступа=1
        Подпись документа="Сертификат временно отозван. Не пытайтесь им подписывать!"
Попытка подписать документ подпись4
        Попыток несанкционированного доступа=2
        Подпись документа="Сертификат временно отозван. Не пытайтесь им подписывать!"
Действие сертификата восстанвлено
        За время его отзыва было 2 попытки несанкционированного досьупа
Попытка подписать документ Подпись после восстановления
        Подписано документов на данный момент=3
        Подпись документа="Здесь должна находиться подпись документа  Подпись после восстановления"
. . .

Упомянем еще один оператор. Это оператор клонирования объекта:

oo::copy <идентификатор исходного объекта> <идентификатор клона>

Говорить и писать об ООП на TclOO можно долго и долго.

Еще интересней его исследовать.