From c30bba7ddf960a8c05170320d69b5401932eb91a Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 27 Jan 2023 10:32:48 -0400 Subject: [PATCH] Renmove cardano-cli's dependency on cardano-node --- cardano-cli/cardano-cli.cabal | 4 +- cardano-cli/test/Test/Cli/FilePermissions.hs | 80 +++++++++++++++++++- cardano-node/src/Cardano/Node/Run.hs | 71 +++++++++-------- 3 files changed, 121 insertions(+), 34 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 3bac5ac4097..4f51d15ecea 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -168,6 +168,8 @@ executable cardano-cli test-suite cardano-cli-test import: project-config + , maybe-Win32 + , maybe-unix hs-source-dirs: test main-is: cardano-cli-test.hs @@ -179,7 +181,6 @@ test-suite cardano-cli-test , cardano-api , cardano-api:gen , cardano-cli - , cardano-node , cardano-prelude , cardano-slotting ^>= 0.1 , containers @@ -192,6 +193,7 @@ test-suite cardano-cli-test , text , time , transformers + , transformers-except , yaml other-modules: Test.Config.Mainnet diff --git a/cardano-cli/test/Test/Cli/FilePermissions.hs b/cardano-cli/test/Test/Cli/FilePermissions.hs index 0c0c0901cce..32d6c5c17da 100644 --- a/cardano-cli/test/Test/Cli/FilePermissions.hs +++ b/cardano-cli/test/Test/Cli/FilePermissions.hs @@ -1,14 +1,31 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} +#if !defined(mingw32_HOST_OS) +#define UNIX +#endif + module Test.Cli.FilePermissions ( tests ) where -import Cardano.Prelude +import Prelude + +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.Except +import Control.Monad.Trans.Except.Extra +import Data.Text (Text) +import qualified Data.Text as Text +#ifdef UNIX +import System.Posix.Files +import System.Posix.Types (FileMode) +#else +import System.Win32.File +#endif -import Cardano.Node.Run (checkVRFFilePermissions) import Hedgehog (Property, discover, success) import qualified Hedgehog import qualified Hedgehog.Extras.Test.Base as H @@ -40,6 +57,65 @@ prop_createVRFSigningKeyFilePermissions = \file with the wrong permissions: " <> show err Right () -> success +data VRFPrivateKeyFilePermissionError + = OtherPermissionsExist !FilePath + | GroupPermissionsExist !FilePath + | GenericPermissionsExist !FilePath + deriving Show + +renderVRFPrivateKeyFilePermissionError :: VRFPrivateKeyFilePermissionError -> Text +renderVRFPrivateKeyFilePermissionError err = + case err of + OtherPermissionsExist fp -> + "VRF private key file at: " <> Text.pack fp + <> " has \"other\" file permissions. Please remove all \"other\" file permissions." + + GroupPermissionsExist fp -> + "VRF private key file at: " <> Text.pack fp + <> "has \"group\" file permissions. Please remove all \"group\" file permissions." + GenericPermissionsExist fp -> + "VRF private key file at: " <> Text.pack fp + <> "has \"generic\" file permissions. Please remove all \"generic\" file permissions." + + +-- | Make sure the VRF private key file is readable only +-- by the current process owner the node is running under. +checkVRFFilePermissions :: FilePath -> ExceptT VRFPrivateKeyFilePermissionError IO () +#ifdef UNIX +checkVRFFilePermissions 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) + -- Check the the VRF private key file does not give read/write/exec permissions to any group. + when (hasGroupPermissions fm) + (left $ GroupPermissionsExist vrfPrivKey) + where + hasPermission :: FileMode -> FileMode -> Bool + hasPermission fModeA fModeB = fModeA `intersectFileModes` fModeB /= nullFileMode + + hasOtherPermissions :: FileMode -> Bool + hasOtherPermissions fm' = fm' `hasPermission` otherModes + + hasGroupPermissions :: FileMode -> Bool + hasGroupPermissions fm' = fm' `hasPermission` groupModes +#else +checkVRFFilePermissions 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 + -- https://docs.microsoft.com/en-us/windows/win32/secauthz/standard-access-rights + -- https://docs.microsoft.com/en-us/windows/win32/secauthz/generic-access-rights + -- https://docs.microsoft.com/en-us/windows/win32/secauthz/access-mask + when (attribs `hasPermission` genericPermissions) + (left $ GenericPermissionsExist vrfPrivKey) + where + genericPermissions = gENERIC_ALL .|. gENERIC_READ .|. gENERIC_WRITE .|. gENERIC_EXECUTE + hasPermission fModeA fModeB = fModeA .&. fModeB /= gENERIC_NONE +#endif + + -- ----------------------------------------------------------------------------- tests :: IO Bool diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 197ab528af4..7cfc1a80107 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -19,15 +19,24 @@ module Cardano.Node.Run ) where import qualified Cardano.Api as Api -import Cardano.Prelude hiding (ByteString, STM, atomically, show, take, trace) -import Data.IP (toSockAddr) -import Prelude (String, id, show) +import Prelude +import Control.Concurrent import Control.Concurrent.Class.MonadSTM.Strict -import Control.Monad.Trans.Except.Extra (left) +import Control.Exception +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Except +import Control.Monad.Trans.Except.Extra import "contra-tracer" Control.Tracer +import Data.Either +import Data.IP (toSockAddr) +import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Text (breakOn, pack, take) +import Data.Maybe +import Data.Monoid +import Data.Proxy +import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.Time.Clock (getCurrentTime) @@ -37,6 +46,7 @@ import Network.HostName (getHostName) import Network.Socket (Socket) import System.Directory (canonicalizePath, createDirectoryIfMissing, makeAbsolute) import System.Environment (lookupEnv) +import System.Exit #ifdef UNIX import GHC.Weak (deRefWeak) @@ -61,12 +71,23 @@ import Cardano.Node.Configuration.NodeAddress import Cardano.Node.Configuration.POM (NodeConfiguration (..), PartialNodeConfiguration (..), SomeNetworkP2PMode (..), defaultPartialNodeConfiguration, makeNodeConfiguration, parseNodeConfigurationFP) +import Cardano.Node.Configuration.Socket (SocketOrSocketInfo (..), + gatherConfiguredSockets, getSocketOrSocketInfoAddr) +import qualified Cardano.Node.Configuration.Topology as TopologyNonP2P +import Cardano.Node.Configuration.TopologyP2P +import qualified Cardano.Node.Configuration.TopologyP2P as TopologyP2P +import Cardano.Node.Handlers.Shutdown +import Cardano.Node.Protocol (mkConsensusProtocol) +import Cardano.Node.Protocol.Types +import Cardano.Node.Queries import Cardano.Node.Startup +import Cardano.Node.TraceConstraints (TraceConstraints) import Cardano.Node.Tracing.API import Cardano.Node.Tracing.StateRep (NodeState (NodeKernelOnline)) import Cardano.Node.Tracing.Tracers.Startup (getStartupInfo) import Cardano.Node.Types import Cardano.Tracing.Config (TraceOptions (..), TraceSelection (..)) +import Cardano.Tracing.Tracers import qualified Ouroboros.Consensus.Config as Consensus import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..)) @@ -87,18 +108,6 @@ import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPo import Ouroboros.Network.Subscription (DnsSubscriptionTarget (..), IPSubscriptionTarget (..)) -import Cardano.Node.Configuration.Socket (SocketOrSocketInfo (..), - gatherConfiguredSockets, getSocketOrSocketInfoAddr) -import qualified Cardano.Node.Configuration.Topology as TopologyNonP2P -import Cardano.Node.Configuration.TopologyP2P -import qualified Cardano.Node.Configuration.TopologyP2P as TopologyP2P -import Cardano.Node.Handlers.Shutdown -import Cardano.Node.Protocol (mkConsensusProtocol) -import Cardano.Node.Protocol.Types -import Cardano.Node.Queries -import Cardano.Node.TraceConstraints (TraceConstraints) -import Cardano.Tracing.Tracers - {- HLINT ignore "Fuse concatMap/map" -} {- HLINT ignore "Redundant <$>" -} {- HLINT ignore "Use fewer imports" -} @@ -115,7 +124,7 @@ runNode cmdPc = do configYamlPc <- parseNodeConfigurationFP . getLast $ pncConfigFile cmdPc nc <- case makeNodeConfiguration $ defaultPartialNodeConfiguration <> configYamlPc <> cmdPc of - Left err -> panic $ "Error in creating the NodeConfiguration: " <> Text.pack err + Left err -> error $ "Error in creating the NodeConfiguration: " <> err Right nc' -> return nc' putStrLn $ "Node configuration: " <> show nc @@ -124,7 +133,7 @@ runNode cmdPc = do Just vrfFp -> do vrf <- runExceptT $ checkVRFFilePermissions vrfFp case vrf of Left err -> - putTextLn (renderVRFPrivateKeyFilePermissionError err) >> exitFailure + putStrLn (Text.unpack $ renderVRFPrivateKeyFilePermissionError err) >> exitFailure Right () -> pure () Nothing -> pure () @@ -214,10 +223,10 @@ handleNodeWithTracers cmdPc nc p networkMagic runP = do p loggingLayer <- case eLoggingLayer of - Left err -> putTextLn (Text.pack $ show err) >> exitFailure + Left err -> print err >> exitFailure Right res -> return res !trace <- setupTrace loggingLayer - let tracer = contramap pack $ toLogObject trace + let tracer = contramap Text.pack $ toLogObject trace logTracingVerbosity nc tracer -- Legacy logging infrastructure must trace 'nodeStartTime' and 'nodeBasicInfo'. @@ -282,14 +291,14 @@ setupTrace :: LoggingLayer -> IO (Trace IO Text) setupTrace loggingLayer = do - hn <- maybe hostname (pure . pack) =<< lookupEnv "CARDANO_NODE_LOGGING_HOSTNAME" - return $ - setHostname hn $ - llAppendName loggingLayer "node" (llBasicTrace loggingLayer) + hn <- maybe hostname (return . Text.pack) =<< lookupEnv "CARDANO_NODE_LOGGING_HOSTNAME" + return . setHostname hn $ + llAppendName loggingLayer "node" (llBasicTrace loggingLayer) where - hostname = do - hn0 <- pack <$> getHostName - return $ take 8 $ fst $ breakOn "." hn0 + hostname :: IO Text + hostname = do + hn0 <- Text.pack <$> getHostName + return $ Text.take 8 $ fst $ Text.breakOn "." hn0 {- -- TODO: needs to be finished (issue #4362) @@ -522,11 +531,11 @@ handleSimpleNode runP p2pMode tracers nc onKernel = do Signals.Catch $ do traceWith (startupTracer tracers) NetworkConfigUpdate result <- try $ TopologyP2P.readTopologyFileOrError (startupTracer tracers) nc - case result of - Left (FatalError err) -> + case result :: Either IOException NetworkTopology of + Left err -> traceWith (startupTracer tracers) $ NetworkConfigUpdateError - $ pack "Error reading topology configuration file:" <> err + $ Text.pack $ "Error reading topology configuration file:" <> show err Right nt -> do let (localRoots, publicRoots) = producerAddresses nt traceWith (startupTracer tracers)