implement removeExportDirectory

Not yet called by Command.Export. WebDAV needs this to clean up empty collections. Also, example.sh turned out to not be cleaning up directories when removing content from them, so it made sense for it to use this. Remote.Directory did not need it, and since its cleanup method for empty directories is more efficient than what Command.Export will need to do to find empty directories, it uses Nothing so that extra work can be avoided. This commit was sponsored by Thom May on Patreon.
2017-09-15 13:15:47 -04:00 · 2017-09-15 13:15:47 -04:00 · 9f4ffe65e9
commit 9f4ffe65e9
parent 78a67f29f8
9 changed files with 156 additions and 87 deletions
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@ -47,26 +47,29 @@ gen r u c gc = do
 	let chunkconfig = getChunkConfig c
 	return $ Just $ specialRemote c
 		(prepareStore dir chunkconfig)
-		(retrieve dir chunkconfig)
-		(simplyPrepare $ remove dir)
-		(simplyPrepare $ checkKey dir chunkconfig)
+		(retrieveKeyFileM dir chunkconfig)
+		(simplyPrepare $ removeKeyM dir)
+		(simplyPrepare $ checkPresentM dir chunkconfig)
 		Remote
 			{ uuid = u
 			, cost = cst
 			, name = Git.repoDescribe r
 			, storeKey = storeKeyDummy
 			, retrieveKeyFile = retreiveKeyFileDummy
-			, retrieveKeyFileCheap = retrieveCheap dir chunkconfig
+			, retrieveKeyFileCheap = retrieveKeyFileCheapM dir chunkconfig
 			, removeKey = removeKeyDummy
 			, lockContent = Nothing
 			, checkPresent = checkPresentDummy
 			, checkPresentCheap = True
 			, exportActions = return $ ExportActions
-				{ storeExport = storeExportDirectory dir
-				, retrieveExport = retrieveExportDirectory dir
-				, removeExport = removeExportDirectory dir
-				, checkPresentExport = checkPresentExportDirectory dir
-				, renameExport = renameExportDirectory dir
+				{ storeExport = storeExportM dir
+				, retrieveExport = retrieveExportM dir
+				, removeExport = removeExportM dir
+				, checkPresentExport = checkPresentExportM dir
+				-- Not needed because removeExportLocation
+				-- auto-removes empty directories.
+				, removeExportDirectory = Nothing
+				, renameExport = renameExportM dir
 				}
 			, whereisKey = Nothing
 			, remoteFsck = Nothing
@ -166,17 +169,17 @@ finalizeStoreGeneric tmp dest = do
 		mapM_ preventWrite =<< dirContents dest
 		preventWrite dest

-retrieve :: FilePath -> ChunkConfig -> Preparer Retriever
-retrieve d (LegacyChunks _) = Legacy.retrieve locations d
-retrieve d _ = simplyPrepare $ byteRetriever $ \k sink ->
+retrieveKeyFileM :: FilePath -> ChunkConfig -> Preparer Retriever
+retrieveKeyFileM d (LegacyChunks _) = Legacy.retrieve locations d
+retrieveKeyFileM d _ = simplyPrepare $ byteRetriever $ \k sink ->
 	sink =<< liftIO (L.readFile =<< getLocation d k)

-retrieveCheap :: FilePath -> ChunkConfig -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieveKeyFileCheapM :: FilePath -> ChunkConfig -> Key -> AssociatedFile -> FilePath -> Annex Bool
 -- no cheap retrieval possible for chunks
-retrieveCheap _ (UnpaddedChunks _) _ _ _ = return False
-retrieveCheap _ (LegacyChunks _) _ _ _ = return False
+retrieveKeyFileCheapM _ (UnpaddedChunks _) _ _ _ = return False
+retrieveKeyFileCheapM _ (LegacyChunks _) _ _ _ = return False
 #ifndef mingw32_HOST_OS
-retrieveCheap d NoChunks k _af f = liftIO $ catchBoolIO $ do
+retrieveKeyFileCheapM d NoChunks k _af f = liftIO $ catchBoolIO $ do
 	file <- absPath =<< getLocation d k
 	ifM (doesFileExist file)
 		( do
@ -185,11 +188,11 @@ retrieveCheap d NoChunks k _af f = liftIO $ catchBoolIO $ do
 		, return False
 		)
 #else
-retrieveCheap _ _ _ _ _ = return False
+retrieveKeyFileCheapM _ _ _ _ _ = return False
 #endif

-remove :: FilePath -> Remover
-remove d k = liftIO $ removeDirGeneric d (storeDir d k)
+removeKeyM :: FilePath -> Remover
+removeKeyM d k = liftIO $ removeDirGeneric d (storeDir d k)

 {- Removes the directory, which must be located under the topdir.
 -
@ -216,9 +219,9 @@ removeDirGeneric topdir dir = do
 		then return ok
 		else doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir)

-checkKey :: FilePath -> ChunkConfig -> CheckPresent
-checkKey d (LegacyChunks _) k = Legacy.checkKey d locations k
-checkKey d _ k = checkPresentGeneric d (locations d k)
+checkPresentM :: FilePath -> ChunkConfig -> CheckPresent
+checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations k
+checkPresentM d _ k = checkPresentGeneric d (locations d k)

 checkPresentGeneric :: FilePath -> [FilePath] -> Annex Bool
 checkPresentGeneric d ps = liftIO $
@ -230,8 +233,8 @@ checkPresentGeneric d ps = liftIO $
 			)
 		)

