Winlogon Notification Package - Problem bei IPC mit Service

[quendolineDD]

Hallo DP.

Ich habe einen Service programmiert, welcher eine NamedPipe zur Verfügung stellt. Bisher sendete eine Batchdatei den Benutzernamen des angemledeten Users an den Service. Da ich jedoch keine Batchdatei mehr verwenden wollte, habe ich mir eine DLL geschrieben und diese für das Logon-Event im Winlogon als Notification Package registriert (Einträge in Registry etc.). Das dabei auftretende Problem ist jedoch, das beim Ausführen der DLL der Service noch nicht gestartet zu sein scheint (Laut Log findet das Event ca. 1 Sekunde vor dem Start des Services statt). Trotz des Aufrufs von WaitNamedPipe in der DLL, kommt es nicht zu einem Kontakt zwischen DLL und Service. Infolge dessen habe ich das Event auf StartShell verschoben, welches später eintritt.

Zitat von msdn:

A shell start event occurs after the user has logged on but before the desktop appears. It differs from the logon event in that the user's security context has been established, and resources such as network connections are available.

Bei der IPC würde ich gerne bei Named Pipes bleiben.
Trotz Recherche auch im englischsprachigen Bereich, bin ich bisher erfolglos geblieben.
Worin liegt das Problem, dass keine Verbindung zwischen Service und DLL zustande kommt?

[Dezipaitor]

Was ist das grundlegende Problem, dass du lösen willst? Benutzername des angemeldeten Benutzers rausfinden?

[quendolineDD]

Nein, das ist kein Problem.
Das grundlegende Problem ist, das trotz WaitNamedPipe keine Verbindung zwischen Service und DLL zustande kommt.
In der DLL

Delphi-Quellcode:

      try
        if WaitNamedPipe (PipeName, NMPWAIT_WAIT_FOREVER) then
        begin
          hPipe := CreateFile (PipeName, GENERIC_ALL, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); 
          if hPipe <> INVALID_HANDLE_VALUE then
          begin
            LogMsg('WriteFile');
            WriteFile(hPipe, lpData, sizeof(lpData), iWritten, nil);
          end;
        end;
      finally
        CloseHandle (hPipe);
      end;

[Dezipaitor]

Du musst in einer Schleife prüfen mit CreateFile, ob die Pipe schon existiert. Bei Fehler sollte GetLastError ERROR_FILE_NOT_FOUND zurückliefern.

[Apollonius]

Was schlägt denn fehl? Werte doch mal die Fehlercodes aus.

[quendolineDD]

Wieso kommt es denn bitte bei WaitNamedPipe zu keiner Weiterführung und stattdessen muss man mit CreateFile iterieren. Das entzieht sich meiner Logik.
Dezipator hat die Lösung genannt.

[Dezipaitor]

Wenn du WaitnamedPipe verwenden willst muss auf der anderen Seite ConnectNamedPipe aufgerufen werden. Hast du das?

[quendolineDD]

Manchmal sind doch die Lösungen so simpel, das man am liebsten .
Edit: Aber ConnectNamedPipe verwende ich im Service.

[Dezipaitor]

Ich habe den Quelltext einsehen können und schreibe hier meine Erkentnisse, damit andere auch davon profitieren können.

@quendolineDD: Ich kann dir aber auch raten Apollonius mal zu fragen, ob er Lust/Zeit hat, den Quelltext anzuschauen. Er ist da ziemlich gut drin

---

Ich sehe folgende Probleme:

1. PipeName = '\.pipeRegPipe'; sollte eigentlich so \\.\pipe\pipename aussehen.

2.  WaitForSingleObject (Pipe.oOverlap.hEvent, 1000); Benutze besser WaitForMultipleObjects mit INFINITE Timeout und mit einem zweiten Event. Es wird ausgelöst, wenn der Thread beendet werden soll. D.h. du musst ein OnTerminate Ereignis verwenden, worin du das Signal setzt.

3.

Delphi-Quellcode:

