Date: Sat, 07 Mar 1998 12:32:53 +0100
From: Christophe Raffalli <raffalli@univ-savoie.fr>
To: caml-list@inria.fr
Subject: POP3 to mailbox in caml
This is a multi-part message in MIME format.
--------------17207467FD095AE479B6DBC
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: quoted-printable
Hello,
Here is an example of a small programme that retrive your mail from a
POP3 server to add then in a standard unix mailbox file. I think it is
an intersting exemple, and it even may be usefull in some situation !
Although it works for me, it may have bugs ... use it at your own risk !
To compile the program, just type
ocamlc -o popget -custom unix.cma popget.ml -cclib -lunix
To use it type
popget server_name [-d] [-p port_number] [-l userid] [-P password] [-m
mailbox] [-b] [-s sec]
where
server_name : is the name of the pop3 server
-d : means delete message from serve (default is none)
-p port: specify the pop3 port (default 110)
-l userid: specify the pop3 user name (default $USER)
-P passwd: specify the pop3 passwd (default "")
-m mailbox: specify the unix mailbox (default /var/spool/mail/$USER)
-b : run in background and check mail periodicaly (default false)
-s time : when -b is given: the number of seconds between chack
(default 300)
-- =
Christophe Raffalli
Laboratoire de Mathématique / LAMA
Université de Savoie
UFR SFA, Campus Scientifique
73376, Le Bourget du Lac CEDEX, FRANCE.
URL: http://www.logique.jussieu.fr/www.raffalli
email: Christophe.Raffalli@univ-savoie.fr
--------------17207467FD095AE479B6DBC
Content-Type: text/plain; charset=us-ascii; name="popget.ml"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="popget.ml"
open Unix
(*
ocamlc -o popget-custom unix.cma popget.ml -cclib -lunix
*)
let usage () =
prerr_string Sys.argv.(0);
prerr_string " server_name [-d] [-p port_number] [-l userid] [-P password] [-m mailbox]";
prerr_newline();
exit 1
let bug str =
prerr_string Sys.argv.(0);
prerr_string ": bug: ";
prerr_endline str;
exit 1
let error str =
prerr_string Sys.argv.(0);
prerr_string ": error: ";
prerr_endline str;
usage ()
let establish_connection name port =
try
let address =
let host = gethostbyname name in
ADDR_INET (host.h_addr_list.(0), port)
in
let a_socket = socket PF_INET SOCK_STREAM 0 in
connect a_socket address;
a_socket
with
Unix_error(errno,fun_name,par) ->
error (fun_name^": "^(error_message errno))
| Not_found ->
error ("can not connect to POP3 server \""^name^"\"")
let server_name, mailbox_name, user_name, passwd, port, delete, verbose,
background, sleep_time =
let i = ref 1 in
let port = ref 110 in
let delete = ref false in
let mailbox_name = ref
(try Filename.concat (Sys.getenv "HOME") "Inbox"
with Not_found -> "Inbox")
in
let user_name = ref
(try Sys.getenv "USER"
with Not_found -> "anonymous")
in
let passwd = ref "" in
let server_name = ref "mail" in
let verbose = ref false in
let background = ref false in
let sleep_time = ref 300 in
let l = Array.length Sys.argv in
while (!i < l) do
match Sys.argv.(!i) with
"-p" ->
incr i;
if (!i >= l) then usage ();
(try port := int_of_string Sys.argv.(!i)
with Failure _ -> usage ());
incr i
| "-l" ->
incr i;
if (!i >= l) then usage ();
user_name := Sys.argv.(!i);
incr i
| "-m" ->
incr i;
if (!i >= l) then usage ();
mailbox_name := Sys.argv.(!i);
incr i
| "-P" ->
incr i;
if (!i >= l) then usage ();
passwd := Sys.argv.(!i);
incr i
| "-d" ->
incr i;
delete := true
| "-v" ->
incr i;
verbose := true
| "-b" ->
incr i;
background := true
| "-s" ->
incr i;
if (!i >= l) then usage ();
(try sleep_time := int_of_string Sys.argv.(!i)
with Failure _ -> usage ());
incr i
| name ->
incr i;
server_name := name
done;
!server_name, !mailbox_name, !user_name, !passwd, !port, !delete, !verbose,
!background, !sleep_time
open Genlex
let lexer = make_lexer []
let tokens str = lexer (Stream.of_string str)
let days = [|"Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat"|]
let months = [|"Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun";
"Jul"; "Aug"; "Sep"; "Oct"; "Nov"; "Dec"|]
let go () =
let channel = establish_connection server_name port in
let out_ch = out_channel_of_descr channel in
let in_ch = in_channel_of_descr channel in
let get_line () =
let line = input_line in_ch in
let len = String.length line in
if line.[len-1] <> '\r' then bug "badly terminated line";
let line = String.sub line 0 (len-1) in
if verbose then (print_string line; print_newline ());
line
in
let compare_line str =
let line = get_line () in
if String.length line < String.length str
or String.sub line 0 (String.length str) <> str then
error ("expected \""^str^"\", got \""^line)
else line
in
let send str =
output_string out_ch str;
output_char out_ch '\n';
flush out_ch
in
compare_line "+OK POP3";
send ("USER "^user_name);
compare_line "+OK";
send ("PASS "^passwd);
compare_line "+OK";
send "STAT";
let num = match tokens (compare_line "+OK") with parser
[<'Ident "+"; 'Ident "OK"; 'Int num; 'Int size >] ->
Printf.printf "%d new messages (%d octets)\n" num size;
num
| [< >] ->
bug "bad answer to STAT"
in
send "LIST";
compare_line "+OK";
let msgs = Array.create num 0 in
for i = 0 to num - 1 do
match tokens (get_line ()) with parser
[<'Int id; 'Int size >] ->
msgs.(i) <- id
| [< >] ->
bug "illegal line in LIST command."
done;
compare_line ".";
let mailbox =
try
open_out_gen [Open_binary; Open_wronly; Open_append; Open_creat]
0o600 mailbox_name
with
Sys_error errmsg ->
error (mailbox_name^" could not be opened: "^errmsg)
in
for i = 0 to num - 1 do
Printf.printf "getting message %d\n" msgs.(i);
send ("RETR "^string_of_int msgs.(i));
compare_line "+OK";
let tm = localtime (time ()) in
sleep 1;
Printf.fprintf mailbox "From - %s %s %d %2d:%2d:%2d %d\n"
days.(tm.tm_wday) months.(tm.tm_mon)
tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec tm.tm_year;
let cont = ref true in
while !cont do
let line = get_line () in
if line = "." then
cont := false
else begin
output_string mailbox line;
output_string mailbox "\n"
end
done;
output_string mailbox "\n\n"
done;
close_out mailbox;
if delete then begin
for i = 0 to num - 1 do
Printf.printf "deleting message %d\n" msgs.(i);
send ("DELE "^string_of_int msgs.(i));
compare_line "+OK"
done
end;
send "QUIT";
try
compare_line "+OK"; ()
with End_of_file ->
send "QUIT";
try
compare_line "+OK"; ()
with End_of_file -> ()
let _ =
if background then
while true do
go ();
sleep sleep_time
done
else go ()
--------------17207467FD095AE479B6DBC--
This archive was generated by hypermail 2b29 : Sun Jan 02 2000 - 11:58:13 MET