-storeExportDirectory :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
-storeExportDirectory d src _k loc p = liftIO $ catchBoolIO $ do
+storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
+storeExportM d src _k loc p = liftIO $ catchBoolIO $ do
 	createDirectoryIfMissing True (takeDirectory dest)
 	-- Write via temp file so that checkPresentGeneric will not
 	-- see it until it's fully stored.
@ -240,27 +243,27 @@ storeExportDirectory d src _k loc p = liftIO $ catchBoolIO $ do
  where
 	dest = exportPath d loc

-retrieveExportDirectory :: FilePath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
-retrieveExportDirectory d _k loc dest p = liftIO $ catchBoolIO $ do
+retrieveExportM :: FilePath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
+retrieveExportM d _k loc dest p = liftIO $ catchBoolIO $ do
 	withMeteredFile src p (L.writeFile dest)
 	return True
  where
 	src = exportPath d loc

-removeExportDirectory :: FilePath -> Key -> ExportLocation -> Annex Bool
-removeExportDirectory d _k loc = liftIO $ do
+removeExportM :: FilePath -> Key -> ExportLocation -> Annex Bool
+removeExportM d _k loc = liftIO $ do
 	nukeFile src
 	removeExportLocation d loc
 	return True
  where
 	src = exportPath d loc

-checkPresentExportDirectory :: FilePath -> Key -> ExportLocation -> Annex Bool
-checkPresentExportDirectory d _k loc =
+checkPresentExportM :: FilePath -> Key -> ExportLocation -> Annex Bool
+checkPresentExportM d _k loc =
 	checkPresentGeneric d [exportPath d loc]

-renameExportDirectory :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex Bool
-renameExportDirectory d _k oldloc newloc = liftIO $ catchBoolIO $ do
+renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex Bool
+renameExportM d _k oldloc newloc = liftIO $ catchBoolIO $ do
 	createDirectoryIfMissing True (takeDirectory dest)
 	renameFile src dest
 	removeExportLocation d oldloc
--- a/Remote/External.hs
+++ b/Remote/External.hs
@ -71,11 +71,12 @@ gen r u c gc
 		exportsupported <- checkExportSupported' external
 		let exportactions = if exportsupported
 			then return $ ExportActions
