You are not logged in.
Pages: 1
Hi ab,
I would like to start my http server in the background on Linux. I tested ./SERVERNAME with '&' but it doesn't work. Do you have some ideas ?
Thank you
Delphi 2010 - Delphi XE5 (x64 Apps) - CodeTyphon - Typhon IDE v 5.7 - FPC 3.1.1 - mORMot 1.18
Windows 7 - VirtualBox : Linux Debian 8.5 Jessie 32 bits
Offline
Run the executable as a Linux daemon.
There are plenty of scripts around, allowing to do so.
Just ensure that your server won't use the console as interaction.
You would have to run it in a given blocking mode.
Offline
I just post the complete FPC mORMot daemon code, in case anybody else has also some use for it !
program RestServerLinuxARMDaemon;
{$mode objfpc}{$H+}
{$define UseCThreads}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
sysutils,
Classes,
mORMotHttpServer,
RESTData,
RESTServerClass,
daemonapp;
Type
{ TTestDaemon }
TTestDaemon = Class(TCustomDaemon)
Private
fORMServer: TSOHITServer;
fHTTPServer: TSQLHttpServer;
public
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;
end;
{ TTestThread }
Procedure AWriteln(MSg : String; B : Boolean);
begin
Application.Log(etcustom,Msg+BoolToStr(B));
end;
{ TTestDaemon }
function TTestDaemon.Start: Boolean;
begin
Result:=inherited Start;
AWriteln('Daemon Start',Result);
AWriteln('Dir: '+GetAppConfigDir(False)+'data',True);
if not DirectoryExists(GetAppConfigDir(False))
then CreateDir(GetAppConfigDir(False));
fORMServer := TSOHITServer.Create(GetAppConfigDir(False)+'data','root');
fHTTPServer := TSQLHttpServer.Create(HTTP_PORT,[fORMServer]);
end;
function TTestDaemon.Stop: Boolean;
begin
Result:=inherited Stop;
AWriteln('Daemon Stop: ',Result);
FreeAndNil(fHTTPServer);
FreeAndNil(fORMServer);
end;
function TTestDaemon.Pause: Boolean;
begin
Result:=inherited Pause;
AWriteln('Daemon pause: ',Result);
end;
function TTestDaemon.Continue: Boolean;
begin
Result:=inherited Continue;
AWriteln('Daemon continue: ',Result);
end;
function TTestDaemon.Execute: Boolean;
begin
Result:=inherited Execute;
AWriteln('Daemon execute: ',Result);
end;
function TTestDaemon.ShutDown: Boolean;
begin
Result:=inherited ShutDown;
AWriteln('Daemon Shutdown: ',Result);
Try
Try
FreeAndNil(fHTTPServer);
Except
End;
Finally
FreeAndNil(fORMServer);
End;
end;
function TTestDaemon.Install: Boolean;
begin
Result:=inherited Install;
AWriteln('Daemon Install: ',Result);
end;
function TTestDaemon.UnInstall: boolean;
begin
Result:=inherited UnInstall;
AWriteln('Daemon UnInstall: ',Result);
end;
Type
{ TTestDaemonMapper }
TTestDaemonMapper = Class(TCustomDaemonMapper)
Constructor Create(AOwner : TComponent); override;
end;
{ TTestDaemonMapper }
constructor TTestDaemonMapper.Create(AOwner: TComponent);
Var
D : TDaemonDef;
begin
inherited Create(AOwner);
D:=DaemonDefs.Add as TDaemonDef;
D.DisplayName:='Test daemon';
D.Name:='TestDaemon';
D.DaemonClassName:='TTestDaemon';
D.WinBindings.ServiceType:=stWin32;
end;
begin
RegisterDaemonClass(TTestDaemon);
RegisterDaemonMapper(TTestDaemonMapper);
Application.Title:='Daemon test application';
Application.Run;
end.
And the systemd script:
[Unit]
Description=mORMot server
After=network.target
[Service]
User=superdad
Type=simple
ExecStart=/home/superdad/tmp/daemon -r
RemainAfterExit=yes
TimeoutSec=25
[Install]
WantedBy=multi-user.target
Last edited by AOG (2015-09-17 15:27:57)
Offline
Thank you for your help AOG. It will be very usefull
Delphi 2010 - Delphi XE5 (x64 Apps) - CodeTyphon - Typhon IDE v 5.7 - FPC 3.1.1 - mORMot 1.18
Windows 7 - VirtualBox : Linux Debian 8.5 Jessie 32 bits
Offline
It looks like the daemon code posted by AOG need to be updated in order to compile. I can not find a class called TSOHITServer in the mORMot source code.
TSOHITServer should be AOG's derived class, but not a class included by the mORMot framework...
Delphi XE4 Pro on Windows 7 64bit.
Lazarus trunk built with fpcupdelux on Windows with cross-compile for Linux 64bit.
Offline
Here is a simple implementation of a FPC/Lazarus/Codetyphon daemon
program eventserv;
//{$define Debug}
uses
{$ifdef linux}
cthreads,
cmem, // the c memory manager is on some systems much faster for multi-threading
{$endif}
sysutils,classes,unix, baseunix,lnet;
type
{ TLTCPTest }
TLTCPServer = class
private
FCon: TLTCP; // THE server connection
procedure OnEr(const msg: string; aSocket: TLSocket);
procedure OnAc(aSocket: TLSocket);
procedure OnRe(aSocket: TLSocket);
procedure OnDs(aSocket: TLSocket);
public
constructor Create;
destructor Destroy; override;
procedure Run; // main loop with CallAction
end;
//===========================
Var
{ vars for daemonizing }
aOld,aTerm: pSigActionRec;
ps1 : psigset;
sSet : cardinal;
pid : pid_t;
zerosigs : sigset_t;
//err: LongInt;
//mypid:integer;
TCP: TLTCPServer;
//==================================================================================
procedure TLTCPServer.OnEr(const msg: string; aSocket: TLSocket);
begin
//aSocket.Disconnect(true);
{$ifdef DEBUG}
Writeln(logfile, datetimetostr(now)+' TCPServer ERROR: '+msg+' '+aSocket.PeerAddress+CR+LF);
{$endif}
end;
//==================================================================================
procedure TLTCPServer.OnAc(aSocket: TLSocket);
begin
//if BLACKLIST.Find(aSocket.PeerAddress,ind) then aSocket.Disconnect(True);
{$ifdef DEBUG}
//Writeln(logfile, datetimetostr(now)+' Accepted connection from: '+aSocket.PeerAddress+CR+LF);
{$endif}
end;
//==================================================================================
procedure TLTCPServer.OnDs(aSocket: TLSocket);
begin
// Writeln('Lost connection'); // write info if connection was lost
end;
//==================================================================================
procedure TLTCPServer.OnRe(aSocket: TLSocket); // on recieve message
begin
///////////////////////////////////////// your functionality
end;
//==================================================================================
constructor TLTCPServer.Create;
begin
FCon := TLTCP.Create(nil); // create new TCP connection
FCon.OnError := @OnEr; // assign all callbacks
FCon.OnReceive := @OnRe;
FCon.OnDisconnect := @OnDs;
FCon.OnAccept := @OnAc;
FCon.Timeout := 150; // responsive enough, but won't hog cpu
FCon.ReuseAddress := True;
end;
//==================================================================================
destructor TLTCPServer.Destroy;
begin
FCon.Free; // free the TCP connection
inherited Destroy;
end;
//=================================== MAIN PROC ============================
procedure TLTCPServer.Run;
var counter,i:integer;
myport:word;
begin
///..............
if FCon.Listen(myPort) then
begin // if listen went ok
repeat
inc(counter);
FCon.Callaction; // eventize the lNet
// some to do
until Quit; // until user quit
end;// else // listen
{$ifdef DEBUG}
// Writelog(datetimetostr(now)+' Listener not start!!! Port may be busy!!!');
{$endif} ;
end;
{ handle SIGTERM }
//==================================================================================================
procedure DoSig(sig : longint);cdecl;
begin
case sig of
SIGTERM : Quit := true;
end;
//---
{$ifdef DEBUG}
Writeln(logfile, datetimetostr(now)+' Closed by SIGTERM');
CloseFile(logfile);
{$endif}
end;
//==================================================================================================
procedure RunDaemon();
begin
//writeln('Connecting...');
{$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 }
deletefile(iam);
pid := fpFork;
case pid of
0 : begin { we are in the child }
Close(input); { close standard in }
Assign(input,'/dev/null');
ReWrite(input);
Close(output); { close standard out }
Assign(output,'/dev/null');
ReWrite(output);
Close(stderr); { close standard error }
pid:=fpGetPid;
//createpidfile(pid);
end;
-1 :begin
//WriteLn('forking error, process not demonized!');
halt(1);
end;
else begin
//Halt;
FpExit(0);{ successful fork, so parent dies }
end;
end;
//------------------------------------
if isroot then
begin
TCP := TLTCPServer.Create;
TCP.Run;
TCP.Free;
end;
//------------------------------------
//deletefile(mypath+'d.pid');
end;
//==================================================================================================
Begin
//remotekilled:=false;
mypath:=extractfilepath(paramstr(0));
iam:=paramstr(0);
isroot:=true;
//**Check for superuser rights**
if fpGetUID <> 0 then
begin
//Writeln('Error: Need superuser rights');
isroot:=false;
//halt;
end;
RunDaemon;
End.
Offline
Hello everyone,
I finally found sometime to setup a linux VM and until now everything has been smooth ( fpcupdeluxe gave me big push here), now I want to make a simple daemon for querying static data I already have on a SQLite .db file, I post on this thread because it is sticked out here and I have one simple question related to linux servers.
Seems like I have to put these compiler directives on my lpr :
{$I Synopse.inc}
uses
...
{$I SynDprUses.inc}
...
Will that be enough ? Or there is any other directive I have to add
I'm working with current trunk ( Lazarus & FPC ) and the version mORMot which TestSQL3 reports is:
Using mORMot 1.18.3765 FTS3
Running on Linux-4.4.0-88-generic #111-Ubuntu SMP Thu Jul 20 09:32:39 UTC 2017
TSQLite3LibraryStatic 3.19.2 with internal MM
Generated with: Free Pascal 3.1.1 MOP 64 bit compiler
Thank you
Offline
Check https://synopse.info/files/html/Synopse … l#TITL_143
Information here is not fully applying to FpcUpDeluxe, but you got the information about .inc files.
Offline
I'll share this tip, which I found when searching for a simpler solution.
$ (./my_app &) &
Obviously is not a complete Daemon, but It Works!
And you do not need to modify the application.
Offline
Check this thread too
https://synopse.info/forum/viewtopic.php?id=6395
Last edited by dcoun (2022-10-28 14:50:45)
Offline
Pages: 1