{ *********************************************************************************** } { * CryptoLib Library * } { * Copyright (c) 2018 - 20XX Ugochukwu Mmaduekwe * } { * Github Repository * } { * Distributed under the MIT software license, see the accompanying file LICENSE * } { * or visit http://www.opensource.org/licenses/mit-license.php. * } { * Acknowledgements: * } { * * } { * Thanks to Sphere 10 Software (http://www.sphere10.com/) for sponsoring * } { * development of this library * } { * ******************************************************************************* * } (* &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& *) unit ClpAsn1Objects; {$I ..\Include\CryptoLib.inc} interface uses Classes, Math, SyncObjs, StrUtils, SysUtils, Generics.Collections, ClpEncoders, ClpBits, ClpBigInteger, ClpArrayUtils, ClpStringUtils, ClpCryptoLibTypes, ClpConverters, ClpIAsn1Objects, ClpOidTokenizer, ClpIOidTokenizer; resourcestring SDataOverflow = 'Data Overflow'; SCorruptedStreamInvalidTag = 'Corrupted Stream - Invalid High Tag Number Found'; SEOFFound = 'EOF Found Inside Tag Value'; SInvalidEnd = 'EOF Found When Length Expected'; SInvalidDerLength = 'DER Length More Than 4 Bytes: %d'; SEndOfStream = 'EOF Found Reading Length'; SNegativeLength = 'Corrupted Stream - Negative Length Found'; SOutOfBoundsLength = 'Corrupted stream - Out of Bounds Length Found'; SUnknownTag = 'Unknown Tag " %d " Encountered'; SEndOfContent = 'Unexpected End-of-Contents Marker'; SIndefiniteLength = 'Indefinite Length Primitive Encoding Encountered'; SUnknownBerObject = 'Unknown BER Object Encountered'; SCorruptedStream = 'Corrupted Stream Detected: %s'; SInvalidLength = 'Negative Lengths not Allowed", "Length"'; SEndOfStreamTwo = 'DEF Length %d " TObject truncated by " %d'; SInvalidBufferLength = 'Buffer Length Not Right For Data'; SMalformedContent = 'Malformed End-of-Contents Marker'; SExtraData = 'Extra Data Found After Object'; SUnRecognizedObjectStream = 'Cannot Recognise Object in Stream'; SUnRecognizedObjectByteArray = 'Cannot Recognise Object in ByteArray'; SIllegalObject = 'Illegal Object in GetInstance: %s, "obj"'; SStrNil = '"Str" Cannot be Nil'; SProcessingError = 'Error Processing Object : "%s"'; SInvalidObject = 'Object Implicit - Explicit Expected.'; SUnknownObject = 'Unknown object in GetInstance: %s, "obj"'; SInvalidSequence = 'Failed to Construct Sequence from byte array: "%s"'; SImplicitObject = 'Implicitly Tagged Object'; SImplicitTag = 'Implicit Tagging for Tag: %d'; SUnknownObjectBER = 'Unknown BER Object Encountered: $%x'; SImplicitTagging = 'Implicit Tagging not Implemented'; SUnConstructedEncoding = 'Sequences Must Use Constructed Encoding (see X.690 8.9.1/8.10.1)'; SUnConstructedEncoding2 = 'Sets Must Use Constructed Encoding (see X.690 8.11.1/8.12.1)'; SMalformedObject = 'Malformed Object %s'; SUnSupportedTag = 'Unsupported Tag Number'; SConvertError = 'EIOCryptoLibException Converting Stream to Byte Array: %s'; SEncodingError = 'Encoding Error in GetInstance: %s "obj"'; SDataNil = '"data"'; SInvalidRange = 'Must be in the Range 0 to 7", "padBits"'; SPadBitError = 'If "data" is Empty, "padBits" Must be 0'; SUnalignedData = 'Attempt to Get non-octet Aligned Data from BIT STRING"'; STruncatedBitString = 'Truncated BIT STRING Detected", "octets"'; SNotImplemented = 'Not Implemented %s'; SUnConstructedTag = 'Explicit Tags Must be Constructed (see X.690 8.14.2)'; SParsingError = '%s'; SEmptyInput = 'Input Cannot be Empty "astr"'; SInvalidValue = 'Byte Value Should Have 1 Byte in it'', "val"'; SInvalidBooleanValue = 'BOOLEAN Value Should Have 1 Byte in it", "Value"'; SMalformedEnumerated = 'Malformed Enumerated'; SZeroLength = 'Enumerated has Zero Length, "enc"'; SInvalidEncoding = 'Invalid Encoding Value: %d'; SFewObject = 'Too Few Objects in Input Vector, "v"'; SVectorTooLarge = 'Input Vector too Large", "vector"'; SNoTaggedObjectFound = 'No Tagged Object Found in Vector. Structure Doesn ''t Seem to be of Type External, "Vector"'; SInvalidEncodingValue = 'Invalid Encoding Value'; SObjectNil = ' "obj" Can''t be Nil'; SValueNil = ' "value" Can''t be Nil'; SMalformedInteger = 'Malformed Integer'; SIdentifierNil = 'Identifier Cannot be Empty'; SInvalidOID = '"String " %s is " not an OID"'; SInvalidBranchId = '"String " %s " not a valid OID branch", "branchID"'; SIllegalCharacters = 'String Contains Illegal Characters "str"'; SObjectEncodeError = 'Cannot Encode Object added to SET'; SIndexOutOfRange = '%d >= %d'; SInitialCapacityNegative = 'InitialCapacity must not be Negative'; SElementNil = 'element cannot be Nil'; SOtherNil = 'other cannot be Nil'; SOtherElementsNil = 'other elements cannot be Nil'; SElementsNil = '"elements" cannot be null, or contain null'; SElementVectorNil = 'elementVector cannot be Nil'; SASN1IntegerPositiveOutOfRangeError = 'ASN.1 Integer out of positive int range'; SASN1IntegerOutOfRangeError = 'ASN.1 Integer out of int range'; SEnumeratedNegative = 'enumerated must be non-negative'; // ** Start Stream Operations ** // type TStreamHelper = class helper for TStream public function ReadByte(): Int32; procedure WriteByte(b: Byte); inline; end; type TStreamSorter = class sealed(TObject) public class function Read(input: TStream; var buffer: TCryptoLibByteArray; offset, count: Int32): Int32; static; class function ReadByte(input: TStream): Int32; static; end; type TStreamUtils = class sealed(TObject) strict private const BufferSize = Int32(512); public class procedure Drain(const inStr: TStream); static; class function ReadAll(const inStr: TStream): TCryptoLibByteArray; static; inline; class function ReadAllLimited(const inStr: TStream; limit: Int32) : TCryptoLibByteArray; static; inline; class function ReadFully(const inStr: TStream; var buf: TCryptoLibByteArray) : Int32; overload; static; inline; class function ReadFully(const inStr: TStream; var buf: TCryptoLibByteArray; off, len: Int32): Int32; overload; static; class procedure PipeAll(const inStr, outStr: TStream); static; /// /// Pipe all bytes from inStr to outStr, throwing /// EStreamOverflowCryptoLibException if greater than limit bytes in /// inStr. /// /// /// Input Stream /// /// /// Limit /// /// /// Output Stream /// /// /// The number of bytes actually transferred, if not greater than /// limit /// /// class function PipeAllLimited(const inStr: TStream; limit: Int64; const outStr: TStream): Int64; static; class procedure WriteBufTo(const buf: TMemoryStream; const output: TStream); overload; static; inline; class function WriteBufTo(const buf: TMemoryStream; const output: TCryptoLibByteArray; offset: Int32): Int32; overload; static; inline; class procedure WriteZeroes(const outStr: TStream; count: Int64); static; end; type TBaseInputStream = class abstract(TStream) {$IFDEF DELPHI} private function GetPosition: Int64; inline; procedure SetPosition(const Pos: Int64); inline; procedure SetSize64(const NewSize: Int64); inline; {$ENDIF DELPHI} protected {$IFDEF FPC} function GetPosition: Int64; override; procedure SetPosition(const Pos: Int64); override; procedure SetSize64(const NewSize: Int64); override; {$ENDIF FPC} function GetSize: Int64; override; procedure SetSize(NewSize: LongInt); overload; override; procedure SetSize(const NewSize: Int64); overload; override; public function ReadByte: Int32; virtual; function Read(var buffer; count: LongInt): LongInt; overload; override; function Write(const buffer; count: LongInt): LongInt; overload; override; function Read(buffer: TCryptoLibByteArray; offset, count: LongInt) : LongInt; overload; {$IFDEF SUPPORT_TSTREAM_READ_BYTEARRAY_OVERLOAD} override {$ELSE} virtual {$ENDIF SUPPORT_TSTREAM_READ_BYTEARRAY_OVERLOAD}; function Write(const buffer: TCryptoLibByteArray; offset, count: LongInt) : LongInt; overload; {$IFDEF SUPPORT_TSTREAM_WRITE_BYTEARRAY_OVERLOAD} override {$ELSE} virtual {$ENDIF SUPPORT_TSTREAM_WRITE_BYTEARRAY_OVERLOAD}; function Seek(offset: LongInt; Origin: Word): LongInt; overload; override; function Seek(const offset: Int64; Origin: TSeekOrigin): Int64; overload; override; {$IFNDEF _FIXINSIGHT_} property Size: Int64 read GetSize write SetSize64; {$ENDIF} property Position: Int64 read GetPosition write SetPosition; end; type TFilterStream = class(TStream) protected var Fs: TStream; function GetPosition: Int64; {$IFDEF FPC} override; {$ENDIF FPC} procedure SetPosition(const Value: Int64); {$IFDEF FPC} override; {$ENDIF FPC} function GetSize: Int64; override; public constructor Create(const s: TStream); property Size: Int64 read GetSize; property Position: Int64 read GetPosition write SetPosition; function Seek(const offset: Int64; Origin: TSeekOrigin): Int64; override; function Read(var buffer; count: LongInt): LongInt; override; function Write(const buffer; count: LongInt): LongInt; override; function ReadByte(): Int32; procedure WriteByte(Value: Byte); end; type TLimitedInputStream = class abstract(TBaseInputStream) strict private var F_limit: Int32; strict protected var F_in: TStream; procedure SetParentEofDetect(&on: Boolean); public constructor Create(inStream: TStream; limit: Int32); function GetRemaining(): Int32; virtual; end; type TDefiniteLengthInputStream = class(TLimitedInputStream) strict private var F_originalLength, F_remaining: Int32; function GetRemaining: Int32; reintroduce; inline; class function GetEmptyBytes: TCryptoLibByteArray; static; inline; public constructor Create(inStream: TStream; length: Int32); function ReadByte(): Int32; override; function Read(buf: TCryptoLibByteArray; off, len: LongInt) : LongInt; override; procedure ReadAllIntoByteArray(var buf: TCryptoLibByteArray); function ToArray: TCryptoLibByteArray; property Remaining: Int32 read GetRemaining; class property EmptyBytes: TCryptoLibByteArray read GetEmptyBytes; end; type /// /// a general purpose ASN.1 decoder - note: this class differs from the
/// others in that it returns null after it has read the last object in
/// the stream. If an ASN.1 Null is encountered a DerBER Null object is
/// returned.
///
TAsn1InputStream = class(TFilterStream) strict private var Flimit: Int32; FtmpBuffers: TCryptoLibMatrixByteArray; FStream: TStream; /// /// build an object given its tag and the number of bytes to construct it /// from. /// function BuildObject(tag, tagNo, length: Int32): IAsn1Object; public constructor Create(const inputStream: TStream); overload; /// /// Create an ASN1InputStream where no DER object will be longer than /// limit. /// /// /// stream containing ASN.1 encoded data. /// /// /// maximum size of a DER encoded object. /// constructor Create(const inputStream: TStream; limit: Int32); overload; destructor Destroy(); override; /// /// the stream is automatically limited to the length of the input array. /// /// /// array containing ASN.1 encoded data. /// constructor Create(const input: TCryptoLibByteArray); overload; function ReadObject(): IAsn1Object; function ReadVector(const dIn: TDefiniteLengthInputStream) : IAsn1EncodableVector; virtual; function CreateDerSequence(const dIn: TDefiniteLengthInputStream) : IDerSequence; virtual; function CreateDerSet(const dIn: TDefiniteLengthInputStream) : IDerSet; virtual; class function FindLimit(const input: TStream): Int32; static; class function ReadTagNumber(const s: TStream; tag: Int32): Int32; static; class function ReadLength(const s: TStream; limit: Int32): Int32; static; class function GetBuffer(const defIn: TDefiniteLengthInputStream; const tmpBuffers: TCryptoLibMatrixByteArray): TCryptoLibByteArray; static; inline; class function CreatePrimitiveDerObject(tagNo: Int32; const defIn: TDefiniteLengthInputStream; const tmpBuffers: TCryptoLibMatrixByteArray): IAsn1Object; static; end; type TDerOutputStream = class(TFilterStream) strict private procedure WriteLength(length: Int32); strict protected procedure WriteNull(); public constructor Create(const os: TStream); procedure WriteEncoded(tag: Int32; const bytes: TCryptoLibByteArray); overload; procedure WriteEncoded(tag: Int32; first: Byte; const bytes: TCryptoLibByteArray); overload; procedure WriteEncoded(tag: Int32; const bytes: TCryptoLibByteArray; offset, length: Int32); overload; procedure WriteEncoded(flags, tagNo: Int32; const bytes: TCryptoLibByteArray); overload; procedure WriteTag(flags, tagNo: Int32); procedure WriteObject(const obj: IAsn1Encodable); overload; virtual; procedure WriteObject(const obj: IAsn1Object); overload; virtual; end; type TAsn1OutputStream = class sealed(TDerOutputStream) public constructor Create(os: TStream); end; type // TODO Make Obsolete in favour of Asn1OutputStream? TBerOutputStream = class sealed(TDerOutputStream) public constructor Create(os: TStream); end; type TConstructedOctetStream = class(TBaseInputStream) strict private var F_parser: IAsn1StreamParser; F_first: Boolean; F_currentStream: TStream; public constructor Create(const parser: IAsn1StreamParser); function Read(buffer: TCryptoLibByteArray; offset, count: LongInt) : LongInt; override; function ReadByte(): Int32; override; end; type TIndefiniteLengthInputStream = class(TLimitedInputStream) strict private var F_lookAhead: Int32; F_eofOn00: Boolean; function CheckForEof(): Boolean; inline; function RequireByte(): Int32; inline; public constructor Create(inStream: TStream; limit: Int32); procedure SetEofOn00(eofOn00: Boolean); function Read(buffer: TCryptoLibByteArray; offset, count: LongInt) : LongInt; override; function ReadByte(): Int32; override; end; // ** End Stream Operations ** // type TCollectionUtilities = class sealed(TObject) public class function ToStructuredString(c: TCryptoLibGenericArray) : String; static; end; type TAsn1Encodable = class abstract(TInterfacedObject, IAsn1Encodable, IAsn1Convertible) public const Der: String = 'DER'; Ber: String = 'BER'; function GetEncoded(): TCryptoLibByteArray; overload; function GetEncoded(const encoding: String): TCryptoLibByteArray; overload; /// /// Return the DER encoding of the object, null if the DER encoding can /// not be made. /// /// /// return a DER byte array, null otherwise. /// function GetDerEncoded(): TCryptoLibByteArray; overload; function Equals(const other: IAsn1Convertible): Boolean; reintroduce; function GetHashCode(): {$IFDEF DELPHI}Int32; {$ELSE}PtrInt; {$ENDIF DELPHI}override; function ToAsn1Object(): IAsn1Object; virtual; abstract; class function IsNullOrContainsNull(const data : TCryptoLibGenericArray): Boolean; static; class function OpenArrayToDynamicArray(const data: array of IAsn1Encodable) : TCryptoLibGenericArray; static; end; type TAsn1Object = class abstract(TAsn1Encodable, IAsn1Object) strict protected function Asn1Equals(const asn1Object: IAsn1Object): Boolean; virtual; abstract; function Asn1GetHashCode(): Int32; virtual; abstract; public /// Create a base ASN.1 object from a byte array. /// The byte array to parse. /// The base ASN.1 object represented by the byte array. /// /// If there is a problem parsing the data, or parsing an object did not exhaust the available data. /// class function FromByteArray(const data: TCryptoLibByteArray) : IAsn1Object; static; /// Read a base ASN.1 object from a stream. /// The stream to parse. /// The base ASN.1 object represented by the byte array. /// If there is a problem parsing the data. class function FromStream(const inStr: TStream): IAsn1Object; static; function ToAsn1Object(): IAsn1Object; override; procedure Encode(const derOut: TStream); virtual; abstract; function CallAsn1Equals(const obj: IAsn1Object): Boolean; function CallAsn1GetHashCode(): Int32; end; type TDerObjectIdentifier = class(TAsn1Object, IDerObjectIdentifier) strict private const LONG_LIMIT = Int64((Int64($7FFFFFFFFFFFFFFF) shr 7) - $7F); class var FLock: TCriticalSection; Fcache: array [0 .. 1023] of IDerObjectIdentifier; var Fidentifier: String; Fbody: TCryptoLibByteArray; class procedure Boot(); static; class constructor CreateDerObjectIdentifier(); class destructor DestroyDerObjectIdentifier(); constructor Create(const oid: IDerObjectIdentifier; const branchID: String); overload; constructor Create(const bytes: TCryptoLibByteArray); overload; function GetID: String; inline; procedure WriteField(const outputStream: TStream; fieldValue: Int64); overload; procedure WriteField(const outputStream: TStream; const fieldValue: TBigInteger); overload; procedure DoOutput(const bOut: TMemoryStream); overload; function GetBody(): TCryptoLibByteArray; class function IsValidBranchID(const branchID: String; start: Int32) : Boolean; static; class function IsValidIdentifier(const identifier: String): Boolean; static; class function MakeOidStringFromBytes(const bytes: TCryptoLibByteArray) : String; static; strict protected function Asn1GetHashCode(): Int32; override; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public // /** // * return an Oid from the passed in object // * // * @exception ArgumentException if the object cannot be converted. // */ class function GetInstance(const obj: TObject): IDerObjectIdentifier; overload; static; // /** // * return an Oid from the passed in byte array // */ class function GetInstance(const obj: TCryptoLibByteArray) : IDerObjectIdentifier; overload; static; inline; // /** // * return an object Identifier from a tagged object. // * // * @param obj the tagged object holding the object we want // * @param explicitly true if the object is meant to be explicitly // * tagged false otherwise. // * @exception ArgumentException if the tagged object cannot // * be converted. // */ class function GetInstance(const obj: IAsn1TaggedObject; explicitly: Boolean): IDerObjectIdentifier; overload; static; inline; class function FromOctetString(const enc: TCryptoLibByteArray) : IDerObjectIdentifier; static; constructor Create(const identifier: String); overload; property ID: String read GetID; function Branch(const branchID: String): IDerObjectIdentifier; virtual; // /** // * Return true if this oid is an extension of the passed in branch, stem. // * @param stem the arc or branch that is a possible parent. // * @return true if the branch is on the passed in stem, false otherwise. // */ function &on(const stem: IDerObjectIdentifier): Boolean; virtual; procedure Encode(const derOut: TStream); override; function ToString(): String; override; end; type /// /// Mutable class for building ASN.1 constructed objects such as SETs or /// SEQUENCEs. /// TAsn1EncodableVector = class sealed(TInterfacedObject, IAsn1EncodableVector) strict private const DefaultCapacity = Int32(10); var FElements: TCryptoLibGenericArray; FElementCount: Int32; FCopyOnWrite: Boolean; function GetCount: Int32; function GetSelf(Index: Int32): IAsn1Encodable; procedure Reallocate(minCapacity: Int32); class function GetEmptyElements: TCryptoLibGenericArray; static; inline; public class function FromEnumerable(const e: TList) : IAsn1EncodableVector; static; constructor Create(); overload; constructor Create(initialCapacity: Int32); overload; constructor Create(const v: array of IAsn1Encodable); overload; destructor Destroy(); override; procedure Add(const objs: array of IAsn1Encodable); overload; procedure Add(const element: IAsn1Encodable); overload; procedure AddAll(const other: IAsn1EncodableVector); procedure AddOptional(const objs: array of IAsn1Encodable); procedure AddOptionalTagged(isExplicit: Boolean; tagNo: Int32; const obj: IAsn1Encodable); property Self[Index: Int32]: IAsn1Encodable read GetSelf; default; property count: Int32 read GetCount; function GetEnumerable: TCryptoLibGenericArray; virtual; function CopyElements(): TCryptoLibGenericArray; function TakeElements(): TCryptoLibGenericArray; class function CloneElements(const elements : TCryptoLibGenericArray) : TCryptoLibGenericArray; static; class property EmptyElements: TCryptoLibGenericArray read GetEmptyElements; end; type TAsn1Generator = class abstract(TInterfacedObject, IAsn1Generator) strict private var F_out: TStream; strict protected constructor Create(outStream: TStream); function GetOut: TStream; inline; property &Out: TStream read GetOut; public procedure AddObject(const obj: IAsn1Encodable); virtual; abstract; function GetRawOutputStream(): TStream; virtual; abstract; procedure Close(); virtual; abstract; end; type /// /// A Null object. /// TAsn1Null = class abstract(TAsn1Object, IAsn1Null) public function ToString(): String; override; end; type TAsn1OctetString = class abstract(TAsn1Object, IAsn1OctetString, IAsn1OctetStringParser) strict private var FStr: TCryptoLibByteArray; strict protected function GetStr: TCryptoLibByteArray; inline; function GetParser: IAsn1OctetStringParser; inline; function Asn1GetHashCode(): Int32; override; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public property Str: TCryptoLibByteArray read GetStr; property parser: IAsn1OctetStringParser read GetParser; /// /// return an Octet string from a tagged object. /// /// /// the tagged object holding the object we want. /// /// /// explicitly true if the object is meant to be explicitly tagged false /// otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IAsn1OctetString; overload; static; /// /// return an Octet string from the given object. /// /// /// the object we want converted. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IAsn1OctetString; overload; static; /// /// the octets making up the octet string. /// constructor Create(const Str: TCryptoLibByteArray); overload; constructor Create(const obj: IAsn1Encodable); overload; function GetOctetStream(): TStream; function GetOctets(): TCryptoLibByteArray; virtual; function ToString(): String; override; end; type /// /// return an Asn1Sequence from the given object. /// TAsn1Sequence = class abstract(TAsn1Object, IAsn1Sequence) strict private var FElements: TCryptoLibGenericArray; type TAsn1SequenceParserImpl = class sealed(TInterfacedObject, IAsn1SequenceParserImpl, IAsn1SequenceParser) strict private var Fouter: IAsn1Sequence; Fmax, Findex: Int32; public constructor Create(const outer: IAsn1Sequence); function ReadObject(): IAsn1Convertible; function ToAsn1Object(): IAsn1Object; end; strict protected function GetCount: Int32; virtual; function GetParser: IAsn1SequenceParser; virtual; function GetSelf(Index: Int32): IAsn1Encodable; virtual; function Asn1GetHashCode(): Int32; override; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; function GetElements: TCryptoLibGenericArray; inline; constructor Create(); overload; constructor Create(const element: IAsn1Encodable); overload; constructor Create(const elements: array of IAsn1Encodable); overload; constructor Create(const elementVector: IAsn1EncodableVector); overload; public destructor Destroy(); override; function ToString(): String; override; function GetEnumerable: TCryptoLibGenericArray; virtual; function ToArray(): TCryptoLibGenericArray; virtual; // /** // * return the object at the sequence position indicated by index. // * // * @param index the sequence number (starting at zero) of the object // * @return the object at the sequence position indicated by index. // */ property Self[Index: Int32]: IAsn1Encodable read GetSelf; default; /// /// return an Asn1Sequence from the given object. /// /// /// the object we want converted. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IAsn1Sequence; overload; static; /// /// return an Asn1Sequence from the given object. /// /// /// the byte array we want converted. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TCryptoLibByteArray): IAsn1Sequence; overload; static; // /** // * Return an ASN1 sequence from a tagged object. There is a special // * case here, if an object appears to have been explicitly tagged on // * reading but we were expecting it to be implicitly tagged in the // * normal course of events it indicates that we lost the surrounding // * sequence - so we need to add it back (this will happen if the tagged // * object is a sequence that contains other sequences). If you are // * dealing with implicitly tagged sequences you really should // * be using this method. // * // * @param obj the tagged object. // * @param explicitly true if the object is meant to be explicitly tagged, // * false otherwise. // * @exception ArgumentException if the tagged object cannot // * be converted. // */ class function GetInstance(const obj: IAsn1TaggedObject; explicitly: Boolean): IAsn1Sequence; overload; static; property parser: IAsn1SequenceParser read GetParser; property count: Int32 read GetCount; property elements: TCryptoLibGenericArray read GetElements; end; type TDerOctetString = class(TAsn1OctetString, IDerOctetString) public /// The octets making up the octet string. constructor Create(const Str: TCryptoLibByteArray); overload; constructor Create(const obj: IAsn1Encodable); overload; destructor Destroy(); override; procedure Encode(const derOut: TStream); overload; override; class procedure Encode(const derOut: TDerOutputStream; const bytes: TCryptoLibByteArray; offset, length: Int32); reintroduce; overload; static; inline; end; type TBerOctetString = class(TDerOctetString, IBerOctetString) strict private const MaxLength = Int32(1000); var Focts: TList; function GenerateOcts(): TList; class function ToBytes(octs: TList) : TCryptoLibByteArray; static; public /// /// The octets making up the octet string. constructor Create(const Str: TCryptoLibByteArray); overload; constructor Create(const octets: TList); overload; constructor Create(const obj: IAsn1Object); overload; constructor Create(const obj: IAsn1Encodable); overload; destructor Destroy(); override; function GetOctets(): TCryptoLibByteArray; override; /// /// return the DER octets that make up this string. /// function GetEnumerable: TCryptoLibGenericArray; virtual; procedure Encode(const derOut: TStream); override; class function FromSequence(const seq: IAsn1Sequence) : IBerOctetString; static; end; type /// /// A Null object. /// TDerNull = class(TAsn1Null, IDerNull) strict private class function GetInstance: IDerNull; static; inline; const ZeroBytes: TCryptoLibByteArray = Nil; strict protected constructor Create(dummy: Int32); function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; function Asn1GetHashCode(): Int32; override; public procedure Encode(const derOut: TStream); override; class property Instance: IDerNull read GetInstance; end; type TDerSequence = class(TAsn1Sequence, IDerSequence) strict private class function GetEmpty: IDerSequence; static; inline; public class function FromVector(const elementVector: IAsn1EncodableVector) : IDerSequence; static; /// /// create an empty sequence /// constructor Create(); overload; /// /// create a sequence containing one object /// constructor Create(const element: IAsn1Encodable); overload; constructor Create(const elements: array of IAsn1Encodable); overload; /// /// create a sequence containing a vector of objects. /// constructor Create(const elementVector: IAsn1EncodableVector); overload; destructor Destroy(); override; /// /// A note on the implementation:
As Der requires the constructed, /// definite-length model to
be used for structured types, this /// varies slightly from the
ASN.1 descriptions given. Rather than /// just outputing Sequence,
we also have to specify Constructed, /// and the objects length.
///
procedure Encode(const derOut: TStream); override; class property Empty: IDerSequence read GetEmpty; end; type TBerSequence = class(TDerSequence, IBerSequence) strict private class function GetEmpty: IBerSequence; static; inline; public class function FromVector(const elementVector: IAsn1EncodableVector) : IBerSequence; static; /// /// create an empty sequence /// constructor Create(); overload; /// /// create a sequence containing one object /// constructor Create(const element: IAsn1Encodable); overload; constructor Create(const elements: array of IAsn1Encodable); overload; /// /// create a sequence containing a vector of objects. /// constructor Create(const elementVector: IAsn1EncodableVector); overload; destructor Destroy(); override; /// /// A note on the implementation:
As Der requires the constructed, /// definite-length model to
be used for structured types, this /// varies slightly from the
ASN.1 descriptions given. Rather than /// just outputing Sequence,
we also have to specify Constructed, /// and the objects length.
///
procedure Encode(const derOut: TStream); override; class property Empty: IBerSequence read GetEmpty; end; type /// ** // * ASN.1 TaggedObject - in ASN.1 notation this is any object preceded by // * a [n] where n is some number - these are assumed to follow the construction // * rules (as with sequences). // */ TAsn1TaggedObject = class abstract(TAsn1Object, IAsn1TaggedObject, IAsn1TaggedObjectParser) strict private FtagNo: Int32; Fexplicitly: Boolean; Fobj: IAsn1Encodable; strict protected // /** // * @param tagNo the tag number for this object. // * @param obj the tagged object. // */ constructor Create(tagNo: Int32; const obj: IAsn1Encodable); overload; // /** // * @param explicitly true if the object is explicitly tagged. // * @param tagNo the tag number for this object. // * @param obj the tagged object. // */ constructor Create(explicitly: Boolean; tagNo: Int32; const obj: IAsn1Encodable); overload; function GetTagNo: Int32; inline; function Getexplicitly: Boolean; inline; function Getobj: IAsn1Encodable; inline; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; function Asn1GetHashCode(): Int32; override; public class function IsConstructed(isExplicit: Boolean; const obj: IAsn1Object) : Boolean; static; class function GetInstance(const obj: IAsn1TaggedObject; explicitly: Boolean): IAsn1TaggedObject; overload; static; inline; class function GetInstance(obj: TObject): IAsn1TaggedObject; overload; static; inline; property tagNo: Int32 read GetTagNo; property explicitly: Boolean read Getexplicitly; property obj: IAsn1Encodable read Getobj; // /** // * return whether or not the object may be explicitly tagged. // *

// * Note: if the object has been read from an input stream, the only // * time you can be sure if isExplicit is returning the true state of // * affairs is if it returns false. An implicitly tagged object may appear // * to be explicitly tagged, so you need to understand the context under // * which the reading was done as well, see GetObject below.

// */ function isExplicit(): Boolean; inline; function IsEmpty(): Boolean; inline; // /** // * return whatever was following the tag. // *

// * Note: tagged objects are generally context dependent if you're // * trying to extract a tagged object you should be going via the // * appropriate GetInstance method.

// */ function GetObject(): IAsn1Object; inline; // /** // * Return the object held in this tagged object as a parser assuming it has // * the type of the passed in tag. If the object doesn't have a parser // * associated with it, the base object is returned. // */ function GetObjectParser(tag: Int32; isExplicit: Boolean): IAsn1Convertible; function ToString(): String; override; end; type TAsn1Tags = class sealed(TObject) public const &Boolean = Int32($01); &Integer = Int32($02); BitString = Int32($03); OctetString = Int32($04); Null = Int32($05); ObjectIdentifier = Int32($06); &External = Int32($08); Enumerated = Int32($0A); Sequence = Int32($10); SequenceOf = Int32($10); // for completeness &Set = Int32($11); SetOf = Int32($11); // for completeness NumericString = Int32($12); PrintableString = Int32($13); T61String = Int32($14); VideotexString = Int32($15); IA5String = Int32($16); UtcTime = Int32($17); GeneralizedTime = Int32($18); GraphicString = Int32($19); VisibleString = Int32($1A); GeneralString = Int32($1B); UniversalString = Int32($1C); BmpString = Int32($1E); Utf8String = Int32($0C); Constructed = Int32($20); Application = Int32($40); Tagged = Int32($80); end; type /// /// return an Asn1Set from the given object. /// TAsn1Set = class abstract(TAsn1Object, IAsn1Set) strict private var FElements: TCryptoLibGenericArray; function GetDerEncoded(const obj: IAsn1Encodable) : TCryptoLibByteArray; overload; /// /// return true if a <= b (arrays are assumed padded with zeros). /// class function LessThanOrEqual(const a, b: TCryptoLibByteArray) : Boolean; static; type TAsn1SetParserImpl = class sealed(TInterfacedObject, IAsn1SetParserImpl, IAsn1SetParser) strict private Fouter: IAsn1Set; Fmax, Findex: Int32; public constructor Create(const outer: IAsn1Set); function ReadObject(): IAsn1Convertible; function ToAsn1Object(): IAsn1Object; end; strict protected function GetCount: Int32; virtual; function GetParser: IAsn1SetParser; inline; function GetSelf(Index: Int32): IAsn1Encodable; virtual; function Asn1GetHashCode(): Int32; override; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; function GetElements: TCryptoLibGenericArray; inline; procedure Sort(); constructor Create(); overload; constructor Create(const element: IAsn1Encodable); overload; constructor Create(const elements: array of IAsn1Encodable); overload; constructor Create(const elementVector: IAsn1EncodableVector); overload; public destructor Destroy(); override; function ToString(): String; override; function ToArray(): TCryptoLibGenericArray; virtual; function GetEnumerable: TCryptoLibGenericArray; virtual; // /** // * return the object at the sequence position indicated by index. // * // * @param index the sequence number (starting at zero) of the object // * @return the object at the sequence position indicated by index. // */ property Self[Index: Int32]: IAsn1Encodable read GetSelf; default; /// /// return an ASN1Set from the given object. /// /// /// the object we want converted. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IAsn1Set; overload; static; /// /// return an Asn1Set from the given object. /// /// /// the byte array we want converted. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TCryptoLibByteArray): IAsn1Set; overload; static; // /** // * Return an ASN1 sequence from a tagged object. There is a special // * case here, if an object appears to have been explicitly tagged on // * reading but we were expecting it to be implicitly tagged in the // * normal course of events it indicates that we lost the surrounding // * sequence - so we need to add it back (this will happen if the tagged // * object is a sequence that contains other sequences). If you are // * dealing with implicitly tagged sequences you really should // * be using this method. // * // * @param obj the tagged object. // * @param explicitly true if the object is meant to be explicitly tagged, // * false otherwise. // * @exception ArgumentException if the tagged object cannot // * be converted. // */ class function GetInstance(const obj: IAsn1TaggedObject; explicitly: Boolean): IAsn1Set; overload; static; property parser: IAsn1SetParser read GetParser; property count: Int32 read GetCount; property elements: TCryptoLibGenericArray read GetElements; end; type /// /// A Der encoded set object /// TDerSet = class(TAsn1Set, IDerSet) strict private class function GetEmpty: IDerSet; static; inline; public class function FromVector(const elementVector: IAsn1EncodableVector) : IDerSet; overload; static; class function FromVector(const elementVector: IAsn1EncodableVector; needsSorting: Boolean): IDerSet; overload; static; /// /// create an empty set /// constructor Create(); overload; /// /// a single object that makes up the set. /// constructor Create(const element: IAsn1Encodable); overload; constructor Create(const elements: array of IAsn1Encodable); overload; /// /// a vector of objects making up the set. /// constructor Create(const elementVector: IAsn1EncodableVector); overload; constructor Create(const elementVector: IAsn1EncodableVector; needsSorting: Boolean); overload; destructor Destroy(); override; /// /// A note on the implementation:
As Der requires the constructed, /// definite-length model to
be used for structured types, this /// varies slightly from the
ASN.1 descriptions given. Rather than /// just outputing Set,
we also have to specify Constructed, and /// the objects length.
///
procedure Encode(const derOut: TStream); override; class property Empty: IDerSet read GetEmpty; end; type TAsn1StreamParser = class(TInterfacedObject, IAsn1StreamParser) strict private var F_in: TStream; F_limit: Int32; FtmpBuffers: TCryptoLibMatrixByteArray; procedure Set00Check(enabled: Boolean); inline; public constructor Create(const inStream: TStream); overload; constructor Create(const inStream: TStream; limit: Int32); overload; constructor Create(const encoding: TCryptoLibByteArray); overload; destructor Destroy; override; function ReadIndef(tagValue: Int32): IAsn1Convertible; function ReadImplicit(Constructed: Boolean; tag: Int32): IAsn1Convertible; function ReadTaggedObject(Constructed: Boolean; tag: Int32): IAsn1Object; function ReadObject(): IAsn1Convertible; virtual; function ReadVector(): IAsn1EncodableVector; inline; end; type TDerSetParser = class(TInterfacedObject, IAsn1SetParser, IAsn1Convertible, IDerSetParser) strict private var F_parser: IAsn1StreamParser; public constructor Create(const parser: IAsn1StreamParser); function ReadObject(): IAsn1Convertible; inline; function ToAsn1Object(): IAsn1Object; inline; end; type TDerSequenceParser = class(TInterfacedObject, IAsn1SequenceParser, IAsn1Convertible, IDerSequenceParser) strict private var F_parser: IAsn1StreamParser; public constructor Create(const parser: IAsn1StreamParser); function ReadObject(): IAsn1Convertible; inline; function ToAsn1Object(): IAsn1Object; inline; end; type /// /// Base class for an application specific object /// TDerApplicationSpecific = class(TAsn1Object, IDerApplicationSpecific) strict private var FisConstructed: Boolean; Ftag: Int32; Foctets: TCryptoLibByteArray; class function ReplaceTagNumber(newTag: Int32; const input: TCryptoLibByteArray): TCryptoLibByteArray; static; strict protected function GetApplicationTag: Int32; inline; function GetLengthOfHeader(const data: TCryptoLibByteArray): Int32; inline; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; function Asn1GetHashCode(): Int32; override; public constructor Create(IsConstructed: Boolean; tag: Int32; const octets: TCryptoLibByteArray); overload; constructor Create(tag: Int32; const octets: TCryptoLibByteArray); overload; constructor Create(tag: Int32; const obj: IAsn1Encodable); overload; constructor Create(isExplicit: Boolean; tag: Int32; const obj: IAsn1Encodable); overload; constructor Create(tagNo: Int32; const vec: IAsn1EncodableVector); overload; function IsConstructed(): Boolean; inline; function GetContents(): TCryptoLibByteArray; inline; /// /// Return the enclosed object assuming explicit tagging. /// /// /// the resulting object /// /// /// if reconstruction fails. /// function GetObject(): IAsn1Object; overload; inline; /// /// Return the enclosed object assuming implicit tagging. /// /// /// the type tag that should be applied to the object's contents. /// /// /// the resulting object /// /// /// if reconstruction fails. /// function GetObject(derTagNo: Int32): IAsn1Object; overload; inline; procedure Encode(const derOut: TStream); override; property ApplicationTag: Int32 read GetApplicationTag; end; type TBerApplicationSpecific = class(TDerApplicationSpecific, IBerApplicationSpecific) public constructor Create(tagNo: Int32; const vec: IAsn1EncodableVector); end; type TBerOctetStringParser = class(TInterfacedObject, IAsn1OctetStringParser, IAsn1Convertible, IBerOctetStringParser) strict private var F_parser: IAsn1StreamParser; public constructor Create(const parser: IAsn1StreamParser); function GetOctetStream(): TStream; inline; function ToAsn1Object(): IAsn1Object; end; type TBerApplicationSpecificParser = class(TInterfacedObject, IAsn1ApplicationSpecificParser, IAsn1Convertible, IBerApplicationSpecificParser) strict private var F_tag: Int32; F_parser: IAsn1StreamParser; public constructor Create(tag: Int32; const parser: IAsn1StreamParser); function ReadObject(): IAsn1Convertible; inline; function ToAsn1Object(): IAsn1Object; inline; end; type TDerStringBase = class abstract(TAsn1Object, IAsn1String, IDerStringBase) strict protected constructor Create(); function Asn1GetHashCode(): Int32; override; public function GetString(): String; virtual; abstract; function ToString(): String; override; end; type /// /// Der Bit string object. /// TDerBitString = class(TDerStringBase, IDerBitString) strict private const FTable: array [0 .. 15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'); strict protected var FmData: TCryptoLibByteArray; FmPadBits: Int32; function GetmPadBits: Int32; inline; function GetmData: TCryptoLibByteArray; inline; function Asn1GetHashCode(): Int32; override; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; property mPadBits: Int32 read GetmPadBits; property mData: TCryptoLibByteArray read GetmData; public constructor Create(const data: TCryptoLibByteArray; padBits: Int32); overload; constructor Create(const data: TCryptoLibByteArray); overload; constructor Create(namedBits: Int32); overload; constructor Create(const obj: IAsn1Encodable); overload; function GetString(): String; override; function GetOctets(): TCryptoLibByteArray; virtual; function GetBytes(): TCryptoLibByteArray; virtual; procedure Encode(const derOut: TStream); override; function GetInt32Value: Int32; virtual; property Int32Value: Int32 read GetInt32Value; /// /// return a Der Bit string from the passed in object /// /// /// a Bit string or an object that can be converted into one. /// /// /// return a Der Bit string instance, or null. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerBitString; overload; static; inline; class function GetInstance(const obj: TCryptoLibByteArray): IDerBitString; overload; static; /// /// return a Der Bit string from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// true if the object is meant to be explicitly tagged false otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerBitString; overload; static; inline; class function FromAsn1Octets(const octets: TCryptoLibByteArray) : IDerBitString; static; end; type TBerBitString = class(TDerBitString, IBerBitString) public constructor Create(const data: TCryptoLibByteArray; padBits: Int32); overload; constructor Create(const data: TCryptoLibByteArray); overload; constructor Create(namedBits: Int32); overload; constructor Create(const obj: IAsn1Encodable); overload; procedure Encode(const derOut: TStream); override; end; type TBerGenerator = class abstract(TAsn1Generator, IBerGenerator) strict private var F_tagged, F_isExplicit: Boolean; F_tagNo: Int32; strict protected constructor Create(outStream: TStream); overload; constructor Create(outStream: TStream; tagNo: Int32; isExplicit: Boolean); overload; procedure WriteHdr(tag: Int32); procedure WriteBerHeader(tag: Int32); procedure WriteBerBody(contentStream: TStream); procedure WriteBerEnd(); public procedure AddObject(const obj: IAsn1Encodable); override; function GetRawOutputStream(): TStream; override; procedure Close(); override; end; type /// /// A BER Null object. /// TBerNull = class sealed(TDerNull, IBerNull) strict private class function GetInstance: IBerNull; static; inline; constructor Create(dummy: Int32); public procedure Encode(const derOut: TStream); override; class property Instance: IBerNull read GetInstance; end; type TBerSequenceGenerator = class(TBerGenerator, IBerSequenceGenerator) public constructor Create(outStream: TStream); overload; constructor Create(outStream: TStream; tagNo: Int32; isExplicit: Boolean); overload; end; type TBerSequenceParser = class(TInterfacedObject, IAsn1SequenceParser, IAsn1Convertible, IBerSequenceParser) strict private var F_parser: IAsn1StreamParser; public constructor Create(const parser: IAsn1StreamParser); function ReadObject(): IAsn1Convertible; inline; function ToAsn1Object(): IAsn1Object; inline; end; type /// /// A Ber encoded set object /// TBerSet = class sealed(TDerSet, IBerSet) strict private class function GetEmpty: IBerSet; static; inline; public class function FromVector(const elementVector: IAsn1EncodableVector) : IBerSet; overload; static; class function FromVector(const elementVector: IAsn1EncodableVector; needsSorting: Boolean): IBerSet; overload; static; /// /// create an empty set /// constructor Create(); overload; /// /// a single object that makes up the set. /// constructor Create(const element: IAsn1Encodable); overload; /// /// a vector of objects making up the set. /// constructor Create(const elementVector: IAsn1EncodableVector); overload; constructor Create(const v: IAsn1EncodableVector; needsSorting: Boolean); overload; destructor Destroy(); override; /// /// A note on the implementation:
As Ber requires the constructed, /// definite-length model to
be used for structured types, this /// varies slightly from the
ASN.1 descriptions given. Rather than /// just outputing Set,
we also have to specify Constructed, and /// the objects length.
///
procedure Encode(const derOut: TStream); override; class property Empty: IBerSet read GetEmpty; end; type TBerSetParser = class(TInterfacedObject, IAsn1SetParser, IAsn1Convertible, IBerSetParser) strict private var F_parser: IAsn1StreamParser; public constructor Create(const parser: IAsn1StreamParser); function ReadObject(): IAsn1Convertible; inline; function ToAsn1Object(): IAsn1Object; inline; end; type /// /// DER TaggedObject - in ASN.1 notation this is any object preceded by
/// a [n] where n is some number - these are assumed to follow the /// construction
rules (as with sequences).
///
TDerTaggedObject = class(TAsn1TaggedObject, IDerTaggedObject) public /// /// the tag number for this object. /// /// /// the tagged object. /// constructor Create(tagNo: Int32; const obj: IAsn1Encodable); overload; /// /// true if an explicitly tagged object. /// /// /// the tag number for this object. /// /// /// the tagged object. /// constructor Create(explicitly: Boolean; tagNo: Int32; const obj: IAsn1Encodable); overload; /// /// create an implicitly tagged object that contains a zero length /// sequence. /// /// /// the tag number for this object. /// constructor Create(tagNo: Int32); overload; procedure Encode(const derOut: TStream); override; end; type /// /// BER TaggedObject - in ASN.1 notation this is any object preceded by
/// a [n] where n is some number - these are assumed to follow the /// construction
rules (as with sequences).
///
TBerTaggedObject = class(TDerTaggedObject, IBerTaggedObject) public /// /// the tag number for this object. /// /// /// the tagged object. /// constructor Create(tagNo: Int32; const obj: IAsn1Encodable); overload; /// /// true if an explicitly tagged object. /// /// /// the tag number for this object. /// /// /// the tagged object. /// constructor Create(explicitly: Boolean; tagNo: Int32; const obj: IAsn1Encodable); overload; /// /// create an implicitly tagged object that contains a zero length /// sequence. /// /// /// the tag number for this object. /// constructor Create(tagNo: Int32); overload; procedure Encode(const derOut: TStream); override; end; type TBerTaggedObjectParser = class(TInterfacedObject, IAsn1TaggedObjectParser, IAsn1Convertible, IBerTaggedObjectParser) strict private var F_constructed: Boolean; F_tagNumber: Int32; F_parser: IAsn1StreamParser; function GetIsConstructed: Boolean; inline; function GetTagNo: Int32; inline; public constructor Create(Constructed: Boolean; tagNumber: Int32; const parser: IAsn1StreamParser); destructor Destroy; override; function GetObjectParser(tag: Int32; isExplicit: Boolean) : IAsn1Convertible; inline; function ToAsn1Object(): IAsn1Object; property IsConstructed: Boolean read GetIsConstructed; property tagNo: Int32 read GetTagNo; end; type TDerBmpString = class(TDerStringBase, IDerBmpString) strict private var FStr: String; function GetStr: String; inline; strict protected function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public property Str: String read GetStr; /// /// basic constructor - byte encoded string. /// constructor Create(const astr: TCryptoLibByteArray); overload; /// /// basic constructor /// constructor Create(const astr: String); overload; function GetString(): String; override; procedure Encode(const derOut: TStream); override; /// /// return a BMP string from the given object. /// /// /// the object we want converted. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerBmpString; overload; static; inline; /// /// return a BMP string from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// true if the object is meant to be explicitly tagged false otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerBmpString; overload; static; inline; end; type TDerBoolean = class(TAsn1Object, IDerBoolean) strict private var Fvalue: Byte; function GetIsTrue: Boolean; inline; constructor Create(Value: Boolean); overload; class function GetFalse: IDerBoolean; static; inline; class function GetTrue: IDerBoolean; static; inline; strict protected function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; function Asn1GetHashCode(): Int32; override; public constructor Create(const val: TCryptoLibByteArray); overload; procedure Encode(const derOut: TStream); override; function ToString(): String; override; property IsTrue: Boolean read GetIsTrue; class property True: IDerBoolean read GetTrue; class property False: IDerBoolean read GetFalse; /// /// return a DerBoolean from the passed in object. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerBoolean; overload; static; inline; /// /// return a DerBoolean from the passed in boolean. /// class function GetInstance(Value: Boolean): IDerBoolean; overload; static; inline; /// /// return a Boolean from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// explicitly true if the object is meant to be explicitly tagged false /// otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerBoolean; overload; static; inline; class function FromOctetString(const Value: TCryptoLibByteArray) : IDerBoolean; static; end; type TDerEnumerated = class(TAsn1Object, IDerEnumerated) strict private class var Fcache: array [0 .. 11] of IDerEnumerated; var Fbytes: TCryptoLibByteArray; FStart: Int32; function GetValue: TBigInteger; inline; function GetBytes: TCryptoLibByteArray; inline; function GetIntValueExact: Int32; inline; strict protected function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; function Asn1GetHashCode(): Int32; override; public constructor Create(val: Int32); overload; constructor Create(val: Int64); overload; constructor Create(const val: TBigInteger); overload; constructor Create(const bytes: TCryptoLibByteArray); overload; procedure Encode(const derOut: TStream); override; property Value: TBigInteger read GetValue; property bytes: TCryptoLibByteArray read GetBytes; property IntValueExact: Int32 read GetIntValueExact; function HasValue(const x: TBigInteger): Boolean; /// /// return an integer from the passed in object /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerEnumerated; overload; static; inline; /// /// return an Enumerated from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// true if the object is meant to be explicitly tagged false otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerEnumerated; overload; static; inline; class function FromOctetString(const enc: TCryptoLibByteArray) : IDerEnumerated; static; end; type TDerGraphicString = class(TDerStringBase, IDerGraphicString) strict private var FmString: TCryptoLibByteArray; function GetmString: TCryptoLibByteArray; inline; protected function Asn1GetHashCode(): Int32; override; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public property mString: TCryptoLibByteArray read GetmString; /// /// basic constructor - with bytes. /// /// /// the byte encoding of the characters making up the string. /// constructor Create(const encoding: TCryptoLibByteArray); function GetString(): String; override; function GetOctets(): TCryptoLibByteArray; inline; procedure Encode(const derOut: TStream); override; /// /// return a Graphic String from the passed in object /// /// /// a DerGraphicString or an object that can be converted into one. /// /// /// return a DerGraphicString instance, or null. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerGraphicString; overload; static; inline; class function GetInstance(const obj: TCryptoLibByteArray) : IDerGraphicString; overload; static; /// /// return a Graphic string from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// true if the object is meant to be explicitly tagged false otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerGraphicString; overload; static; inline; end; type /// /// Class representing the DER-type External /// TDerExternal = class(TAsn1Object, IDerExternal) strict private var FdirectReference: IDerObjectIdentifier; FindirectReference: IDerInteger; FdataValueDescriptor, FexternalContent: IAsn1Object; Fencoding: Int32; function GetDataValueDescriptor: IAsn1Object; function GetDirectReference: IDerObjectIdentifier; /// /// /// The encoding of the content. Valid values are /// /// /// <ul>
<li><code>0</code> /// single-ASN1-type</li>
/// <li><code>1</code> OCTET STRING</li>
/// <li><code>2</code> BIT STRING</li>
/// </ul> ///
///
function GetEncoding: Int32; function GetExternalContent: IAsn1Object; function GetIndirectReference: IDerInteger; procedure SetDataValueDescriptor(const Value: IAsn1Object); procedure SetDirectReference(const Value: IDerObjectIdentifier); procedure SetEncoding(const Value: Int32); procedure SetExternalContent(const Value: IAsn1Object); procedure SetIndirectReference(const Value: IDerInteger); class function GetObjFromVector(const v: IAsn1EncodableVector; Index: Int32) : IAsn1Object; static; inline; class procedure WriteEncodable(ms: TMemoryStream; const e: IAsn1Encodable); static; inline; strict protected function Asn1GetHashCode(): Int32; override; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public constructor Create(const vector: IAsn1EncodableVector); overload; /// /// Creates a new instance of DerExternal
See X.690 for more /// informations about the meaning of these parameters ///
/// /// The direct reference or <code>null</code> if not set. /// /// /// The indirect reference or <code>null</code> if not set. /// /// /// The data value descriptor or <code>null</code> if not /// set. /// /// /// The external data in its encoded form. /// constructor Create(const directReference: IDerObjectIdentifier; const indirectReference: IDerInteger; const dataValueDescriptor: IAsn1Object; const externalData: IDerTaggedObject); overload; constructor Create(const directReference: IDerObjectIdentifier; const indirectReference: IDerInteger; const dataValueDescriptor: IAsn1Object; encoding: Int32; const externalData: IAsn1Object); overload; procedure Encode(const derOut: TStream); override; property dataValueDescriptor: IAsn1Object read GetDataValueDescriptor write SetDataValueDescriptor; property directReference: IDerObjectIdentifier read GetDirectReference write SetDirectReference; property encoding: Int32 read GetEncoding write SetEncoding; property ExternalContent: IAsn1Object read GetExternalContent write SetExternalContent; property indirectReference: IDerInteger read GetIndirectReference write SetIndirectReference; end; type TDerInteger = class sealed(TAsn1Object, IDerInteger) strict private class var FAllowUnsafeInteger: Boolean; class constructor CreateDerInteger(); var Fbytes: TCryptoLibByteArray; FStart: Int32; function GetBytes: TCryptoLibByteArray; inline; function GetPositiveValue: TBigInteger; inline; function GetValue: TBigInteger; inline; function GetIntPositiveValueExact: Int32; inline; function GetIntValueExact: Int32; inline; class function GetAllowUnsafeInteger: Boolean; static; inline; class procedure SetAllowUnsafeInteger(const Value: Boolean); static; inline; strict protected function Asn1GetHashCode(): Int32; override; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public const SignExtSigned = Int32(-1); SignExtUnsigned = Int32($FF); constructor Create(Value: Int32); overload; constructor Create(Value: Int64); overload; constructor Create(const Value: TBigInteger); overload; constructor Create(const bytes: TCryptoLibByteArray); overload; constructor Create(const bytes: TCryptoLibByteArray; clone: Boolean); overload; property Value: TBigInteger read GetValue; property PositiveValue: TBigInteger read GetPositiveValue; property IntPositiveValueExact: Int32 read GetIntPositiveValueExact; property IntValueExact: Int32 read GetIntValueExact; property bytes: TCryptoLibByteArray read GetBytes; procedure Encode(const derOut: TStream); override; function HasValue(const x: TBigInteger): Boolean; function ToString(): String; override; // /** // * return an integer from the passed in object // * // * @exception ArgumentException if the object cannot be converted. // */ class function GetInstance(const obj: TObject): IDerInteger; overload; static; // /** // * return an Integer from a tagged object. // * // * @param obj the tagged object holding the object we want // * @param isExplicit true if the object is meant to be explicitly // * tagged false otherwise. // * @exception ArgumentException if the tagged object cannot // * be converted. // */ class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerInteger; overload; static; inline; /// /// Apply the correct validation for an INTEGER primitive following the /// BER rules. /// /// /// The raw encoding of the integer. /// /// /// if the (in)put fails this validation. /// class function IsMalformed(const bytes: TCryptoLibByteArray) : Boolean; static; class function SignBytesToSkip(const bytes: TCryptoLibByteArray) : Int32; static; class function IntValue(const bytes: TCryptoLibByteArray; start, signExt: Int32): Int32; static; class property AllowUnsafeInteger: Boolean read GetAllowUnsafeInteger write SetAllowUnsafeInteger; end; type TDerExternalParser = class(TAsn1Encodable, IDerExternalParser) strict private var F_parser: IAsn1StreamParser; public constructor Create(const parser: IAsn1StreamParser); function ReadObject(): IAsn1Convertible; inline; function ToAsn1Object(): IAsn1Object; override; end; type TDerOctetStringParser = class(TInterfacedObject, IAsn1OctetStringParser, IAsn1Convertible, IDerOctetStringParser) strict private var FStream: TStream; public constructor Create(stream: TStream); destructor Destroy(); override; function GetOctetStream(): TStream; inline; function ToAsn1Object(): IAsn1Object; end; type TDerGeneralString = class(TDerStringBase, IDerGeneralString) strict private var FStr: String; function GetStr: String; inline; property Str: String read GetStr; strict protected function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public constructor Create(const Str: TCryptoLibByteArray); overload; constructor Create(const Str: String); overload; function GetString(): String; override; function GetOctets(): TCryptoLibByteArray; inline; procedure Encode(const derOut: TStream); override; class function GetInstance(const obj: TObject): IDerGeneralString; overload; static; inline; class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerGeneralString; overload; static; inline; end; type TDerGenerator = class abstract(TAsn1Generator, IDerGenerator) strict private var F_tagged, F_isExplicit: Boolean; F_tagNo: Int32; class procedure WriteLength(const outStr: TStream; length: Int32); static; strict protected constructor Create(const outStream: TStream); overload; constructor Create(const outStream: TStream; tagNo: Int32; isExplicit: Boolean); overload; public procedure WriteDerEncoded(tag: Int32; const bytes: TCryptoLibByteArray); overload; class procedure WriteDerEncoded(const outStream: TStream; tag: Int32; const bytes: TCryptoLibByteArray); overload; static; class procedure WriteDerEncoded(const outStr: TStream; tag: Int32; const inStr: TStream); overload; static; end; type /// /// Der IA5String object - this is an ascii string. /// TDerIA5String = class(TDerStringBase, IDerIA5String) strict private var FStr: String; function GetStr: String; inline; property Str: String read GetStr; strict protected function Asn1GetHashCode(): Int32; override; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public /// /// basic constructor - with bytes. /// constructor Create(const Str: TCryptoLibByteArray); overload; /// /// basic constructor - without validation. /// constructor Create(const Str: String); overload; /// /// Constructor with optional validation. /// /// /// the base string to wrap. /// /// /// whether or not to check the string. /// /// /// if validate is true and the string contains characters that should /// not be in an IA5String. /// constructor Create(const Str: String; validate: Boolean); overload; function GetString(): String; override; function GetOctets(): TCryptoLibByteArray; inline; procedure Encode(const derOut: TStream); override; /// /// return a DerIA5String from the passed in object /// /// /// a DerIA5String or an object that can be converted into one. /// /// /// return a DerIA5String instance, or null. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerIA5String; overload; static; inline; /// /// return a DerIA5String from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// true if the object is meant to be explicitly tagged false otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerIA5String; overload; static; inline; /// /// return true if the passed in String can be represented without loss /// as an IA5String, false otherwise. /// /// /// true if in printable set, false otherwise. /// class function IsIA5String(const Str: String): Boolean; static; inline; end; type /// /// Der NumericString object - this is an ascii string of characters /// {0,1,2,3,4,5,6,7,8,9, }. /// TDerNumericString = class(TDerStringBase, IDerNumericString) strict private var FStr: String; function GetStr: String; inline; property Str: String read GetStr; strict protected function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public /// /// basic constructor - with bytes. /// constructor Create(const Str: TCryptoLibByteArray); overload; /// /// basic constructor - without validation. /// constructor Create(const Str: String); overload; /// /// Constructor with optional validation. /// /// /// the base string to wrap. /// /// /// whether or not to check the string. /// /// /// if validate is true and the string contains characters that should /// not be in an IA5String. /// constructor Create(const Str: String; validate: Boolean); overload; function GetString(): String; override; function GetOctets(): TCryptoLibByteArray; inline; procedure Encode(const derOut: TStream); override; /// /// return a Numeric string from the passed in object /// /// /// a DerNumericString or an object that can be converted into one. /// /// /// return a DerNumericString instance, or null. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerNumericString; overload; static; inline; /// /// return a Numeric String from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// true if the object is meant to be explicitly tagged false otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerNumericString; overload; static; inline; /// /// Return true if the string can be represented as a NumericString /// ('0'..'9', ' ') /// /// /// string to validate. /// /// /// true if numeric, false otherwise. /// class function IsNumericString(const Str: String): Boolean; static; inline; end; type /// /// Der PrintableString object. /// TDerPrintableString = class(TDerStringBase, IDerPrintableString) strict private var FStr: String; function GetStr: String; inline; strict protected function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public /// /// basic constructor - with bytes. /// constructor Create(const Str: TCryptoLibByteArray); overload; /// /// basic constructor - without validation. /// constructor Create(const Str: String); overload; /// /// Constructor with optional validation. /// /// /// the base string to wrap. /// /// /// whether or not to check the string. /// /// /// if validate is true and the string contains characters that should /// not be in an PrintableString. /// constructor Create(const Str: String; validate: Boolean); overload; function GetString(): String; override; function GetOctets(): TCryptoLibByteArray; inline; procedure Encode(const derOut: TStream); override; property Str: String read GetStr; /// /// return a printable string from the passed in object. /// /// /// a DerPrintableString or an object that can be converted into one. /// /// /// return a DerPrintableString instance, or null. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerPrintableString; overload; static; inline; /// /// return a Printable string from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// true if the object is meant to be explicitly tagged false otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerPrintableString; overload; static; inline; /// /// return true if the passed in String can be represented without loss /// as a PrintableString, false otherwise. /// /// /// string to validate. /// /// /// return true if in printable set, false otherwise. /// class function IsPrintableString(const Str: String): Boolean; static; inline; end; type TDerSequenceGenerator = class(TDerGenerator, IDerSequenceGenerator) strict private var F_bOut: TMemoryStream; public constructor Create(outStream: TStream); overload; constructor Create(outStream: TStream; tagNo: Int32; isExplicit: Boolean); overload; destructor Destroy(); override; procedure AddObject(const obj: IAsn1Encodable); override; function GetRawOutputStream(): TStream; override; procedure Close(); override; end; type /// /// Der T61String (also the teletex string) - 8-bit characters /// TDerT61String = class(TDerStringBase, IDerT61String) strict private var FStr: String; function GetStr: String; inline; property Str: String read GetStr; class function GetEncoding: TEncoding; static; inline; strict protected function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public /// /// basic constructor - with bytes. /// constructor Create(const Str: TCryptoLibByteArray); overload; /// /// basic constructor /// constructor Create(const Str: String); overload; function GetString(): String; override; function GetOctets(): TCryptoLibByteArray; inline; procedure Encode(const derOut: TStream); override; /// /// return a T61 string from the passed in object. /// /// /// a Der T61 string or an object that can be converted into one. /// /// /// return a Der T61 string instance, or null. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerT61String; overload; static; inline; /// /// return a Der T61 string from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// true if the object is meant to be explicitly tagged false otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerT61String; overload; static; inline; end; type /// /// Der UniversalString object. /// TDerUniversalString = class(TDerStringBase, IDerUniversalString) strict private var FStr: TCryptoLibByteArray; const FTable: array [0 .. 15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'); function GetStr: TCryptoLibByteArray; inline; property Str: TCryptoLibByteArray read GetStr; strict protected function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public /// /// basic constructor - byte encoded string. /// constructor Create(const Str: TCryptoLibByteArray); overload; function GetString(): String; override; function GetOctets(): TCryptoLibByteArray; inline; procedure Encode(const derOut: TStream); override; /// /// return a Universal String from the passed in object. /// /// /// a Der T61 string or an object that can be converted into one. /// /// /// return a Der UniversalString instance, or null. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerUniversalString; overload; static; inline; /// /// return a Der UniversalString from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// true if the object is meant to be explicitly tagged false otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerUniversalString; overload; static; inline; end; type /// /// Der UTF8String object. /// TDerUtf8String = class(TDerStringBase, IDerUtf8String) strict private var FStr: String; function GetStr: String; inline; property Str: String read GetStr; strict protected function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public /// /// basic constructor - with bytes. /// constructor Create(const Str: TCryptoLibByteArray); overload; /// /// basic constructor /// constructor Create(const Str: String); overload; function GetString(): String; override; procedure Encode(const derOut: TStream); override; /// /// return an UTF8 string from the passed in object. /// /// /// a Der UTF8String or an object that can be converted into one. /// /// /// return a Der UTF8String instance, or null. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerUtf8String; overload; static; inline; /// /// return a Der UTF8String from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// true if the object is meant to be explicitly tagged false otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerUtf8String; overload; static; inline; end; type TDerVideotexString = class(TDerStringBase, IDerVideotexString) strict private var FmString: TCryptoLibByteArray; function GetmString: TCryptoLibByteArray; inline; protected function Asn1GetHashCode(): Int32; override; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public property mString: TCryptoLibByteArray read GetmString; /// /// basic constructor - with bytes. /// /// /// the byte encoding of the characters making up the string. /// constructor Create(const encoding: TCryptoLibByteArray); function GetString(): String; override; function GetOctets(): TCryptoLibByteArray; inline; procedure Encode(const derOut: TStream); override; /// /// return a Videotex String from the passed in object /// /// /// a DerVideotexString or an object that can be converted into one. /// /// /// return a DerVideotexString instance, or null. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerVideotexString; overload; static; inline; class function GetInstance(const obj: TCryptoLibByteArray) : IDerVideotexString; overload; static; /// /// return a Videotex string from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// true if the object is meant to be explicitly tagged false otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerVideotexString; overload; static; inline; end; type /// /// Der VisibleString object. /// TDerVisibleString = class(TDerStringBase, IDerVisibleString) strict private var FStr: String; function GetStr: String; inline; property Str: String read GetStr; strict protected function Asn1GetHashCode(): Int32; override; function Asn1Equals(const asn1Object: IAsn1Object): Boolean; override; public /// /// basic constructor - byte encoded string. /// constructor Create(const Str: TCryptoLibByteArray); overload; /// /// basic constructor /// constructor Create(const Str: String); overload; function GetString(): String; override; function GetOctets(): TCryptoLibByteArray; inline; procedure Encode(const derOut: TStream); override; /// /// return a DerVisibleString from the passed in object /// /// /// a DerVisibleString or an object that can be converted into one. /// /// /// return a DerVisibleString instance, or null. /// /// /// if the object cannot be converted. /// class function GetInstance(const obj: TObject): IDerVisibleString; overload; static; inline; /// /// return a DerVisibleString from a tagged object. /// /// /// the tagged object holding the object we want /// /// /// true if the object is meant to be explicitly tagged false otherwise. /// /// /// if the tagged object cannot be converted. /// class function GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerVisibleString; overload; static; inline; end; implementation { TStreamHelper } function TStreamHelper.ReadByte: Int32; var buffer: TCryptoLibByteArray; begin System.SetLength(buffer, 1); if (TStreamSorter.Read(Self, buffer, 0, 1) = 0) then begin result := -1; end else begin result := Int32(buffer[0]); end; end; procedure TStreamHelper.WriteByte(b: Byte); var oneByteArray: TCryptoLibByteArray; begin System.SetLength(oneByteArray, 1); oneByteArray[0] := b; // Self.Write(oneByteArray, 0, 1); Self.Write(oneByteArray[0], 1); end; { TStreamSorter } class function TStreamSorter.Read(input: TStream; var buffer: TCryptoLibByteArray; offset, count: Int32): Int32; begin if input is TIndefiniteLengthInputStream then begin result := (input as TIndefiniteLengthInputStream). Read(buffer, offset, count); end else if input is TDefiniteLengthInputStream then begin result := (input as TDefiniteLengthInputStream).Read(buffer, offset, count); end else if input is TConstructedOctetStream then begin result := (input as TConstructedOctetStream).Read(buffer, offset, count); end else begin result := input.Read(buffer[offset], count); end; end; class function TStreamSorter.ReadByte(input: TStream): Int32; begin if input is TIndefiniteLengthInputStream then begin result := (input as TIndefiniteLengthInputStream).ReadByte(); end else if input is TDefiniteLengthInputStream then begin result := (input as TDefiniteLengthInputStream).ReadByte(); end else if input is TConstructedOctetStream then begin result := (input as TConstructedOctetStream).ReadByte(); end else begin result := input.ReadByte(); end; end; { TStreamUtils } class procedure TStreamUtils.Drain(const inStr: TStream); var bs: TCryptoLibByteArray; begin System.SetLength(bs, BufferSize); while (TStreamSorter.Read(inStr, bs, 0, System.length(bs)) > 0) do begin // do nothing end; end; class procedure TStreamUtils.PipeAll(const inStr, outStr: TStream); var numRead: Int32; bs: TCryptoLibByteArray; begin System.SetLength(bs, BufferSize); numRead := TStreamSorter.Read(inStr, bs, 0, System.length(bs)); while ((numRead) > 0) do begin outStr.Write(bs[0], numRead); numRead := TStreamSorter.Read(inStr, bs, 0, System.length(bs)); end; end; class function TStreamUtils.PipeAllLimited(const inStr: TStream; limit: Int64; const outStr: TStream): Int64; var bs: TCryptoLibByteArray; numRead: Int32; total: Int64; begin System.SetLength(bs, BufferSize); total := 0; numRead := TStreamSorter.Read(inStr, bs, 0, System.length(bs)); while ((numRead) > 0) do begin if ((limit - total) < numRead) then begin raise EStreamOverflowCryptoLibException.CreateRes(@SDataOverflow); end; total := total + numRead; outStr.Write(bs[0], numRead); numRead := TStreamSorter.Read(inStr, bs, 0, System.length(bs)); end; result := total; end; class function TStreamUtils.ReadAll(const inStr: TStream): TCryptoLibByteArray; var buf: TMemoryStream; begin buf := TMemoryStream.Create(); try PipeAll(inStr, buf); System.SetLength(result, buf.Size); buf.Position := 0; buf.Read(result[0], buf.Size); finally buf.Free; end; end; class function TStreamUtils.ReadAllLimited(const inStr: TStream; limit: Int32) : TCryptoLibByteArray; var buf: TMemoryStream; begin buf := TMemoryStream.Create(); try PipeAllLimited(inStr, limit, buf); System.SetLength(result, buf.Size); buf.Position := 0; buf.Read(result[0], buf.Size); finally buf.Free; end; end; class function TStreamUtils.ReadFully(const inStr: TStream; var buf: TCryptoLibByteArray; off, len: Int32): Int32; var totalRead, numRead: Int32; begin totalRead := 0; while (totalRead < len) do begin numRead := TStreamSorter.Read(inStr, buf, off + totalRead, len - totalRead); if (numRead < 1) then begin break; end; totalRead := totalRead + numRead; end; result := totalRead; end; class function TStreamUtils.WriteBufTo(const buf: TMemoryStream; const output: TCryptoLibByteArray; offset: Int32): Int32; var bytes: TCryptoLibByteArray; begin buf.Position := 0; System.SetLength(bytes, buf.Size); buf.Read(bytes[0], buf.Size); System.Move(bytes[0], output[offset], System.length(bytes) * System.SizeOf(Byte)); result := System.length(bytes); end; class procedure TStreamUtils.WriteZeroes(const outStr: TStream; count: Int64); var zeroes: TCryptoLibByteArray; begin System.SetLength(zeroes, BufferSize); while (count > BufferSize) do begin outStr.Write(zeroes[0], BufferSize); count := count - BufferSize; end; outStr.Write(zeroes[0], Int32(count)); end; class function TStreamUtils.ReadFully(const inStr: TStream; var buf: TCryptoLibByteArray): Int32; begin result := ReadFully(inStr, buf, 0, System.length(buf)); end; class procedure TStreamUtils.WriteBufTo(const buf: TMemoryStream; const output: TStream); begin output.CopyFrom(buf, buf.Size); end; { TBaseInputStream } function TBaseInputStream.GetPosition: Int64; begin raise ENotSupportedCryptoLibException.Create(''); end; function TBaseInputStream.GetSize: Int64; begin raise ENotSupportedCryptoLibException.Create(''); end; {$IFNDEF _FIXINSIGHT_} function TBaseInputStream.Read(var buffer; count: LongInt): LongInt; begin raise ENotSupportedCryptoLibException.Create(''); end; function TBaseInputStream.Write(const buffer; count: LongInt): LongInt; begin raise ENotSupportedCryptoLibException.Create(''); end; {$ENDIF} function TBaseInputStream.ReadByte: Int32; var buffer: TCryptoLibByteArray; begin System.SetLength(buffer, 1); // if (Read(Buffer, 0, 1) = 0) then if (TStreamSorter.Read(Self, buffer, 0, 1) = 0) then begin result := -1; end else begin result := Int32(buffer[0]); end; end; function TBaseInputStream.Seek(offset: LongInt; Origin: Word): LongInt; begin result := Seek(Int64(offset), TSeekOrigin(Origin)); end; {$IFNDEF _FIXINSIGHT_} function TBaseInputStream.Seek(const offset: Int64; Origin: TSeekOrigin): Int64; begin raise ENotSupportedCryptoLibException.Create(''); end; procedure TBaseInputStream.SetPosition(const Pos: Int64); begin raise ENotSupportedCryptoLibException.Create(''); end; {$ENDIF} procedure TBaseInputStream.SetSize(const NewSize: Int64); begin SetSize(LongInt(NewSize)); end; procedure TBaseInputStream.SetSize(NewSize: LongInt); begin raise ENotSupportedCryptoLibException.Create(''); end; procedure TBaseInputStream.SetSize64(const NewSize: Int64); begin SetSize(NewSize); end; function TBaseInputStream.Read(buffer: TCryptoLibByteArray; offset, count: LongInt): LongInt; var &pos, endPoint, b: Int32; begin Pos := offset; try endPoint := offset + count; while (Pos < endPoint) do begin b := ReadByte(); if (b = -1) then begin break; end; buffer[Pos] := Byte(b); System.Inc(Pos); end; except on e: EIOCryptoLibException do begin if (Pos = offset) then raise; end; end; result := Pos - offset; end; {$IFNDEF _FIXINSIGHT_} function TBaseInputStream.Write(const buffer: TCryptoLibByteArray; offset, count: LongInt): LongInt; begin raise ENotSupportedCryptoLibException.Create(''); end; {$ENDIF} { TFilterStream } constructor TFilterStream.Create(const s: TStream); begin inherited Create(); Fs := s; end; function TFilterStream.GetPosition: Int64; begin result := Fs.Position; end; procedure TFilterStream.SetPosition(const Value: Int64); begin Fs.Position := Value; end; function TFilterStream.Write(const buffer; count: LongInt): LongInt; begin result := Fs.Write(PByte(buffer), count); end; procedure TFilterStream.WriteByte(Value: Byte); begin Fs.WriteByte(Value); end; function TFilterStream.GetSize: Int64; begin result := Fs.Size; end; function TFilterStream.Read(var buffer; count: LongInt): LongInt; begin result := Fs.Read(PByte(buffer), count); end; function TFilterStream.ReadByte: Int32; begin result := TStreamSorter.ReadByte(Fs); end; function TFilterStream.Seek(const offset: Int64; Origin: TSeekOrigin): Int64; begin result := Fs.Seek(offset, Origin); end; { TLimitedInputStream } constructor TLimitedInputStream.Create(inStream: TStream; limit: Int32); begin Inherited Create(); F_in := inStream; F_limit := limit; end; function TLimitedInputStream.GetRemaining: Int32; begin // TODO: maybe one day this can become more accurate result := F_limit; end; procedure TLimitedInputStream.SetParentEofDetect(&on: Boolean); var indefiniteLengthInputStream: TIndefiniteLengthInputStream; begin if F_in is TIndefiniteLengthInputStream then begin indefiniteLengthInputStream := F_in as TIndefiniteLengthInputStream; indefiniteLengthInputStream.SetEofOn00(&on); end; end; { TDefiniteLengthInputStream } constructor TDefiniteLengthInputStream.Create(inStream: TStream; length: Int32); begin Inherited Create(inStream, length); if (length < 0) then begin raise EArgumentCryptoLibException.CreateRes(@SInvalidLength); end; F_originalLength := length; F_remaining := length; if (length = 0) then begin SetParentEofDetect(True); end; end; class function TDefiniteLengthInputStream.GetEmptyBytes: TCryptoLibByteArray; begin result := Nil; end; function TDefiniteLengthInputStream.GetRemaining: Int32; begin result := F_remaining; end; function TDefiniteLengthInputStream.Read(buf: TCryptoLibByteArray; off, len: LongInt): LongInt; var toRead, numRead: Int32; begin if (F_remaining = 0) then begin result := 0; Exit; end; toRead := Min(len, F_remaining); numRead := TStreamSorter.Read(F_in, buf, off, toRead); if (numRead < 1) then begin raise EEndOfStreamCryptoLibException.CreateResFmt(@SEndOfStreamTwo, [F_originalLength, F_remaining]); end; F_remaining := F_remaining - numRead; if (F_remaining = 0) then begin SetParentEofDetect(True); end; result := numRead; end; procedure TDefiniteLengthInputStream.ReadAllIntoByteArray (var buf: TCryptoLibByteArray); begin if (F_remaining <> System.length(buf)) then begin raise EArgumentCryptoLibException.CreateRes(@SInvalidBufferLength); end; F_remaining := F_remaining - TStreamUtils.ReadFully(F_in, buf); if ((F_remaining <> 0)) then begin raise EEndOfStreamCryptoLibException.CreateResFmt(@SEndOfStreamTwo, [F_originalLength, F_remaining]); end; SetParentEofDetect(True); end; function TDefiniteLengthInputStream.ReadByte: Int32; begin if (F_remaining = 0) then begin result := -1; Exit; end; // result := F_in.ReadByte(); result := TStreamSorter.ReadByte(F_in); if (result < 0) then begin raise EEndOfStreamCryptoLibException.CreateResFmt(@SEndOfStreamTwo, [F_originalLength, F_remaining]); end; System.Dec(F_remaining); if (F_remaining = 0) then begin SetParentEofDetect(True); end; end; function TDefiniteLengthInputStream.ToArray: TCryptoLibByteArray; var bytes: TCryptoLibByteArray; begin if (F_remaining = 0) then begin result := EmptyBytes; Exit; end; System.SetLength(bytes, F_remaining); F_remaining := F_remaining - TStreamUtils.ReadFully(F_in, bytes); if (F_remaining <> 0) then begin raise EEndOfStreamCryptoLibException.CreateResFmt(@SEndOfStreamTwo, [F_originalLength, F_remaining]); end; SetParentEofDetect(True); result := bytes; end; { TAsn1InputStream } class function TAsn1InputStream.FindLimit(const input: TStream): Int32; var limitedInputStream: TLimitedInputStream; mem: TMemoryStream; begin limitedInputStream := input as TLimitedInputStream; if (limitedInputStream <> Nil) then begin result := limitedInputStream.GetRemaining(); Exit; end else if (input is TMemoryStream) then begin mem := input as TMemoryStream; result := Int32(mem.Size - mem.Position); Exit; end; result := System.High(Int32); end; class function TAsn1InputStream.GetBuffer(const defIn : TDefiniteLengthInputStream; const tmpBuffers: TCryptoLibMatrixByteArray) : TCryptoLibByteArray; var len: Int32; buf, temp: TCryptoLibByteArray; begin len := defIn.GetRemaining(); if (len >= System.length(tmpBuffers)) then begin result := defIn.ToArray(); Exit; end; buf := tmpBuffers[len]; if (buf = Nil) then begin System.SetLength(temp, len); tmpBuffers[len] := temp; buf := tmpBuffers[len]; end; defIn.ReadAllIntoByteArray(buf); result := buf; end; class function TAsn1InputStream.CreatePrimitiveDerObject(tagNo: Int32; const defIn: TDefiniteLengthInputStream; const tmpBuffers: TCryptoLibMatrixByteArray): IAsn1Object; var bytes: TCryptoLibByteArray; begin case tagNo of TAsn1Tags.Boolean: begin result := TDerBoolean.FromOctetString(GetBuffer(defIn, tmpBuffers)); Exit; end; TAsn1Tags.Enumerated: begin result := TDerEnumerated.FromOctetString(GetBuffer(defIn, tmpBuffers)); Exit; end; TAsn1Tags.ObjectIdentifier: begin result := TDerObjectIdentifier.FromOctetString (GetBuffer(defIn, tmpBuffers)); Exit; end; end; bytes := defIn.ToArray(); case tagNo of TAsn1Tags.BitString: begin result := TDerBitString.FromAsn1Octets(bytes); Exit; end; TAsn1Tags.BmpString: begin result := TDerBmpString.Create(bytes); Exit; end; // TAsn1Tags.GeneralizedTime: // begin // result := TDerGeneralizedTime.Create(bytes); // Exit; // end; TAsn1Tags.GeneralString: begin result := TDerGeneralString.Create(bytes); Exit; end; TAsn1Tags.GraphicString: begin result := TDerGraphicString.Create(bytes); Exit; end; TAsn1Tags.IA5String: begin result := TDerIA5String.Create(bytes); Exit; end; TAsn1Tags.Integer: begin result := TDerInteger.Create(bytes); Exit; end; TAsn1Tags.Null: begin // actual content is ignored (enforce 0 length?) result := TDerNull.Instance; Exit; end; TAsn1Tags.NumericString: begin result := TDerNumericString.Create(bytes); Exit; end; TAsn1Tags.OctetString: begin result := TDerOctetString.Create(bytes); Exit; end; TAsn1Tags.PrintableString: begin result := TDerPrintableString.Create(bytes); Exit; end; TAsn1Tags.T61String: begin result := TDerT61String.Create(bytes); Exit; end; TAsn1Tags.UniversalString: begin result := TDerUniversalString.Create(bytes); Exit; end; // TAsn1Tags.UtcTime: // begin // result := TDerUtcTime.Create(bytes); // Exit; // end; TAsn1Tags.Utf8String: begin result := TDerUtf8String.Create(bytes); Exit; end; TAsn1Tags.VideotexString: begin result := TDerVideotexString.Create(bytes); Exit; end; TAsn1Tags.VisibleString: begin result := TDerVisibleString.Create(bytes); Exit; end; else begin raise EIOCryptoLibException.CreateResFmt(@SUnknownTag, [tagNo]); end; end; end; destructor TAsn1InputStream.Destroy; begin FStream.Free; inherited Destroy; end; constructor TAsn1InputStream.Create(const inputStream: TStream; limit: Int32); begin Inherited Create(inputStream); Flimit := limit; System.SetLength(FtmpBuffers, 16); end; constructor TAsn1InputStream.Create(const inputStream: TStream); begin Create(inputStream, FindLimit(inputStream)); end; constructor TAsn1InputStream.Create(const input: TCryptoLibByteArray); begin // used TBytesStream here for one pass creation and population with byte array :) FStream := TBytesStream.Create(input); Create(FStream, System.length(input)); end; class function TAsn1InputStream.ReadLength(const s: TStream; limit: Int32): Int32; var &length, Size, next, I: Int32; begin length := TStreamSorter.ReadByte(s); if (length < 0) then begin raise EEndOfStreamCryptoLibException.CreateRes(@SInvalidEnd); end; if (length = $80) then begin result := -1; // indefinite-length encoding Exit; end; if (length > 127) then begin Size := length and $7F; // Note: The invalid long form "$ff" (see X.690 8.1.3.5c) will be caught here if (Size > 4) then begin raise EIOCryptoLibException.CreateResFmt(@SInvalidDerLength, [Size]); end; length := 0; I := 0; while I < Size do begin next := TStreamSorter.ReadByte(s); if (next < 0) then begin raise EEndOfStreamCryptoLibException.CreateRes(@SEndOfStream); end; length := (length shl 8) + next; System.Inc(I); end; if (length < 0) then begin raise EIOCryptoLibException.CreateRes(@SNegativeLength); end; if (length >= limit) then // after all we must have read at least 1 byte begin raise EIOCryptoLibException.CreateRes(@SOutOfBoundsLength); end; end; result := length; end; function TAsn1InputStream.ReadObject: IAsn1Object; var tag, tagNo, &length: Int32; IsConstructed: Boolean; indIn: TIndefiniteLengthInputStream; sp: IAsn1StreamParser; begin tag := ReadByte(); if (tag <= 0) then begin if (tag = 0) then begin raise EIOCryptoLibException.CreateRes(@SEndOfContent); end; result := Nil; Exit; end; // // calculate tag number // tagNo := ReadTagNumber(Fs, tag); IsConstructed := (tag and TAsn1Tags.Constructed) <> 0; // // calculate length // length := ReadLength(Fs, Flimit); if (length < 0) then // indefinite length method begin if (not IsConstructed) then begin raise EIOCryptoLibException.CreateRes(@SIndefiniteLength); end; indIn := TIndefiniteLengthInputStream.Create(Fs, Flimit); sp := TAsn1StreamParser.Create(indIn, Flimit); if ((tag and TAsn1Tags.Application) <> 0) then begin result := (TBerApplicationSpecificParser.Create(tagNo, sp) as IBerApplicationSpecificParser).ToAsn1Object(); Exit; end; if ((tag and TAsn1Tags.Tagged) <> 0) then begin result := (TBerTaggedObjectParser.Create(True, tagNo, sp) as IBerTaggedObjectParser).ToAsn1Object(); Exit; end; // TODO There are other tags that may be constructed (e.g. BitString) case tagNo of TAsn1Tags.OctetString: begin result := (TBerOctetStringParser.Create(sp) as IBerOctetStringParser) .ToAsn1Object(); Exit; end; TAsn1Tags.Sequence: begin result := (TBerSequenceParser.Create(sp) as IBerSequenceParser) .ToAsn1Object(); Exit; end; TAsn1Tags.&Set: begin result := (TBerSetParser.Create(sp) as IBerSetParser).ToAsn1Object(); Exit; end; TAsn1Tags.External: begin result := (TDerExternalParser.Create(sp) as IDerExternalParser) .ToAsn1Object(); Exit; end; else begin raise EIOCryptoLibException.CreateRes(@SUnknownBerObject); end; end; end else begin try result := BuildObject(tag, tagNo, length); except on e: EArgumentCryptoLibException do begin raise EAsn1CryptoLibException.CreateResFmt(@SCorruptedStream, [e.Message]); end; end; end; end; function TAsn1InputStream.ReadVector(const dIn: TDefiniteLengthInputStream) : IAsn1EncodableVector; var v: IAsn1EncodableVector; o: IAsn1Object; subStream: TAsn1InputStream; begin if (dIn.Remaining < 1) then begin result := TAsn1EncodableVector.Create(0) as IAsn1EncodableVector; Exit; end; subStream := TAsn1InputStream.Create(dIn); try v := TAsn1EncodableVector.Create(); o := subStream.ReadObject(); while (o <> Nil) do begin v.Add([o]); o := subStream.ReadObject(); end; finally subStream.Free; end; result := v; end; function TAsn1InputStream.BuildObject(tag, tagNo, length: Int32): IAsn1Object; var IsConstructed: Boolean; defIn: TDefiniteLengthInputStream; v: IAsn1EncodableVector; strings: TList; I: Int32; begin IsConstructed := (tag and TAsn1Tags.Constructed) <> 0; defIn := TDefiniteLengthInputStream.Create(Fs, length); if ((tag and TAsn1Tags.Application) <> 0) then begin try result := TDerApplicationSpecific.Create(IsConstructed, tagNo, defIn.ToArray()); Exit; finally defIn.Free; end; end; if ((tag and TAsn1Tags.Tagged) <> 0) then begin result := (TAsn1StreamParser.Create(defIn) as IAsn1StreamParser) .ReadTaggedObject(IsConstructed, tagNo); Exit; end; if (IsConstructed) then begin // TODO There are other tags that may be constructed (e.g. BitString) case (tagNo) of TAsn1Tags.OctetString: // // yes, people actually do this... // begin try v := ReadVector(defIn); strings := TList.Create; strings.capacity := v.count; I := 0; while (I <> v.count) do begin strings.Add(v[I] as IDerOctetString); end; result := TBerOctetString.Create(strings); Exit; finally defIn.Free; end; end; TAsn1Tags.Sequence: begin try result := CreateDerSequence(defIn); Exit; finally defIn.Free; end; end; TAsn1Tags.&Set: begin try result := CreateDerSet(defIn); Exit; finally defIn.Free; end; end; TAsn1Tags.External: begin try result := TDerExternal.Create(ReadVector(defIn)); Exit; finally defIn.Free; end; end; else begin defIn.Free; // free the stream incase an unsupported tag is encountered. raise EIOCryptoLibException.CreateResFmt(@SUnknownTag, [tagNo]); end; end; end; try result := CreatePrimitiveDerObject(tagNo, defIn, FtmpBuffers); finally defIn.Free; end; end; function TAsn1InputStream.CreateDerSequence (const dIn: TDefiniteLengthInputStream): IDerSequence; begin result := TDerSequence.FromVector(ReadVector(dIn)); end; function TAsn1InputStream.CreateDerSet(const dIn : TDefiniteLengthInputStream): IDerSet; begin result := TDerSet.FromVector(ReadVector(dIn), False); end; class function TAsn1InputStream.ReadTagNumber(const s: TStream; tag: Int32): Int32; var tagNo, b: Int32; begin tagNo := tag and $1F; // // with tagged object tag number is bottom 5 bits, or stored at the start of the content // if (tagNo = $1F) then begin tagNo := 0; b := TStreamSorter.ReadByte(s); // X.690-0207 8.1.2.4.2 // "c) bits 7 to 1 of the first subsequent octet shall not all be zero." if ((b and $7F) = 0) then // Note: -1 will pass begin raise EIOCryptoLibException.CreateRes(@SCorruptedStreamInvalidTag); end; while ((b >= 0) and ((b and $80) <> 0)) do begin tagNo := tagNo or (b and $7F); tagNo := tagNo shl 7; b := TStreamSorter.ReadByte(s); end; if (b < 0) then begin raise EEndOfStreamCryptoLibException.CreateRes(@SEOFFound); end; tagNo := tagNo or (b and $7F); end; result := tagNo; end; { TDerOutputStream } constructor TDerOutputStream.Create(const os: TStream); begin Inherited Create(os); end; procedure TDerOutputStream.WriteEncoded(tag: Int32; first: Byte; const bytes: TCryptoLibByteArray); begin WriteByte(Byte(tag)); WriteLength(System.length(bytes) + 1); WriteByte(first); Write(bytes[0], System.length(bytes)); end; procedure TDerOutputStream.WriteEncoded(tag: Int32; const bytes: TCryptoLibByteArray); begin WriteByte(Byte(tag)); WriteLength(System.length(bytes)); if bytes <> Nil then begin Write(bytes[0], System.length(bytes)); end; end; procedure TDerOutputStream.WriteEncoded(flags, tagNo: Int32; const bytes: TCryptoLibByteArray); begin WriteTag(flags, tagNo); WriteLength(System.length(bytes)); Write(bytes[0], System.length(bytes)); end; procedure TDerOutputStream.WriteEncoded(tag: Int32; const bytes: TCryptoLibByteArray; offset, length: Int32); begin WriteByte(Byte(tag)); WriteLength(length); Write(bytes[offset], length); end; procedure TDerOutputStream.WriteLength(length: Int32); var Size, I: Int32; val: UInt32; begin if (length > 127) then begin Size := 1; val := UInt32(length); val := val shr 8; while (val <> 0) do begin System.Inc(Size); val := val shr 8; end; WriteByte(Byte(Size or $80)); I := (Size - 1) * 8; while I >= 0 do begin WriteByte(Byte(TBits.Asr32(length, I))); System.Dec(I, 8); end; end else begin WriteByte(Byte(length)); end; end; procedure TDerOutputStream.WriteNull; begin WriteByte(TAsn1Tags.Null); WriteByte($00); end; procedure TDerOutputStream.WriteObject(const obj: IAsn1Encodable); var asn1: IAsn1Object; begin if (obj = Nil) then begin WriteNull(); end else begin asn1 := obj.ToAsn1Object(); asn1.Encode(Self); end; end; procedure TDerOutputStream.WriteObject(const obj: IAsn1Object); begin if (obj = Nil) then begin WriteNull(); end else begin obj.Encode(Self); end; end; procedure TDerOutputStream.WriteTag(flags, tagNo: Int32); var stack: TCryptoLibByteArray; Pos: Int32; begin if (tagNo < 31) then begin WriteByte(Byte(flags or tagNo)); end else begin WriteByte(Byte(flags or $1F)); if (tagNo < 128) then begin WriteByte(Byte(tagNo)); end else begin System.SetLength(stack, 5); Pos := System.length(stack); System.Dec(Pos); stack[Pos] := Byte(tagNo and $7F); repeat tagNo := TBits.Asr32(tagNo, 7); System.Dec(Pos); stack[Pos] := Byte(tagNo and $7F or $80); until (not(tagNo > 127)); Write(stack[Pos], System.length(stack) - Pos); end; end; end; { TAsn1OutputStream } constructor TAsn1OutputStream.Create(os: TStream); begin Inherited Create(os); end; { TBerOutputStream } constructor TBerOutputStream.Create(os: TStream); begin Inherited Create(os); end; { TConstructedOctetStream } constructor TConstructedOctetStream.Create(const parser: IAsn1StreamParser); begin Inherited Create(); F_parser := parser; F_first := True; end; function TConstructedOctetStream.Read(buffer: TCryptoLibByteArray; offset, count: LongInt): LongInt; var s, aos: IAsn1OctetStringParser; totalRead, numRead: Int32; begin if (F_currentStream = Nil) then begin if (not F_first) then begin result := 0; Exit; end; if (not Supports(F_parser.ReadObject(), IAsn1OctetStringParser, s)) then begin result := 0; Exit; end; F_first := False; F_currentStream := s.GetOctetStream(); end; totalRead := 0; while True do begin numRead := TStreamSorter.Read(F_currentStream, buffer, offset + totalRead, count - totalRead); if (numRead > 0) then begin totalRead := totalRead + numRead; if (totalRead = count) then begin result := totalRead; Exit; end; end else begin if (not Supports(F_parser.ReadObject(), IAsn1OctetStringParser, aos)) then begin F_currentStream := Nil; result := totalRead; Exit; end; F_currentStream := aos.GetOctetStream(); end end; result := 0; end; function TConstructedOctetStream.ReadByte: Int32; var s, aos: IAsn1OctetStringParser; b: Int32; begin if (F_currentStream = Nil) then begin if (not F_first) then begin result := 0; Exit; end; if (not Supports(F_parser.ReadObject(), IAsn1OctetStringParser, s)) then begin result := 0; Exit; end; F_first := False; F_currentStream := s.GetOctetStream(); end; while True do begin // b := F_currentStream.ReadByte(); b := TStreamSorter.ReadByte(F_currentStream); if (b >= 0) then begin result := b; Exit; end; if (not Supports(F_parser.ReadObject(), IAsn1OctetStringParser, aos)) then begin F_currentStream := Nil; result := -1; Exit; end; F_currentStream := aos.GetOctetStream(); end; result := 0; end; { TIndefiniteLengthInputStream } function TIndefiniteLengthInputStream.RequireByte: Int32; begin // result := F_in.ReadByte(); result := TStreamSorter.ReadByte(F_in); if (result < 0) then begin // Corrupted stream raise EEndOfStreamCryptoLibException.Create(''); end; end; function TIndefiniteLengthInputStream.CheckForEof: Boolean; var extra: Int32; begin if (F_lookAhead = $00) then begin extra := RequireByte(); if (extra <> 0) then begin raise EIOCryptoLibException.CreateRes(@SMalformedContent); end; F_lookAhead := -1; SetParentEofDetect(True); result := True; Exit; end; result := F_lookAhead < 0; end; constructor TIndefiniteLengthInputStream.Create(inStream: TStream; limit: Int32); begin Inherited Create(inStream, limit); F_lookAhead := RequireByte(); CheckForEof(); end; function TIndefiniteLengthInputStream.Read(buffer: TCryptoLibByteArray; offset, count: LongInt): LongInt; var numRead: Int32; begin // Only use this optimisation if we aren't checking for 00 if ((F_eofOn00) or (count <= 1)) then begin result := (Inherited Read(buffer, offset, count)); Exit; end; if (F_lookAhead < 0) then begin result := 0; Exit; end; numRead := TStreamSorter.Read(F_in, buffer, offset + 1, count - 1); if (numRead <= 0) then begin // Corrupted stream raise EEndOfStreamCryptoLibException.Create(''); end; buffer[offset] := Byte(F_lookAhead); F_lookAhead := RequireByte(); result := numRead + 1; end; function TIndefiniteLengthInputStream.ReadByte: Int32; begin if (F_eofOn00 and CheckForEof()) then begin result := -1; Exit; end; result := F_lookAhead; F_lookAhead := RequireByte(); end; procedure TIndefiniteLengthInputStream.SetEofOn00(eofOn00: Boolean); begin F_eofOn00 := eofOn00; if (F_eofOn00) then begin CheckForEof(); end; end; { TCollectionUtilities } class function TCollectionUtilities.ToStructuredString (c: TCryptoLibGenericArray): String; var sl: TStringList; idx: Int32; begin if (c = Nil) then begin result := '[]'; Exit; end; sl := TStringList.Create(); sl.LineBreak := ''; try sl.Add('['); sl.Add((c[0] as TAsn1Encodable).ClassName); if System.length(c) > 1 then begin for idx := 1 to System.length(c) - 2 do begin sl.Add(', '); sl.Add((c[idx] as TAsn1Encodable).ClassName); end; end; sl.Add(']'); result := sl.Text; finally sl.Free; end; end; { TAsn1Encodable } function TAsn1Encodable.Equals(const other: IAsn1Convertible): Boolean; var o1, o2: IAsn1Object; begin if (other = Self as IAsn1Convertible) then begin result := True; Exit; end; if (other = Nil) then begin result := False; Exit; end; o1 := ToAsn1Object(); o2 := other.ToAsn1Object(); result := ((o1 = o2) or ((o2 <> Nil) and (o1.CallAsn1Equals(o2)))); end; function TAsn1Encodable.GetDerEncoded: TCryptoLibByteArray; begin try result := GetEncoded(Der); except on e: EIOCryptoLibException do begin result := Nil; end; end; end; function TAsn1Encodable.GetEncoded: TCryptoLibByteArray; var bOut: TMemoryStream; aOut: TAsn1OutputStream; begin bOut := TMemoryStream.Create(); aOut := TAsn1OutputStream.Create(bOut); try aOut.WriteObject(Self as IAsn1Encodable); System.SetLength(result, bOut.Size); bOut.Position := 0; bOut.Read(result[0], System.length(result)); finally bOut.Free; aOut.Free; end; end; function TAsn1Encodable.GetEncoded(const encoding: String): TCryptoLibByteArray; var bOut: TMemoryStream; dOut: TDerOutputStream; begin if (encoding = Der) then begin bOut := TMemoryStream.Create(); dOut := TDerOutputStream.Create(bOut); try dOut.WriteObject(Self as IAsn1Encodable); System.SetLength(result, bOut.Size); bOut.Position := 0; bOut.Read(result[0], System.length(result)); finally bOut.Free; dOut.Free; end; Exit; end; result := GetEncoded(); end; function TAsn1Encodable.GetHashCode: {$IFDEF DELPHI}Int32; {$ELSE}PtrInt; {$ENDIF DELPHI} begin result := ToAsn1Object().CallAsn1GetHashCode(); end; class function TAsn1Encodable.IsNullOrContainsNull (const data: TCryptoLibGenericArray): Boolean; var count, I: Int32; begin if (data = Nil) then begin result := True; Exit; end; count := System.length(data); for I := 0 to System.Pred(count) do begin if (data[I] = Nil) then begin result := True; Exit; end; end; result := False; end; class function TAsn1Encodable.OpenArrayToDynamicArray (const data: array of IAsn1Encodable): TCryptoLibGenericArray; var LDataLength, LIdx: Int32; begin LDataLength := System.length(data); System.SetLength(result, LDataLength); for LIdx := 0 to System.Pred(LDataLength) do begin result[LIdx] := data[LIdx]; end; end; { TAsn1Object } function TAsn1Object.CallAsn1Equals(const obj: IAsn1Object): Boolean; begin result := Asn1Equals(obj); end; function TAsn1Object.CallAsn1GetHashCode: Int32; begin result := Asn1GetHashCode(); end; class function TAsn1Object.FromByteArray(const data: TCryptoLibByteArray) : IAsn1Object; var asn1: TAsn1InputStream; input: TBytesStream; begin try // used TBytesStream here for one pass creation and population with byte array :) input := TBytesStream.Create(data); try asn1 := TAsn1InputStream.Create(input, System.length(data)); try result := asn1.ReadObject(); finally asn1.Free; end; if (input.Position <> input.Size) then begin raise EIOCryptoLibException.CreateRes(@SExtraData); end; finally input.Free; end; except on e: EInvalidCastCryptoLibException do begin raise EIOCryptoLibException.CreateRes(@SUnRecognizedObjectByteArray); end; end; end; class function TAsn1Object.FromStream(const inStr: TStream): IAsn1Object; var asn1Stream: TAsn1InputStream; begin asn1Stream := TAsn1InputStream.Create(inStr); try try result := asn1Stream.ReadObject(); except on e: EInvalidCastCryptoLibException do begin raise EIOCryptoLibException.CreateRes(@SUnRecognizedObjectStream); end; end; finally asn1Stream.Free; end; end; function TAsn1Object.ToAsn1Object: IAsn1Object; begin result := Self as IAsn1Object; end; { TDerObjectIdentifier } function TDerObjectIdentifier.GetID: String; begin result := Fidentifier; end; function TDerObjectIdentifier.Asn1Equals(const asn1Object: IAsn1Object) : Boolean; var other: IDerObjectIdentifier; begin if (not Supports(asn1Object, IDerObjectIdentifier, other)) then begin result := False; Exit; end; result := ID = other.ID; end; function TDerObjectIdentifier.Asn1GetHashCode: Int32; begin result := TStringUtils.GetStringHashCode(Fidentifier); end; class procedure TDerObjectIdentifier.Boot; begin if FLock = Nil then begin FLock := TCriticalSection.Create; end; end; function TDerObjectIdentifier.Branch(const branchID: String) : IDerObjectIdentifier; begin result := TDerObjectIdentifier.Create(Self as IDerObjectIdentifier, branchID); end; constructor TDerObjectIdentifier.Create(const oid: IDerObjectIdentifier; const branchID: String); begin Inherited Create(); if (not(IsValidBranchID(branchID, 1))) then begin raise EArgumentCryptoLibException.CreateResFmt(@SInvalidBranchId, [branchID]); end; Fidentifier := oid.ID + '.' + branchID; end; constructor TDerObjectIdentifier.Create(const identifier: String); begin Inherited Create(); if (identifier = '') then begin raise EArgumentNilCryptoLibException.CreateRes(@SIdentifierNil); end; if (not(IsValidIdentifier(identifier))) then begin raise EFormatCryptoLibException.CreateResFmt(@SInvalidOID, [identifier]); end; Fidentifier := identifier; end; constructor TDerObjectIdentifier.Create(const bytes: TCryptoLibByteArray); begin Inherited Create(); Fidentifier := MakeOidStringFromBytes(bytes); Fbody := System.Copy(bytes); end; function TDerObjectIdentifier.&on(const stem: IDerObjectIdentifier): Boolean; var LocalId, stemId: String; begin LocalId := ID; stemId := stem.ID; result := (System.length(LocalId) > System.length(stemId)) and (LocalId[System.length(stemId) + 1] = '.') and (AnsiStartsStr(stemId, LocalId)); end; class constructor TDerObjectIdentifier.CreateDerObjectIdentifier; begin TDerObjectIdentifier.Boot; end; class destructor TDerObjectIdentifier.DestroyDerObjectIdentifier; begin FLock.Free; end; procedure TDerObjectIdentifier.DoOutput(const bOut: TMemoryStream); var tok: IOidTokenizer; token: String; first: Int32; begin tok := TOidTokenizer.Create(Fidentifier); token := tok.NextToken(); first := StrToInt(token) * 40; token := tok.NextToken(); if (System.length(token) <= 18) then begin WriteField(bOut, Int64(first + StrToInt64(token))); end else begin WriteField(bOut, TBigInteger.Create(token).Add(TBigInteger.ValueOf(first))); end; while (tok.HasMoreTokens) do begin token := tok.NextToken(); if (System.length(token) <= 18) then begin WriteField(bOut, StrToInt64(token)); end else begin WriteField(bOut, TBigInteger.Create(token)); end; end; end; procedure TDerObjectIdentifier.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.ObjectIdentifier, GetBody()); end; class function TDerObjectIdentifier.FromOctetString (const enc: TCryptoLibByteArray): IDerObjectIdentifier; var HashCode, first: Int32; entry: IDerObjectIdentifier; begin HashCode := TArrayUtils.GetArrayHashCode(enc); first := HashCode and 1023; FLock.Acquire; try entry := Fcache[first]; if ((entry <> Nil) and (TArrayUtils.AreEqual(enc, entry.GetBody()))) then begin result := entry; Exit; end; Fcache[first] := TDerObjectIdentifier.Create(enc); result := Fcache[first]; finally FLock.Release; end; end; function TDerObjectIdentifier.GetBody: TCryptoLibByteArray; var bOut: TMemoryStream; begin FLock.Acquire; try if (Fbody = Nil) then begin bOut := TMemoryStream.Create(); try DoOutput(bOut); System.SetLength(Fbody, bOut.Size); bOut.Position := 0; bOut.Read(Fbody[0], System.length(Fbody)); finally bOut.Free; end; end; finally FLock.Release; end; result := Fbody; end; class function TDerObjectIdentifier.GetInstance(const obj: IAsn1TaggedObject; explicitly: Boolean): IDerObjectIdentifier; var o: IAsn1Object; begin o := obj.GetObject(); if ((explicitly) or (Supports(o, IDerObjectIdentifier))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := FromOctetString(TAsn1OctetString.GetInstance(o as TAsn1Object) .GetOctets()); end; class function TDerObjectIdentifier.GetInstance(const obj: TObject) : IDerObjectIdentifier; begin if ((obj = Nil) or (obj is TDerObjectIdentifier)) then begin result := obj as TDerObjectIdentifier; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerObjectIdentifier.GetInstance(const obj: TCryptoLibByteArray) : IDerObjectIdentifier; begin result := FromOctetString(obj); end; class function TDerObjectIdentifier.IsValidBranchID(const branchID: String; start: Int32): Boolean; var digitCount, Pos: Int32; ch: Char; begin digitCount := 0; Pos := System.length(branchID) + 1; System.Dec(Pos); while (Pos >= start) do begin ch := branchID[Pos]; if (ch = '.') then begin if ((digitCount = 0) or ((digitCount > 1) and (branchID[Pos + 1] = '0'))) then begin result := False; Exit; end; digitCount := 0; end else if (CharInSet(ch, ['0' .. '9'])) then begin System.Inc(digitCount); end else begin result := False; Exit; end; System.Dec(Pos); end; if ((digitCount = 0) or ((digitCount > 1) and (branchID[Pos + 1] = '0'))) then begin result := False; Exit; end; result := True; end; class function TDerObjectIdentifier.IsValidIdentifier(const identifier : String): Boolean; var first: Char; begin if ((System.length(identifier) < 3) or (identifier[2] <> '.')) then begin result := False; Exit; end; first := identifier[1]; if (not CharInSet(first, ['0' .. '2'])) then begin result := False; Exit; end; result := IsValidBranchID(identifier, 3); end; class function TDerObjectIdentifier.MakeOidStringFromBytes (const bytes: TCryptoLibByteArray): String; var objId: TStringList; Value: Int64; bigValue: TBigInteger; first: Boolean; I, b: Int32; begin Value := 0; bigValue := Default (TBigInteger); first := True; objId := TStringList.Create(); objId.LineBreak := ''; try I := 0; while I <> System.length(bytes) do begin b := Int32(bytes[I]); if (Value <= LONG_LIMIT) then begin Value := Value + (b and $7F); if ((b and $80) = 0) then // end of number reached begin if (first) then begin if (Value < 40) then begin objId.Add('0'); end else if (Value < 80) then begin objId.Add('1'); Value := Value - 40; end else begin objId.Add('2'); Value := Value - 80; end; first := False; end; objId.Add('.'); objId.Add(IntToStr(Value)); Value := 0; end else begin Value := Value shl 7; end; end else begin if (not bigValue.IsInitialized) then begin bigValue := TBigInteger.ValueOf(Value); end; bigValue := bigValue.&Or(TBigInteger.ValueOf(b and $7F)); if ((b and $80) = 0) then begin if (first) then begin objId.Add('2'); bigValue := bigValue.Subtract(TBigInteger.ValueOf(80)); first := False; end; objId.Add('.'); objId.Add(bigValue.ToString()); bigValue := Default (TBigInteger); Value := 0; end else begin bigValue := bigValue.ShiftLeft(7); end end; System.Inc(I); end; result := objId.Text; finally objId.Free; end; end; function TDerObjectIdentifier.ToString: String; begin result := ID; end; procedure TDerObjectIdentifier.WriteField(const outputStream: TStream; const fieldValue: TBigInteger); var byteCount, I: Int32; tmpValue: TBigInteger; tmp: TCryptoLibByteArray; begin byteCount := (fieldValue.BitLength + 6) div 7; if (byteCount = 0) then begin outputStream.WriteByte(0); end else begin tmpValue := fieldValue; System.SetLength(tmp, byteCount); I := byteCount - 1; while I >= 0 do begin tmp[I] := Byte((tmpValue.Int32Value and $7F) or $80); tmpValue := tmpValue.ShiftRight(7); System.Dec(I); end; tmp[byteCount - 1] := tmp[byteCount - 1] and $7F; outputStream.Write(tmp[0], System.length(tmp)); end; end; procedure TDerObjectIdentifier.WriteField(const outputStream: TStream; fieldValue: Int64); var tempRes: TCryptoLibByteArray; Pos: Int32; begin System.SetLength(tempRes, 9); Pos := 8; tempRes[Pos] := Byte(fieldValue and $7F); while (fieldValue >= (Int64(1) shl 7)) do begin fieldValue := TBits.Asr64(fieldValue, 7); System.Dec(Pos); tempRes[Pos] := Byte((fieldValue and $7F) or $80); end; outputStream.Write(tempRes[Pos], 9 - Pos); end; { TAsn1EncodableVector } procedure TAsn1EncodableVector.Add(const objs: array of IAsn1Encodable); var obj: IAsn1Encodable; begin for obj in objs do begin Add(obj); end; end; procedure TAsn1EncodableVector.Add(const element: IAsn1Encodable); var capacity, minCapacity: Int32; begin if (element = Nil) then begin raise EArgumentNilCryptoLibException.CreateRes(@SElementNil); end; capacity := System.length(FElements); minCapacity := FElementCount + 1; if ((minCapacity > capacity) or FCopyOnWrite) then begin Reallocate(minCapacity); end; FElements[FElementCount] := element; FElementCount := minCapacity; end; procedure TAsn1EncodableVector.AddAll(const other: IAsn1EncodableVector); var otherElementCount, capacity, minCapacity, I: Int32; otherElement: IAsn1Encodable; begin if (other = Nil) then begin raise EArgumentNilCryptoLibException.CreateRes(@SOtherNil); end; otherElementCount := other.count; if (otherElementCount < 1) then begin Exit; end; capacity := System.length(FElements); minCapacity := FElementCount + otherElementCount; if ((minCapacity > capacity) or FCopyOnWrite) then begin Reallocate(minCapacity); end; I := 0; repeat otherElement := other[I]; if (otherElement = Nil) then begin raise ENullReferenceCryptoLibException.CreateRes(@SOtherElementsNil); end; FElements[FElementCount + I] := otherElement; System.Inc(I); until not(I < otherElementCount); FElementCount := minCapacity; end; procedure TAsn1EncodableVector.AddOptional(const objs: array of IAsn1Encodable); var obj: IAsn1Encodable; begin if (System.length(objs) <> 0) then begin for obj in objs do begin if (obj <> Nil) then begin Add(obj); end; end; end; end; procedure TAsn1EncodableVector.AddOptionalTagged(isExplicit: Boolean; tagNo: Int32; const obj: IAsn1Encodable); begin if (obj <> Nil) then begin Add(TDerTaggedObject.Create(isExplicit, tagNo, obj) as IDerTaggedObject); end; end; function TAsn1EncodableVector.CopyElements : TCryptoLibGenericArray; begin if (FElementCount = 0) then begin result := EmptyElements; Exit; end; result := System.Copy(FElements, 0, FElementCount); System.SetLength(result, FElementCount); end; constructor TAsn1EncodableVector.Create(const v: array of IAsn1Encodable); begin inherited Create(); Add(v); end; constructor TAsn1EncodableVector.Create(initialCapacity: Int32); begin Inherited Create(); if (initialCapacity < 0) then begin raise EArgumentCryptoLibException.CreateRes(@SInitialCapacityNegative); end; if (initialCapacity = 0) then begin FElements := EmptyElements; end else begin System.SetLength(FElements, initialCapacity); end; FElementCount := 0; FCopyOnWrite := False; end; constructor TAsn1EncodableVector.Create(); begin Create(DefaultCapacity); end; destructor TAsn1EncodableVector.Destroy; begin inherited Destroy; end; class function TAsn1EncodableVector.FromEnumerable (const e: TList): IAsn1EncodableVector; var v: IAsn1EncodableVector; obj: IAsn1Encodable; begin v := TAsn1EncodableVector.Create(); for obj in e do begin v.Add(obj); end; result := v; end; function TAsn1EncodableVector.GetCount: Int32; begin result := FElementCount; end; class function TAsn1EncodableVector.GetEmptyElements : TCryptoLibGenericArray; begin result := Nil; end; function TAsn1EncodableVector.GetEnumerable : TCryptoLibGenericArray; begin result := CopyElements(); end; function TAsn1EncodableVector.GetSelf(Index: Int32): IAsn1Encodable; begin if (Index >= FElementCount) then begin raise EIndexOutOfRangeCryptoLibException.CreateResFmt(@SIndexOutOfRange, [Index, FElementCount]); end; result := FElements[Index]; end; procedure TAsn1EncodableVector.Reallocate(minCapacity: Int32); var oldCapacity, newCapacity: Int32; LocalCopy: TCryptoLibGenericArray; begin oldCapacity := System.length(FElements); newCapacity := Max(oldCapacity, minCapacity + (TBits.Asr32(minCapacity, 1))); LocalCopy := System.Copy(FElements, 0, FElementCount); System.SetLength(LocalCopy, newCapacity); FElements := LocalCopy; FCopyOnWrite := False; end; function TAsn1EncodableVector.TakeElements : TCryptoLibGenericArray; begin if (FElementCount = 0) then begin result := EmptyElements; Exit; end; if (System.length(FElements) = FElementCount) then begin FCopyOnWrite := True; result := FElements; Exit; end; result := System.Copy(FElements, 0, FElementCount); System.SetLength(result, FElementCount); end; class function TAsn1EncodableVector.CloneElements(const elements : TCryptoLibGenericArray) : TCryptoLibGenericArray; begin if System.length(elements) < 1 then begin result := EmptyElements; end else begin result := System.Copy(elements); end; end; { TAsn1Generator } constructor TAsn1Generator.Create(outStream: TStream); begin F_out := outStream; end; function TAsn1Generator.GetOut: TStream; begin result := F_out; end; { TAsn1Null } function TAsn1Null.ToString: String; begin result := 'NULL'; end; { TAsn1OctetString } function TAsn1OctetString.GetStr: TCryptoLibByteArray; begin result := FStr; end; function TAsn1OctetString.GetParser: IAsn1OctetStringParser; begin result := Self as IAsn1OctetStringParser; end; constructor TAsn1OctetString.Create(const Str: TCryptoLibByteArray); begin Inherited Create(); if (Str = Nil) then begin raise EArgumentNilCryptoLibException.CreateRes(@SStrNil); end; FStr := Str; end; function TAsn1OctetString.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerOctetString; begin if (not Supports(asn1Object, IDerOctetString, other)) then begin result := False; Exit; end; result := TArrayUtils.AreEqual(GetOctets(), other.GetOctets()); end; function TAsn1OctetString.Asn1GetHashCode: Int32; begin result := TArrayUtils.GetArrayHashCode(GetOctets()); end; constructor TAsn1OctetString.Create(const obj: IAsn1Encodable); begin Inherited Create(); try FStr := obj.GetEncoded(TAsn1Encodable.Der); except on e: EIOCryptoLibException do begin raise EArgumentCryptoLibException.CreateResFmt(@SProcessingError, [e.Message]); end; end; end; class function TAsn1OctetString.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IAsn1OctetString; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IAsn1OctetString))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := TBerOctetString.FromSequence (TAsn1Sequence.GetInstance(o as TAsn1Object)); end; class function TAsn1OctetString.GetInstance(const obj: TObject) : IAsn1OctetString; var asn1TaggedObject: IAsn1TaggedObject; begin if ((obj = Nil) or (obj is TAsn1OctetString)) then begin result := obj as TAsn1OctetString; Exit; end; // TODO: this needs to be deleted in V2 if Supports(obj, IAsn1TaggedObject, asn1TaggedObject) then begin result := GetInstance(asn1TaggedObject.GetObject() as TAsn1Object); Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; function TAsn1OctetString.GetOctets: TCryptoLibByteArray; begin result := Str; end; function TAsn1OctetString.GetOctetStream: TStream; begin // used TBytesStream here for one pass creation and population with byte array :) result := TBytesStream.Create(Str); end; function TAsn1OctetString.ToString: String; begin result := '#' + THex.Encode(Str); end; { TAsn1Sequence } function TAsn1Sequence.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var that: IAsn1Sequence; o1, o2: IAsn1Object; I, LCount: Int32; begin that := asn1Object as IAsn1Sequence; if (that = Nil) then begin result := False; Exit; end; LCount := count; if (that.count <> LCount) then begin result := False; Exit; end; for I := 0 to System.Pred(LCount) do begin o1 := FElements[I].ToAsn1Object(); o2 := that.elements[I].ToAsn1Object(); if ((o1 <> o2) and (not o1.CallAsn1Equals(o2))) then begin result := False; Exit; end; end; result := True; end; function TAsn1Sequence.Asn1GetHashCode: Int32; var hc, I: Int32; begin I := System.length(FElements); hc := I + 1; System.Dec(I); while (I >= 0) do begin hc := hc * 257; hc := hc xor (FElements[I].ToAsn1Object().CallAsn1GetHashCode()); System.Dec(I); end; result := hc; end; constructor TAsn1Sequence.Create(); begin inherited Create(); FElements := TAsn1EncodableVector.EmptyElements; end; constructor TAsn1Sequence.Create(const element: IAsn1Encodable); begin Inherited Create(); if (element = Nil) then begin raise EArgumentNilCryptoLibException.CreateRes(@SElementNil); end; FElements := TCryptoLibGenericArray.Create(element); end; constructor TAsn1Sequence.Create(const elementVector: IAsn1EncodableVector); begin Inherited Create(); if (elementVector = Nil) then begin raise EArgumentNilCryptoLibException.CreateRes(@SElementVectorNil); end; FElements := elementVector.TakeElements(); end; constructor TAsn1Sequence.Create(const elements: array of IAsn1Encodable); var LElementsCopy: TCryptoLibGenericArray; begin Inherited Create(); LElementsCopy := OpenArrayToDynamicArray(elements); if (TAsn1Encodable.IsNullOrContainsNull(LElementsCopy)) then begin raise ENullReferenceCryptoLibException.CreateRes(@SElementsNil); end; FElements := TAsn1EncodableVector.CloneElements(LElementsCopy); end; destructor TAsn1Sequence.Destroy; begin inherited Destroy; end; function TAsn1Sequence.GetCount: Int32; begin result := System.length(FElements); end; function TAsn1Sequence.GetElements: TCryptoLibGenericArray; begin result := FElements; end; function TAsn1Sequence.GetEnumerable: TCryptoLibGenericArray; begin result := FElements; end; class function TAsn1Sequence.GetInstance(const obj: TObject): IAsn1Sequence; var primitive: IAsn1Object; Sequence: IAsn1Sequence; res: IAsn1SequenceParser; begin if ((obj = Nil) or (obj is TAsn1Sequence)) then begin result := obj as TAsn1Sequence; Exit; end; if (Supports(obj, IAsn1SequenceParser, res)) then begin result := TAsn1Sequence.GetInstance(res.ToAsn1Object() as TAsn1Object); Exit; end; if (obj is TAsn1Encodable) then begin primitive := (obj as TAsn1Encodable).ToAsn1Object(); if (Supports(primitive, IAsn1Sequence, Sequence)) then begin result := Sequence; Exit; end; end; raise EArgumentCryptoLibException.CreateResFmt(@SUnknownObject, [obj.ClassName]); end; class function TAsn1Sequence.GetInstance(const obj: TCryptoLibByteArray) : IAsn1Sequence; begin try result := TAsn1Sequence.GetInstance(FromByteArray(obj) as TAsn1Object); except on e: EIOCryptoLibException do begin raise EArgumentCryptoLibException.CreateResFmt(@SInvalidSequence, [e.Message]); end; end; end; class function TAsn1Sequence.GetInstance(const obj: IAsn1TaggedObject; explicitly: Boolean): IAsn1Sequence; var inner: IAsn1Object; Sequence: IAsn1Sequence; begin inner := obj.GetObject(); if (explicitly) then begin if (not(obj.isExplicit())) then raise EArgumentCryptoLibException.CreateRes(@SInvalidObject); result := inner as IAsn1Sequence; Exit; end; // // constructed object which appears to be explicitly tagged // when it should be implicit means we have to add the // surrounding sequence. // if (obj.isExplicit()) then begin if (Supports(obj, IBerTaggedObject)) then begin result := TBerSequence.Create(inner); Exit; end; result := TDerSequence.Create(inner); Exit; end; if (Supports(inner, IAsn1Sequence, Sequence)) then begin result := Sequence; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SUnknownObject, [(obj as TAsn1TaggedObject).ClassName]); end; function TAsn1Sequence.GetParser: IAsn1SequenceParser; begin result := TAsn1SequenceParserImpl.Create(Self as IAsn1Sequence); end; function TAsn1Sequence.GetSelf(Index: Int32): IAsn1Encodable; begin result := FElements[Index]; end; function TAsn1Sequence.ToArray: TCryptoLibGenericArray; begin result := TAsn1EncodableVector.CloneElements(FElements); end; function TAsn1Sequence.ToString: String; begin result := TCollectionUtilities.ToStructuredString(FElements); end; { TAsn1Sequence.TAsn1SequenceParserImpl } constructor TAsn1Sequence.TAsn1SequenceParserImpl.Create (const outer: IAsn1Sequence); begin inherited Create(); Fouter := outer; Fmax := outer.count; end; function TAsn1Sequence.TAsn1SequenceParserImpl.ReadObject: IAsn1Convertible; var obj: IAsn1Encodable; Sequence: IAsn1Sequence; asn1Set: IAsn1Set; begin if (Findex = Fmax) then begin result := Nil; Exit; end; obj := Fouter[Findex]; System.Inc(Findex); if (Supports(obj, IAsn1Sequence, Sequence)) then begin result := Sequence.parser; Exit; end; if (Supports(obj, IAsn1Set, asn1Set)) then begin result := asn1Set.parser; Exit; end; // NB: Asn1OctetString implements Asn1OctetStringParser directly // if (obj is Asn1OctetString) // return ((Asn1OctetString)obj).Parser; result := obj; end; function TAsn1Sequence.TAsn1SequenceParserImpl.ToAsn1Object: IAsn1Object; begin result := Fouter; end; { TDerOctetString } constructor TDerOctetString.Create(const Str: TCryptoLibByteArray); begin Inherited Create(Str); end; constructor TDerOctetString.Create(const obj: IAsn1Encodable); begin Inherited Create(obj); end; destructor TDerOctetString.Destroy; begin inherited Destroy; end; procedure TDerOctetString.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.OctetString, Str); end; class procedure TDerOctetString.Encode(const derOut: TDerOutputStream; const bytes: TCryptoLibByteArray; offset, length: Int32); begin derOut.WriteEncoded(TAsn1Tags.OctetString, bytes, offset, length); end; { TBerOctetString } constructor TBerOctetString.Create(const octets: TList); begin Inherited Create(ToBytes(octets)); Focts := octets; end; constructor TBerOctetString.Create(const Str: TCryptoLibByteArray); begin Inherited Create(Str); end; constructor TBerOctetString.Create(const obj: IAsn1Encodable); begin Inherited Create(obj.ToAsn1Object()); end; destructor TBerOctetString.Destroy; begin Focts.Free; inherited Destroy; end; constructor TBerOctetString.Create(const obj: IAsn1Object); begin Inherited Create(obj); end; procedure TBerOctetString.Encode(const derOut: TStream); var oct: IDerOctetString; LListIDerOctetString: TCryptoLibGenericArray; begin if ((derOut is TAsn1OutputStream) or (derOut is TBerOutputStream)) then begin (derOut as TDerOutputStream).WriteByte(TAsn1Tags.Constructed or TAsn1Tags.OctetString); (derOut as TDerOutputStream).WriteByte($80); // // write out the octet array // LListIDerOctetString := Self.GetEnumerable; for oct in LListIDerOctetString do begin (derOut as TDerOutputStream).WriteObject(oct); end; (derOut as TDerOutputStream).WriteByte($00); (derOut as TDerOutputStream).WriteByte($00); end else begin (Inherited Encode(derOut)); end; end; class function TBerOctetString.FromSequence(const seq: IAsn1Sequence) : IBerOctetString; var v: TList; obj: IAsn1Encodable; LListAsn1Encodable: TCryptoLibGenericArray; begin v := TList.Create(); LListAsn1Encodable := seq.GetEnumerable; for obj in LListAsn1Encodable do begin v.Add(obj as IDerOctetString); end; result := TBerOctetString.Create(v); end; function TBerOctetString.GenerateOcts: TList; var I, endPoint: Int32; nStr: TCryptoLibByteArray; begin result := TList.Create(); I := 0; while I < System.length(Str) do begin endPoint := Min(System.length(Str), I + MaxLength); System.SetLength(nStr, endPoint - I); System.Move(Str[I], nStr[0], System.length(nStr) * System.SizeOf(Byte)); result.Add(TDerOctetString.Create(nStr) as IDerOctetString); System.Inc(I, MaxLength); end; end; function TBerOctetString.GetEnumerable: TCryptoLibGenericArray; var LList: TList; begin if (Focts = Nil) then begin LList := GenerateOcts(); try result := LList.ToArray; Exit; finally LList.Free; end; end; result := Focts.ToArray; end; function TBerOctetString.GetOctets: TCryptoLibByteArray; begin result := Str; end; class function TBerOctetString.ToBytes(octs: TList) : TCryptoLibByteArray; var bOut: TMemoryStream; o: IDerOctetString; octets: TCryptoLibByteArray; begin bOut := TMemoryStream.Create(); try for o in octs do begin octets := o.GetOctets(); bOut.Write(octets[0], System.length(octets)); end; System.SetLength(result, bOut.Size); bOut.Position := 0; bOut.Read(result[0], bOut.Size); finally bOut.Free; end; end; { TDerNull } function TDerNull.Asn1Equals(const asn1Object: IAsn1Object): Boolean; begin result := Supports(asn1Object, IDerNull); end; function TDerNull.Asn1GetHashCode: Int32; begin result := -1; end; {$IFNDEF _FIXINSIGHT_} constructor TDerNull.Create(dummy: Int32); begin Inherited Create(); end; {$ENDIF} procedure TDerNull.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.Null, ZeroBytes); end; class function TDerNull.GetInstance: IDerNull; begin result := TDerNull.Create(0); end; { TDerSequence } class function TDerSequence.GetEmpty: IDerSequence; begin result := TDerSequence.Create(); end; constructor TDerSequence.Create(const element: IAsn1Encodable); begin Inherited Create(element); end; constructor TDerSequence.Create; begin Inherited Create(); end; constructor TDerSequence.Create(const elementVector: IAsn1EncodableVector); begin Inherited Create(elementVector); end; constructor TDerSequence.Create(const elements: array of IAsn1Encodable); begin Inherited Create(elements); end; destructor TDerSequence.Destroy; begin inherited Destroy; end; procedure TDerSequence.Encode(const derOut: TStream); var bOut: TMemoryStream; dOut: TDerOutputStream; obj: IAsn1Encodable; bytes: TCryptoLibByteArray; LListAsn1Encodable: TCryptoLibGenericArray; begin // TODO Intermediate buffer could be avoided if we could calculate expected length bOut := TMemoryStream.Create(); dOut := TDerOutputStream.Create(bOut); try LListAsn1Encodable := Self.GetEnumerable; for obj in LListAsn1Encodable do begin dOut.WriteObject(obj); end; System.SetLength(bytes, bOut.Size); bOut.Position := 0; bOut.Read(bytes[0], bOut.Size); finally bOut.Free; dOut.Free; end; (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.Sequence or TAsn1Tags.Constructed, bytes); end; class function TDerSequence.FromVector(const elementVector : IAsn1EncodableVector): IDerSequence; begin if elementVector.count < 1 then begin result := Empty; end else begin result := TDerSequence.Create(elementVector); end; end; { TBerSequence } class function TBerSequence.GetEmpty: IBerSequence; begin result := TBerSequence.Create(); end; constructor TBerSequence.Create(const element: IAsn1Encodable); begin Inherited Create(element); end; constructor TBerSequence.Create; begin Inherited Create(); end; constructor TBerSequence.Create(const elementVector: IAsn1EncodableVector); begin Inherited Create(elementVector); end; destructor TBerSequence.Destroy; begin inherited Destroy; end; constructor TBerSequence.Create(const elements: array of IAsn1Encodable); begin Inherited Create(elements); end; procedure TBerSequence.Encode(const derOut: TStream); var o: IAsn1Encodable; LListAsn1Encodable: TCryptoLibGenericArray; begin if ((derOut is TAsn1OutputStream) or (derOut is TBerOutputStream)) then begin (derOut as TDerOutputStream).WriteByte(TAsn1Tags.Sequence or TAsn1Tags.Constructed); (derOut as TDerOutputStream).WriteByte($80); LListAsn1Encodable := Self.GetEnumerable; for o in LListAsn1Encodable do begin (derOut as TDerOutputStream).WriteObject(o); end; (derOut as TDerOutputStream).WriteByte($00); (derOut as TDerOutputStream).WriteByte($00); end else begin (Inherited Encode(derOut)); end; end; class function TBerSequence.FromVector(const elementVector : IAsn1EncodableVector): IBerSequence; begin if elementVector.count < 1 then begin result := Empty; end else begin result := TBerSequence.Create(elementVector); end; end; { TAsn1TaggedObject } function TAsn1TaggedObject.GetObject: IAsn1Object; begin if (Fobj <> Nil) then begin result := Fobj.ToAsn1Object(); Exit; end; result := Nil; end; function TAsn1TaggedObject.GetTagNo: Int32; begin result := FtagNo; end; function TAsn1TaggedObject.Getexplicitly: Boolean; begin result := Fexplicitly; end; function TAsn1TaggedObject.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IAsn1TaggedObject; begin if (not Supports(asn1Object, IAsn1TaggedObject, other)) then begin result := False; Exit; end; result := ((tagNo = other.tagNo) and // TODO Should this be part of equality? (explicitly = other.explicitly)) and (GetObject().Equals(other.GetObject())); end; function TAsn1TaggedObject.Asn1GetHashCode: Int32; var code: Int32; begin code := Abs(tagNo); // TODO: actually this is wrong - the problem is that a re-encoded // object may end up with a different hashCode due to implicit // tagging. As implicit tagging is ambiguous if a sequence is involved // it seems the only correct method for both equals and hashCode is to // compare the encodings... // code := code xor explicitly.GetHashCode(); if (Fobj <> Nil) then begin code := code xor Fobj.GetHashCode(); end; result := code; end; constructor TAsn1TaggedObject.Create(tagNo: Int32; const obj: IAsn1Encodable); begin Inherited Create(); Fexplicitly := True; FtagNo := tagNo; Fobj := obj; end; constructor TAsn1TaggedObject.Create(explicitly: Boolean; tagNo: Int32; const obj: IAsn1Encodable); begin Inherited Create(); // IAsn1Choice marker interface 'insists' on explicit tagging Fexplicitly := explicitly or (Supports(obj, IAsn1Choice)); FtagNo := tagNo; Fobj := obj; end; class function TAsn1TaggedObject.GetInstance(obj: TObject): IAsn1TaggedObject; begin if ((obj = Nil) or (obj is TAsn1TaggedObject)) then begin result := obj as TAsn1TaggedObject; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SUnknownObject, [obj.ClassName]); end; function TAsn1TaggedObject.Getobj: IAsn1Encodable; begin result := Fobj; end; class function TAsn1TaggedObject.GetInstance(const obj: IAsn1TaggedObject; explicitly: Boolean): IAsn1TaggedObject; begin if (explicitly) then begin result := GetInstance(obj.GetObject() as TAsn1Object); Exit; end; raise EArgumentCryptoLibException.CreateRes(@SImplicitObject); end; function TAsn1TaggedObject.GetObjectParser(tag: Int32; isExplicit: Boolean) : IAsn1Convertible; begin case tag of TAsn1Tags.&Set: begin result := TAsn1Set.GetInstance(Self as IAsn1TaggedObject, isExplicit).parser; Exit; end; TAsn1Tags.Sequence: begin result := TAsn1Sequence.GetInstance(Self as IAsn1TaggedObject, isExplicit).parser; Exit; end; TAsn1Tags.OctetString: begin result := TAsn1OctetString.GetInstance(Self as IAsn1TaggedObject, isExplicit).parser; Exit; end; end; if (isExplicit) then begin result := GetObject(); Exit; end; raise ENotImplementedCryptoLibException.CreateResFmt(@SImplicitTag, [tag]); end; class function TAsn1TaggedObject.IsConstructed(isExplicit: Boolean; const obj: IAsn1Object): Boolean; var Tagged: IAsn1TaggedObject; begin if ((isExplicit) or (Supports(obj, IAsn1Sequence)) or (Supports(obj, IAsn1Set))) then begin result := True; Exit; end; if (not Supports(obj, IAsn1TaggedObject, Tagged)) then begin result := False; Exit; end; result := IsConstructed(Tagged.isExplicit(), Tagged.GetObject()); end; function TAsn1TaggedObject.IsEmpty: Boolean; begin result := False; // empty; end; function TAsn1TaggedObject.isExplicit: Boolean; begin result := Fexplicitly; end; function TAsn1TaggedObject.ToString: String; begin result := '[' + IntToStr(tagNo) + ']' + (Fobj as TAsn1Encodable).ClassName; end; { TAsn1Set } function TAsn1Set.GetDerEncoded(const obj: IAsn1Encodable): TCryptoLibByteArray; begin try result := obj.GetEncoded(Der); except on e: EIOCryptoLibException do begin raise EInvalidArgumentCryptoLibException.CreateRes(@SObjectEncodeError); end; end; end; function TAsn1Set.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var that: IAsn1Set; o1, o2: IAsn1Object; idx, LCount: Int32; begin if (not Supports(asn1Object, IAsn1Set, that)) then begin result := False; Exit; end; LCount := count; if (that.count <> LCount) then begin result := False; Exit; end; for idx := 0 to System.Pred(LCount) do begin o1 := FElements[idx].ToAsn1Object(); o2 := that.elements[idx].ToAsn1Object(); if ((o1 <> o2) and (not o1.CallAsn1Equals(o2))) then begin result := False; Exit; end; end; result := True; end; function TAsn1Set.Asn1GetHashCode: Int32; var hc, I: Int32; begin I := System.length(FElements); hc := I + 1; System.Dec(I); while (I >= 0) do begin hc := hc * 257; hc := hc xor FElements[I].ToAsn1Object().CallAsn1GetHashCode(); System.Dec(I); end; result := hc; end; constructor TAsn1Set.Create(); begin Inherited Create(); FElements := TAsn1EncodableVector.EmptyElements; end; constructor TAsn1Set.Create(const element: IAsn1Encodable); begin Inherited Create(); if (element = Nil) then begin raise EArgumentNilCryptoLibException.CreateRes(@SElementNil); end; FElements := TCryptoLibGenericArray.Create(element); end; constructor TAsn1Set.Create(const elementVector: IAsn1EncodableVector); begin Inherited Create(); if (elementVector = Nil) then begin raise EArgumentNilCryptoLibException.CreateRes(@SElementVectorNil); end; FElements := elementVector.TakeElements(); end; constructor TAsn1Set.Create(const elements: array of IAsn1Encodable); var LElementsCopy: TCryptoLibGenericArray; begin Inherited Create(); LElementsCopy := OpenArrayToDynamicArray(elements); if (TAsn1Encodable.IsNullOrContainsNull(LElementsCopy)) then begin raise ENullReferenceCryptoLibException.CreateRes(@SElementsNil); end; FElements := TAsn1EncodableVector.CloneElements(LElementsCopy); end; destructor TAsn1Set.Destroy; begin inherited Destroy; end; function TAsn1Set.GetCount: Int32; begin result := System.length(FElements); end; function TAsn1Set.GetElements: TCryptoLibGenericArray; begin result := FElements; end; function TAsn1Set.GetEnumerable: TCryptoLibGenericArray; begin result := FElements; end; class function TAsn1Set.GetInstance(const obj: TCryptoLibByteArray): IAsn1Set; begin try result := TAsn1Set.GetInstance(FromByteArray(obj) as TAsn1Object); except on e: EIOCryptoLibException do begin raise EArgumentCryptoLibException.CreateResFmt(@SInvalidSequence, [e.Message]); end; end; end; class function TAsn1Set.GetInstance(const obj: IAsn1TaggedObject; explicitly: Boolean): IAsn1Set; var inner: IAsn1Object; asn1Set: IAsn1Set; asn1Sequence: IAsn1Sequence; v: IAsn1EncodableVector; ae: IAsn1Encodable; LListAsn1Encodable: TCryptoLibGenericArray; begin inner := obj.GetObject(); if (explicitly) then begin if (not(obj.isExplicit())) then raise EArgumentCryptoLibException.CreateRes(@SInvalidObject); result := inner as IAsn1Set; Exit; end; // // constructed object which appears to be explicitly tagged // when it should be implicit means we have to add the // surrounding sequence. // if (obj.isExplicit()) then begin result := TDerSet.Create(inner); Exit; end; if (Supports(inner, IAsn1Set, asn1Set)) then begin result := asn1Set; Exit; end; // // in this case the parser returns a sequence, convert it // into a set. // if (Supports(inner, IAsn1Sequence, asn1Sequence)) then begin v := TAsn1EncodableVector.Create(); LListAsn1Encodable := asn1Sequence.GetEnumerable; for ae in LListAsn1Encodable do begin v.Add(ae); end; // TODO Should be able to construct set directly from sequence? result := TDerSet.Create(v, False); Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SUnknownObject, [(obj as TAsn1TaggedObject).ClassName]); end; class function TAsn1Set.GetInstance(const obj: TObject): IAsn1Set; var primitive: IAsn1Object; asn1Set: IAsn1Set; res: IAsn1SetParser; begin if ((obj = Nil) or (obj is TAsn1Set)) then begin result := obj as TAsn1Set; Exit; end; if (Supports(obj, IAsn1SetParser, res)) then begin result := TAsn1Set.GetInstance(res.ToAsn1Object() as TAsn1Object); Exit; end; if (obj is TAsn1Encodable) then begin primitive := (obj as TAsn1Encodable).ToAsn1Object(); if (Supports(primitive, IAsn1Set, asn1Set)) then begin result := asn1Set; Exit; end; end; raise EArgumentCryptoLibException.CreateResFmt(@SUnknownObject, [obj.ClassName]); end; function TAsn1Set.GetParser: IAsn1SetParser; begin result := TAsn1SetParserImpl.Create(Self as IAsn1Set); end; function TAsn1Set.GetSelf(Index: Int32): IAsn1Encodable; begin result := FElements[Index]; end; class function TAsn1Set.LessThanOrEqual(const a, b: TCryptoLibByteArray): Boolean; var last, I, a0, b0: Int32; begin {$IFDEF DEBUG} System.Assert((System.length(a) >= 2) and (System.length(b) >= 2)); {$ENDIF DEBUG} (* * NOTE: Set elements in DER encodings are ordered first according to their tags (class and * number); the CONSTRUCTED bit is not part of the tag. * * For SET-OF, this is unimportant. All elements have the same tag and DER requires them to * either all be in constructed form or all in primitive form, according to that tag. The * elements are effectively ordered according to their content octets. * * For SET, the elements will have distinct tags, and each will be in constructed or * primitive form accordingly. Failing to ignore the CONSTRUCTED bit could therefore lead to * ordering inversions. *) a0 := a[0] and (not TAsn1Tags.Constructed); b0 := b[0] and (not TAsn1Tags.Constructed); if (a0 <> b0) then begin result := a0 < b0; Exit; end; last := Math.Min(System.length(a), System.length(b)) - 1; I := 1; while I < last do begin if (a[I] <> b[I]) then begin result := (a[I]) < (b[I]); Exit; end; System.Inc(I); end; result := (a[last]) <= (b[last]); end; procedure TAsn1Set.Sort; var count, I, j: Int32; eh, ei, et, e2, e1: IAsn1Encodable; bh, bi, bt, b2, b1: TCryptoLibByteArray; begin count := System.length(FElements); if (count < 2) then begin Exit; end; eh := FElements[0]; ei := FElements[1]; bh := GetDerEncoded(eh); bi := GetDerEncoded(ei); if (LessThanOrEqual(bi, bh)) then begin et := ei; ei := eh; eh := et; bt := bi; bi := bh; bh := bt; end; for I := 2 to System.Pred(count) do begin e2 := FElements[I]; b2 := GetDerEncoded(e2); if (LessThanOrEqual(bi, b2)) then begin FElements[I - 2] := eh; eh := ei; bh := bi; ei := e2; bi := b2; continue; end; if (LessThanOrEqual(bh, b2)) then begin FElements[I - 2] := eh; eh := e2; bh := b2; continue; end; j := I - 1; System.Dec(j); while (j > 0) do begin e1 := FElements[j - 1]; b1 := GetDerEncoded(e1); if (LessThanOrEqual(b1, b2)) then begin break; end; FElements[j] := e1; System.Dec(j); end; FElements[j] := e2; end; FElements[count - 2] := eh; FElements[count - 1] := ei; end; function TAsn1Set.ToArray: TCryptoLibGenericArray; begin result := TAsn1EncodableVector.CloneElements(FElements); end; function TAsn1Set.ToString: String; begin result := TCollectionUtilities.ToStructuredString(FElements); end; { TAsn1Set.TAsn1SetParserImpl } constructor TAsn1Set.TAsn1SetParserImpl.Create(const outer: IAsn1Set); begin Inherited Create(); Fouter := outer; Fmax := outer.count; end; function TAsn1Set.TAsn1SetParserImpl.ReadObject: IAsn1Convertible; var obj: IAsn1Encodable; Sequence: IAsn1Sequence; asn1Set: IAsn1Set; begin if (Findex = Fmax) then begin result := Nil; Exit; end; obj := Fouter[Findex]; System.Inc(Findex); if (Supports(obj, IAsn1Sequence, Sequence)) then begin result := Sequence.parser; Exit; end; if (Supports(obj, IAsn1Set, asn1Set)) then begin result := asn1Set.parser; Exit; end; // NB: Asn1OctetString implements Asn1OctetStringParser directly // if (obj is Asn1OctetString) // return ((Asn1OctetString)obj).Parser; result := obj; end; function TAsn1Set.TAsn1SetParserImpl.ToAsn1Object: IAsn1Object; begin result := Fouter; end; { TDerSet } class function TDerSet.GetEmpty: IDerSet; begin result := TDerSet.Create(); end; constructor TDerSet.Create(const elements: array of IAsn1Encodable); begin Inherited Create(elements); Sort(); end; constructor TDerSet.Create; begin Inherited Create(); end; constructor TDerSet.Create(const element: IAsn1Encodable); begin Inherited Create(element); end; constructor TDerSet.Create(const elementVector: IAsn1EncodableVector); begin Create(elementVector, True); end; constructor TDerSet.Create(const elementVector: IAsn1EncodableVector; needsSorting: Boolean); begin Inherited Create(elementVector); if (needsSorting) then begin Sort(); end; end; destructor TDerSet.Destroy; begin inherited Destroy; end; procedure TDerSet.Encode(const derOut: TStream); var bOut: TMemoryStream; dOut: TDerOutputStream; obj: IAsn1Encodable; bytes: TCryptoLibByteArray; LListAsn1Encodable: TCryptoLibGenericArray; begin // TODO Intermediate buffer could be avoided if we could calculate expected length bOut := TMemoryStream.Create(); dOut := TDerOutputStream.Create(bOut); try LListAsn1Encodable := Self.GetEnumerable; for obj in LListAsn1Encodable do begin dOut.WriteObject(obj); end; System.SetLength(bytes, bOut.Size); bOut.Position := 0; bOut.Read(bytes[0], bOut.Size); finally bOut.Free; dOut.Free; end; (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.&Set or TAsn1Tags.Constructed, bytes); end; class function TDerSet.FromVector(const elementVector: IAsn1EncodableVector; needsSorting: Boolean): IDerSet; begin if elementVector.count < 1 then begin result := Empty; end else begin result := TDerSet.Create(elementVector, needsSorting); end; end; class function TDerSet.FromVector(const elementVector : IAsn1EncodableVector): IDerSet; begin if elementVector.count < 1 then begin result := Empty; end else begin result := TDerSet.Create(elementVector); end; end; { TAsn1StreamParser } procedure TAsn1StreamParser.Set00Check(enabled: Boolean); var indefiniteLengthInputStream: TIndefiniteLengthInputStream; begin if (F_in is TIndefiniteLengthInputStream) then begin indefiniteLengthInputStream := F_in as TIndefiniteLengthInputStream; indefiniteLengthInputStream.SetEofOn00(enabled); end; end; constructor TAsn1StreamParser.Create(const inStream: TStream); begin Create(inStream, TAsn1InputStream.FindLimit(inStream)); end; constructor TAsn1StreamParser.Create(const inStream: TStream; limit: Int32); begin Inherited Create(); F_in := inStream; F_limit := limit; System.SetLength(FtmpBuffers, 16); end; constructor TAsn1StreamParser.Create(const encoding: TCryptoLibByteArray); begin // used TBytesStream here for one pass creation and population with byte array :) Create(TBytesStream.Create(encoding), System.length(encoding)); end; destructor TAsn1StreamParser.Destroy; begin F_in.Free; inherited Destroy; end; function TAsn1StreamParser.ReadVector: IAsn1EncodableVector; var obj: IAsn1Convertible; begin obj := ReadObject(); if obj = Nil then begin result := TAsn1EncodableVector.Create(0); Exit; end; result := TAsn1EncodableVector.Create(); repeat result.Add([obj.ToAsn1Object()]); obj := ReadObject(); until not(obj <> Nil); end; function TAsn1StreamParser.ReadImplicit(Constructed: Boolean; tag: Int32) : IAsn1Convertible; begin if (F_in is TIndefiniteLengthInputStream) then begin if (not Constructed) then begin raise EIOCryptoLibException.CreateRes(@SIndefiniteLength); end; result := ReadIndef(tag); Exit; end; if (Constructed) then begin case tag of TAsn1Tags.&Set: begin result := TDerSetParser.Create(Self as IAsn1StreamParser); Exit; end; TAsn1Tags.Sequence: begin result := TDerSequenceParser.Create(Self as IAsn1StreamParser); Exit; end; TAsn1Tags.OctetString: begin result := TBerOctetStringParser.Create(Self as IAsn1StreamParser); Exit; end; end; end else begin case tag of TAsn1Tags.&Set: begin raise EAsn1CryptoLibException.CreateRes(@SUnConstructedEncoding); end; TAsn1Tags.Sequence: begin raise EAsn1CryptoLibException.CreateRes(@SUnConstructedEncoding2); end; TAsn1Tags.OctetString: begin result := TDerOctetStringParser.Create (F_in as TDefiniteLengthInputStream); Exit; end; end; end; raise EAsn1CryptoLibException.CreateRes(@SImplicitTagging); end; function TAsn1StreamParser.ReadIndef(tagValue: Int32): IAsn1Convertible; begin // Note: INDEF => CONSTRUCTED // TODO There are other tags that may be constructed (e.g. BIT_STRING) case tagValue of TAsn1Tags.External: begin result := TDerExternalParser.Create(Self as IAsn1StreamParser); Exit; end; TAsn1Tags.OctetString: begin result := TBerOctetStringParser.Create(Self as IAsn1StreamParser); Exit; end; TAsn1Tags.Sequence: begin result := TBerSequenceParser.Create(Self as IAsn1StreamParser); Exit; end; TAsn1Tags.&Set: begin result := TBerSetParser.Create(Self as IAsn1StreamParser); Exit; end; else begin raise EAsn1CryptoLibException.CreateResFmt(@SUnknownObjectBER, [tagValue]); end; end; end; function TAsn1StreamParser.ReadObject: IAsn1Convertible; var tag, tagNo, &length: Int32; IsConstructed: Boolean; indIn: TIndefiniteLengthInputStream; sp: IAsn1StreamParser; defIn: TDefiniteLengthInputStream; begin tag := TStreamSorter.ReadByte(F_in); if (tag = -1) then begin result := Nil; Exit; end; // turn off looking for "00" while we resolve the tag Set00Check(False); // // calculate tag number // tagNo := TAsn1InputStream.ReadTagNumber(F_in, tag); IsConstructed := (tag and TAsn1Tags.Constructed) <> 0; // // calculate length // length := TAsn1InputStream.ReadLength(F_in, F_limit); if (length < 0) then // indefinite length method begin if (not IsConstructed) then begin raise EIOCryptoLibException.CreateRes(@SIndefiniteLength); end; indIn := TIndefiniteLengthInputStream.Create(F_in, F_limit); sp := TAsn1StreamParser.Create(indIn, F_limit); if ((tag and TAsn1Tags.Application) <> 0) then begin result := TBerApplicationSpecificParser.Create(tagNo, sp); Exit; end; if ((tag and TAsn1Tags.Tagged) <> 0) then begin result := TBerTaggedObjectParser.Create(True, tagNo, sp); Exit; end; result := sp.ReadIndef(tagNo); Exit; end; defIn := TDefiniteLengthInputStream.Create(F_in, length); if ((tag and TAsn1Tags.Application) <> 0) then begin try result := TDerApplicationSpecific.Create(IsConstructed, tagNo, defIn.ToArray()); Exit; finally defIn.Free; end; end; if ((tag and TAsn1Tags.Tagged) <> 0) then begin result := TBerTaggedObjectParser.Create(IsConstructed, tagNo, TAsn1StreamParser.Create(defIn) as IAsn1StreamParser); Exit; end; if (IsConstructed) then begin // TODO There are other tags that may be constructed (e.g. BitString) case tagNo of TAsn1Tags.OctetString: begin // // yes, people actually do this... // result := TBerOctetStringParser.Create(TAsn1StreamParser.Create(defIn) as IAsn1StreamParser); Exit; end; TAsn1Tags.Sequence: begin result := TDerSequenceParser.Create(TAsn1StreamParser.Create(defIn) as IAsn1StreamParser); Exit; end; TAsn1Tags.&Set: begin result := TDerSetParser.Create(TAsn1StreamParser.Create(defIn) as IAsn1StreamParser); Exit; end; TAsn1Tags.External: begin result := TDerExternalParser.Create(TAsn1StreamParser.Create(defIn) as IAsn1StreamParser); Exit; end; else begin defIn.Free; // free the stream incase an unsupported tag is encountered. raise EIOCryptoLibException.CreateResFmt(@SUnknownTag, [tagNo]); end; end; end; // Some primitive encodings can be handled by parsers too... case tagNo of TAsn1Tags.OctetString: begin result := TDerOctetStringParser.Create(defIn); Exit; end; end; try try result := TAsn1InputStream.CreatePrimitiveDerObject(tagNo, defIn, FtmpBuffers); Exit; except on e: EArgumentCryptoLibException do begin raise EAsn1CryptoLibException.CreateResFmt(@SCorruptedStream, [e.Message]); end; end; finally defIn.Free; end; end; function TAsn1StreamParser.ReadTaggedObject(Constructed: Boolean; tag: Int32) : IAsn1Object; var defIn: TDefiniteLengthInputStream; v: IAsn1EncodableVector; begin if (not Constructed) then begin // Note: !CONSTRUCTED => IMPLICIT defIn := F_in as TDefiniteLengthInputStream; result := TDerTaggedObject.Create(False, tag, TDerOctetString.Create(defIn.ToArray())); Exit; end; v := ReadVector(); if (F_in is TIndefiniteLengthInputStream) then begin if v.count = 1 then begin result := TBerTaggedObject.Create(True, tag, v[0]); Exit; end else begin result := TBerTaggedObject.Create(False, tag, TBerSequence.FromVector(v)); Exit; end; end; if v.count = 1 then begin result := TDerTaggedObject.Create(True, tag, v[0]); Exit; end else begin result := TDerTaggedObject.Create(False, tag, TDerSequence.FromVector(v)); Exit; end; end; { TDerSetParser } constructor TDerSetParser.Create(const parser: IAsn1StreamParser); begin F_parser := parser; end; function TDerSetParser.ReadObject: IAsn1Convertible; begin result := F_parser.ReadObject(); end; function TDerSetParser.ToAsn1Object: IAsn1Object; begin result := TDerSet.Create(F_parser.ReadVector(), False); end; { TDerSequenceParser } constructor TDerSequenceParser.Create(const parser: IAsn1StreamParser); begin F_parser := parser; end; function TDerSequenceParser.ReadObject: IAsn1Convertible; begin result := F_parser.ReadObject(); end; function TDerSequenceParser.ToAsn1Object: IAsn1Object; begin result := TDerSequence.Create(F_parser.ReadVector()); end; { TDerApplicationSpecific } function TDerApplicationSpecific.GetApplicationTag: Int32; begin result := Ftag; end; function TDerApplicationSpecific.GetContents: TCryptoLibByteArray; begin result := Foctets; end; function TDerApplicationSpecific.IsConstructed: Boolean; begin result := FisConstructed; end; function TDerApplicationSpecific.GetLengthOfHeader (const data: TCryptoLibByteArray): Int32; var &length, Size: Int32; begin length := data[1]; // TODO: assumes 1 byte tag if (length = $80) then begin result := 2; // indefinite-length encoding Exit; end; if (length > 127) then begin Size := length and $7F; // Note: The invalid long form "0xff" (see X.690 8.1.3.5c) will be caught here if (Size > 4) then begin raise EInvalidOperationCryptoLibException.CreateResFmt (@SInvalidDerLength, [Size]); end; result := Size + 2; Exit; end; result := 2; end; constructor TDerApplicationSpecific.Create(tag: Int32; const obj: IAsn1Encodable); begin Create(True, tag, obj); end; constructor TDerApplicationSpecific.Create(tag: Int32; const octets: TCryptoLibByteArray); begin Create(False, tag, octets); end; constructor TDerApplicationSpecific.Create(IsConstructed: Boolean; tag: Int32; const octets: TCryptoLibByteArray); begin Inherited Create(); FisConstructed := IsConstructed; Ftag := tag; Foctets := octets; end; function TDerApplicationSpecific.Asn1Equals(const asn1Object : IAsn1Object): Boolean; var other: IDerApplicationSpecific; begin if (not Supports(asn1Object, IDerApplicationSpecific, other)) then begin result := False; Exit; end; result := (IsConstructed = other.IsConstructed) and (ApplicationTag = other.ApplicationTag) and TArrayUtils.AreEqual(GetContents, other.GetContents); end; function TDerApplicationSpecific.Asn1GetHashCode: Int32; var HashCode: Int32; begin case IsConstructed of True: HashCode := 1; False: HashCode := 0; end; result := HashCode xor Ftag xor TArrayUtils.GetArrayHashCode(Foctets); end; constructor TDerApplicationSpecific.Create(tagNo: Int32; const vec: IAsn1EncodableVector); var bOut: TMemoryStream; bs: TCryptoLibByteArray; I: Int32; val: IAsn1Encodable; begin Inherited Create(); Ftag := tagNo; FisConstructed := True; bOut := TMemoryStream.Create(); try I := 0; while I <> vec.count do begin try val := vec[I]; bs := val.GetDerEncoded(); bOut.Write(bs[0], System.length(bs)); except on e: EIOCryptoLibException do begin raise EInvalidOperationCryptoLibException.CreateResFmt (@SMalformedObject, [e.Message]); end; end; System.Inc(I); end; System.SetLength(Foctets, bOut.Size); bOut.Position := 0; bOut.Read(Foctets[0], bOut.Size); finally bOut.Free; end; end; procedure TDerApplicationSpecific.Encode(const derOut: TStream); var classBits: Int32; begin classBits := TAsn1Tags.Application; if (IsConstructed) then begin classBits := classBits or TAsn1Tags.Constructed; end; (derOut as TDerOutputStream).WriteEncoded(classBits, Ftag, Foctets); end; constructor TDerApplicationSpecific.Create(isExplicit: Boolean; tag: Int32; const obj: IAsn1Encodable); var asn1Obj: IAsn1Object; data, tmp: TCryptoLibByteArray; lenBytes: Int32; begin Inherited Create(); asn1Obj := obj.ToAsn1Object(); data := asn1Obj.GetDerEncoded(); FisConstructed := TAsn1TaggedObject.IsConstructed(isExplicit, asn1Obj); Ftag := tag; if (isExplicit) then begin Foctets := data; end else begin lenBytes := GetLengthOfHeader(data); System.SetLength(tmp, System.length(data) - lenBytes); System.Move(data[lenBytes], tmp[0], System.length(tmp) * System.SizeOf(Byte)); Foctets := tmp; end; end; function TDerApplicationSpecific.GetObject: IAsn1Object; begin result := FromByteArray(GetContents()); end; function TDerApplicationSpecific.GetObject(derTagNo: Int32): IAsn1Object; var orig, tmp: TCryptoLibByteArray; begin if (derTagNo >= $1F) then begin raise EIOCryptoLibException.CreateRes(@SUnSupportedTag); end; orig := GetEncoded(); tmp := ReplaceTagNumber(derTagNo, orig); if ((orig[0] and TAsn1Tags.Constructed) <> 0) then begin tmp[0] := tmp[0] or TAsn1Tags.Constructed; end; result := FromByteArray(tmp); end; class function TDerApplicationSpecific.ReplaceTagNumber(newTag: Int32; const input: TCryptoLibByteArray): TCryptoLibByteArray; var tagNo, Index, b, Remaining: Int32; tmp: TCryptoLibByteArray; begin tagNo := input[0] and $1F; index := 1; // // with tagged object tag number is bottom 5 bits, or stored at the start of the content // if (tagNo = $1F) then begin b := input[index]; System.Inc(index); // X.690-0207 8.1.2.4.2 // "c) bits 7 to 1 of the first subsequent octet shall not all be zero." if ((b and $7F) = 0) then // Note: -1 will pass begin raise EIOCryptoLibException.CreateRes(@SCorruptedStreamInvalidTag); end; while ((b and $80) <> 0) do begin b := input[index]; System.Inc(index); end; end; Remaining := System.length(input) - index; System.SetLength(tmp, 1 + Remaining); tmp[0] := Byte(newTag); System.Move(input[index], tmp[1], Remaining * System.SizeOf(Byte)); result := tmp; end; { TBerApplicationSpecific } constructor TBerApplicationSpecific.Create(tagNo: Int32; const vec: IAsn1EncodableVector); begin inherited Create(tagNo, vec); end; { TBerOctetStringParser } constructor TBerOctetStringParser.Create(const parser: IAsn1StreamParser); begin Inherited Create(); F_parser := parser; end; function TBerOctetStringParser.GetOctetStream: TStream; begin result := TConstructedOctetStream.Create(F_parser); end; function TBerOctetStringParser.ToAsn1Object: IAsn1Object; var LStream: TStream; begin try LStream := GetOctetStream(); try result := TBerOctetString.Create(TStreamUtils.ReadAll(LStream)); finally LStream.Free; end; except on e: EIOCryptoLibException do begin raise EAsn1ParsingCryptoLibException.CreateResFmt(@SConvertError, [e.Message]); end; end; end; { TBerApplicationSpecificParser } constructor TBerApplicationSpecificParser.Create(tag: Int32; const parser: IAsn1StreamParser); begin F_tag := tag; F_parser := parser; end; function TBerApplicationSpecificParser.ReadObject: IAsn1Convertible; begin result := F_parser.ReadObject(); end; function TBerApplicationSpecificParser.ToAsn1Object: IAsn1Object; begin result := TBerApplicationSpecific.Create(F_tag, F_parser.ReadVector()); end; { TDerStringBase } function TDerStringBase.Asn1GetHashCode: Int32; begin result := TStringUtils.GetStringHashCode(GetString()); end; constructor TDerStringBase.Create; begin Inherited Create(); end; function TDerStringBase.ToString: String; begin result := GetString(); end; { TDerBitString } class function TDerBitString.GetInstance(const obj: TCryptoLibByteArray) : IDerBitString; begin try result := FromByteArray(obj) as IDerBitString; except on e: Exception do begin raise EArgumentCryptoLibException.CreateResFmt(@SEncodingError, [e.Message]); end; end; end; function TDerBitString.GetmData: TCryptoLibByteArray; begin result := FmData; end; function TDerBitString.GetmPadBits: Int32; begin result := FmPadBits; end; function TDerBitString.GetOctets: TCryptoLibByteArray; begin if (mPadBits <> 0) then begin raise EInvalidOperationCryptoLibException.CreateRes(@SUnalignedData); end; result := System.Copy(mData); end; function TDerBitString.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerBitString; begin if (not Supports(asn1Object, IDerBitString, other)) then begin result := False; Exit; end; result := (mPadBits = other.mPadBits) and (TArrayUtils.AreEqual(mData, other.mData)); end; constructor TDerBitString.Create(const data: TCryptoLibByteArray; padBits: Int32); begin Inherited Create(); if (data = Nil) then begin raise EArgumentNilCryptoLibException.CreateRes(@SDataNil); end; if ((padBits < 0) or (padBits > 7)) then begin raise EArgumentCryptoLibException.CreateRes(@SInvalidRange); end; if ((System.length(data) = 0) and (padBits <> 0)) then begin raise EArgumentCryptoLibException.CreateRes(@SPadBitError); end; FmData := System.Copy(data); FmPadBits := padBits; end; constructor TDerBitString.Create(const data: TCryptoLibByteArray); begin Create(data, 0); end; constructor TDerBitString.Create(namedBits: Int32); var bits, bytes, I, padBits: Int32; data: TCryptoLibByteArray; begin Inherited Create(); if (namedBits = 0) then begin System.SetLength(FmData, 0); FmPadBits := 0; Exit; end; bits := TBigInteger.BitLen(namedBits); bytes := (bits + 7) div 8; {$IFDEF DEBUG} System.Assert((0 < bytes) and (bytes <= 4)); {$ENDIF DEBUG} System.SetLength(data, bytes); System.Dec(bytes); for I := 0 to System.Pred(bytes) do begin data[I] := Byte(namedBits); namedBits := TBits.Asr32(namedBits, 8); end; {$IFDEF DEBUG} System.Assert((namedBits and $FF) <> 0); {$ENDIF DEBUG} data[bytes] := Byte(namedBits); padBits := 0; while ((namedBits and (1 shl padBits)) = 0) do begin System.Inc(padBits); end; {$IFDEF DEBUG} System.Assert(padBits < 8); {$ENDIF DEBUG} FmData := data; FmPadBits := padBits; end; procedure TDerBitString.Encode(const derOut: TStream); var last, mask, unusedBits: Int32; contents: TCryptoLibByteArray; begin if (mPadBits > 0) then begin last := mData[System.length(mData) - 1]; mask := (1 shl mPadBits) - 1; unusedBits := last and mask; if (unusedBits <> 0) then begin contents := TArrayUtils.Prepend(mData, Byte(mPadBits)); // /* // * X.690-0207 11.2.1: Each unused bit in the final octet of the encoding of a bit string value shall be set to zero. // */ contents[System.length(contents) - 1] := Byte(last xor unusedBits); (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.BitString, contents); Exit; end; end; (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.BitString, Byte(mPadBits), mData); end; class function TDerBitString.FromAsn1Octets(const octets: TCryptoLibByteArray) : IDerBitString; var padBits, last, mask: Int32; data: TCryptoLibByteArray; begin if (System.length(octets) < 1) then begin raise EArgumentCryptoLibException.CreateRes(@STruncatedBitString); end; padBits := octets[0]; data := TArrayUtils.CopyOfRange(octets, 1, System.length(octets)); if ((padBits > 0) and (padBits < 8) and (System.length(data) > 0)) then begin last := data[System.length(data) - 1]; mask := (1 shl padBits) - 1; if ((last and mask) <> 0) then begin result := TBerBitString.Create(data, padBits); Exit; end; end; result := TDerBitString.Create(data, padBits); end; function TDerBitString.GetBytes: TCryptoLibByteArray; begin result := System.Copy(mData); // DER requires pad bits be zero if (mPadBits > 0) then begin result[System.length(result) - 1] := result[System.length(result) - 1] and Byte($FF shl mPadBits); end; end; class function TDerBitString.GetInstance(const obj: TObject): IDerBitString; begin if ((obj = Nil) or (obj is TDerBitString)) then begin result := obj as TDerBitString; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerBitString.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerBitString; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerBitString))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := FromAsn1Octets((o as IAsn1OctetString).GetOctets()); end; function TDerBitString.GetInt32Value: Int32; var Value, &length, I, mask: Int32; begin Value := 0; length := Min(4, System.length(mData)); for I := 0 to System.Pred(length) do begin Value := Value or (Int32(mData[I]) shl (8 * I)); end; if ((mPadBits > 0) and (length = System.length(mData))) then begin mask := (1 shl mPadBits) - 1; Value := Value and (not(mask shl (8 * (length - 1)))); end; result := Value; end; function TDerBitString.GetString: String; var buffer: TStringList; I: Int32; Str: TCryptoLibByteArray; ubyte: UInt32; begin buffer := TStringList.Create(); buffer.LineBreak := ''; Str := GetDerEncoded(); buffer.Add('#'); I := 0; try while I <> System.length(Str) do begin ubyte := Str[I]; buffer.Add(FTable[(ubyte shr 4) and $F]); buffer.Add(FTable[Str[I] and $F]); System.Inc(I); end; result := buffer.Text; finally buffer.Free; end; end; function TDerBitString.Asn1GetHashCode: Int32; begin result := mPadBits xor TArrayUtils.GetArrayHashCode(mData); end; constructor TDerBitString.Create(const obj: IAsn1Encodable); begin Create(obj.GetDerEncoded()); end; { TBerBitString } constructor TBerBitString.Create(const data: TCryptoLibByteArray); begin Inherited Create(data); end; constructor TBerBitString.Create(const data: TCryptoLibByteArray; padBits: Int32); begin Inherited Create(data, padBits); end; constructor TBerBitString.Create(const obj: IAsn1Encodable); begin Inherited Create(obj); end; constructor TBerBitString.Create(namedBits: Int32); begin Inherited Create(namedBits); end; procedure TBerBitString.Encode(const derOut: TStream); begin if ((derOut is TAsn1OutputStream) or (derOut is TBerOutputStream)) then begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.BitString, Byte(mPadBits), mData); end else begin Inherited Encode(derOut); end; end; { TBerGenerator } constructor TBerGenerator.Create(outStream: TStream); begin Inherited Create(outStream); end; procedure TBerGenerator.AddObject(const obj: IAsn1Encodable); var temp: TBerOutputStream; begin temp := TBerOutputStream.Create(&Out); try temp.WriteObject(obj); finally temp.Free; end; end; procedure TBerGenerator.Close; begin WriteBerEnd(); end; constructor TBerGenerator.Create(outStream: TStream; tagNo: Int32; isExplicit: Boolean); begin Inherited Create(outStream); F_tagged := True; F_isExplicit := isExplicit; F_tagNo := tagNo; end; function TBerGenerator.GetRawOutputStream: TStream; begin result := &Out; end; procedure TBerGenerator.WriteBerBody(contentStream: TStream); begin TStreamUtils.PipeAll(contentStream, &Out); end; procedure TBerGenerator.WriteBerEnd; begin &Out.WriteByte($00); &Out.WriteByte($00); if (F_tagged and F_isExplicit) then // write extra end for tag header begin &Out.WriteByte($00); &Out.WriteByte($00); end; end; procedure TBerGenerator.WriteBerHeader(tag: Int32); var tagNum: Int32; begin if (F_tagged) then begin tagNum := F_tagNo or TAsn1Tags.Tagged; if (F_isExplicit) then begin WriteHdr(tagNum or TAsn1Tags.Constructed); WriteHdr(tag); end else begin if ((tag and TAsn1Tags.Constructed) <> 0) then begin WriteHdr(tagNum or TAsn1Tags.Constructed); end else begin WriteHdr(tagNum); end; end end else begin WriteHdr(tag); end; end; procedure TBerGenerator.WriteHdr(tag: Int32); begin &Out.WriteByte(Byte(tag)); &Out.WriteByte($80); end; { TBerNull } constructor TBerNull.Create(dummy: Int32); begin Inherited Create(dummy); end; procedure TBerNull.Encode(const derOut: TStream); begin if ((derOut is TAsn1OutputStream) or (derOut is TBerOutputStream)) then begin (derOut as TDerOutputStream).WriteByte(TAsn1Tags.Null); end else begin Inherited Encode(derOut); end; end; class function TBerNull.GetInstance: IBerNull; begin result := TBerNull.Create(0); end; { TBerSequenceGenerator } constructor TBerSequenceGenerator.Create(outStream: TStream); begin Inherited Create(outStream); WriteBerHeader(TAsn1Tags.Constructed or TAsn1Tags.Sequence); end; constructor TBerSequenceGenerator.Create(outStream: TStream; tagNo: Int32; isExplicit: Boolean); begin Inherited Create(outStream, tagNo, isExplicit); WriteBerHeader(TAsn1Tags.Constructed or TAsn1Tags.Sequence); end; { TBerSequenceParser } constructor TBerSequenceParser.Create(const parser: IAsn1StreamParser); begin F_parser := parser; end; function TBerSequenceParser.ReadObject: IAsn1Convertible; begin result := F_parser.ReadObject(); end; function TBerSequenceParser.ToAsn1Object: IAsn1Object; begin result := TBerSequence.Create(F_parser.ReadVector()); end; { TBerSet } class function TBerSet.GetEmpty: IBerSet; begin result := TBerSet.Create(); end; constructor TBerSet.Create; begin Inherited Create(); end; constructor TBerSet.Create(const v: IAsn1EncodableVector; needsSorting: Boolean); begin Inherited Create(v, needsSorting); end; destructor TBerSet.Destroy; begin inherited Destroy; end; constructor TBerSet.Create(const element: IAsn1Encodable); begin Inherited Create(element); end; constructor TBerSet.Create(const elementVector: IAsn1EncodableVector); begin Inherited Create(elementVector, False); end; procedure TBerSet.Encode(const derOut: TStream); var o: IAsn1Encodable; LListAsn1Encodable: TCryptoLibGenericArray; begin if ((derOut is TAsn1OutputStream) or (derOut is TBerOutputStream)) then begin (derOut as TDerOutputStream).WriteByte(TAsn1Tags.&Set or TAsn1Tags.Constructed); (derOut as TDerOutputStream).WriteByte($80); LListAsn1Encodable := Self.GetEnumerable; for o in LListAsn1Encodable do begin (derOut as TDerOutputStream).WriteObject(o); end; (derOut as TDerOutputStream).WriteByte($00); (derOut as TDerOutputStream).WriteByte($00); end else begin (Inherited Encode(derOut)); end; end; class function TBerSet.FromVector(const elementVector: IAsn1EncodableVector; needsSorting: Boolean): IBerSet; begin if elementVector.count < 1 then begin result := Empty; end else begin result := TBerSet.Create(elementVector, needsSorting); end; end; class function TBerSet.FromVector(const elementVector : IAsn1EncodableVector): IBerSet; begin if elementVector.count < 1 then begin result := Empty; end else begin result := TBerSet.Create(elementVector); end; end; { TBerSetParser } constructor TBerSetParser.Create(const parser: IAsn1StreamParser); begin F_parser := parser; end; function TBerSetParser.ReadObject: IAsn1Convertible; begin result := F_parser.ReadObject(); end; function TBerSetParser.ToAsn1Object: IAsn1Object; begin result := TBerSet.Create(F_parser.ReadVector(), False); end; { TDerTaggedObject } constructor TDerTaggedObject.Create(tagNo: Int32; const obj: IAsn1Encodable); begin Inherited Create(tagNo, obj); end; constructor TDerTaggedObject.Create(explicitly: Boolean; tagNo: Int32; const obj: IAsn1Encodable); begin Inherited Create(explicitly, tagNo, obj) end; constructor TDerTaggedObject.Create(tagNo: Int32); begin Inherited Create(False, tagNo, TDerSequence.Empty) end; procedure TDerTaggedObject.Encode(const derOut: TStream); var bytes: TCryptoLibByteArray; flags: Int32; begin if (not IsEmpty()) then begin bytes := obj.GetDerEncoded(); if (explicitly) then begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.Constructed or TAsn1Tags.Tagged, tagNo, bytes); end else begin // // need to mark constructed types... (preserve Constructed tag) // flags := (bytes[0] and TAsn1Tags.Constructed) or TAsn1Tags.Tagged; (derOut as TDerOutputStream).WriteTag(flags, tagNo); derOut.Write(bytes[1], System.length(bytes) - 1); end end else begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.Constructed or TAsn1Tags.Tagged, tagNo, Nil); end; end; { TBerTaggedObject } constructor TBerTaggedObject.Create(tagNo: Int32; const obj: IAsn1Encodable); begin Inherited Create(tagNo, obj); end; constructor TBerTaggedObject.Create(explicitly: Boolean; tagNo: Int32; const obj: IAsn1Encodable); begin Inherited Create(explicitly, tagNo, obj) end; constructor TBerTaggedObject.Create(tagNo: Int32); begin Inherited Create(False, tagNo, TBerSequence.Empty) end; procedure TBerTaggedObject.Encode(const derOut: TStream); var eObj: TList; LListIDerOctetString: TCryptoLibGenericArray; LListIAsn1Encodable: TCryptoLibGenericArray; asn1OctetString: IAsn1OctetString; berOctetString: IBerOctetString; derOctetString: IDerOctetString; asn1Sequence: IAsn1Sequence; asn1Set: IAsn1Set; o: IAsn1Encodable; begin eObj := TList.Create(); try if ((derOut is TAsn1OutputStream) or (derOut is TBerOutputStream)) then begin (derOut as TDerOutputStream) .WriteTag(Byte(TAsn1Tags.Constructed or TAsn1Tags.Tagged), tagNo); (derOut as TDerOutputStream).WriteByte($80); if (not IsEmpty()) then begin if (not explicitly) then begin if (Supports(obj, IAsn1OctetString, asn1OctetString)) then begin if (Supports(asn1OctetString, IBerOctetString, berOctetString)) then begin LListIDerOctetString := berOctetString.GetEnumerable; for derOctetString in LListIDerOctetString do begin eObj.Add(derOctetString as IAsn1Encodable); end; end else begin berOctetString := TBerOctetString.Create (asn1OctetString.GetOctets()); LListIDerOctetString := berOctetString.GetEnumerable; for derOctetString in LListIDerOctetString do begin eObj.Add(derOctetString as IAsn1Encodable); end; end end else if Supports(obj, IAsn1Sequence, asn1Sequence) then begin LListIAsn1Encodable := asn1Sequence.GetEnumerable; for o in LListIAsn1Encodable do begin eObj.Add(o); end; end else if Supports(obj, IAsn1Set, asn1Set) then begin LListIAsn1Encodable := asn1Set.GetEnumerable; for o in LListIAsn1Encodable do begin eObj.Add(o); end; end else begin raise ENotImplementedCryptoLibException.CreateResFmt (@SNotImplemented, [(obj as TAsn1Encodable).ClassName]); end; for o in eObj do begin (derOut as TDerOutputStream).WriteObject(o); end; end else begin (derOut as TDerOutputStream).WriteObject(obj); end; end; (derOut as TDerOutputStream).WriteByte($00); (derOut as TDerOutputStream).WriteByte($00); end else begin (Inherited Encode(derOut)); end finally eObj.Free; end; end; { TBerTaggedObjectParser } constructor TBerTaggedObjectParser.Create(Constructed: Boolean; tagNumber: Int32; const parser: IAsn1StreamParser); begin F_constructed := Constructed; F_tagNumber := tagNumber; F_parser := parser; end; destructor TBerTaggedObjectParser.Destroy; begin F_parser := Nil; inherited Destroy; end; function TBerTaggedObjectParser.GetIsConstructed: Boolean; begin result := F_constructed; end; function TBerTaggedObjectParser.GetObjectParser(tag: Int32; isExplicit: Boolean) : IAsn1Convertible; begin if (isExplicit) then begin if (not F_constructed) then begin raise EIOCryptoLibException.CreateRes(@SUnConstructedTag); end; result := F_parser.ReadObject(); Exit; end; result := F_parser.ReadImplicit(F_constructed, tag); end; function TBerTaggedObjectParser.GetTagNo: Int32; begin result := F_tagNumber; end; function TBerTaggedObjectParser.ToAsn1Object: IAsn1Object; begin try result := F_parser.ReadTaggedObject(F_constructed, F_tagNumber); except on e: EIOCryptoLibException do begin raise EAsn1ParsingCryptoLibException.CreateResFmt(@SParsingError, [e.Message]); end; end; end; { TDerBmpString } function TDerBmpString.GetStr: String; begin result := FStr; end; function TDerBmpString.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerBmpString; begin if (not Supports(asn1Object, IDerBmpString, other)) then begin result := False; Exit; end; result := Str = other.Str; end; constructor TDerBmpString.Create(const astr: TCryptoLibByteArray); var cs: TCryptoLibCharArray; I: Int32; begin Inherited Create(); if (astr = Nil) then begin raise EArgumentNilCryptoLibException.CreateRes(@SEmptyInput); end; System.SetLength(cs, System.length(astr) shr 1); I := 0; while I <> System.length(cs) do begin cs[I] := Char((astr[2 * I] shl 8) or (astr[2 * I + 1] and $FF)); System.Inc(I); end; System.SetString(FStr, PChar(@cs[0]), System.length(cs)); end; constructor TDerBmpString.Create(const astr: String); begin Inherited Create(); if (astr = '') then begin raise EArgumentNilCryptoLibException.CreateRes(@SEmptyInput); end; FStr := astr; end; procedure TDerBmpString.Encode(const derOut: TStream); var c: TCryptoLibCharArray; b: TCryptoLibByteArray; I: Int32; begin c := TStringUtils.StringToCharArray(Str); System.SetLength(b, System.length(c) * 2); I := 0; while I <> System.length(c) do begin b[2 * I] := Byte(Ord(c[I]) shr 8); b[2 * I + 1] := Byte(c[I]); System.Inc(I); end; (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.BmpString, b); end; class function TDerBmpString.GetInstance(const obj: TObject): IDerBmpString; begin if ((obj = Nil) or (obj is TDerBmpString)) then begin result := obj as TDerBmpString; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerBmpString.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerBmpString; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerBmpString))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := TDerBmpString.Create(TAsn1OctetString.GetInstance(o as TAsn1Object) .GetOctets()); end; function TDerBmpString.GetString: String; begin result := FStr; end; { TDerBoolean } function TDerBoolean.GetIsTrue: Boolean; begin result := Fvalue <> 0; end; function TDerBoolean.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerBoolean; begin if (not Supports(asn1Object, IDerBoolean, other)) then begin result := System.False; Exit; end; result := IsTrue = other.IsTrue; end; function TDerBoolean.Asn1GetHashCode: Int32; begin result := Ord(IsTrue); end; constructor TDerBoolean.Create(const val: TCryptoLibByteArray); begin Inherited Create(); if (System.length(val) <> 1) then begin raise EArgumentCryptoLibException.CreateRes(@SInvalidValue); end; // TODO Are there any constraints on the possible byte values? Fvalue := val[0]; end; constructor TDerBoolean.Create(Value: Boolean); begin Inherited Create(); if Value then begin Fvalue := Byte($FF) end else begin Fvalue := Byte(0) end; end; procedure TDerBoolean.Encode(const derOut: TStream); begin // TODO Should we make sure the byte value is one of '0' or '0xff' here? (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.Boolean, TCryptoLibByteArray.Create(Fvalue)); end; class function TDerBoolean.FromOctetString(const Value: TCryptoLibByteArray) : IDerBoolean; var b: Byte; begin if (System.length(Value) <> 1) then begin raise EArgumentCryptoLibException.CreateRes(@SInvalidBooleanValue); end; b := Value[0]; case b of 0: result := TDerBoolean.False; $FF: result := TDerBoolean.True else begin result := TDerBoolean.Create(Value); end; end; end; class function TDerBoolean.GetInstance(Value: Boolean): IDerBoolean; begin if Value then begin result := TDerBoolean.True; end else begin result := TDerBoolean.False; end; end; class function TDerBoolean.GetInstance(const obj: TObject): IDerBoolean; begin if ((obj = Nil) or (obj is TDerBoolean)) then begin Supports(obj, IDerBoolean, result); Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerBoolean.GetFalse: IDerBoolean; begin result := TDerBoolean.Create(System.False); end; class function TDerBoolean.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerBoolean; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerBoolean))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := FromOctetString((o as IAsn1OctetString).GetOctets()); end; class function TDerBoolean.GetTrue: IDerBoolean; begin result := TDerBoolean.Create(System.True); end; function TDerBoolean.ToString: String; begin result := BoolToStr(IsTrue, System.True); end; { TDerEnumerated } function TDerEnumerated.GetBytes: TCryptoLibByteArray; begin result := Fbytes; end; function TDerEnumerated.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerEnumerated; begin if (not Supports(asn1Object, IDerEnumerated, other)) then begin result := False; Exit; end; result := TArrayUtils.AreEqual(bytes, other.bytes); end; function TDerEnumerated.Asn1GetHashCode: Int32; begin result := TArrayUtils.GetArrayHashCode(bytes); end; constructor TDerEnumerated.Create(val: Int32); begin Inherited Create(); if (val < 0) then begin raise EArgumentCryptoLibException.CreateRes(@SEnumeratedNegative); end; Fbytes := TBigInteger.ValueOf(val).ToByteArray(); FStart := 0; end; constructor TDerEnumerated.Create(val: Int64); begin Inherited Create(); if (val < 0) then begin raise EArgumentCryptoLibException.CreateRes(@SEnumeratedNegative); end; Fbytes := TBigInteger.ValueOf(val).ToByteArray(); FStart := 0; end; constructor TDerEnumerated.Create(const val: TBigInteger); begin Inherited Create(); if (val.SignValue < 0) then begin raise EArgumentCryptoLibException.CreateRes(@SEnumeratedNegative); end; Fbytes := val.ToByteArray(); FStart := 0; end; constructor TDerEnumerated.Create(const bytes: TCryptoLibByteArray); begin Inherited Create(); if (TDerInteger.IsMalformed(bytes)) then begin raise EArgumentCryptoLibException.CreateRes(@SMalformedEnumerated); end; if (0 <> (bytes[0] and $80)) then begin raise EArgumentCryptoLibException.CreateRes(@SEnumeratedNegative); end; Fbytes := System.Copy(bytes); FStart := TDerInteger.SignBytesToSkip(bytes); end; procedure TDerEnumerated.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.Enumerated, Fbytes); end; class function TDerEnumerated.FromOctetString(const enc: TCryptoLibByteArray) : IDerEnumerated; var LValue: Int32; possibleMatch: IDerEnumerated; begin if (System.length(enc) > 1) then begin result := TDerEnumerated.Create(enc); Exit; end; if (System.length(enc) = 0) then begin raise EArgumentCryptoLibException.CreateRes(@SZeroLength); end; LValue := enc[0]; if (LValue >= System.length(Fcache)) then begin result := TDerEnumerated.Create(enc); Exit; end; possibleMatch := Fcache[LValue]; if (possibleMatch = Nil) then begin possibleMatch := TDerEnumerated.Create(enc); Fcache[LValue] := possibleMatch; end; result := possibleMatch; end; class function TDerEnumerated.GetInstance(const obj: TObject): IDerEnumerated; begin if ((obj = Nil) or (obj is TDerEnumerated)) then begin result := obj as TDerEnumerated; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerEnumerated.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerEnumerated; var o: IAsn1Object; begin o := obj.GetObject(); if (isExplicit or (Supports(o, IDerEnumerated))) then begin result := GetInstance(o as TObject); Exit; end; result := FromOctetString((o as IAsn1OctetString).GetOctets()); end; function TDerEnumerated.GetIntValueExact: Int32; var count: Int32; begin count := System.length(Fbytes) - FStart; if (count > 4) then begin raise EArithmeticCryptoLibException.CreateRes(@SASN1IntegerOutOfRangeError); end; result := TDerInteger.IntValue(Fbytes, FStart, TDerInteger.SignExtSigned); end; function TDerEnumerated.GetValue: TBigInteger; begin result := TBigInteger.Create(Fbytes); end; function TDerEnumerated.HasValue(const x: TBigInteger): Boolean; begin result := (x.IsInitialized) // Fast check to avoid allocation and (TDerInteger.IntValue(Fbytes, FStart, TDerInteger.SignExtSigned) = x.Int32Value) and (Value.Equals(x)); end; { TDerGraphicString } function TDerGraphicString.GetmString: TCryptoLibByteArray; begin result := FmString; end; function TDerGraphicString.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerGraphicString; begin if (not Supports(asn1Object, IDerGraphicString, other)) then begin result := False; Exit; end; result := TArrayUtils.AreEqual(mString, other.mString); end; function TDerGraphicString.Asn1GetHashCode: Int32; begin result := TArrayUtils.GetArrayHashCode(mString); end; constructor TDerGraphicString.Create(const encoding: TCryptoLibByteArray); begin Inherited Create(); FmString := System.Copy(encoding); end; procedure TDerGraphicString.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.GraphicString, mString); end; class function TDerGraphicString.GetInstance(const obj: TObject) : IDerGraphicString; begin if ((obj = Nil) or (obj is TDerGraphicString)) then begin result := obj as TDerGraphicString; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerGraphicString.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerGraphicString; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerGraphicString))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := TDerGraphicString.Create (TAsn1OctetString.GetInstance(o as TAsn1Object).GetOctets()); end; class function TDerGraphicString.GetInstance(const obj: TCryptoLibByteArray) : IDerGraphicString; begin try result := FromByteArray(obj) as IDerGraphicString; except on e: Exception do begin raise EArgumentCryptoLibException.CreateResFmt(@SEncodingError, [e.Message]); end; end; end; function TDerGraphicString.GetOctets: TCryptoLibByteArray; begin result := System.Copy(mString); end; function TDerGraphicString.GetString: String; begin result := TConverters.ConvertBytesToString(mString, TEncoding.ANSI); end; { TDerExternal } class function TDerExternal.GetObjFromVector(const v: IAsn1EncodableVector; Index: Int32): IAsn1Object; var val: IAsn1Encodable; begin if (v.count <= index) then begin raise EArgumentCryptoLibException.CreateRes(@SFewObject); end; val := v[index]; result := val.ToAsn1Object(); end; class procedure TDerExternal.WriteEncodable(ms: TMemoryStream; const e: IAsn1Encodable); var bs: TCryptoLibByteArray; begin if (e <> Nil) then begin bs := e.GetDerEncoded(); ms.Write(bs[0], System.length(bs)); end; end; function TDerExternal.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerExternal; begin if (Self.Equals(asn1Object)) then begin result := True; Exit; end; if (not Supports(asn1Object, IDerExternal, other)) then begin result := False; Exit; end; result := directReference.Equals(other.directReference) and indirectReference.Equals(other.indirectReference) and dataValueDescriptor.Equals(other.dataValueDescriptor) and ExternalContent.Equals(other.ExternalContent); end; function TDerExternal.Asn1GetHashCode: Int32; var ret: Int32; begin ret := ExternalContent.GetHashCode(); if (directReference <> Nil) then begin ret := ret xor directReference.GetHashCode(); end; if (indirectReference <> Nil) then begin ret := ret xor indirectReference.GetHashCode(); end; if (dataValueDescriptor <> Nil) then begin ret := ret xor dataValueDescriptor.GetHashCode(); end; result := ret; end; constructor TDerExternal.Create(const directReference: IDerObjectIdentifier; const indirectReference: IDerInteger; const dataValueDescriptor: IAsn1Object; encoding: Int32; const externalData: IAsn1Object); begin Inherited Create(); FdirectReference := directReference; FindirectReference := indirectReference; FdataValueDescriptor := dataValueDescriptor; Fencoding := encoding; FexternalContent := externalData.ToAsn1Object(); end; constructor TDerExternal.Create(const vector: IAsn1EncodableVector); var offset: Int32; enc: IAsn1Object; derObjectIdentifier: IDerObjectIdentifier; derInteger: IDerInteger; obj: IAsn1TaggedObject; begin Inherited Create(); offset := 0; enc := GetObjFromVector(vector, offset); if (Supports(enc, IDerObjectIdentifier, derObjectIdentifier)) then begin directReference := derObjectIdentifier; System.Inc(offset); enc := GetObjFromVector(vector, offset); end; if (Supports(enc, IDerInteger, derInteger)) then begin indirectReference := derInteger; System.Inc(offset); enc := GetObjFromVector(vector, offset); end; if (not(Supports(enc, IAsn1TaggedObject))) then begin dataValueDescriptor := enc; System.Inc(offset); enc := GetObjFromVector(vector, offset); end; if (vector.count <> (offset + 1)) then begin raise EArgumentCryptoLibException.CreateRes(@SVectorTooLarge); end; if (not(Supports(enc, IAsn1TaggedObject, obj))) then begin raise EArgumentCryptoLibException.CreateRes(@SNoTaggedObjectFound); end; // Use property accessor to include check on value encoding := obj.tagNo; if ((Fencoding < 0) or (Fencoding > 2)) then begin raise EInvalidOperationCryptoLibException.CreateRes(@SInvalidEncodingValue); end; FexternalContent := obj.GetObject(); end; constructor TDerExternal.Create(const directReference: IDerObjectIdentifier; const indirectReference: IDerInteger; const dataValueDescriptor: IAsn1Object; const externalData: IDerTaggedObject); begin Create(directReference, indirectReference, dataValueDescriptor, externalData.tagNo, externalData.ToAsn1Object()); end; procedure TDerExternal.Encode(const derOut: TStream); var ms: TMemoryStream; buffer: TCryptoLibByteArray; begin ms := TMemoryStream.Create(); try WriteEncodable(ms, directReference); WriteEncodable(ms, indirectReference); WriteEncodable(ms, dataValueDescriptor); WriteEncodable(ms, TDerTaggedObject.Create(TAsn1Tags.External, ExternalContent)); System.SetLength(buffer, ms.Size); ms.Position := 0; ms.Read(buffer[0], ms.Size); (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.Constructed, TAsn1Tags.External, buffer); finally ms.Free; end; end; function TDerExternal.GetDataValueDescriptor: IAsn1Object; begin result := FdataValueDescriptor; end; function TDerExternal.GetDirectReference: IDerObjectIdentifier; begin result := FdirectReference; end; function TDerExternal.GetEncoding: Int32; begin result := Fencoding; end; function TDerExternal.GetExternalContent: IAsn1Object; begin result := FexternalContent; end; function TDerExternal.GetIndirectReference: IDerInteger; begin result := FindirectReference; end; procedure TDerExternal.SetDataValueDescriptor(const Value: IAsn1Object); begin FdataValueDescriptor := Value; end; procedure TDerExternal.SetDirectReference(const Value: IDerObjectIdentifier); begin FdirectReference := Value; end; procedure TDerExternal.SetEncoding(const Value: Int32); begin if ((Fencoding < 0) or (Fencoding > 2)) then begin raise EInvalidOperationCryptoLibException.CreateResFmt (@SInvalidEncoding, [Value]); end; Fencoding := Value; end; procedure TDerExternal.SetExternalContent(const Value: IAsn1Object); begin FexternalContent := Value; end; procedure TDerExternal.SetIndirectReference(const Value: IDerInteger); begin FindirectReference := Value; end; { TDerInteger } class function TDerInteger.GetAllowUnsafeInteger: Boolean; begin result := FAllowUnsafeInteger; end; class procedure TDerInteger.SetAllowUnsafeInteger(const Value: Boolean); begin FAllowUnsafeInteger := Value; end; function TDerInteger.GetBytes: TCryptoLibByteArray; begin result := Fbytes; end; class function TDerInteger.GetInstance(const obj: TObject): IDerInteger; begin if ((obj = Nil) or (obj is TDerInteger)) then begin result := obj as TDerInteger; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; function TDerInteger.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerInteger; begin if (not Supports(asn1Object, IDerInteger, other)) then begin result := False; Exit; end; result := TArrayUtils.AreEqual(bytes, other.bytes); end; function TDerInteger.Asn1GetHashCode: Int32; begin result := TArrayUtils.GetArrayHashCode(Fbytes); end; constructor TDerInteger.Create(const Value: TBigInteger); begin inherited Create(); if (not Value.IsInitialized) then begin raise EArgumentNilCryptoLibException.CreateRes(@SValueNil); end; Fbytes := Value.ToByteArray(); FStart := 0; end; constructor TDerInteger.Create(Value: Int32); begin inherited Create(); Fbytes := TBigInteger.ValueOf(Value).ToByteArray(); FStart := 0; end; constructor TDerInteger.Create(Value: Int64); begin inherited Create(); Fbytes := TBigInteger.ValueOf(Value).ToByteArray(); FStart := 0; end; constructor TDerInteger.Create(const bytes: TCryptoLibByteArray); begin Create(bytes, True); end; constructor TDerInteger.Create(const bytes: TCryptoLibByteArray; clone: Boolean); begin Inherited Create(); if (IsMalformed(bytes)) then begin raise EArgumentCryptoLibException.CreateRes(@SMalformedInteger); end; if clone then begin Fbytes := System.Copy(bytes); end else begin Fbytes := bytes; end; FStart := SignBytesToSkip(bytes); end; class constructor TDerInteger.CreateDerInteger; begin FAllowUnsafeInteger := False; end; procedure TDerInteger.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.Integer, Fbytes); end; class function TDerInteger.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerInteger; var o: IAsn1Object; begin if (obj = Nil) then raise EArgumentNilCryptoLibException.CreateRes(@SObjectNil); o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerInteger))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := TDerInteger.Create(TAsn1OctetString.GetInstance(o as TAsn1Object) .GetOctets()); end; function TDerInteger.GetIntPositiveValueExact: Int32; var count: Int32; begin count := System.length(Fbytes) - FStart; if ((count > 4) or ((count = 4) and (0 <> (bytes[FStart] and $80)))) then begin raise EArithmeticCryptoLibException.CreateRes (@SASN1IntegerPositiveOutOfRangeError); end; result := IntValue(Fbytes, FStart, SignExtUnsigned); end; function TDerInteger.GetIntValueExact: Int32; var count: Int32; begin count := System.length(Fbytes) - FStart; if (count > 4) then begin raise EArithmeticCryptoLibException.CreateRes(@SASN1IntegerOutOfRangeError); end; result := IntValue(Fbytes, FStart, SignExtSigned); end; function TDerInteger.GetPositiveValue: TBigInteger; begin result := TBigInteger.Create(1, Fbytes); end; function TDerInteger.GetValue: TBigInteger; begin result := TBigInteger.Create(Fbytes); end; function TDerInteger.HasValue(const x: TBigInteger): Boolean; begin result := (x.IsInitialized) // Fast check to avoid allocation and (IntValue(Fbytes, FStart, SignExtSigned) = x.Int32Value) and (Value.Equals(x)); end; class function TDerInteger.IntValue(const bytes: TCryptoLibByteArray; start, signExt: Int32): Int32; var LLength, LPos, LVal: Int32; begin LLength := System.length(bytes); LPos := Max(start, LLength - 4); LVal := ShortInt(bytes[LPos]) and signExt; System.Inc(LPos); while (LPos < LLength) do begin LVal := (LVal shl 8) or bytes[LPos]; System.Inc(LPos); end; result := LVal; end; class function TDerInteger.IsMalformed(const bytes : TCryptoLibByteArray): Boolean; begin case System.length(bytes) of 0: begin result := True; end; 1: begin result := False; end else begin result := (ShortInt(bytes[0]) = (TBits.Asr32(ShortInt(bytes[1]), 7))) and (not AllowUnsafeInteger); end; end; end; class function TDerInteger.SignBytesToSkip(const bytes : TCryptoLibByteArray): Int32; var LPos, LLast: Int32; begin LPos := 0; LLast := System.length(bytes) - 1; while ((LPos < LLast) and (ShortInt(bytes[LPos]) = TBits.Asr32(ShortInt(bytes[LPos + 1]), 7))) do begin System.Inc(LPos); end; result := LPos; end; function TDerInteger.ToString: String; begin result := Value.ToString(); end; { TDerExternalParser } constructor TDerExternalParser.Create(const parser: IAsn1StreamParser); begin Inherited Create(); F_parser := parser; end; function TDerExternalParser.ReadObject: IAsn1Convertible; begin result := F_parser.ReadObject(); end; function TDerExternalParser.ToAsn1Object: IAsn1Object; begin result := TDerExternal.Create(F_parser.ReadVector()); end; { TDerOctetStringParser } constructor TDerOctetStringParser.Create(stream: TStream); begin FStream := stream; end; destructor TDerOctetStringParser.Destroy; begin FStream.Free; inherited Destroy; end; function TDerOctetStringParser.GetOctetStream: TStream; begin result := FStream; end; function TDerOctetStringParser.ToAsn1Object: IAsn1Object; begin try result := TDerOctetString.Create((FStream as TDefiniteLengthInputStream) .ToArray()); except on e: EIOCryptoLibException do begin raise EInvalidOperationCryptoLibException.CreateResFmt(@SConvertError, [e.Message]); end; end; end; { TDerGeneralString } function TDerGeneralString.GetStr: String; begin result := FStr; end; function TDerGeneralString.GetOctets: TCryptoLibByteArray; begin result := TConverters.ConvertStringToBytes(Str, TEncoding.ASCII); end; function TDerGeneralString.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerGeneralString; begin if (not Supports(asn1Object, IDerGeneralString, other)) then begin result := False; Exit; end; result := Str = other.Str; end; constructor TDerGeneralString.Create(const Str: TCryptoLibByteArray); begin Create(TConverters.ConvertBytesToString(Str, TEncoding.ASCII)); end; constructor TDerGeneralString.Create(const Str: String); begin Inherited Create(); if (Str = '') then begin raise EArgumentNilCryptoLibException.CreateRes(@SStrNil); end; FStr := Str; end; procedure TDerGeneralString.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.GeneralString, GetOctets()); end; class function TDerGeneralString.GetInstance(const obj: TObject) : IDerGeneralString; begin if ((obj = Nil) or (obj is TDerGeneralString)) then begin result := obj as TDerGeneralString; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerGeneralString.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerGeneralString; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerGeneralString))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := TDerGeneralString.Create (TAsn1OctetString.GetInstance(o as TAsn1Object).GetOctets()); end; function TDerGeneralString.GetString: String; begin result := Str; end; { TDerGenerator } constructor TDerGenerator.Create(const outStream: TStream); begin Inherited Create(outStream); end; constructor TDerGenerator.Create(const outStream: TStream; tagNo: Int32; isExplicit: Boolean); begin Inherited Create(outStream); F_tagged := True; F_isExplicit := isExplicit; F_tagNo := tagNo; end; class procedure TDerGenerator.WriteDerEncoded(const outStream: TStream; tag: Int32; const bytes: TCryptoLibByteArray); begin outStream.WriteByte(Byte(tag)); WriteLength(outStream, System.length(bytes)); outStream.Write(bytes[0], System.length(bytes)); end; procedure TDerGenerator.WriteDerEncoded(tag: Int32; const bytes: TCryptoLibByteArray); var tagNum, newTag: Int32; bOut: TMemoryStream; temp: TCryptoLibByteArray; begin if (F_tagged) then begin tagNum := F_tagNo or TAsn1Tags.Tagged; if (F_isExplicit) then begin newTag := F_tagNo or TAsn1Tags.Constructed or TAsn1Tags.Tagged; bOut := TMemoryStream.Create(); try WriteDerEncoded(bOut, tag, bytes); bOut.Position := 0; System.SetLength(temp, bOut.Size); bOut.Read(temp[0], bOut.Size); WriteDerEncoded(&Out, newTag, temp); finally bOut.Free; end; end else begin if ((tag and TAsn1Tags.Constructed) <> 0) then begin tagNum := tagNum or TAsn1Tags.Constructed; end; WriteDerEncoded(&Out, tagNum, bytes); end; end else begin WriteDerEncoded(&Out, tag, bytes); end; end; class procedure TDerGenerator.WriteDerEncoded(const outStr: TStream; tag: Int32; const inStr: TStream); begin WriteDerEncoded(outStr, tag, TStreamUtils.ReadAll(inStr)); end; class procedure TDerGenerator.WriteLength(const outStr: TStream; length: Int32); var Size, val, I: Int32; begin if (length > 127) then begin Size := 1; val := length; val := TBits.Asr32(val, 8); while (val <> 0) do begin System.Inc(Size); val := TBits.Asr32(val, 8); end; outStr.WriteByte(Byte(Size or $80)); I := (Size - 1) * 8; while I >= 0 do begin outStr.WriteByte(Byte(TBits.Asr32(length, I))); System.Dec(I, 8); end; end else begin outStr.WriteByte(Byte(length)); end; end; { TDerIA5String } function TDerIA5String.GetStr: String; begin result := FStr; end; function TDerIA5String.GetOctets: TCryptoLibByteArray; begin result := TConverters.ConvertStringToBytes(Str, TEncoding.ASCII); end; class function TDerIA5String.IsIA5String(const Str: String): Boolean; var ch: Char; begin for ch in Str do begin if (Ord(ch) > $007F) then begin result := False; Exit; end; end; result := True; end; function TDerIA5String.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerIA5String; begin if (not Supports(asn1Object, IDerIA5String, other)) then begin result := False; Exit; end; result := Str = other.Str; end; function TDerIA5String.Asn1GetHashCode: Int32; begin result := TStringUtils.GetStringHashCode(FStr); end; constructor TDerIA5String.Create(const Str: TCryptoLibByteArray); begin Create(TConverters.ConvertBytesToString(Str, TEncoding.ASCII), False); end; constructor TDerIA5String.Create(const Str: String); begin Create(Str, False); end; constructor TDerIA5String.Create(const Str: String; validate: Boolean); begin Inherited Create(); if (Str = '') then begin raise EArgumentNilCryptoLibException.CreateRes(@SStrNil); end; if (validate and (not IsIA5String(Str))) then begin raise EArgumentCryptoLibException.CreateRes(@SIllegalCharacters); end; FStr := Str; end; procedure TDerIA5String.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.IA5String, GetOctets()); end; class function TDerIA5String.GetInstance(const obj: TObject): IDerIA5String; begin if ((obj = Nil) or (obj is TDerIA5String)) then begin result := obj as TDerIA5String; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerIA5String.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerIA5String; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerIA5String))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := TDerIA5String.Create(TAsn1OctetString.GetInstance(o as TAsn1Object) .GetOctets()); end; function TDerIA5String.GetString: String; begin result := Str; end; { TDerNumericString } function TDerNumericString.GetStr: String; begin result := FStr; end; function TDerNumericString.GetOctets: TCryptoLibByteArray; begin result := TConverters.ConvertStringToBytes(Str, TEncoding.ASCII); end; class function TDerNumericString.IsNumericString(const Str: String): Boolean; var ch: Char; begin for ch in Str do begin // char.IsDigit(ch) if ((Ord(ch) > $007F) or ((ch <> ' ') and (not CharInSet(ch, ['0' .. '9'])))) then begin result := False; Exit; end; end; result := True; end; function TDerNumericString.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerNumericString; begin if (not Supports(asn1Object, IDerNumericString, other)) then begin result := False; Exit; end; result := Str = other.Str; end; constructor TDerNumericString.Create(const Str: TCryptoLibByteArray); begin Create(TConverters.ConvertBytesToString(Str, TEncoding.ASCII), False); end; constructor TDerNumericString.Create(const Str: String); begin Create(Str, False); end; constructor TDerNumericString.Create(const Str: String; validate: Boolean); begin Inherited Create(); if (Str = '') then begin raise EArgumentNilCryptoLibException.CreateRes(@SStrNil); end; if (validate and (not IsNumericString(Str))) then begin raise EArgumentCryptoLibException.CreateRes(@SIllegalCharacters); end; FStr := Str; end; procedure TDerNumericString.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.NumericString, GetOctets()); end; class function TDerNumericString.GetInstance(const obj: TObject) : IDerNumericString; begin if ((obj = Nil) or (obj is TDerNumericString)) then begin result := obj as TDerNumericString; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerNumericString.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerNumericString; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerNumericString))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := TDerNumericString.Create (TAsn1OctetString.GetInstance(o as TAsn1Object).GetOctets()); end; function TDerNumericString.GetString: String; begin result := Str; end; { TDerPrintableString } function TDerPrintableString.GetStr: String; begin result := FStr; end; function TDerPrintableString.GetString: String; begin result := Str; end; function TDerPrintableString.GetOctets: TCryptoLibByteArray; begin result := TConverters.ConvertStringToBytes(Str, TEncoding.ASCII); end; class function TDerPrintableString.IsPrintableString(const Str: String) : Boolean; var ch: Char; begin for ch in Str do begin if ((Ord(ch) > $007F)) then begin result := False; Exit; end; // if (char.IsLetterOrDigit(ch)) if CharInSet(ch, ['a' .. 'z', 'A' .. 'Z', '0' .. '9']) then begin continue; end; case IndexStr(UnicodeString(ch), [''' ''', '\', '(', ')', '+', '-', '.', ':', '=', '?', '/', ',']) of 0 .. 11: begin continue; end; end; result := False; Exit; end; result := True; end; function TDerPrintableString.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerPrintableString; begin if (not Supports(asn1Object, IDerPrintableString, other)) then begin result := False; Exit; end; result := Str = other.Str; end; constructor TDerPrintableString.Create(const Str: TCryptoLibByteArray); begin Create(TConverters.ConvertBytesToString(Str, TEncoding.ASCII), False); end; constructor TDerPrintableString.Create(const Str: String); begin Create(Str, False); end; constructor TDerPrintableString.Create(const Str: String; validate: Boolean); begin Inherited Create(); if (Str = '') then begin raise EArgumentNilCryptoLibException.CreateRes(@SStrNil); end; if (validate and (not IsPrintableString(Str))) then begin raise EArgumentCryptoLibException.CreateRes(@SIllegalCharacters); end; FStr := Str; end; procedure TDerPrintableString.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.PrintableString, GetOctets()); end; class function TDerPrintableString.GetInstance(const obj: TObject) : IDerPrintableString; begin if ((obj = Nil) or (obj is TDerPrintableString)) then begin result := obj as TDerPrintableString; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerPrintableString.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerPrintableString; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerPrintableString))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := TDerPrintableString.Create (TAsn1OctetString.GetInstance(o as TAsn1Object).GetOctets()); end; { TDerSequenceGenerator } procedure TDerSequenceGenerator.AddObject(const obj: IAsn1Encodable); var temp: TDerOutputStream; begin temp := TDerOutputStream.Create(F_bOut); try temp.WriteObject(obj); finally temp.Free; end; end; procedure TDerSequenceGenerator.Close; var temp: TCryptoLibByteArray; begin F_bOut.Position := 0; System.SetLength(temp, F_bOut.Size); F_bOut.Read(temp[0], F_bOut.Size); WriteDerEncoded(TAsn1Tags.Constructed or TAsn1Tags.Sequence, temp); end; constructor TDerSequenceGenerator.Create(outStream: TStream); begin Inherited Create(outStream); F_bOut := TMemoryStream.Create(); end; constructor TDerSequenceGenerator.Create(outStream: TStream; tagNo: Int32; isExplicit: Boolean); begin Inherited Create(outStream, tagNo, isExplicit); F_bOut := TMemoryStream.Create(); end; destructor TDerSequenceGenerator.Destroy; begin F_bOut.Free; inherited Destroy; end; function TDerSequenceGenerator.GetRawOutputStream: TStream; begin result := F_bOut; end; { TDerT61String } class function TDerT61String.GetEncoding: TEncoding; begin result := TEncoding.GetEncoding('iso-8859-1'); end; function TDerT61String.GetStr: String; begin result := FStr; end; function TDerT61String.GetOctets: TCryptoLibByteArray; var LEncoding: TEncoding; begin LEncoding := TDerT61String.GetEncoding(); try result := TConverters.ConvertStringToBytes(Str, LEncoding); finally LEncoding.Free; end; end; function TDerT61String.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerT61String; begin if (not Supports(asn1Object, IDerT61String, other)) then begin result := False; Exit; end; result := Str = other.Str; end; constructor TDerT61String.Create(const Str: TCryptoLibByteArray); var LEncoding: TEncoding; begin Inherited Create(); LEncoding := TDerT61String.GetEncoding(); try Create(TConverters.ConvertBytesToString(Str, LEncoding)); finally LEncoding.Free; end; end; constructor TDerT61String.Create(const Str: String); begin Inherited Create(); if (Str = '') then begin raise EArgumentNilCryptoLibException.CreateRes(@SStrNil); end; FStr := Str; end; procedure TDerT61String.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.T61String, GetOctets()); end; class function TDerT61String.GetInstance(const obj: TObject): IDerT61String; begin if ((obj = Nil) or (obj is TDerT61String)) then begin result := obj as TDerT61String; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerT61String.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerT61String; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerT61String))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := TDerT61String.Create(TAsn1OctetString.GetInstance(o as TAsn1Object) .GetOctets()); end; function TDerT61String.GetString: String; begin result := Str; end; { TDerUniversalString } function TDerUniversalString.GetStr: TCryptoLibByteArray; begin result := FStr; end; function TDerUniversalString.GetOctets: TCryptoLibByteArray; begin result := System.Copy(Str); end; function TDerUniversalString.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerUniversalString; begin if (not Supports(asn1Object, IDerUniversalString, other)) then begin result := False; Exit; end; result := TArrayUtils.AreEqual(Str, other.Str); end; constructor TDerUniversalString.Create(const Str: TCryptoLibByteArray); begin Inherited Create(); if (Str = Nil) then begin raise EArgumentNilCryptoLibException.CreateRes(@SStrNil); end; FStr := Str; end; procedure TDerUniversalString.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.UniversalString, Str); end; class function TDerUniversalString.GetInstance(const obj: TObject) : IDerUniversalString; begin if ((obj = Nil) or (obj is TDerUniversalString)) then begin result := obj as TDerUniversalString; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerUniversalString.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerUniversalString; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerUniversalString))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := TDerUniversalString.Create (TAsn1OctetString.GetInstance(o as TAsn1Object).GetOctets()); end; function TDerUniversalString.GetString: String; var buffer: TStringList; I: Int32; enc: TCryptoLibByteArray; ubyte: UInt32; begin buffer := TStringList.Create(); buffer.LineBreak := ''; enc := GetDerEncoded(); buffer.Add('#'); I := 0; try while I <> System.length(enc) do begin ubyte := enc[I]; buffer.Add(FTable[(ubyte shr 4) and $F]); buffer.Add(FTable[enc[I] and $F]); System.Inc(I); end; result := buffer.Text; finally buffer.Free; end; end; { TDerUtf8String } function TDerUtf8String.GetStr: String; begin result := FStr; end; function TDerUtf8String.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerUtf8String; begin if (not Supports(asn1Object, IDerUtf8String, other)) then begin result := False; Exit; end; result := Str = other.Str; end; constructor TDerUtf8String.Create(const Str: TCryptoLibByteArray); begin Create(TConverters.ConvertBytesToString(Str, TEncoding.UTF8)); end; constructor TDerUtf8String.Create(const Str: String); begin Inherited Create(); if (Str = '') then begin raise EArgumentNilCryptoLibException.CreateRes(@SStrNil); end; FStr := Str; end; procedure TDerUtf8String.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.Utf8String, TConverters.ConvertStringToBytes(Str, TEncoding.UTF8)); end; class function TDerUtf8String.GetInstance(const obj: TObject): IDerUtf8String; begin if ((obj = Nil) or (obj is TDerUtf8String)) then begin result := obj as TDerUtf8String; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerUtf8String.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerUtf8String; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerUtf8String))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := TDerUtf8String.Create(TAsn1OctetString.GetInstance(o as TAsn1Object) .GetOctets()); end; function TDerUtf8String.GetString: String; begin result := Str; end; { TDerVideotexString } function TDerVideotexString.GetmString: TCryptoLibByteArray; begin result := FmString; end; function TDerVideotexString.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerVideotexString; begin if (not Supports(asn1Object, IDerVideotexString, other)) then begin result := False; Exit; end; result := TArrayUtils.AreEqual(mString, other.mString); end; function TDerVideotexString.Asn1GetHashCode: Int32; begin result := TArrayUtils.GetArrayHashCode(mString); end; constructor TDerVideotexString.Create(const encoding: TCryptoLibByteArray); begin Inherited Create(); FmString := System.Copy(encoding); end; procedure TDerVideotexString.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.VideotexString, mString); end; class function TDerVideotexString.GetInstance(const obj: TObject) : IDerVideotexString; begin if ((obj = Nil) or (obj is TDerVideotexString)) then begin result := obj as TDerVideotexString; Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; class function TDerVideotexString.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerVideotexString; var o: IAsn1Object; begin o := obj.GetObject(); if ((isExplicit) or (Supports(o, IDerVideotexString))) then begin result := GetInstance(o as TAsn1Object); Exit; end; result := TDerVideotexString.Create (TAsn1OctetString.GetInstance(o as TAsn1Object).GetOctets()); end; class function TDerVideotexString.GetInstance(const obj: TCryptoLibByteArray) : IDerVideotexString; begin try result := FromByteArray(obj) as IDerVideotexString; except on e: Exception do begin raise EArgumentCryptoLibException.CreateResFmt(@SEncodingError, [e.Message]); end; end; end; function TDerVideotexString.GetOctets: TCryptoLibByteArray; begin result := System.Copy(mString); end; function TDerVideotexString.GetString: String; begin result := TConverters.ConvertBytesToString(mString, TEncoding.ANSI) end; { TDerVisibleString } function TDerVisibleString.GetStr: String; begin result := FStr; end; function TDerVisibleString.GetOctets: TCryptoLibByteArray; begin result := TConverters.ConvertStringToBytes(Str, TEncoding.ASCII); end; function TDerVisibleString.Asn1Equals(const asn1Object: IAsn1Object): Boolean; var other: IDerVisibleString; begin if (not Supports(asn1Object, IDerVisibleString, other)) then begin result := False; Exit; end; result := Str = other.Str; end; function TDerVisibleString.Asn1GetHashCode: Int32; begin result := TStringUtils.GetStringHashCode(FStr); end; constructor TDerVisibleString.Create(const Str: TCryptoLibByteArray); begin Create(TConverters.ConvertBytesToString(Str, TEncoding.ASCII)); end; constructor TDerVisibleString.Create(const Str: String); begin Inherited Create(); if (Str = '') then begin raise EArgumentNilCryptoLibException.CreateRes(@SStrNil); end; FStr := Str; end; procedure TDerVisibleString.Encode(const derOut: TStream); begin (derOut as TDerOutputStream).WriteEncoded(TAsn1Tags.VisibleString, GetOctets()); end; class function TDerVisibleString.GetInstance(const obj: TObject) : IDerVisibleString; var asn1OctetString: IAsn1OctetString; asn1TaggedObject: IAsn1TaggedObject; begin if ((obj = Nil) or (obj is TDerVisibleString)) then begin result := obj as TDerVisibleString; Exit; end; if Supports(obj, IAsn1OctetString, asn1OctetString) then begin result := TDerVisibleString.Create(asn1OctetString.GetOctets()); Exit; end; if Supports(obj, IAsn1TaggedObject, asn1TaggedObject) then begin result := GetInstance(asn1TaggedObject.GetObject() as TAsn1Object); Exit; end; raise EArgumentCryptoLibException.CreateResFmt(@SIllegalObject, [obj.ClassName]); end; {$IFNDEF _FIXINSIGHT_} class function TDerVisibleString.GetInstance(const obj: IAsn1TaggedObject; isExplicit: Boolean): IDerVisibleString; begin result := GetInstance(obj.GetObject() as TAsn1Object); end; {$ENDIF} function TDerVisibleString.GetString: String; begin result := Str; end; end.