GMailにアクセス
IMAP で GMail にアクセスし、メール一覧を表示するプログラムを PLT Scheme で作ってみました。
SSL 接続の他、メールのタイトル等のデコードの方法、syntax-case でのマクロの作り方といったポイントにも触れていきたいと思います。
SSL ライブラリ
PLT には IMAP その他ネットワーク関連のライブラリは充実しているんですが、SSL 接続だけちょっと手間が要るみたいです。次のようなライブラリを作る必要があります。
ssl-url.ss:
;; Reference: http://schemecookbook.org/view/Scm/SslUrl #lang scheme/base (require scheme/unit net/url-structs net/url-sig net/url-unit net/tcp-sig net/ssl-tcp-unit) (define-compound-unit url+tcp@ (import) (link [((TCP : tcp^)) (make-ssl-tcp@ #f #f #f #f #f #f #f)] [((URL : url^)) url@ TCP]) (export URL TCP)) (define-values/invoke-unit url+tcp@ (import) (export tcp^ url^)) (provide (struct-out url)) (provide-signature-elements url^ tcp^)
せっかく作っておいて何ですが、以下で利用するのは tcp-connect だけです。
[追記]
すいません、わざわざライブラリを作る必要なんてありませんでした。
(require openssl)
して
(ssl-connect "imap.gmail.com" 993)
だけで接続できます。大変失礼いたしました…
[/追記]
SSL 接続
では GMail に接続する関数を作ります:
(require scheme/port srfi/8 net/imap net/head net/base64 net/qp "ssl-url.ss" (for-syntax scheme/base)) (define (connect-gmail user pass) (receive (in out) (tcp-connect "imap.gmail.com" 993) (imap-connect* in out user pass "Inbox")))
imap-connect* は IMAP オブジェクトと、メールボックスにある全メール数、新着メール数の3値を返す関数です。
ここまでは特に苦も無くできました。
メールの取得
IMAP ライブラリのメール取得関数を紹介しておきましょう。
(imap-get-messages imap '(1 2 3) '(header flags))
このような形式で、第2引数で指定されたインデックスの、第3引数で指定したフィールドを取得します。
(フィールドにはこの2つのほかに、uid と body があります)
戻り値はリストのリストで、指定したフィールドの順にデータが入ったリストが返ってきます:
((header-string-1 (list-of-flags-1)) (header-string-2 (list-of-flags-2)) (header-string-3 (list-of-flags-3)))
(header-string は実際にはバイト列)
ここで、各フィールドにアクセスする関数を作っておきましょう。
上記のようにメールはただのリストなので、car とか cadr 等を使ってアクセスすれば OK です。上の例の形式でメールを取得する場合、次のようにアクセサを作れば良いわけです:
(define-values (message-header message-flags) (values car cadr))
しかし、いつか気が変わって body も取得したい等となった時に、このやり方だとちょっと面倒ではないかと思います。そこで、アクセサ関数を自動的に定義するマクロを作ってみました。
(define-syntax (define-accessors x) (define ((accessor-name stx) field) (datum->syntax stx (string->symbol (format "message-~a" (syntax-e field))))) (syntax-case x () ((k (f ...)) (with-syntax ((((f i) ...) (for/list (((field index) (in-indexed (syntax->list #'(f ...))))) #`(#,field #,index)))) #`(begin #,@(map (lambda (f i) #`(define (#,f msg) (list-ref msg #,i))) (map (accessor-name #'k) (syntax->list #'(f ...))) (syntax->list #'(i ...))) (define #,(datum->syntax #'k 'message-fields) '(f ...)))))))
いかがでしょうか。多分慣れない方には不愉快なぐらい難しく見えると思うんですが、慣れれば大したことはありません。
真ん中あたりの for/list というのは Common Lisp で言う loop 構文のようなもので、これでフィールド名とそのインデックスの対のリスト ((f i) ...) を作っています。
その次の #`(begin 以下がマクロ展開される式です。はじめの #,@(map の部分でアクセサ関数を定義しています。
ここで注意すべき点がありまして、普通に
(define message-header ...
等と欲しい名前をそのまま書いてもそんな名前の変数は定義されないんです。名前衝突を避けるために自動的にユニークな名前に変換されるためで、通常はそれが Scheme マクロの有難いところなんですが、この場合は困ります。
そんな時、datum->syntax という関数を使うことで、指定した名前の識別子を作ることが可能になります。
なお、リストの要素にアクセスするのに list-ref を使っていますが、インデックスを "d" の個数に対応させて car、cadr 等の関数名を生成する方法もあります:
(define-syntax (define-accessors x) (define ((accessor-name stx) field) (datum->syntax stx (string->symbol (format "message-~a" (syntax-e field))))) (define (cad*r i) (string->symbol (format "ca~ar" (list->string (for/list ((_ (in-range i))) #\d))))) (syntax-case x () ((k (f ...)) (with-syntax ((((f g) ...) (for/list (((field index) (in-indexed (syntax->list #'(f ...))))) #`(#,field #,(cad*r index))))) #`(begin #,@(map (lambda (f g) #`(define #,f #,g)) (map (accessor-name #'k) (syntax->list #'(f ...))) (syntax->list #'(g ...))) (define #,(datum->syntax #'k 'message-fields) '(f ...)))))))
マクロの使い方自体は
(define-accessors (header body flags))
と簡単です。これで message-header, message-body のように、フィールド名に応じたアクセサ関数が定義されます。
また同時に、指定されたフィールドのリストを、message-fields という変数として定義しています。これは imap-get-messages 関数の第3引数として使うことを意図したものです。
MIME デコード、文字コード変換
メールを読むプログラムを作る時に必ず直面するのが、タイトルなどに有る
=?ISO-2022-JP?B?GyRCJE8kRiRKJSIlcyVGJUobKEI=?=
みたいな文字列をどうやってデコードするんだろう？という問題ではないでしょうか。
簡単に説明しますと、まず文字列を "?" で区切ってください。その2番目の部分 (ISO-2022-JP) が文字エンコーディングの方式を表しています。次の B というのが Base64 で符号化されていることを示すフラグ (Q だと Quoted-Printable) です。したがって、その次の文字列は Base64 で符号化された ISO-2022-JP の文字列、ということになります。
(define (decode-header-field field) (define (mime-decode type bstr) ((if (bytes=? type #"B") base64-decode qp-decode) bstr)) (regexp-replace* #rx"\r\n ?" (regexp-replace* #rx"=\\?(.+?)\\?(.)\\?(.+?)\\?=" field (lambda (_ enc type bstr) (convert-bytes (bytes->string/latin-1 enc) (mime-decode type bstr)))) #"")) (define (convert-bytes enc bstr) (let ((o (open-output-bytes))) (convert-stream enc (open-input-bytes bstr) "UTF-8" o) (get-output-bytes o)))
デコーダ関数をこのように定義すると、ヘッダーからタイトルを取り出して表示するコードはこのように書けます:
(define (header-field field msg) (extract-field (string->bytes/latin-1 field) (message-header msg))) (printf "~a~%" (decode-header-field (header-field "Subject" msg)))
ここで msg は imap-get-messages で得られたリストの要素です。extract-field は net/head ライブラリで提供されている関数です。ヘッダとフィールドの値を、文字列なら文字列、バイト列ならバイト列に揃える必要があるので気をつけましょう。
メール一覧を表示する関数を作る前に、本文から1行だけ取り出す関数を作ってみましょう:
(define (body-snippet msg) (cond ((regexp-match #rx"(?i:charset=([-0-9a-z]+))" (header-field "Content-Type" msg)) => (lambda (enc) (convert-bytes (bytes->string/latin-1 (cadr enc)) (first-line (message-body msg))))) (else (first-line (message-body msg))))) (define (first-line bstr) (read-bytes-line (open-input-bytes bstr) 'return-linefeed))
仕上げ
一覧表示関数です:
(define (print-headline imap nums) (newline) (for-each (lambda (msg) (printf "~a ~a (~a)~%" (if (new-message? msg) "*" " ") (decode-header-field (header-field "Subject" msg)) (body-snippet msg))) (imap-get-messages imap nums message-fields))) (define (new-message? msg) (not (memq '|\Seen| (message-flags msg))))
利用例:
(receive (imap all new) (connect-gmail "user" "pass") (print-headline imap (for/list ((i (in-range all))) (add1 i))) (imap-disconnect imap))
