Raw sockets in Haskell

Question

There is a raw socket type provided in Network.Socket, but near binding sockets there is a comment "Currently only Unix domain sockets and the Internet families are supported". How can I use raw sockets in haskell?

What I am trying to achieve, as working Python code:

import binascii
import socket

# Create raw socket.
ethType = b'FFFF' # 2 bytes, has to be >= 0x0600. FFFF is "unavailable" by IEEE.
sock = socket.socket(socket.AF_PACKET, socket.SOCK_RAW)
sock.bind( ('lo', int(ethType,16)) )

# Create packet.
srcMac  = b'000000000000' # 6 bytes
destMac = b'000000000000' # 6 bytes
header = binascii.a2b_hex( destMac + srcMac + ethType ) # 14 bytes
message = b'Hello, World!'
sock.send(header + message)

# Receive such packets
while True: print (sock.recv(65535))

EDIT1: In Haskell, I use sock <- socket AF_PACKET Raw 0xFFFF to create a socket, but bindSocket requires a SockAddr as an argument, for which available constructors are

SockAddrInet PortNumber HostAddress  
SockAddrInet6 PortNumber FlowInfo HostAddress6 ScopeID   
SockAddrUnix String

but none of these seems right.

EDIT2: Thanks to a comment by Yuras I got receiving packets to work:

import Network.Socket
sock <- socket AF_PACKET Raw 0xFFFF
recv sock 0xFFFF

EDIT3: Trying to send a packet from a socket without binding it results in an exception:

sock <- socket AF_PACKET Raw 0xFFFF
send sock "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\255\255"
*** Exception: send: does not exist (No such device or address)

This makes sense, because the kernel would not have any clue on which interface to actually transmit the packet. Is there any way to bind a (raw) socket to an interface in Haskell?

Answer 1

Network.Pcap can be used to send and receive raw data.

import qualified Data.ByteString.Char8 as B
import Network.Pcap

main = do
    -- open device
    dev <- openLive "lo" 65535 False 0
    setFilter dev "ether proto 0xFFFF" True 0

    -- send
    sendPacketBS dev (B.pack "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\255\255Hello, World!")

    -- receive
    loopBS dev (-1) (\_ packet -> putStrLn (show packet))

Answer 2

This interface is supported by Network.Socket.

Answer 3

First of all, you don't need to bind raw socket to use it. From man 7 raw

A raw socket can be bound to a specific local address using the bind(2) call. If it isn't bound, all packets with the specified IP protocol are received.

If you want to bind it, then you can use bindSocket because raw sockets use the same sockaddr structure as ip uses:

Raw sockets use the standard sockaddr_in address structure defined in ip(7)

Answer 4

Had similar task and the only way I could come with is using FFI. Current network (2.4.0.1 at the time of writing) only knows about three SockAddr families, none of which are suitable for AF_PACKET sockets. What's required is struct sockaddr_ll, which is not available.

There was a patch that added SockAddrRaw, but even though it was merget it seems that it was eventually lost.

My code is dirty (sorry, that's my first "serious" FFI code ever), but I thought I'd share it anyway.

First, I created BindPacketHack.hsc.

{-# LANGUAGE CPP, ForeignFunctionInterface #-}

module BindPacketHack (bindPacket) where

import Foreign
import Foreign.C.Types
import Foreign.C.String
import Network.Socket
import Network.Socket.Internal (zeroMemory)

#include <sys/socket.h>
#include <netpacket/packet.h>
#include <net/if.h>

data SockAddrLL = SockAddrLL { family :: CShort
                             , protocol :: CShort
                             , ifindex :: CInt }
   deriving (Eq, Show)

instance Storable SockAddrLL where
    sizeOf _    = (#size struct sockaddr_ll)
    alignment _ = alignment (undefined :: CInt)
    peek _      = error "peek is not implemented, sorry"
    poke ptr sa = do
        zeroMemory ptr (fromIntegral $ sizeOf sa)
        (#poke struct sockaddr_ll, sll_family) ptr (family sa)
        (#poke struct sockaddr_ll, sll_protocol) ptr (protocol sa)
        (#poke struct sockaddr_ll, sll_ifindex) ptr (ifindex sa)


foreign import ccall unsafe "if_nametoindex"
    c_if_nametoindex :: CString -> IO CInt

ifaceIndex :: String -> IO CInt
ifaceIndex name = withCString name c_if_nametoindex


foreign import ccall unsafe "bind"
    c_bind_ll :: CInt -> Ptr SockAddrLL -> CInt -> IO CInt

bindLL :: Socket -> SockAddrLL -> IO Integer
bindLL s sa = alloca $ \ptr -> do
    poke ptr sa
    ret <- c_bind_ll (fdSocket s) ptr (fromIntegral $ sizeOf sa)
    return $ toInteger ret


bindPacket :: Socket -> ProtocolNumber -> String -> IO ()
bindPacket s proto ifname = do
    ifindex <- ifaceIndex ifname
    bindLL s (sockAddrLL (fromIntegral proto) ifindex)
    return ()

As you might notice, the SockAddrLL is incomplete and thus my implementation is quite limited. This is because I've needed only those three fields, with the rest being zeroed out. Adding more is trivial, though.

Run hsc2hs BindPacketHack.hsc, it'll parse C header files and a .hs file will appear. Now you can use it like this:

s <- socket AF_PACKET Raw eth_PPPoEDiscovery
setFdOption (Fd $ fdSocket s) CloseOnExec True
setSocketOption s Broadcast 1
bindPacket s eth_PPPoEDiscovery "eth0"
send s rawPPPoEPacket -- don't forget Ethernet header