Add --skip-key-group-permission-check command line argument, disabling group permissions check for VRF key.

Author: carbolymer

bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs

@@ -74,6 +74,7 @@ mkNodeConfig configFp_
                  , shelleyVRFFile = Just ""
                  , shelleyCertFile = Just ""
                  , shelleyBulkCredsFile = Just ""
+                 , isGroupPermissionChecked = def
                  }
                , pncValidateDB = Last $ Just False
                , pncShutdownConfig = Last $ Just $ ShutdownConfig Nothing Nothing

cardano-node/ChangeLog.md

@@ -30,6 +30,8 @@
 - KeepAlive client tracing: dropped `KeepAliveClient` from `kind` of
   `AddSample` messages in the legacy tracing system.
 
+- Add `--skip-key-group-permission-check` command line argument, disabling group permissions check for VRF key.
+
 ## 10.2 -- January 2025
 
 - Use p2p network stack by default, warn when using the legacy network stack.

cardano-node/cardano-node.cabal

@@ -172,6 +172,7 @@ library
                       , dns
                       , ekg-wai
                       , ekg-core
+                      , extra
                       , filepath
                       , formatting
                       , generic-data
@@ -263,6 +264,7 @@ test-suite cardano-node-test
                       , cardano-protocol-tpraos
                       , cardano-node
                       , cardano-slotting
+                      , data-default-class
                       , directory
                       , filepath
                       , hedgehog

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -45,20 +45,21 @@ import           Ouroboros.Consensus.Node (NodeDatabasePaths (..))
 import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..))
 import           Ouroboros.Consensus.Node.Genesis (GenesisConfig, GenesisConfigFlags,
                    defaultGenesisConfigFlags, mkGenesisConfig)
-import qualified Ouroboros.Network.Diffusion.Configuration as Ouroboros
-import           Ouroboros.Network.Mux (ForkPolicy, noBindForkPolicy, responderForkPolicy)
-import qualified Ouroboros.Network.PeerSelection.Governor as PeerSelection
 import           Ouroboros.Consensus.Storage.LedgerDB.Args (QueryBatchSize (..))
 import           Ouroboros.Consensus.Storage.LedgerDB.Snapshots (NumOfDiskSnapshots (..),
                    SnapshotInterval (..))
 import           Ouroboros.Consensus.Storage.LedgerDB.V1.Args (FlushFrequency (..))
 import           Ouroboros.Network.Diffusion.Configuration as Configuration
+import qualified Ouroboros.Network.Diffusion.Configuration as Ouroboros
+import           Ouroboros.Network.Mux (ForkPolicy, noBindForkPolicy, responderForkPolicy)
+import qualified Ouroboros.Network.PeerSelection.Governor as PeerSelection
 
 import           Control.Concurrent (getNumCapabilities)
 import           Control.Monad (unless, void, when)
 import           Data.Aeson
 import qualified Data.Aeson.Types as Aeson
 import           Data.Bifunctor (Bifunctor (..))
+import           Data.Default.Class
 import           Data.Hashable (Hashable)
 import           Data.Maybe
 import           Data.Monoid (Last (..))
@@ -825,7 +826,7 @@ makeNodeConfiguration pnc = do
                  -- they are not minting blocks.
                  case getLast $ pncProtocolFiles pnc of
                    Just pFiles -> pFiles
-                   Nothing -> ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing
+                   Nothing -> ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing def
              , ncValidateDB = validateDB
              , ncShutdownConfig = shutdownConfig
              , ncStartAsNonProducingNode = startAsNonProducingNode

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

@@ -23,6 +23,7 @@ import           Cardano.Prelude (ConvertText (..))
 import           Ouroboros.Consensus.Ledger.SupportsMempool
 import           Ouroboros.Consensus.Node
 
+import           Data.Default.Class
 import           Data.Foldable
 import           Data.Maybe (fromMaybe)
 import           Data.Monoid (Last (..))
@@ -31,6 +32,7 @@ import           Data.Word (Word32)
 import           Options.Applicative hiding (str)
 import qualified Options.Applicative as Opt
 import qualified Options.Applicative.Help as OptI
