Question

我在这里不知所措。几周以来，我试图用我的Delphi应用程序获得Kerberos票。

我咨询过：

How can I get a Kerberos ticket with Delphi?（老实说，我不明白为什么赏金会得到回报，顺便说一下）
https://msdn.microsoft.com/en-us/library/aa374713%28v=vs.85%29.aspx
最重要的是：https://msdn.microsoft.com/en-us/library/ee498143.aspx

最后一页链接到我转换为Delphi的示例代码 - 我想。在表单上，我从Overbytes Socket组件中删除了一个TWSocket，并将其命名为mySocket。休息是在代码中完成的。问题是，我似乎得到了Kerberos TGT，但无法通过UDP连接获得Ticket本身。服务器只是不回答。我也觉得这里存在一些根本性的错误，在与服务器通信期间媒体中断。为什么我可以使用API来获取TGT但是必须切换到UDP才能获得票证？

开始讨论这个问题可能是一个好的开始，就是先忽略代码并告诉我，我的方式是否正确。以下是我的步骤：

调用InitSecurityInterface以获取SecurityFunctionTable
为Kerberos包调用QuerySecurityPackageInfo以获取最大邮件大小
为Kerberos包调用AcquireCredentialsHandle
使用上面收到的CredentialsHandle和KerberosServer调用InitializeSecurityContext。接收一些消息，可能包含KerbTicket，一个Curb TGT或其他任何内容
根据InitializeSecurityContext的结果，使用收到的KerbTicket或打开与KerbServer的UDP连接从步骤4发送收到的缓冲区
使用answer message作为InitilizeSecurityContext
从步骤4开始重复，直到结果为SEC_E_OK

我理解正确吗？如果是这样，请考虑阅读我的实现以找出我的错误。如果没有，请解释它是如何完成的。

以下是代码：

unit ukerber;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  IdSSPI, IdAuthenticationSSPI, Vcl.StdCtrls, OverbyteIcsWndControl,
  OverbyteIcsWSocket;

const
  krbServer: PAnsiChar = 'krbtgt/mydomain.int';

type
  TForm2 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    mySocket: TWSocket;
    procedure Button1Click(Sender: TObject);
    procedure mySocketDataAvailable(Sender: TObject; ErrCode: Word);
    function InitPackage(var maxMessage: Cardinal): Boolean;
    function SendUDPMessage(outBuf: Pointer; outsize: Cardinal): Boolean;
    function GenClientContext(pIn: Pointer; InputSize: Cardinal; pOut: Pointer; Outputsize: PCardinal; var Done: Boolean): Boolean;
    procedure Cleanup;
  private
    { Private-Deklarationen }
    secfunc: SecurityFunctionTableA;
    maxMessageSize: Cardinal;
    hCredential: SecHandle;
    hContext: CtxtHandle;
    pOutBuf, pInBuf: PByteArray;
    MessageReceived: Boolean;
  public
    { Public-Deklarationen }
  end;

procedure Pause(Zeit: Longint);

var
  Form2: TForm2;

implementation

{$R *.dfm}

// the main method from the C-example
// this starts the ticket acquisition
procedure TForm2.Button1Click(Sender: TObject);
var
  sec_State: SECURITY_STATUS;
  pszTargetName: PSEC_CHAR;

  hNewContext: CtxtHandle;
  Output, Input: SecBufferDesc;
  outSecBuf, inSecBuf: SecBuffer;
  fContextAttr: ULONG;

  cbOut, cbIn: Cardinal;
  Done: Boolean;
  timeOut: Integer;
