Create MutexObjectUnit.pas

CommonUtils/MutexObjectUnit.pas

@@ -0,0 +1,340 @@
+{
+Copyright (c) 2024, Loginov Dmitry Sergeevich
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright notice,
+   this list of conditions and the following disclaimer in the documentation
+   and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+}
+
+unit MutexObjectUnit;
+
+{$IFDEF FPC}{$MODE DELPHI}{$H+}{$CODEPAGE UTF8}{$ENDIF}
+
+interface
+
+uses
+  {$IFDEF MSWINDOWS}Windows,{$ENDIF}
+  {$IFDEF UNIX}Unix, BaseUnix, pthreads, TimeIntervals, unixtype, {$ENDIF}
+  Classes, SysUtils, SyncObjs;
+
+type
+  EMutexError = class(Exception);
+
+  { TMutexObject }
+
+  TMutexObject = class
+  private
+    FMutexName: string;
+    {$IFDEF MSWINDOWS}
+    FMutex: THandle;         // Объект "мьютекс" будет создан через функцию CreateMutexShared
+    {$ELSE MSWINDOWS}
+    UsePthreadMutex: Boolean;
+    FMutex: pthread_mutex_t; // Используется если не указано имя мьютекса (только внутри процесса)
+                             // по сути, та же критическая секция, только с таймаутом
+
+    FLockFD: cint;           // Дескриптор файла блокировки (если указано имя мьютекса)
+    FLockCount: Integer;     // Если блокировка установлена, то FLockCount > 0
+    FLockThreadId: UInt64;   // ID потока, который установил блокировку (только он может снять блокировку)
+    
+    function GetLockFileName: string;
+    {$ENDIF MSWINDOWS}
+
+  public
+    constructor Create(MutexName: string; aInitialOwner: Boolean = False);
+    destructor Destroy; override;
+    function WaitFor(TimeOutMs: DWORD): TWaitResult;
+    procedure ReleaseMutex;
+  end;
+
+implementation
+
+{$IfDef MSWINDOWS}
+function CreateMutexShared(AName: string; LastError: PCardinal = nil): THandle;
+var
+  SD:TSecurityDescriptor;
+  SA:TSecurityAttributes;
+  pSA: PSecurityAttributes;
+begin
+  if not InitializeSecurityDescriptor(@SD, SECURITY_DESCRIPTOR_REVISION) then
+    raise EMutexError.CreateFmt('CreateMutexShared: Error InitializeSecurityDescriptor: %s', [SysErrorMessage(GetLastError)]);
+
+  SA.nLength:=SizeOf(TSecurityAttributes);
+  SA.lpSecurityDescriptor:=@SD;
+  SA.bInheritHandle:=False;
+
+  if not SetSecurityDescriptorDacl(SA.lpSecurityDescriptor, True, nil, False) then
+    raise EMutexError.CreateFmt('CreateMutexShared: Error SetSecurityDescriptorDacl: %s', [SysErrorMessage(GetLastError)]);
+
+  pSA := @SA;
+
+  Result := CreateMutex(pSA, False, PChar('Global\' + AName)); // Пытаемся создать с директивой Global
+  if Result = 0 then
+    Result := CreateMutex(pSA, False, PChar(AName)); // Пытаемся создать без директивы Global
+
+  if Assigned(LastError) then
+    LastError^ := GetLastError;
+
+  if Result = 0 then
+    raise EMutexError.CreateFmt('CreateMutexShared: can not create mutex object: %s', [SysErrorMessage(GetLastError)]);
+end;
+{$EndIf MSWINDOWS}
+
+{ TMutexObject }
+
+{$IfDef UNIX}
+function TMutexObject.GetLockFileName: string;
+begin
+  Result := '/var/lock/' + FMutexName + '.lock';
+end;
+{$ENDIF}
+
+constructor TMutexObject.Create(MutexName: string; aInitialOwner: Boolean);
+{$IfDef LINUX}
+var
+  Mattr: pthread_mutexattr_t;
+  I: Integer;
+{$ENDIF}
+begin
+  FMutexName := MutexName;
+  {$IfDef MSWINDOWS}
+  FMutex := CreateMutexShared(MutexName);
+  {$Else MSWINDOWS}
+
+  UsePthreadMutex := MutexName = '';
+
+  if UsePthreadMutex then
+  begin
+    CheckOSError(pthread_mutexattr_init(@Mattr));
+    try
+      CheckOSError(pthread_mutexattr_settype(@Mattr,Ord(PTHREAD_MUTEX_RECURSIVE)));
+      CheckOSError(pthread_mutex_init(@FMutex,@Mattr));
+    finally
+      pthread_mutexattr_destroy(@Mattr); // don't raise second error, it would hide the first
+    end;
+
+  end else
+  begin
+    // Удаляем все недопустимые символы из имени мьютекса
+    for I := 1 to Length(FMutexName) do
+      if AnsiChar(FMutexName[I]) in ['\', '/', ':', '*', '"', '?', '|', '<', '>'] then
+        FMutexName[I] := '_';
+    FMutexName := AnsiLowerCase(FMutexName);
+  end;
+
+  if aInitialOwner then
+    WaitFor(0);
+
+  {$EndIf MSWINDOWS}
+end;
+
+destructor TMutexObject.Destroy;
+begin
+  {$IfDef MSWINDOWS}
+  if FMutex <> 0 then
+  begin
+    FileClose(FMutex);
+    //CloseHandle(HMutex);
+    FMutex := 0;
+  end;
+  {$ELSE MSWINDOWS}
+  if UsePthreadMutex then
+    pthread_mutex_destroy(@FMutex)
+  else
+  begin
+    if FLockFD > 0 then
+    begin
+      if FLockCount > 0 then
+        fpFlock(FLockFD, LOCK_UN); // Если блокировка установлена, то снимаем её
+      fpClose(FLockFD);
+    end;
+  end;
+  {$ENDIF MSWINDOWS}
+  inherited;
+end;
+
+{$IfDef LINUX}
+function pthread_mutex_timedlock(__mutex:Ppthread_mutex_t; __abstime: Ptimespec):cint;cdecl; external libthreads;
+
+procedure MSecsFromNow (tNow : Timeval; aTimeout : Integer; out tfuture: TTimespec);
+
+var
+  td,tm : integer;
+
+begin
+  td:=aTimeout div 1000;
+  tm:=aTimeout mod 1000;
+  tfuture.tv_sec:=tnow.tv_sec+td;
+  tfuture.tv_nsec:=tnow.tv_usec*1000+(tm*1000*1000);
+end;
+{$ENDIF LINUX}
+
+function TMutexObject.WaitFor(TimeOutMs: DWORD): TWaitResult;
+{$IfDef MSWINDOWS}
+var
+  WinRes: Cardinal;
+{$Else MSWINDOWS}
+var
+  td,tm,Errno: Integer;
+  tnow: ttimeval;
+  Tmp: timespec;
+  ti: TTimeInterval;
+  TmpLockFD, RWMode: cint;
+  sLockFile: string;
+{$EndIf MSWINDOWS}
+begin
+  {$IfDef MSWINDOWS}
+  WinRes := WaitForSingleObject(FMutex, TimeOutMs);
+  case WinRes of
+    WAIT_OBJECT_0: Result := wrSignaled;
+    WAIT_TIMEOUT: Result := wrTimeout;
+    WAIT_ABANDONED: Result := wrAbandoned;
+  else
+    //WAIT_FAILED:
+    Result := wrError;
+  end;
+  {$Else MSWINDOWS}
+  if UsePthreadMutex then
+  begin
+    Result:=wrError;
+    if (TimeOutMs=0) then
+      begin
+        ErrNo:=pthread_mutex_trylock(@FMutex);
+        if ErrNo=0 then
+          Result:=wrSignaled
+        else if (Errno=ESysEAGAIN) then
+          Result:=wrTimeout
+      end
+    else if (TimeOutMs<>INFINITE) then
+      begin
+      fpgettimeofday(@tnow,Nil);
+
+      MsecsFromNow(tnow, TimeOutMs,tmp);
+      ErrNo:=pthread_mutex_timedlock(@FMutex,@tmp);
+
+      if ErrNo=0 then
+        Result:=wrSignaled
+      else if (Errno=ESysEBUSY) or (errNo=ESysETIMEDOUT) then
+        Result:=wrTimeout
+      end
+    else
+      begin
+      if (pthread_mutex_lock(@FMutex)=0) then
+        Result:=wrSignaled
+      end;
+  end else
+  begin
+
+    if (FLockCount > 0) and (GetCurrentThreadId = FLockThreadId) then
+    begin
+      Inc(FLockCount);
+      Result := wrSignaled;
+      Exit;
+    end;
+
+    sLockFile := GetLockFileName;
+    TmpLockFD := fpOpen(sLockFile, O_RDWR or O_CREAT);
+    if TmpLockFD <= 0 then
+      raise EMutexError.CreateFmt('can not open lock file "%s": %s ', [sLockFile, SysErrorMessage(GetLastOSError)]);
+
+    if TimeOutMs = 0 then
+    begin
+      if fpFlock(TmpLockFD, LOCK_EX or LOCK_NB) = 0 then
+        Result := wrSignaled
+      else
+        Result := wrTimeout;
+    end else if TimeOutMs = INFINITE then
+    begin
+      if fpFlock(TmpLockFD, LOCK_EX) = 0 then
+        Result := wrSignaled
+      else
+        Result := wrError;
+    end else
+    begin
+      ti.Start;
+      Result := wrTimeout;
+
+      while ti.ElapsedMilliseconds() < TimeOutMs do
+      begin
+        // К сожалению, в линуксе невозможно указать время ожидания снятия блокировки
+        // файла, поэтому организуем цикл ожидания снятия блокировки
+        if fpFlock(TmpLockFD, LOCK_EX or LOCK_NB) = 0 then
+        begin
+          Result := wrSignaled;
+          Break;
+        end else if ti.ElapsedMilliseconds > 5 then // Первые 5 миллисекунд НЕ используем Sleep
+          Sleep(10);
+      end;
+
+      if Result = wrTimeout then
+        if fpFlock(TmpLockFD, LOCK_EX or LOCK_NB) = 0 then
+          Result := wrSignaled;
+    end;
+
+    if Result = wrSignaled then // Если удалось захватить блокировку файла
+    begin
+      FLockThreadId := GetCurrentThreadId; // Внимание! Для Linux идентификаторы потоков задействуются повторно!!!
+      FLockCount := 1;
+      FLockFD := TmpLockFD; // Запоминаем дескриптор файла, чтобы сработал метод ReleaseMutex
+
+      RWMode := S_IRUSR or S_IRGRP or S_IROTH or S_IWUSR or S_IWGRP or S_IWOTH;
+      FpChmod(sLockFile, RWMode); // Настраиваем чтение/запись для всех пользователей
+    end else
+    begin
+      fpClose(TmpLockFD);
+    end;
+  end;
+  {$EndIf MSWINDOWS}
+end;
+
+procedure TMutexObject.ReleaseMutex;
+{$IfDef UNIX}
+var
+  TmpLockFD: cint;
+{$ENDIF}
+begin
+  {$IfDef MSWINDOWS}
+  Windows.ReleaseMutex(FMutex);
+  {$Else MSWINDOWS}
+  if UsePthreadMutex then
+    CheckOSError(pthread_mutex_unlock(@FMutex))
+  else
+  begin
+    if FLockCount > 0 then
+    begin
+      if GetCurrentThreadId <> FLockThreadId then
+        raise EMutexError.Create('TMutexWrapper: попытка вызова ReleaseMutex из другого потока для занятого мьютекса');
+      if FLockCount = 1 then
+      begin
+        TmpLockFD := FLockFD;
+        FLockFD := 0;
+        FLockThreadId := 0;
+        FLockCount := 0;
+        fpFlock(TmpLockFD, LOCK_UN);
+        fpClose(TmpLockFD);
+        Exit;
+      end;
+      Dec(FLockCount);
+    end;
+  end;
+  {$EndIf MSWINDOWS}
+end;
+
+end.
+