みなさん、PPAP してますか？ ZIP ファイルをメールに添付して、後からパスワードを送るアレです。個人的にはビジネスでファイルをメールに添付する習慣をなくしていきたいところですが、すぐには変わらないのも習慣です。

仕方がないので以下がかんたんにできるプログラムを Haskell で開発します。

Mac から ZIP ファイルを送信した際に Windows で　ZIP を展開して文字化けしないように気を配る
作成した ZIP ファイルにパスワードを付ける、それもできるだけかんたんに
できれば Mac 固有のファイルが ZIP に紛れ込まないようにする（.DS_Store など）

本プログラム作成の過程で調査も兼ねていくつかのライブラリを使用してみました。

すべての実装は以下のような仕様とします。

引数に指定されたファイルまたはディレクトリを ZIP に圧縮する
引数に指定されたファイルが存在しない場合はエラー終了する
指定された引数がひとつだけなら、単に .zip を付与した名前で ZIP を作成する（foo.txt だけが指定されていた場合 foo.txt.zip とする）
指定された引数が複数なら archive.zip とする
既に同名の ZIP ファイルが存在するなら foo.txt.1.zip、foo.txt.2.zip などと増えていく

また、すべての PPAP モジュールは以下の Main.hs から呼び出されます。

Main.hs

module Main where

import           System.Environment             ( getArgs )

import           PPAP                           ( run )

main :: IO ()
main = getArgs >>= run

zip-archive 版

以下 Hackage に依存します。

bytestring
unix
zip-archive

サンプルコードは以下のとおりです。

PPAP.hs

module PPAP where

import           Codec.Archive.Zip              ( ZipOption(OptRecursive)
                                                , addFilesToArchive
                                                , emptyArchive
                                                , fromArchive
                                                )
import           Control.Monad                  ( when )
import qualified Data.ByteString.Lazy          as LBS
import           System.Environment             ( getArgs )
import           System.Exit                    ( ExitCode(ExitFailure)
                                                , exitWith
                                                )
import           System.Posix.Files             ( fileExist )

decideZipFileName :: [String] -> IO FilePath
decideZipFileName args = go args 0
 where
  go :: [String] -> Int -> IO FilePath
  go args n = do
    exist <- fileExist candidate
    if exist then go args (succ n) else return candidate
   where
    basename  = if length args == 1 then head args else "archive"
    suffix    = if n == 0 then "" else "." ++ show n
    candidate = basename ++ suffix ++ ".zip"

run :: IO ()
run = do
  args <- getArgs
  null args `when` exitWith (ExitFailure 1)
  let options = replicate (length args) OptRecursive
  archive <- addFilesToArchive options emptyArchive args
  zipFile <- decideZipFileName args
  LBS.writeFile zipFile $ fromArchive archive

zip-archive パッケージは使用がかなりかんたんですが、その分細かいことができません。具体的には ZIP エントリのエントリ名を自由に変更できません¹。また、ZIP ファイルのパスワードによる暗号化もできません。ただし使い方がかんたんです。単にプラットフォーム依存の文字コードで ZIP が作成できればよいのであればこれが一番良いかもしれません。

zip 版

以下 Hackage に依存します。

bytestring
extra
iconv
string-conversions
unix
zip

サンプルコードは以下のとおりです。

PPAP.hs

module PPAP where

import           Codec.Archive.Zip              ( CompressionMethod(Deflate)
                                                , ZipArchive
                                                , addEntry
                                                , createArchive
                                                , mkEntrySelector
                                                )
import           Codec.Text.IConv               ( convert )
import           Control.Monad                  ( unless
                                                , when
                                                )
import           Control.Monad.IO.Class         ( liftIO )
import qualified Data.ByteString               as BS
import           Data.ByteString.Builder        ( stringUtf8
                                                , toLazyByteString
                                                )
import           Data.String.Conversions        ( convertString )
import           System.Directory.Extra         ( listFilesRecursive )
import           System.Exit                    ( ExitCode(ExitFailure)
                                                , exitWith
                                                )
import           System.IO                      ( hPutStrLn
                                                , stderr
                                                )
