unit uTSP;

interface

uses
  System.Classes, IdASN1Util, System.SysUtils, uCryptHelper, IOUtils, System.Net.HttpClient;

type
  EASN1Exception = class(Exception);
  ETSPException = class(Exception)
  private
    FCode: Integer;
    FCodeString: string;
    FFailureCode: Integer;
    FFailureCodeString: string;
  public
    constructor Create(const Code, FailureCode: Integer; FailureCodeString: string = ''); overload;
    property Code: Integer read FCode;
    property CodeString: string read FCodeString;
    property FailureCode: Integer read FFailureCode;
    property FailureCodeString: string read FFailureCodeString;
  end;

function ASN1AsXML(Memory: PAnsiChar; MemorySize: Cardinal): string;
function ASN1FindOID(Memory: PAnsiChar; MemorySize: Cardinal; OID: string): PAnsiChar;
function ASN1GetTimeStamp(Memory: PAnsiChar; MemorySize: Cardinal): TBytes;
procedure TSPGetResponse(TimeStampServer: string; Container: WideString; Data, Response: TStream);

implementation

constructor ETSPException.Create(const Code, FailureCode: Integer; FailureCodeString: string = '');
var
  S: string;
begin
  FCode:=Code;
  FFailureCode:=FailureCode;
  case FCode of
  0: FCodeString:='';
  1: FCodeString:='Modifications';
  2: FCodeString:='Rejection';
  3: FCodeString:='Waiting';
  4: FCodeString:='Revocation warning';
  5: FCodeString:='Revocation notification';
  else FCodeString:='Code='+FCode.ToString;
  end;
  if FailureCodeString<>'' then
    FFailureCodeString:=FailureCodeString
  else
  case FFailureCode of
  0: FFailureCodeString:='Bad failure';
  1: FFailureCodeString:='The request data is incorrect (for notary services)';
  2: FFailureCodeString:='The authority indicated in the request is different from the one creating the response token';
  4: FFailureCodeString:='The data submitted has the wrong format';
  8: FFailureCodeString:='No certificate could be found matching the provided criteria';
  16: FFailureCodeString:='MessageTime was not sufficiently close to the system time, as defined by local policy';
  32: FFailureCodeString:='Transaction not permitted or supported';
  64: FFailureCodeString:='Integrity check failed';
  128: FFailureCodeString:='Unrecognized or unsupported algorithm identifier';
  else FFailureCodeString:='FailureCode='+FFailureCode.ToString;
  end;
  S:=FCodeString;
  if S<>'' then S:=S+': ';
  inherited Create(S+FFailureCodeString);
end;

const
  ASN1_BOOL = $01;
  ASN1_BIT_STRING = $03;
  ASN1_UTF8_STRING = $0c;
  ASN1_NUMERIC_STRING	= $12;
  ASN1_PRINTABLE_STRING = $13;
  ASN1_IA5_STRING	= $16;
  ASN1_UTC_TIME	= $17;
  ASN1_BMP_STRING = $1e;
  ASN1_SEQUENCE = $30;
  ASN1_CONTEXT_SPECIFIC	= $a0;

function ASNEncOIDItem(Value: Integer): string;
begin
  Result:='';
  repeat
    Result:=AnsiChar((Value mod 128) or $80*Ord(Length(Result)>0))+Result;
    Value:=Value div 128;
  until Value=0;
end;

function MibToId(Mib: string): string;
var
  I: Integer;
  S: string;
begin
  Result:='';
  I:=0;
  for S in Mib.Split(['.']) do
  begin
    case I of
    0:Result:=S;
    1:Result:=ASNEncOIDItem(Result.ToInteger*40+S.ToInteger);
    else Result:=Result+ASNEncOIDItem(S.ToInteger);
    end;
    Inc(I);
  end;
end;

function ASN1DecOIDItem(var Buffer: PAnsiChar): Integer;
begin
  Result:=0;
  repeat
    Result:=Result*128 + Ord(Buffer^) and $7F;
    Inc(Buffer);
  until Ord((Buffer-1)^)<$80;
end;

function IdToMib(Id: PAnsiChar; Size: Integer): string;
var
  X: Integer;
  B: PAnsiChar;
begin
  B:=Id+Size;
  X:=ASN1DecOIDItem(Id);
  Result:=(X div 40).ToString+'.'+(X mod 40).ToString;
  while Id<B do Result:=Result+'.'+ASN1DecOIDItem(Id).ToString;
