Службы WinNT и демоны Unix

[shade]

Несколько раз поднимался этот вопрос и ни разу не видел нормального полноценного ответа.

А вот сейчас копаясь с примерами решил поднять эту тему.

Во-первых для определенности
Службами будем называть службы WindowsNT
Демонами будем называть Unix-демонов

1. Для тех кто писал службы WinNT на Delphi использовали WinSvc,
в FPC этот модуль есть, в пакетах и называется он jwaWinSvc. Так что все что было применимо в Delphi, можно с успехом использовать на FPC

2. В FCL (fcl-base) есть свой модуль для создания служб и демонов - юнит daemonapp - надо полагать кроссплатформное решение для написания служб и демонов.

ранее обсуждалось:
Демоны http://freepascal.ru/forum/viewtopic.php?t=2212&start=0
Службы http://freepascal.ru/forum/viewtopic.ph ... ht=service

[Replicator]

О, не замечал этого модуля. Надо присмотреться, спасибо.

[Attid]

про службы не смотрел, а про демонов вроде все описанно, или ты хауту решил собрать ?

[shade]

Для начала поковырять и сделать примерчики, а там может и howto напишется, но не буду обещать.

[Attid]

ну про демонов пример тут он и простой и все показывает, причем еще под BSD должен работать =)

а встроеный пакет в лазаре смотрел ? что там намудрили ?

[shade]

Классы выглядят многообещающе:

Код: Выделить всё

  TCustomDaemon = Class(TDataModule)
  private
    FController: TDaemonController;
    FDaemonDef: TDaemonDef;
    FThread : TThread;
    FStatus: TCurrentStatus;
    function GetLogger: TEventLog;
    procedure SetStatus(const AValue: TCurrentStatus);
  Protected
    Function Start : Boolean; virtual;
    Function Stop : Boolean; virtual;
    Function Pause : Boolean; virtual;
    Function Continue : Boolean; virtual;
    Function Execute : Boolean; virtual;
    Function ShutDown : Boolean; virtual;
    Function Install : Boolean; virtual;
    Function UnInstall: boolean; virtual;
    Function HandleCustomCode(ACode : DWord) : Boolean; Virtual;
  Public
    Procedure LogMessage(Msg : String);
    Procedure ReportStatus;
   
    // Filled in at runtime by controller
    Property Definition : TDaemonDef Read FDaemonDef;
    Property DaemonThread : TThread Read FThread;
    Property Controller : TDaemonController Read FController;
    Property Status : TCurrentStatus Read FStatus Write SetStatus;
    Property Logger : TEventLog Read GetLogger;
  end;

  TCustomControlCodeEvent = Procedure(Sender : TCustomDaemon; ACode : DWord; Var Handled : Boolean) of object;

  TDaemon = Class(TCustomDaemon)
  private
    FAfterInstall: TDaemonEvent;
    FAfterUnInstall: TDaemonEvent;
    FBeforeInstall: TDaemonEvent;
    FBeforeUnInstall: TDaemonEvent;
    FOnContinue: TDaemonOKEvent;
    FOnCustomControl: TCustomControlCodeEvent;
    FOnExecute: TDaemonEvent;
    FOnPause: TDaemonOKEvent;
    FOnShutDown: TDaemonEvent;
    FOnStart: TDaemonOKEvent;
    FOnStop: TDaemonOKEvent;
  Protected
    Function Start : Boolean; override;
    Function Stop : Boolean; override;
    Function Pause : Boolean; override;
    Function Continue : Boolean; override;
    Function Execute : Boolean; override;
    Function ShutDown : Boolean; override;
    Function Install : Boolean; override;
    Function UnInstall: boolean; override;
    Function HandleCustomCode(ACode : DWord) : Boolean; Override;
  Public
    Property Definition;
    Property Status;
  Published
    Property OnStart : TDaemonOKEvent Read FOnStart Write FOnStart;
    Property OnStop : TDaemonOKEvent Read FOnStop Write FOnStop;
    Property OnPause : TDaemonOKEvent Read FOnPause Write FOnPause;
    Property OnContinue : TDaemonOKEvent Read FOnContinue Write FOnContinue;
    Property OnShutDown : TDaemonEvent Read FOnShutDown Write FOnShutDown;
    Property OnExecute : TDaemonEvent Read FOnExecute Write FOnExecute;
    Property BeforeInstall : TDaemonEvent Read FBeforeInstall Write FBeforeInstall;
    Property AfterInstall : TDaemonEvent Read FAfterInstall Write FAfterInstall;
    Property BeforeUnInstall : TDaemonEvent Read FBeforeUnInstall Write FBeforeUnInstall;
    Property AfterUnInstall : TDaemonEvent Read FAfterUnInstall Write FAfterUnInstall;
    Property OnControlCode : TCustomControlCodeEvent Read FOnCustomControl Write FOnCustomControl;
  end;

[shade]

