clsoap.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

  const AData, ASignature: string);
var
  context: HCRYPTPROV;
  hash: HCRYPTHASH;
  key: HCRYPTKEY;
  s: string;
begin
  if not CryptAcquireContext(@context, nil, nil, GetAvailableProviderType(), 0) then
  begin
    if not CryptAcquireContext(@context, nil, nil, GetAvailableProviderType(), CRYPT_NEWKEYSET) then
    begin
      raise EclSoapMessageError.Create(GetLastErrorText('CryptAcquireContext'));
    end;
  end;
  try
    if not CryptImportPublicKeyInfoEx(context, X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
      @ACertificate.Context.pCertInfo.SubjectPublicKeyInfo, 0, 0, nil, @key) then
    begin
      raise EclSoapMessageError.Create(GetLastErrorText('CryptImportPublicKeyInfoEx'));
    end;
    try
      if not CryptCreateHash(context, CALG_SHA1, 0, 0, @hash) then
      begin
        raise EclSoapMessageError.Create(GetLastErrorText('CryptCreateHash'));
      end;
      try
        if not CryptHashData(hash, Pointer(AData), Length(AData), 0) then
        begin
          raise EclSoapMessageError.Create(GetLastErrorText('CryptHashData'));
        end;
        if not CryptVerifySignature(hash, Pointer(ASignature), Length(ASignature), key, nil, 0) then
        begin
          s := ReversedString(ASignature);
          if not CryptVerifySignature(hash, Pointer(s), Length(s), key, nil, 0) then
          begin
            raise EclSoapMessageError.Create(GetLastErrorText('CryptVerifySignature'));
          end;
        end;
      finally
        CryptDestroyHash(hash);
      end;
    finally
      CryptDestroyKey(key);
    end;
  finally
    CryptReleaseContext(context, 0);
  end;
end;

procedure TclSoapMessage.VerifySignatureValue(ACertificate: TclCertificate;
  const AData: IXMLDOMNode; const ASignature: string);
var
  encoder: TclEncoder;
  canonicalizer: TclXmlCanonicalizer;
  encodedSig, sig, data: string;