begin
  Done := False;
  if InitPackage(maxMessageSize) then
  begin
    try
      pOutBuf := nil;
      pInBuf := nil;

      GetMem(pOutBuf, maxMessageSize);
      GetMem(pInBuf, maxMessageSize);
      SecInvalidateHandle(hCredential);
      SecInvalidateHandle(hContext);

      if not GenClientContext(nil, 0, pOutBuf, @cbOut, Done) then
      begin
        Cleanup;
        Exit;
      end;

      // ------------
      // up to here everything seem to work just fine
      // ------------
      if not SendUDPMessage(pOutBuf, cbout) then
      begin
        Cleanup;
        Exit;
      end;
      timeOut := 0;

      while not Done and (timeOut <= 100) do
      begin
        repeat
          Pause(1000);
          Inc(timeOut);
        until MessageReceived or (timeOut >= 100);

        if MessageReceived then
        begin
          cbOut := maxMessageSize;
          if not GenClientContext(pInBuf, cbIn, pOutBuf, @cbout, Done) then
          begin
            Cleanup;
            Exit;
          end;
          if not SendUDPMessage(pOutBuf, cbout) then
          begin
            Cleanup;
            Exit;
          end;

        end;
      end;

      if Done then  // <<<----------Sadly... never done
      begin
        // Kerberos-ticket ---->>>>  pInBuf

      end
      else  // this happens every time
        ShowMessage('Authentification failed due to server timeout');
    finally
      Cleanup;
    end;
  end;
end;

procedure TForm2.Cleanup;
begin
  secfunc.DeleteSecurityContext(@hcontext);
  secfunc.FreeCredentialsHandle(@hCredential);
  FreeMem(pInBuf);
  FreeMem(pOutBuf);
end;

function TForm2.GenClientContext(pIn: Pointer; InputSize: Cardinal;
  pOut: Pointer; Outputsize: PCardinal; var Done: Boolean): Boolean;
var
  sec_State: SECURITY_STATUS;
  LifeTime: TimeStamp;
  OutBuffDesc: SecBufferDesc;
  OutSecBuff: SecBuffer;
  InBuffDesc: SecBufferDesc;
  InSecBuff: SecBuffer;
  ContextAttributes: ULONG;
  NewContext: Boolean;
  KerberosServer: PAnsiChar;

  function SetSecHandle: PSecHandle;
  begin
    if NewContext then
      Result := nil
    else
      Result := @hContext;
  end;

  function SetInBuffer: PSecBufferDesc;
  begin
    if NewContext then
      Result := nil
    else
      Result := @InBuffDesc;
  end;

begin
  if not Assigned(pIn) then
  begin
    NewContext := True;
  // No user athentication needed, so we'll skip that part of the example
    sec_State := secfunc.AcquireCredentialsHandleA(
      nil,
      PAnsiChar('Kerberos'),
      SECPKG_CRED_OUTBOUND,
      nil,
      nil,
      nil,
      nil,
      @hCredential,
      @LifeTime
      );
    if not SEC_SUCCESS(sec_State) then
    begin
      ShowMessage('AqcuireCredentials failed, Error#: ' + IntToStr(sec_State));
      Result := False;
      Exit;
    end;
  end;

    // Prepare buffers
    // Output
  OutBuffDesc.ulVersion := SECBUFFER_VERSION;
  OutBuffDesc.cBuffers := 1;
  OutBuffDesc.pBuffers := @OutSecBuff;

  OutSecBuff.cbBuffer := Outputsize^;
  OutSecBuff.BufferType := SECBUFFER_TOKEN;
  OutSecBuff.pvBuffer := pOut;

    //Input
  InBuffDesc.ulVersion := SECBUFFER_VERSION;
  InBuffDesc.cBuffers := 1;
  InBuffDesc.pBuffers := @InSecBuff;

  InSecBuff.cbBuffer := InputSize;
  InSecBuff.BufferType := SECBUFFER_TOKEN;
  InSecBuff.pvBuffer := pIn;

