Understanding module parameters in OCaml - functional-programming

I'm trying to understand what's the point of this connect function:
let connect netif ethif arpv4 ipv4 icmpv4 udpv4 tcpv4 =
let udpv4_listeners = Hashtbl.create 7 in
let tcpv4_listeners = Hashtbl.create 7 in
let t = { netif; ethif; arpv4; ipv4; icmpv4; tcpv4; udpv4;
udpv4_listeners; tcpv4_listeners } in
Log.info (fun f -> f "stack assembled: %a" pp t);
Lwt.async (fun () -> listen t);
Lwt.return t
My first assumption is: are the netif ethif arpv4 ipv4 icmpv4 udpv4 tcpv4 parameters being taken to be by default the 'variables' of same name enclosed in the scope of the connect function definition?
Please see the entire context here: https://github.com/mirage/mirage-tcpip/blob/master/src/stack-direct/tcpip_stack_direct.ml#L122
If this is not the case, then does it mean that I need to always pass all these 7 parameters when I call connect? What's the point of passing them if they're already created here?

Related

How to make a request to an IPv6 address using the http-client package in haskell?

I've been trying to make a request to an IPv6 address using the parseRequest function from Network.HTTP.Client (https://hackage.haskell.org/package/http-client-0.7.10/docs/Network-HTTP-Client.html) package as follows:
request <- parseRequest "http://[2001:0db8:85a3:0000:0000:8a2e:0370:7334]"
Instead of parsing it as an address/addrInfo, it is parsed as a hostname and throws the error: does not exist (Name or service not known). As a next step, I tried pointing a domain to the same IPv6 address and then using the domain name in parseRequest, then it successfully resolves that into the IPv6 address and makes the request. Is there some other way I can directly use the IPv6 address to make the request using the http-client package?
PS: I also tried without square brackets around the IP address, in this case the error is Invalid URL:
request <- parseRequest "http://2001:0db8:85a3:0000:0000:8a2e:0370:7334"
More context:
For an IPv4 address, the getAddrInfo function generates the address as:
AddrInfo {addrFlags = [AI_NUMERICHOST], addrFamily = AF_INET, addrSocketType = Stream, addrProtocol = 6, addrAddress = 139.59.90.1:80, addrCanonName = Nothing}
whereas for IPv6 address(inside the square brackets format):
AddrInfo {addrFlags = [AI_ADDRCONFIG], addrFamily = AF_UNSPEC, addrSocketType = Stream, addrProtocol = 6, addrAddress = 0.0.0.0:0, addrCanonName = Nothing}
and the error prints as:
(ConnectionFailure Network.Socket.getAddrInfo (called with preferred socket type/protocol: AddrInfo {addrFlags = [AI_ADDRCONFIG], addrFamily = AF_UNSPEC, addrSocketType = Stream, addrProtocol = 6, addrAddress = 0.0.0.0:0, addrCanonName = Nothing}, host name: Just "[2001:0db8:85a3:0000:0000:8a2e:0370:7334]", service name: Just "80"): does not exist (Name or service not known))

