cardano-tracer: Create symlink for logging directory.

cardano-tracer/CHANGELOG.md

@@ -1,5 +1,9 @@
 # ChangeLog
 
+## 0.3.2 (February 24, 2025)
+
+* Introduce symbolic links.
+
 ## 0.3.1 (January 22, 2025)
 
 * Fix race condition when querying `NodeInfo` data point, occasionally resulting in fallback `NodeName`s instead of proper ones.

cardano-tracer/src/Cardano/Tracer/Handlers/Logs/File.hs

@@ -7,7 +7,7 @@ module Cardano.Tracer.Handlers.Logs.File
 
 import           Cardano.Logging (TraceObject (..))
 import           Cardano.Tracer.Configuration
-import           Cardano.Tracer.Handlers.Logs.Utils
+import           Cardano.Tracer.Handlers.Logs.Utils (createEmptyLogRotationAndSymlink)
 import           Cardano.Tracer.Types
 import           Cardano.Tracer.Utils (nl, readRegistry)
 
@@ -57,7 +57,7 @@ writeTraceObjectsToFile registry loggingParams@LoggingParams{logRoot, logFormat}
           let subDirForLogs :: FilePath
               subDirForLogs = rootDirAbs </> T.unpack nodeName
 
-          createEmptyLogRotation currentLogLock key registry subDirForLogs
+          createEmptyLogRotationAndSymlink currentLogLock key registry subDirForLogs
           handles <- readRegistry registry
           let handle = fst (fromJust (Map.lookup key handles))
           BS8.hPutStr handle preparedLines

cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs

@@ -7,8 +7,7 @@ module Cardano.Tracer.Handlers.Logs.Rotator
 
 import           Cardano.Tracer.Configuration
 import           Cardano.Tracer.Environment
-import           Cardano.Tracer.Handlers.Logs.Utils (createOrUpdateEmptyLog, getTimeStampFromLog,
-                   isItLog)
+import           Cardano.Tracer.Handlers.Logs.Utils
 import           Cardano.Tracer.MetaTrace
 import           Cardano.Tracer.Types (HandleRegistry, HandleRegistryKey, NodeName)
 import           Cardano.Tracer.Utils (showProblemIfAny, readRegistry)
@@ -134,7 +133,7 @@ checkIfCurrentLogIsFull
   -> IO ()
 checkIfCurrentLogIsFull currentLogLock handle key registry maxSizeInBytes subDirForLogs =
   whenM logIsFull do
-     createOrUpdateEmptyLog currentLogLock key registry subDirForLogs
+     createEmptyLogRotationAndUpdateSymlink currentLogLock key registry subDirForLogs
 
  where
   logIsFull :: IO Bool

cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Utils.hs

@@ -2,7 +2,8 @@
 
 module Cardano.Tracer.Handlers.Logs.Utils
   ( createOrUpdateEmptyLog
-  , createEmptyLogRotation
+  , createEmptyLogRotationAndSymlink
+  , createEmptyLogRotationAndUpdateSymlink
   , getTimeStampFromLog
   , isItLog
   , logExtension
@@ -11,18 +12,21 @@ module Cardano.Tracer.Handlers.Logs.Utils
   ) where
 
 import           Cardano.Tracer.Configuration (LogFormat (..), LoggingParams (..))
-import           Cardano.Tracer.Types (HandleRegistry, HandleRegistryKey)
+import           Cardano.Tracer.Types (HandleRegistry, HandleRegistryKey, HandleRegistryMap)
 import           Cardano.Tracer.Utils (modifyRegistry_)
 
+import           Control.Monad.Extra (whenM)
+-- import           Control.Concurrent.MVar (MVar) -- newMVar, swapMVar, readMVar, tryReadMVar, modifyMVar_)
 import           Control.Concurrent.Extra (Lock, withLock)
 import           Data.Foldable (for_)
 import qualified Data.Map as Map
 import           Data.Maybe (isJust)
+-- import           Data.Text (Text)
 import qualified Data.Text as T
 import           Data.Time.Clock (UTCTime)
 import           Data.Time.Clock.System (getSystemTime, systemToUTCTime)
 import           Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
-import           System.Directory (createDirectoryIfMissing)
+import           System.Directory (createDirectoryIfMissing, createFileLink, doesFileExist, renamePath, removeFile)
 import           System.FilePath (takeBaseName, takeExtension, takeFileName, (<.>), (</>))
 import           System.IO (IOMode (WriteMode), hClose, openFile)
 