//  KerberosServer := krbServer;  // Tried both krbtgt and following...no change
  KerberosServer := PAnsiChar('RestrictedKrbHost/FM-DC01.mydomain.int');

  sec_State := secfunc.InitializeSecurityContextA(
    @hCredential,
    SetSecHandle,
    KerberosServer,                                                              
    ISC_REQ_DELEGATE + ISC_REQ_MUTUAL_AUTH,
    0,
    SECURITY_NATIVE_DREP,
    SetInBuffer,
    0,
    @hContext,
    @OutBuffDesc,
    @contextAttributes,
    @Lifetime
    );

  if not SEC_SUCCESS(sec_State) then
  begin
    ShowMessage('init context failed, Error #: ' + IntToStr(sec_State));
    Result := False;
    Exit;
  end;

  if (sec_State = SEC_I_COMPLETE_NEEDED) or
    (sec_State = SEC_I_COMPLETE_AND_CONTINUE) then
  begin
    sec_State := secfunc.CompleteAuthToken(@hContext, @OutBuffDesc);
    if not SEC_SUCCESS(sec_State) then
    begin
      ShowMessage('complete failed, Error #: ' + IntToStr(sec_State));
      Result := False;
      Exit;
    end;
  end;

  Outputsize^ := OutSecBuff.cbBuffer;

  // First call of this method results in sec_state = SEC_I_CONTINUE_NEEDED 
  // which should be OK, but then I have to switch to UDP communication
  // and that seems to be buggy.

  Done := not ((sec_State = SEC_I_CONTINUE_NEEDED) or (sec_State = SEC_I_COMPLETE_AND_CONTINUE));
  Result := True;
end;

function TForm2.InitPackage(var maxMessage: Cardinal): Boolean;
var
  sec_State: SECURITY_STATUS;
  pPkgInfo: PSecPkgInfoA;
  InitSecurityInterfaceA: function: PSecurityFunctionTableA; stdcall;
begin
  Result := False;
  MessageReceived := False;
  try
    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
    begin
      maxMessage := pPkgInfo^.cbMaxToken;
      Result := True;
    end;
  finally
    secfunc.FreeContextBuffer(pPkgInfo);
  end;
end;

procedure TForm2.mySocketDataAvailable(Sender: TObject; ErrCode: Word);
var
  inBuf: array of Byte;
  BufLen: Integer;
  Length: Integer;
  sentSize: Cardinal;
begin
  MessageReceived := False;
  // Data should pour in here. Hopefully the Kerberos-ticket
  // First DWORD is message size, rest is the message itself
  Length := mySocket.Receive(@sentsize, SizeOf(DWORD));
  if Length <= 0 then
  begin
    Exit;
  end;
  // The rest
  SetLength(inBuf, SizeOf(sentSize));
  Length := mySocket.Receive(@inBuf, SizeOf(inBuf));
  if Length >= 0 then
  begin
    pInBuf := @inBuf;
    MessageReceived := True;
  end;
end;

function TForm2.SendUDPMessage(outBuf: Pointer; outsize: Cardinal): Boolean;
begin
  mySocket.Proto := 'udp';
  mySocket.Addr := 'FM-DC01.mydomain.int';
  mySocket.Port := '88';
  mySocket.Connect;
  // send size of message first, then message itself
  Result := (mySocket.Send(PByte(@outsize), SizeOf(outsize)) > -1);
  if Result then
    if mySocket.State = wsConnected then
      Result := (mySocket.Send(outBuf, outsize) > -1);
end;

// small method to wait for action, should not be part of the problem
procedure Pause(Zeit: Longint);
var
  Tick: DWORD;
  Event: THandle;
begin
  Event := CreateEvent(nil, False, False, nil);
  try
    Tick := GetTickCount + DWORD(Zeit);
    while (Zeit > 0) and
      (MsgWaitForMultipleObjects(1, Event, False, Zeit, QS_ALLINPUT) <> WAIT_TIMEOUT) do
    begin
      Application.ProcessMessages;
      Zeit := Tick - GetTickCount;
    end;
  finally
    CloseHandle(Event);
  end;
end;    

end.

使用Delphi应用程序获取Kerberos票证

0 个答案: