make tor hidden service work when directory watching is not available

Avoid crashing when built w/o inotify..

diff --git a/Annex/ChangedRefs.hs b/Annex/ChangedRefs.hs
index 0dc82d3b3c945105107775b43b0c614a609ca886..1f2372c048710b7c5718abf525fe54b8cc3ca409 100644 (file)
--- 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 92c70f05eb526f97790c96feee7f3e63d21a6346..27db8ad82f5350daa64ec82adb2eb0d914689255 100644 (file)
--- 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 351fb38bb7dfb09e4c624e1d4efb7195faa75d17..b3db7513c0592cb02d2c4a814ac764e92f7ab758 100644 (file)
--- 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 344d5aefbcd697449a1ea87ca06576547d3c293f..6149df37671dfbc7c898b56e4a6a91efcefea771 100644 (file)
--- 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