Insist that OtherEntryType 'K' mandates GnuFormat

haskell · Dec 10, 2023 · fb7a657 · fb7a657
1 parent ef61ce8
commit fb7a657
Show file tree

Hide file tree

Showing 2 changed files with 3 additions and 0 deletions.
diff --git a/Codec/Archive/Tar/Write.hs b/Codec/Archive/Tar/Write.hs
@@ -38,6 +38,8 @@ write es = LBS.concat $ map putEntry es ++ [LBS.replicate (512*2) 0]
 putEntry :: Entry -> LBS.ByteString
 putEntry entry = case entryContent entry of
   NormalFile       content size -> LBS.concat [ header, content, padding size ]
+  OtherEntryType 'K' _ _
+    | entryFormat entry /= GnuFormat -> error "putEntry: long symlink support is a GNU extension"
   OtherEntryType 'L' _ _
     | entryFormat entry /= GnuFormat -> error "putEntry: long filename support is a GNU extension"
   OtherEntryType _ content size -> LBS.concat [ header, content, padding size ]

diff --git a/test/Codec/Archive/Tar/Types/Tests.hs b/test/Codec/Archive/Tar/Types/Tests.hs
@@ -85,6 +85,7 @@ instance (Arbitrary tarPath, Arbitrary linkTarget) => Arbitrary (GenEntry tarPat
     entryOwnership <- arbitrary
     entryTime <- arbitraryOctal 11
     entryFormat <- case entryContent of
+      OtherEntryType 'K' _ _ -> pure GnuFormat
       OtherEntryType 'L' _ _ -> pure GnuFormat
       _ -> arbitrary
     pure Entry{..}