Kerberos für SOAP per WSDL Import

[Sherlock]

Delphi XE2!
Der Titel klingt etwas kryptisch, aber ich denke er fasst gut zusammen, was mir fehlt.
Ich habe ein WSDL in XE2 importiert, um damit dann mit einem WebService zu kommunizieren. Der Service steht mir leider nicht zur Verfügung. Gegen SoapUI klappt es jedenfalls. JETZT kommt der Kunde darauf, daß das ja bitte schön noch per Kerberos verschlüsselt werden müsste. Ich weiss nichtmal annähernd wo ich da ansetzen muss. Ich habe dies hier http://stackoverflow.com/questions/1...et-with-delphi gesehen, sehe aber nicht wie ich das jetzt dem SOAPHTTPClient beibringen kann. Hat jemand schon etwas ähnliches getan, oder ein Beispiel/Ansatz wie vorzugehen ist?

Danke,
Sherlock

[Union]

Hier findest Du einen Ansatz, um das Kerberos-Ticket in den SOAP-Header zu schreiben. Du kannst natürlich auch den entsprechenden Event OnWebServiceRequest verwenden und die SOAP-Header Stringliste patchen.

[Sherlock]

Äh...ich oute mich mal eben als nicht Versteher. Wo muss ich da was ändern? Ich meine, diese eine Klasse kann ich gerne irgendwo hinzufügen, aber...nunja. Am SOAP-Ergebnis ändert das eher nichts. Ich denke mal ich müsste die vom WSDL-Importer generierte Unit bearbeiten, aber... wo? Das Event sehe ich gar überhaupt nicht, da könnte ich also auch nicht ansetzen. Hast du vielleicht noch ein oder zwei Brotkrumen?

Sherlock

[mjustin]

Zitat:

Zitat von Sherlock (Beitrag 1291697)

JETZT kommt der Kunde darauf, daß das ja bitte schön noch per Kerberos verschlüsselt werden müsste.

Kerberos ist keine Verschlüsselung (der SOAP Nachricht). Die Nachricht soll nur ein gültiges Kerberos "Ticket" enthalten, das man vom Kerberos Server erst bekomment muss. Die Aufgabe ist

* Anmeldung am Kerberus Server
* Kerberos Ticket anfordern
* Ticket in den SOAP Header integrieren und SOAP Nachricht senden

https://de.wikipedia.org/wiki/Kerberos_%28Informatik%29

Sind denn die Schritte eins und zwei schon gelöst? Diese sind ja die Voraussetzungen, um die es in dem Stackoverflow Beitrag geht. Der SOAPHTTPClient kann nicht out of the box (z.B. durch Setzen einer Property) kerberosfähig gemacht werden. Er muss lediglich einen weiteren Header erhalten. Wie man den zu setzenden Wert dieses Headers vom Kerberos Server erhält, ist die "spannendere" Frage.

[Sherlock]

Ach, die Front dachte ich am Freitag zu erledigen, hat aber nicht geklappt. Ich hatte mich in den Indys verloren, weil es zunächst den Anschein hatte, daß die sowas mitbringen, aber... In Frage kommen wohl die Komponenten/Units, die SSPI im Namen haben - aber da man sich noch weniger wortreich über deren Verwendung auslässt wie Embarcadero bei den eigenen Komponenten, ist es ein einziges extrem frustrierendes Ratespiel. Also werde ich heute wohl die C++ Beispiele übersetzen müssen, was mir auch wahnsinnig viel Spaß macht. Es ist erstaunlich, wie wenig Delphi Code man zu dem Thema findet, bei der riesen Menge an Fragenden.

Sherlock

[Sherlock]

Sodele, ich würde das hier gerne weiterspinnen. Meine Recherchen im Netz führen mich zu der Erkenntnis, daß es niemanden gibt, der bereits erfolgreich mit Delphi in OS ein Kerberos Ticket angefordert hat. Alle verweisen auf die üblichen Verdächtigen, die bei SO, oder eben der msdn verlinkt sind. Knackpunkt ist folgendes:
Es ist eben nicht damit getan ein paar API-Funktionen aufzurufen. Ein Kerberos-Ticket muss man sich auch per UDP-Kommunikation mit dem Kerberos-Server verdienen. Das führt dazu, daß selbst die zahlreichen voneinander abgeschrieben Beispile in den C-Dialekten an der Stelle äusserst schwammig werden. Ich halte Kerberos mittlerweile für eine Art weissen Wal, den jeder angeblich mal gesehen hat :D