-				{ storeExport = storeExportExternal external
-				, retrieveExport = retrieveExportExternal external
-				, removeExport = removeExportExternal external
-				, checkPresentExport = checkPresentExportExternal external
-				, renameExport = renameExportExternal external
+				{ storeExport = storeExportM external
+				, retrieveExport = retrieveExportM external
+				, removeExport = removeExportM external
+				, checkPresentExport = checkPresentExportM external
+				, removeExportDirectory = Just $ removeExportDirectoryM external
+				, renameExport = renameExportM external
 				}
 			else exportUnsupported
 		-- Cheap exportSupported that replaces the expensive
@ -84,13 +85,13 @@ gen r u c gc
 			then exportIsSupported
 			else exportUnsupported
 		mk cst avail
-			(store external)
-			(retrieve external)
-			(remove external)
-			(checkKey external)
-			(Just (whereis external))
-			(Just (claimurl external))
-			(Just (checkurl external))
+			(storeKeyM external)
+			(retrieveKeyFileM external)
+			(removeKeyM external)
+			(checkPresentM external)
+			(Just (whereisKeyM external))
+			(Just (claimUrlM external))
+			(Just (checkUrlM external))
 			exportactions
 			cheapexportsupported
  where
@ -170,8 +171,8 @@ checkExportSupported' external = safely $
 		UNSUPPORTED_REQUEST -> Just $ return False
 		_ -> Nothing

-store :: External -> Storer
-store external = fileStorer $ \k f p ->
+storeKeyM :: External -> Storer
+storeKeyM external = fileStorer $ \k f p ->
 	handleRequestKey external (\sk -> TRANSFER Upload sk f) k (Just p) $ \resp ->
 		case resp of
 			TRANSFER_SUCCESS Upload k' | k == k' ->
@ -182,8 +183,8 @@ store external = fileStorer $ \k f p ->
 					return False
 			_ -> Nothing

-retrieve :: External -> Retriever
-retrieve external = fileRetriever $ \d k p -> 
+retrieveKeyFileM :: External -> Retriever
+retrieveKeyFileM external = fileRetriever $ \d k p -> 
 	handleRequestKey external (\sk -> TRANSFER Download sk d) k (Just p) $ \resp ->
 		case resp of
 			TRANSFER_SUCCESS Download k'
@ -192,8 +193,8 @@ retrieve external = fileRetriever $ \d k p ->
 				| k == k' -> Just $ giveup errmsg
 			_ -> Nothing

-remove :: External -> Remover
-remove external k = safely $ 
+removeKeyM :: External -> Remover
+removeKeyM external k = safely $ 
 	handleRequestKey external REMOVE k Nothing $ \resp ->
 		case resp of
 			REMOVE_SUCCESS k'
@ -204,8 +205,8 @@ remove external k = safely $
 					return False
 			_ -> Nothing

-checkKey :: External -> CheckPresent
-checkKey external k = either giveup id <$> go
+checkPresentM :: External -> CheckPresent
+checkPresentM external k = either giveup id <$> go
  where
 	go = handleRequestKey external CHECKPRESENT k Nothing $ \resp ->
 		case resp of
@ -217,15 +218,15 @@ checkKey external k = either giveup id <$> go
 				| k' == k -> Just $ return $ Left errmsg
 			_ -> Nothing

-whereis :: External -> Key -> Annex [String]
-whereis external k = handleRequestKey external WHEREIS k Nothing $ \resp -> case resp of
+whereisKeyM :: External -> Key -> Annex [String]
+whereisKeyM external k = handleRequestKey external WHEREIS k Nothing $ \resp -> case resp of
 	WHEREIS_SUCCESS s -> Just $ return [s]
 	WHEREIS_FAILURE -> Just $ return []
 	UNSUPPORTED_REQUEST -> Just $ return []
 	_ -> Nothing

-storeExportExternal :: External -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
-storeExportExternal external f k loc p = safely $
+storeExportM :: External -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
+storeExportM external f k loc p = safely $
 	handleRequestExport external loc req k (Just p) $ \resp -> case resp of
 		TRANSFER_SUCCESS Upload k' | k == k' ->
 			Just $ return True
@ -240,8 +241,8 @@ storeExportExternal external f k loc p = safely $
  where
 	req sk = TRANSFEREXPORT Upload sk f

-retrieveExportExternal :: External -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
-retrieveExportExternal external k loc d p = safely $
+retrieveExportM :: External -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool
+retrieveExportM external k loc d p = safely $
 	handleRequestExport external loc req k (Just p) $ \resp -> case resp of
 		TRANSFER_SUCCESS Download k'
 			| k == k' -> Just $ return True
@ -256,22 +257,8 @@ retrieveExportExternal external k loc d p = safely $
  where
 	req sk = TRANSFEREXPORT Download sk d

-removeExportExternal :: External -> Key -> ExportLocation -> Annex Bool
-removeExportExternal external k loc = safely $
-	handleRequestExport external loc REMOVEEXPORT k Nothing $ \resp -> case resp of
-		REMOVE_SUCCESS k'
-			| k == k' -> Just $ return True
-		REMOVE_FAILURE k' errmsg
-			| k == k' -> Just $ do
-				warning errmsg
-				return False
-		UNSUPPORTED_REQUEST -> Just $ do
-			warning "REMOVEEXPORT not implemented by external special remote"
-			return False
-		_ -> Nothing
-
-checkPresentExportExternal :: External -> Key -> ExportLocation -> Annex Bool
-checkPresentExportExternal external k loc = either giveup id <$> go
+checkPresentExportM :: External -> Key -> ExportLocation -> Annex Bool
+checkPresentExportM external k loc = either giveup id <$> go
  where
 	go = handleRequestExport external loc CHECKPRESENTEXPORT k Nothing $ \resp -> case resp of
 		CHECKPRESENT_SUCCESS k'
@ -284,8 +271,31 @@ checkPresentExportExternal external k loc = either giveup id <$> go
 			Left "CHECKPRESENTEXPORT not implemented by external special remote"
 		_ -> Nothing

-renameExportExternal :: External -> Key -> ExportLocation -> ExportLocation -> Annex Bool
-renameExportExternal external k src dest = safely $
+removeExportM :: External -> Key -> ExportLocation -> Annex Bool
+removeExportM external k loc = safely $
+	handleRequestExport external loc REMOVEEXPORT k Nothing $ \resp -> case resp of
+		REMOVE_SUCCESS k'
+			| k == k' -> Just $ return True
+		REMOVE_FAILURE k' errmsg
+			| k == k' -> Just $ do
+				warning errmsg
+				return False
+		UNSUPPORTED_REQUEST -> Just $ do
+			warning "REMOVEEXPORT not implemented by external special remote"
+			return False
+		_ -> Nothing
+
+removeExportDirectoryM :: External -> ExportDirectory -> Annex Bool
+removeExportDirectoryM external dir = safely $
+	handleRequest external req Nothing $ \resp -> case resp of
+		REMOVEEXPORTDIRECTORY_SUCCESS -> Just $ return True
+		REMOVEEXPORTDIRECTORY_FAILURE -> Just $ return False
+		UNSUPPORTED_REQUEST -> Just $ return True
+  where
+	req = REMOVEEXPORTDIRECTORY dir
+
+renameExportM :: External -> Key -> ExportLocation -> ExportLocation -> Annex Bool
+renameExportM external k src dest = safely $
 	handleRequestExport external src req k Nothing $ \resp -> case resp of
 		RENAMEEXPORT_SUCCESS k'
 			| k' == k -> Just $ return True
@ -619,16 +629,16 @@ getAvailability external r gc =
 		return avail
 	defavail = return GloballyAvailable

-claimurl :: External -> URLString -> Annex Bool
-claimurl external url =
+claimUrlM :: External -> URLString -> Annex Bool
+claimUrlM external url =
 	handleRequest external (CLAIMURL url) Nothing $ \req -> case req of
 		CLAIMURL_SUCCESS -> Just $ return True
 		CLAIMURL_FAILURE -> Just $ return False
 		UNSUPPORTED_REQUEST -> Just $ return False
 		_ -> Nothing

-checkurl :: External -> URLString -> Annex UrlContents
-checkurl external url = 
+checkUrlM :: External -> URLString -> Annex UrlContents
+checkUrlM external url = 
 	handleRequest external (CHECKURL url) Nothing $ \req -> case req of
 		CHECKURL_CONTENTS sz f -> Just $ return $ UrlContents sz
 			(if null f then Nothing else Just $ mkSafeFilePath f)
--- a/Remote/External/Types.hs
+++ b/Remote/External/Types.hs
@ -36,7 +36,7 @@ import Types.StandardGroups (PreferredContentExpression)
 import Utility.Metered (BytesProcessed(..))
 import Types.Transfer (Direction(..))
 import Config.Cost (Cost)
-import Types.Remote (RemoteConfig, ExportLocation(..))
+import Types.Remote (RemoteConfig, ExportLocation(..), ExportDirectory(..))
 import Types.Availability (Availability(..))
 import Types.Key
 import Utility.Url (URLString)
@ -121,6 +121,7 @@ data Request
 	| TRANSFEREXPORT Direction SafeKey FilePath
 	| CHECKPRESENTEXPORT SafeKey
 	| REMOVEEXPORT SafeKey
+	| REMOVEEXPORTDIRECTORY ExportDirectory
 	| RENAMEEXPORT SafeKey ExportLocation
 	deriving (Show)

@ -160,6 +161,8 @@ instance Proto.Sendable Request where
 		[ "CHECKPRESENTEXPORT", Proto.serialize key ]
 	formatMessage (REMOVEEXPORT key) =
 		[ "REMOVEEXPORT", Proto.serialize key ]
+	formatMessage (REMOVEEXPORTDIRECTORY dir) =
+		[ "REMOVEEXPORTDIRECTORY", Proto.serialize dir ]
 	formatMessage (RENAMEEXPORT key newloc) =
 		[ "RENAMEEXPORT"
 		, Proto.serialize key
@ -190,6 +193,8 @@ data Response
 	| WHEREIS_FAILURE
 	| EXPORTSUPPORTED_SUCCESS
 	| EXPORTSUPPORTED_FAILURE
+	| REMOVEEXPORTDIRECTORY_SUCCESS
+	| REMOVEEXPORTDIRECTORY_FAILURE
 	| RENAMEEXPORT_SUCCESS Key
 	| RENAMEEXPORT_FAILURE Key
 	| UNSUPPORTED_REQUEST
@ -218,6 +223,8 @@ instance Proto.Receivable Response where
 	parseCommand "WHEREIS-FAILURE" = Proto.parse0 WHEREIS_FAILURE
 	parseCommand "EXPORTSUPPORTED-SUCCESS" = Proto.parse0 EXPORTSUPPORTED_SUCCESS
 	parseCommand "EXPORTSUPPORTED-FAILURE" = Proto.parse0 EXPORTSUPPORTED_FAILURE
+	parseCommand "REMOVEEXPORTDIRECTORY-SUCCESS" = Proto.parse0 REMOVEEXPORTDIRECTORY_SUCCESS
+	parseCommand "REMOVEEXPORTDIRECTORY-FAILURE" = Proto.parse0 REMOVEEXPORTDIRECTORY_FAILURE
 	parseCommand "RENAMEEXPORT-SUCCESS" = Proto.parse1 RENAMEEXPORT_SUCCESS
 	parseCommand "RENAMEEXPORT-FAILURE" = Proto.parse1 RENAMEEXPORT_FAILURE
 	parseCommand "UNSUPPORTED-REQUEST" = Proto.parse0 UNSUPPORTED_REQUEST
@ -352,3 +359,7 @@ instance Proto.Serializable URI where
 instance Proto.Serializable ExportLocation where
 	serialize (ExportLocation loc) = loc
 	deserialize = Just . ExportLocation
+
+instance Proto.Serializable ExportDirectory where
+	serialize (ExportDirectory loc) = loc
+	deserialize = Just . ExportDirectory
--- a/Remote/Helper/Export.hs
+++ b/Remote/Helper/Export.hs
@ -32,8 +32,9 @@ instance HasExportUnsupported (Annex (ExportActions Annex)) where
 			warning "store export is unsupported"
 			return False
 		, retrieveExport = \_ _ _ _ -> return False
-		, removeExport = \_ _ -> return False
 		, checkPresentExport = \_ _ -> return False
+		, removeExport = \_ _ -> return False
+		, removeExportDirectory = Just $ \_ -> return False
 		, renameExport = \_ _ _ -> return False
 		}

--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@ -92,6 +92,8 @@ gen r u c gc = do
 					, retrieveExport = retrieveExportS3 info h
 					, removeExport = removeExportS3 info h
 					, checkPresentExport = checkPresentExportS3 info h
+					-- S3 does not have directories.
+					, removeExportDirectory = Nothing
 					, renameExport = renameExportS3 info h
 					}
 			, whereisKey = Just (getWebUrls info c)
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@ -73,8 +73,10 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			, exportActions = withDAVHandle this $ \mh -> return $ ExportActions
 				{ storeExport = storeExportDav mh
 				, retrieveExport = retrieveExportDav mh
-				, removeExport = removeExportDav mh
 				, checkPresentExport = checkPresentExportDav this mh
+				, removeExport = removeExportDav mh
+				, removeExportDirectory = Just $
+					removeExportDirectoryDav mh
 				, renameExport = renameExportDav mh
 				}
 			, whereisKey = Nothing
