No output from non standard File Descriptor - unix

I am having issues receiving data from the child process.
To send a string to the child process you write to FD3 and it will output the result to FD4.
The child process runs fine, and if it couldn't write to FD4, the process would not start correctly, so FD4 has to be available but I just don't know why no output is given.
My initial thoughts is when sending the string (to FD3) it wasn't null byte terminating therefore not receiving the string correctly (and then not sending anything back on FD4) but I am sure I am doing it correctly.
I have tested writing to FD4 within the child process manually and the parent receives the output.
use nix::fcntl::FcntlArg::{F_SETFD};
use nix::fcntl::{fcntl, open, FdFlag, OFlag};
use nix::sys::socket::{socketpair, AddressFamily, SockFlag, SockType};
use nix::sys::stat::Mode;
use nix::unistd::{close, dup2, execvp, fork, pipe, read, write, ForkResult};
use std::ffi::CString;
use std::os::unix::io::RawFd;
use std::process::abort;
fn main() {
let input_socket: (RawFd, RawFd) = create_socket();
let output_socket: (RawFd, RawFd) = create_socket();
match fork() {
Ok(ForkResult::Parent { child, .. }) => {
println!("Child PID: {}", child);
close(input_socket.1).unwrap();
close(output_socket.1).unwrap();
let test = r#"{"id":0,"method":"Target.getTargets"}\0"#;
write(input_socket.0, test.as_bytes()).expect("unable to write");
let mut buf = [0; 64];
read(output_socket.0, &mut buf).unwrap();
println!("BUFFER: {:#?}", std::str::from_utf8(&buf).unwrap());
}
Ok(ForkResult::Child) => {
setup_child(input_socket.1, output_socket.1);
abort()
}
Err(err) => { println!("{}", err); abort()},
}
}
#[cfg(any(
target_os = "android",
target_os = "dragonfly",
target_os = "emscripten",
target_os = "freebsd",
target_os = "linux",
target_os = "netbsd",
target_os = "openbsd"
))]
fn create_socket() -> (RawFd, RawFd) {
socketpair(
AddressFamily::Unix,
SockType::Stream,
None,
SockFlag::SOCK_CLOEXEC,
)
.unwrap()
}
#[cfg(any(target_os = "ios", target_os = "macos"))]
fn create_socket() -> (RawFd, RawFd) {
let socket = socketpair(
AddressFamily::Unix,
SockType::Stream,
None,
SockFlag::empty(),
)
.unwrap();
fcntl(socket.0, F_SETFD(FdFlag::FD_CLOEXEC)).unwrap();
fcntl(socket.1, F_SETFD(FdFlag::FD_CLOEXEC)).unwrap();
socket
}
fn setup_child(input: RawFd, output: RawFd) {
let _input: RawFd = dup2(input, 3).unwrap();
let _output: RawFd = dup2(output, 4).unwrap();
let file = CString::new("/Applications/Google Chrome.app/Contents/MacOS/Google Chrome").unwrap();
let arg1 = CString::new("--remote-debugging-pipe").unwrap();
let arg2 = CString::new("--enable-logging=stderr").unwrap();
let args = vec![arg1.as_c_str(),arg2.as_c_str()];
let _res = execvp(&file, &args).unwrap();
}
This is the open FDs for the child process: lsof -p 14620
COMMAND PID USER FD TYPE DEVICE SIZE/OFF NODE NAME
Chrome 14620 tom 0 PIPE 0xcafab653bf79be56 16384 ->0xfc41206e43b6bb9d
Chrome 14620 tom 1 PIPE 0x71c3c6a8bffbf5ad 16384 ->0x587f975b5bfd4499
Chrome 14620 tom 2 PIPE 0x71c3c6a8bffbf5ad 16384 ->0x587f975b5bfd4499
Chrome 14620 tom 3u unix 0x36cd3ac44c49d68d 0t0 ->0x36cd3ac44c49f2ad
Chrome 14620 tom 4u unix 0x36cd3ac44c49dc05 0t0 ->0x36cd3ac44c49f9b5
UPDATE
I found the issue, for some reason the first argument when running the chrome process was being ignored?? So when I place any other argument as the first in the list chrome actually starts up the remote debugging. Weird issue!
When I run the chrome process in terminal with --remote-debugging-pipe as the first argument it works fine too, so why does it happen when i use: execvp(&file, &args)