Die API-Aufrufe bekommt man mit Hilfe von ein bis zwei Indy-Units einigermaßen zusammengeklöppelt. Aber selbst dann muss der korrekte SPN von Aussen gesetzt werden, Es gibt keine API, die einem das abnimmt. Hier die Source meines kleinen Testprojekts:

Delphi-Quellcode:

uses IdSSPI, IdAuthenticationSSPI

procedure TForm2.Button1Click(Sender: TObject);
var
  secfunc: SecurityFunctionTableA;
  sec_Entry: SECURITY_STATUS;
  pszTargetName: PSEC_CHAR;
  hCredential: SecHandle;
  tsExpiry: TimeStamp;
  hNewContext: CtxtHandle;
  Output: SecBufferDesc;
  token: SecBuffer;
  fContextAttr: ULONG;
  pPkgInfo: PSecPkgInfoA;
  TokenPointer: PByteArray;
  InitSecurityInterfaceA: function: PSecurityFunctionTableA; stdcall;
begin
  try
    TokenPointer := nil;
    InitSecurityInterfaceA := GetProcAddress(GetModuleHandle('secur32.dll'), 'InitSecurityInterfaceA');
    if Assigned(InitSecurityInterfaceA) then
      secfunc := InitSecurityInterfaceA^;

    sec_State:= secfunc.QuerySecurityPackageInfoA(
      PAnsiChar('Kerberos'),
      @pPkgInfo
      );

    if sec_State = SEC_E_OK then
      sec_State := secfunc.AcquireCredentialsHandleA(
        nil,
        pPkgInfo^.Name,
        SECPKG_CRED_OUTBOUND,
        nil,
        nil,
        nil,
        nil,
        @hCredential,
        @tsExpiry
        );

    Output.ulVersion := SECBUFFER_VERSION;
    Output.cBuffers := 1;
    Output.pBuffers := @token;

    GetMem(TokenPointer, ppkginfo^.cbMaxToken);

    token.cbBuffer := ppkginfo^.cbMaxToken;
    token.BufferType := SECBUFFER_TOKEN;
    token.pvBuffer := tokenpointer;

    if sec_State = SEC_E_OK then
      sec_State := secfunc.InitializeSecurityContextA(
        @hCredential,
        nil,
        PAnsiChar('RestrictedKrbHost/FM-DC01.mydomain.int'),   // Muss man eben irgendwie selbst herausfinden
        ISC_REQ_DELEGATE + ISC_REQ_MUTUAL_AUTH,
        0,
        SECURITY_NATIVE_DREP,
        nil,
        0,
        @hNewContext,
        @Output,
        @fContextAttr,
        @tsExpiry
        );

    if sec_State = SEC_I_CONTINUE_NEEDED then  // Derzeit ist genau das der Status
    begin
      // Output irgendwie an den Kerberos-Server senden und die Anwort mit erneutem Aufruf von 
      // InitializeSecurityContextA verwursten
    end;

    if sec_State = SEC_E_OK then
    begin
      ShowMessage('YAY!');
    end
    else
      case sec_State of
        SEC_E_OK: ShowMessage('YAY!');
        SEC_I_COMPLETE_AND_CONTINUE: ShowMessage('SEC_I_COMPLETE_AND_CONTINUE');
        SEC_I_COMPLETE_NEEDED: ShowMessage('SEC_I_COMPLETE_NEEDED');
        SEC_I_CONTINUE_NEEDED: ShowMessage('SEC_I_CONTINUE_NEEDED');
        SEC_I_INCOMPLETE_CREDENTIALS: ShowMessage('SEC_I_INCOMPLETE_CREDENTIALS');
        SEC_E_INSUFFICIENT_MEMORY: ShowMessage('SEC_E_INSUFFICIENT_MEMORY');
        SEC_E_INTERNAL_ERROR: ShowMessage('SEC_E_INTERNAL_ERROR');
        SEC_E_INVALID_HANDLE: ShowMessage('SEC_E_INVALID_HANDLE');
        SEC_E_INVALID_TOKEN: ShowMessage('SEC_E_INVALID_TOKEN');
        SEC_E_LOGON_DENIED: ShowMessage('SEC_E_LOGON_DENIED');
        SEC_E_NO_AUTHENTICATING_AUTHORITY: ShowMessage('SEC_E_NO_AUTHENTICATING_AUTHORITY');
        SEC_E_NO_CREDENTIALS: ShowMessage('SEC_E_NO_CREDENTIALS');
        SEC_E_TARGET_UNKNOWN: ShowMessage('SEC_E_TARGET_UNKNOWN');
        SEC_E_UNSUPPORTED_FUNCTION: ShowMessage('SEC_E_UNSUPPORTED_FUNCTION');
        SEC_E_WRONG_PRINCIPAL: ShowMessage('SEC_E_WRONG_PRINCIPAL');
      else
        ShowMessage('UNKNOWN ERROR Code. Last Error:' + IntToStr(GetLastError));
      end;
  finally
    secfunc.FreeCredentialsHandle(@hCredential);
    secfunc.FreeContextBuffer(pPkgInfo);
    FreeMem(TokenPointer);
  end;
