zip2tar-0.0: src/Main.hs

module Main where

import qualified Options.Applicative as OP
import System.Posix.Types (FileMode)

import qualified Codec.Archive.Zip.Unix as ZipUnix
import qualified Codec.Archive.Zip as Zip
import qualified Data.Conduit.Tar as CTar
import qualified Conduit as C
import Data.Conduit (runConduitRes, (.|))

import qualified Data.Time.Clock.POSIX as PosixTime
import qualified Data.ByteString.Char8 as BC
import qualified Data.Map as Map
import qualified Data.List as List
import qualified Data.Char as Char
import Data.Traversable (for)
import Data.Ord (comparing)
import Data.Bits ((.&.), (.|.))
import Data.Word (Word32)

import Control.Monad (join, void)



info :: OP.Parser a -> OP.ParserInfo a
info p =
   OP.info
      (OP.helper <*> p)
      (OP.fullDesc <>
       OP.progDesc "Convert ZIP to TAR archive")

data Sort = SortPosition | SortLexicographic
   deriving (Eq, Ord)

parser :: OP.Parser (IO ())
parser =
   pure convertZipToTar
   <*> parseInfoConversion
   <*>
      OP.flag SortPosition SortLexicographic
         (OP.long "sort-by-name" <>
          OP.help
            "sort files by names (default: storage order)")
   <*>
      OP.strArgument
         (OP.metavar "INPUT" <>
          OP.help "Input ZIP archive")

parseInfoConversion ::
   OP.Parser (Zip.EntrySelector -> Zip.EntryDescription -> CTar.FileInfo)
parseInfoConversion =
   pure fileInfoFromZipEntry
   <*>
      OP.option (OP.eitherReader packName)
         (OP.long "user-name" <>
          OP.metavar "NAME" <>
          OP.value BC.empty <>
          OP.help "UNIX user name for files in TAR output")
   <*>
      OP.option OP.auto
         (OP.long "user-id" <>
          OP.metavar "UID" <>
          OP.value 0 <>
          OP.help "UNIX user id for files in TAR output")
   <*>
      OP.option (OP.eitherReader packName)
         (OP.long "group-name" <>
          OP.metavar "NAME" <>
          OP.value BC.empty <>
          OP.help "UNIX group name for files in TAR output")
   <*>
      OP.option OP.auto
         (OP.long "group-id" <>
          OP.metavar "GID" <>
          OP.value 0 <>
          OP.help "UNIX group id for files in TAR output")
   <*>
      OP.flag AttributeWindows AttributeUNIX
         (OP.long "use-unix-permissions" <>
          OP.help
            ("respect UNIX file permissions of zipped files " ++
             "(default: read Windows attributes)"))

packName :: String -> Either String BC.ByteString
packName name =
   if all Char.isAscii name
   then Right $ BC.pack name
   else Left "name contains non-ASCII characters"


main :: IO ()
main = join $ OP.execParser $ info parser


convertZipToTar ::
   (Zip.EntrySelector -> Zip.EntryDescription -> CTar.FileInfo) ->
   Sort -> FilePath -> IO ()
convertZipToTar fileInfoFromZipEntry_ sortMode zipPath =
   Zip.withArchive zipPath $ do
      let sort =
            case sortMode of
               SortPosition -> List.sortBy (comparing (Zip.edOffset . snd))
               SortLexicographic -> id
      entries <- sort . Map.toList <$> Zip.getEntries
      files <-
         for entries $ \(selector, descr) ->
            flip fmap (Zip.getEntrySource selector) $ \src ->
               src
               .|
               (C.yield (Left $ fileInfoFromZipEntry_ selector descr)
                >>
                C.mapC Right)
      C.liftIO $ runConduitRes $
         sequence_ files
         .|
         void CTar.tar
         .|
         C.stdoutC


data AttributeSource = AttributeWindows | AttributeUNIX
   deriving (Eq, Ord)


windowsReadonlyAttr :: Word32
windowsReadonlyAttr = 1

unixUserReadable :: FileMode
unixUserReadable = 0o400

unixUserWriteable :: FileMode
unixUserWriteable = 0o200

unixPermFromWindowsAttr :: Word32 -> FileMode
unixPermFromWindowsAttr attrs =
   unixUserReadable
   .|.
   if attrs .&. windowsReadonlyAttr == 0
      then unixUserWriteable
      else 0

fileInfoFromZipEntry ::
   BC.ByteString -> CTar.UserID ->
   BC.ByteString -> CTar.GroupID ->
   AttributeSource ->
   Zip.EntrySelector -> Zip.EntryDescription -> CTar.FileInfo
fileInfoFromZipEntry userName userId groupName groupId attrSrc sel descr =
   CTar.FileInfo {
      CTar.filePath      = BC.pack $ Zip.unEntrySelector sel,
      CTar.fileUserId    = userId,
      CTar.fileUserName  = userName,
      CTar.fileGroupId   = groupId,
      CTar.fileGroupName = groupName,
      CTar.fileMode      =
         (case attrSrc of
            AttributeWindows -> unixPermFromWindowsAttr
            AttributeUNIX -> ZipUnix.toFileMode) $
         Zip.edExternalFileAttrs descr,
      CTar.fileSize      = fromIntegral $ Zip.edUncompressedSize descr,
      CTar.fileType      = CTar.FTNormal,
      CTar.fileModTime   =
         fromInteger $ round $
         (realToFrac $ PosixTime.utcTimeToPOSIXSeconds $ Zip.edModTime descr
            :: Rational)
   }