+import           System.Info.Extra (isWindows)
 import           System.Posix.Types (Fd (..))
 import           Text.Read (readMaybe)
 
@@ -60,6 +62,7 @@ nodeRunParser = do
   shelleyVRFFile  <- optional parseVrfKeyFilePath
   shelleyCertFile <- optional parseOperationalCertFilePath
   shelleyBulkCredsFile <- optional parseBulkCredsFilePath
+  isGroupPermissionChecked <- parseSkipGroupPermissionCheck
   startAsNonProducingNode <- lastOption parseStartAsNonProducingNode
 
   -- Node Address
@@ -93,6 +96,7 @@ nodeRunParser = do
              , shelleyVRFFile
              , shelleyCertFile
              , shelleyBulkCredsFile
+             , isGroupPermissionChecked
              }
            , pncValidateDB = validate
            , pncShutdownConfig =
@@ -349,6 +353,15 @@ parseVrfKeyFilePath =
         <> completer (bashCompleter "file")
     )
 
+parseSkipGroupPermissionCheck :: Parser IsGroupPermissionChecked
+parseSkipGroupPermissionCheck = asum
+  [ whenA (not isWindows) $
+      flag def SkipFileGroupPermissionCheck $
+        long "skip-key-group-permission-check"
+            <> help "Skip checking of group permissions for the key files."
+  , pure def
+  ]
+
 parseStartAsNonProducingNode :: Parser Bool
 parseStartAsNonProducingNode =
   switch $ mconcat
