#load "unix.cma";; let () = try let addresses = Unix.gethostbyname name in let addresses = Array.map Unix.string_of_inet_addr addresses.Unix.h_addr_list in (* addresses is an array of IP addresses *) Array.iter print_endline addresses with Not_found -> Printf.printf "Can't resolve %s\n" name (*-----------------------------*) let () = try let host = Unix.gethostbyaddr (Unix.inet_addr_of_string address) in let name = host.Unix.h_name in (* name is the hostname ("www.perl.com") *) print_endline name with Not_found -> Printf.printf "Can't resolve %s\n" address (*-----------------------------*) let () = try let host = Unix.gethostbyaddr (Unix.inet_addr_of_string address) in let name = host.Unix.h_name in try let addresses = Unix.gethostbyname name in let addresses = Array.map Unix.string_of_inet_addr addresses.Unix.h_addr_list in Array.iter print_endline addresses; let found = List.mem address (Array.to_list addresses) in print_endline (if found then "found" else "not found") with Not_found -> Printf.printf "Can't look up %s\n" name with Not_found -> Printf.printf "Can't look up %s\n" address (*-----------------------------*) #!/usr/bin/ocaml (* mxhost - find mx exchangers for a host *) (* Though there is an experimental new DNS resolver for OCaml called Netdns, it does not yet support resolving MX records. For now, we'll use Net::DNS through perl4caml until a better solution is available. *) #directory "+perl";; #load "perl4caml.cma";; let _ = Perl.eval "use Net::DNS" let host = Sys.argv.(1) let res = Perl.call_class_method "Net::DNS::Resolver" "new" [] let mx = Perl.call_array ~fn:"mx" [res; Perl.sv_of_string host] let () = if mx = [] then Printf.eprintf "Can't find MX records for %s (%s)\n" host (Perl.string_of_sv (Perl.call_method res "errorstring" [])) let () = List.iter (fun record -> let preference = Perl.call_method record "preference" [] in let exchange = Perl.call_method record "exchange" [] in Printf.printf "%s %s\n" (Perl.string_of_sv preference) (Perl.string_of_sv exchange)) mx (*-----------------------------*) #!/usr/bin/ocaml (* hostaddrs - canonize name and show addresses *) #load "unix.cma";; let name = Sys.argv.(1) let hent = Unix.gethostbyname name let () = Printf.printf "%s => %s\n" hent.Unix.h_name (* in case different *) (String.concat " " (Array.to_list (Array.map Unix.string_of_inet_addr hent.Unix.h_addr_list))) |
(* The Netclient package from Ocamlnet provides an event-driven FTP client. This client does not currently support uploading. Ocamlnet is available here: http://projects.camlcity.org/projects/ocamlnet.html This recipe assumes it has been installed with findlib. *) #use "topfind";; #require "netclient";; (* Create an FTP client instance. *) let ftp = new Ftp_client.ftp_client () (* Build and execute a chain of FTP methods. *) let () = ftp#add (new Ftp_client.connect_method ~host:"127.0.0.1" ()); ftp#add (new Ftp_client.login_method ~user:"anonymous" ~get_password:(fun () -> "user@example.com") ~get_account:(fun () -> "anonymous") ()); ftp#add (new Ftp_client.walk_method (`Dir "/pub")); let ch = new Netchannels.output_channel (open_out "output.txt") in ftp#add (new Ftp_client.get_method ~file:(`Verbatim "index.txt") ~representation:`Image ~store:(fun _ -> `File_structure ch) ()); ftp#run () (*-----------------------------*) (* If an error occurs, it will be exposed by the "state" property. *) let () = match ftp#state with | `Error (Ftp_client.FTP_error (Unix.Unix_error (e, _, _))) -> Printf.eprintf "Error: %s\n%!" (Unix.error_message e) | _ -> () (*-----------------------------*) (* To determine the current working directory, send invoke the `PWD command and inspect the result in a callback. *) let () = ftp#add (new Ftp_client.invoke_method ~command:`PWD ~process_result:(fun state (code, message) -> Printf.printf "I'm in the directory %s\n%!" message) ()) (*-----------------------------*) (* Use mkdir_method and rmdir_method to make and remove directories from the remote server. Use the optional ~onerror argument to specify an error handler. *) let () = ftp#add ~onerror:(fun e -> Printf.eprintf "Can't create /ocaml: %s\n%!" (Printexc.to_string e)) (new Ftp_client.mkdir_method (`Verbatim "/pub/ocaml")) (*-----------------------------*) (* Use a list_method to get a list of files in a remote directory. *) let () = let buffer = Buffer.create 256 in let ch = new Netchannels.output_buffer buffer in ftp#add ~onsuccess:(fun () -> print_endline (Buffer.contents buffer)) ~onerror:(fun e -> Printf.eprintf "Can't get a list of files in /pub: %s\n%!" (Printexc.to_string e)) (new Ftp_client.list_method ~dir:(`Verbatim "/pub") ~representation:`Image ~store:(fun _ -> `File_structure ch) ()) (*-----------------------------*) (* Use `QUIT followed by ftp#abort to close the connection and exit the event loop. *) let () = ftp#add (new Ftp_client.invoke_method ~command:`QUIT ~process_result:(fun _ _ -> ftp#abort ()) ()) |
(* Use Netsendmail, part of the Netstring package that comes with Ocamlnet, to send mail through a command-line mailer program. *) #use "topfind";; #require "netstring";; let () = Netsendmail.sendmail ~mailer:"/usr/sbin/sendmail" (* defaults to "/usr/lib/sendmail" *) (Netsendmail.compose ~from_addr:(from_name, from_address) ~to_addrs:[(to_name, to_address)] ~subject:subject body) (*-----------------------------*) (* You can also open a pipe directly to sendmail. *) #load "unix.cma";; let () = let sendmail = Unix.open_process_out "/usr/lib/sendmail -oi -t -odq" in output_string sendmail "\ From: User Originating Mail <me@host> To: Final Destination <you@otherhost> Subject: A relevant subject line Body of the message goes here, in as many lines as you like. "; ignore (Unix.close_process_out sendmail) |
(* There is no NNTP library available for OCaml. With a little preparation, we can easily use the one that comes with Perl using perl4caml (http://merjis.com/developers/perl4caml) *) #directory "+perl";; #load "perl4caml.cma";; module NNTP = struct open Perl let _ = eval "use Net::NNTP" (* Returned by "list" method so that newsgroups stay sorted. *) module GroupMap = Map.Make(String) (* Wrapper for Net::NNTP class. *) class nntp host = let nntp = call_class_method "Net::NNTP" "new" [sv_of_string host] in (* Raise a Failure exception if we couldn't connect. *) let () = if sv_is_undef nntp then failwith (string_of_sv (eval "$!")) in (* Helper function to transform nullable string arrays to OCaml. *) let maybe_string_list sv = if sv_is_undef sv then raise Not_found else List.map string_of_sv (list_of_av (deref_array sv)) in object (self) val nntp = nntp method group name = match call_method_array nntp "group" [sv_of_string name] with | [narticles; first; last; name] -> (int_of_sv narticles, int_of_sv first, int_of_sv last, string_of_sv name) | _ -> raise Not_found method head msgid = maybe_string_list (call_method nntp "head" [sv_of_int msgid]) method body msgid = maybe_string_list (call_method nntp "body" [sv_of_int msgid]) method article msgid = maybe_string_list (call_method nntp "article" [sv_of_int msgid]) method postok () = bool_of_sv (call_method nntp "postok" []) method post lines = let lines = List.map sv_of_string lines in if (sv_is_undef (call_method nntp "post" lines)) then failwith (string_of_sv (eval "$!")) method list () = let hv = deref_hash (call_method nntp "list" []) in let map = ref GroupMap.empty in List.iter (fun (name, info) -> map := GroupMap.add name (match list_of_av (deref_array info) with | [last; first; flags] -> (int_of_sv last, int_of_sv first, string_of_sv flags) | _ -> assert false) !map) (assoc_of_hv hv); !map method quit () = ignore (call_method nntp "quit" []) end end (*-----------------------------*) (* Connect to an NNTP server by creating an "nntp" object. *) let server = try new NNTP.nntp "news.west.cox.net" with Failure s -> Printf.eprintf "Can't connect to news server: %s\n" s; exit 1 (*-----------------------------*) (* Select a newsgroup and retrieve its stats. *) let (narticles, first, last, name) = try server#group "misc.test" with Not_found -> Printf.eprintf "Can't select misc.test\n"; exit 1 (*-----------------------------*) (* Get the headers from the last article. *) let headers = try server#head last with Not_found -> Printf.eprintf "Can't get headers from article %d in %s\n" last name; exit 1 (*-----------------------------*) (* Get the body from the last article. *) let body = try server#head last with Not_found -> Printf.eprintf "Can't get body from article %d in %s\n" last name; exit 1 (*-----------------------------*) (* Get the headers and body from the last article. *) let article = try server#head last with Not_found -> Printf.eprintf "Can't get article from article %d in %s\n" last name; exit 1 (*-----------------------------*) (* Determine if posting is allowed with this server. *) let () = if not (server#postok ()) then Printf.eprintf "Server didn't tell me I could post.\n" (*-----------------------------*) (* Post a message. *) let () = begin try server#post lines with Failure s -> Printf.eprintf "Can't post: %s\n" s; exit 1 end (*-----------------------------*) (* Get the complete list of newsgroups. *) let () = let groupmap = server#list () in NNTP.GroupMap.iter (fun group (last, first, flags) -> if flags = "y" then (* I can post to [group] *) ()) groupmap |
(* Use Netpop, which is part of Ocamlnet. *) #use "topfind";; #require "pop";; (* To create a Netpop client, you need to look up the server address and build a network connection first. Netpop uses wrappers called Netchannels to abstract the input and output channels. *) let inet_addr = (Unix.gethostbyname mail_server).Unix.h_addr_list.(0) let addr = Unix.ADDR_INET (inet_addr, Netpop.tcp_port) let ic, oc = Unix.open_connection addr let pop = new Netpop.client (new Netchannels.input_channel ic) (new Netchannels.output_channel oc) let () = pop#user username; pop#pass password (* Messages are retreived as a hashtable from message IDs to tuples, each tuple containing the message size in bytes and a string of server-specific extension data. *) let messages = pop#list () let () = Hashtbl.iter (fun msgid (size, ext) -> let message = pop#retr msgid in (* message is a Netchannels.in_obj_channel *) pop#dele msgid) messages (*-----------------------------*) (* Use pop#apop instead of pop#user/pop#pass to avoid sending passwords in plaintext across the network. *) let () = pop#apop username password (*-----------------------------*) (* Get a message by number and print it to the console. *) let () = Printf.printf "Retrieving %d : %!" msgnum; try let message = pop#retr msgnum in print_newline (); print_endline (Netchannels.string_of_in_obj_channel message) with Netpop.Err_status e -> Printf.printf "failed (%s)\n%!" e (*-----------------------------*) (* Gracefully tear down the connection. *) let () = pop#quit (); Unix.shutdown_connection ic; close_out oc |
(* To simulate a Telnet client with OCaml, you can use the Telnet_client module from Ocamlnet's "netclient" package. This module is written in an asynchronous style, so you will need to create event handlers to process the Telnet events that occur: data, end of file, timeout, and the sending and receiving of options (also known as "do", "don't", "will", and "won't". *) #use "topfind";; #require "netclient";; open Telnet_client (* This class wraps the Telnet session for convenience in defining event handlers and chaining them together. *) class session ~host ~port ~username ~password ~prompt ~timeout = object (self) (* Telnet_client.telnet_session instance to wrap. *) val telnet = new telnet_session (* Initial on-data handler, which will be redefined later. *) val mutable process = fun _ -> () (* Initialize the Telnet session. *) initializer telnet#set_connection (Telnet_connect (host, port)); telnet#set_options {connection_timeout=timeout; verbose_connection=false; verbose_input=false; verbose_output=false}; telnet#set_callback self#on_input; telnet#set_exception_handler self#on_exception; telnet#attach (); process <- self#start (* Build an input callback that checks for a regular expression match in the input and calls a callback function if the match is positive. *) method waitfor pat cb = let rex = Pcre.regexp pat in fun data -> if Pcre.pmatch ~rex data then cb data (* Enqueue a line of data and flush the output queue. *) method write data = Queue.add (Telnet_data data) telnet#output_queue; Queue.add (Telnet_data "\n") telnet#output_queue; telnet#update () (* Handle first input: wait for a login prompt and then invoke self#send_username to send the username. *) method start = self#waitfor "ogin:" self#send_username (* Send the username and wait for the password prompt. *) method send_username data = self#write username; process <- self#waitfor "assword:" self#send_password (* Send the password and wait to see if we succeeded. *) method send_password data = self#write password; process <- self#verify_login (* Determine if the login was a success or a failure. Abort with an exception on failure; call self#logged_in on success. *) method verify_login data = if Pcre.pmatch ~pat:"incorrect" data then failwith "Login failed" else if Pcre.pmatch ~pat:"^\\s*$" data then () (* ignore blank lines *) else self#logged_in data (* Logged in successfully. Wait for a prompt if necessary and call self#run_ls to send the first command. *) method logged_in data = process <- self#waitfor prompt self#run_ls; self#waitfor prompt self#run_ls data (* Do a directory listing and wait for results. *) method run_ls data = self#write "/bin/ls -1"; process <- self#gather_files (* This variable will buffer the results of the "ls" command. *) val mutable files = "" (* Buffer the filenames printed out from the "ls" command and print them out once we get a prompt. *) method gather_files data = if Pcre.pmatch ~pat:prompt data then begin files <- Pcre.replace ~pat:"^/bin/ls -1\\s*" files; Printf.printf "Files: %s\n%!" (String.concat ", " (Pcre.split ~pat:"\\s+" files)); self#run_top data end else files <- files ^ data (* Run another command until we get a prompt and then call self#close to close the connection. *) method run_top data = self#write "top -n1 -b"; process <- self#waitfor prompt self#close (* Close the connection by sending an EOF. *) method close data = Queue.add Telnet_eof telnet#output_queue (* When we receive an EOF, exit the program. *) method on_eof () = prerr_endline "EOF"; exit 0 (* If a timeout event is received, exit with an error code. *) method on_timeout () = prerr_endline "Timeout"; exit 1 (* Print any thrown exceptions to standard error. *) method on_exception exn = prerr_endline (Printexc.to_string exn) (* This is the main error handler, which dispatches on Telnet_client events. *) method on_input got_synch = while not (Queue.is_empty telnet#input_queue) do let tc = Queue.take telnet#input_queue in match tc with | Telnet_data data -> process data | Telnet_eof -> self#on_eof () | Telnet_timeout -> self#on_timeout () | Telnet_will _ | Telnet_wont _ | Telnet_do _ | Telnet_dont _ -> (* The telnet_session handles these events. Calling this method is necessary. *) telnet#process_option_command tc | _ -> () done (* Run the Telnet session by calling the "run" method on the underling telnet_session instance. *) method run = telnet#run end (* Create an instance of our custom session class. *) let session = new session ~host:"localhost" ~port:23 ~username:"test" ~password:"pleac" ~prompt:"\\$ $" ~timeout:10. (* Start the session. *) let () = session#run () |
#!/usr/bin/ocaml (* ping - send and receive ICMP echo packets *) (* There do not appear to be any libraries available for pinging servers from OCaml, ICMP or otherwise. In this recipe, we will make a diversion from the Perl recipe, which simply determines if a host is up, and instead write a lookalike for the "ping" shell command. We might as well, if we're going to all the trouble of building ICMP packets directly. *) (* Import Unix and enable threads using findlib for convenience. *) #use "topfind";; #require "unix";; #thread;; (* The Packet module defines a data type and operations for building, parsing, and checking the integrity of ICMP packets. *) module Packet = struct exception Invalid_length of int exception Invalid_checksum of int * int (* type' and code define the ICMP message type. An echo message has type'=8, code=0, and an echo reply has type'=0, code=0. The id is a unique identifier for the current process to help distinguish between replies for other processes. seq is the sequence number, which is usually incremented with each message. data is the message body whose contents depend on the type of message. *) type t = { type' : int; code : int; id : int; seq : int; data : string } (* Define a convenience function for constructing packets. *) let make ?(type'=8) ?(code=0) ~id ~seq data = {type'=type'; code=code; id=id; seq=seq; data=data} (* Calculate a checksum for a message by adding its contents, two bytes at a time, folding the high order bits into the low order bits, and taking the logical complement. The result will be an int with 16-bit precision. *) let checksum s = let num_bytes = String.length s in let num_shorts = num_bytes / 2 in let rec sum_shorts i sum = if i < num_shorts then let short = Int32.of_int (int_of_char s.[i * 2] lsl 8 + int_of_char s.[i * 2 + 1]) in sum_shorts (i + 1) (Int32.add sum short) else sum in let sum = sum_shorts 0 0l in let sum = if num_bytes mod 2 = 1 then Int32.add sum (Int32.of_int (int_of_char s.[num_bytes - 1] lsl 8)) else sum in let sum = Int32.add (Int32.shift_right sum 16) (Int32.logand sum 0xffffl) in Int32.to_int (Int32.logand (Int32.lognot (Int32.add (Int32.shift_right sum 16) sum)) 0xffffl) (* Convert a packet to a string that can be sent over a socket. *) let to_string {type'=type'; code=code; id=id; seq=seq; data=data} = let b = Buffer.create 20 in Buffer.add_char b (char_of_int type'); Buffer.add_char b (char_of_int code); Buffer.add_char b '\000'; (* checksum hi *) Buffer.add_char b '\000'; (* checksum lo *) Buffer.add_char b (char_of_int (id lsr 8 land 0xff)); Buffer.add_char b (char_of_int (id land 0xff)); Buffer.add_char b (char_of_int (seq lsr 8 land 0xff)); Buffer.add_char b (char_of_int (seq land 0xff)); Buffer.add_string b data; let packet = Buffer.contents b in let sum = checksum packet in packet.[2] <- char_of_int (sum lsr 8 land 0xff); packet.[3] <- char_of_int (sum land 0xff); packet (* Parse a string into a packet structure. If the string is less than 8 bytes long, an Invalid_length exception will be raised. If the checksum does not match the contents, an Invalid_checksum exception will be raised. *) let of_string s = if String.length s < 8 then raise (Invalid_length (String.length s)); let s' = String.copy s in s'.[2] <- '\000'; s'.[3] <- '\000'; let sum = int_of_char s.[2] lsl 8 + int_of_char s.[3] in let sum' = checksum s' in if sum <> sum' then raise (Invalid_checksum (sum, sum')); {type'=int_of_char s.[0]; code=int_of_char s.[1]; id=int_of_char s.[4] lsl 8 + int_of_char s.[5]; seq=int_of_char s.[6] lsl 8 + int_of_char s.[7]; data=String.sub s 8 (String.length s - 8)} end (* Define a data structure for the message body of our echo requests. *) type payload = { timestamp : float; data : string } (* Send a single ICMP echo request to the given socket and address. *) let ping socket sockaddr id seq = let payload = Marshal.to_string {timestamp=Unix.gettimeofday (); data="abcdefghijklmnopqrstuvwxyz0123456"} [] in let message = Packet.to_string (Packet.make ~id ~seq payload) in ignore (Unix.sendto socket message 0 (String.length message) [] sockaddr) (* Loop forever waiting for echo replies, printing them to the console along with their hostname, IP, and round-trip time. *) let pong socket id = let buffer = String.make 256 '\000' in while true do let length, sockaddr = Unix.recvfrom socket buffer 0 (String.length buffer) [] in let response = Packet.of_string (String.sub buffer 20 (length - 20)) in match sockaddr, response with | Unix.ADDR_INET (addr, port), {Packet.type'=0; code=0; id=id'; seq=seq; data=data} when id = id' -> let host_entry = Unix.gethostbyaddr addr in let payload = Marshal.from_string data 0 in Printf.printf "%d bytes from %s (%s): icmp_seq=%d time=%.3f ms\n%!" (String.length data) host_entry.Unix.h_name (Unix.string_of_inet_addr addr) seq ((Unix.gettimeofday () -. payload.timestamp) *. 1000.) | _ -> () done (* Read hostname from command line. *) let host = if Array.length Sys.argv <> 2 then (Printf.eprintf "Usage: %s host\n" Sys.argv.(0); exit 1) else Sys.argv.(1) (* Use DNS to find the IP address and canonical name. *) let name, addr = try let h = Unix.gethostbyname host in h.Unix.h_name, h.Unix.h_addr_list.(0) with Not_found -> Printf.eprintf "%s: unknown host %s\n" Sys.argv.(0) host; exit 2 (* Make sure we are running as root, since this is required to open a socket with SOCK_RAW and send ICMP packets. *) let () = if Unix.getuid () <> 0 then (Printf.eprintf "%s: icmp ping requires root privilege\n" Sys.argv.(0); exit 3) (* Start the ping loop. *) let () = Printf.printf "PING %s (%s)\n" name (Unix.string_of_inet_addr addr); (* Build a socket and destination address. *) let proto = (Unix.getprotobyname "icmp").Unix.p_proto in let socket = Unix.socket Unix.PF_INET Unix.SOCK_RAW proto in let sockaddr = Unix.ADDR_INET (addr, 0) in (* Use the PID as the ID for packets, and create a counter for the sequence number. *) let id = Unix.getpid () in let seq = ref 0 in (* Start a background thread to print the echo replies. *) ignore (Thread.create (pong socket) id); (* Loop forever sending echo requests and sleeping. *) while true do incr seq; ping socket sockaddr id !seq; Unix.sleep 1 done |
(* WHOIS servers depend on the TLD, and their output formats are informal, inconsistent, and completely different from server to server. This makes a general solution very large and ad-hoc. The Net::Whois package, on which the original Perl recipe was based, no longer works since WHOIS servers started redirecting to other servers for most of the information. Since no libraries are available for this task, we will do a WHOIS lookup manually using sockets. This example shows how to perform a WHOIS lookup for the "sourceforge.net" domain, and probably will not work without modification for domains under any other TLD. *) #load "unix.cma";; #load "str.cma";; let domain_name = "sourceforge.net" let whois_server = "whois.internic.net" let service = Unix.getservbyname "whois" "tcp" let ltrim = let re = Str.regexp "^[ \r\n\t\x00\x0B]*" in Str.global_replace re "" let () = (* Connect to the parent server to find the redirect. *) let host = Unix.gethostbyname whois_server in let socket_in, socket_out = Unix.open_connection (Unix.ADDR_INET (host.Unix.h_addr_list.(0), service.Unix.s_port)) in output_string socket_out domain_name; output_string socket_out "\n"; flush socket_out; let whois_redirect_regexp = Str.regexp "Whois Server: \\(.*\\)" in let whois_redirect = ref "" in begin try while true do let line = ltrim (input_line socket_in) in if Str.string_match whois_redirect_regexp line 0 then whois_redirect := Str.matched_group 1 line done with End_of_file -> Unix.shutdown_connection socket_in end; if !whois_redirect = "" then failwith "Couldn't find WHOIS redirect"; (* Connect to the real server and get the WHOIS data. *) let host = Unix.gethostbyname !whois_redirect in let socket_in, socket_out = Unix.open_connection (Unix.ADDR_INET (host.Unix.h_addr_list.(0), service.Unix.s_port)) in output_string socket_out domain_name; output_string socket_out "\n"; flush socket_out; let domain_name_regexp = Str.regexp "Domain name: \\(.*\\)" in let domain_name = ref "" in let registrant_regexp = Str.regexp "Registrant:" in let registrant_name = ref "" in let registrant_address = ref [] in let registrant_country = ref "" in let contact_regexp = Str.regexp "\\(.*\\) Contact:" in let contacts = ref [] in begin try while true do let line = ltrim (input_line socket_in) in if Str.string_match domain_name_regexp line 0 then domain_name := Str.matched_group 1 line else if Str.string_match registrant_regexp line 0 then begin (* Read registrant data. *) registrant_name := ltrim (input_line socket_in); let finished = ref false in while not !finished do let line = ltrim (input_line socket_in) in if String.length line > 2 then registrant_address := !registrant_address @ [line] else if String.length line = 2 then registrant_country := line else finished := true done end else if Str.string_match contact_regexp line 0 then begin (* Read contact data. *) let contact_type = Str.matched_group 1 line in let contact_info = ref [] in for i = 1 to 6 do let line = ltrim (input_line socket_in) in contact_info := !contact_info @ [line] done; contacts := (contact_type, !contact_info) :: !contacts end done with End_of_file -> Unix.shutdown_connection socket_in end; (* Display the results. *) Printf.printf "The domain is called %s\n" !domain_name; Printf.printf "Mail for %s should be sent to:\n" !registrant_name; List.iter (Printf.printf "\t%s\n") !registrant_address; Printf.printf "\t%s\n" !registrant_country; if !contacts = [] then Printf.printf "No contact information.\n" else begin Printf.printf "Contacts:\n"; List.iter (fun (contact_type, contact_info) -> Printf.printf " %s\n" contact_type; List.iter (Printf.printf " %s\n") contact_info) !contacts end |
#!/usr/bin/ocaml (* expn -- convince smtp to divulge an alias expansion *) #use "topfind";; (* Findlib *) #require "str";; (* Stdlib *) #require "unix";; (* Stdlib *) #require "perl";; (* Perl4caml *) #require "smtp";; (* Ocamlnet *) let _ = Perl.eval "use Net::DNS" (* Net::DNS *) let selfname = Unix.gethostname () let () = if Array.length Sys.argv < 2 then (Printf.eprintf "usage: %s address@host ...\n" Sys.argv.(0); exit 1) let () = List.iter (fun combo -> let name, host = match Str.bounded_split (Str.regexp "@") combo 2 with | [] -> "", "" | [name] -> name, "localhost" | [name; host] -> name, host | _ -> assert false in let hosts = Perl.call_array ~fn:"mx" [Perl.sv_of_string host] in let hosts = List.map (fun mx -> Perl.call_method mx "exchange" []) hosts in let hosts = if hosts = [] then [Perl.sv_of_string host] else hosts in List.iter (fun host -> let host = Perl.string_of_sv host in Printf.printf "Expanding %s at %s (%s): %!" name host combo; let inet_addr = (Unix.gethostbyname host).Unix.h_addr_list.(0) in let addr = Unix.ADDR_INET (inet_addr, Netsmtp.tcp_port) in try let ic, oc = Unix.open_connection addr in let smtp = new Netsmtp.client (new Netchannels.input_channel ic) (new Netchannels.output_channel oc) in ignore (smtp#helo ~host:selfname ()); print_endline (match smtp#expn name with | None -> "None" | Some results -> String.concat ", " results); smtp#quit (); Unix.shutdown_connection ic; close_out oc with Unix.Unix_error (Unix.ECONNREFUSED, _, _) -> Printf.eprintf "cannot connect to %s\n" host) hosts) (List.tl (Array.to_list Sys.argv)) |