make tor hidden service work when directory watching is not available

Avoid crashing when built w/o inotify..

4 files changed, 23 insertions, 19 deletions

diff --git a/Annex/ChangedRefs.hs b/Annex/ChangedRefs.hs
index 0dc82d3b3..1f2372c04 100644
--- a/Annex/ChangedRefs.hs
+++ b/Annex/ChangedRefs.hs
@@ -71,7 +71,7 @@ stopWatchingChangedRefs h@(ChangedRefsHandle wh chan) = do
 	atomically $ closeTBMChan chan
 	drainChangedRefs h
 
-watchChangedRefs :: Annex ChangedRefsHandle
+watchChangedRefs :: Annex (Maybe ChangedRefsHandle)
 watchChangedRefs = do
 	-- This channel is used to accumulate notifications,
 	-- because the DirWatcher might have multiple threads that find
@@ -90,8 +90,11 @@ watchChangedRefs = do
 		, modifyHook = notifyhook
 		}
 
-	h <- liftIO $ watchDir refdir (const False) True hooks id
-	return $ ChangedRefsHandle h chan
+	if canWatch
+		then do
+			h <- liftIO $ watchDir refdir (const False) True hooks id
+			return $ Just $ ChangedRefsHandle h chan
+		else return Nothing
 
 notifyHook :: TBMChan Git.Sha -> FilePath -> Maybe FileStatus -> IO ()
 notifyHook chan reffile _
diff --git a/Command/NotifyChanges.hs b/Command/NotifyChanges.hs
index 92c70f05e..27db8ad82 100644
--- a/Command/NotifyChanges.hs
+++ b/Command/NotifyChanges.hs
@@ -24,18 +24,19 @@ seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart
-start = do
-	h <- watchChangedRefs
-
-	-- No messages need to be received from the caller,
-	-- but when it closes the connection, notice and terminate.
-	let receiver = forever $ void $ getProtocolLine stdin
-	let sender = forever $ send . CHANGED =<< waitChangedRefs h
-
-	liftIO $ send READY
-	void $ liftIO $ concurrently sender receiver
-	liftIO $ stopWatchingChangedRefs h
-	stop
+start = go =<< watchChangedRefs
+  where
+	go (Just h) = do
+		-- No messages need to be received from the caller,
+		-- but when it closes the connection, notice and terminate.
+		let receiver = forever $ void $ getProtocolLine stdin
+		let sender = forever $ send . CHANGED =<< waitChangedRefs h
+
+		liftIO $ send READY
+		void $ liftIO $ concurrently sender receiver
+		liftIO $ stopWatchingChangedRefs h
+		stop
+	go Nothing = stop
 
 send :: Notification -> IO ()
 send n = do
diff --git a/P2P/Annex.hs b/P2P/Annex.hs
index 351fb38bb..b3db7513c 100644
--- a/P2P/Annex.hs
+++ b/P2P/Annex.hs
@@ -26,7 +26,7 @@ import Utility.Metered
 import Control.Monad.Free
 
 data RunMode
-	= Serving UUID ChangedRefsHandle
+	= Serving UUID (Maybe ChangedRefsHandle)
 	| Client
 
 -- Full interpreter for Proto, that can receive and send objects.
@@ -114,12 +114,12 @@ runLocal runmode runner a = case a of
 				next
 			Right _ -> runner next
 	WaitRefChange next -> case runmode of
-		Serving _ h -> do
+		Serving _ (Just h) -> do
 			v <- tryNonAsync $ liftIO $ waitChangedRefs h
 			case v of
 				Left e -> return (Left (show e))
 				Right changedrefs -> runner (next changedrefs)
-		_ -> return $ Left "change notification not implemented for client"
+		_ -> return $ Left "change notification not available"
   where
 	transfer mk k af ta = case runmode of
 		-- Update transfer logs when serving.
diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs
index 344d5aefb..6149df376 100644
--- a/RemoteDaemon/Transport/Tor.hs
+++ b/RemoteDaemon/Transport/Tor.hs
@@ -110,7 +110,7 @@ serveClient th u r q = bracket setup cleanup start
 		liftAnnex th $ mergeState st'
 	
 	authed conn theiruuid = 
-		bracket watchChangedRefs (liftIO . stopWatchingChangedRefs) $ \crh -> do
+		bracket watchChangedRefs (liftIO . maybe noop stopWatchingChangedRefs) $ \crh -> do
 			v' <- runFullProto (Serving theiruuid crh) conn $
 				P2P.serveAuthed u
 			case v' of