Skip to content

Commit 960407b

Browse files
sorkisorki
committed
remote: add StoreConnection, reclaim runStoreSocket, now greetServer
1 parent 1f1d437 commit 960407b

File tree

6 files changed

+195
-151
lines changed

6 files changed

+195
-151
lines changed

‎hnix-store-remote/hnix-store-remote.cabal‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -114,7 +114,7 @@ library
114114
, data-default-class
115115
, dependent-sum > 0.7
116116
, dependent-sum-template >= 0.2.0.1 && < 0.3
117-
, directory
117+
-- , directory
118118
, dlist >= 1.0
119119
, exceptions
120120
, generic-arbitrary < 1.1

‎hnix-store-remote/src/System/Nix/Store/Remote.hs‎

Lines changed: 93 additions & 61 deletions
Original file line numberDiff line numberDiff line change
@@ -10,11 +10,11 @@ module System.Nix.Store.Remote
1010
, MonadStore
1111
-- * Runners
1212
, runStore
13-
, runStoreOpts
14-
, runStoreOptsTCP
13+
, runStoreConnection
14+
, runStoreSocket
1515
-- ** Daemon
1616
, runDaemon
17-
, runDaemonOpts
17+
, runDaemonConnection
1818
, justdoit
1919
) where
2020

@@ -30,15 +30,16 @@ import System.Nix.Store.Remote.MonadStore
3030
, RemoteStoreT
3131
, RemoteStoreError(RemoteStoreError_GetAddrInfoFailed))
3232
import System.Nix.Store.Remote.Client
33+
import System.Nix.Store.Remote.Server (WorkerHelper, runProxyDaemon)
3334
import System.Nix.Store.Remote.Types
3435

3536
import qualified Control.Monad.Catch
3637
import qualified Network.Socket
37-
import qualified System.Directory
38+
-- see TODO bellow
39+
--import qualified System.Directory
3840

39-
-- wip daemon
41+
-- wip justdoit
4042
import System.Nix.StorePath (StorePath)
41-
import System.Nix.Store.Remote.Server (WorkerHelper, runDaemonSocket)
4243
import qualified System.Nix.StorePath
4344

4445
-- * Compat
@@ -53,67 +54,48 @@ runStore
5354
)
5455
=> RemoteStoreT m a
5556
-> Run m a
56-
runStore = runStoreOpts defaultSockPath
57+
runStore = runStoreConnection def
5758

58-
defaultSockPath :: String
59-
defaultSockPath = "/nix/var/nix/daemon-socket/socket"
60-
61-
runStoreOpts
62-
:: ( MonadIO m
63-
, MonadMask m
64-
)
65-
=> FilePath
66-
-> RemoteStoreT m a
67-
-> Run m a
68-
runStoreOpts socketPath =
69-
runStoreOpts'
70-
Network.Socket.AF_UNIX
71-
(SockAddrUnix socketPath)
72-
73-
runStoreOptsTCP
59+
runStoreConnection
7460
:: ( MonadIO m
7561
, MonadMask m
7662
)
77-
=> String
78-
-> Int
63+
=> StoreConnection
7964
-> RemoteStoreT m a
8065
-> Run m a
81-
runStoreOptsTCP host port code = do
82-
addrInfo <- liftIO $ Network.Socket.getAddrInfo
83-
(Just Network.Socket.defaultHints)
84-
(Just host)
85-
(Just $ show port)
86-
case addrInfo of
87-
(sockAddr:_) ->
88-
runStoreOpts'
89-
(Network.Socket.addrFamily sockAddr)
90-
(Network.Socket.addrAddress sockAddr)
91-
code
92-
_ -> pure (Left RemoteStoreError_GetAddrInfoFailed, mempty)
66+
runStoreConnection sc k =
67+
connectionToSocket sc
68+
>>= \case
69+
Left e -> pure (Left e, mempty)
70+
Right (fam, sock) -> runStoreSocket fam sock k
9371

94-
runStoreOpts'
72+
runStoreSocket
9573
:: ( MonadIO m
9674
, MonadMask m
9775
)
9876
=> Family
9977
-> SockAddr
10078
-> RemoteStoreT m a
10179
-> Run m a
102-
runStoreOpts' sockFamily sockAddr code =
80+
runStoreSocket sockFamily sockAddr code =
10381
Control.Monad.Catch.bracket
10482
(liftIO open)
10583
(liftIO . Network.Socket.close . hasStoreSocket)
106-
(\s -> runRemoteStoreT s $ runStoreSocket code)
84+
(\s -> runRemoteStoreT s $ greetServer >> code)
10785
where
10886
open = do
109-
soc <- Network.Socket.socket sockFamily Network.Socket.Stream 0
87+
soc <-
88+
Network.Socket.socket
89+
sockFamily
90+
Network.Socket.Stream
91+
Network.Socket.defaultProtocol
11092
Network.Socket.connect soc sockAddr
11193
pure soc
11294

