S3: Allow removing files from IA, but warn about derived versions potentially still existing there.

Removal works, only derives are a potential issue, so allow removing
with a warning. This way, unexporting a file works, and behavior is
consistent with IA remotes whether or not exporttree=yes.

Also tested exporting filenames containing unicode, spaces, underscores.
All worked, despite the IA's faq saying it doesn't.

This commit was sponsored by Trenton Cronholm on Patreon.

1 files changed, 14 insertions, 11 deletions

diff --git a/Remote/S3.hs b/Remote/S3.hs
index c7b72def5..396d2c388 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -278,14 +278,17 @@ retrieveCheap _ _ _ = return False
  - While it may remove the file, there are generally other files
  - derived from it that it does not remove. -}
 remove :: S3Info -> S3Handle -> Remover
-remove info h k
+remove info h k = warnIARemoval info $ do
+	res <- tryNonAsync $ sendS3Handle h $
+		S3.DeleteObject (T.pack $ bucketObject info k) (bucket info)
+	return $ either (const False) (const True) res
+
+warnIARemoval :: S3Info -> Annex a -> Annex a
+warnIARemoval info a
 	| isIA info = do
-		warning "Cannot remove content from the Internet Archive"
-		return False
-	| otherwise = do
-		res <- tryNonAsync $ sendS3Handle h $
-			S3.DeleteObject (T.pack $ bucketObject info k) (bucket info)
-		return $ either (const False) (const True) res
+		warning "Derived versions of removed file may still be present in the Internet Archive"
+		a
+	| otherwise = a
 
 checkKey :: Remote -> S3Info -> Maybe S3Handle -> CheckPresent
 checkKey r info Nothing k = case getpublicurl info of
@@ -342,7 +345,7 @@ retrieveExportS3 r info _k loc f p =
 		return True
 
 removeExportS3 :: Remote -> S3Info -> Key -> ExportLocation -> Annex Bool
-removeExportS3 r info _k loc = 
+removeExportS3 r info _k loc = warnIARemoval info $
 	catchNonAsync go (\e -> warning (show e) >> return False)
   where
 	go = withS3Handle (config r) (gitconfig r) (uuid r) $ \h -> do
@@ -620,9 +623,9 @@ getBucketObject c = munge . key2file
 getBucketExportLocation :: RemoteConfig -> ExportLocation -> FilePath
 getBucketExportLocation c (ExportLocation loc) = getFilePrefix c ++ loc
 
-{- Internet Archive limits filenames to a subset of ascii,
- - with no whitespace. Other characters are xml entity
- - encoded. -}
+{- Internet Archive documentation limits filenames to a subset of ascii.
+ - While other characters seem to work now, this entity encodes everything
+ - else to avoid problems. -}
 iaMunge :: String -> String
 iaMunge = (>>= munge)
   where