Merge pull request #6095 from IntersectMBO/smelc/cardano-testnet-cust…

…om-output-dir

cardano-tesnet: allow to specify output directory

cardano-testnet/src/Parsers/Cardano.hs

@@ -57,6 +57,11 @@ pCardanoTestnetCliOptions envCli = CardanoTestnetOptions
       <>  OA.help "Enable new epoch state logging to logs/ledger-epoch-state.log"
       <>  OA.showDefault
       )
+  <*> optional (OA.strOption
+      (   OA.long "output-dir"
+      <>  OA.help "Directory where to store files, sockets, and so on. It is created if it doesn't exist. If unset, a temporary directory is used."
+      <>  OA.metavar "DIRECTORY"
+      ))
   where
     pAnyShelleyBasedEra' :: Parser AnyShelleyBasedEra
     pAnyShelleyBasedEra' =

cardano-testnet/src/Parsers/Run.hs

@@ -53,4 +53,4 @@ runTestnetCmd = \case
 
 runCardanoOptions :: CardanoTestnetCliOptions -> IO ()
 runCardanoOptions (CardanoTestnetCliOptions testnetOptions shelleyOptions) =
-  runTestnet $ cardanoTestnetDefault testnetOptions shelleyOptions
+  runTestnet testnetOptions $ cardanoTestnetDefault testnetOptions shelleyOptions

cardano-testnet/src/Testnet/Filepath.hs

@@ -25,6 +25,8 @@ makeSprocket
 makeSprocket tmpAbsPath node
   = Sprocket (makeTmpBaseAbsPath tmpAbsPath) (makeSocketDir tmpAbsPath </> node)
 