import           System.Posix                   ( FileStatus )
import           System.Posix.Files             ( fileExist
                                                , getFileStatus
                                                , isDirectory
                                                )

decideZipFileName :: [String] -> IO FilePath
decideZipFileName args = go args 0
 where
  go :: [String] -> Int -> IO FilePath
  go args n = do
    exist <- fileExist candidate
    if exist then go args (succ n) else return candidate
   where
    basename  = if length args == 1 then head args else "archive"
    suffix    = if n == 0 then "" else "." ++ show n
    candidate = basename ++ suffix ++ ".zip"

listFiles' :: (FilePath, FileStatus) -> IO [FilePath]
listFiles' (fp, fs) =
  if isDirectory fs then listFilesRecursive fp else return [fp]

exitFailureIfFileNotExist :: FilePath -> IO ()
exitFailureIfFileNotExist fp = do
  exist <- fileExist fp
  unless exist $ do
    hPutStrLn stderr $ "File not exist: " ++ fp
    exitWith $ ExitFailure 1

getFileStatus' :: FilePath -> IO (FilePath, FileStatus)
getFileStatus' fp = do
  fs <- getFileStatus fp
  return (fp, fs)

toShiftJIS :: String -> String
toShiftJIS =
  convertString . convert "UTF-8" "Shift_JIS" . toLazyByteString . stringUtf8

archive :: [FilePath] -> ZipArchive ()
archive []         = return ()
archive (fp : fps) = do
  selector <- mkEntrySelector $ toShiftJIS fp
  contents <- liftIO $ BS.readFile fp
  addEntry Deflate contents selector
  archive fps

run :: [String] -> IO ()
run args = do
  null args `when` exitWith (ExitFailure 1)
  mapM_ exitFailureIfFileNotExist args
  pairs <- mapM getFileStatus' args
  files <- mapM listFiles' pairs
  let files' = concat files
  zipFileName <- decideZipFileName args
  createArchive zipFileName $ archive files'

zip パッケージは zip-archive パッケージに比べると使うのは面倒ですが、それほど低レベルでもないため ZipArchive モナドの使い方さえわかってしまえば問題ないでしょう。ただしこのパッケージでもパスワードによる暗号化ができません。

LibZip 版

以下パッケージに依存します。

bytestring
extra
iconv
string-conversions
transformers
unix
LibZip

PPAP.hs

module PPAP where

import           Codec.Archive.LibZip           ( OpenFlag(CreateFlag)
                                                , addFile
                                                , sourceFile
                                                , withEncryptedArchive
                                                )
import           Codec.Archive.LibZip.Types     ( Zip )
import           Codec.Text.IConv               ( convert )
import           Control.Monad                  ( unless
                                                , when
                                                )
import           Control.Monad.Trans.State.Strict
                                                ( StateT )
import           Data.ByteString.Builder        ( stringUtf8
                                                , toLazyByteString
                                                )
import           Data.String.Conversions        ( convertString )
import           System.Directory.Extra         ( listFilesRecursive )
import           System.Exit                    ( ExitCode(ExitFailure)
                                                , exitWith
                                                )
import           System.IO                      ( hPutStrLn
                                                , stderr
                                                )
import           System.Posix                   ( FileStatus )
import           System.Posix.Files             ( fileExist
                                                , getFileStatus
                                                , isDirectory
                                                )

decideZipFileName :: [String] -> IO FilePath
decideZipFileName args = go args 0
 where
  go :: [String] -> Int -> IO FilePath
  go args n = do
    exist <- fileExist candidate
    if exist then go args (succ n) else return candidate
   where
    basename  = if length args == 1 then head args else "archive"
    suffix    = if n == 0 then "" else "." ++ show n
    candidate = basename ++ suffix ++ ".zip"

listFiles' :: (FilePath, FileStatus) -> IO [FilePath]
listFiles' (fp, fs) =
  if isDirectory fs then listFilesRecursive fp else return [fp]