@ -189,10 +191,6 @@ retrieveExportDav mh  _k loc d p = runExport mh $ \_dav -> do
 	retrieveHelper (exportLocation loc) d p
 	return True

-removeExportDav :: Maybe DavHandle -> Key -> ExportLocation -> Annex Bool
-removeExportDav mh _k loc = runExport mh $ \_dav ->
-	removeHelper (exportLocation loc)
-
 checkPresentExportDav :: Remote -> Maybe DavHandle -> Key -> ExportLocation -> Annex Bool
 checkPresentExportDav r mh _k loc = case mh of
 	Nothing -> giveup $ name r ++ " not configured"
@ -200,6 +198,15 @@ checkPresentExportDav r mh _k loc = case mh of
 		v <- goDAV h $ existsDAV (exportLocation loc)
 		either giveup return v

+removeExportDav :: Maybe DavHandle -> Key -> ExportLocation -> Annex Bool
+removeExportDav mh _k loc = runExport mh $ \_dav ->
+	removeHelper (exportLocation loc)
+
+removeExportDirectoryDav :: Maybe DavHandle -> ExportDirectory -> Annex Bool
+removeExportDirectoryDav mh (ExportDirectory dir) = runExport mh $ \_dav ->
+	safely (inLocation dir delContentM)
+		>>= maybe (return False) (const $ return True)
+
 renameExportDav :: Maybe DavHandle -> Key -> ExportLocation -> ExportLocation -> Annex Bool
 renameExportDav Nothing _ _ _ = return False
 renameExportDav (Just h) _k src dest
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@ -19,6 +19,7 @@ module Types.Remote
 	, Verification(..)
 	, unVerified
 	, ExportLocation(..)
