include "bytedata.s7i";
include "unicode.s7i";
const array string: classTagName is [0] (
"EOC (End-of-Content)",
"BOOLEAN",
"INTEGER",
"BIT STRING",
"OCTET STRING",
"NULL",
"OBJECT IDENTIFIER",
"Object Descriptor",
"EXTERNAL",
"REAL (float)",
"ENUMERATED",
"EMBEDDED PDV",
"UTF8String",
"RELATIVE-OID",
"(reserved 14)",
"(reserved 15)",
"SEQUENCE",
"SET",
"NumericString",
"PrintableString",
"T61String",
"VideotexString",
"IA5String",
"UTCTime",
"GeneralizedTime",
"GraphicString",
"VisibleString",
"GeneralString",
"UniversalString",
"CHARACTER STRING",
"BMPString",
"(use long-form)"
);
const type: asn1TagType is new enum
tagEndOfContent,
tagBoolean,
tagInteger,
tagBitString,
tagOctetString,
tagNull,
tagObjectIdentifier,
tagObjectDescriptor,
tagExternal,
tagReal,
tagEnumerated,
tagEmbeddedPdv,
tagUTF8String,
tagRelativeOid,
tagReserved14,
tagReserved15,
tagSequence,
tagSet,
tagNumericString,
tagPrintableString,
tagT61String,
tagVideotexString,
tagIA5String,
tagUTCTime,
tagGeneralizedTime,
tagGraphicString,
tagVisibleString,
tagGeneralString,
tagUniversalString,
tagCharacterString,
tagBMPString,
tagUseLongForm
end enum;
const type: asn1TagClass is new enum
universalTagClass, applicationTagClass, contextSpecificTagClass, privateTagClass
end enum;
const type: asn1DataElement is new struct
var asn1TagClass: tagClass is universalTagClass;
var boolean: constructed is FALSE;
var asn1TagType: tagType is tagEndOfContent;
var boolean: indefinite is FALSE;
var integer: dataStart is 0;
var integer: length is 0;
end struct;
const func asn1TagType: (in asn1DataElement: dataElem) . tagCategory is
return dataElem.tagType;
const varfunc asn1TagType: (inout asn1DataElement: dataElem) . tagCategory is
return var dataElem.tagType;
const func string: encodeObjectIdentifier (in array integer: oid) is func
result
var string: encodedOid is "";
local
var integer: pos is 3;
var integer: subId is 0;
var string: subIdStri is "";
begin
encodedOid := str(chr(oid[1] * 40 + oid[2]));
while pos <= length(oid) do
subId := oid[pos];
if subId < 0 then
raise RANGE_ERROR;
elsif subId <= 127 then
encodedOid &:= chr(subId);
else
subIdStri := str(chr(subId mod 128));
subId := subId mdiv 128;
repeat
subIdStri := str(chr(subId mod 128 + 128)) & subIdStri;
subId := subId mdiv 128;
until subId = 0;
encodedOid &:= subIdStri;
end if;
incr(pos);
end while;
end func;
const func array integer: decodeObjectIdentifier (in string: encodedOid) is func
result
var array integer: oid is 0 times 0;
local
var integer: pos is 2;
var integer: subId is 0;
var boolean: highBitClear is FALSE;
begin
oid &:= ord(encodedOid[1]) mdiv 40;
oid &:= ord(encodedOid[1]) mod 40;
while pos <= length(encodedOid) do
subId := 0;
repeat
subId *:= 128;
subId +:= ord(encodedOid[pos]) mod 128;
highBitClear := ord(encodedOid[pos]) <= 127;
incr(pos);
until highBitClear;
oid &:= subId;
end while;
end func;
const func string: objectIdentifier (in string: encodedOid) is func
result
var string: stri is "";
local
var integer: pos is 2;
var integer: subId is 0;
var boolean: highBitClear is FALSE;
begin
stri := str(ord(encodedOid[1]) mdiv 40);
stri &:= " " & str(ord(encodedOid[1]) mod 40);
while pos <= length(encodedOid) do
subId := 0;
repeat
subId *:= 128;
subId +:= ord(encodedOid[pos]) mod 128;
highBitClear := ord(encodedOid[pos]) <= 127;
incr(pos);
until highBitClear;
stri &:= " " & str(subId);
end while;
end func;
const func asn1DataElement: getAsn1DataElement (in string: stri, inout integer: pos) is func
result
var asn1DataElement: dataElement is asn1DataElement.value;
local
var integer: classTag is 0;
var integer: length is 0;
var integer: eocPos is 0;
var integer: numOctets is 0;
begin
classTag := ord(stri[pos]);
incr(pos);
length := ord(stri[pos]);
incr(pos);
dataElement.tagClass := asn1TagClass conv (classTag >> 6);
dataElement.constructed := (classTag >> 5) mod 2 <> 0;
dataElement.tagType := asn1TagType conv (classTag mod 32);
if length <= 127 then
dataElement.length := length;
elsif length = 128 then
dataElement.indefinite := TRUE;
eocPos := pos(stri, "\0;\0;", pos);
if eocPos <> 0 then
dataElement.length := eocPos - pos;
else
dataElement.length := length(stri) + 1 - pos;
end if;
else
numOctets := length mod 128;
dataElement.length := bytes2Int(stri[pos fixLen numOctets], UNSIGNED, BE);
pos +:= numOctets;
end if;
dataElement.dataStart := pos;
end func;
const func string: getData (in string: stri, inout integer: pos,
in asn1DataElement: dataElement) is func
result
var string: data is "";
begin
data := stri[dataElement.dataStart len dataElement.length];
pos +:= dataElement.length;
end func;
const proc: skipData (inout integer: pos, in asn1DataElement: dataElement) is func
begin
pos +:= dataElement.length;
end func;
const func string: genAsn1Length (in integer: length) is func
result
var string: asn1 is "";
local
var string: lengthAsBytes is "";
begin
if length <= 127 then
asn1 &:= chr(length);
else
lengthAsBytes := bytes(length, UNSIGNED, BE);
asn1 &:= chr(128 + length(lengthAsBytes));
asn1 &:= lengthAsBytes;
end if;
end func;
const func asn1TagType: asn1TagTypeOfString (in string: stri) is func
result
var asn1TagType: tagType is tagEndOfContent;
local
const set of char: visibleChar is {' ' .. '~'};
const set of char: printableChar is
{'A' .. 'Z'} | {'a' .. 'z'} | {'0' .. '9'} |
{' ', ''', '(', ')', '+', ',', '-', '.', '/', ':', '=', '?'};
var boolean: isPrintableString is TRUE;
var boolean: isVisibleString is TRUE;
var char: ch is ' ';
begin
for ch range stri until not isPrintableString do
if ch not in printableChar then
isPrintableString := FALSE;
end if;
if ch not in visibleChar then
isVisibleString := FALSE;
end if;
end for;
if isPrintableString then
tagType := tagPrintableString;
elsif isVisibleString then
tagType := tagVisibleString;
else
tagType := tagUTF8String;
end if;
end func;
const func string: genAsn1Element (in asn1TagType: tagType, in string: data) is func
result
var string: asn1 is "";
begin
asn1 &:= chr(ord(tagType));
asn1 &:= genAsn1Length(length(data));
asn1 &:= data;
end func;
const func string: genAsn1Integer (in string: data) is func
result
var string: asn1 is "";
begin
asn1 &:= chr(ord(tagInteger));
asn1 &:= genAsn1Length(length(data));
asn1 &:= data;
end func;
const func string: genAsn1String (in string: data) is func
result
var string: asn1 is "";
local
var asn1TagType: tagType is tagEndOfContent;
begin
tagType := asn1TagTypeOfString(data);
if tagType = tagUTF8String then
asn1 := genAsn1Element(tagUTF8String, toUtf8(data));
else
asn1 := genAsn1Element(tagType, data);
end if;
end func;
const func string: genAsn1Sequence (in string: data) is func
result
var string: asn1 is "";
begin
asn1 &:= chr(ord(tagSequence) + 32);
asn1 &:= genAsn1Length(length(data));
asn1 &:= data;
end func;
const func string: genAsn1Set (in string: data) is func
result
var string: asn1 is "";
begin
asn1 &:= chr(ord(tagSet) + 32);
asn1 &:= genAsn1Length(length(data));
asn1 &:= data;
end func;
const func string: genExplicitAsn1Tag (in integer: tagNumber, in string: data) is func
result
var string: asn1 is "";
begin
asn1 &:= chr(tagNumber + 160);
asn1 &:= genAsn1Length(length(data));
asn1 &:= data;
end func;
const proc: printAsn1 (in string: stri, inout integer: pos) is func
local
var integer: startPos is 0;
var boolean: constructed is TRUE;
var integer: classTag is 0;
var asn1TagType: tagType is tagEndOfContent;
var integer: length is 0;
var integer: numOctets is 0;
var string: contents is "";
var integer: posAfterwards is 0;
var integer: subId is 0;
begin
startPos := pos;
write(pos lpad 5 <& ": ");
classTag := ord(stri[pos]);
incr(pos);
length := ord(stri[pos]);
incr(pos);
write(classTag radix 16 lpad0 2 <& " ");
write("UACP"[(classTag >> 6) + 1]);
constructed := (classTag >> 5) mod 2 <> 0;
write("PC"[succ(ord(constructed))]);
tagType := asn1TagType conv (classTag mod 32);
write(" " <& length radix 16 lpad0 2);
if classTag mod 32 = 31 then
writeln(" *** long form *** ");
end if;
if length <= 127 then
contents := stri[pos len length];
posAfterwards := pos + length;
elsif length = 128 then
writeln(" *** indefinite form ***");
posAfterwards := pos;
contents := getAsciiz(stri, posAfterwards);
if pos <= length(stri) and stri[pos] = '\0;' then
incr(pos);
else
writeln(" *** Second byte of EOC (End-of-Content) not 0");
end if;
else
numOctets := length mod 128;
if numOctets <= 7 then
length := bytes2Int(stri[pos fixLen numOctets], UNSIGNED, BE);
else
writeln(" *** numOctets (" <& numOctets <& ") too big.");
length := 0;
end if;
pos +:= numOctets;
contents := stri[pos len length];
posAfterwards := pos + length;
end if;
write(" " <& length lpad 4);
if (classTag >> 6) = 2 then
write(" EXPLICIT TAG [" <& ord(tagType) <& "]");
else
write(" " <& classTagName[ord(tagType)]);
end if;
if tagType = tagObjectIdentifier then
write(":");
for subId range decodeObjectIdentifier(contents) do
write(" " <& subId);
end for;
writeln(" (" <& literal(contents) <& ")");
else
writeln(": " <& literal(contents));
end if;
if constructed then
while pos < posAfterwards do
printAsn1(stri, pos);
end while;
if pos <> posAfterwards then
writeln("strange things happen " <& pos <& " " <& posAfterwards);
end if;
writeln("Leaving construct started at " <& startPos);
else
if posAfterwards > succ(length(stri)) then
writeln("strange things happen " <& posAfterwards <& " " <& succ(length(stri)));
end if;
pos := posAfterwards;
end if;
end func;
const proc: printAsn1 (in string: stri) is func
local
var integer: pos is 1;
begin
while pos < length(stri) do
printAsn1(stri, pos);
end while;
end func;
const proc: searchLengthByte (in string: stri, in integer: pos) is func
local
var integer: testPos is 0;
var integer: printPos is 0;
begin
for testPos range pred(pos) downto 2 do
if ord(stri[testPos]) = pred(pos - testPos) then
printPos := pred(testPos);
printAsn1(stri, printPos);
end if;
end for;
end func;