PDA

View Full Version : Howto write a server that runs on linux with freepascal



noeska
06-09-2008, 03:07 PM
FreePascal
Linux
Server

Who knows a bare bones example on how to write a server that runs on linux with freepascal?

technomage
06-09-2008, 07:03 PM
There is an example that ships with freepascal called daemon.pp, it gives you the basics.

noeska
06-09-2008, 07:09 PM
It is not in my examples folder. Where can i download daemon.pp ?

JSoftware
06-09-2008, 09:39 PM
It's in the source packet

Lowercase
15-09-2008, 06:52 AM
hi !
don't know if it's efficient, but look at this


unit Daemon;

{************************************************* ************************************************}
{ }
{ Borland Community Chatbot }
{ Copyright (c) 2002 Dave Nottage }
{ }
{ This program is free software; you can redistribute it and/or modify it under the terms of the }
{ GNU General Public License as published by the Free Software Foundation; either version 2 of }
{ the License, or (at your option) any later version. }
{ }
{ This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; }
{ without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. }
{ See the GNU General Public License for more details. }
{ }
{ You should have received a copy of the GNU General Public License along with this program; }
{ if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, }
{ MA 02111-1307 USA }
{ }
{ Original author: Dave Nottage }
{ Email: davidn@smartchat.net.au }
{ Snail mail: Borland Community Chatbot, 1 Victoria St, MILE END, SA, 5031, Australia }
{ }
{************************************************* ************************************************}

{************************************************* *********}
{ Borland Chat Daemonizer }
{************************************************* *********}

interface

type
TDaemonApplication = class(TObject)
private
FTerminated: Boolean;
FPID: pid_t;
FStdOutput: string;
FErrOutput: string;
FDetach: Boolean;
procedure InstallSignalHandlers;
procedure PerformDaemonMagic;
protected
function Daemonize: Boolean; virtual;
procedure DoSigHup; virtual;
procedure DoSigTerm; virtual;
procedure DoSigQuit; virtual;
public
constructor Create;
procedure Run;
property Detach: Boolean read FDetach write FDetach; // determines whether to fork or not.
property ErrorOutput: string read FErrOutput write FErrOutput; // change to setter method so it is dynamic
property PID: pid_t read FPID;
property StandardOutput: string read FStdOutput write FStdOutput;
property Terminated: boolean read FTerminated;
end;

var
Application: TDaemonApplication = nil;

implementation

uses
Libc;

{ handle SIGHUP & SIGTERM }
procedure DoSig(sig: longint); cdecl;
begin
case sig of
SIGHUP:
// Dispatch SIGHUP
Application.DoSigHup;
SIGTERM:
// Dispatch SIGTERM
Application.DoSigTerm;
SIGQUIT:
// Dispatch SIGQUIT
Application.DoSigQuit;
end;
end;

constructor TDaemonApplication.Create;
begin
inherited Create;
FStdOutput := '/dev/null'; // change to a constant (non-localised)
FErrOutput := '/dev/null';
FTerminated := False;
FDetach := True;
end;

procedure TDaemonApplication.PerformDaemonMagic;
begin
setsid()
// http://www.erlenstar.demon.co.uk/unix/faq_2.html#SEC16
Close(Input);
AssignFile(Output, FStdOutput);
Rewrite(Output);
AssignFile(ErrOutput, FErrOutput);
Rewrite(ErrOutput);
end;

function TDaemonApplication.Daemonize: Boolean;
begin
{ daemonize }
if FDetach then
begin
FPID := fork();
case FPID of
0:
begin
PerformDaemonMagic;
__chdir('/');
end;
-1:
// Forking error
else
// Halt;
end;
end
else
Result := True;
end;

procedure TDaemonApplication.InstallSignalHandlers;
var
SignalAction: TSigAction;
SignalSet: TSigSet;
begin
{ block all signals except -HUP & -TERM }

sigfillset(SignalSet);

sigdelset(SignalSet, SIGHUP);
sigdelset(SignalSet, SIGTERM);

pthread_sigmask(SIG_BLOCK, @SignalSet, nil);

{ setup the signal handlers }
FillChar(SignalAction, SizeOf(SignalAction), 0);
SignalAction.__sigaction_handler := @DoSig;
sigaction(SIGTERM, @SignalAction, nil);

FillChar(SignalAction, SizeOf(SignalAction), 0);
SignalAction.__sigaction_handler := @DoSig;
sigaction(SIGHUP, @SignalAction, nil);

end;

procedure TDaemonApplication.Run;
begin
if Daemonize then
begin
InstallSignalHandlers;
while not FTerminated do
begin
// Here we will allow whatever hooks into the daemon application, to
// do their thing.
// RunDataModules;
end;
end;
end;

procedure TDaemonApplication.DoSigTerm;
begin
FTerminated := True;
end;

procedure TDaemonApplication.DoSigHup;
begin

end;

procedure TDaemonApplication.DoSigQuit;
begin

end;

