1
{-# LANGUAGE BangPatterns #-}
3
{-# LANGUAGE DataKinds #-}
4
{-# LANGUAGE FlexibleContexts #-}
6
{-# LANGUAGE NamedFieldPuns #-}
7
{-# LANGUAGE ScopedTypeVariables #-}
9
#if !defined(mingw32_HOST_OS)
13
module Cardano.Node.Run
15
, checkVRFFilePermissions
18
import Cardano.Prelude hiding (ByteString, atomically, take, trace)
19
import Prelude (String)
21
import qualified Control.Concurrent.Async as Async
22
import Control.Monad.Trans.Except.Extra (left)
24
import Data.Text (breakOn, pack, take)
25
import qualified Data.Text as Text
26
import Data.Time.Clock (getCurrentTime)
27
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
28
import Data.Version (showVersion)
29
import Network.HostName (getHostName)
30
import Network.Socket (AddrInfo, Socket)
31
import System.Directory (canonicalizePath, createDirectoryIfMissing, makeAbsolute)
32
import System.Environment (lookupEnv)
34
import System.Posix.Files
35
import System.Posix.Types (FileMode)
37
import System.Win32.File
40
import Cardano.BM.Data.LogItem (LOContent (..), LogObject (..), PrivacyAnnotation (..),
42
import Cardano.BM.Data.Tracer (ToLogObject (..), TracingVerbosity (..))
43
import Cardano.BM.Data.Transformers (setHostname)
44
import Cardano.BM.Trace
45
import Paths_cardano_node (version)
47
import qualified Cardano.Crypto.Libsodium as Crypto
49
import Cardano.Node.Configuration.Logging (LoggingLayer (..), Severity (..),
50
createLoggingLayer, nodeBasicInfo, shutdownLoggingLayer)
51
import Cardano.Node.Configuration.POM (NodeConfiguration (..),
52
PartialNodeConfiguration (..), defaultPartialNodeConfiguration,
53
makeNodeConfiguration, parseNodeConfigurationFP)
54
import Cardano.Node.Types
55
import Cardano.Tracing.Config (TraceOptions (..), TraceSelection (..))
56
import Cardano.Tracing.Constraints (TraceConstraints)
57
import Cardano.Tracing.Metrics (HasKESMetricsData (..), HasKESInfo (..))
59
import qualified Ouroboros.Consensus.Config as Consensus
60
import Ouroboros.Consensus.Config.SupportsNode (getNetworkMagic)
61
import Ouroboros.Consensus.Node (DiffusionArguments (..), DiffusionTracers (..),
62
DnsSubscriptionTarget (..), IPSubscriptionTarget (..), RunNode, RunNodeArgs (..),
64
import qualified Ouroboros.Consensus.Node as Node (getChainDB, run)
65
import Ouroboros.Consensus.Node.ProtocolInfo
66
import Ouroboros.Consensus.Util.Orphans ()
67
import Ouroboros.Network.Magic (NetworkMagic (..))
68
import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..), DiffusionMode)
70
import qualified Cardano.Api.Protocol.Types as Protocol
71
import Cardano.Node.Configuration.Socket (SocketOrSocketInfo (..),
72
gatherConfiguredSockets, getSocketOrSocketInfoAddr, renderSocketConfigError)
73
import Cardano.Node.Configuration.Topology
74
import Cardano.Node.Handlers.Shutdown
75
import Cardano.Node.Protocol (mkConsensusProtocol, renderProtocolInstantiationError)
76
import Cardano.Node.Protocol.Types
77
import Cardano.Tracing.Kernel
78
import Cardano.Tracing.Peer
79
import Cardano.Tracing.Tracers
81
{- HLINT ignore "Use fewer imports" -}
84
:: PartialNodeConfiguration
87
-- TODO: Remove sodiumInit: https://github.com/input-output-hk/cardano-base/issues/175
90
configYamlPc <- parseNodeConfigurationFP . getLast $ pncConfigFile cmdPc
92
nc <- case makeNodeConfiguration $ defaultPartialNodeConfiguration <> configYamlPc <> cmdPc of
93
Left err -> panic $ "Error in creating the NodeConfiguration: " <> Text.pack err
94
Right nc' -> return nc'
96
case shelleyVRFFile $ ncProtocolFiles nc of
97
Just vrfFp -> do vrf <- runExceptT $ checkVRFFilePermissions vrfFp
100
putTextLn (renderVRFPrivateKeyFilePermissionError err) >> exitFailure
105
eitherSomeProtocol <- runExceptT $ mkConsensusProtocol nc
107
p :: SomeConsensusProtocol <-
108
case eitherSomeProtocol of
109
Left err -> putTextLn (renderProtocolInstantiationError err) >> exitFailure
112
eLoggingLayer <- runExceptT $ createLoggingLayer
113
(Text.pack (showVersion version))
117
loggingLayer <- case eLoggingLayer of
118
Left err -> putTextLn (show err) >> exitFailure
119
Right res -> return res
121
!trace <- setupTrace loggingLayer
122
let tracer = contramap pack $ toLogObject trace
124
logTracingVerbosity nc tracer
126
let handleNodeWithTracers
127
:: ( HasKESMetricsData blk
129
, TraceConstraints blk
130
, Protocol.Protocol IO blk
132
=> Protocol.ProtocolInfoArgs IO blk
134
handleNodeWithTracers runP = do
135
-- This IORef contains node kernel structure which holds node kernel.
136
-- Used for ledger queries and peer connection status.
137
nodeKernelData <- mkNodeKernelData
138
let ProtocolInfo { pInfoConfig = cfg } = Protocol.protocolInfo runP
140
(Consensus.configBlock cfg)
144
(llEKGDirect loggingLayer)
145
Async.withAsync (handlePeersListSimple trace nodeKernelData)
146
$ \_peerLogingThread ->
147
-- We ignore peer loging thread if it dies, but it will be killed
148
-- when 'handleSimpleNode' terminates.
149
handleSimpleNode p runP trace tracers nc (setNodeKernel nodeKernelData)
151
shutdownLoggingLayer loggingLayer
154
SomeConsensusProtocol _ runP -> handleNodeWithTracers runP
156
logTracingVerbosity :: NodeConfiguration -> Tracer IO String -> IO ()
157
logTracingVerbosity nc tracer =
158
case ncTraceConfig nc of
159
TracingOff -> return ()
160
TracingOn traceConf ->
161
case traceVerbosity traceConf of
162
NormalVerbosity -> traceWith tracer "tracing verbosity = normal verbosity "
163
MinimalVerbosity -> traceWith tracer "tracing verbosity = minimal verbosity "
164
MaximalVerbosity -> traceWith tracer "tracing verbosity = maximal verbosity "
166
-- | Add the application name and unqualified hostname to the logging
167
-- layer basic trace.
169
-- If the @CARDANO_NODE_LOGGING_HOSTNAME@ environment variable is set,
170
-- it overrides the system hostname. This is useful when running a
171
-- local test cluster with all nodes on the same host.
174
-> IO (Trace IO Text)
175
setupTrace loggingLayer = do
176
hn <- maybe hostname (pure . pack) =<< lookupEnv "CARDANO_NODE_LOGGING_HOSTNAME"
179
llAppendName loggingLayer "node" (llBasicTrace loggingLayer)
182
hn0 <- pack <$> getHostName
183
return $ take 8 $ fst $ breakOn "." hn0
185
handlePeersListSimple
187
-> NodeKernelData blk
189
handlePeersListSimple tr nodeKern = forever $ do
190
getCurrentPeers nodeKern >>= tracePeers tr
191
threadDelay 2000000 -- 2 seconds.
193
-- | Sets up a simple node, which will run the chain sync protocol and block
194
-- fetch protocol, and, if core, will also look at the mempool when trying to
195
-- create a new block.
200
, Protocol.Protocol IO blk
202
=> SomeConsensusProtocol
203
-> Protocol.ProtocolInfoArgs IO blk
205
-> Tracers RemoteConnectionId LocalConnectionId blk
207
-> (NodeKernel IO RemoteConnectionId LocalConnectionId blk -> IO ())
208
-- ^ Called on the 'NodeKernel' after creating it, but before the network
209
-- layer is initialised. This implies this function must not block,
210
-- otherwise the node won't actually start.
212
handleSimpleNode scp runP trace nodeTracers nc onKernel = do
213
meta <- mkLOMeta Notice Public
215
let pInfo = Protocol.protocolInfo runP
216
tracer = toLogObject trace
218
createTracers nc trace tracer
220
(publicIPv4SocketOrAddr, publicIPv6SocketOrAddr, localSocketOrPath) <- do
221
result <- runExceptT (gatherConfiguredSockets nc)
223
Right triplet -> return triplet
226
(appendName "error" trace)
227
(meta, LogMessage (Text.pack (renderSocketConfigError error)))
230
dbPath <- canonDbPath nc
232
eitherTopology <- readTopologyFile nc
233
nt <- either (\err -> panic $ "Cardano.Node.Run.handleSimpleNode.readTopologyFile: " <> err) pure eitherTopology
235
let diffusionTracers :: DiffusionTracers
236
diffusionTracers = createDiffusionTracers nodeTracers
238
(ipProducerAddrs, dnsProducerAddrs) = producerAddresses nt
240
dnsProducers :: [DnsSubscriptionTarget]
241
dnsProducers = uncurry dnsSubscriptionTarget `map` dnsProducerAddrs
243
ipProducers :: IPSubscriptionTarget
244
ipProducers = ipSubscriptionTargets ipProducerAddrs
246
diffusionArguments :: DiffusionArguments
248
createDiffusionArguments
249
publicIPv4SocketOrAddr
250
publicIPv6SocketOrAddr
256
ipv4 <- traverse getSocketOrSocketInfoAddr publicIPv4SocketOrAddr
257
ipv6 <- traverse getSocketOrSocketInfoAddr publicIPv6SocketOrAddr
260
(appendName "addresses" trace)
261
(meta, LogMessage . Text.pack . show $ catMaybes [ipv4, ipv6])
263
(appendName "diffusion-mode" trace)
264
(meta, LogMessage . Text.pack . show . ncDiffusionMode $ nc)
266
(appendName "dns-producers" trace)
267
(meta, LogMessage . Text.pack . show $ dnsProducers)
269
(appendName "ip-producers" trace)
270
(meta, LogMessage . Text.pack . show $ ipProducers)
272
withShutdownHandling nc trace $ \sfds ->
275
{ rnTraceConsensus = consensusTracers nodeTracers
276
, rnTraceNTN = nodeToNodeTracers nodeTracers
277
, rnTraceNTC = nodeToClientTracers nodeTracers
278
, rnProtocolInfo = pInfo
279
, rnNodeKernelHook = \registry nodeKernel -> do
280
maybeSpawnOnSlotSyncedShutdownHandler nc sfds trace registry
281
(Node.getChainDB nodeKernel)
285
{ srnBfcMaxConcurrencyBulkSync = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc
286
, srnBfcMaxConcurrencyDeadline = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc
287
, srnChainDbValidateOverride = ncValidateDB nc
288
, srnSnapshotInterval = ncSnapshotInterval nc
289
, srnDatabasePath = dbPath
290
, srnDiffusionArguments = diffusionArguments
291
, srnDiffusionTracers = diffusionTracers
292
, srnEnableInDevelopmentVersions = False -- TODO get this value from the node configuration
293
, srnTraceChainDB = chainDBTracer nodeTracers
296
createDiffusionTracers :: Tracers RemoteConnectionId LocalConnectionId blk
298
createDiffusionTracers nodeTracers' = DiffusionTracers
299
{ dtIpSubscriptionTracer = ipSubscriptionTracer nodeTracers'
300
, dtDnsSubscriptionTracer = dnsSubscriptionTracer nodeTracers'
301
, dtDnsResolverTracer = dnsResolverTracer nodeTracers'
302
, dtErrorPolicyTracer = errorPolicyTracer nodeTracers'
303
, dtLocalErrorPolicyTracer = localErrorPolicyTracer nodeTracers'
304
, dtAcceptPolicyTracer = acceptPolicyTracer nodeTracers'
305
, dtMuxTracer = muxTracer nodeTracers'
306
, dtMuxLocalTracer = muxLocalTracer nodeTracers'
307
, dtHandshakeTracer = handshakeTracer nodeTracers'
308
, dtHandshakeLocalTracer = localHandshakeTracer nodeTracers'
309
, dtDiffusionInitializationTracer = diffusionInitializationTracer nodeTracers'
310
, dtLedgerPeersTracer = nullTracer -- TODO network team
318
createTracers NodeConfiguration { ncValidateDB }
320
let ProtocolInfo{ pInfoConfig = cfg } = Protocol.protocolInfo runP
322
meta <- mkLOMeta Notice Public
323
traceNamedObject (appendName "networkMagic" tr)
324
(meta, LogMessage ("NetworkMagic " <> show (unNetworkMagic . getNetworkMagic $ Consensus.configBlock cfg)))
326
startTime <- getCurrentTime
327
traceNodeBasicInfo tr =<< nodeBasicInfo nc scp startTime
328
traceCounter "nodeStartTime" tr (ceiling $ utcTimeToPOSIXSeconds startTime)
330
when ncValidateDB $ traceWith tracer "Performing DB validation"
332
traceNodeBasicInfo :: Trace IO Text -> [LogObject Text] -> IO ()
333
traceNodeBasicInfo tr basicInfoItems =
334
forM_ basicInfoItems $ \(LogObject nm mt content) ->
335
traceNamedObject (appendName nm tr) (mt, content)
337
--------------------------------------------------------------------------------
339
--------------------------------------------------------------------------------
341
canonDbPath :: NodeConfiguration -> IO FilePath
342
canonDbPath NodeConfiguration{ncDatabaseFile = DbFile dbFp} = do
343
fp <- canonicalizePath =<< makeAbsolute dbFp
344
createDirectoryIfMissing True fp
348
-- | Make sure the VRF private key file is readable only
349
-- by the current process owner the node is running under.
350
checkVRFFilePermissions :: FilePath -> ExceptT VRFPrivateKeyFilePermissionError IO ()
352
checkVRFFilePermissions vrfPrivKey = do
353
fs <- liftIO $ getFileStatus vrfPrivKey
355
-- Check the the VRF private key file does not give read/write/exec permissions to others.
356
when (hasOtherPermissions fm)
357
(left $ OtherPermissionsExist vrfPrivKey)
358
-- Check the the VRF private key file does not give read/write/exec permissions to any group.
359
when (hasGroupPermissions fm)
360
(left $ GroupPermissionsExist vrfPrivKey)
362
hasPermission :: FileMode -> FileMode -> Bool
363
hasPermission fModeA fModeB = fModeA `intersectFileModes` fModeB /= nullFileMode
365
hasOtherPermissions :: FileMode -> Bool
366
hasOtherPermissions fm' = fm' `hasPermission` otherModes
368
hasGroupPermissions :: FileMode -> Bool
369
hasGroupPermissions fm' = fm' `hasPermission` groupModes
371
checkVRFFilePermissions vrfPrivKey = do
372
attribs <- liftIO $ getFileAttributes vrfPrivKey
373
-- https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilea
374
-- https://docs.microsoft.com/en-us/windows/win32/fileio/file-access-rights-constants
375
-- https://docs.microsoft.com/en-us/windows/win32/secauthz/standard-access-rights
376
-- https://docs.microsoft.com/en-us/windows/win32/secauthz/generic-access-rights
377
-- https://docs.microsoft.com/en-us/windows/win32/secauthz/access-mask
378
when (attribs `hasPermission` genericPermissions)
379
(left $ GenericPermissionsExist vrfPrivKey)
381
genericPermissions = gENERIC_ALL .|. gENERIC_READ .|. gENERIC_WRITE .|. gENERIC_EXECUTE
382
hasPermission fModeA fModeB = fModeA .&. fModeB /= gENERIC_NONE
385
createDiffusionArguments
386
:: Maybe (SocketOrSocketInfo Socket AddrInfo)
387
-- ^ Either a socket bound to IPv4 address provided by systemd or IPv4
388
-- address to bind to for NodeToNode communication.
389
-> Maybe (SocketOrSocketInfo Socket AddrInfo)
390
-- ^ Either a socket bound to IPv6 address provided by systemd or IPv6
391
-- address to bind to for NodeToNode communication.
392
-> Maybe (SocketOrSocketInfo Socket SocketPath)
393
-- ^ Either a SOCKET_UNIX socket provided by systemd or a path for
394
-- NodeToClient communication.
396
-> IPSubscriptionTarget
397
-> [DnsSubscriptionTarget]
398
-> DiffusionArguments
399
createDiffusionArguments publicIPv4SocketsOrAddrs
400
publicIPv6SocketsOrAddrs
403
ipProducers dnsProducers
406
-- This is not elegant, but it will change once `coot/connection-manager` is
407
-- merged into `ouroboros-networ`.
408
{ daIPv4Address = eitherSocketOrSocketInfo <$> publicIPv4SocketsOrAddrs
409
, daIPv6Address = eitherSocketOrSocketInfo <$> publicIPv6SocketsOrAddrs
410
, daLocalAddress = mLocalSocketOrPath >>= return . fmap unSocketPath
411
. eitherSocketOrSocketInfo
412
, daIpProducers = ipProducers
413
, daDnsProducers = dnsProducers
414
-- TODO: these limits are arbitrary at the moment;
415
-- issue: https://github.com/input-output-hk/ouroboros-network/issues/1836
416
, daAcceptedConnectionsLimit = AcceptedConnectionsLimit {
417
acceptedConnectionsHardLimit = 512
418
, acceptedConnectionsSoftLimit = 384
419
, acceptedConnectionsDelay = 5
421
, daDiffusionMode = diffusionMode
424
eitherSocketOrSocketInfo :: SocketOrSocketInfo a b -> Either a b
425
eitherSocketOrSocketInfo (ActualSocket a) = Left a
426
eitherSocketOrSocketInfo (SocketInfo b) = Right b
428
dnsSubscriptionTarget :: NodeDnsAddress -> Int -> DnsSubscriptionTarget
429
dnsSubscriptionTarget na valency =
430
DnsSubscriptionTarget { dstDomain = nodeHostDnsAddressToDomain (naHostAddress na)
431
, dstPort = naPort na
432
, dstValency = valency
435
ipSubscriptionTargets :: [NodeIPAddress] -> IPSubscriptionTarget
436
ipSubscriptionTargets ipProdAddrs =
437
let ips = nodeAddressToSockAddr <$> ipProdAddrs
438
in IPSubscriptionTarget { ispIps = ips
439
, ispValency = length ips
446
, [(NodeDnsAddress, Int)])
447
producerAddresses nt =
449
RealNodeTopology producers' ->
451
. mapMaybe remoteAddressToNodeAddress
453
MockNodeTopology nodeSetup ->
455
. mapMaybe remoteAddressToNodeAddress
456
. concatMap producers
added
removed
cardano-node/src/Cardano/Node/Run.hs
