POP3クライアントのモジュールを書いてみた

さて、今回はPOP3クライアントのモジュールを書いてみようと思います。前回、半泣きでテストを書いてみたので、それに合わせてつらつらと書いていけば良いはずです。

ところでPOP3では、三つの状態（AUTHORIZATION, TRANSACTION, UPDATE）が規定されています。「クライアント側だから考慮しなくていいかなぁ」と迷ったものの、そういう仕様を知ってしまった以上は実装してみたいと思います。趣味のYAGNI破りです。

では、前回ざっと決めたデザイン（オブジェクトを使う、POP3サーバーとの入出力は関数で包んじゃう、など）に沿ってコードを書いていきます。いつも通り、コンパイルエラーの山と戦うのですが、経験値が上がってきたおかげで以前ほど、苦しまなくなってきました。

で、できたのがこんなコード。

type stat =
  | Authrization
  | Transaction
  | Update
  | Close

type cmd =
  | User of string
  | Pass of string
  | Quit
  | Stat
  | List of int option
  | Retr of int
  | Dele of int
  | Noop
  | Rset
  | Top of int * int

type res =
  | OneLine
  | MultiLine

exception Error_response

type cmd_info_rec = {str:string; res:res; trans:stat option}

let cmd_info stat cmd =
  let sp = Printf.sprintf in
  let otos = function Some i -> sp " %d" i | None -> "" in
  match stat with
  | Authrization -> (
      match cmd with
      | User s -> {str = sp "USER %s" s; res = OneLine; trans = None}
      | Pass s -> {str = sp "PASS %s" s; res = OneLine; trans = Some Transaction}
      | Quit ->   {str = "QUIT"; res = OneLine; trans = Some Close}
      | x -> invalid_arg "stat is Authrization"
    )
  | Transaction -> (
      match cmd with
      | Stat ->   {str = "STAT"; res = OneLine; trans = None}
      | List o -> {str = "LIST" ^ (otos o); res = MultiLine; trans = None}
      | Retr i -> {str = sp "RETR %d" i; res = MultiLine; trans = None}
      | Dele i -> {str = sp "DELE %d" i; res = OneLine; trans = None}
      | Noop ->   {str = "NOOP"; res = OneLine; trans = None}
      | Rset ->   {str = "RSET"; res = MultiLine; trans = None}
      | Top (i, j) -> {str = sp "TOP %d %d" i j; res = MultiLine; trans = None}
      | Quit ->   {str = "QUIT"; res = OneLine; trans = Some Update}
      | x -> invalid_arg "stat is Transaction"
    )
  | x -> invalid_arg "stat is neither Authrization nor Transaction"

let recieve_response infun resmode =
  let re = Str.regexp (if resmode = OneLine then "\r\n" else "\r\n.\r\n") in
  let bufsize = 1024 in
  let resbuf = Buffer.create bufsize in
  let tmpbuf = String.create bufsize in
  let rec recv () =
    let rlen = infun tmpbuf 0 bufsize in (
      try
        let pos = Str.search_forward re tmpbuf 0 in
        Buffer.add_substring resbuf tmpbuf 0 pos;
        Buffer.contents resbuf
      with
      | Not_found ->
          Buffer.add_substring resbuf tmpbuf 0 rlen; recv ()
    ) in
  recv ()

let parse_and_check_response resbuf =
  let list = Str.split (Str.regexp "\r\n") resbuf in
  match list with
  | [] -> failwith "invalid response";
  | hd::tl -> (
      let res = Str.bounded_split (Str.regexp " ") hd 2 in
      match (List.hd res) with
      | "+OK" -> String.concat " " (List.tl res)::tl
      | "-ERR" -> raise Error_response
      | _ -> failwith "invalid response"
    )

