System.USB: 来自设备的串口

Question

我正在使用 usb-1.3.0.4 / System.USB。扫描并选择了相关的串行USB设备后，如何找到相应的串行端口（例如Windows上的COM3）？

这是我所追求的示例：

module Main (main) where

import System.USB
import System.Hardware.Serialport
import qualified Data.Vector as V
import Data.Maybe

main :: IO ()
main = do
    devicePort 0x2341 0x0043 >>= either putStrLn usePort
    where usePort p = do
              s <- openSerial p defaultSerialSettings
              putStrLn $ "opened serial port " ++ p
              closeSerial s

-- | Find port for attached USB serial device
devicePort :: VendorId -> ProductId -> IO (Either String FilePath)
devicePort vid pid = do
    ctx <- newCtx
    findDevice ctx vid pid >>= \md -> case md of
        Just dev -> fmap (maybe (Left "not a serial device") Right) $ serialPort dev
        Nothing -> return $ Left "device not found"

-- | Scan for first device with given vendor and product identifiers
findDevice :: Ctx -> VendorId -> ProductId -> IO (Maybe Device)
findDevice ctx vid pid = fmap (listToMaybe . V.toList) $ V.filterM p =<< getDevices ctx
    where p x = do
              d <- getDeviceDesc x
              return $ deviceVendorId d == vid && deviceProductId d == pid

serialPort :: Device -> IO (Maybe FilePath)
serialPort dev = undefined

最后一个函数的可能实现是什么？

Answer 1

如果实在无法通过其他方式解决，请无视本回答

您应该考虑其他选择。您无需扫描与特定供应商或产品 ID 匹配的设备，而是可以简单地接受串行接口的名称作为程序的参数或作为可配置选项。在 Windows 上，它的形式是 "COMx"，而在 Unix 上，它只是一个路径。

此外，串行接口可能并不总是USB设备，这会阻止您通过扫描USB设备来枚举PCI或集成串行端口。此外，将值硬编码到源代码中会在设备稍后被其他设备替换时带来痛苦的更新。

静态端口命名

如果您使用 Windows，分配一个自定义接口编号（例如 COM7）应该会在您拔下接口或重新启动计算机时保持不变。在 Linux 上，它有点做作：您可以添加一个与产品和供应商 ID 相匹配的 Udev 规则，这样它将创建一个具有自定义名称的节点，例如 /dev/arduinoN。我强烈建议您采用这种方法，因为提供手动路径或修改 Udev 文件（可以说）比重新编译您的应用程序更容易。我知道一个 DMX 产品可以做到这一点：因为它使用现成的 FTDI 接口，它附带了一个匹配该供应商和产品 ID 的规则，并重命名了节点 /dev/dmxN。虽然规则与其他 FTDI 接口冲突，但在您的情况下不会，因为 Arduino 有自己的产品和供应商 ID 分配。

Answer 2

您需要在注册表中搜索您的设备。在密钥 HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum 下有多个密钥（在大多数情况下是 USB，但有时驱动程序将其安装在不同的子密钥中），它们本身包含格式为 VID_xxxx&PID_xxxx 的密钥。你必须先找到这把钥匙。它很可能类似于 HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\USB\VID_xxxx&PID_xxxx.

此键本身包含新的子键。这些子键包含一个名为 Device Parameters 的键，其中包含所需的键值对 PortName，端口类似于 COM3。

遗憾的是，我不知道 Haskell 是如何做到的。

Answer 3

根据 dryman 的建议和一些挖掘，我完全放弃了 usblib，并在 Windows 上直接通过注册表实现（我将在 Linux 改天）：

{-# LANGUAGE RecordWildCards #-}
module USBSerial (USBSerial(..), usbSerials) where

import System.Win32.Registry (hKEY_LOCAL_MACHINE, regOpenKey, regCloseKey, regQueryValue, regQueryValueEx)
import System.Win32.Types (DWORD, HKEY)
import Control.Exception (handle, bracket, SomeException(..))
import Foreign (toBool, Storable(peek, sizeOf), castPtr, alloca)
import Data.List.Split (splitOn)
import Data.List (stripPrefix)
import Numeric (readHex, showHex)
import Data.Maybe (catMaybes)
import Control.Monad (forM)

data USBSerial = USBSerial
    { key           :: String
    , vendorId      :: Int
    , productId     :: Int
    , portName      :: String
    , friendlyName  :: String
    }

instance Show USBSerial where
    show USBSerial{..} = unwords [ portName, toHex vendorId, toHex productId, friendlyName ]
        where toHex x = let s = showHex x "" in replicate (4 - length s) '0' ++ s

usbSerials :: Maybe Int -> Maybe Int -> IO [USBSerial]
usbSerials mVendorId mProductId = withHKey hKEY_LOCAL_MACHINE path $ \hkey -> do
    n <- regQueryValueDWORD hkey "Count"
    fmap catMaybes $ forM [0..n-1] $ \i -> do
        key <- regQueryValue hkey . Just . show $ i
        case keyToVidPid key of
            Just (vendorId, productId)
                | maybe True (==vendorId) mVendorId && maybe True (==productId) mProductId -> do
                    portName <- getPortName key
                    friendlyName <- getFriendlyName key
                    return $ Just USBSerial{..}
            _ -> return Nothing
    where path = "SYSTEM\CurrentControlSet\Services\usbser\Enum"

getPortName :: String -> IO String
getPortName serial = withHKey hKEY_LOCAL_MACHINE path $ flip regQueryValue (Just "PortName")
    where path = "SYSTEM\CurrentControlSet\Enum\" ++ serial ++ "\Device Parameters"

getFriendlyName :: String -> IO String
getFriendlyName serial = withHKey hKEY_LOCAL_MACHINE path $ flip regQueryValue (Just "FriendlyName")
    where path = "SYSTEM\CurrentControlSet\Enum\" ++ serial

keyToVidPid :: String -> Maybe (Int, Int)
keyToVidPid name
    | (_:s:_) <- splitOn "\" name
    , (v:p:_) <- splitOn "&" s
    , Just v <- fromHex =<< stripPrefix "VID_" v
    , Just p <- fromHex =<< stripPrefix "PID_" p = Just (v, p)
    | otherwise = Nothing
    where fromHex s = case readHex s of
            [(x, "")] -> Just x
            _         -> Nothing

withHKey :: HKEY -> String -> (HKEY -> IO a) -> IO a
withHKey hive path = handle (\(SomeException e) -> error $ show e) . bracket (regOpenKey hive path) regCloseKey

-- | Read DWORD value from registry.
-- From http://compgroups.net/comp.lang.haskell/working-with-the-registry-windows-xp/2579164
regQueryValueDWORD :: HKEY -> String -> IO DWORD
regQueryValueDWORD hkey name = alloca $ \ptr -> do
    regQueryValueEx hkey name (castPtr ptr) (sizeOf (undefined :: DWORD))
    peek ptr

例如：

main :: IO ()
main = usbSerials (Just 0x2341) Nothing >>= mapM_ print

产生如下输出：

COM7 2341 8036 Arduino Leonardo (COM7)
COM3 2341 0043 Arduino Uno (COM3)

System.USB: 来自设备的串口

System.USB: serial port from Device

haskell

libusb

静态端口命名