initialization
Application := TDaemonApplication.Create;

finalization
Application.Free;

end.

noeska
19-04-2010, 02:21 PM
Sorry for digging up this old post of mine, but i am still strugling with daemon.pp and how it is supposed to work. It should also work under windows? But compiling it with fpc under windows and linux it is not giving me an working example. It think it should write some info to an log file? But where is that log file?

pjpdev
19-04-2010, 05:10 PM
Hi noeska...

If you're using Lazarus theres a package you can install called lazdaemon. You'll find it in the available packages list in the "Configure packages" dialog. This'll give you a nice template that you can use when creating a new project.

User137
19-04-2010, 07:20 PM
Synapse works with Linux too. I made wrap up class to Next3D game engine, at least michalis said it compiled under Linux.
http://www.pascalgamedevelopment.com/forum/index.php?topic=6218.0
There is demo too of TCP and UDP server, sending and receiving different packets.

I know its possible to directly use Synapse but i'm not so keen on doing the complicated multi-threading stuff again every time for network projects :)

It doesn't rely on any visual component so it should work even without Lazarus.

noeska
20-04-2010, 04:17 PM
I dont use lazarus. I only use fpc.

As for the real webserver part i use indy. That part is already working but when starting the server then it blocks the console.

So i thought i need a daemon so i can start the server in the background. Any other alternatives or good documentation on the fpc daemon.pp example?

(btw this is a port from delphi (win32) to fpc (linux). Al that fails that i can start the server in the background so the console remains useable.

jdarling
20-04-2010, 05:47 PM
Noeska, your looking to Fork your execution, not Daemon execution. Daemon implies running as part of the Kernel or Kernel Group, while Forking simply means to execute in parallel with the current operations.

Look at launching a forked process (I have code some place if I can ever find it LOL), but until then read http://www.freepascal.org/docs-html/rtl/oldlinux/fork.html

- Jeremy

PS: Everyone is correct that Synapse has better cross platform than Indy. Though, if my reading has not deceived me, that may change soon. Also look at switching from Threading to Fiber execution as this will lower your overhead in both Linux and Windows. It will also get you out of having to worry about thread runaway and loading.

jdarling
20-04-2010, 06:00 PM
Oh yeah, and if you don't want to make ANY changes to your app, you can always add & to your call on the command line to run it in the background :)

Quick from http://linux.about.com/od/linux101/l/blnewbie3_3_1.htm
Example: MyApp &

NOTE: There is a space between app and the &. Of course if you had command line args you would do MyApp [args] &

- Jeremy

noeska
21-04-2010, 05:05 PM
Found an example linux 'daemon' code for freepascal: http://paste.pocoo.org/show/13316/
That does a fpFork. I did a rewrite on it to store the pid in an file. So on the second call to the application it finds the pid and does an
fpKill(oldpid, SIGTERM); to stop it again.

Now i am looking into FpSetuid to have it run under a specific user also.

noeska
22-04-2010, 08:12 PM
Finaly i made it work. I now have an daemon application that starts an indyhttp server and server pages for threads as an normal user.

The sourcecode:


{---------------------------------------------------------------------------

Filename..: daemon.pp
Programmer: Ken J. Wright / M van der Honing
Date......: 03/21/2000 / 20/04/2010

Purpose - Program to demonstrate construction of a Linux daemon.

Usage:
1) Compile this program.
2) Run it. You will be immediately returned to a command prompt.
3) Issue the command: ps ax|grep daemon. This will show you the process
id of the program "daemon" that you just ran.
4) Issue the command: tail -f daemon.log. This let's you watch the log file
being filled with the message in the code below. Press Ctrl/c to break
out of the tail command.
5) Issue the command: kill -HUP pid. pid is the process number you saw with
the ps command above. You will see that a new log file has been created.
6) Issue the command: kill -TERM pid. This will stop the daemon. Issuing the
ps command above, you will see that the daemon is no longer running.

-------------------------------<< REVISIONS >>--------------------------------
Ver | Date | Prog | Decription
-------+------------+------+--------------------------------------------------
1.00 | 03/21/2000 | kjw | Initial release.
1.01 | 03/21/2000 | kjw | Forgot to close input, output, & stderr.
1.10 | 20/04/2010 | mvdh | Store PID and do autokill when already running
1.11 | 21/04/2010 | mvdh | Added simple indy http server
1.12 | 22/04/2010 | mvdh | Server starts as root but uses user in threads
------------------------------------------------------------------------------
}

Program Daemon;
{$mode delphi}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
SysUtils,
BaseUnix,
IdBaseComponent,
IdComponent,
IdTCPServer,
IdCustomHTTPServer,
IdHTTPServer,
IdContext,
IdCustomTCPServer,
IdSocketHandle,
IdThread;

type
TMyWebProg = class(TObject)
protected
IdHTTPServer1: TIdHTTPServer;
procedure IdOnBeforeListenerRun(AThread: TIdThread);
procedure IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
public
constructor Create;
destructor Destroy; override;
end;