end;

function ASN1DecInt(Data: PAnsiChar; Size: Integer): Integer;
var
  n: Integer;
  neg: Boolean;
  x: Byte;
begin
  Result := 0;
  neg := False;
  for n := 1 to Size do
  begin
    x := Ord(Data^);
    if (n = 1) and (x > $7F) then
      neg := True;
    if neg then
      x := not x;
    Result := Result * 256 + x;
    Inc(Data);
  end;
  if neg then
    Result := -(Result + 1);
end;

procedure ASN1DecodeItem(Memory: PAnsiChar; out DataType: Integer; out Data: PAnsiChar; out Size: Integer; CheckDataType: Integer = 0);
var
  I: Integer;
begin
  Size:=0;
  DataType:=Ord(Memory^);
  Inc(Memory);
  if Ord(Memory^)<$80 then
    Size:=Ord(Memory^)
  else
    for I:=1 to Ord(Memory^) and $7F do
    begin
      Inc(Memory);
      Size:=Size*256+Ord(Memory^);
    end;
  Data:=Memory+1;
  if not (CheckDataType in [0,DataType]) then
    raise EASN1Exception.Create('Datatype failed (Expected: '+CheckDataType.ToString+', Found: '+DataType.ToString+')');
end;

function IsASN1Include(MemoryDataType: Integer; MemoryData: PAnsiChar; MemorySize: Integer): Boolean;
var
  DataType,Size: Integer;
  Data: PAnsiChar;
begin
  if (MemorySize<5) or (MemoryDataType<>ASN1_OCTSTR) then Exit(False);
  ASN1DecodeItem(MemoryData,DataType,Data,Size);
  Result:=(DataType in [ASN1_SEQUENCE,ASN1_UTF8_STRING]) and (Data+Size=MemoryData+MemorySize);
end;

function ASN1GetValueAsString(DataType: Integer; Data: PAnsiChar; Size: Integer): string;
begin
  case DataType of
  ASN1_INT,ASN1_BOOL:
    Result:=ASN1DecInt(Data,Size).ToString;
  ASN1_NUMERIC_STRING,ASN1_IA5_STRING,ASN1_PRINTABLE_STRING,ASN1_UTC_TIME:
    Result:=TEncoding.ANSI.GetString(BytesOf(Data,Size));
  ASN1_OBJID:
    Result:=IdToMib(Data,Size);
  ASN1_BMP_STRING:
    Result:=TEncoding.BigEndianUnicode.GetString(BytesOf(Data,Size));
  ASN1_UTF8_STRING:
    Result:=TEncoding.UTF8.GetString(BytesOf(Data,Size));
  else
    Result:=AsBase64(Data,Size);
  end;
end;

function ASN1AsXML(Memory: PAnsiChar; MemorySize: Cardinal): string;
var
  DataType,Size: Integer;
  Data,MemoryEnd: PAnsiChar;
begin
  Result:='';
  MemoryEnd:=Memory+MemorySize;
  while Memory<MemoryEnd do
  begin
    ASN1DecodeItem(Memory,DataType,Data,Size);
    Result:=Result+'<T'+DataType.ToString+'>';
    if ((DataType and $20)<>0) or IsASN1Include(DataType,Data,Size) then
      Result:=Result+ASN1AsXML(Data,Size)
    else
      Result:=Result+ASN1GetValueAsString(DataType,Data,Size);
    Result:=Result+'</T'+DataType.ToString+'>';
    Memory:=Data+Size;
  end;
end;

function ASN1FindOID(Memory: PAnsiChar; MemorySize: Cardinal; OID: string): PAnsiChar;
var
  DataType,Size: Integer;
  Data,MemoryEnd: PAnsiChar;
begin
  Result:=nil;
  MemoryEnd:=Memory+MemorySize;
  while (Result=nil) and (Memory<MemoryEnd) do
  begin
    ASN1DecodeItem(Memory,DataType,Data,Size);
    if (DataType and $20)<>0  then
      Result:=ASN1FindOID(Data,Size,OID)
    else
      if (DataType=ASN1_OBJID) and (IdToMib(Data,Size)=OID) then
        Result:=Memory;
    Memory:=Data+Size;
  end;
end;

