fix file descriptor leak

when importing from a directory special remote that is configured with
exporttree=yes

CHANGELOG

@@ -25,6 +25,8 @@ git-annex (8.20200523) UNRELEASED; urgency=medium
   * init: If lock probing stalls for a long time (eg a broken NFS server),
     display a message to let the user know what's taking so long.
   * init: When annex.pidlock is set, skip lock probing.
+  * Fix file descriptor leak when importing from a directory special remote
+    that is configured with exporttree=yes.
 
  -- Joey Hess <id@joeyh.name>  Tue, 26 May 2020 10:20:52 -0400
 

Remote/Directory.hs

@@ -350,20 +350,28 @@ retrieveExportWithContentIdentifierM dir loc cid dest mkkey p =
 
 	docopy cont = do
 #ifndef mingw32_HOST_OS
-		-- Need a duplicate fd for the post check, since
-		-- hGetContentsMetered closes its handle.
-		fd <- liftIO $ openFd f ReadOnly Nothing defaultFileFlags
-		dupfd <- liftIO $ dup fd
-		h <- liftIO $ fdToHandle fd
+		let open = do
+			-- Need a duplicate fd for the post check, since
+			-- hGetContentsMetered closes its handle.
+			fd <- openFd f ReadOnly Nothing defaultFileFlags
+			dupfd <- dup fd
+			h <- fdToHandle fd
+			return (h, dupfd)
+		let close (h, dupfd) = do
+			hClose h
+			closeFd dupfd
+		bracketIO open close $ \(h, dupfd) -> do
 #else
-		h <- liftIO $ openBinaryFile f ReadMode
+		let open = openBinaryFile f ReadMode
+		let close = hClose
+		bracketIO setup close $ \h -> do
 #endif
-		liftIO $ hGetContentsMetered h p >>= L.writeFile dest
-		k <- mkkey
+			liftIO $ hGetContentsMetered h p >>= L.writeFile dest
+			k <- mkkey
 #ifndef mingw32_HOST_OS
-		cont dupfd (return k)
+			cont dupfd (return k)
 #else
-		cont (return k)
+			cont (return k)
 #endif
 	
 	-- Check before copy, to avoid expensive copy of wrong file