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))