@@ -35,7 +39,11 @@ logExtension ForMachine = ".json"
 
 -- | An example of the valid log name: 'node-2021-11-29T09-55-04.json'.
 isItLog :: LogFormat -> FilePath -> Bool
-isItLog format pathToLog = hasProperPrefix && hasTimestamp && hasProperExt
+isItLog format pathToLog = and
+  [ hasProperPrefix
+  , hasTimestamp
+  , hasProperExt
+  ]
  where
   fileName = takeFileName pathToLog
   hasProperPrefix = T.pack logPrefix `T.isPrefixOf` T.pack fileName
@@ -47,38 +55,83 @@ isItLog format pathToLog = hasProperPrefix && hasTimestamp && hasProperExt
 
   maybeTimestamp = T.drop (length logPrefix) . T.pack . takeBaseName $ fileName
 
-createEmptyLogRotation
+symLinkName :: LogFormat -> FilePath
+symLinkName format = "node" <.> logExtension format
+
+symLinkNameTmp :: LogFormat -> FilePath
+symLinkNameTmp format = symLinkName format <.> "tmp"
+
+createEmptyLogRotationAndSymlink
   :: Lock
   -> HandleRegistryKey
   -> HandleRegistry
   -> FilePath
   -> IO ()
-createEmptyLogRotation currentLogLock key registry subDirForLogs = do
+createEmptyLogRotationAndSymlink currentLogLock key@(_, LoggingParams{logFormat = format}) registry subDirForLogs = do
   -- The root directory (as a parent for subDirForLogs) will be created as well if needed.
-  createDirectoryIfMissing True subDirForLogs
-  createOrUpdateEmptyLog currentLogLock key registry subDirForLogs
+  withLock currentLogLock do
+    newLog <- createOrUpdateEmptyLog key registry subDirForLogs
+    let
+      symLink :: FilePath
+      symLink = subDirForLogs </> symLinkName format
 
--- | Create an empty log file (with the current timestamp in the name).
-createOrUpdateEmptyLog :: Lock -> HandleRegistryKey -> HandleRegistry -> FilePath -> IO ()
-createOrUpdateEmptyLog currentLogLock key@(_, LoggingParams{logFormat = format}) registry subDirForLogs = do
+    appendFile "/tmp/mylog" ("one: symlink: " ++ symLink ++ "\n\n")
+    whenM (doesFileExist symLink) do
+      appendFile "/tmp/mylog" ("one: symlink exists, rm: " ++ symLink ++ "\n\n")
+      removeFile symLink
+    createFileLink newLog symLink
+    appendFile "/tmp/mylog" ("one: createFileLink newLog (" ++ newLog ++ ") symLink (" ++ symLink ++ ")\n\n")
+
+createEmptyLogRotationAndUpdateSymlink
+  :: Lock
+  -> HandleRegistryKey
+  -> HandleRegistry
+  -> FilePath
+  -> IO ()
+createEmptyLogRotationAndUpdateSymlink currentLogLock key@(_, LoggingParams{logFormat = format}) registry subDirForLogs = do
+  -- The root directory (as a parent for subDirForLogs) will be created as well if needed.
+  createDirectoryIfMissing True subDirForLogs
   withLock currentLogLock do
-    ts <- formatTime defaultTimeLocale timeStampFormat . systemToUTCTime <$> getSystemTime
-    let pathToLog = subDirForLogs </> logPrefix <> ts <.> logExtension format
+    newLog <- createOrUpdateEmptyLog key registry subDirForLogs
+    let
+      symLink, tmpLink :: FilePath
+      symLink = subDirForLogs </> symLinkName    format
+      tmpLink = subDirForLogs </> symLinkNameTmp format
+    appendFile "/tmp/mylog" ("two: symlink: " ++ symLink ++ "\n\n")
+    appendFile "/tmp/mylog" ("two: tmplink: " ++ tmpLink ++ "\n")
+    whenM (doesFileExist tmpLink) do
+      appendFile "/tmp/mylog" ("two: tmplink exists, rm: " ++ tmpLink ++ "\n\n")
+      removeFile tmpLink
+    createFileLink newLog tmpLink
+    appendFile "/tmp/mylog" ("two: createFileLink newLog (" ++ newLog ++ ") tmpLink (" ++ tmpLink ++ ")\n\n")
+    renamePath tmpLink symLink
+    appendFile "/tmp/mylog" ("two: renamePath tmpLink (" ++ tmpLink ++ ") symLink (" ++ symLink ++ ")\n\n")
 
