Page 2 of 2 FirstFirst 12
Results 11 to 13 of 13

Thread: Howto write a server that runs on linux with freepascal

  1. #11

    Re: Howto write a server that runs on linux with freepascal

    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

  2. #12

    Re: Howto write a server that runs on linux with freepascal

    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
    Code:
    fpKill(oldpid, SIGTERM);
    to stop it again.

    Now i am looking into FpSetuid to have it run under a specific user also.
    http://3das.noeska.com - create adventure games without programming

  3. #13

    Re: Howto write a server that runs on linux with freepascal

    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:
    [code=delphi]
    {---------------------------------------------------------------------------

    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.
    [/code]
    http://3das.noeska.com - create adventure games without programming

Page 2 of 2 FirstFirst 12

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Comodo SSL