+	, ExportDirectory(..)
 	, isExportSupported
 	, ExportActions(..)
 	)
@ -164,6 +165,9 @@ unVerified a = do
 newtype ExportLocation = ExportLocation FilePath
 	deriving (Show, Eq)

+newtype ExportDirectory = ExportDirectory FilePath
+	deriving (Show, Eq)
+
 isExportSupported :: RemoteA a -> a Bool
 isExportSupported r = exportSupported (remotetype r) (config r) (gitconfig r)

@ -178,6 +182,13 @@ data ExportActions a = ExportActions
 	, retrieveExport :: Key -> ExportLocation -> FilePath -> MeterUpdate -> a Bool
 	-- Removes an exported file (succeeds if the contents are not present)
 	, removeExport :: Key -> ExportLocation -> a Bool
+	-- Removes an exported directory. Typically the directory will be
+	-- empty, but it could possbly contain files or other directories,
+	-- and it's ok to delete those. If the remote does not use
+	-- directories, or automatically cleans up empty directories,
+	-- this can be Nothing. Should not fail if the directory was
+	-- already removed.
+	, removeExportDirectory :: Maybe (ExportDirectory -> a Bool)
 	-- Checks if anything is exported to the remote at the specified
 	-- ExportLocation.
 	-- Throws an exception if the remote cannot be accessed.