end;

Wer hat sowas mal wirklich vollumfänglich implementiert? (Der SOAP-Teil aus meinem Startpost kann erstmal getrost vergessen werden)

Sherlock

[slemke76]

Hallo,

nachdem ich meinen gestrigen Tag (erfolgreich) damit verbracht habe, zuerst einem Apache NTLM Authentifizierung (SSO mit FF, Chrome, etc.) beizubringen und danach das Ganze auch mit Indy anzusprechen, habe ich mich mit Kerberos beschäftigt - NTLM ist jetzt ja nicht mehr unbedingt auf dem Stand der Dinge :-)


Deswegen die Frage hier - ging es hier noch weiter? Vermutlich nicht, oder?
Ich hätte grosses Interesse dadran, Indy die Kerberos Authentifizierung beizubringen (siehe oben :-). Werde aber die kommenden Wochen wenig Zeit haben - aber der Thread ruht ja schon recht lange :-)

Ich habe mich heute mal rangesetzt, die grundsätzliche Vorgehensweise ist von Microsoft hier beschrieben:
https://docs.microsoft.com/en-us/win...ty-with-gssapi

In dem Beispiel von Sherlock ist die Bestimmung des SPN hard-coded („Muss man eben irgendwie selbst herausfinden“) – das habe ich über AcquireCredentialsHandle gelöst – darüber bekommt man den aktuellen Usernamen im Format user@fqdn. Dann wird mit der Funktion getKerberosSPN eine Namensauflösung gemacht (Firefox und Konsorten machen das wohl ähnlich?). Mit gegebenen SPN und Credentials kann man jetzt InitializeSecurityContext aufrufen. Am Status „SEC_I_CONTINUE_NEEDED“ muss man (anscheinend) CompleteAuthToken aufrufen.

Soweit ist alles umgesetzt (mit den Jedis für die WIn32API, das fiel mir leichter ��).

Wie geht es weiter? Gute Frage �� Ich würde jetzt für mich eine passende „Gegenstelle“ aufbauen (Apache mit Kerberosauth) und dann über die Debug-Logs von Kerberos (siehe auch https://www.msxfaq.de/windows/kerberos/kerbdebug.htm) schauen, was Firefox und Co. machen und dann versuchen, das ganze weiter zu bauen.

Bitte nicht auf Code-Qualität achten, da ist bestimmt noch das ein oder andere Leak drin, ist halt nur ein Prototyp.

Achtung: Viel "zusammengeklautes" dabei, oft aber nicht immer mit Quellenangabe :-) Wie gesagt, ein Prototyp.

EDIT:
Ich habe gerade auf meinen Client nochmal geschaut - die Tickets kann man sich mit klist ansehen.... Und: Es wurde auch tatsächlich ein Ticket ausgestellt. Sieht im Moment gar nicht so schlecht aus.... RestrictedKrbHost muss vermutlich durch den Servernamen ersetzt werden, auf den man Zugriff nehmen möchte (?).

Grüße
Sebastian

Delphi-Quellcode:

