Skip to content

Commit c30bba7

Browse files
Jimbo4350Jimbo4350
committed
Renmove cardano-cli's dependency on cardano-node
1 parent 9ab4b98 commit c30bba7

File tree

3 files changed

+121
-34
lines changed

3 files changed

+121
-34
lines changed

‎cardano-cli/cardano-cli.cabal

+3-1
Original file line numberDiff line numberDiff line change
@@ -168,6 +168,8 @@ executable cardano-cli
168168

169169
test-suite cardano-cli-test
170170
import: project-config
171+
, maybe-Win32
172+
, maybe-unix
171173

172174
hs-source-dirs: test
173175
main-is: cardano-cli-test.hs
@@ -179,7 +181,6 @@ test-suite cardano-cli-test
179181
, cardano-api
180182
, cardano-api:gen
181183
, cardano-cli
182-
, cardano-node
183184
, cardano-prelude
184185
, cardano-slotting ^>= 0.1
185186
, containers
@@ -192,6 +193,7 @@ test-suite cardano-cli-test
192193
, text
193194
, time
194195
, transformers
196+
, transformers-except
195197
, yaml
196198

197199
other-modules: Test.Config.Mainnet

‎cardano-cli/test/Test/Cli/FilePermissions.hs

+78-2
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,31 @@
1+
{-# LANGUAGE CPP #-}
12
{-# LANGUAGE OverloadedStrings #-}
23
{-# LANGUAGE TemplateHaskell #-}
34

5+
#if !defined(mingw32_HOST_OS)
6+
#define UNIX
7+
#endif
8+
49
module Test.Cli.FilePermissions
510
( tests
611
) where
712

8-
import Cardano.Prelude
13+
import Prelude
14+
15+
import Control.Monad
16+
import Control.Monad.IO.Class
17+
import Control.Monad.Trans.Except
18+
import Control.Monad.Trans.Except.Extra
19+
import Data.Text (Text)
20+
import qualified Data.Text as Text
921

22+
#ifdef UNIX
23+
import System.Posix.Files
24+
import System.Posix.Types (FileMode)
25+
#else
26+
import System.Win32.File
27+
#endif
1028

11-
import Cardano.Node.Run (checkVRFFilePermissions)
1229
import Hedgehog (Property, discover, success)
1330
import qualified Hedgehog
1431
import qualified Hedgehog.Extras.Test.Base as H
@@ -40,6 +57,65 @@ prop_createVRFSigningKeyFilePermissions =
4057
\file with the wrong permissions: " <> show err
4158
Right () -> success
4259

60+
data VRFPrivateKeyFilePermissionError
61+
= OtherPermissionsExist !FilePath
62+
| GroupPermissionsExist !FilePath
63+
| GenericPermissionsExist !FilePath
64+
deriving Show
65+
66+
renderVRFPrivateKeyFilePermissionError :: VRFPrivateKeyFilePermissionError -> Text
67+
renderVRFPrivateKeyFilePermissionError err =
68+
case err of
69+
OtherPermissionsExist fp ->
70+
"VRF private key file at: " <> Text.pack fp
71+
<> " has \"other\" file permissions. Please remove all \"other\" file permissions."
72+
73+
GroupPermissionsExist fp ->
74+
"VRF private key file at: " <> Text.pack fp
75+
<> "has \"group\" file permissions. Please remove all \"group\" file permissions."
76+
GenericPermissionsExist fp ->
77+
"VRF private key file at: " <> Text.pack fp
78+
<> "has \"generic\" file permissions. Please remove all \"generic\" file permissions."
79+
80+
81+
-- | Make sure the VRF private key file is readable only
82+
-- by the current process owner the node is running under.
83+
checkVRFFilePermissions :: FilePath -> ExceptT VRFPrivateKeyFilePermissionError IO ()
84+
#ifdef UNIX
85+
checkVRFFilePermissions vrfPrivKey = do
86+
fs <- liftIO $ getFileStatus vrfPrivKey
87+
let fm = fileMode fs
88+
-- Check the the VRF private key file does not give read/write/exec permissions to others.
89+
when (hasOtherPermissions fm)
90+
(left $ OtherPermissionsExist vrfPrivKey)
91+
-- Check the the VRF private key file does not give read/write/exec permissions to any group.
92+
when (hasGroupPermissions fm)
93+
(left $ GroupPermissionsExist vrfPrivKey)
94+
where
95+
hasPermission :: FileMode -> FileMode -> Bool
96+
hasPermission fModeA fModeB = fModeA `intersectFileModes` fModeB /= nullFileMode
97+
98+
hasOtherPermissions :: FileMode -> Bool
99+
hasOtherPermissions fm' = fm' `hasPermission` otherModes
100+
101+
hasGroupPermissions :: FileMode -> Bool
102+
hasGroupPermissions fm' = fm' `hasPermission` groupModes
103+
#else
104+
checkVRFFilePermissions vrfPrivKey = do
105+
attribs <- liftIO $ getFileAttributes vrfPrivKey
106+
-- https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilea
107+
-- https://docs.microsoft.com/en-us/windows/win32/fileio/file-access-rights-constants
108+
-- https://docs.microsoft.com/en-us/windows/win32/secauthz/standard-access-rights
109+
-- https://docs.microsoft.com/en-us/windows/win32/secauthz/generic-access-rights
110+
-- https://docs.microsoft.com/en-us/windows/win32/secauthz/access-mask
111+
when (attribs `hasPermission` genericPermissions)
112+
(left $ GenericPermissionsExist vrfPrivKey)
113+
where
114+
genericPermissions = gENERIC_ALL .|. gENERIC_READ .|. gENERIC_WRITE .|. gENERIC_EXECUTE
115+
hasPermission fModeA fModeB = fModeA .&. fModeB /= gENERIC_NONE
116+
#endif
117+
118+
43119
-- -----------------------------------------------------------------------------
44120

45121
tests :: IO Bool

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

+40-31
Original file line numberDiff line numberDiff line change
@@ -19,15 +19,24 @@ module Cardano.Node.Run
1919
) where
2020

2121
import qualified Cardano.Api as Api
22-
import Cardano.Prelude hiding (ByteString, STM, atomically, show, take, trace)
23-
import Data.IP (toSockAddr)
24-
import Prelude (String, id, show)
22+
import Prelude
2523

24+
import Control.Concurrent
2625
import Control.Concurrent.Class.MonadSTM.Strict
27-
import Control.Monad.Trans.Except.Extra (left)
26+
import Control.Exception
27+
import Control.Monad
28+
import Control.Monad.IO.Class (liftIO)
29+
import Control.Monad.Trans.Except
30+
import Control.Monad.Trans.Except.Extra
2831
import "contra-tracer" Control.Tracer
32+
import Data.Either
33+
import Data.IP (toSockAddr)
34+
import Data.Map.Strict (Map)
2935
import qualified Data.Map.Strict as Map
30-
import Data.Text (breakOn, pack, take)
36+
import Data.Maybe
37+
import Data.Monoid
38+
import Data.Proxy
39+
import Data.Text (Text)
3140
import qualified Data.Text as Text
3241
import qualified Data.Text.Encoding as Text
3342
import Data.Time.Clock (getCurrentTime)
@@ -37,6 +46,7 @@ import Network.HostName (getHostName)
3746
import Network.Socket (Socket)
3847
import System.Directory (canonicalizePath, createDirectoryIfMissing, makeAbsolute)
3948
import System.Environment (lookupEnv)
49+
import System.Exit
4050

4151
#ifdef UNIX
4252
import GHC.Weak (deRefWeak)
@@ -61,12 +71,23 @@ import Cardano.Node.Configuration.NodeAddress
6171
import Cardano.Node.Configuration.POM (NodeConfiguration (..),
6272
PartialNodeConfiguration (..), SomeNetworkP2PMode (..),
6373
defaultPartialNodeConfiguration, makeNodeConfiguration, parseNodeConfigurationFP)
74+
import Cardano.Node.Configuration.Socket (SocketOrSocketInfo (..),
75+
gatherConfiguredSockets, getSocketOrSocketInfoAddr)
76+
import qualified Cardano.Node.Configuration.Topology as TopologyNonP2P
77+
import Cardano.Node.Configuration.TopologyP2P
78+
import qualified Cardano.Node.Configuration.TopologyP2P as TopologyP2P
79+
import Cardano.Node.Handlers.Shutdown
80+
import Cardano.Node.Protocol (mkConsensusProtocol)
81+
import Cardano.Node.Protocol.Types
82+
import Cardano.Node.Queries
6483
import Cardano.Node.Startup
84+
import Cardano.Node.TraceConstraints (TraceConstraints)
6585
import Cardano.Node.Tracing.API
6686
import Cardano.Node.Tracing.StateRep (NodeState (NodeKernelOnline))
6787
import Cardano.Node.Tracing.Tracers.Startup (getStartupInfo)
6888
import Cardano.Node.Types
6989
import Cardano.Tracing.Config (TraceOptions (..), TraceSelection (..))
90+
import Cardano.Tracing.Tracers
7091

7192
import qualified Ouroboros.Consensus.Config as Consensus
7293
import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..))
@@ -87,18 +108,6 @@ import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPo
87108
import Ouroboros.Network.Subscription (DnsSubscriptionTarget (..),
88109
IPSubscriptionTarget (..))
89110