Var
{ vars for daemonizing }
bHup,
bTerm : boolean;
fLog : text;
fPid : text;
fTest : text;
logname : string;
pidname : string;
aOld,
aTerm,
aHup : pSigActionRec;
ps1 : psigset;
sSet : cardinal;
pid : pid_t;
oldpid : pid_t;
secs : longint;
zerosigs : sigset_t;
hr,mn,sc,sc100 : word;
myserver: TMyWebProg;


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

{ open the log file }
Procedure NewLog;
Begin
Assign(fLog,logname);
Rewrite(fLog);
Writeln(flog,'Log created at ',formatdatetime('hh:nn:ss',now));
Close(fLog);
End;

{ open the log file }
Procedure SavePid(apid: integer);
Begin
Assign(fPid,pidname);
Rewrite(fPid);
Writeln(fPid,apid);
Close(fPid);
End;

{ save test file }
Procedure SaveTest(aname: string);
Begin
Assign(fTest,'/tmp/'+aname);
Rewrite(fTest);
Writeln(fTest,'test: ',formatdatetime('hh:nn:ss',now));
Close(fTest);
End;

{ open the log file }
Procedure LoadPid(var apid: integer);
var
s: ansistring;
Begin
Try
Assign(fPid,pidname);
Reset(fPid);
Writeln(pidname);
Read(fPid,s);
Writeln(string(s));
Close(fPid);
apid := strtoint(s);
Except
apid := 0;
End;
End;

{ open the log file }
Procedure DeletePid();
Begin
Assign(fPid,pidname);
Rewrite(fPid);
Writeln(fPid,0);
Close(fPid);
End;

constructor TMyWebProg.Create;
var a : TIdSocketHandle;
begin
inherited Create;

idhttpserver1 := TIdHTTPServer.Create();
a:=idhttpserver1.Bindings.Add;
a.IP:='127.0.0.1';
a.port:=80;
idhttpserver1.DefaultPort := 25000;
idhttpserver1.AutoStartSession := True;
idhttpserver1.ServerSoftware := 'Test Web';
idhttpserver1.SessionState := True;
idhttpserver1.OnBeforeListenerRun := IdOnBeforeListenerRun;
idhttpserver1.active:=true;
idhttpserver1.OnCommandGet := IdHTTPServer1CommandGet;
end;

destructor TMyWebProg.Destroy;
begin
FreeAndNil(idhttpserver1);
inherited Destroy;
end;

procedure TMyWebProg.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
Begin
SaveTest('test0.txt');
AResponseInfo.ContentText:='hello';
End;

procedure TMyWebProg.IdOnBeforeListenerRun(AThread: TIdThread);
begin
//make threads run as user ...
fpSetGid(1000); //first change group
fpSetUid(1000);
end;

Begin

writeln('Program: ',ParamStr(0));
pidname := 'daemon.pid';
oldpid := 0;
LoadPid(oldpid);
writeln('oldpid: ',oldpid);

if oldpid=0 then
begin

logname := 'daemon.log';
secs := 10;
fpsigemptyset(zerosigs);

{ set global daemon booleans }
bHup := true; { to open log file }
bTerm := false;

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

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

aTerm^.sa_mask := zerosigs;
aTerm^.sa_flags := 0;
{$ifndef BSD} {Linux'ism}
aTerm^.sa_restorer := nil;
{$endif}
aHup^.sa_handler := SigactionHandler(@DoSig);
aHup^.sa_mask := zerosigs;
aHup^.sa_flags := 0;
{$ifndef BSD} {Linux'ism}
aHup^.sa_restorer := nil;
{$endif}
fpSigAction(SIGTERM,aTerm,aOld);
fpSigAction(SIGHUP,aHup,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 : secs := 0; { forking error, so run as non-daemon }
Else
Begin
SavePid(pid);
Halt; { successful fork, so parent dies }
End;
End;

{ begin processing loop }
Repeat
If bHup Then Begin
{$I-}
Close(fLog);
{$I+}
IOResult;
NewLog;
myserver:=TMyWebProg.Create; //this does not ...
bHup := false;
End;
{----------------------}

{ Do your daemon stuff }
Append(flog);
Writeln(flog,'daemon code activated at ',formatdatetime('hh:nn:ss',now));
Close(fLog);

{ the following output goes to the bit bucket }
Writeln('daemon code activated at ',hr:0,':',mn:0,':',sc:0);
{----------------------}
If bTerm Then
BREAK
Else
{ wait a while }
fpSelect(0,nil,nil,nil,secs*1000);
Until bTerm;

{ Clean up on closing the daemon }
If bTerm Then
Begin
Append(flog);
Writeln(flog,'daemon destroyed at ',formatdatetime('hh:nn:ss',now));
Close(fLog);
DeletePid();
myserver.free;
End;
End
Else
Begin
Writeln('daemon already running at: ',oldpid);
fpKill(oldpid, SIGTERM);
End;
End.