IPC über NamedPipes - Generelles Problem

[quendolineDD]

Hallo DP-Community.

Ich hab vor ein paar Wochen mit der Planung eines Projektes angefangen, mir dafür alle in der DP zu findenden Beiträge angeschaut und ausprobiert, wobei mein Erfolg mäßig ausfällt.
Ich habe zuerst einen Service, welcher eine NamedPipe zur Verfügung stellt und auf diese soll mein Programm Daten an den Service schicken, welcher daraufhin Daten in einer lokalen Datenbank speichert, und bei erfolgreicher Verbindung zum Hauptserver ein Image der Datenbank hochladen soll.

Vorerst wichtig:
- Dienst stellt NamedPipe zur Verfügung und LIEST darauf (Pipe ist READONLY)
- Programm verbindet zur Pipe und SCHREIBT



Erstmal bin ich schon dabei zu scheitern, den Datenfluss zwischen Programm und Service fehlerfrei zum laufen zu bringen.
Bisher kommt "Zugriff Verweigert" obwohl ich lt. Forum Zugriff für jeden eingestellt habe ...

Woran liegts?

Delphi-Quellcode:

unit uLogService;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;

const
  PipeName = '\\.\pipe\CtrPipe';

type
  TService1 = class(TService)
    procedure ServiceShutdown(Sender: TService);
    procedure ServiceExecute(Sender: TService);
    procedure WriteToLogfile(const aText: String);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
  private
    PipeFileHandle : THandle;
  public
    function GetServiceController: TServiceController; override;
  end;

var
  Service1: TService1;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TService1.ServiceShutdown(Sender: TService);
begin
  WriteToLogfile('Beendet');
end;

procedure TService1.ServiceExecute(Sender: TService);
var
  msg : ShortString;
  dw  : DWORD;
begin
msg := ''; dw := 0;

  WriteToLogfile('Begin Execute');
  while not Terminated do
  begin
    ServiceThread.ProcessRequests(False); 
    Try
      ReadFile(PipeFileHandle, msg, sizeof(msg), dw, nil);
      if msg <> '' then
      begin
        WriteToLogfile(msg);
      end;
    Except
      WriteToLogfile('ReadFile - '+SysErrorMessage(GetLastError));
    end;
  end;
  WriteToLogfile('End Execute');
end;

procedure TService1.WriteToLogfile(const aText: String);
const
  logfile = '\log\log.txt';
var
  List : TStringList;
  Time : String;
begin
  List := TStringList.Create;
  Time := TimeToStr(GetTime);
  try
    List.LoadFromFile(logfile);
  except
    List.SaveToFile(logfile);
    List.LoadFromFile(logfile);
  end;
  List.Add(format('%s Zeit: %s', [aText, Time]));
  List.SaveToFile(logfile);
  List.Destroy;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
var
  FSA : SECURITY_ATTRIBUTES;
  FSD : SECURITY_DESCRIPTOR;
begin
  WriteToLogfile('Started');
   InitializeSecurityDescriptor(@FSD, SECURITY_DESCRIPTOR_REVISION);
   SetSecurityDescriptorDacl(@FSD, True, nil, False);
   FSA.lpSecurityDescriptor := @FSD;
   FSA.nLength := sizeof(SECURITY_ATTRIBUTES);
   FSA.bInheritHandle := True; 

  try
    CreateNamedPipe(PipeName, PIPE_ACCESS_INBOUND, PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE or PIPE_NOWAIT, PIPE_UNLIMITED_INSTANCES, 4096, 4096, 50, @FSA);
    try
      PipeFileHandle := CreateFile(PipeName, GENERIC_READ, 0, @FSA, OPEN_EXISTING, 0, 0);
    except
      WriteToLogfile('CreateFile - '+SysErrorMessage(GetLastError));
    end;
  except
    WriteToLogfile('CreateNamedPipe - '+SysErrorMessage(GetLastError));
  end;

  Started := True;
end;

end.

Programm

Delphi-Quellcode:

program ServiceCaller;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

const
  PipeName = '\\.\pipe\CtrPipe';

type
  RPIPEMessage = record
    Size : Cardinal;
    Msg  : String;
  end;

function ProcessMsg(aMsg : RPIPEMessage): RPIPEMessage;
begin
  Result.Size := SizeOf(Result);
  if WaitNamedPipe(PChar(PipeName), 10) then
    if not CallNamedPipe(
      PChar(PipeName), @aMsg, aMsg.Size, @Result, Result.Size, Result.Size, 3000
    ) then begin
      Writeln(SysErrorMessage(GetLastError));
      Readln;
    end;
end;

var
  Pipe   : THandle;
  inmsg, outmsg : RPIPEMessage;
begin

  inmsg.Msg := 'test';
  inmsg.Size := sizeof(inmsg);

  Writeln(inmsg.Msg);
  outmsg := ProcessMsg(inmsg);
  Writeln(outmsg.Msg);
  Readln;
end.

Bin für alles offen.

[Dezipaitor]

Schau mal (abseits von der Security), wie ich das gemacht habe. Dein Serverbeispiel ist nämlich grundlegend falsch.
http://jedi-apilib.svn.sourceforge.n...s/Pipe/Access/

Die DPR-Dateien dort, kannst du direkt ansehen (view).

[quendolineDD]

Danke, das hat mir nun wirklich das Verständnis für die Sache gebracht.

Ich muss nun erstmal das mit den Sicherheitsregeln in Erfahrung bringen...

Edit:
Kennst jemand ein Tutorial, wo das mit den SIDs / Richtlinien irgendwo erklärt ist?

[Dezipaitor]