Реализация Windows NT службы готова может есть еще глюки, но покрайней мере устанавливается, запускается, приостанавливается, возобновляется, останавливается, удаляется.

Тестируем.

[Attid]

подниму ка я тему.

вопрос про линукс, у меня там демон запускает програмку и следит за тем чтобы она не упала, если падает логируем


сокращено вот так

Код: Выделить всё

     while (FpWaitPid(pid,@status,WNOHANG) = 0) do
     begin
       sleep(1000);
     end;
     AddLog('Programm with pid '+IntToStr(pid)+' exit whith code '+IntToStr(status));


в логах потом вижу что пограмка выходит с кодами 139 и 15, может еще что есть, но эти самы частые. вопрос где описывается что означают эти цифры ?

[shade]

Хм.. а можете ещё добавить перенаправление stderr и его логирование? Ну по крайней мере будет проще разобраться.

[Attid]

да как бы это пока не напрягает, так просто читал логи смотрю есть непонятные сообщения.

а так если упал програм то так ему и надо, запускается следующий экземпляр.та програмка может и сама выходить при определеных командах "так спроектированно" типа.

[Timid]

Кстати, как настроить реакцию системы если демон или служба "упали". Ну, чтобы рестартовать их снова.
Пока знаю два пути, запускать вспомогательную службу (демон), проверяющий наличие первого. Использовать "запуск по расписанию" с семафорами на проверку дубликата - предыдущего уже запущенного экземпляра службы. Есть еще какие-нибудь идеи?

[Attid]

по расписанию никуда не годится.

так что только следить другим демоном, в фодоре вроде есть специальный демон для этого, в остальных самому писать =)

[dionic]

ну про демонов пример тут он и простой и все показывает, причем еще под BSD должен работать =)

а встроеный пакет в лазаре смотрел ? что там намудрили ?

Attid , подскажите плиз еще раз ссылочку с примером демона, а то эта что-то не работает. И если знаете где можно взять примеры работы daemonapp напишите если не сложно.

[Attid]

я себе не сохранял этот файл
вот то что работает у меня (собирал еще на старой версии фпц на последней возможно нужно что-то править)

Код: Выделить всё

program acKerneld;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  SysUtils,BaseUnix, uConst;

Var
   { vars for daemonizing }
   bTerm : boolean;
   aOld,
   aTerm: pSigActionRec;
   ps1  : psigset;
   sSet : cardinal;
   pid  : pid_t;
   zerosigs : sigset_t;
   status: integer;

{ handle SIGTERM }
procedure DoSig(sig : longint);cdecl;
begin
   case sig of
      SIGTERM : bTerm := true;
   end;
end;

procedure AddLog(str : string);
begin
  AddText2File(DateTimeMs2Str(Now)+' '+str,ChangeFileExt(ParamStr(0),'.log'));
end;




Begin
   {$hints off}
   FpsigEmptySet(zerosigs);
   {$hints on}
   { set global daemon booleans }
   bTerm := false;

   { block all signals except -TERM }
   sSet := $ffffbffe;
   ps1 := @sSet;
   fpsigprocmask(sig_block,ps1,nil);

   { setup the signal handlers }
   new(aOld);
   new(aTerm);
   aTerm^.sa_handler{.sh} := SigactionHandler(@DoSig);

   aTerm^.sa_mask := zerosigs;
   aTerm^.sa_flags := 0;
   fpSigAction(SIGTERM,aTerm,aOld);
   { daemonize }
   pid := fpFork;
   case pid of
      0 : begin { we are in the child }
         Close(input);  { close standard in }
         Close(output); { close standard out }
         Assign(output,'/dev/null');
         ReWrite(output);
         Close(stderr); { close standard error }
         Assign(stderr,'/dev/null');
         ReWrite(stderr);
      end;
      -1 :begin
            WriteLn('forking error, so halt 1');
            halt(1);
          end;
     else begin
          Halt;          { successful fork, so parent dies }
          end;
   end;
   AddLog('Daemon start');
   { begin processing loop }
   repeat
     pid := fpFork;
     case pid of
        0 : begin { we are in the child }
              FpExecv(ExtractFilePath(ParamStr(0))+'ackernel2',nil);
              fpExit(127); //If the execve fails, we return an exitvalue of 127
            end;
       -1 : begin
              WriteLn('running error, so halt 2');
              halt(2);
            end;
     else   begin
              AddLog('Programm running, pid = '+IntToStr(pid));
            end;
     end;

     while (FpWaitPid(pid,@status,WNOHANG) = 0) do
     begin
       sleep(1000);
       if bTerm then
       begin
         AddLog('Demon was terminate.');
         status := FpKill(pid,SIGKILL);
         AddLog('Programm with pid '+IntToStr(pid)+' was killed, return '+IntToStr(status));
         FpExit(0);
       end;
     end;

     AddLog('Programm with pid '+IntToStr(pid)+' exit whith code '+IntToStr(status));

   Until bTerm;
   
End.