+-- TODO rename me: since the introduction of --output-dir in the cardano-testnet
+-- executable, this is a directory that can persist after the test ends.
 -- Temporary path used at runtime
 newtype TmpAbsolutePath = TmpAbsolutePath
   { unTmpAbsPath :: FilePath

cardano-testnet/src/Testnet/Property/Run.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
 module Testnet.Property.Run
   ( runTestnet
   -- Ignore tests on various OSs
@@ -19,11 +21,12 @@ import           Data.Bool (bool)
 import           Data.String (IsString (..))
 import qualified System.Console.ANSI as ANSI
 import           System.Console.ANSI (Color (..), ColorIntensity (..), ConsoleLayer (..), SGR (..))
+import           System.Directory
 import qualified System.Exit as IO
 import qualified System.Info as SYS
 import qualified System.IO as IO
 
-import           Testnet.Property.Util (integrationWorkspace)
+import           Testnet.Property.Util (integration, integrationWorkspace)
 import           Testnet.Start.Types
 
 import           Hedgehog (Property)
@@ -35,11 +38,11 @@ import qualified Test.Tasty.Hedgehog as H
 import           Test.Tasty.Providers (testPassed)
 import           Test.Tasty.Runners (Result (resultShortDescription), TestTree)
 
-runTestnet :: (Conf -> H.Integration a) -> IO ()
-runTestnet tn = do
+runTestnet :: CardanoTestnetOptions -> (Conf -> H.Integration a) -> IO ()
+runTestnet tnOpts tn = do
   tvRunning <- STM.newTVarIO False
 
-  void . H.check $ testnetProperty $ \c -> do
+  void . H.check $ testnetProperty tnOpts $ \c -> do
     void $ tn c
     H.evalIO . STM.atomically $ STM.writeTVar tvRunning True
 
@@ -60,17 +63,30 @@ runTestnet tn = do
       IO.exitFailure
 
 
-testnetProperty :: (Conf -> H.Integration ()) -> H.Property
-testnetProperty tn = integrationWorkspace "testnet" $ \workspaceDir -> do
-  conf <- mkConf workspaceDir
-
-  -- Fork a thread to keep alive indefinitely any resources allocated by testnet.
-  void . H.evalM . liftResourceT . resourceForkIO . forever . liftIO $ IO.threadDelay 10000000
-
-  void $ tn conf
-
-  H.failure -- Intentional failure to force failure report
-
+testnetProperty :: CardanoTestnetOptions -> (Conf -> H.Integration ()) -> H.Property
+testnetProperty CardanoTestnetOptions{cardanoOutputDir} runTn =
+  case cardanoOutputDir of
+      Nothing -> do
+        integrationWorkspace "testnet" $ \workspaceDir -> do
+          mkConf workspaceDir >>= forkAndRunTestnet
+      Just userOutputDir ->
+        integration $ do
+          absUserOutputDir <- H.evalIO $ makeAbsolute userOutputDir
+          dirExists <- H.evalIO $ doesDirectoryExist absUserOutputDir
+          (if dirExists then
+            -- Likely dangerous, but who are we to judge the user?
+            H.note_ $ "Reusing " <> absUserOutputDir
+          else do
+            liftIO $ createDirectory absUserOutputDir
+            H.note_ $ "Created " <> absUserOutputDir)
+          conf <- mkConf absUserOutputDir
+          forkAndRunTestnet conf
+  where
+    forkAndRunTestnet conf = do
+      -- Fork a thread to keep alive indefinitely any resources allocated by testnet.
+      void $ H.evalM . liftResourceT . resourceForkIO . forever . liftIO $ IO.threadDelay 10000000
+      void $ runTn conf
+      H.failure -- Intentional failure to force failure report
 
 -- Ignore properties on various OSs
 

cardano-testnet/src/Testnet/Start/Types.hs

@@ -74,6 +74,7 @@ data CardanoTestnetOptions = CardanoTestnetOptions
   , cardanoNodeLoggingFormat :: NodeLoggingFormat
   , cardanoNumDReps :: NumDReps -- ^ The number of DReps to generate at creation
   , cardanoEnableNewEpochStateLogging :: Bool -- ^ if epoch state logging is enabled
+  , cardanoOutputDir :: Maybe FilePath -- ^ The output directory where to store files, sockets, and so on. If unset, a temporary directory is used.
   } deriving (Eq, Show)
 
 cardanoNumPools :: CardanoTestnetOptions -> NumPools
@@ -105,6 +106,7 @@ instance Default CardanoTestnetOptions where
     , cardanoNodeLoggingFormat = NodeLoggingFormatAsJson
     , cardanoNumDReps = 3
     , cardanoEnableNewEpochStateLogging = True
+    , cardanoOutputDir = Nothing
     }
 
 -- | Options that are implemented by writing fields in the Shelley genesis file.

cardano-testnet/test/cardano-testnet-golden/files/golden/help.cli

@@ -13,6 +13,7 @@ Usage: cardano-testnet cardano [--num-pool-nodes COUNT]
   [--nodeLoggingFormat LOGGING_FORMAT]
   [--num-dreps NUMBER]
   [--enable-new-epoch-state-logging]
+  [--output-dir DIRECTORY]
   --testnet-magic INT
   [--epoch-length SLOTS]
   [--slot-length SECONDS]

cardano-testnet/test/cardano-testnet-golden/files/golden/help/cardano.cli

@@ -11,6 +11,7 @@ Usage: cardano-testnet cardano [--num-pool-nodes COUNT]
   [--nodeLoggingFormat LOGGING_FORMAT]
   [--num-dreps NUMBER]
   [--enable-new-epoch-state-logging]
+  [--output-dir DIRECTORY]
   --testnet-magic INT
   [--epoch-length SLOTS]
   [--slot-length SECONDS]
@@ -44,6 +45,9 @@ Available options:
   --enable-new-epoch-state-logging
                            Enable new epoch state logging to
                            logs/ledger-epoch-state.log