90-
import Cardano.Node.Configuration.Socket (SocketOrSocketInfo (..),
91-
gatherConfiguredSockets, getSocketOrSocketInfoAddr)
92-
import qualified Cardano.Node.Configuration.Topology as TopologyNonP2P
93-
import Cardano.Node.Configuration.TopologyP2P
94-
import qualified Cardano.Node.Configuration.TopologyP2P as TopologyP2P
95-
import Cardano.Node.Handlers.Shutdown
96-
import Cardano.Node.Protocol (mkConsensusProtocol)
97-
import Cardano.Node.Protocol.Types
98-
import Cardano.Node.Queries
99-
import Cardano.Node.TraceConstraints (TraceConstraints)
100-
import Cardano.Tracing.Tracers
101-
102111
{- HLINT ignore "Fuse concatMap/map" -}
103112
{- HLINT ignore "Redundant <$>" -}
104113
{- HLINT ignore "Use fewer imports" -}
@@ -115,7 +124,7 @@ runNode cmdPc = do
115124
configYamlPc <- parseNodeConfigurationFP . getLast $ pncConfigFile cmdPc
116125

117126
nc <- case makeNodeConfiguration $ defaultPartialNodeConfiguration <> configYamlPc <> cmdPc of
118-
Left err -> panic $ "Error in creating the NodeConfiguration: " <> Text.pack err
127+
Left err -> error $ "Error in creating the NodeConfiguration: " <> err
119128
Right nc' -> return nc'
120129

