Lazarus. Daemon/Service

unit Posix.Daemon;

// http://blog.paolorossi.net/2017/09/04/building-a-real-linux-daemon-with-delphi-part-2/

// The standard location of syslog log is /var/log/syslog
// tail -f /var/log/syslog

interface

uses
  System.SysUtils,
  System.IOUtils,
  Posix.Stdlib,
  Posix.SysStat,
  Posix.SysTypes,
  Posix.Unistd,
  Posix.Signal,
  Posix.Fcntl,
  Log;

procedure InitDaemon;

var
  pid, sid: pid_t;
  fid: Integer;
  Running: Boolean;

const
  // Missing from linux/StdlibTypes.inc !!! <stdlib.h>
  EXIT_FAILURE = 1;
  EXIT_SUCCESS = 0;

implementation

// 1. If SIGTERM is received, shut down the daemon and exit cleanly.
// 2. If SIGHUP is received, reload the configuration files, if this applies.
procedure HandleSignals(SigNum: Integer); cdecl;
begin
  case SigNum of
    SIGTERM:
    begin
      Running := False;
    end;
    SIGHUP:
    begin
      StrToLog('daemon: reloading config');
      // Reload configuration
    end;
  end;
end;


procedure InitDaemon;
var
  idx: Integer;
const
  Debug = False;
  WriteStdOut = False;
  Sequrity = False;
  ChangeDir = False;
begin
  // If the parent process is the init process then the current process is already a daemon
  // Remarks: this check here
	if getppid() = 1 then
  begin
    if Debug then StrToLog('Nothing to do, I''m already a daemon');
    Exit; // already a daemon
  end;

  if Debug then StrToLog('before 1st fork() - original process');

  // Call fork(), to create a background process.
  pid := fork();

  if Debug then StrToLog('after 1st fork() - the child is born');

  if pid < 0 then
    raise Exception.Create('Error forking the process');

  // Call exit() in the first child, so that only the second
  // child (the actual daemon process) stays around
  if pid > 0 then
    Halt(EXIT_SUCCESS);

  if Debug then StrToLog('the parent is killed!');

  // This call will place the server in a new process group and session and
  // detaches its controlling terminal
  sid := setsid();
  if sid < 0 then
    raise Exception.Create('Impossible to create an independent session');

  if Debug then StrToLog('session created and process group ID set');

  // Catch, ignore and handle signals
  signal(SIGCHLD, TSignalHandler(SIG_IGN));
  signal(SIGHUP, HandleSignals);
  signal(SIGTERM, HandleSignals);

  if Debug then StrToLog('before 2nd fork() - child process');

  // Call fork() again, to be sure daemon can never re-acquire the terminal
  pid := fork();

  if Debug then StrToLog('after 2nd fork() - the grandchild is born');

  if pid < 0 then
    raise Exception.Create('Error forking the process');

  // Call exit() in the first child, so that only the second child
  // (the actual daemon process) stays around. This ensures that the daemon
  // process is re-parented to init/PID 1, as all daemons should be.
  if pid > 0 then
    Halt(EXIT_SUCCESS);
  if Debug then StrToLog('the 1st child is killed!');
  StrToLog('Daemon creation is done.');

  // Open descriptors are inherited to child process, this may cause the use
  // of resources unneccessarily. Unneccesarry descriptors should be closed
  // before fork() system call (so that they are not inherited) or close
  // all open descriptors as soon as the child process starts running

  idx:=0;
  if idx<>0 then;
  
  if not WriteStdOut then begin
    // Close all opened file descriptors (stdin, stdout and stderr)
    for idx := sysconf(_SC_OPEN_MAX) downto 0 do
      __close(idx);

    if Debug then StrToLog('file descriptors closed');

    // Route I/O connections to > dev/null

    // Open STDIN
    fid := __open('/dev/null', O_RDWR);
    // Dup STDOUT
    dup(fid);
    // Dup STDERR
    dup(fid);

    if Debug then StrToLog('stdin, stdout, stderr redirected to /dev/null');
  end;

  if Sequrity then begin
    // Set new file permissions:
    // most servers runs as super-user, for security reasons they should
    // protect files that they create, with unmask the mode passes to open(), mkdir()
    // Restrict file creation mode to 750
  	umask(027);
    if Debug then StrToLog('file permission changed to 750');
  end;

  if ChangeDir then begin
    // The current working directory should be changed to the root directory (/), in
    // order to avoid that the daemon involuntarily blocks mount points from being unmounted
    chdir('/');
    if Debug then StrToLog('changed directory to "/"');
  end;
end;

end.