make tor hidden service work when directory watching is not available

Avoid crashing when built w/o inotify..

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
+	if canWatch
-	return $ ChangedRefsHandle h chan
+		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 _

Command/NotifyChanges.hs

@@ -24,18 +24,19 @@ seek :: CmdParams -> CommandSeek
 seek = withNothing start
 
 start :: CommandStart
-start = do
+start = go =<< watchChangedRefs
-	h <- 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
 
-	-- No messages need to be received from the caller,
+		liftIO $ send READY
-	-- but when it closes the connection, notice and terminate.
+		void $ liftIO $ concurrently sender receiver
-	let receiver = forever $ void $ getProtocolLine stdin
+		liftIO $ stopWatchingChangedRefs h
-	let sender = forever $ send . CHANGED =<< waitChangedRefs h
+		stop
-
+	go Nothing = stop
-	liftIO $ send READY
-	void $ liftIO $ concurrently sender receiver
-	liftIO $ stopWatchingChangedRefs h
-	stop
 
 send :: Notification -> IO ()
 send n = do

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.

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