struct
  let _ = Random.self_init ()

  type mail = {
      mail_to : string list;
      mail_cc : string list ;
      mail_from : string;
      mail_subject : string;
      mail_body : string;
    }

  let simple_connect hostname port =
    let s = socket PF_INET SOCK_STREAM 0 in
    let h = Unix.gethostbyname hostname in
    let addr = h.h_addr_list.(0) in
    try
      Unix.connect s (ADDR_INET(addr,port));
      s
    with e -> close s; raise e

  let last_response = ref ""

  let bad_response () =
    failwith (Printf.sprintf "Bad response [%s]"
                (String.escaped !last_response))

  let read_response ic =
    last_response := input_line ic;
    if String.length !last_response > 3 then
      int_of_string (String.sub !last_response 0 3)
    else
      bad_response ()

  let escape_single_dot_on_line s =
    let len = String.length s in
    let b = Buffer.create len in
    let state = ref 1 in
  (* state = 1: beginning of line;
     state = 2: dot encountered at beginning of line;
     state = 0: safe line (encountered more than one character *)
    let a = Buffer.add_char b in
    for i = 0 to len - 1 do
      match s.[i] with
        '\n' | '\r' when !state = 0 -> state := 1; a s.[i]
      | '\n' | '\r' when !state = 1 -> state := 1; a s.[i]
      | '\n' | '\r' when !state = 2 -> a ' '; state := 1; a s.[i]
      | '.' when !state = 1 -> state := 2; a '.'
      | c -> state := 0; a c
    done;
    Buffer.contents b

  let make_mail mail =
    let mes_id =
      let t = Unix.localtime (Unix.time ()) in
      let n = Random.int 100000000 in
      Printf.sprintf "<%04d-%02d-%02d-%02d:%02d:%02d.%08d-share-library@ocaml.org>"
        (t.Unix.tm_year + 1900)
        (t.Unix.tm_mon + 1)
        t.Unix.tm_mday
        t.Unix.tm_hour
        t.Unix.tm_min
        t.Unix.tm_sec
        n
    in
    (mes_id,
     Printf.sprintf
       "Content-Type: text/plain; charset=iso-8859-1\r\nContent-Transfer-Encoding: 8bit\r\nFrom: %s\r\nTo: %s\r\n%sSubject: %s\r\nMIME-Version: 1.0\r\nMessage-ID: %s\r\n\r\n%s"
       mail.mail_from
       (String.concat "," mail.mail_to)
       (match mail.mail_cc with
         [] -> ""
       | l -> Printf.sprintf "Cc: %s\r\n" (String.concat "," l)
       )
       mail.mail_subject
       mes_id
       (escape_single_dot_on_line mail.mail_body)
    )

  let canon_addr s =
    let len = String.length s in
    let rec iter_end s pos =
      if pos = -1 then s else
      if s.[pos] = ' ' then iter_end s (pos-1) else
      iter_begin s (pos-1) pos

    and iter_begin s pos last =
      if pos = -1 || s.[pos] = ' ' then
        String.sub s (pos+1) (last - pos)
      else iter_begin s (pos-1) last

    in
    iter_end s (len - 1)

  let sendmail smtp_server smtp_port mail =
(* a completely synchronous function (BUG) *)
    try
      let s = simple_connect smtp_server smtp_port in
      let ic = in_channel_of_descr s in
      let oc = out_channel_of_descr s in

      try
        if read_response ic <> 220 then bad_response ();

        Printf.fprintf oc "HELO %s\r\n" (gethostname ()); flush oc;
      if read_response ic <> 250 then bad_response ();

        Printf.fprintf oc "MAIL FROM:%s\r\n" (canon_addr mail.mail_from);
        flush oc;
        if read_response ic <> 250 then bad_response ();

        List.iter
          (fun addr ->
            Printf.fprintf oc "RCPT TO:%s\r\n" (canon_addr addr); flush oc;
            if read_response ic <> 250 then bad_response ()
          )
          (mail.mail_to @ mail.mail_cc);

        Printf.fprintf oc "DATA\r\n"; flush oc;
        if read_response ic <> 354 then bad_response ();

        let (mes_id, body) = make_mail mail in
        Printf.fprintf oc "%s\r\n.\r\n" body; flush oc;
        if read_response ic <> 250 then bad_response ();

        Printf.fprintf oc "QUIT\r\n"; flush oc;
        if read_response ic <> 221 then bad_response ();

        close_out oc;
        mes_id
      with e ->
        Printf.fprintf oc "QUIT\r\n"; flush oc;
        if read_response ic <> 221 then bad_response ();
        close_out oc;
        raise e

    with e ->
      raise (Failure (Printexc.to_string e))
end