When a literal IPv6 address is used in a URL, it should be surrounded by square brackets (as per RFC 2732) so the colons in the literal address aren't misinterpreted as some kind of port designation.
When a literal IPv6 address is resolved using the C library function getaddrinfo (or the equivalent Haskell function getAddrInfo), these functions are not required to handle these extra square brackets, and at least on Linux they don't.
Therefore, it's the responsibility of the HTTP client library to remove the square brackets from the hostname extracted from the URL before resolving the literal IPv6 address using getaddrinfo, and the http-client package doesn't do this, at least as of version 0.7.10. So, this is a bug, and I can see you've appropriately filed a bug report.
Unfortunately, I don't see an easy way to work around the issue. You can manipulate the Request after parsing to remove the square brackets from the host field, like so:
{-# LANGUAGE OverloadedStrings #-}
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Network.HTTP.Client
import Network.HTTP.Types.Status (statusCode)
main :: IO ()
main = do
manager <- newManager defaultManagerSettings
request <- parseRequest "http://[::1]"
let request' = request { host = removeBrackets (host request) }
response <- httpLbs request' manager
print response
removeBrackets :: ByteString -> ByteString
removeBrackets bs =
case BS.stripPrefix "[" bs >>= BS.stripSuffix "]" of
Just bs' -> bs'
Nothing -> bs
The problem with this is that it also removes the square brackets from the value in the Host header, so the HTTP request will contain the header:
Host: ::1
instead of the correct
Host: [::1]
which may or may not cause problems, depending on the web server at the other end.
You could try using a patched http-client package. The following patch against version 0.7.10 seems to work, but I didn't test it very extensively:
diff --git a/Network/HTTP/Client/Connection.hs b/Network/HTTP/Client/Connection.hs
index 0e329cd..719822e 100644
--- a/Network/HTTP/Client/Connection.hs
+++ b/Network/HTTP/Client/Connection.hs
## -15,6 +15,7 ## module Network.HTTP.Client.Connection
import Data.ByteString (ByteString, empty)
import Data.IORef
+import Data.List (stripPrefix, isSuffixOf)
import Control.Monad
import Network.HTTP.Client.Types
import Network.Socket (Socket, HostAddress)
## -158,8 +159,12 ## withSocket :: (Socket -> IO ())
withSocket tweakSocket hostAddress' host' port' f = do
let hints = NS.defaultHints { NS.addrSocketType = NS.Stream }
addrs <- case hostAddress' of
- Nothing ->
- NS.getAddrInfo (Just hints) (Just host') (Just $ show port')
+ Nothing -> do
+ let port'' = Just $ show port'
+ case ip6Literal host' of
+ Just lit -> NS.getAddrInfo (Just hints { NS.addrFlags = [NS.AI_NUMERICHOST] })
+ (Just lit) port''
+ Nothing -> NS.getAddrInfo (Just hints) (Just host') port''
Just ha ->
return
[NS.AddrInfo
## -173,6 +178,11 ## withSocket tweakSocket hostAddress' host' port' f = do
E.bracketOnError (firstSuccessful addrs $ openSocket tweakSocket) NS.close f
+ where
+ ip6Literal h = case stripPrefix "[" h of
+ Just rest | "]" `isSuffixOf` rest -> Just (init rest)
+ _ -> Nothing
+
openSocket tweakSocket addr =
E.bracketOnError
(NS.socket (NS.addrFamily addr) (NS.addrSocketType addr)

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

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.

Basic `listenOn` HTTP server "Recv failure: Connection reset by peer"

While diving into Haskell's Network library, I'm making a very simple HTTP server based on info from this link.
import Control.Concurrent
import Control.Monad
import Network
import System.IO
main = withSocketsDo $ listenOn (PortNumber 8080) >>= loop
loop :: Socket -> IO ()
loop sock = do
(h,_,_) <- accept sock
forkIO $ handleRequest h
loop sock
handleRequest :: Handle -> IO ()
handleRequest h = do
hPutStr h $ httpRequest "Pong!\n"
hFlush h
hClose h
httpRequest :: String -> String
httpRequest body = "HTTP/1.0 200 OK\r\n"
++ "Content-Length: " ++ (show.length) body ++ "\r\n"
++ "\r\n" ++ body ++ "\r\n"
However, even though I manage to get some response, the handles seems to be closed unexpectedly soon (sometimes?) as curl tells me:
$ curl localhost:8080
Pong!
curl: (56) Recv failure: Connection reset by peer
NB: Sometimes I don't even get the message (Pong!) or just a part of it. Sometimes, it works... but if I run 100 curls in a row I eventually get some connection resets.
Why is the connection reset? I tried with and without forkIO without success. Have I missed some essential about IO streams in Haskell? Thanks!
OS: recent Ubuntu ; GHC: 7.8.4
--- Edit: ---
jozefg identified that the problem came from draining the request's contents! However I'd like to send this content back to the client and it hangs while using the following code:
handleRequest :: Handle -> IO ()
handleRequest h = do
contents <- getHandleContents h
hPutStr h $ httpRequest contents
hFlush h
hClose h
getHandleContents :: Handle -> IO String
getHandleContents h = do
iseof <- hIsEOF h
if iseof
then return []
else do
newLine <- hGetLine h
nextLines <- getHandleContents h
return $ newLine ++ '\n' : nextLines
Moreover I had no success draining the whole contents using hGetContents. Any idea why?

The error seems to be that you are not fully reading the data the client sends upon making a get-request as described in this answer for Rust. The solution proposed there is basically to write a small loop which drains the header from the handle before you respond. The Haskell version is
drainHeaders :: Handle -> IO ()
drainHeaders h = do
line <- hGetLine h
if line == "\r" then return () else drainHeaders h
so then your code may be written
import Control.Concurrent
import Control.Exception (bracket)
import Control.Monad
import Network
import System.IO
main = withSocketsDo $
bracket (listenOn (PortNumber 8080)) sClose loop
loop :: Socket -> IO ()
loop sock = do
(handle, _host, _port) <- accept sock
-- Handle is automatically closed now even in the face of async exns
forkFinally (handleRequest handle) (const $ hClose handle)
loop sock
drainHeaders :: Handle -> IO ()
drainHeaders h = do
line <- hGetLine h -- Strips off a trailing \n
if line == "\r" then return () else drainHeaders h
handleRequest :: Handle -> IO ()
handleRequest h = do
drainHeaders h
hPutStr h $ httpRequest "Pong!\n"
hFlush h
httpRequest :: String -> String
httpRequest body =
mconcat [ "HTTP/1.0 200 OK\r\nContent-Length: "
, (show . length) body
, "\r\n\r\n"
, body
, "\r\n" ]
I also took the liberty of tweaking the code to make it a bit more exception safe by using forkFinally and bracket to handle closing things in the face of exceptions: I doubt it's 100% perfect but it's now a little bit cleaner.

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