Schwerlich wird gutes Material zum Thema SID, DACL und SecurityDescriptor zu finden sein.
Codeproject hat einige Artikel dazu, die jedoch eher schlecht als recht sind - imho. Das mag jedoch auch am Thema liegen.
http://www.codeproject.com/info/sear...rityDescriptor

Was würde dich denn abhalten die JWSCL zu verwenden?

[quendolineDD]

Das werd ich mir alles mal noch zu gemüte führen, dank dir. Selbst die MSDN liefert keine wirklichen Informationen zu ihren Structures, außer das dise variativ (variiren kann) ist.

Für mich ergibt sich noch das Problem: Unter welchen Umständen kann es passieren, dass das Erstellen einer Named Pipe (CreateNamedPipe) nicht erlaubt ist? Rein rechtemäßig.
Auf den Rechnern bei uns am BSZ kann ich dan dem Projekt nur unter Admin-Konto arbeiten, obwohl ich als Privat-Konto Dienste erstellen kann, wobei dann ja der Dienst im System-Konto laufen müsste und die Pipe erstell können dürfte ...

Als ich mich im lokalen Administrator-Konto eingeloggt habe, ging alles ohne Probleme, ansonsten habe ich ein INVALIDE_HANDLE_VALUE erhalten ...

Zu deiner Frage Dezipaitor:

Im Prozess der Lernphase mag ich lieber das Rad neu erfinden und es voll und ganz vestehen als mich nur der äußeren Umstände bewusst zu sein. :-)
Ich hab eure Sachen zwar in einigen Projekten schon bewusst genutzt, jedoch störte mich hier in der JwWindows ein Fehler in der Adressierung einer Api ...

[Dezipaitor]

Zitat:

Zitat von quendolineDD

Für mich ergibt sich noch das Problem: Unter welchen Umständen kann es passieren, dass das Erstellen einer Named Pipe (CreateNamedPipe) nicht erlaubt ist? Rein rechtemäßig.

1. Es existiert bereits eine Pipe mit dem Namen.
2. Pipe-Typ muss bei Verbinden derselbe sein, wie beim Erstellen.
3. (Kann mir gerade keine weiteren denken)

Zitat:

Zitat von quendolineDD

Auf den Rechnern bei uns am BSZ kann ich dan dem Projekt nur unter Admin-Konto arbeiten, obwohl ich als Privat-Konto Dienste erstellen kann, wobei dann ja der Dienst im System-Konto laufen müsste und die Pipe erstell können dürfte ...

Dienste starten/beenden/erstellen kann man nur mit Adminrechten (by default).
Die Pipe läuft auch mit normalen Rechten, da das damit garnichts zu tun hat.
Dein Code erstellt eine leere DACL (SetSecurityDescriptorDacl), welche jeden Zugriff auf die PIPE sperrt.
leere DACL = totale Verweigerung
nil DACL = totaler Zugriff erlaubt

BSZ???

Zitat:

Zitat von quendolineDD

Als ich mich im lokalen Administrator-Konto eingeloggt habe, ging alles ohne Probleme, ansonsten habe ich ein INVALIDE_HANDLE_VALUE erhalten ...

Was, wie, wo, GetLastError?

Zitat:

Zitat von quendolineDD

Im Prozess der Lernphase mag ich lieber das Rad neu erfinden und es voll und ganz vestehen als mich nur der äußeren Umstände bewusst zu sein. :-)

Habe ich nichts dagegen und bin ich völlig dafür, aber das konnte ich ja nicht wissen :gruebel:

Zitat:

Zitat von quendolineDD

Ich hab eure Sachen zwar in einigen Projekten schon bewusst genutzt, jedoch störte mich hier in der JwWindows ein Fehler in der Adressierung einer Api ...

Drei Dinge interessieren mich dabei:
1. Welche Projekte und wie und was benutzt?
2. Was für ein Fehler ist das denn? :wiejetzt: Etwas genauer bitte!
3. Warum hast du keine Meldung gemacht? :wall:

[quendolineDD]

Konnte den Fehler mit der Pipe heute nicht reproduzieren, wer weiß ... Liegt wohl am Wetter ;-)
Läuft nun alles wie geschmiert, bekommt nur noch einen kleinen Schliff bzgl. DACL.

BSZ = Berufliches Schulzentrum :D

Ich schau nochmal zu Hause nach dem auftretenden Fehler, geht hier gerade nicht ....

EDIT:

Also der Fehler kommt schon recht am Anfang.

[Fehler] JwsclToken.pas(4311): Inkompatible Typen: 'JwaWindows._SID' und 'JwaWinNT._SID'

Delphi-Quellcode:

mL.Label_.Sid := MandatorySid.CreateCopyOfSID;

[Dezipaitor]

Alles klar:

Das ist ein Standardfehler beim Einbinden von JwaWindows.pas und rührt daher, dass nie jemand die Anleitung liest:
http://blog.delphi-jedi.net/2008/03/...o-setup-jwscl/

[quendolineDD]

:wall: Ich hab mir lediglich die in den Textdateien mitgelieferten Instructions angeschaut, mag aber auch sein das ich es übersehen habe ...

[quendolineDD]

An sich klappt nun alles wie gewollt ;-)

Nun steht ja in der While-Schleife meines Services in der Reihenfolge ConnectNamedPipe -> Readfile -> DisconnectNamedPipe (stark vereinfacht ;-) ) nachdem letztmaligen Verbinden eines Clients der Service wieder bei ConnectNamedPipe ... Wenn ich jetzt den Service über services.msc beenden will "hängt" er ja an dieser Stelle.
Für meinen Service nutz ich gleich das von Delphi mitgelieferte "Serviceanwendung". Muss ich dafür das ganze mit dem Service selber schreiben um den Hauptthread beenden zu können ?! Bzw. kann ich an einer Stelle im TService einspringen um das ganze zu kontrollieren?