+  --output-dir DIRECTORY   Directory where to store files, sockets, and so on.
+                           It is created if it doesn't exist. If unset, a
+                           temporary directory is used.
   --testnet-magic INT      Specify a testnet magic id.
   --epoch-length SLOTS     Epoch length, in number of slots (default: 500)
   --slot-length SECONDS    Slot length (default: 0.1)

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

@@ -18,7 +18,7 @@ import qualified Data.Map as Map
 import           Data.Maybe (fromJust, fromMaybe)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
-import           System.Directory (makeAbsolute)
+import           System.Directory
 import           System.FilePath ((</>))
 import           System.IO (hFlush)
 
@@ -57,7 +57,7 @@ writeTraceObjectsToFile registry loggingParams@LoggingParams{logRoot, logFormat}
           let subDirForLogs :: FilePath
               subDirForLogs = rootDirAbs </> T.unpack nodeName
 
-          createEmptyLogRotation currentLogLock key registry subDirForLogs
+          createEmptyLogRotationAndUpdateSymlink 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)
@@ -25,7 +24,7 @@ import qualified Data.Map as Map
 import qualified Data.Text as Text
 import           Data.Time (diffUTCTime, getCurrentTime)
 import           Data.Word (Word32, Word64)
-import           System.Directory (doesDirectoryExist, makeAbsolute, removeFile)
+import           System.Directory
 import           System.Directory.Extra (listDirectories, listFiles)
 import           System.FilePath (takeFileName, (</>))
 import           System.IO (Handle, hTell)

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