@@ -373,3 +386,6 @@ parserHelpOptions = fromMaybe mempty . OptI.unChunk . OptI.fullDesc (Opt.prefs m
 renderHelpDoc :: Int -> OptI.Doc -> String
 renderHelpDoc cols =
   (`OptI.renderShowS` "") . OptI.layoutPretty (OptI.LayoutOptions (OptI.AvailablePerLine cols 1.0))
+
+whenA :: Alternative f => Bool -> f a -> f a
+whenA cond v = if cond then v else empty

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

@@ -123,7 +123,7 @@ import           Ouroboros.Network.Subscription (DnsSubscriptionTarget (..),
 
 import           Control.Concurrent (killThread, mkWeakThreadId, myThreadId, getNumCapabilities)
 import           Control.Concurrent.Class.MonadSTM.Strict
-import           Control.Exception (try, IOException)
+import           Control.Exception (try, Exception, IOException)
 import qualified Control.Exception as Exception
 import           Control.Monad (forM, forM_, unless, void, when)
 import           Control.Monad.Class.MonadThrow (MonadThrow (..))
@@ -185,34 +185,24 @@ runNode cmdPc = do
 
     putStrLn $ "Node configuration: " <> show nc
 
-    case shelleyVRFFile $ ncProtocolFiles nc of
-      Just vrfFp -> do vrf <- runExceptT $ checkVRFFilePermissions (File vrfFp)
-                       case vrf of
-                         Left err -> Exception.throwIO err
-                         Right () ->
-                           pure ()
-      Nothing -> pure ()
-
-    eitherSomeProtocol <- runExceptT $ mkConsensusProtocol
-                                         (ncProtocolConfig nc)
-                                         -- TODO: Convert ncProtocolFiles to Maybe as relay nodes
-                                         -- don't need these.
-                                         (Just $ ncProtocolFiles nc)
-
-    p :: SomeConsensusProtocol <-
-      case eitherSomeProtocol of
-        Left err -> Exception.throwIO err
-        Right p  -> pure p
-
-    let networkMagic :: Api.NetworkMagic =
-          case p of
-            SomeConsensusProtocol _ runP ->
-              let ProtocolInfo { pInfoConfig } = fst $ Api.protocolInfo @IO runP
-              in getNetworkMagic $ Consensus.configBlock pInfoConfig
-
-    case p of
-      SomeConsensusProtocol blockType runP ->
-        handleNodeWithTracers cmdPc nc p networkMagic blockType runP
+    case ncProtocolFiles nc of
+      ProtocolFilepaths{shelleyVRFFile=Just vrfFp, isGroupPermissionChecked} ->
+        runThrowExceptT $
+          checkVRFFilePermissions isGroupPermissionChecked (File vrfFp)
+      _ -> pure ()
+
+    consensusProtocol <-
+      runThrowExceptT $
+        mkConsensusProtocol
+         (ncProtocolConfig nc)
+         -- TODO: Convert ncProtocolFiles to Maybe as relay nodes
+         -- don't need these.
+         (Just $ ncProtocolFiles nc)
+
+    handleNodeWithTracers cmdPc nc consensusProtocol
+
+runThrowExceptT :: Exception e => ExceptT e IO a -> IO a
+runThrowExceptT act = runExceptT act >>= either Exception.throwIO pure
 
 -- | Workaround to ensure that the main thread throws an async exception on
 -- receiving a SIGTERM signal.
@@ -233,17 +223,13 @@ installSigTermHandler = do
   return ()
 
 handleNodeWithTracers
-  :: ( TraceConstraints blk
-     , Api.Protocol IO blk
-     )
-  => PartialNodeConfiguration
+  :: PartialNodeConfiguration
   -> NodeConfiguration
   -> SomeConsensusProtocol
-  -> Api.NetworkMagic
-  -> Api.BlockType blk
-  -> Api.ProtocolInfoArgs blk
   -> IO ()
-handleNodeWithTracers cmdPc nc0 p networkMagic blockType runP = do
+handleNodeWithTracers cmdPc nc0 p@(SomeConsensusProtocol blockType runP) = do
+  let ProtocolInfo{pInfoConfig} = fst $ Api.protocolInfo @IO runP
+      networkMagic :: Api.NetworkMagic = getNetworkMagic $ Consensus.configBlock pInfoConfig
   -- This IORef contains node kernel structure which holds node kernel.
   -- Used for ledger queries and peer connection status.
   nodeKernelData <- mkNodeKernelData
@@ -913,17 +899,18 @@ canonDbPath NodeConfiguration{ncDatabaseFile = nodeDatabaseFps} =
 
 -- | Make sure the VRF private key file is readable only
 -- by the current process owner the node is running under.
-checkVRFFilePermissions :: File content direction -> ExceptT VRFPrivateKeyFilePermissionError IO ()
+checkVRFFilePermissions :: IsGroupPermissionChecked -> File content direction -> ExceptT VRFPrivateKeyFilePermissionError IO ()
 #ifdef UNIX
-checkVRFFilePermissions (File vrfPrivKey) = do
+checkVRFFilePermissions isGroupPermissionChecked (File vrfPrivKey) = do
   fs <- liftIO $ getFileStatus vrfPrivKey
   let fm = fileMode fs
   -- Check the the VRF private key file does not give read/write/exec permissions to others.
-  when (hasOtherPermissions fm)
-       (left $ OtherPermissionsExist vrfPrivKey)
+  when (hasOtherPermissions fm) $
+     left $ OtherPermissionsExist vrfPrivKey
   -- Check the the VRF private key file does not give read/write/exec permissions to any group.
-  when (hasGroupPermissions fm)
-       (left $ GroupPermissionsExist vrfPrivKey)
+  when (isGroupPermissionChecked == CheckFileGroupPermission) $
+    when (hasGroupPermissions fm) $
+       left $ GroupPermissionsExist vrfPrivKey
  where
   hasPermission :: FileMode -> FileMode -> Bool
   hasPermission fModeA fModeB = fModeA `intersectFileModes` fModeB /= nullFileMode
@@ -934,7 +921,7 @@ checkVRFFilePermissions (File vrfPrivKey) = do
   hasGroupPermissions :: FileMode -> Bool
   hasGroupPermissions fm' = fm' `hasPermission` groupModes
 #else
-checkVRFFilePermissions (File vrfPrivKey) = do
+checkVRFFilePermissions _ (File vrfPrivKey) = do
   attribs <- liftIO $ getFileAttributes vrfPrivKey
   -- https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilea
   -- https://docs.microsoft.com/en-us/windows/win32/fileio/file-access-rights-constants

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

@@ -17,6 +17,7 @@ module Cardano.Node.Types
   , PeerSnapshotFile (..)
   , CheckpointsFile(..)
   , ProtocolFilepaths (..)
+  , IsGroupPermissionChecked(..)
   , GenesisHash(..)
   , CheckpointsHash(..)
   , MaxConcurrencyBulkSync(..)
@@ -50,6 +51,7 @@ import           Ouroboros.Network.NodeToNode (DiffusionMode (..))
 import           Control.Exception
 import           Data.Aeson
 import           Data.ByteString (ByteString)
+import           Data.Default.Class (Default (..))
 import           Data.Monoid (Last (..))
 import           Data.String (IsString)
 import           Data.Text (Text)
@@ -172,8 +174,17 @@ data ProtocolFilepaths =
      , shelleyVRFFile       :: !(Maybe FilePath)
      , shelleyCertFile      :: !(Maybe FilePath)
      , shelleyBulkCredsFile :: !(Maybe FilePath)
+     , isGroupPermissionChecked :: !IsGroupPermissionChecked
      } deriving (Eq, Show)
 
+data IsGroupPermissionChecked
+  = CheckFileGroupPermission
+  | SkipFileGroupPermissionCheck
+  deriving stock (Eq, Show)
+
+instance Default IsGroupPermissionChecked where
+  def = CheckFileGroupPermission
+
 newtype GenesisHash = GenesisHash (Crypto.Hash Crypto.Blake2b_256 ByteString)
   deriving newtype (Eq, Show, ToJSON, FromJSON)
 

cardano-node/test/Test/Cardano/Node/FilePermissions.hs

@@ -38,14 +38,14 @@ import           System.IO (FilePath, IO)
 import           Text.Show (Show (..))
 
 #ifdef UNIX
-import           Cardano.Node.Types (VRFPrivateKeyFilePermissionError (..))
+import           Cardano.Node.Types (VRFPrivateKeyFilePermissionError (..), IsGroupPermissionChecked(..))
 
 import           System.Posix.Files
 import           System.Posix.IO (closeFd, createFile)
 import           System.Posix.Types (FileMode)
 
 import           Control.Exception (bracket)
-import           Hedgehog (Gen, classify, forAll)
+import           Hedgehog 
 import qualified Hedgehog.Gen as Gen
 #endif
 
@@ -56,10 +56,10 @@ prop_createVRFFileWithOwnerPermissions :: Property
 prop_createVRFFileWithOwnerPermissions =
   property $ do
     let vrfSign = "vrf-signing-key"
-    vrfSkey <- liftIO $ generateSigningKey AsVrfKey
+    vrfSkey <- evalIO $ generateSigningKey AsVrfKey
     createFileWithOwnerPermissions vrfSign vrfSkey
 
-    fResult <- liftIO . runExceptT $ checkVRFFilePermissions vrfSign
+    fResult <- evalIO . runExceptT $ checkVRFFilePermissions CheckFileGroupPermission vrfSign
     case fResult of
       Left err -> failWith Nothing $ show err
       Right () -> liftIO (removeFile (unFile vrfSign)) >> success
@@ -84,7 +84,7 @@ prop_sanityCheck_checkVRFFilePermissions =
     correctResult <-
       liftIO $ bracket  (createFile (unFile vrfPrivateKeyCorrect) correctPermission)
                         (\h -> closeFd h >> removeFile (unFile vrfPrivateKeyCorrect))
-                        (const . liftIO . runExceptT $ checkVRFFilePermissions vrfPrivateKeyCorrect)
+                        (const . liftIO . runExceptT $ checkVRFFilePermissions CheckFileGroupPermission vrfPrivateKeyCorrect)
     case correctResult of
       Left err ->
         failWith Nothing $ "checkVRFFilePermissions should not have failed with error: "
@@ -105,7 +105,7 @@ prop_sanityCheck_checkVRFFilePermissions =
                             setFileMode (unFile vrfPrivateKeyOther) $ createPermissions oPermissions
                             return h)
                         (\h -> closeFd h >> removeFile (unFile vrfPrivateKeyOther))
