Предотвращение запуска нескольких копий программы.

Обсуждаются как существующие проекты (перевод документации, информационная система и т.п.), так и создание новых.

Модератор: Модераторы

Предотвращение запуска нескольких копий программы.

Сообщение Cheb » 20.03.2007 15:52:32

После долгих, многомесячных мучений смог-таки исхитриться состряпать кросс-платформенный модуль, работающий и под Вин и под Лин.

(проблема с любыми предложениями типа "создать файлик/семафор/ещё какую хрень, и проверять по его наличию запущена ли программа" упираются в тот факт, что программа может и умереть, не успев подчистить за собой. И что тогда - больше не запустится?)

Вот. В виндовсе эксплуатируется тот факт, что система сама метит мьютекс как "бесхозный" если скончалась породившая его программа (и не важно, успела она перед смертью пискнуть, или нет). В Линуксе эксплуатируется тот факт, что для всех запущенных процессов в файловой системе имеются виртуальные папки "/proc/<номер PID>".

Вопрос знатокам: моя процедура создаёт маленький файлик, куда пишет PID. Дело это муторное и не надёжное, из-за того, что не ясно в какой папке его создавать. Там же, где лежит сама программа? А если это /bin/ или /usr/bin/ ? Точно ведь по рукам дадут. Так вот, вопрос: как в Линуксе создавать именованые мьютексы, или сходжие объекты, способные содержать число?

Код: Выделить всё
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.
   
Последний раз редактировалось Cheb 17.04.2007 15:53:25, всего редактировалось 1 раз.
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 590
Зарегистрирован: 06.06.2005 15:54:34

Сообщение Attid » 20.03.2007 16:16:38

файлик вроде как надо создавать /var/run/
там даже апач этим занимается =)
но там тоже права нужны без них никуда
так что проще в /tmp or /var/tmp
тем более у них есть свойство после перезагрузке очищаться .
Аватара пользователя
Attid
долгожитель
 
Сообщения: 2578
Зарегистрирован: 27.10.2006 17:29:15
Откуда: 44°32′23.63″N 41°2′25.2″E

Сообщение Sergei I. Gorelkin » 20.03.2007 19:34:14

/var/tmp при перезагрузке не очищается, этим он и отличается от /tmp. А на моей системе и /tmp не очищается, и фиг поймешь чего подкрутить надо.
Можно, наверное, держать файл с pid все время открытым с запретом совместной записи. Тогда при смерти программы он должен закрыться, а запись - разрешиться.

Первый раз вижу, чтобы виндовый мьютекс проверяли на WAIT_ABANDONED. Даже в случае внезапной смерти программы все принадлежащие ей дескрипторы (handle) будут закрыты. Мьютекс (и подобные ему объекты) будет удален при закрытии последнего своего handle, поэтому риск умереть, не подчистив, отсутствует.

А вот гораздо более интересная задача - при обнаружении предыдущего экземпляра передать ему свою командную строку...
Аватара пользователя
Sergei I. Gorelkin
энтузиаст
 
Сообщения: 1368
Зарегистрирован: 24.07.2005 14:40:41
Откуда: Зеленоград

Сообщение Cheb » 20.03.2007 20:06:46

так что проще в /tmp or /var/tmp

А ведь и действительно! Кто угодно может туда писать. Спасибо :D

Тоды это будет
Код: Выделить всё
    Fn:= '/tmp/.' + ChangeFileExt(ExtractFileName(ParamStr(0)),'') + 'SingleInstanceMutex';


Первый раз вижу, чтобы виндовый мьютекс проверяли на WAIT_ABANDONED.

Уже не помню точно, но, ЕМНИП, я тестировал её разными способами, в том числе закомментировав вызов ReleaseMutex(M), и роняя программу разными способами - и мьютекс часто преспокойно переживал смерть программы. Почему, собственно, его и приходится проверять на бесхозность. Вроде бы, не помню точно, он остаётся неубранным если зависшую программу убить через Диспетчер задач.
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 590
Зарегистрирован: 06.06.2005 15:54:34

Сообщение alexs » 21.03.2007 11:09:55

По моему надо проверять не факт наличия файла-флага - а факт залоченности этого файла.
при создани файла - указываеш метод создания - монопольно, и поседующие экземпляры (пока работае экземпляр создавший этот файл) пересоздать файл не могут - следовательно программа запущена.
Если при запуске файл был обнаружен, но его получилось удалить - значит превыдущий экземпляр был завершён аварийно - и можно запускть текущий. Я по этой методике давно работаю - универсально кросплатформенное решение.
Аватара пользователя
alexs
долгожитель
 
Сообщения: 3476
Зарегистрирован: 15.05.2005 23:17:07
Откуда: г.Ставрополь

Сообщение Cheb » 25.03.2007 04:44:56

О... Уже обкатать успел, и пару страшных багов убить. Причём, пошёл совершенно другим путём.

Кстати, угадайте почему в предыдущей линукс-весиии каждый второй запуск следующего экземпляра увенчивался успехом? :oops:
Последний раз редактировалось Cheb 17.04.2007 15:54:27, всего редактировалось 1 раз.
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 590
Зарегистрирован: 06.06.2005 15:54:34