@@ -1,27 +1,33 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Cardano.Tracer.Handlers.Logs.Utils
-  ( createOrUpdateEmptyLog
-  , createEmptyLogRotation
+  ( createLogAndSymLink
+  , createOrUpdateEmptyLog
+  , createEmptyLogRotationAndUpdateSymlink
   , getTimeStampFromLog
   , isItLog
   , logExtension
   , logPrefix
   , timeStampFormat
+  , isItSymLink
+  , symLinkName
   ) where
 
 import           Cardano.Tracer.Configuration (LogFormat (..), LoggingParams (..))
 import           Cardano.Tracer.Types (HandleRegistry, HandleRegistryKey)
 import           Cardano.Tracer.Utils (modifyRegistry_)
 
 import           Control.Concurrent.Extra (Lock, withLock)
+import qualified Data.ByteString as BS
 import           Data.Foldable (for_)
 import qualified Data.Map as Map
 import           Data.Maybe (isJust)
 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 (createFileLink, doesFileExist, getSymbolicLinkTarget,
+                   pathIsSymbolicLink, renamePath, removeFile)
 import           System.Directory (createDirectoryIfMissing)
 import           System.FilePath (takeBaseName, takeExtension, takeFileName, (<.>), (</>))
 import           System.IO (IOMode (WriteMode), hClose, openFile)
@@ -33,6 +39,22 @@ logExtension :: LogFormat -> String
 logExtension ForHuman   = ".log"
 logExtension ForMachine = ".json"
 
+symLinkName :: LogFormat -> FilePath
+symLinkName format = "node" <.> logExtension format
+
+symLinkNameTmp :: LogFormat -> FilePath
+symLinkNameTmp format = symLinkName format <.> "tmp"
+
+isItSymLink :: LogFormat -> FilePath -> IO Bool
+isItSymLink format fileName =
+  if takeFileName fileName == symLinkName format
+    then pathIsSymbolicLink fileName
+    else return False
+
+doesSymLinkValid :: FilePath -> IO Bool
+doesSymLinkValid pathToSymLink =
+  doesFileExist =<< getSymbolicLinkTarget pathToSymLink
+
 -- | An example of the valid log name: 'node-2021-11-29T09-55-04.json'.
 isItLog :: LogFormat -> FilePath -> Bool
 isItLog format pathToLog = hasProperPrefix && hasTimestamp && hasProperExt
@@ -47,19 +69,63 @@ isItLog format pathToLog = hasProperPrefix && hasTimestamp && hasProperExt
 
   maybeTimestamp = T.drop (length logPrefix) . T.pack . takeBaseName $ fileName
 
-createEmptyLogRotation
+-- | Create a new log file and a symlink to it, from scratch.
+createLogAndSymLink :: FilePath -> LogFormat -> IO FilePath
+createLogAndSymLink subDirForLogs format = do
+  pathToNewLog <- createEmptyLog subDirForLogs format
+  whenM (doesFileExist symLink) $ removeFile symLink
+  createFileLink pathToNewLog symLink
+  return pathToNewLog
+ where
+  symLink = subDirForLogs </> symLinkName format
+
+-- | Create an empty log file (with the current timestamp in the name).
+createEmptyLog :: FilePath -> LogFormat -> IO FilePath
+createEmptyLog subDirForLogs format = do
+  ts <- formatTime defaultTimeLocale timeStampFormat . systemToUTCTime <$> getSystemTime
+  let pathToLog = subDirForLogs </> logPrefix <> ts <.> logExtension format
+  BS.writeFile pathToLog BS.empty
+  return pathToLog
+
+-- | Create a new log file and move existing symlink
+--   from the old log file to the new one.
+--
+-- It is technically possible that, during checking if the current log is full,
+-- another thread is writing in the current log (via its symbolic link). If so,
+-- we cannot switch to the new log file to avoid writing interruption. That's why
+-- we use 'Lock'.
+createEmptyLogAndUpdateSymLink
   :: Lock
   -> HandleRegistryKey
   -> HandleRegistry
   -> FilePath
   -> IO ()
-createEmptyLogRotation currentLogLock key registry subDirForLogs = do
+createEmptyLogAndUpdateSymLink currentLogLock key registry subDirForLogs = do
+  newLog <- createEmptyLog subDirForLogs format
+  whenM (doesFileExist tmpSymLink) $ removeFile tmpSymLink
+  createFileLink newLog tmpSymLink
+   withLock currentLogLock $
+     renamePath tmpSymLink realSymLink -- Atomic operation (uses POSIX.rename function).
+  where
+   tmpSymLink  = subDirForLogs </> symLinkNameTmp format
+   realSymLink = subDirForLogs </> symLinkName format
+
+-- old: createEmptyLogRotation
+-- old: createLogAndUpdateSymlink
+createEmptyLogRotationAndUpdateSymlink
+  :: Lock
+  -> HandleRegistryKey
+  -> HandleRegistry
+  -> FilePath
+  -> IO ()
+createEmptyLogRotationAndUpdateSymlink currentLogLock key 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
+  filePath <- createEmptyLogRotationAndUpdateSymlink currentLogLock key registry subDirForLogs
+  undefined 
 
 -- | Create an empty log file (with the current timestamp in the name).
-createOrUpdateEmptyLog :: Lock -> HandleRegistryKey -> HandleRegistry -> FilePath -> IO ()
+createOrUpdateEmptyLog :: Lock -> HandleRegistryKey -> HandleRegistry -> FilePath -> IO FilePath
 createOrUpdateEmptyLog currentLogLock key@(_, LoggingParams{logFormat = format}) registry subDirForLogs = do
   withLock currentLogLock do
     ts <- formatTime defaultTimeLocale timeStampFormat . systemToUTCTime <$> getSystemTime
@@ -73,6 +139,7 @@ createOrUpdateEmptyLog currentLogLock key@(_, LoggingParams{logFormat = format})
       newHandle <- openFile pathToLog WriteMode
       let newMap = Map.insert key (newHandle, pathToLog) handles
       pure newMap
+    pure pathToLog
 
 getTimeStampFromLog :: FilePath -> Maybe UTCTime
 getTimeStampFromLog pathToLog =
@@ -82,3 +149,4 @@ getTimeStampFromLog pathToLog =
 
 timeStampFormat :: String
 timeStampFormat = "%Y-%m-%dT%H-%M-%S"
+