exitFailureIfFileNotExist :: FilePath -> IO ()
exitFailureIfFileNotExist fp = do
  exist <- fileExist fp
  unless exist $ do
    hPutStrLn stderr $ "File not exist: " ++ fp
    exitWith $ ExitFailure 1

getFileStatus' :: FilePath -> IO (FilePath, FileStatus)
getFileStatus' fp = do
  fs <- getFileStatus fp
  return (fp, fs)

toShiftJIS :: String -> String
toShiftJIS =
  convertString . convert "UTF-8" "Shift_JIS" . toLazyByteString . stringUtf8

archive :: [FilePath] -> StateT Zip IO ()
archive []         = return ()
archive (fp : fps) = do
  zs <- sourceFile fp 0 0
  addFile (toShiftJIS fp) zs
  archive fps

run :: [String] -> IO ()
run args = do
  null args `when` exitWith (ExitFailure 1)
  mapM_ exitFailureIfFileNotExist args
  pairs <- mapM getFileStatus' args
  files <- mapM listFiles' pairs
  let files' = concat files
  zipFileName <- decideZipFileName args
  withEncryptedArchive [CreateFlag] "foobar" zipFileName $ archive files'

LibZip パッケージは別途 libzip ライブラリが必要になります。誤算だったのは withEncryptedArchive を用いて ZIP ファイルを作成するとパスワード付き ZIP が作成できると思っていたのですができませんでした。エラーにもならず、普通の ZIP が生成されます。

LibZip の該当関数のソースコードを見てみたら既に暗号化された ZIP にファイルに追加することはできるみたいですが、新規に暗号化 ZIP を作ることはこのパッケージではできないみたいです。ソースコードに libzip の zip_file_set_encryption が含まれていませんでした。

まとめ

Haskell でいくつかの ZIP パッケージを実際に使用して試してみましたが、それら全てにパスワード付き ZIP を作成する関数がそもそも提供されていませんでした。パスワード付き ZIP は、ZIP の標準機能として ZipCrypto がサポートされていますが、これは脆弱性が指摘されているため使用が推奨されておらず、ZIP ファイル形式仕様 5.2 からサポートされた拡張機能の暗号化方式はベンダーごとに方式が異なり（WinZip は AES、7-Zip は AE-x、SecureZIP は RC2、RC4 など）、更には X.509 デジタル証明書ベースの暗号化と認証、アーカイブヘッダの暗号化などもあったりし、広く使われてきた歴史あるファイル形式であるため混沌を極めています。

libzip を使用してパスワード付き ZIP を作成するのは、以下のようなコードになります。

#include <stdio.h>
#include <stdlib.h>
#include <zip.h>

int main() {
    int err;
    zip_t *zip = zip_open("protected.zip", ZIP_CREATE | ZIP_EXCL, &err);

    if (zip == NULL) {
        fprintf(stderr, "Error creating ZIP archive: %d\n", err);
        return 1;
    }

    if (zip_set_default_password(zip, "password") < 0) {
        fprintf(stderr, "Error setting ZIP password\n");
        zip_close(zip);
        return 1;
    }

    zip_source_t *source = zip_source_buffer(zip, "Hello, World!", 13, 0);
    if (source == NULL) {
        fprintf(stderr, "Error creating source for new file\n");
        zip_close(zip);
        return 1;
    }

    if (zip_file_add(zip, "foo.txt", source, ZIP_FL_ENC_UTF_8) < 0) {
        fprintf(stderr, "Error adding file to ZIP: %s\n", zip_strerror(zip));
        zip_source_free(source);
        zip_close(zip);
        return 1;
    }

    if (zip_close(zip) < 0) {
        fprintf(stderr, "Error closing ZIP archive: %s\n", zip_strerror(zip));
        return 1;
    }

    printf("ZIP archive 'protected.zip' created successfully.\n");
    return 0;
}

2023 年末に公開されているパッケージにこの機能がない、というのが残念ですが、C 言語を書く覚悟があれば、libzip を用いて Haskell から C 言語で作成した関数を呼び出し、パスワード付き ZIP を作成することはできます。

toEntry を使った後 eRelativePath で名前を替えればできるかもしれません ↩