Haskell Socks Client request - http

I'm writing a client that listens the request via SOCKS5 from my browser. Then connect to the target server and perform http action via the client, then send the result back.
However I have no idea how to perform the HTTP(S) request.
I'm using the Network.Simple.TCP
serverb :: IO ()
serverb =
serve (Host "127.0.0.1") "8000" $ \(connectionSocket, remoteAddr) -> do
x <- recv connectionSocket 64
print (B.unpack <$> x)
send connectionSocket (B.pack [0x05, 0x00])
t <- recv connectionSocket 1024
print t
case t of
Nothing -> return ()
Just t' -> do
let (tAddr, tPort) = getADDR ((B.unpack t') !! 3) t'
send connectionSocket (B.pack [0x05, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00])
print tAddr
h <- recv connectionSocket 1024
print h
-- don't know how to do the rest
putStrLn $ "TCP connection established from " ++ show remoteAddr
getADDR :: Word8 -> ByteString -> (ByteString, ByteString)
getADDR t x = bimap B.pack B.pack $ go ([], f t s)
where
s = B.unpack x
f x = if t == 0x03 then drop 5 else drop 4
go (p, [a, b]) = (p, [a, b])
go (a, (b : bs)) = go (a ++ [b], bs)
The getADDR extracts DST.ADDR and DST.PORT.
I think I'm getting the full HTTP(S) request in h as ByteString, but I don't know how how to perform the request.
some of the contents in h
GET / HTTP/1.1\r\nHost: www.example.com\r\nConnection: keep-alive (I'm not showing all of request)
Can anyone give some hints on what I should do and what packages are needed?

Related

MAX14830 not flushing TX

So after a day of struggling I managed to get Debian 11 on a IMX7D, 5.4.129 kernel to recognize the MAX14830 and talk to it via the MAX310X driver. But when I try to send data with echo a > /dev/ttyMAX0 nothing happens. Well except the Tx count going up.
Looking at the SPI traffic this seems to be going correctly and the chip is sending the expected responses (Tx FIFO count returns three if three characters are being send) but nothing seems to happen to the buffer. The driver keeps interrogating the max but the FIFO stays at 3. Then the driver reaches a timeout I guess. Because it then sends 0x81,0x00 which clears the IRQen register, followed by 0x9B 0x40 which sets the baudrate register... which makes it all the more confusing.
So far I've gone through all the stty settings and used -ixon to disable XON/XOFF but that didn't make a difference.
Is there a way/place/file that holds the settings for the driver? Or am I forgetting something? RX doesn't seem to work either but not sure if the max isn't receiving it or just not informing the driver.
The relevant portion of the DTS
&ecspi3 {
max14830: max14830#3 {
compatible = "maxim,max14830";
spi-max-frequency = <15000000>;
reg = <0>; // SPI chip select number
clocks = <&clk16m0>;
clock-names = "osc";
interrupt-parent = <&gpio5>;
interrupts = <7 IRQ_TYPE_EDGE_FALLING>;
gpio-controller; // Marks the device node as a GPIO controller
#gpio-cells = <2>;
clk16m0: clk16m0 {
compatible = "fixed-clock";
#clock-cells = <0>;
clock-frequency = <3686400>; // freq of external xtal
clock-accuracy = <100>;
};
};
};
And the comms during startup
OUT IN MEANING
0x9F 0xCE -> Write globalCmd = Enable Extend register map acces
0x05 0x00 -> 0x0F 0xB4 -> Clear SpclChrIntEn= RevID is B4
0x9F 0xCD -> Write globalCmd = Disable Extend register map access
0x8A 0x01 -> Write UART0 Mode2 = Set RST
0x8A 0x00 -> Write UART0 Mode2 = Clear RST
0x1C 0x00 -> 0x0F 0x01 -> Read UART0 DivLSB = Div0 set
0x89 0x80 -> Set UART0 MODE1 = ~RTS0 is three state
0xAA 0x01 -> Write UART1 Mode2 = Set RST
0xAA 0x00 -> Write UART1 Mode2 = Clear RST
0x3C 0x00 -> 0x0F 0x01 -> Read UART1 DivLSB = Div0 set
0xA9 0x80 -> Set UART1 MODE1 = ~RTS1 is three state
0xCA 0x01 -> Write UART2 Mode2 = Set RST
0xCA 0x00 -> Write UART2 Mode2 = Clear RST
0x5C 0x00 -> 0xF 0x01 -> Read UART2 DivLSB = Div0 set
0xC9 0x80 -> Set UART2 MODE1 = ~RTS2 is three state
0xEA 0x01 -> Write UART3 Mode2 = Set RST
0xEA 0x00 -> Write UART3 Mode2 = Clear RST
0x7C 0x00 -> 0x0F 0x01 -> Read UART3 DivLSB = Div0 set
0xE9 0x80 -> Set UART3 MODE1 = ~RTS3 is three state
0x9A 0x44 -> Write PLLConfig = Set PreDiv5 and PreDiv2
0x9E 0x14 -> Write ClockSource = 0001 0100 -> first 1 at dont care, second PLLen
0x81 0x00 -> Clear IRQen UART0
0x02 0x00 -> 0x0F 0x60 -> Read ISR UART0 = both fifo empty
0x1B 0x00 -> 0x0F 0x00 -> Read BRConfig UART0 -> all clear
0x9B 0x40 -> Write BRConfig UART0 -> FRACT2 Set
0xA1 0x00 -> Clear IRQen UART1
0x22 0x00 -> 0x0F 0x60 -> Read ISR UART1 = both fifo empty
0x3B 0x00 -> 0x0F 0x00 -> Read BRConfig UART1 -> all clear
0xBB 0x40 -> Write BRConfig UART1 -> FRACT2 Set
0xC1 0x00 -> Clear IRQen UART2
0x42 0x00 -> 0x0F 0x60 -> Read ISR UART2 = both fifo empty
0x58 0x00 -> 0x0F 0x00 -> Read BRConfig UART2 -> all clear
0xDB 0x40 -> Write BRConfig UART2 -> FRACT2 Set
0xE1 0x00 -> Clear IRQen UART3
0x62 0x00 -> 0x0F 0x60 -> Read ISR UART3 = both fifo empty
0x7B 0x00 -> 0x0F 0x00 -> Read BRConfig UART3 -> all clear
0xFB 0x40 -> Write BRConfig UART3 -> FRACT2 Set
ttyMAX0 setup according to stty
Result of stty -F /dev/ttyMAX0
-parenb -> don't generate parity
-parodd -> Even parity?
-cmspar -> No stick parity
cs8 -> character size 8 bits
hupcl -> don't send hangup signal
-cstopb -> use one bit per character
cread -> allow input to be received
clocal -> disable modem control signals
-crtscts -> dont enable rts/cts handschaking
-ignbr -> don't ignore break characters
-brkint -> breaks don't cause an interrupt signal
-ignpar -> don't ignore characters with parity errors
-parmrk -> don't mark parity errors
-inpck -> don't enable parity checking
-istrip -> don't clear high (8th) bit of input characters
-inlcr -> dont translate newline to carriage return
-igncr -> don't ignore carriage return
icrnl -> don't translate carriage return to newline
-ixon -> disable XON/XOFF flow control
-ixoff -> disable sending of start/stop characters
-iuclc -> don't translate uppercase to lowercase
-ixany -> Don't let any character restart output
-imaxbel -> don't beep and flush
-iutf8 -> don't assume characters are utf8 encoded
OUTPUT SETTINGS
opost -> post process output
-olcuc -> don't translate lower to upper
-ocrnl -> don't translate carriage return to newline
onlcr -> translate newline to carriage return newline
-onocr -> print carriage return in the first column
-onlret -> newline doesn't perform a carriage return
-ofill -> don't use fill characters instead of timing for delays
-ofdel -> don't use delete character for fill instead of null
nl0
cr0
tab0 -> horizontal tab delay style 0
bs0
vt0
ff0 -> form feed delay style
isig -> enable interrpt,
icanon -> enable special characters: erase, kill, werase, rprnt
iexten -> enable non-POSIX special characters
echo -> echo input characters
echoe -> echo erase characters as backspace-space-backspace
echok -> echo a newline after a kill character
-echonl
-noflsh -> don't disable flushing after interrupt & quit special
chars
-xcase
-tostop
-echoprt
echoctl -> echo control characters in hat notation ('^c')
echoke -> kill all line by obeying the echoprt and echoe settings
-flusho
-extproc
TX wasn't working because clock-names should have been xtal
RX wasn't working because i never opened the port but checked /proc/tty/driver/max310x for received data and the driver disables rx if a port isn't open.
Working node.
&ecspi3 {
/delete-node/spidev#0;
max14830: max14830#3 {
compatible = "maxim,max14830";
spi-max-frequency = <15000000>;
reg = <0>; // SPI chip select number
clocks = <&clk16m0>;
clock-names = "xtal"; /* because using external xtal */
interrupt-parent = <&gpio5>;
interrupts = <11 IRQ_TYPE_EDGE_FALLING>;
gpio-controller; /* Marks the device node as a GPIO controller */
#gpio-cells = <2>;
clk16m0: clk16m0 {
compatible = "fixed-clock";
#clock-cells = <0>;
clock-frequency = <3686400>; /* external xtal frequency */
clock-accuracy = <100>;
};
};
};
```

Understanding module parameters in OCaml

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?

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.

libnetfilter_queue: Why can't I see the TCP payload of packets from nfq_get_payload?

I have a fairly basic user space firewall application. It receives data from libnetfilter_queue properly, we can see all the IP and TCP header information including source and destination IPs, ports, protocols, etc, but we don't get ANY of the TCP payload information...
The setup is pretty standard, I won't include it all but here are the highlights:
#define MAX_BUFFER_SIZE 65535
nfq_set_mode(qh, NFQNL_COPY_PACKET, MAX_BUFFER_SIZE)
So we are asking for the FULL PACKET back...
In the main thread we have:
rv = recv(fd, nfq_buffer, sizeof(nfq_buffer), 0);
printf("\nGot packet len: %d", rv);
if (rv > 0)
nfq_handle_packet(nfq_h, (char*)nfq_buffer, rv);
Here, on a standard HTTP call I will get a packet length of 140. But, in the callback handler the PACKET length is ALWAYS 64:
static int handle_packet(struct nfq_q_handle* qh, struct nfgenmsg* nfmsg, struct nfq_data* dat, void* data)
{
struct nfqnl_msg_packet_hdr* nfq_hdr = nfq_get_msg_packet_hdr(dat);
unsigned char* nf_packet;
int len = nfq_get_payload(dat,&nf_packet);
struct iphdr *iph = ((struct iphdr *) nf_packet);
iphdr_size = iph->ihl << 2;
if (iph->protocol == 6){
struct tcphdr *tcp = ((struct tcphdr *) (nf_packet + iphdr_size));
unsigned short tcphdr_size = (tcp->doff << 2);
printf("\nGot a packet!! len: %d iphdr: %d tcphdr: %d", len, iphdr_size, tcphdr_size);
}
}
In TCP, len is ALWAYS 64 (iphdr is 20, tcphdr is 44)... ALWAYS. I never get the TCP payload. What am I doing wrong???
Thanks to Joel for pointing out that problem was not in the C code, but in the iptables rules. There was a -m conntrack --ctstate ESTABLISHED,RELATED -j ACCEPT rule prior to the NFQUEUE rule, so I was only getting the connection setup packets... whoops.

Resources