-                        (const .liftIO . runExceptT $ checkVRFFilePermissions vrfPrivateKeyOther)
+                        (const .liftIO . runExceptT $ checkVRFFilePermissions CheckFileGroupPermission vrfPrivateKeyOther)
     case otherResult of
       Left (OtherPermissionsExist _) -> success
       Left err ->
@@ -128,7 +128,7 @@ prop_sanityCheck_checkVRFFilePermissions =
                             setFileMode (unFile vrfPrivateKeyGroup) $ createPermissions gPermissions
                             return h)
                         (\h -> closeFd h >> removeFile (unFile vrfPrivateKeyGroup))
-                        (const . liftIO . runExceptT $ checkVRFFilePermissions vrfPrivateKeyGroup)
+                        (const . liftIO . runExceptT $ checkVRFFilePermissions CheckFileGroupPermission vrfPrivateKeyGroup)
     case groupResult of
       Left (GroupPermissionsExist _) -> success
       Left err ->

cardano-node/test/Test/Cardano/Node/POM.hs

@@ -15,25 +15,26 @@ import           Cardano.Node.Handlers.Shutdown
 import           Cardano.Node.Types
 import           Cardano.Tracing.Config (PartialTraceOptions (..), defaultPartialTraceConfiguration,
                    partialTraceSelectionToEither)
