Skip to content

Commit

Permalink
wIP
Browse files Browse the repository at this point in the history
  • Loading branch information
Jimbo4350 committed Jan 27, 2023
1 parent 9ab4b98 commit f8dac15
Show file tree
Hide file tree
Showing 3 changed files with 121 additions and 34 deletions.
4 changes: 3 additions & 1 deletion cardano-cli/cardano-cli.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -168,6 +168,7 @@ executable cardano-cli

test-suite cardano-cli-test
import: project-config
, maybe-Win32

hs-source-dirs: test
main-is: cardano-cli-test.hs
Expand All @@ -179,7 +180,6 @@ test-suite cardano-cli-test
, cardano-api
, cardano-api:gen
, cardano-cli
, cardano-node
, cardano-prelude
, cardano-slotting ^>= 0.1
, containers
Expand All @@ -192,6 +192,8 @@ test-suite cardano-cli-test
, text
, time
, transformers
, transformers-except
, unix
, yaml

other-modules: Test.Config.Mainnet
Expand Down
80 changes: 78 additions & 2 deletions cardano-cli/test/Test/Cli/FilePermissions.hs
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand Down
71 changes: 40 additions & 31 deletions cardano-node/src/Cardano/Node/Run.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand All @@ -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 (..))
Expand All @@ -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" -}
Expand All @@ -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
Expand All @@ -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 ()
Expand Down Expand Up @@ -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'.
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down

0 comments on commit f8dac15

Please sign in to comment.