11395
justdoit :: Run IO (Bool, Bool)
11496
justdoit = do
115-
runDaemonOpts handler "/tmp/dsock" $
116-
runStoreOpts "/tmp/dsock"
97+
runDaemonConnection handler (StoreConnection_Socket "/tmp/dsock") $
98+
runStoreConnection (StoreConnection_Socket "/tmp/dsock")
11799
$ do
118100
a <- isValidPath pth
119101
b <- isValidPath pth
@@ -140,31 +122,81 @@ runDaemon
140122
-> m a
141123
-> m a
142124
runDaemon workerHelper =
143-
runDaemonOpts
125+
runDaemonConnection
144126
workerHelper
145-
defaultSockPath
127+
def
128+
129+
-- | Run an emulated nix daemon using given @StoreConnection@
130+
-- the deamon will close when the continuation returns.
131+
runDaemonConnection
132+
:: forall m a
133+
. ( MonadIO m
134+
, MonadConc m
135+
)
136+
=> WorkerHelper m
137+
-> StoreConnection
138+
-> m a
139+
-> m a
140+
runDaemonConnection workerHelper sc k =
141+
connectionToSocket sc
142+
>>= \case
143+
Left e -> error $ show e
144+
Right (fam, sock) -> runDaemonSocket workerHelper fam sock k
146145

147-
-- | Run an emulated nix daemon on given socket address.
146+
-- | Run an emulated nix daemon using given @StoreConnection@
148147
-- the deamon will close when the continuation returns.
149-
runDaemonOpts
148+
runDaemonSocket
150149
:: forall m a
151150
. ( MonadIO m
152151
, MonadConc m
153152
)
154153
=> WorkerHelper m
155-
-> FilePath
154+
-> Family
155+
-> SockAddr
156156
-> m a
157157
-> m a
158-
runDaemonOpts workerHelper f k = Control.Monad.Catch.bracket
159-
(liftIO
160-
$ Network.Socket.socket
161-
Network.Socket.AF_UNIX
162-
Network.Socket.Stream
163-
Network.Socket.defaultProtocol
164-
)
165-
(\lsock -> liftIO $ Network.Socket.close lsock *> System.Directory.removeFile f)
166-
$ \lsock -> do
167-
-- ^^^^^^^^^^^^
168-
-- TODO: this: --------------------------------------------------////////////
169-
liftIO $ Network.Socket.bind lsock (SockAddrUnix f)
170-
runDaemonSocket workerHelper lsock k
158+
runDaemonSocket workerHelper sockFamily sockAddr k =
159+
Control.Monad.Catch.bracket
160+
(liftIO
161+
$ Network.Socket.socket
162+
sockFamily
163+
Network.Socket.Stream
164+
Network.Socket.defaultProtocol
165+
)
166+
(\lsock -> liftIO $ Network.Socket.close lsock) -- *> System.Directory.removeFile f)
167+
$ \lsock -> do
168+
-- ^^^^^^^^^^^^
169+
-- TODO: this: -------------------------------------------------------////////////
170+
-- should really be
171+
-- a file lock followed by unlink *before* bind rather than after close. If
172+
-- the program crashes (or loses power or something) then a stale unix
173+
-- socket will stick around and prevent the daemon from starting. using a
174+
-- lock file instead means only one "copy" of the daemon can hold the lock,
175+
-- and can safely unlink the socket before binding no matter how shutdown
176+
-- occured.
177+
178+
-- set up the listening socket
179+
liftIO $ Network.Socket.bind lsock sockAddr
180+
runProxyDaemon workerHelper lsock k
181+
182+
connectionToSocket
183+
:: MonadIO m
184+
=> StoreConnection
185+
-> m (Either RemoteStoreError (Family, SockAddr))
186+
connectionToSocket (StoreConnection_Socket (StoreSocketPath f)) =
187+
pure $ pure
188+
( Network.Socket.AF_UNIX
189+
, SockAddrUnix f
190+
)
191+
connectionToSocket (StoreConnection_TCP StoreTCP{..}) = do
192+
addrInfo <- liftIO $ Network.Socket.getAddrInfo
193+
(Just Network.Socket.defaultHints)
194+
(Just storeTCPHost)
195+
(Just $ show storeTCPPort)
196+
case addrInfo of
197+
(sockAddr:_) ->
198+
pure $ pure
199+
( Network.Socket.addrFamily sockAddr
200+
, Network.Socket.addrAddress sockAddr
201+
)
202+
_ -> pure (Left RemoteStoreError_GetAddrInfoFailed)

‎hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs‎

Lines changed: 64 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
module System.Nix.Store.Remote.Client.Core
22
( Run
3-
, runStoreSocket
3+
, greetServer
44
, doReq
55
) where
66

@@ -78,81 +78,68 @@ doReq = \case
7878
$ getReplyS @a
7979
)
8080