--- a/doc/design/external_special_remote_protocol.mdwn
+++ b/doc/design/external_special_remote_protocol.mdwn
@ -176,6 +176,17 @@ replying with `UNSUPPORTED-REQUEST` is acceptable.
  `REMOVE-FAILURE`.  
  If the content was already not present in the remote, it should
  respond with `REMOVE-SUCCESS`.
+* `REMOVEEXPORTDIRECTORY Directory`  
+  Requests the remote remove an exported directory.  
+  If the remote does not use directories, or automatically cleans up
+  empty directories, this does not need to be implemented.  
+  The directory will be in the form of a relative path, and may contain path
+  separators, whitespace, and other special characters.  
+  Typically the directory will be empty, but it could possbly contain
+  files or other directories, and it's ok to remove those.  
+  The remote responds with either `REMOVEEXPORTDIRECTORY-SUCCESS`
+  or `REMOVEEXPORTDIRECTORY-FAILURE`.  
+  Should not fail if the directory was already removed.
 * `RENAMEEXPORT Key NewName`  
  Requests the remote rename a file stored on it from the previously
  provided Name to the NewName.  
@ -261,6 +272,10 @@ while it's handling a request.
  Indicates that a `RENAMEEXPORT` was done successfully.
 * `RENAMEEXPORT-FAILURE Key`  
  Indicates that a `RENAMEEXPORT` failed for whatever reason.
+* `REMOVEEXPORTDIRECTORY-SUCCESS`  
+  Indicates that a `REMOVEEXPORTDIRECTORY` was done successfully.
+* `REMOVEEXPORTDIRECTORY-FAILURE`  
+  Indicates that a `REMOVEEXPORTDIRECTORY` failed for whatever reason.
 * `UNSUPPORTED-REQUEST`  
  Indicates that the special remote does not know how to handle a request.

--- a/doc/special_remotes/external/example.sh
+++ b/doc/special_remotes/external/example.sh
@ -264,6 +264,15 @@ while read line; do
 			key="$2"
 			doremove "$key" "$exportlocation"
 		;;
+		REMOVEEXPORTDIRECTORY)
+			shift 1
+			dir="$@"
+			if [ ! -d "$dir" ] || rm -rf "$mydirectory/$dir"; then
+				echo REMOVEEXPORTDIRECTORY-SUCCESS
+			else
+				echo REMOVEEXPORTDIRECTORY-FAILURE
+			fi
+		;;
 		RENAMEEXPORT)
 			key="$2"
 			shift 2