The problem is how I am running the process.
execvp(&file, &args) requires the first arg to be the file location. Thanks to: source
Changing this code makes everything run as expected:
let args = vec![file.as_c_str(), arg1.as_c_str(),arg2.as_c_str()];

Related

bus error on usage of rusqlite with spatialite extension

I'm seeing a bus error on cargo run when attempting to load the spatialite extension with rusqlite:
Finished dev [unoptimized + debuginfo] target(s) in 1.19s
Running `target/debug/rust-spatialite-example`
[1] 33253 bus error cargo run --verbose
My suspicion is that there's a mismatch of sqlite version and spatialite and that they need to be built together rather than using the bundled feature of rusqlite, though it seems like that'd result in a different error?
Here's how things are set up:
Cargo.toml
[package]
name = "rust-spatialite-example"
version = "0.0.0"
edition = "2021"
# See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html
[dependencies]
rusqlite = { version = "0.28.0", features = ["load_extension", "bundled"] }
init.sql
CREATE TABLE place (
id INTEGER PRIMARY KEY,
name TEXT NOT NULL
);
SELECT AddGeometryColumn('place', 'geom', 4326, 'POINT', 'XY', 0);
SELECT CreateSpatialIndex('place', 'geom');
main.rs
use rusqlite::{Connection, Result, LoadExtensionGuard};
#[derive(Debug)]
struct Place {
id: i32,
name: String,
geom: String,
}
fn load_spatialite(conn: &Connection) -> Result<()> {
unsafe {
let _guard = LoadExtensionGuard::new(conn)?;
conn.load_extension("/opt/homebrew/Cellar/libspatialite/5.0.1_2/lib/mod_spatialite", None)
}
}
fn main() -> Result<()> {
let conn = Connection::open("./geo.db")?;
load_spatialite(&conn)?;
// ... sql statements that aren't executed
Ok(())
}
Running:
cat init.sql | spatialite geo.db
cargo run
The mod_spatialite path is correct (there's an expected SqliteFailure error when that path is wrong). I tried explicitly setting sqlite3_modspatialite_init as the entry point and the behavior stayed the same.

Can you convert a mut i8 into an i32?

I am attempting to build a small terminal emulator and am running into some interesting type conflicts with libc. When I am attempting to set up the slave portion of the pty connection I need to create the slave with a system call to ptsname() in order to get the name for the pts so I can access it. However, I get a type error saying that libc::ptsname() requires an i32 for the input. This is in direct conflict with the man page that says it should be passed a file descriptor. I'm just wondering if I can convert the libc::c_int that I have for a file descriptor into a i32 to pass into ptsname.
The code is as follows :
use libc::{self, c_int, grantpt, posix_openpt, ptsname, unlockpt, O_RDWR};
use std::os::unix::io::FromRawFd;
use std::process::{Child, Command, Stdio};
#[derive(Debug)]
pub struct Pty {
process: Child,
fd: i32,
}
fn create_pty(process: &str) -> Pty {
let master: c_int;
unsafe {
// create master/slave pair of fd
master = posix_openpt(O_RDWR);
if master == -1 {
panic!("Failed to posix_openpt");
}
// set slave ownership and mode as master
let mut result = grantpt(master);
if result == -1 {
panic!("Failed to grantpt");
}
// unlock slave
result = unlockpt(master);
if result == -1 {
panic!("Failed to unlockpt");
}
}
let slave: c_int = ptsname(master as i32);
slave = libc::open(slave);
let mut builder = Command::new(process);
match builder.spawn() {
Ok(process) => {
let pty = Pty {
process,
fd: master,
};
pty
}
Err(e) => {
panic!("Failed to create pty: {}", e);
}
}
}
fn main() {
let shell = "/bin/bish";
let pty = create_pty(shell);
println!("{:?}", pty);
}
and the console output(The second error can be ignored for now):
error[E0308]: mismatched types
--> src/main.rs:42:24
|
42 | let slave: c_int = ptsname(master as i32);
| ^^^^^^^^^^^^^^^^^^^^^^ expected i32, found *-ptr
|
= note: expected type `i32`
found type `*mut i8`
error[E0060]: this function takes at least 2 parameters but 1 parameter was supplied
--> src/main.rs:43:13
|
43 | slave = libc::open(slave);
| ^^^^^^^^^^^^^^^^^ expected at least 2 parameters
error: aborting due to 2 previous errors
Some errors have detailed explanations: E0060, E0308.
For more information about an error, try `rustc --explain E0060`.
error: could not compile `experiment`.

It's not saying that it requires an input of i32, but rather that you're asking that ptsname(master as i32); has the type i32. This might be a bit confusing because c_int is an alias for i32, so it sounds like it's asking for an unrelated type.
The problem is that you're giving slave the type c_int, when ptsname returns *mut c_char (c_char is also an alias, this time for i8).

Send SIGINT to a process by sending ctrl-c to stdin

I'm looking for a way to mimick a terminal for some automated testing: i.e. start a process and then interact with it via sending data to stdin and reading from stdout. E.g. sending some lines of input to stdin including ctrl-c and ctrl-\ which should result in sending signals to the process.
Using std::process::Commannd I'm able to send input to e.g. cat and I'm also seeing its output on stdout, but sending ctrl-c (as I understand that is 3) does not cause SIGINT sent to the shell. E.g. this program should terminate:
use std::process::{Command, Stdio};
use std::io::Write;
fn main() {
let mut child = Command::new("sh")
.arg("-c").arg("-i").arg("cat")
.stdin(Stdio::piped())
.spawn().unwrap();
let mut stdin = child.stdin.take().unwrap();
stdin.write(&[3]).expect("cannot send ctrl-c");
child.wait();
}
I suspect the issue is that sending ctrl-c needs the some tty and via sh -i it's only in "interactive mode".
Do I need to go full fledged and use e.g. termion or ncurses?
Update: I confused shell and terminal in the original question. I cleared this up now. Also I mentioned ssh which should have been sh.

The simplest way is to directly send the SIGINT signal to the child process. This can be done easily using nix's signal::kill function:
// add `nix = "0.15.0"` to your Cargo.toml
use std::process::{Command, Stdio};
use std::io::Write;
fn main() {
// spawn child process
let mut child = Command::new("cat")
.stdin(Stdio::piped())
.spawn().unwrap();
// send "echo\n" to child's stdin
let mut stdin = child.stdin.take().unwrap();
writeln!(stdin, "echo");
// sleep a bit so that child can process the input
std::thread::sleep(std::time::Duration::from_millis(500));
// send SIGINT to the child
nix::sys::signal::kill(
nix::unistd::Pid::from_raw(child.id() as i32),
nix::sys::signal::Signal::SIGINT
).expect("cannot send ctrl-c");
// wait for child to terminate
child.wait().unwrap();
}
You should be able to send all kinds of signals using this method. For more advanced "interactivity" (e.g. child programs like vi that query terminal size) you'd need to create a pseudoterminal like #hansaplast did in his solution.

After a lot of research I figured out it's not too much work to do the pty fork myself. There's pty-rs, but it has bugs and seems unmaintained.
The following code needs pty module of nix which is not yet on crates.io, so Cargo.toml needs this for now:
[dependencies]
nix = {git = "https://github.com/nix-rust/nix.git"}
The following code runs cat in a tty and then writes/reads from it and sends Ctrl-C (3):
extern crate nix;
use std::path::Path;
use nix::pty::{posix_openpt, grantpt, unlockpt, ptsname};
use nix::fcntl::{O_RDWR, open};
use nix::sys::stat;
use nix::unistd::{fork, ForkResult, setsid, dup2};
use nix::libc::{STDIN_FILENO, STDOUT_FILENO, STDERR_FILENO};
use std::os::unix::io::{AsRawFd, FromRawFd};
use std::io::prelude::*;
use std::io::{BufReader, LineWriter};
fn run() -> std::io::Result<()> {
// Open a new PTY master
let master_fd = posix_openpt(O_RDWR)?;
// Allow a slave to be generated for it
grantpt(&master_fd)?;
unlockpt(&master_fd)?;
// Get the name of the slave
let slave_name = ptsname(&master_fd)?;
match fork() {
Ok(ForkResult::Child) => {
setsid()?; // create new session with child as session leader
let slave_fd = open(Path::new(&slave_name), O_RDWR, stat::Mode::empty())?;
// assign stdin, stdout, stderr to the tty, just like a terminal does
dup2(slave_fd, STDIN_FILENO)?;
dup2(slave_fd, STDOUT_FILENO)?;
dup2(slave_fd, STDERR_FILENO)?;
std::process::Command::new("cat").status()?;
}
Ok(ForkResult::Parent { child: _ }) => {
let f = unsafe { std::fs::File::from_raw_fd(master_fd.as_raw_fd()) };
let mut reader = BufReader::new(&f);
let mut writer = LineWriter::new(&f);
writer.write_all(b"hello world\n")?;
let mut s = String::new();
reader.read_line(&mut s)?; // what we just wrote in
reader.read_line(&mut s)?; // what cat wrote out
writer.write(&[3])?; // send ^C
writer.flush()?;
let mut buf = [0; 2]; // needs bytewise read as ^C has no newline
reader.read(&mut buf)?;
s += &String::from_utf8_lossy(&buf).to_string();
println!("{}", s);
println!("cat exit code: {:?}", wait::wait()?); // make sure cat really exited
}
Err(_) => println!("error"),
}
Ok(())
}
fn main() {
run().expect("could not execute command");
}
Output:
hello world
hello world
^C
cat exit code: Signaled(2906, SIGINT, false)

Try adding -t option TWICE to force pseudo-tty allocation. I.e.
klar (16:14) ~>echo foo | ssh user#host.ssh.com tty
not a tty
klar (16:14) ~>echo foo | ssh -t -t user#host.ssh.com tty
/dev/pts/0
When you have a pseudo-tty, I think it should convert that to SIGINT as you wanted to do.
In your simple example, you could also just close stdin after the write, in which case the server should exit. For this particular case it would be more elegant and probably more reliable.

Solution without using a crate
Now that you are spawning a command in Rust, you might as well spawn another to send SIGINT to it. That command is kill.
So, you can do this:
use std::process::{Command, Stdio};
use std::io::{Result, Write};
fn main() -> Result<()> {
let mut child = Command::new("sh")
.arg("-c").arg("-i").arg("cat")
.stdin(Stdio::piped())
.spawn()?;
let mut stdin = child.stdin.take().unwrap();
let mut kill = Command::new("kill")
.arg(child.id().to_string())
.spawn()?;
kill.wait()
}

Ejabberd: error in simple module to handle offline messages

I have an Ejabberd 17.01 installation where I need to push a notification in case a recipient is offline. This seems the be a common task and solutions using a customized Ejabberd module can be found everywhere. However, I just don't get it running. First, here's me script:
-module(mod_offline_push).
-behaviour(gen_mod).
-export([start/2, stop/1]).
-export([push_message/3]).
-include("ejabberd.hrl").
-include("logger.hrl").
-include("jlib.hrl").
start(Host, _Opts) ->
?INFO_MSG("mod_offline_push loading", []),
ejabberd_hooks:add(offline_message_hook, Host, ?MODULE, push_message, 10),
ok.
stop(Host) ->
?INFO_MSG("mod_offline_push stopping", []),
ejabberd_hooks:add(offline_message_hook, Host, ?MODULE, push_message, 10),
ok.
push_message(From, To, Packet) ->
?INFO_MSG("mod_offline_push -> push_message", [To]),
Type = fxml:get_tag_attr_s(<<"type">>, Packet), % Supposedly since 16.04
%Type = xml:get_tag_attr_s(<<"type">>, Packet), % Supposedly since 13.XX
%Type = xml:get_tag_attr_s("type", Packet),
%Type = xml:get_tag_attr_s(list_to_binary("type"), Packet),
?INFO_MSG("mod_offline_push -> push_message", []),
ok.
The problem is the line Type = ... line in method push_message; without that line the last info message is logged (so the hook definitely works). When browsing online, I can find all kinds of function calls to extract elements from Packet. As far as I understand it changed over time with new releases. But it's not good, all variants lead in some kind of error. The current way returns:
2017-01-25 20:38:08.701 [error] <0.21678.0>#ejabberd_hooks:run1:332 {function_clause,[{fxml,get_tag_attr_s,[<<"type">>,{message,<<>>,normal,<<>>,{jid,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>},{jid,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>},[],[{text,<<>>,<<"sfsdfsdf">>}],undefined,[],#{}}],[{file,"src/fxml.erl"},{line,169}]},{mod_offline_push,push_message,3,[{file,"mod_offline_push.erl"},{line,33}]},{ejabberd_hooks,safe_apply,3,[{file,"src/ejabberd_hooks.erl"},{line,382}]},{ejabberd_hooks,run1,3,[{file,"src/ejabberd_hooks.erl"},{line,329}]},{ejabberd_sm,route,3,[{file,"src/ejabberd_sm.erl"},{line,126}]},{ejabberd_local,route,3,[{file,"src/ejabberd_local.erl"},{line,110}]},{ejabberd_router,route,3,[{file,"src/ejabberd_router.erl"},{line,87}]},{ejabberd_c2s,check_privacy_route,5,[{file,"src/ejabberd_c2s.erl"},{line,1886}]}]}
running hook: {offline_message_hook,[{jid,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>},{jid,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>},{message,<<>>,normal,<<>>,{jid,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>},{jid,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>},[],[{text,<<>>,<<"sfsdfsdf">>}],undefined,[],#{}}]}
I'm new Ejabberd and Erlang, so I cannot really interpret the error, but the Line 33 as mentioned in {mod_offline_push,push_message,3,[{file,"mod_offline_push.erl"}, {line,33}]} is definitely the line calling get_tag_attr_s.
UPDATE 2017/01/27: Since this cost me a lot of headache -- and I'm still not perfectly happy -- I post here my current working module in the hopes it might help others. My setup is Ejabberd 17.01 running on Ubuntu 16.04. Most stuff I tried and failed with seem to for older versions of Ejabberd:
-module(mod_fcm_fork).
-behaviour(gen_mod).
%% public methods for this module
-export([start/2, stop/1]).
-export([push_notification/3]).
%% included for writing to ejabberd log file
-include("ejabberd.hrl").
-include("logger.hrl").
-include("xmpp_codec.hrl").
%% Copied this record definition from jlib.hrl
%% Including "xmpp_codec.hrl" and "jlib.hrl" resulted in errors ("XYZ already defined")
-record(jid, {user = <<"">> :: binary(),
server = <<"">> :: binary(),
resource = <<"">> :: binary(),
luser = <<"">> :: binary(),
lserver = <<"">> :: binary(),
lresource = <<"">> :: binary()}).
start(Host, _Opts) ->
?INFO_MSG("mod_fcm_fork loading", []),
% Providing the most basic API to the clients and servers that are part of the Inets application
inets:start(),
% Add hook to handle message to user who are offline
ejabberd_hooks:add(offline_message_hook, Host, ?MODULE, push_notification, 10),
ok.
stop(Host) ->
?INFO_MSG("mod_fcm_fork stopping", []),
ejabberd_hooks:add(offline_message_hook, Host, ?MODULE, push_notification, 10),
ok.
push_notification(From, To, Packet) ->
% Generate JID of sender and receiver
FromJid = lists:concat([binary_to_list(From#jid.user), "#", binary_to_list(From#jid.server), "/", binary_to_list(From#jid.resource)]),
ToJid = lists:concat([binary_to_list(To#jid.user), "#", binary_to_list(To#jid.server), "/", binary_to_list(To#jid.resource)]),
% Get message body
MessageBody = Packet#message.body,
% Check of MessageBody is not empty
case MessageBody/=[] of
true ->
% Get first element (no idea when this list can have more elements)
[First | _ ] = MessageBody,
% Get message data and convert to string
MessageBodyText = binary_to_list(First#text.data),
send_post_request(FromJid, ToJid, MessageBodyText);
false ->
?INFO_MSG("mod_fcm_fork -> push_notification: MessageBody is empty",[])
end,
ok.
send_post_request(FromJid, ToJid, MessageBodyText) ->
%?INFO_MSG("mod_fcm_fork -> send_post_request -> MessageBodyText = ~p", [Demo]),
Method = post,
PostURL = gen_mod:get_module_opt(global, ?MODULE, post_url,fun(X) -> X end, all),
% Add data as query string. Not nice, query body would be preferable
% Problem: message body itself can be in a JSON string, and I couldn't figure out the correct encoding.
URL = lists:concat([binary_to_list(PostURL), "?", "fromjid=", FromJid,"&tojid=", ToJid,"&body=", edoc_lib:escape_uri(MessageBodyText)]),
Header = [],
ContentType = "application/json",
Body = [],
?INFO_MSG("mod_fcm_fork -> send_post_request -> URL = ~p", [URL]),
% ADD SSL CONFIG BELOW!
%HTTPOptions = [{ssl,[{versions, ['tlsv1.2']}]}],
HTTPOptions = [],
Options = [],
httpc:request(Method, {URL, Header, ContentType, Body}, HTTPOptions, Options),
ok.

Actually it fails with second arg Packet you pass to fxml:get_tag_attr_s in push_message function
{message,<<>>,normal,<<>>,
{jid,<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>,
<<"homer">>,<<"xxx.xxx.xxx.xxx">>,<<"conference">>},
{jid,<<"carl">>,<<"xxx.xxx.xxx.xxx">>,<<>>,<<"carl">>,
<<"xxx.xxx.xxx.xxx">>,<<>>},
[],
[{text,<<>>,<<"sfsdfsdf">>}],
undefined,[],#{}}
because it is not xmlel
Looks like it is record "message" defined in tools/xmpp_codec.hrl
with <<>> id and type 'normal'
xmpp_codec.hrl
-record(message, {id :: binary(),
type = normal :: 'chat' | 'error' | 'groupchat' | 'headline' | 'normal',
lang :: binary(),
from :: any(),
to :: any(),
subject = [] :: [#text{}],
body = [] :: [#text{}],
thread :: binary(),
error :: #error{},
sub_els = [] :: [any()]}).
Include this file and use just
Type = Packet#message.type
or, if you expect binary value
Type = erlang:atom_to_binary(Packet#message.type, utf8)

The newest way to do that seems to be with xmpp:get_type/1:
Type = xmpp:get_type(Packet),
It returns an atom, in this case normal.

How do I make a simple GET request in OCaml?

I'm trying to do something that should be simple: make a GET request to a url. However, when I search for examples of how to do this I often wind up with near-gibberish like this.
Does anyone know how to make a simple HTTP request using OCaml? I'm an OCaml newbie with some Haskell exp.
NOTE:
A solution using the lowest possible level OCaml would be ideal. I've seen the Cohttp library used, but I'm more interested in a native (?) HTTP OCaml lib or something along those lines.
In response to #antron, a solution using the lowest possible level native OCaml would be much appreciated. I'm led to believe that this will involve the Unix library. But if there is another solution that does not involve 3rd party libraries it would be just as welcome.

Use the Cohttp library. See the Client example.
The relevant line is:
Cohttp_lwt_unix.Client.get (Uri.of_string "http://www.reddit.com/")
This gives you a pair of (response, body) inside the Lwt monad. response is basically a record, and body is a stream. The rest of the example is just printing some interesting bits of those.

Perhaps the most basic way to send a GET request in OCaml is to use the Unix library and the basic input/output routines from Pervasives.
Here is a very simple example:
let ip = Unix.((gethostbyname "caml.inria.fr").h_addr_list.(0))
let addr = Unix.ADDR_INET (ip, 80)
let sock = Unix.(socket PF_INET SOCK_STREAM 0)
let _ = Unix.connect sock addr
let in_ch = Unix.in_channel_of_descr sock
let out_ch = Unix.out_channel_of_descr sock
let _ =
output_string out_ch
"GET /pub/docs/manual-ocaml/index.html HTTP/1.1\r\n\
Host: caml.inria.fr\r\n\
User-Agent: OCaml\r\n\
Connection: close\r\n\
\r\n";
flush out_ch
let _ =
try
while true do
print_string (input_line in_ch)
done
with End_of_file ->
Unix.close sock
The Unix. prefixes are not necessary if one puts open Unix at the top of the file, but I preferred to leave them in for clarity.
The program can be compiled to byte code with ocamlc unix.cma -o get get.ml.
I agree with #ChriS' suggestion to read Leroy and Rémy's Unix system programming in OCaml (I've included a link to the online version); it's a great book.

For low level Unix programming in OCaml (even if you don't know much about it), I recommend the excellent book Unix System Programming in OCaml. It will tell you how to write the client you want.

For those searching a quite independent solution, I found one which should at least work on any Unix* like OS.
From Rosetta Code:
let try_finalise f x finally y =
let res = try f x with e -> finally y; raise e in
finally y;
res
let rec restart_on_EINTR f x =
try f x with Unix.Unix_error (Unix.EINTR, _, _) -> restart_on_EINTR f x
let double_fork_treatment server service (client_descr, _ as client) =
let treat () =
match Unix.fork () with
| 0 ->
if Unix.fork () <> 0 then exit 0;
Unix.close server; service client; exit 0
| k ->
ignore (restart_on_EINTR (Unix.waitpid []) k)
in
try_finalise treat () Unix.close client_descr
let install_tcp_server_socket addr =
let s = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
try
Unix.bind s addr;
Unix.listen s 10;
s
with e -> Unix.close s; raise e
let tcp_server treat_connection addr =
ignore (Sys.signal Sys.sigpipe Sys.Signal_ignore);
let server_sock = install_tcp_server_socket addr in
while true do
let client = restart_on_EINTR Unix.accept server_sock in
treat_connection server_sock client
done
let server () =
let port = 8080 in
let host = (Unix.gethostbyname (Unix.gethostname())).Unix.h_addr_list.(0) in
let addr = Unix.ADDR_INET (host, port) in
let treat sock (client_sock, client_addr as client) =
let service (s, _) =
let response = "\
HTTP/1.1 200 OK\r\n\
Content-Type: text/html; charset=UTF-8\r\n\r\n\
<html><head><title>Goodbye, world!</title>\
<style>body { background-color: #0FF }\
h1 { font-size:3em; color: black; }</style></head>\
<body><h1>Goodbye, world!</h1></body></html>\r\n"
in
Unix.write s response 0 (String.length response);
in
double_fork_treatment sock service client
in
tcp_server treat addr
let _ =
Unix.handle_unix_error server ()
It's not a one liner but it's relative straight forward.

Resources