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