Prevent multiple instances from running (Win + *nix)

[Chebmaster]

Here's my unit, I finished it at last! Tested, tried, never lets you down, correctly determines the presence/absence of the previous instance even if it crashed or was KILL'ed/ended via the TaskManager. :D

[Updatet THRICE. See the last posts.]

Win32: both FPC and Delphi, Linux: FPC only.
unit cl_pms;

{$ifdef fpc}
{$mode delphi}
{$endif}

interface

uses
SysUtils {$ifdef win32}, Windows{$else}, baseunix {$endif};

function ThisIsAnOnlyInstance: boolean;

implementation

{$ifdef win32}

var
M: THandle;
Di: boolean = false;

function ThisIsAnOnlyInstance: boolean;
var N: string;
begin
Result:=True;
N:=ChangeFileExt(ExtractFileName(ParamStr(0)),'') + 'SingleInstanceMutex';
M:=OpenMutex(MUTEX_MODIFY_STATE, False, PChar(N));
if M = 0 then M:=CreateMutex(nil, True, PChar(N))
else begin
if WaitForSingleObject(M, 0) <> WAIT_ABANDONED
then Result:=False;
end;
Di:=Result;
end;

{$else}

var
Fn: string;
Di: boolean = false;

function ThisIsAnOnlyInstance: boolean;
var
i: integer;
t: Text;
s: stat;
begin
Result:=True;
Fn:= '/tmp/.' + ChangeFileExt(ExtractFileName(ParamStr(0)),'') + 'SingleInstanceMutex';
Try
if FileExists(Fn) then begin
i:=0;
AssignFile(t, Fn);
Reset(t);
Readln(t, i);
CloseFile(t);
if i = fpGetPid() then Exit
else
if DirectoryExists('/proc/' + IntToStr(i)) then begin
if not FileExists('/proc/' + IntToStr(i) + '/exe') //I'm unsure if
// any *nix creates one or it's just my distribution
or ((ExtractFileName(fpReadLink ('/proc/' + IntToStr(i) + '/exe')) = ExtractFileName(ParamStr(0)))
and not ((Length(ParamStr(0)) >=8)and(copy(ParamStr(0),1, 8) <> '/tmp/upx')))
then begin
Exit(False);
end;
end;
end;
AssignFile(t, Fn);
Rewrite(t);
Writeln(t, fpGetPid());
CloseFile(t);
Except
End;
Di:=Result;
end;
{$endif}

initialization
finalization
Try
{$ifdef win32}
if Di then ReleaseMutex(M);
{$else}
if Di and FileExists(Fn) then DeleteFile(Fn);
{$endif}
Except End;
end.

[deathshadow]

I would be slightly concerned in your non-win32 version that if the program crashes, or the OS crashes, or the system loses power - basically if your finalization never runs (which is par for the course with *nix programs in my experience), if something ELSE has grabbed the PID (like after a reboot) you cannot run your program.

I would expand the verification beyond just checking that the PID directory exists, probably by checking that the name of the executable is the same as the %comm parameter in /proc/PID/stat file...

Though I'd be tempted to have the program create and environment variable unique to itself, then check /proc/PID/environ to see if that is set.

[Chebmaster]

Thanks, I greatly appreciate your help :)

I'll upgrade and update the procedure when I get my hands free.

[Chebmaster]

I didn't find a function in Pascal to set a environment variable, but I have noticed that the /proc/PID folder does always contain a file named "exe". In some cases it's just empty 0-byte long file, but mostly it's a symbolic link to the process' executable.

So I just used this trick:
if fpReadLink ('/proc/' + IntToStr(i) + '/exe') = ParamStr(0) then <yes>

Will it work in any unixes or is specific to particular distros?
I added a safety-check, just in case. If the "exe" file doesnt't exitst, it gets that as "consider the PID belongs to a correct process".

[Chebmaster]

:oops: Damn!!! Each second attempt it allows the second copy to run!
Where did I err? :(

[Chebmaster]

[insert a headbanging here] How could I have been so stupid! In the finalization section it was deleting the tempfile regardless of the function result!

Corrected.

[deathshadow]

being that /proc in linux is coded to the kernel, and really hasn't seen major revision since the old Plan9 system you would THINK you were golden... BUT, /exe is technically linux specific.

if the /proc/pid/exe does not exist, I would also check:

/proc/pid/object/a.out
/proc/pid/file

The first being Solaris, the second being freeBSD and it's kin. They should all return the same value in their appropriate environ.

I'm not sure about other *nix's like AIX, QNX, OSX or the host of BSD offshoots. In theory AIX mirrors linux so it SHOULD work... so that would get you the lions share of possibilities.

I do know this will NOT work on HP-UX, since it doesn't have a procfs... but then how many people USE HP-UX in this day and age.

[Chebmaster]

Unfortunately, I have only Linux to test :(

[Chebmaster]

Updated, corrected the bug with not working if the program is UPXed.