+import           Ouroboros.Cardano.Network.Diffusion.Configuration (defaultNumberOfBigLedgerPeers)
 import           Ouroboros.Consensus.Node (NodeDatabasePaths (..))
 import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..))
 import           Ouroboros.Consensus.Node.Genesis (disableGenesisConfig)
+import           Ouroboros.Consensus.Storage.LedgerDB.Args
 import           Ouroboros.Consensus.Storage.LedgerDB.Snapshots (NumOfDiskSnapshots (..),
                    SnapshotInterval (..))
-import           Ouroboros.Consensus.Storage.LedgerDB.Args
 import           Ouroboros.Network.Block (SlotNo (..))
 import           Ouroboros.Network.Diffusion.Configuration (ConsensusMode (..))
 import           Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..),
                    DiffusionMode (InitiatorAndResponderDiffusionMode))
 import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 
+import           Data.Default.Class
 import           Data.Monoid (Last (..))
 import           Data.Text (Text)
 
 import           Hedgehog (Property, discover, withTests, (===))
 import qualified Hedgehog
 import           Hedgehog.Internal.Property (evalEither, failWith)
-import Ouroboros.Cardano.Network.Diffusion.Configuration (defaultNumberOfBigLedgerPeers)
 
 
 -- This is a simple test to check that the POM technique is working as intended.
@@ -181,7 +182,7 @@ testPartialCliConfig =
     , pncDatabaseFile = mempty
     , pncDiffusionMode = mempty
     , pncExperimentalProtocolsEnabled = Last $ Just True
-    , pncProtocolFiles = Last . Just $ ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing
+    , pncProtocolFiles = Last . Just $ ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing def
     , pncValidateDB = Last $ Just True
     , pncProtocolConfig = mempty
     , pncMaxConcurrencyBulkSync = mempty
@@ -227,7 +228,7 @@ eExpectedConfig = do
     , ncConfigFile = ConfigYamlFilePath "configuration/cardano/mainnet-config.json"
     , ncTopologyFile = TopologyFile "configuration/cardano/mainnet-topology.json"
     , ncDatabaseFile = OnePathForAllDbs "mainnet/db/"
-    , ncProtocolFiles = ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing
+    , ncProtocolFiles = ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing def
     , ncValidateDB = True
     , ncProtocolConfig = testNodeProtocolConfiguration
     , ncDiffusionMode = InitiatorAndResponderDiffusionMode