Haskell中的原始套接字

Question

Network.Socket中提供了一个原始套接字类型，但在接近绑定套接字处有一条注释“目前只支持Unix域套接字和Internet系列”。我如何在Haskell中使用原始套接字？

我所试图实现的，如工作Python代码：

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： 在Haskell，我用sock <- socket AF_PACKET Raw 0xFFFF创建一个套接字，但bindSocket需要SockAddr作为参数，为此可用的构造函数是

SockAddrInet PortNumber HostAddress 
SockAddrInet6 PortNumber FlowInfo HostAddress6 ScopeID 
SockAddrUnix String 

但这些似乎都没有。

EDIT2： 由于评论由Yuras我得到了接收数据包的工作：

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

EDIT3： 试图发送从套接字的数据包，而不结合它导致异常：

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) 

这很有意义，因为内核不会在实际传输数据包的接口上有任何线索。有没有办法将（原始）套接字绑定到Haskell中的接口？

Answer 1

Network.Pcap可用于发送和接收原始数据。

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

此接口由Network.Socket支持。

Answer 3

首先，你不需要绑定原始套接字来使用它。 From man 7 raw

使用bind（2）调用可以将原始套接字绑定到特定的本地地址。如果未绑定，则接收所有具有指定IP协议的数据包。

如果你要绑定，那么你可以使用bindSocket因为原始套接字使用相同的sockaddr结构ip用途：

原始套接字使用IP定义的标准sockaddr_in的地址结构（7）

Answer 4

有类似的任务，我唯一的方法就是使用FFI。目前的network（撰写本文时为2.4.0.1）只知道三个SockAddr家族，其中没有一个适合AF_PACKET插座。需要的是struct sockaddr_ll，这是不可用的。

有一个patch that added SockAddrRaw，但即使它是merget它似乎是最终失去了。

我的代码是脏的（不好意思，这是我的第一个“严肃”的FFI代码曾经），但我想我反正分享。我建立了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() 

正如你可能会注意到，在SockAddrLL是不完整的，因此我的实现是相当有限的。这是因为我只需要这三个字段，剩下的字段被清零。虽然增加更多是微不足道的。

运行hsc2hs BindPacketHack.hsc，它会解析C头文件，并出现一个.hs文件。现在你可以像这样使用它：

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