class pop3_client ~infun ~outfun = object (self)

  val mutable stat = Authrization

  val infuc = infun
  val outfun = outfun

  method private execmd cmd =
    let ci = cmd_info stat cmd in
    let sendstr = ci.str ^ "\r\n" in
    outfun sendstr 0 (String.length sendstr);
    let resbuf = recieve_response infun ci.res in
    let reslist = parse_and_check_response resbuf in (
      match ci.trans with
      | None -> ()
      | Some s -> ignore (stat <- s)
    );
    reslist

  method auth ~user ~pass =
    ignore (recieve_response infun OneLine);
    ignore (self#execmd (User user));
    ignore (self#execmd (Pass pass));
    ()

  method quit () = ignore (self#execmd Quit)
  method stat () = self#execmd Stat
  method list ?(msgno) () = self#execmd (List msgno)
  method retr ~msgno = self#execmd (Retr msgno)
  method dele ~msgno = ignore (self#execmd (Dele msgno))
  method noop () = ignore (self#execmd Noop)
  method rset () = ignore (self#execmd Rset)
  method top ~msgno ~line  = self#execmd (Top (msgno, line))
end

今回悩んだのは、共通処理をletによる関数定義にすべきか、privateメソッドにすべきか、というところでした。 他のライブラリのコードを適当に眺めて見たんですが、どうもポリシーが読み取れなかった。

それはさておき、改めてコードを見てみると、サービス精神のかけらも無いインターフェースにひるみますねぇ。このモジュールを使ったプログラムが、list や retr メソッドのレスポンスを涙ぐましく処理している姿が目に浮かびます…　「一つメソッドを叩けば、各メッセージについてヘッダーの連想配列と本文のタプルをリストにして返してくれる」、そんなやさしいメソッドがあってしかるべきですが、力尽きてきたのでこの辺で…

あと、本当はOCamlのシグネチャという機能を活用して、モジュールに対するアクセスを制限しなきゃならないはず。recieve_responseとかの関数は、外から呼ばれるとまずいのですから。これも力尽きたのを理由に省略…

というわけで、いくつかの手抜きをやり過ごしつつ実際に動かしてみましょう。そもそもの目的が「Gmailにアクセス」だったのでそれをやってみます。

open Unix
open Ssl
open Pop3

type conn_info = {host:string; port:int; cafile:string}
type user_info = {user:string; password:string}

let ci = {host = "pop.gmail.com"; port = 995;
          cafile = "/usr/ports/security/ca-roots/files/ca-root.crt"}
let ui = {user = "hogehoge"; password = "hogepass"}

let ssl_conn info =
  Ssl.init () ;
  let hostent =
      try gethostbyname info.host with
      | Not_found -> failwith "gethostbyname" in
  let sockaddr = ADDR_INET((hostent.h_addr_list.(0)), info.port) in
  let ctx = Ssl.create_context Ssl.SSLv23 Ssl.Client_context in
  Ssl.load_verify_locations ctx info.cafile "";
  let ssl = Ssl.open_connection_with_context ctx sockaddr in
  Ssl.verify ssl;
  ssl

let main () =
  let ssl = ssl_conn ci in
  let p = print_endline in
  let p_hr () = print_endline "--------------------------" in

  p "connecting...";
  p_hr ();

  let pop3 = new pop3_client ~infun:(Ssl.read ssl) ~outfun:(Ssl.write ssl) in
  pop3#auth ~user:(ui.user) ~pass:(ui.password);

  p "mail list";
  p_hr ();
  p (String.concat "\n" (pop3#list ()));
  p_hr ();

  let rec loop () =
    p "please enter msgno > ";
    try
      let msgno = read_int () in
      p_hr ();
      p (String.concat "\n" (pop3#retr ~msgno:msgno));
      p_hr ();
      loop ()
    with _ -> () in
  loop ();

  pop3#rset ();
  pop3#quit ();
  Ssl.shutdown_connection ssl
;;

let () = main ()

SSL接続のところは以前のコードの流用です。で、取得した接続を、Ssl.read/writeに部分適用して入出力用の関数を作成し、pop3_clientに渡してあげています。これを以下のようにコンパイルしてみます。

ocamlbuild -ocamlc 'ocamlfind c -package str,ssl -linkpkg' mailan.byte

そして、おもむろに./mailan.byteと叩いてみると…

mitsu@garlic$ ./mailan.byte
connecting...
--------------------------
mail list
--------------------------
1 messages (1633 bytes)
1 1633
--------------------------
please enter msgno >
1
--------------------------
message follows
Delivered-To: hogehoge@gmail.com
Received: by 10.20.30.40 with SMTP id 28314098way;
        Mon, 2 Jun 2008 07:30:29 -0700 (PDT)
From: hogehoge@hotmail.com
To: hogehoge@gmail.com
Subject: test mail
Date: Mon, 2 Jun 2008 14:29:12 +0000
Content-Type: text/plain; charset="iso-2022-jp"
MIME-Version: 1.0
X-OriginalArrivalTime: 02 Jun 2008 14:29:13.0438 (UTC) FILETIME=[078997E0:01C8C4BD]

hello, world

_________________________________________________________________
Live Search CO?^8!:w$GEl5~$NET?4It$,3DI=<($K!*%I%3$r$_$F$_$k!)
http://maps.live.com/
--------------------------
please enter msgno >
q
mitsu@garlic$

一応、成功です（出力内容は一部編集してます）。

メッセージの一覧が表示され、その後メッセージ番号を入力すると、当該メールのヘッダと本文が表示されました（LISTとRETRコマンドのレスポンスを表示しているだけとも言う…）。

メールに付与している広告文が文字化けしていますが、iso-2022-jp⇒UTF-8（私の開発環境）の文字コード変換が必要っぽいです。OCamlでは、camomileというライブラリをつかうのが定番のようですが、それはまた別の話…

補足：　コード中に "rn" とか "n" といった文字列がありますが、CR-LF等です。エスケープシーケンスが消えちゃっているようです。