Haskell で UTF-8 メールを送信 - SMTPClient 使用

Haskell

前回 id:fits:20101101 にて Scala や F# で実装したメールの送信処理を Haskell で実装してみました。

メール送信には HaskellNet を使う方法もあるようですが、今回は SMTPClient を使いました。

  • HaskellPlatform 2010.2.0.0 (GHC 6.10.4)
  • SMTPClient 1.0.3

なお、メール送信処理の仕様は id:fits:20101101 と同じです。（Shift_JIS の実行時引数と標準入力を UTF-8 に変換して送信）

サンプルのソースコードは http://github.com/fits/try_samples/tree/master/blog/20101106/

事前準備

必要なパッケージを cabal コマンドでインストールします。

> cabal install hsemail
> cabal install SMTPClient
> cabal install base64-string

iconv パッケージもインストールしておきます。（手順は id:fits:20101105 参照）

簡単なメール送信

まず、エンコード処理は行わずにメール送信する処理です。入力文字のままメール送信されます。（Content-Type などのメールヘッダー無し）

send_mail_simple.hs
import System
import Network.SMTP.Simple

main = do
    args <- getArgs
    -- メール本文（標準入力から取得）
    body <- getContents
    -- Fromメールアドレスからドメイン部分を取得
    let domain = tail $ snd $ break (== '@') $ args !! 1
    -- メッセージ作成
    let msg = SimpleMessage [NameAddr Nothing (args !! 1)] [NameAddr Nothing (args !! 2)] (args !! 3) body
    -- メール送信
    sendSimpleMessages putStr (head args) domain [msg]

ちなみに、sendSimpleMessages を使ったメールの送信では SMTP サーバーの IP アドレスを指定する必要があります。（ホスト名は使えない）

実行例
> runhaskell send_mail_simple.hs 192.168.1.1 xxxx@xxx.com xxxx@xxx.com "テストノート by Haskell" < mail.txt

UTF-8 のメール送信

SMTPClient で妥当な UTF-8 のメールを送信するには、自前でエンコードまわりの処理を実装する事になると思います。

他のプログラム言語なら、Network.SMTP.Simple の toMessage 関数の処理内容を実行時に書き換えるような方法で解決するところですが。

Haskell でそのような手段が可能かどうか判らなかったので、今回は Network.SMTP.Simple の toMessage と sendSimpleMessages を参考に自前で実装してみました。（toMimeMessage と sendMimeMessage）


メールヘッダーの Content-Type や Content-Transfer-Encoding の設定は、Message の OptionalField を使い、Codec.Binary.Base64.String の encode を使って BASE64 エンコードしています。（文字コード変換は iconv 使用）

なお、今回の方法で BASE64 エンコードすると文字列の長さに応じて自動的に改行が入るようになっているので、Subject に使う場合は各行に "=?UTF-8?B?" と "?=" が付くよう処理しています。

send_mail.hs
import System
import System.Time (CalendarTime(..), getClockTime, toCalendarTime)
import Network.Socket (SockAddr(..), inet_addr)
import Network.SMTP.Client
import Network.SMTP.Simple
import Codec.Text.IConv (convert)
import qualified Data.ByteString.Lazy.Char8 as C
import qualified Codec.Binary.Base64.String as B

sourceEncode = "Shift_JIS"
targetEncode = "UTF-8"

-- 文字コード変換
convertEncode :: String -> String
convertEncode s = C.unpack $ convert sourceEncode targetEncode $ C.pack $ s

--Base64エンコード
encodeBase64 :: String -> String
encodeBase64 s = B.encode $ convertEncode s

-- ヘッダー用Base64エンコード（encodeBase64 の結果に改行が入るケースを考慮）
encodeBase64Header :: String -> String
encodeBase64Header s = unlines $ map addEncodeInfo $ lines $ encodeBase64 s

-- エンコード情報を付与
addEncodeInfo :: String -> String
addEncodeInfo s = "=?" ++ targetEncode ++ "?B?" ++ s ++ "?="

-- Mime用メッセージ変換
toMimeMessage :: CalendarTime -> SimpleMessage -> Message
toMimeMessage ct sm =
    Message
        [
            From (from sm), 
            To (to sm), 
            Subject (encodeBase64Header $ subject sm), 
            Date ct,
            OptionalField "Content-Type" ("text/plain; charset=" ++ targetEncode),
            OptionalField "Content-Transfer-Encoding" "BASE64"
        ]
        (encodeBase64 $ body sm)

-- Mimeメッセージ送信
sendMimeMessage :: String -> SimpleMessage -> IO()
sendMimeMessage smtpHostIp msg = do
    nowCT <- toCalendarTime =<< getClockTime
    -- Fromメールアドレスからドメイン部分を取り出し
    let heloDomain = tail $ snd $ break (== '@') $ nameAddr_addr $ head $ from msg
    hostAddr <- inet_addr smtpHostIp
    let smtpSockAddr = SockAddrInet 25 hostAddr
    -- メール送信
    sendRawMessages putStr smtpSockAddr heloDomain [toMimeMessage nowCT msg]

-- メイン処理
main = do
    args <- getArgs
    -- メール本文（標準入力から取得）
    body <- getContents
    -- メッセージ作成
    let msg = SimpleMessage [NameAddr Nothing (args !! 1)] [NameAddr Nothing (args !! 2)] (args !! 3) body
    -- メール送信
    sendMimeMessage (head args) msg
実行例
> runhaskell -liconv send_mail.hs 192.168.1.1 xxxx@xxx.com xxxx@xxx.com "テストノート by Haskell" < mail.txt