121130
putStrLn $ "Node configuration: " <> show nc
@@ -124,7 +133,7 @@ runNode cmdPc = do
124133
Just vrfFp -> do vrf <- runExceptT $ checkVRFFilePermissions vrfFp
125134
case vrf of
126135
Left err ->
127-
putTextLn (renderVRFPrivateKeyFilePermissionError err) >> exitFailure
136+
putStrLn (Text.unpack $ renderVRFPrivateKeyFilePermissionError err) >> exitFailure
128137
Right () ->
129138
pure ()
130139
Nothing -> pure ()
@@ -214,10 +223,10 @@ handleNodeWithTracers cmdPc nc p networkMagic runP = do
214223
p
215224

216225
loggingLayer <- case eLoggingLayer of
217-
Left err -> putTextLn (Text.pack $ show err) >> exitFailure
226+
Left err -> print err >> exitFailure
218227
Right res -> return res
219228
!trace <- setupTrace loggingLayer
220-
let tracer = contramap pack $ toLogObject trace
229+
let tracer = contramap Text.pack $ toLogObject trace
221230
logTracingVerbosity nc tracer
222231

223232
-- Legacy logging infrastructure must trace 'nodeStartTime' and 'nodeBasicInfo'.
@@ -282,14 +291,14 @@ setupTrace
282291
:: LoggingLayer
283292
-> IO (Trace IO Text)
284293
setupTrace loggingLayer = do
285-
hn <- maybe hostname (pure . pack) =<< lookupEnv "CARDANO_NODE_LOGGING_HOSTNAME"
286-
return $
287-
setHostname hn $
288-
llAppendName loggingLayer "node" (llBasicTrace loggingLayer)
294+
hn <- maybe hostname (return . Text.pack) =<< lookupEnv "CARDANO_NODE_LOGGING_HOSTNAME"
295+
return . setHostname hn $
296+
llAppendName loggingLayer "node" (llBasicTrace loggingLayer)
289297
where
290-
hostname = do
291-
hn0 <- pack <$> getHostName
292-
return $ take 8 $ fst $ breakOn "." hn0
298+
hostname :: IO Text
299+
hostname = do
300+
hn0 <- Text.pack <$> getHostName
301+
return $ Text.take 8 $ fst $ Text.breakOn "." hn0
293302

294303
{-
295304
-- TODO: needs to be finished (issue #4362)
@@ -522,11 +531,11 @@ handleSimpleNode runP p2pMode tracers nc onKernel = do
522531
Signals.Catch $ do
523532
traceWith (startupTracer tracers) NetworkConfigUpdate
524533
result <- try $ TopologyP2P.readTopologyFileOrError (startupTracer tracers) nc
525-
case result of
526-
Left (FatalError err) ->
534+
case result :: Either IOException NetworkTopology of
535+
Left err ->
527536
traceWith (startupTracer tracers)
528537
$ NetworkConfigUpdateError
529-
$ pack "Error reading topology configuration file:" <> err
538+
$ Text.pack $ "Error reading topology configuration file:" <> show err
530539
Right nt -> do
531540
let (localRoots, publicRoots) = producerAddresses nt
532541
traceWith (startupTracer tracers)

0 commit comments

Comments
 (0)