repeat
          hPipe := CreateFile (PipeName, GENERIC_ALL, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
        until hPipe <> INVALID_HANDLE_VALUE;

Das ständige Iterieren erzeugt 100% CPU Last. Man wartet normalerweise 1-2sek und versucht es dann nochmal. Weiterhin fehlt ein Ausstiegssignal (z.b. max Versuche, Event). Sonst kann man Winlogon/PC nur noch langsam beenden.

4. FlushFileBuffers sollte verwendet werden, bevor die Pipe geschlossen wird, damit gerade gesendete Daten nicht verloren gehen.

5. ReadFile kehrt bei asynchronen Pipes sofort zurück. Du musst also erstmal WaitForMultipleObjects mit dem OverlappedEvent verwenden.

6. Du verwendest ManualReset = true für das Event, d.h. du musst das Event vor jeder Verwendung erstmal zurücksetzen - oder false verwenden.

[quendolineDD]

Danke für deine Antworten. Habe es gestern nicht mehr geschafft daran weiter zu arbeiten.
Ich habe mich nun entschlossen doch den Quelltext zu veröffentlichen (Dank des Artikels ).

Es handelt sich hierbei um einen Service, der eine Named Pipe zur Verfügung stellt und über diese einen Benutzernamen und den Computernamen erhält.

Delphi-Quellcode:

unit uPipeThread;

interface

uses
  Windows,
  SysUtils,
  Classes,
  Dialogs;

const
  CONNECTING_STATE = 0;
  READING_STATE = 1;
  BUFSIZE = 4096;
  PipeName = '\\.\pipe\RegPipe';

type
  TDataArray = array[0..BUFSIZE-1] of Char;

  LPOVERLAPPED = POVERLAPPED;
  LPPipeInst = ^PipeInst;
  _PipeInst = record
    oOverlap : OVERLAPPED;
    hPipeInst : THandle;
    chRequest : TDataArray;
    cbRead : DWORD;
    dwState : DWORD;
    fPendingIO : BOOL;
    EventArray : TWOHandleArray;
  end;
  PipeInst = _PipeInst;

  TPipeThread = class(TThread)
  private
    Pipe : PipeInst;
    FAccount : String;
    FDomain : String;
    FOnTerminate: TNotifyEvent;

    function ConnectToNewClient (hPipe : THandle; lpo : LPOVERLAPPED) : BOOL;
    procedure DisconnectAndReconnect;

    procedure log(msg : string);
    procedure SetOnTerminate(const Value: TNotifyEvent);
    property OnTerminate : TNotifyEvent read FOnTerminate write SetOnTerminate;
  protected
    procedure Execute; override;

  public
    Constructor Create;
  end;

implementation

{ TPipeThread }

function TPipeThread.ConnectToNewClient(hPipe: THandle;
  lpo: LPOVERLAPPED): BOOL;
var
  fConnected : BOOL;
  fPendingIO : BOOL;
begin
  log('connecttonewclient');
  fConnected := false;
  fPendingIO := true;

  fConnected := ConnectNamedPipe (hPipe, lpo);

  Pipe.EventArray[1] := lpo^.hEvent;
  
  if fConnected then
  begin
    Result := false;
    Exit;
  end;

  case GetLastError of
    ERROR_IO_PENDING : fPendingIO := true;
    ERROR_PIPE_CONNECTED : SetEvent(lpo^.hEvent);
  else
    Result := false;
    Exit;
  end;
  Result := fPendingIO;
end;

constructor TPipeThread.Create;
begin
  log('create');

  
  FreeOnTerminate := false;
  try
  Pipe.EventArray[0] := CreateEvent(nil, false, true, nil);
  except
    on E: Exception do log(E.Message);
  end;

  log('create 2');

  inherited Create(true);
end;

procedure TPipeThread.DisconnectAndReconnect;
begin
  log('dc and rc');

  DisconnectNamedPipe (Pipe.hPipeInst);

  Pipe.fPendingIO := ConnectToNewClient (Pipe.hPipeInst, @Pipe.oOverlap);
  if Pipe.fPendingIO then
    Pipe.dwState := CONNECTING_STATE
  else
    Pipe.dwState := READING_STATE;
end;

procedure TPipeThread.Execute;
var
  i : DWORD;
  dwWait : DWORD;
  cbRet : DWORD;
  dwError : DWORD;
  fSuccess : BOOL;
begin
  log('execute');

  Pipe.oOverlap.hEvent := CreateEvent (nil, false, true, nil);
  Pipe.hPipeInst := CreateNamedPipe (
    PipeName,
    PIPE_ACCESS_DUPLEX or FILE_FLAG_OVERLAPPED,
    PIPE_TYPE_MESSAGE or PIPE_NOWAIT,
    PIPE_UNLIMITED_INSTANCES,
    BUFSIZE,
    BUFSIZE,
    0,
    nil);

    Pipe.fPendingIO := ConnectToNewClient (Pipe.hPipeInst, @Pipe.oOverlap);
    if Pipe.fPendingIO then
      Pipe.dwState := CONNECTING_STATE
    else
      Pipe.dwState := READING_STATE;

    while (not Terminated) do
    begin
      log('in loop');
      log('before waitformultipleobjcts');
      dwWait := WaitForMultipleObjects(2, @Pipe.EventArray[0], false, INFINITE);
      //dwWait := WaitForSingleObject (Pipe.oOverlap.hEvent, 1000);
      log('after waitformultipleobjcts');
      i := dwWait - WAIT_OBJECT_0;
      if i <> 1 then
      begin
        if Pipe.fPendingIO then
        begin
          fSuccess := GetOverlappedResult (
            Pipe.hPipeInst,
            Pipe.oOverlap,
            cbRet,
            false);

          case Pipe.dwState of
            CONNECTING_STATE: Pipe.dwState := READING_STATE;
            READING_STATE:
            begin
              if (not fSuccess) and (cbRet = 0) then
                DisconnectAndReconnect;
            end;
          end;
        end;

        case Pipe.dwState of
          READING_STATE:
          begin
            fSuccess := ReadFile (
              Pipe.hPipeInst,
              Pipe.oOverlap,
              BUFSIZE,
              Pipe.cbRead,
              @Pipe.oOverlap);

            if fSuccess and (Pipe.cbRead <> 0) then
            begin
              Pipe.fPendingIO := false;
              FAccount := Copy(Pipe.chRequest, 0, Pos(#35, Pipe.chRequest)-1);
              FDomain := Copy(Pipe.chRequest, Pos(#35, Pipe.chRequest), sizeof(Pipe.chRequest));
              log(FAccount + ' // '+ FDomain);
            end;
            dwError := GetLastError;
            if (not fSuccess) and (dwError = ERROR_IO_PENDING) then
              Pipe.fPendingIO := true;

            DisconnectAndReconnect;
          end;
        end;       
      end;
    end;
    CloseHandle (Pipe.oOverlap.hEvent);
    CloseHandle (Pipe.hPipeInst);
end;

procedure TPipeThread.log(msg: string);
var
  s : tstrings;
begin
  try
  s := TStringList.Create;
  try
    s.LoadFromFile('C:\log.txt');
  except
    s.SaveToFile('C:\log.txt');                           
  end;
  s.Add(Msg);
  s.SaveToFile('C:\log.txt');
  finally
    s.Free;
  end;
end;

procedure TPipeThread.SetOnTerminate(const Value: TNotifyEvent);
begin
  log('onterminate');

  SetEvent(Pipe.EventArray[0]);
  FOnTerminate := Value;
end;

end.

Das ist meine aktuelle Debug-Version, in der auch schon Änderungen bzgl. der Vorschläge von Christian eingeflossen sind. Es klappt aber noch nicht so. Fehlverhalten ist aktuell folgendes (was eventuell auch vom Fehlübersetzen des C-Quellgerüstes stammen könnte).
Hierzu ein Auszug aus der Logdatei:

Zitat:

create
create 2
execute
connecttonewclient
in loop
before waitformultipleobjcts
after waitformultipleobjcts
dc and rc
connecttonewclient
in loop
before waitformultipleobjcts

Mal schauen. Außerdem klappt das mit dem schließen noch nicht und dem neuen Event, aber das ist erstmal nebensächlich.