#!/usr/bin/perl # Convert::ASN1 on-target probe. Prints one tagged line per measured value; the # suite file names and compares them, so a single wrong answer is one red case # rather than one red suite. # # Every encoding asserted here is DER derived from X.690 by hand, not read back # out of this module -- a codec compared only against itself agrees with its own # bugs. Anything whose bytes are not host-independent is configured until it is # (see `timezone => 0` below) rather than left to the guest's clock. use strict; use warnings; # Line-buffered: a payload killed part way must not take its whole transcript # with it. Without this the suite sees an empty $out and every case reads # got:'' -- which says nothing about where it stopped. $| = 1; sub p { my ($t,@v)=@_; printf "%s %s\n", $t, join(' ',@v); } sub hx { uc unpack("H*", $_[0]) } sub cp { join(',', map { ord } split //, $_[0]) } # --- the module, and the load-time dependencies it drags in ----------------- require Convert::ASN1; p("R1-version", $Convert::ASN1::VERSION); p("R2-inc-path", $INC{'Convert/ASN1.pm'} // 'MISSING'); # Convert::ASN1's own BEGIN block requires ::IO unconditionally -- there is no # XS &_encode here, so the pure-Perl branch always runs -- and IO.pm does # `use Socket` at file scope. Socket is therefore a HARD LOAD-TIME dependency # of `use Convert::ASN1`, even for code that never touches a socket, and Socket # is XS: it works on this arm only because it is linked into the interpreter # (static_ext), there being no DynaLoader on a perl built -Uusedl. Encode is # the same shape, required in ASN1.pm's BEGIN under CHECK_UTF8. p("R3-io-loaded", $INC{'Convert/ASN1/IO.pm'} ? 'YES' : 'NO'); p("R4-socket-loaded", $INC{'Socket.pm'} ? 'YES' : 'NO'); p("R5-encode-loaded", $INC{'Encode.pm'} ? 'YES' : 'NO'); p("R6-parser-loaded", $INC{'Convert/ASN1/parser.pm'} ? 'YES' : 'NO'); p("R7-io-unavailable", defined $Convert::ASN1::IO_UNAVAILABLE ? 'SET' : 'UNSET'); p("R8-io-reason", do { my $r = $Convert::ASN1::IO_UNAVAILABLE // ''; $r =~ /(panic: \S+)/ ? $1 : ($r eq '' ? 'none' : 'other'); }); p("R9-encode-is-utf8", (eval { Encode::is_utf8("x") ? 'TRUE' : 'FALSE' } // 'ERR')); # --- the ticket's schema: integer, string, sequence, optional --------------- my $asn = Convert::ASN1->new; my $prep = $asn->prepare(q< Point ::= SEQUENCE { id INTEGER, label PrintableString, active BOOLEAN, tag OCTET STRING OPTIONAL, coords SEQUENCE OF INTEGER } >) ? 'YES' : 'NO'; p("R10-prepare", $prep); p("R11-prepare-err", $prep eq 'YES' ? 'none' : ($asn->error // 'undef')); my $pt = $asn->find('Point'); p("R12-find", $pt ? 'YES' : 'NO'); my %v = (id => 1000, label => 'brintOS', active => 1, coords => [1, -128, 300]); my $der = $pt->encode(\%v); p("R13-enc-ok", defined $der ? 'YES' : 'NO'); p("R14-enc-err", defined $der ? 'none' : ($pt->error // 'undef')); p("R15-der", defined $der ? hx($der) : 'NONE'); p("R16-der-len", defined $der ? length($der) : -1); my $der_opt = $pt->encode({ %v, tag => "\x01\x02" }); p("R17-der-opt", defined $der_opt ? hx($der_opt) : 'NONE'); p("R18-der-opt-len", defined $der_opt ? length($der_opt) : -1); # --- decode back, and compare the structure -------------------------------- my $d = $pt->decode($der); p("R20-dec-ok", $d ? 'YES' : 'NO'); p("R21-dec-err", $d ? 'none' : ($pt->error // 'undef')); p("R22-id", $d ? $d->{id} : 'NONE'); p("R23-label", $d ? $d->{label} : 'NONE'); p("R24-active", $d ? ($d->{active} ? 'TRUE' : 'FALSE') : 'NONE'); p("R25-tag", $d ? (exists $d->{tag} ? 'PRESENT' : 'ABSENT') : 'NONE'); p("R26-coords", $d ? join(',', @{$d->{coords}}) : 'NONE'); p("R27-keys", $d ? join(',', sort keys %$d) : 'NONE'); p("R28-id-num", $d ? (($d->{id} ^ $d->{id}) eq '0' ? 'NUMBER' : 'STRING') : 'NONE'); my $d2 = $pt->decode($der_opt); p("R29-opt-tag", $d2 ? (exists $d2->{tag} ? hx($d2->{tag}) : 'ABSENT') : 'NONE'); p("R30-opt-keys", $d2 ? join(',', sort keys %$d2) : 'NONE'); # The decoded tree re-encodes to the same bytes, twice over. Comparing only # against the input would say the input was well formed; the third pass catches # an encoder that is stable only after one normalisation. my $re = $d ? $pt->encode($d) : undef; p("R31-roundtrip", (defined $re && defined $der && $re eq $der) ? 'SAME' : 'DIFF'); my $re2 = defined $re ? $pt->encode($pt->decode($re)) : undef; p("R32-roundtrip3", (defined $re2 && defined $der && $re2 eq $der) ? 'SAME' : 'DIFF'); # --- truncated / malformed encodings are REJECTED -------------------------- # A decoder that returns a partial structure is worse than one that fails: the # caller cannot tell. Every case asserts no value came back, not a value. my @bad = ( ['trunc-1', substr($der, 0, length($der)-1)], ['trunc-half', substr($der, 0, int(length($der)/2))], ['trunc-hdr', substr($der, 0, 2)], ['empty', ''], ['garbage', "\xDE\xAD\xBE\xEF"], ['wrong-tag', "\x31" . substr($der, 1)], ['short-len', "\x30\x0A" . substr($der, 2)], ['long-len', "\x30\x7F" . substr($der, 2)], ['trailing', $der . "\x00\x00"], ); for my $b (@bad) { my ($name, $bytes) = @$b; my $r = eval { $pt->decode($bytes) }; p("R40-$name", (defined $r && !$@) ? 'RETURNED' : 'REJECTED'); } # The complement: the nine above measure rejection only if the good one parses. p("R41-wellformed", $pt->decode($der) ? 'ACCEPTED' : 'REJECTED'); # and an error string is set on the failure, so a caller can say what went wrong $pt->decode(substr($der, 0, 5)); p("R42-error-set", (defined $pt->error && length $pt->error) ? 'SET' : 'EMPTY'); # --- integer edges: two's complement, minimal length, the sign-byte rule ---- my $ia = Convert::ASN1->new; $ia->prepare(q< I ::= INTEGER >) or die $ia->error; my $i = $ia->find('I'); for my $n (0, 1, 127, 128, 255, 256, -1, -128, -129, 65535, -32768, 2147483647, -2147483648) { (my $k = $n) =~ s/-/m/; p("R50-int-$k", hx($i->encode($n))); my $back = $i->decode($i->encode($n)); p("R51-rt-$k", defined $back ? $back : 'NONE'); } # --- the other universal types, in one structure --------------------------- my $t = Convert::ASN1->new; $t->prepare(q< Types ::= SEQUENCE { b BOOLEAN, n NULL, o OBJECT IDENTIFIER, e ENUMERATED { red(0), green(1), blue(2) }, bs BIT STRING, os OCTET STRING, u UTF8String, ia IA5String, ps PrintableString, bmp BMPString } >) or die $t->error; my $ty = $t->find('Types'); my $tder = $ty->encode({ b => 0, n => 1, o => '1.2.840.113549.1.1.11', e => 2, bs => "\xA0", os => "\x00\xFF", u => "caf\x{e9}", ia => 'a@b.c', ps => 'OK 42', bmp => "\x00\x41\x00\x42", }); p("R60-types-enc", defined $tder ? 'YES' : 'NO'); p("R61-types-der", defined $tder ? hx($tder) : 'NONE'); my $td = defined $tder ? $ty->decode($tder) : undef; p("R62-bool-false", $td ? ($td->{b} ? 'TRUE' : 'FALSE') : 'NONE'); p("R63-null", $td ? (defined $td->{n} ? "DEFINED-$td->{n}" : 'UNDEF') : 'NONE'); p("R64-oid", $td ? $td->{o} : 'NONE'); p("R65-enum", $td ? $td->{e} : 'NONE'); p("R66-bitstring", ($td && ref $td->{bs} eq 'ARRAY') ? hx($td->{bs}[0]) : 'NOT-ARRAY'); p("R67-bitlen", ($td && ref $td->{bs} eq 'ARRAY') ? $td->{bs}[1] : 'NOT-ARRAY'); p("R68-octets", $td ? hx($td->{os}) : 'NONE'); p("R69-utf8-cp", $td ? cp($td->{u}) : 'NONE'); p("R70-utf8-len", $td ? length($td->{u}) : 'NONE'); p("R71-ia5", $td ? $td->{ia} : 'NONE'); p("R72-print", $td ? $td->{ps} : 'NONE'); p("R73-bmp", $td ? hx($td->{bmp}) : 'NONE'); # --- tagging: implicit vs explicit context tags ---------------------------- my $g = Convert::ASN1->new; $g->prepare(q< Tagged ::= SEQUENCE { imp [0] IMPLICIT INTEGER, exp [1] EXPLICIT INTEGER } >) or die $g->error; my $tg = $g->find('Tagged'); my $gder = $tg->encode({ imp => 5, exp => 5 }); p("R74-tagged-der", defined $gder ? hx($gder) : 'NONE'); my $gd = defined $gder ? $tg->decode($gder) : undef; p("R75-tagged-imp", $gd ? $gd->{imp} : 'NONE'); p("R76-tagged-exp", $gd ? $gd->{exp} : 'NONE'); # --- CHOICE, SET OF, ANY, and a nested SEQUENCE OF SEQUENCE ---------------- my $c = Convert::ASN1->new; $c->prepare(q< Ch ::= CHOICE { i INTEGER, s PrintableString } Bag ::= SET OF INTEGER Alg ::= SEQUENCE { algorithm OBJECT IDENTIFIER, parameters ANY OPTIONAL } Rows ::= SEQUENCE OF SEQUENCE { k INTEGER, v PrintableString } >) or die $c->error; my $ch = $c->find('Ch'); p("R77-choice-i", hx($ch->encode({ i => 7 }))); p("R78-choice-s", hx($ch->encode({ s => 'x' }))); my $cd = $ch->decode($ch->encode({ s => 'x' })); p("R79-choice-dec", $cd ? join('=', %$cd) : 'NONE'); my $bag = $c->find('Bag'); p("R80-setof", hx($bag->encode([3,1,2]))); p("R81-setof-dec", join(',', @{ $bag->decode($bag->encode([3,1,2])) })); # ANY carries an already-encoded TLV through untouched -- the property every # X.509 / LDAP schema leans on, and the one a naive codec re-wraps. my $alg = $c->find('Alg'); my $ader = $alg->encode({ algorithm => '1.2.840.113549.1.1.11', parameters => "\x05\x00" }); p("R82-any-der", defined $ader ? hx($ader) : 'NONE'); my $ad = defined $ader ? $alg->decode($ader) : undef; p("R83-any-oid", $ad ? $ad->{algorithm} : 'NONE'); p("R84-any-param", $ad ? hx($ad->{parameters}) : 'NONE'); p("R85-any-absent", do { my $r = $alg->decode($alg->encode({ algorithm => '1.2.840.113549.1.1.11' })); $r ? (exists $r->{parameters} ? 'PRESENT' : 'ABSENT') : 'NONE'; }); my $rows = $c->find('Rows'); my $rder = $rows->encode([ { k => 1, v => 'a' }, { k => 2, v => 'b' } ]); p("R86-rows-der", defined $rder ? hx($rder) : 'NONE'); my $rd = defined $rder ? $rows->decode($rder) : undef; p("R87-rows-dec", $rd ? join(';', map { "$_->{k}=$_->{v}" } @$rd) : 'NONE'); # --- long-form length: content over 127 bytes takes a multi-byte length ---- my $lo = Convert::ASN1->new; $lo->prepare(q< L ::= OCTET STRING >) or die $lo->error; my $los = $lo->find('L'); my $big = "\xAB" x 200; my $lder = $los->encode($big); p("R88-longlen-hdr", defined $lder ? hx(substr($lder,0,3)) : 'NONE'); p("R89-longlen-len", defined $lder ? length($lder) : -1); p("R90-longlen-rt", (defined $lder && $los->decode($lder) eq $big) ? 'SAME' : 'DIFF'); # --- times: the POSIX (encode) and Time::Local (decode) paths -------------- # timezone => 0 pins the offset, so these bytes do not depend on the guest's # clock setting; the epoch round trip below is checked without it as well. my $tm = Convert::ASN1->new; $tm->prepare(q< T ::= SEQUENCE { g GeneralizedTime, u UTCTime } >) or die $tm->error; my $tmo = $tm->find('T'); $tmo->configure(encode => { timezone => 0 }); my $epoch = 1000000000; # 2001-09-09T01:46:40Z my $tmder = $tmo->encode({ g => $epoch, u => $epoch }); p("R91-time-enc", defined $tmder ? 'YES' : 'NO'); p("R92-time-der", defined $tmder ? hx($tmder) : 'NONE'); my $tmd = defined $tmder ? $tmo->decode($tmder) : undef; p("R93-time-g", $tmd ? $tmd->{g} : 'NONE'); p("R94-time-u", $tmd ? $tmd->{u} : 'NONE'); p("R95-timelocal-loaded", $INC{'Time/Local.pm'} ? 'YES' : 'NO'); p("R96-posix-loaded", $INC{'POSIX.pm'} ? 'YES' : 'NO'); # unconfigured: the bytes carry the guest's offset, the epoch must survive it my $tm2 = $tm->find('T'); my $tmd2 = $tm2->decode($tm2->encode({ g => $epoch, u => $epoch })); p("R97-time-tz-rt", ($tmd2 && $tmd2->{g} == $epoch && $tmd2->{u} == $epoch) ? 'SAME' : 'DIFF'); # --- a bad schema is rejected, and says why -------------------------------- my $bs = Convert::ASN1->new; my $bad = $bs->prepare(q< Broken ::= SEQUENCE { >) ? 'ACCEPTED' : 'REJECTED'; p("R98-bad-schema", $bad); p("R99-bad-schema-err", $bad eq 'REJECTED' ? ((defined $bs->error && length $bs->error) ? 'SET' : 'EMPTY') : 'n/a'); my $bs2 = Convert::ASN1->new; p("R100-undef-type", ($bs2->prepare(q< A ::= SEQUENCE { x NoSuchType } >) && $bs2->find('A')) ? 'ACCEPTED' : 'REJECTED'); # --- REAL: the one type that reaches POSIX, and the base-2 encoding -------- # X.690 8.5.7: first content octet 0x80 = binary, base 2, scale 0, 1-byte # exponent, positive; then a two's-complement exponent and a mantissa. 0.15625 # is 160 x 2**-10, so F6 A0 -- exact, which is what makes a byte assertion # legitimate for a float at all. my $rl = Convert::ASN1->new; $rl->prepare(q< R ::= REAL >) or die $rl->error; my $rr = $rl->find('R'); p("R101-real-zero", hx($rr->encode(0))); p("R102-real-eighth", hx($rr->encode(0.15625))); p("R103-real-one", hx($rr->encode(1))); p("R104-real-neg", hx($rr->encode(-0.5))); p("R105-real-rt", $rr->decode($rr->encode(0.15625))); p("R106-real-rt-neg",$rr->decode($rr->encode(-0.5))); p("R107-posix-loaded", $INC{'POSIX.pm'} ? 'YES' : 'NO'); # --- what `encoding => DER` does and does not do --------------------------- # configure() accepts DER, but this release canonicalises nothing: SET OF comes # out in insertion order either way, where DER (X.690 11.6) requires the members # be sorted by their encodings. Pinned in both modes so a future release that # starts sorting is a reported change rather than a silent one -- it matters to # anyone verifying an X.509 signature, where the bytes must be canonical. my $ber = Convert::ASN1->new; $ber->prepare(q< Bag ::= SET OF INTEGER >) or die $ber->error; my $der_m = Convert::ASN1->new; $der_m->prepare(q< Bag ::= SET OF INTEGER >) or die $der_m->error; $der_m->configure(encoding => 'DER'); p("R108-setof-ber", hx($ber->find('Bag')->encode([3,1,2]))); p("R109-setof-der", hx($der_m->find('Bag')->encode([3,1,2]))); p("R110-der-accepted", (eval { Convert::ASN1->new->configure(encoding => 'DER'); 1 }) ? 'YES' : 'NO'); p("R111-bogus-encoding", (eval { Convert::ASN1->new->configure(encoding => 'XER'); 1 }) ? 'ACCEPTED' : 'REJECTED'); # --- integers beyond an IV: the X.509 case this module exists for ---------- # Anything with abs() >= 2**31 goes through i2osp/os2ip, which load Math::BigInt # themselves (`eval "use $biclass"`) and return undef if it is absent. poky # names Math::BigInt in RDEPENDS:${PN}-ptest and NOT in RDEPENDS:${PN} -- the # wrong list, because an RSA modulus is an INTEGER, not a test fixture. The # bbappend adds it; without it every case below reads UNDEF. p("R130-bigint-avail", (eval { require Math::BigInt; 1 }) ? 'YES' : 'NO'); my $ib = Convert::ASN1->new; $ib->prepare(q< I ::= INTEGER Key ::= SEQUENCE { n INTEGER, e INTEGER } >) or die $ib->error; my $bi = $ib->find('I'); for my $n (2147483648, 4294967296, -2147483649) { (my $k = $n) =~ s/-/m/; my $e = $bi->encode($n); p("R131-big-$k", defined $e ? hx($e) : 'UNDEF'); p("R132-bigrt-$k", defined $e ? ($bi->decode($e) // 'UNDEF') : 'UNDEF'); } # 2**2047 + 1: 256 content bytes with the top bit set, so DER prepends a 00 sign # byte (257) and the length goes long-form -- 02 82 01 01 00 80 ... 00 01. This # is the size and shape of an RSA-2048 modulus, which is the whole reason a # BER/DER codec needs bigints at all. my $rsa = eval { Math::BigInt->new(2)->bpow(2047)->binc }; my $rder = defined $rsa ? $bi->encode("$rsa") : undef; p("R133-rsa-hdr", defined $rder ? hx(substr($rder,0,6)) : 'UNDEF'); p("R134-rsa-len", defined $rder ? length($rder) : -1); p("R135-rsa-tail", defined $rder ? hx(substr($rder,-2)) : 'UNDEF'); p("R136-rsa-rt", (defined $rder && defined $rsa && "$rsa" eq "".$bi->decode($rder)) ? 'SAME' : 'DIFF'); p("R137-rsa-digits", defined $rsa ? length("$rsa") : -1); # ...and the same modulus in the structure it actually travels in: a bare # RSAPublicKey, modulus + public exponent 65537. Here the value is passed as a # Math::BigInt OBJECT, which is the natural calling convention inside a SEQUENCE. my $key = $ib->find('Key'); my $kder = defined $rsa ? $key->encode({ n => $rsa, e => 65537 }) : undef; p("R138-key-hdr", defined $kder ? hx(substr($kder,0,8)) : 'UNDEF'); p("R139-key-len", defined $kder ? length($kder) : -1); p("R140-key-tail", defined $kder ? hx(substr($kder,-5)) : 'UNDEF'); my $kd = defined $kder ? $key->decode($kder) : undef; p("R141-key-n-rt", ($kd && defined $rsa && "$rsa" eq "".$kd->{n}) ? 'SAME' : 'DIFF'); p("R142-key-e", $kd ? $kd->{e} : 'UNDEF'); # The trap, pinned because it fails SILENTLY: passing that same object at TOP # level encodes as zero with no error set. _encode tests UNIVERSAL::isa($stash, # 'HASH'), and a Math::BigInt is a blessed hash, so the object is mistaken for a # stash and the value read out of it is undef. Inside a SEQUENCE (above) it is # fine. Nothing warns; the caller gets a well-formed encoding of the wrong # number, which is worse than an error. my $otop = do { local $SIG{__WARN__} = sub {}; # _encode warns from its own file defined $rsa ? $bi->encode($rsa) : undef }; p("R143-obj-at-top", defined $otop ? hx($otop) : 'UNDEF'); p("R144-obj-at-top-err", ($bi->error // '') eq '' ? 'NONE' : 'SET'); print "ALL-ASN1-OK\n";