Сообщение Attid » 30.03.2007 17:43:05

finalization можно сократить до
Код: Выделить всё
finalization
  Try
{$ifdef win32}
    if Di then ReleaseMutex(M);
{$else}
    if Di and FileExists(Fn) then DeleteFile(Fn);
{$endif}
  Except End;
end.

целых 3 слова =)

вот пытаюсь отгадать твою загадку
Кстати, угадайте почему в предыдущей линукс-весиии каждый второй запуск следующего экземпляра увенчивался успехом? Embarassed


только относительно другой задачи. хочу запустить процесс и следить чтоб не пропал =)
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)))

вот этого не пойму
что есть вероятность того что процесса уже нет а папка осталась ?

то что ты сравниваешь имя бинарника пида это понятно, вдруг этот пид занял другой процесс. а вот про папку раскажи плиз
Аватара пользователя
Attid
долгожитель
 
Сообщения: 2578
Зарегистрирован: 27.10.2006 17:29:15
Откуда: 44°32′23.63″N 41°2′25.2″E

Сообщение Cheb » 17.04.2007 15:52:11

ОБНАРУЖЕН СТРАШНЫЙ БАГ :shock:
Если программу пожать UPX'ом то ничерта не работает, поскольку имя бинарника генерится на лету, случайным образом и никогда не совпадает. :cry:

Обновил первый пост, добавив
and not ((Length(ParamStr(0)) >=8)and(copy(ParamStr(0),1, 8 ) <> '/tmp/upx')))

вот пытаюсь отгадать твою загадку

Потому что было if FileExists(Fn) then DeleteFile(Fn); :oops:

что есть вероятность того что процесса уже нет а папка осталась ?

Какая папка? Pid? Тогда думаю, нулевая.

о что ты сравниваешь имя бинарника пида это понятно, вдруг этот пид занял другой процесс. а вот про папку раскажи плиз

?..
Что про папку? Где про папку?
Просто у меня, в качестве временной меры, /usr/bin/<имя моей программы> - это симлинк, указывающий на реальный файл, в папке проекта, куда всё компилится. Можно запустить и так, и так, имя бинарника будет тем же, а путь будет указан разный.

целых 3 слова =)

Спасибо, учёл :D
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 590
Зарегистрирован: 06.06.2005 15:54:34

Сообщение YuriPro » 31.03.2008 16:22:58

Проблему запуска нескольких экземпляров программы можно решить с помощью семафора, изменяя его значение с установкой флага SEM_UNDO. В этом случае после завершения процесса система откатит изменения.
YuriPro
новенький
 
Сообщения: 11
Зарегистрирован: 30.01.2007 18:19:08

Сообщение Attid » 31.03.2008 16:41:43

YuriPro
а рабочий пример под обе ОС ?
Аватара пользователя
Attid
долгожитель
 
Сообщения: 2578
Зарегистрирован: 27.10.2006 17:29:15
Откуда: 44°32′23.63″N 41°2′25.2″E

Сообщение YuriPro » 02.04.2008 11:16:48

Attid писал(а):а рабочий пример под обе ОС ?

Только под одну. Под Win вопрос закрывается мьютексами. :)
YuriPro
новенький
 
Сообщения: 11
Зарегистрирован: 30.01.2007 18:19:08

Сообщение Attid » 02.04.2008 12:03:22

а тут представлено кросс решение.
Аватара пользователя
Attid
долгожитель
 
Сообщения: 2578
Зарегистрирован: 27.10.2006 17:29:15
Откуда: 44°32′23.63″N 41°2′25.2″E

Сообщение YuriPro » 02.04.2008 12:34:02

Я вовсе не против универсального решения. :)
Просто предлагаю другой, реально работающий (а с моей точки зрения - и более простой) вариант. Надеюсь он тоже пригодится.
YuriPro
новенький
 
Сообщения: 11
Зарегистрирован: 30.01.2007 18:19:08

Сообщение Attid » 02.04.2008 12:58:25

ты пока не предлогаешь, а показываешь направление =)

сделай пример , юнит который можно подключить и вызвать функцию.
Аватара пользователя
Attid
долгожитель
 
Сообщения: 2578
Зарегистрирован: 27.10.2006 17:29:15
Откуда: 44°32′23.63″N 41°2′25.2″E

Сообщение Attid » 03.04.2008 17:39:38

Cheb
всетаки что-то ты страшное намудрил тут
Код: Выделить всё
               and not ((Length(ParamStr(0)) >=8)and(copy(ParamStr(0),1, 8) <> '/tmp/upx')))


название програмы должно быть меньше 8 символов и не содержать в себе upx ? =)
Аватара пользователя
Attid
долгожитель
 
Сообщения: 2578
Зарегистрирован: 27.10.2006 17:29:15
Откуда: 44°32′23.63″N 41°2′25.2″E

След.

Вернуться в Разное

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 0

Рейтинг@Mail.ru