81-
runStoreSocket
81+
greetServer
8282
:: MonadRemoteStore m
83-
=> m a
84-
-> m a
85-
runStoreSocket code = do
86-
ClientHandshakeOutput{..}
87-
<- greet
88-
89-
setProtoVersion clientHandshakeOutputLeastCommonVersion
90-
code
91-
92-
where
93-
greet
94-
:: MonadRemoteStore m
95-
=> m ClientHandshakeOutput
96-
greet = do
97-
98-
sockPutS
99-
(mapErrorS
100-
RemoteStoreError_SerializerHandshake
101-
workerMagic
102-
)
103-
WorkerMagic_One
104-
105-
magic <-
83+
=> m ClientHandshakeOutput
84+
greetServer = do
85+
sockPutS
86+
(mapErrorS
87+
RemoteStoreError_SerializerHandshake
88+
workerMagic
89+
)
90+
WorkerMagic_One
91+
92+
magic <-
93+
sockGetS
94+
$ mapErrorS
95+
RemoteStoreError_SerializerHandshake
96+
workerMagic
97+
98+
unless
99+
(magic == WorkerMagic_Two)
100+
$ throwError RemoteStoreError_WorkerMagic2Mismatch
101+
102+
daemonVersion <- sockGetS protoVersion
103+
104+
when (daemonVersion < ProtoVersion 1 10)
105+
$ throwError RemoteStoreError_ClientVersionTooOld
106+
107+
pv <- getProtoVersion
108+
sockPutS protoVersion pv
109+
110+
let leastCommonVersion = min daemonVersion pv
111+
112+
when (leastCommonVersion >= ProtoVersion 1 14)
113+
$ sockPutS int (0 :: Int) -- affinity, obsolete
114+
115+
when (leastCommonVersion >= ProtoVersion 1 11) $ do
116+
sockPutS
117+
(mapErrorS RemoteStoreError_SerializerPut bool)
118+
False -- reserveSpace, obsolete
119+
120+
daemonNixVersion <- if leastCommonVersion >= ProtoVersion 1 33
121+
then do
122+
-- If we were buffering I/O, we would flush the output here.
123+
txtVer <-
106124
sockGetS
107-
$ mapErrorS
108-
RemoteStoreError_SerializerHandshake
109-
workerMagic
110-
111-
unless
112-
(magic == WorkerMagic_Two)
113-
$ throwError RemoteStoreError_WorkerMagic2Mismatch
114-
115-
daemonVersion <- sockGetS protoVersion
116-
117-
when (daemonVersion < ProtoVersion 1 10)
118-
$ throwError RemoteStoreError_ClientVersionTooOld
119-
120-
pv <- getProtoVersion
121-
sockPutS protoVersion pv
122-
123-
let leastCommonVersion = min daemonVersion pv
124-
125-
when (leastCommonVersion >= ProtoVersion 1 14)
126-
$ sockPutS int (0 :: Int) -- affinity, obsolete
127-
128-
when (leastCommonVersion >= ProtoVersion 1 11) $ do
129-
sockPutS
130-
(mapErrorS RemoteStoreError_SerializerPut bool)
131-
False -- reserveSpace, obsolete
132-
133-
daemonNixVersion <- if leastCommonVersion >= ProtoVersion 1 33
134-
then do
135-
-- If we were buffering I/O, we would flush the output here.
136-
txtVer <-
137-
sockGetS
138-
$ mapErrorS
139-
RemoteStoreError_SerializerGet
140-
text
141-
pure $ Just txtVer
142-
else pure Nothing
143-
144-
remoteTrustsUs <- if leastCommonVersion >= ProtoVersion 1 35
145-
then do
146-
sockGetS
147-
$ mapErrorS RemoteStoreError_SerializerHandshake trustedFlag
148-
else pure Nothing
149-
150-
setProtoVersion leastCommonVersion
151-
processOutput
152-
153-
pure ClientHandshakeOutput
154-
{ clientHandshakeOutputNixVersion = daemonNixVersion
155-
, clientHandshakeOutputTrust = remoteTrustsUs
156-
, clientHandshakeOutputLeastCommonVersion = leastCommonVersion
157-
, clientHandshakeOutputServerVersion = daemonVersion
158-
}
125+
$ mapErrorS
126+
RemoteStoreError_SerializerGet
127+
text
128+
pure $ Just txtVer
129+
else pure Nothing
130+
131+
remoteTrustsUs <- if leastCommonVersion >= ProtoVersion 1 35
132+
then do
133+
sockGetS
134+
$ mapErrorS RemoteStoreError_SerializerHandshake trustedFlag
135+
else pure Nothing
136+
137+
setProtoVersion leastCommonVersion
138+
processOutput
139+
140+
pure ClientHandshakeOutput
141+
{ clientHandshakeOutputNixVersion = daemonNixVersion
142+
, clientHandshakeOutputTrust = remoteTrustsUs
143+
, clientHandshakeOutputLeastCommonVersion = leastCommonVersion
144+
, clientHandshakeOutputServerVersion = daemonVersion
145+
}

0 commit comments

Comments
 (0)