Add symbolic logging to cardano-tracer

cardano-node/src/Cardano/Node/Startup.hs

@@ -4,8 +4,8 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Node.Startup where
@@ -169,98 +169,6 @@
   , niIpProducers   :: IPSubscriptionTarget
   }
 
-data NodeInfo = NodeInfo
-  { niName            :: Text
-  , niProtocol        :: Text
-  , niVersion         :: Text
-  , niCommit          :: Text
-  , niStartTime       :: UTCTime
-  , niSystemStartTime :: UTCTime
-  } deriving (Eq, Generic, ToJSON, FromJSON, Show)
-
-deriving instance (NFData NodeInfo)
-
-instance MetaTrace NodeInfo where
-  namespaceFor NodeInfo {}  =
-    Namespace [] ["NodeInfo"]
-  severityFor  (Namespace _ ["NodeInfo"]) _ =
-    Just Info
-  severityFor _ns _ =
-    Nothing
-  documentFor  (Namespace _ ["NodeInfo"]) = Just
-    "Basic information about this node collected at startup\
-        \\n\
-        \\n _niName_: Name of the node. \
-        \\n _niProtocol_: Protocol which this nodes uses. \
-        \\n _niVersion_: Software version which this node is using. \
-        \\n _niStartTime_: Start time of this node. \
-        \\n _niSystemStartTime_: How long did the start of the node took."
-  documentFor _ns =
-     Nothing
-  allNamespaces = [ Namespace [] ["NodeInfo"]]
-
-
--- | Prepare basic info about the node. This info will be sent to 'cardano-tracer'.
-prepareNodeInfo
-  :: NodeConfiguration
-  -> SomeConsensusProtocol
-  -> TraceConfig
-  -> UTCTime
-  -> IO NodeInfo
-prepareNodeInfo nc (SomeConsensusProtocol whichP pForInfo) tc nodeStartTime = do
-  nodeName <- prepareNodeName
-  return $ NodeInfo
-    { niName            = nodeName
-    , niProtocol        = pack . show . ncProtocol $ nc
-    , niVersion         = pack . showVersion $ version
-    , niCommit          = $(gitRev)
-    , niStartTime       = nodeStartTime
-    , niSystemStartTime = systemStartTime
-    }
- where
-  cfg = pInfoConfig $ fst $ Api.protocolInfo @IO pForInfo
-
-  systemStartTime :: UTCTime
-  systemStartTime =
-    case whichP of
-      Api.ByronBlockType ->
-        getSystemStartByron
-      Api.ShelleyBlockType ->
-        let DegenLedgerConfig cfgShelley = configLedger cfg
-        in getSystemStartShelley cfgShelley
-      Api.CardanoBlockType ->
-        let CardanoLedgerConfig _ cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage cfgConway = configLedger cfg
-        in minimum [ getSystemStartByron
-                   , getSystemStartShelley cfgShelley
-                   , getSystemStartShelley cfgAllegra
-                   , getSystemStartShelley cfgMary
-                   , getSystemStartShelley cfgAlonzo
-                   , getSystemStartShelley cfgBabbage
-                   , getSystemStartShelley cfgConway
-                   ]
-
-  getSystemStartByron = WCT.getSystemStart . getSystemStart . configBlock $ cfg
-  getSystemStartShelley = sgSystemStart . shelleyLedgerGenesis . shelleyLedgerConfig
-
-  prepareNodeName =
-    case tcNodeName tc of
-      Just aName -> return aName
-      Nothing -> do
-        -- The user didn't specify node's name in the configuration.
-        -- In this case we should form node's name as "host_port",
-        -- where 'host' is the machine's host name and 'port' is taken
-        -- from the '--port' CLI-parameter.
-
-        let suffix :: String
-            suffix
-              | SocketConfig{ncNodePortNumber = Last (Just port)} <- ncSocketConfig nc
-              = "_" <> show port
-              | otherwise
-              = ""
-
-        hostName <- getHostName
-        return (pack (hostName <> suffix))
-
 -- | This information is taken from 'BasicInfoShelleyBased'. It is required for
 --   'cardano-tracer' service (particularly, for RTView).
 data NodeStartupInfo = NodeStartupInfo {

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/cardano-tracer.cabal

@@ -1,7 +1,7 @@
 cabal-version: 3.0
 
 name:                   cardano-tracer
-version:                0.3.1
+version:                0.3.2
 synopsis:               A service for logging and monitoring over Cardano nodes
 description:            A service for logging and monitoring over Cardano nodes.
 category:               Cardano,
@@ -164,7 +164,7 @@ library
                       , bimap
                       , blaze-html
                       , bytestring
-                      , cardano-node
+                      -- , cardano-node
                       , cborg
                       , containers
                       , contra-tracer

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 @@
   ) 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 @@
 
 -- | 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 @@
 
   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