unit MainUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  JwaSspi, JwaWinDNS, IdBaseComponent, IdComponent, IdTCPConnection, IdDNSResolver;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1AcquireCredentialsHandle: TButton;
    procedure Button1AcquireCredentialsHandleClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  protected
    function GetAuth(): TBytes;
    function getKerberosSPN(userName: String):WideString;
  private
    { Private-Deklarationen }
    // sind derzeit keine properties...
    FMaxMessageLen: Cardinal;
    FCred: SecHandle;
    FCredCtx :CtxtHandle;
    FContextAttrib: Cardinal;
    FSPN: WideString;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  WinSock;

const
  SEC_E_OK                         = 0;
  {$EXTERNALSYM SEC_E_OK}
  SEC_I_CONTINUE_NEEDED            = HRESULT($00090312);
  {$EXTERNALSYM SEC_I_CONTINUE_NEEDED}
  SEC_I_COMPLETE_NEEDED            = HRESULT($00090313);
  {$EXTERNALSYM SEC_I_COMPLETE_NEEDED}
  SEC_I_COMPLETE_AND_CONTINUE      = HRESULT($00090314);
  {$EXTERNALSYM SEC_I_COMPLETE_AND_CONTINUE}

// https://docs.microsoft.com/en-us/windows/win32/secauthn/sspi-kerberos-interoperability-with-gssapi

function TForm1.GetAuth(): TBytes;
var
  pkgInfo: PSecPkgInfo;
  SecBuf: SecBuffer;
  BuffDesc: SecBufferDesc;
  status: SECURITY_STATUS;
  attrs: Cardinal;
  tsExpiry: TTimeStamp;
  attrName: SecPkgCredentials_Names;
const
  NEG_STR: WideString = 'Kerberos'; // 'NTLM'; // 'Negotiate';
begin
  // https://stackoverflow.com/questions/33829755/sspi-and-sql-server-windows-authentication
  // https://entwickler-ecke.de/topic_Existiert+BenutzerPasswort+am+System+geloest_13781,0.html
  // https://github.com/graemeg/freepascal/blob/master/packages/winunits-jedi/src/jwasspi.pas

  Result := nil;

  status := QuerySecurityPackageInfo(PSecWChar(NEG_STR), pkgInfo);
  if status <> SEC_E_OK then
    raise Exception.CreateFmt('Couldn''t query package info for %s, error %X', [NEG_STR, status]);
  FMaxMessageLen := pkgInfo.cbMaxToken; // 4096;
  FreeContextBuffer(pkgInfo);

  TTimeStamp(tsExpiry).QuadPart := 0;
  status := AcquireCredentialsHandle(nil, PSecWChar(NEG_STR), SECPKG_CRED_OUTBOUND, //  SECPKG_CRED_BOTH
    nil, nil, nil, nil, @FCred, tsExpiry); // tsExpiry as var parameter
  if status <> SEC_E_OK then
    raise Exception.CreateFmt('AcquireCredentialsHandle error %X', [status]);

  BuffDesc.ulVersion := SECBUFFER_VERSION;
  BuffDesc.cBuffers := 1;
  BuffDesc.pBuffers := @SecBuf;

  SecBuf.BufferType := SECBUFFER_TOKEN;
  SetLength(Result, FMaxMessageLen);
  SecBuf.pvBuffer := @Result[0];
  SecBuf.cbBuffer := FMaxMessageLen;

  status := QueryCredentialsAttributes(@FCred, SECPKG_CRED_ATTR_NAMES, @attrName);
  if status <> SEC_E_OK then
    raise Exception.CreateFmt('QueryCredentialsAttributes error %X', [status]);
  
  Memo1.Lines.Add('result of QueryCredentialsAttributes: '+PWideChar(attrName.sUserName));

  // Now build the correct format.
  FSPN := getKerberosSPN(PWideChar(attrName.sUserName));

  Memo1.Lines.Add('SPN used: '+FSPN);
  // something like RestrictedKrbHost/fqdn-of-kerberos-server;

  FContextAttrib := ISC_REQ_DELEGATE or ISC_REQ_MUTUAL_AUTH or ISC_REQ_INTEGRITY or ISC_REQ_EXTENDED_ERROR;
  // ISC_REQ_CONFIDENTIALITY or ISC_REQ_REPLAY_DETECT or ISC_REQ_CONNECTION;
  // $8C03C;
  // ISC_REQ_MUTUAL_AUTH or ISC_REQ_IDENTIFY or ISC_REQ_CONFIDENTIALITY or ISC_REQ_REPLAY_DETECT or ISC_REQ_SEQUENCE_DETECT or ISC_REQ_CONNECTION or ISC_REQ_DELEGATE;

  status := InitializeSecurityContext(@FCred, nil, PSecWChar(FSPN),
    FContextAttrib,
    0, SECURITY_NATIVE_DREP,    nil, 0, @FCredCtx, @BuffDesc, attrs, @tsExpiry);
  if status <= 0 then
    raise Exception.CreateFmt('InitializeSecurityContext error %X', [status]);

  if (status = SEC_I_COMPLETE_NEEDED) or (status = SEC_I_COMPLETE_AND_CONTINUE) or (status = SEC_I_CONTINUE_NEEDED) then begin
    status := CompleteAuthToken(@FCredCtx, @BuffDesc);
    if status <> SEC_E_OK then begin
      FreeCredentialsHandle(@FCred);
      Result := nil;
      raise Exception.CreateFmt('CompleteAuthToken error %X', [status]);
    end;
  end
  else if (status <> SEC_E_OK) and (status <> SEC_I_CONTINUE_NEEDED) then begin
    // SEC_I_CONTINUE_NEEDED
    // The client must send the output token to the server and wait for a return token.
    // The returned token is then passed in another call to InitializeSecurityContext (Negotiate). The output token can be empty
    FreeCredentialsHandle(@FCred);
    Result := nil;
    raise Exception.CreateFmt('InitializeSecurityContext error %X', [status]);
  end;

  SetLength(Result, SecBuf.cbBuffer);

  if status = SEC_E_OK then
    Memo1.Lines.Add('result is SEC_E_OK');