-    modifyRegistry_ registry \handles -> do
+-- | Create an empty log file (with the current timestamp in the name).
+createOrUpdateEmptyLog :: HandleRegistryKey -> HandleRegistry -> FilePath -> IO FilePath
+createOrUpdateEmptyLog key@(_, LoggingParams{logFormat = format}) registry subDirForLogs = do
+  formattedTime :: String <-
+    formatTime defaultTimeLocale timeStampFormat . systemToUTCTime <$> getSystemTime
+  let
+    pathToLog :: FilePath
+    pathToLog = subDirForLogs </> logPrefix <> formattedTime <.> logExtension format
+  modifyRegistry_ registry \(handles :: HandleRegistryMap) -> do
 
-      for_ @Maybe (Map.lookup key handles) \(handle, _filePath) ->
-        hClose handle
+    for_ @Maybe (Map.lookup key handles) \(handle, _filePath) ->
+      hClose handle
 
-      newHandle <- openFile pathToLog WriteMode
-      let newMap = Map.insert key (newHandle, pathToLog) handles
-      pure newMap
+    newHandle <- openFile pathToLog WriteMode
+    let newMap :: HandleRegistryMap
+        newMap = Map.insert key (newHandle, pathToLog) handles
+    pure newMap
+  pure pathToLog
 
 getTimeStampFromLog :: FilePath -> Maybe UTCTime
-getTimeStampFromLog pathToLog =
-  parseTimeM True defaultTimeLocale timeStampFormat timeStamp
- where
+getTimeStampFromLog pathToLog = let
+  timeStamp :: String
   timeStamp = drop (length logPrefix) . takeBaseName . takeFileName $ pathToLog
+    in
+  parseTimeM True defaultTimeLocale timeStampFormat timeStamp
 
 timeStampFormat :: String
 timeStampFormat = "%Y-%m-%dT%H-%M-%S"

cardano-tracer/src/Cardano/Tracer/Types.hs

@@ -11,6 +11,7 @@ module Cardano.Tracer.Types
   , ProtocolsBrake
   , Registry (..)
   , HandleRegistry
+  , HandleRegistryMap
   , HandleRegistryKey
   ) where
 
@@ -65,8 +66,11 @@ type ProtocolsBrake = TVar Bool
 type    Registry :: Type -> Type -> Type
 newtype Registry a b = Registry { getRegistry :: MVar (Map a b) }
 
+type HandleRegistry :: Type
+type HandleRegistry = Registry HandleRegistryKey (Handle, FilePath)
+
 type HandleRegistryKey :: Type
 type HandleRegistryKey = (NodeName, LoggingParams)
 
-type HandleRegistry :: Type
-type HandleRegistry = Registry HandleRegistryKey (Handle, FilePath)
+type HandleRegistryMap :: Type
+type HandleRegistryMap = Map HandleRegistryKey (Handle, FilePath)

cardano-tracer/src/Cardano/Tracer/Utils.hs

@@ -35,6 +35,7 @@ module Cardano.Tracer.Utils
   , lookupRegistry
   , elemsRegistry
   , clearRegistry
+  , modifyRegistry
   , modifyRegistry_
   , readRegistry
   , getProcessId
@@ -60,7 +61,7 @@ import           Control.Applicative (liftA2, liftA3)
 import           Control.Concurrent (killThread, mkWeakThreadId, myThreadId)
 import           Control.Concurrent.Async (Concurrently(..))
 import           Control.Concurrent.Extra (Lock)
-import           Control.Concurrent.MVar (newMVar, swapMVar, readMVar, tryReadMVar, modifyMVar_)
+import           Control.Concurrent.MVar (newMVar, swapMVar, readMVar, tryReadMVar, modifyMVar, modifyMVar_)
 import           Control.Concurrent.STM (atomically)
 import           Control.Concurrent.STM.TVar (modifyTVar', stateTVar, readTVarIO, newTVarIO)
 import           Control.Exception (SomeAsyncException (..), SomeException, finally, fromException,
@@ -302,6 +303,9 @@ clearRegistry registry@(Registry mvar) = do
   void do
     swapMVar mvar Map.empty
 
+modifyRegistry :: Registry a b -> (Map.Map a b -> IO (Map.Map a b, res)) -> IO res
+modifyRegistry (Registry registry) = modifyMVar registry
+
 modifyRegistry_ :: Registry a b -> (Map.Map a b -> IO (Map.Map a b)) -> IO ()
 modifyRegistry_ (Registry registry) = modifyMVar_ registry