Часто приходится слышать, что скриптовому
языку 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 1set length 0set data1 $datawhile {$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 2continue } if {$peek_tag1 == 0x80} {incr tvlif {$tvl > 0} { incr length 2}::asn::asnGetByte data1 tag } else {set l1 [string length $data1]::asn::asnGetLength data1 llset l2 [string length $data1]set l3 [expr $l1 - $l2]incr length $l3incr length $llincr 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* hexstrscan $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 в hexbinary 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_tagif {$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 pubkeyinfobinary scan $pubkeyinfo H* ret(pubkeyinfo_hex)::asn::asnGetSequence pubkeyinfo pubkey_algoid::asn::asnGetObjectIdentifier pubkey_algoid ret(pubkey_algo)::asn::asnGetBitString pubkeyinfo pubkeyset 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_listarray 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 при наследовании - superclassif {[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 1set length 0set data1 $datawhile {$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 2continue } if {$peek_tag1 == 0x80} {incr tvlif {$tvl > 0} { incr length 2}::asn::asnGetByte data1 tag } else {set l1 [string length $data1]::asn::asnGetLength data1 llset l2 [string length $data1]set l3 [expr $l1 - $l2]incr length $l3incr length $llincr 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* hexstrscan $hexstr %llx length } } } return}package require pkiset ::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"#Класс certificateoo::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 в hexbinary 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_tagif {$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 pubkeyinfobinary scan $pubkeyinfo H* ret(pubkeyinfo_hex)::asn::asnGetSequence pubkeyinfo pubkey_algoid::asn::asnGetObjectIdentifier pubkey_algoid ret(pubkey_algo)::asn::asnGetBitString pubkeyinfo pubkeyset 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_listarray 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 для указанного класса. В этом случае идентификатор объекта будет браться из этой переменной.
Интересно сравнить с созданием объекта в 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 binaryset data [read $fd]close $fdif {[catch {certificate create cert1 $data} er1]} {puts "Файл не содержит СЕРТИФИКАТ"exit}array set cert_parse [cert1 parse_cert]#parray cert_parseputs "Распарсенный сертификат"foreach ind [array names cert_parse] { puts "\tcert_parse($ind)"}
Выполним пример:
$tclsh ./example1.tclLoading 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 oidset name [::pki::_oid_number_to_name $oid]::asn::asnGetString valblock valuelappend 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"
}
#Загружаем сертификат
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 pubkeyset 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.tclsource ./classparsecert_and_pk.tclset 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 binaryset data [read $fd]close $fdif {[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 oidset name [::pki::_oid_number_to_name $oid]::asn::asnGetString valblock valuelappend 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"}#Создаем объект pubkeyputs "КЛАСС 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_polfor {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 retsstlappend rr $retsstreturn $rr } method keyUsage {} { #keyUsageset 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_binset 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) $retkuset aku(critcert) $critcertreturn [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]"
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 1keyUsage 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 ::certificateMixin-ы класса certificate ::parseexts
Добавление/переопределение методов у объектов
В принципе этого материала достаточно, чтобы начать использовать ООП в Tcl. Но мы упомянули и то, что в TcllOO можно динамически конструировать не только сам класс, то и экземпляры класса, т.е. объекты. На одной из таких возможностей хотелось бы остановится.
Для этого добавим в класс certificate еще один метод для подписания этим сертификатом некоторого документа:
#Метод для Подписания документаoo::define certificate {method signDoc {doc} {set sign "Здесь должна находиться подпись документа $doc"#Счетчик подписанных документовmy variable signedDoc#Количество подписанных документовincr signedDocreturn [list $signedDoc $sign]}}
При вызове этого метода должно происходить подписание документа и увеличение счетчика подписанных документов на единицу. В качестве результата работы этого метода возвращается общее число подписанных на данный момент документов и сама подпись:
. . . set doc "Подпись1"puts "Подписание документа $doc"foreach {count sign} [cert1 signDoc $doc] { puts "\tПодписано документов на данный момент=$count" puts "\tПодпись документа=\"$sign\""}. . .
Результат будет выглядеть так:
. . .Подписание документа Подпись1 Подписано документов на данный момент=1 Подпись документа="Здесь должна находиться подпись документа Подпись1". . .
Сам алгорит подписи здесь не рассматривается, но его можно найти в утилите cryptoarmpkcs:
А теперь представим, что владелец сертификата убывает в отпуск. Он знает, что в отпуске он будет отдыхать и не в коем случае не будет работать с документами и тем более что-либо подписывать. Он хочет отозвать сертификат, а когда вернется восстановить его действие. Для этих целей служит следующая функция:
#Процедура отзыва сертификата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.tclsource ./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 binaryset data [read $fd]close $fdif {$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_parseif {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 oidset name [::pki::_oid_number_to_name $oid]::asn::asnGetString valblock valuelappend 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 signedDocreturn [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 cert1foreach 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 можно долго и долго.Еще интересней его исследовать.