function ASN1GetTimeStamp(Memory: PAnsiChar; MemorySize: Cardinal): TBytes;
var
  DataType,Size: Integer;
  Data: PAnsiChar;
begin
  Data:=ASN1FindOID(Memory,MemorySize,'1.2.840.113549.1.9.16.1.4');
  if Data=nil then
    raise EASN1Exception.Create('Timestamp not found');
  ASN1DecodeItem(Data,DataType,Data,Size,ASN1_OBJID);
  Inc(Data,Size); //выйдем из узла с OID timestamp
  ASN1DecodeItem(Data,DataType,Data,Size,ASN1_CONTEXT_SPECIFIC);
  ASN1DecodeItem(Data,DataType,Data,Size,ASN1_OCTSTR);
  Result:=BytesOf(Data,Size);
end;

var HTTPClient: THTTPClient = nil;

procedure TSPGetResponse(TimeStampServer: string; Container: WideString; Data, Response: TStream);
var
  S: AnsiString;
  Hash,Request: TStringStream;
  HTTPResponse: IHTTPResponse;
  DataType,Size: Integer;
  Memory: PAnsiChar;
  E,B: Integer;
  F: string;
begin

  Hash:=TStringStream.Create;
  try
    GetHashStream(Container,Data,nil,nil,Hash,nil);
    S:=ASNObject(ASNObject(ASNEncInt(1),ASN1_INT)+
      ASNObject(ASNObject(ASNObject(MibToId('1.2.643.2.2.9'),ASN1_OBJID),ASN1_SEQ)+
      ASNObject(Hash.DataString,ASN1_OCTSTR),ASN1_SEQ)+ASNObject(Char(True),ASN1_BOOL),ASN1_SEQ);
  finally
    Hash.Free;
  end;

  Request:=TStringStream.Create(S);
  try

    if HTTPClient=nil then
      HTTPClient:=THTTPClient.Create;
    try
      HTTPClient.ContentType:='application/timestamp-query';
      HTTPResponse:=HTTPClient.Post(TimeStampServer,Request,Response);
    except
      on E:Exception do
        raise ETSPException.Create(E.ClassName+': '+E.Message+'. URL:'+TimeStampServer);
    end;

    if HTTPResponse.StatusCode>=300 then
      raise ETSPException.Create('('+Trim(HTTPResponse.StatusCode.ToString)+') '+Trim(HTTPResponse.StatusText)+'. URL:'+TimeStampServer);
    if not SameText(HTTPResponse.MimeType,'application/timestamp-reply') then
      raise ETSPException.Create('Bad reply. Content-Type: '+HTTPResponse.MimeType+'. URL:'+TimeStampServer);

    Response.Position:=0;
    Request.Clear;
    Request.CopyFrom(Response,Response.Size);
    Memory:=Request.Memory;
    ASN1DecodeItem(Memory,DataType,Memory,Size,ASN1_SEQUENCE);
    ASN1DecodeItem(Memory,DataType,Memory,Size,ASN1_SEQUENCE);
    ASN1DecodeItem(Memory,DataType,Memory,Size,ASN1_INT);
    E:=ASN1DecInt(Memory,Size);
    if E<>0 then //обработка ошибки
    begin
      B:=0;
      F:='';
      //далее может быть сразу: или код ошибки, или текст ошибки, а только потом - код ошибки
      //сервер может возвращать только код
      while True do
      begin
        Inc(Memory,Size); //переход на следующий узел
        ASN1DecodeItem(Memory,DataType,Memory,Size);
        case DataType of
        ASN1_BIT_STRING: //это код ошибки
          if Size=2 then
            B:=PByte(Memory+1)^; //второй байт
        ASN1_SEQUENCE: //это блок с текстом ошибки
        begin
          ASN1DecodeItem(Memory,DataType,Memory,Size); //получим текстовую строку об ошибке
          if DataType in [ASN1_UTF8_STRING,ASN1_PRINTABLE_STRING,ASN1_IA5_STRING,ASN1_BMP_STRING] then
          begin
            F:=ASN1GetValueAsString(DataType,Memory,Size);
            Continue;
          end;
        end;
        end;
        Break;
      end;
      raise ETSPException.Create(E,B,F);
    end;

  finally
    Request.Free;
  end;

end;

initialization

finalization
  HTTPClient.Free;

end.