begin
  encoder := nil;
  canonicalizer := nil;
  try
    encoder := TclEncoder.Create(nil);
    canonicalizer := TclXmlCanonicalizer.Create();

    encodedSig := StringReplace(ASignature, #32, '', [rfReplaceAll]);
    encoder.DecodeString(encodedSig, sig, cmMIMEBase64);
    data := canonicalizer.Canonicalize(AData);

    VerifySignatureValue(ACertificate, data, sig);
  finally
    canonicalizer.Free();
    encoder.Free();
  end;
end;

procedure TclSoapMessage.VerifySignature(ASecurity: IXMLDOMNode);
var
  cert: TclCertificate;
  data, signature, keyInfo: IXMLDOMNode;
  s: string;
  handled: Boolean;
begin
  handled := False;
  DoGetCertificate(cert, handled);
  if (cert = nil) then
  begin
    keyInfo := ASecurity.selectSingleNode('//' + GetDsNodeName('KeyInfo') + '/' + wsseNameSpace
      + ':SecurityTokenReference/' + wsseNameSpace + ':Reference/@URI');
    if (keyInfo <> nil) then
    begin
      s := string(keyInfo.text);
      if (s <> '') and (s[1] = '#') then
      begin
        system.Delete(s, 1, 1);
      end;
      data := ASecurity.selectSingleNode('//*[@' + IdName + '="' + s + '"]');
      if (data = nil) then
      begin
        raise EclSoapMessageError.Create(cSoapDataNotFound);
      end;
      cert := GetCertificateFromNode(data);
    end;
  end;
  if (cert = nil) then
  begin
    raise EclSoapMessageError.Create(cCertificateRequired);
  end;
  signature := ASecurity.selectSingleNode('//' + GetDsNodeName('SignatureValue'));
  data := ASecurity.selectSingleNode('//' + GetDsNodeName('SignedInfo'));

  VerifySignatureValue(cert, data, string(signature.text));
end;

procedure TclSoapMessage.VerifyReferenceDigests(ADom: IXMLDOMDocument; ASignature: IXMLDOMNode);
var
  refList: IXMLDOMNodeList;
  data, reference: IXMLDOMNode;
  s: string;
begin
  refList := ASignature.selectNodes('//' + GetDsNodeName('Reference'));
  reference := refList.nextNode();
  while (reference <> nil) do
  begin
    s := GetAttributeValue(reference, 'URI');
    if (s <> '') and (s[1] = '#') then
    begin
      system.Delete(s, 1, 1);
    end;
    data := ADom.selectSingleNode('//*[@' + IdName + '="' + s + '"]');
    if (data = nil) then
    begin
      raise EclSoapMessageError.Create(cSoapDataNotFound);
    end;
    data := ApplyTransforms(reference, data);

    VerifyDigestValue(data, string(reference.selectSingleNode(GetDsNodeName('DigestValue')).text));

    reference := refList.nextNode();
  end;
end;

procedure TclSoapMessage.Verify;
var
  dom: IXMLDOMDocument;
  security, signature: IXMLDOMNode;
begin
{$IFDEF DEMO}
{$IFNDEF STANDALONEDEMO}
  if FindWindow('TAppBuilder', nil) = 0 then
  begin
    MessageBox(0, 'This demo version can be run under Delphi/C++Builder IDE only. ' +
      'Please visit www.clevercomponents.com to purchase your ' +
      'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    ExitProcess(1);
  end else
{$ENDIF}
  begin
{$IFNDEF IDEDEMO}
    if (not IsHttpRequestDemoDisplayed) and (not IsCertDemoDisplayed)
      and (not IsEncoderDemoDisplayed) then
    begin
      MessageBox(0, 'Please visit www.clevercomponents.com to purchase your ' +
        'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    end;
    IsHttpRequestDemoDisplayed := True;
    IsCertDemoDisplayed := True;
    IsEncoderDemoDisplayed := True;
{$ENDIF}
  end;
{$ENDIF}

  CheckRequestExists();
  if not IsSigned then
  begin
    raise EclSoapMessageError.Create(cMessageNotSigned);
  end;
  dom := CoDOMDocument.Create();
  dom.loadXML(TclXmlItem(Self.Items[0]).XmlData);
  security := dom.selectSingleNode('//' + wsseNameSpace + ':Security');
  if (security <> nil) then
  begin
    VerifySignature(security);
  end;
  signature := dom.selectSingleNode('//' + GetDsNodeName('Signature'));
  if (signature <> nil) then
  begin
    VerifyReferenceDigests(dom, signature);
  end;
  RemoveNode(signature);
  RemoveNode(security);
  TclXmlItem(Self.Items[0]).XmlData := dom.xml;
end;

function TclSoapMessage.GetCertificate: TclCertificate;
var
  handled: Boolean;
begin
  Result := nil;
  handled := False;
  DoGetCertificate(Result, handled);
  if (Result = nil) then
  begin
    raise EclSoapMessageError.Create(cCertificateRequired);
  end;
end;

procedure TclSoapMessage.DoGetCertificate(var ACertificate: TclCertificate; var Handled: Boolean);
begin
  if Assigned(OnGetCertificate) then
  begin
    OnGetCertificate(Self, ACertificate, Handled);
  end;
end;

function TclSoapMessage.CreateSecuredKeyInfo(ACertificate: TclCertificate;
  ASignature: IXMLDOMNode): IXMLDOMNode;
const
  KeyTokenId = 'X509Token';
var
  securityToken, keyInfo, node, reference: IXMLDOMNode;
  encoder: TclEncoder;
  certValue, encodedCertValue: string;
begin
  Result := ASignature.ownerDocument.createElement(wsseNameSpace + ':Security');
  SetAttributeValue(Result, 'xmlns:' + wsseNameSpace, 'http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd');

  if IsIncludeCertificate then
  begin
    securityToken := ASignature.ownerDocument.createElement(wsseNameSpace + ':BinarySecurityToken');
    Result.appendChild(securityToken);

    SetAttributeValue(securityToken, 'ValueType', 'http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-x509-token-profile-1.0#X509v3');
    SetAttributeValue(securityToken, 'EncodingType', 'http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-soap-message-security-1.0#Base64Binary');

    SetAttributeValue(securityToken, IdName, KeyTokenId);

    encoder := TclEncoder.Create(nil);
    try
      SetLength(certValue, ACertificate.Context.cbCertEncoded);
      system.Move(ACertificate.Context.pbCertEncoded^, Pointer(certValue)^, ACertificate.Context.cbCertEncoded);

      encoder.EncodeString(certValue, encodedCertValue, cmMIMEBase64);
      securityToken.text := encodedCertValue;
    finally
      encoder.Free();
    end;

    keyInfo := ASignature.ownerDocument.createElement(GetDsNodeName('KeyInfo'));
    ASignature.appendChild(keyInfo);

    node := ASignature.ownerDocument.createElement(wsseNameSpace + ':SecurityTokenReference');
    keyInfo.appendChild(node);

    reference := ASignature.ownerDocument.createElement(wsseNameSpace + ':Reference');
    node.appendChild(reference);

    SetAttributeValue(reference, 'URI', '#' + KeyTokenId);
  end;
  
  Result.appendChild(ASignature);
end;

function TclSoapMessage.GetNameSpace(ANode: IXMLDOMNode): string;
var
  ind: Integer;
begin
  ind := Pos(':', ANode.nodeName);
  if (ind > 0) then
  begin
    Result := Copy(ANode.nodeName, 1, ind - 1);
  end else
  begin
    Result := '';
  end;
end;

function TclSoapMessage.CreateSignedInfo(ADom: IXMLDomDocument): IXMLDomNode;
var
  i: Integer;
  reference, data, node: IXMLDomNode;
  canonicalizer: TclXmlCanonicalizer;
  encoder: TclEncoder;
  digestValue: string;
begin
  encoder := nil;
  canonicalizer := nil;
  try
    encoder := TclEncoder.Create(nil);
    canonicalizer := TclXmlCanonicalizer.Create();
    Result := ADom.createElement(GetDsNodeName('SignedInfo'));

    node := ADom.createElement(dsNameSpace + ':CanonicalizationMethod');
    Result.appendChild(node);
    SetAttributeValue(node, 'Algorithm', 'http://www.w3.org/2001/10/xml-exc-c14n#');
    if (SignatureStyle = ssDotNet) then
    begin
      SetAttributeValue(node, 'xmlns:' + dsNameSpace, 'http://www.w3.org/2000/09/xmldsig#');
    end;

    node := ADom.createElement(GetDsNodeName('SignatureMethod'));
    Result.appendChild(node);
    SetAttributeValue(node, 'Algorithm', 'http://www.w3.org/2000/09/xmldsig#rsa-sha1');

    for i := 0 to SignReferences.Count - 1 do
    begin
      reference := ADom.createElement(GetDsNodeName('Reference'));
      Result.appendChild(reference);
      SetAttributeValue(reference, 'URI', '#' + SignReferences[i]);

      data := ADom.selectSingleNode('//*[@' + IdName + '="' + SignReferences[i] + '"]');
      if (data = nil) then
      begin
        raise EclSoapMessageError.Create(cSoapDataNotFound);
      end;

      data := CreateTransforms(reference, data);

      node := ADom.createElement(GetDsNodeName('DigestMethod'));
      reference.appendChild(node);
      SetAttributeValue(node, 'Algorithm', 'http://www.w3.org/2000/09/xmldsig#sha1');

      node := ADom.createElement(GetDsNodeName('DigestValue'));
      reference.appendChild(node);
      encoder.EncodeString(GetDigestValue(canonicalizer.Canonicalize(data)), digestValue, cmMIMEBase64);
      node.text := digestValue;
    end;
  finally
    canonicalizer.Free();
    encoder.Free();
  end;
end;

function TclSoapMessage.CreateTransforms(const AReference, AData: IXMLDomNode): IXMLDomNode;
var
  i: Integer;
  transforms, node: IXMLDomNode;
begin
  Result := AData;

  transforms := AData.ownerDocument.createElement(GetDsNodeName('Transforms'));
  AReference.appendChild(transforms);

  for i := 0 to SignTransforms.Count - 1 do
  begin
    node := AData.ownerDocument.createElement(GetDsNodeName('Transform'));
    transforms.appendChild(node);
    SetAttributeValue(node, 'Algorithm', SignTransforms[i]);
    Result := TransformData(Result, SignTransforms[i]);
  end;
end;

function TclSoapMessage.ApplyTransforms(const AReference, AData: IXMLDomNode): IXMLDomNode;
var
  list: IXMLDOMNodeList;
  transform: IXMLDomNode;
begin
  Result := AData;
  list := AReference.selectNodes('//' + GetDsNodeName('Transform/@Algorithm'));
  transform := list.nextNode();
  while (transform <> nil) do
  begin
    Result := TransformData(Result, string(transform.text));
    transform := list.nextNode();
  end;
end;

function TclSoapMessage.TransformData(const AData: IXMLDomNode; const Algorithm: string): IXMLDomNode;
var
  transDom, resDom: IXMLDOMDocument;
  template: string;
  handled: Boolean;
begin
  Result := AData;

  transDom := CoDOMDocument.Create();
  resDom := CoDOMDocument.Create();

  handled := False;
  template := '';
  DoTransformData(Algorithm, template, handled);

  if handled then
  begin
    transDom.loadXML(template);
    if (transDom.xml = '') then
    begin
      raise EclSoapMessageError.Create(string(transDom.parseError.srcText + #13#10 + transDom.parseError.reason));
    end;
    Assert(transDom.xml <> '');

    AData.transformNodeToObject(transDom, resDom);
    if (resDom.xml = '') then
    begin
      raise EclSoapMessageError.Create(string(resDom.parseError.srcText + #13#10 + resDom.parseError.reason));
    end;

    Result := resDom.firstChild;
  end;
end;

function TclSoapMessage.CreateSignature(ACertificate: TclCertificate;
  ASignedInfo: IXMLDomNode): IXMLDomNode;
var
  node: IXMLDomNode;
  sigValue, encSigValue: string;
  encoder: TclEncoder;
  canonicalizer: TclXmlCanonicalizer;
begin
  encoder := nil;
  canonicalizer := nil;
  try
    encoder := TclEncoder.Create(nil);
    canonicalizer := TclXmlCanonicalizer.Create();

    Result := ASignedInfo.ownerDocument.createElement(GetDsNodeName('Signature'));
    Result.appendChild(ASignedInfo);

    SetAttributeValue(Result, GetDsNameSpace('xmlns'), 'http://www.w3.org/2000/09/xmldsig#');

    node := ASignedInfo.ownerDocument.createElement(GetDsNodeName('SignatureValue'));
    Result.appendChild(node);

    if (GetAttributeValue(ASignedInfo, GetDsNameSpace('xmlns')) = '') then
    begin
      SetAttributeValue(ASignedInfo, GetDsNameSpace('xmlns'), 'http://www.w3.org/2000/09/xmldsig#');
    end;

    sigValue := GetSignatureValue(ACertificate, canonicalizer.Canonicalize(ASignedInfo));

    if (SignatureStyle = ssDotNet) then
    begin
      sigValue := ReversedString(sigValue);
    end;

    encoder.EncodeString(sigValue, encSigValue, cmMIMEBase64);

    SetAttributeValue(ASignedInfo, GetDsNameSpace('xmlns'), '');

    node.text := encSigValue;
  finally
    canonicalizer.Free();
    encoder.Free();
  end;
end;

function TclSoapMessage.GetSignatureValue(ACertificate: TclCertificate; const AXml: string): string;
var