end;

function TForm1.getKerberosSPN(userName: String):WideString;
// @ToDo: String / Widestring bereinigen
var
  strArray: TArray<String>;
  queryDomain: string;
  kerberosHostname: string;
  DNS_REC: PDNS_RECORD;
begin
  // https://searchfox.org/mozilla-central/source/extensions/auth/nsAuthSSPI.cpp
  //  -> MakeSN()
  // https://searchfox.org/mozilla-central/source/netwerk/dns/nsDNSService2.cpp
  // https://www.msxfaq.de/windows/kerberos/kerberosspn.htm
  // https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-adts/7fcdce70-5205-44d6-9c3a-260e616a2f04

  result:='';

  // userName should be something like
  // username@fqdn
  strArray := userName.Split(['@']);
  if length(strArray) <> 2 then
    raise Exception.CreateFmt('invalid Username', []);

  // SRV Record für kerberos Server abfragen
  queryDomain := '_kerberos._tcp.'+strArray[1];

// Memo1.Lines.Add('Abfrage Kerberos-Server: '+queryDomain);

  // https://www.codenewsfast.com/cnf/article/0/permalink.art-ng1921q9862

  // über Win32 API
  // über Indy müsste man erst System-DNS bestimmen - das lassen wir mal Windows machen :-)
  // https://stackoverflow.com/questions/6444102/look-up-if-mail-server-exists-for-list-of-emails
  kerberosHostname:='';
  if DnsQuery(PWideChar(queryDomain), DNS_TYPE_SRV, 0, nil, @DNS_REC, nil) = 0 then begin
    while assigned(DNS_REC) do begin
      if DNS_REC.wType = DNS_TYPE_SRV then begin
        // do something...
        kerberosHostname:=DNS_REC.Data.SRV.pNameTarget;
      end;
      DNS_REC := DNS_REC.pNext;
    end;
  end;

  if kerberosHostname = '' then
    raise Exception.CreateFmt('could not determinate kerberos server!', []);

// Memo1.Lines.Add(' -> '+kerberosHostname);

  result := Format('%s/%s', ['RestrictedKrbHost', kerberosHostname]);
end;

procedure TForm1.Button1AcquireCredentialsHandleClick(Sender: TObject);
begin
  Memo1.Lines.Clear;
  GetAuth();
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1AcquireCredentialsHandleClick(nil);;
end;

end.