diff --git a/README b/README --- a/README +++ b/README @@ -1,12 +1,19 @@ Tools for Automotive ECU Development -tovcd - Converts several CAN formats to VCD. -todbc - Generate Vector DBC files from CAN specification. -probe - Extracts configuration and probed signals from ECU. -canview - View CAN traffic. -cansend - Send CAN message. +tovcd - Converts several CAN formats to VCD. +todbc - Generate Vector DBC files from CAN specification. +probe - Extracts configuration and probed signals from ECU. +canview - View CAN traffic. +cansend - Send CAN message. +git2cc - Bridge Git repositories to ClearCase. +commit - Git commits with ClearQuest activity annotations. + +Future Tools: + +toesb - Converts s-record ECU images to the Eaton Standard Binary format. vcdgrep - Search VCD files for signal patterns and assertion violations. brakedancer-layout - Generate a brakedancer signal layout from a VCD file. +ecush - ECU development shell. http://hackage.haskell.org/package/ecu diff --git a/ecu.cabal b/ecu.cabal --- a/ecu.cabal +++ b/ecu.cabal @@ -1,14 +1,14 @@ name: ecu -version: 0.0.0 +version: 0.0.1 category: Utils synopsis: Tools for automotive ECU development. description: - These are a collection of tools developed and used by Eaton's + This is a collection of tools developed and used by Eaton's electro-hydraulic software engineers. Most tools is this - collection and for interacting with, and analyzing vehicle + collection are for interacting with, and analyzing vehicle ECU data via a CAN bus. These tools require the Kvaser canlib library: http://www.kvaser.com/ @@ -64,6 +64,32 @@ vcd >= 0.1.4 && < 2 ghc-options: -W extensions: ForeignFunctionInterface + +executable toesb + hs-source-dirs: src + main-is: ToESB.hs + build-depends: base >= 4.2 && < 5, + bytestring >= 0.9.1 && < 0.9.2, + digest >= 0.0.0.8 && < 0.0.1 + ghc-options: -W + +executable commit + hs-source-dirs: src + main-is: Commit.hs + build-depends: base >= 4.2 && < 5 + ghc-options: -W + +executable git2cc + hs-source-dirs: src + main-is: Git2CC.hs + build-depends: base >= 4.2 && < 5, + directory >= 1.0.1 && < 1.1, + process >= 1.0.1 && < 1.1 + ghc-options: -W + +source-repository head + type: git + location: git://github.com/tomahawkins/ecu.git source-repository head type: git diff --git a/src/CANView.hs b/src/CANView.hs --- a/src/CANView.hs +++ b/src/CANView.hs @@ -1,5 +1,7 @@ module Main (main) where +import Control.Monad +import Data.Word import System.Environment import Text.Printf @@ -9,26 +11,27 @@ main = do args <- getArgs case args of - ["--std"] -> do + ["-h"] -> help + ["--help"] -> help + "--std" : ids -> do initCAN bus <- openBus 0 Standard flushRxQueue bus - canview bus - [] -> do + canview bus $ map read ids + ids -> do initCAN bus <- openBus 0 Extended flushRxQueue bus - canview bus - _ -> help + canview bus $ map read ids -canview :: Bus -> IO () -canview bus = do +canview :: Bus -> [Word32] -> IO () +canview bus ids = do m <- recvMsg bus case m of - Nothing -> canview bus - Just (t, m) -> do - putStrLn $ printf "%10i " t ++ show m - canview bus + Nothing -> canview bus ids + Just (t, m@(Msg id _)) -> do + when (null ids || elem id ids) $ putStrLn $ printf "%10i " t ++ show m + canview bus ids help :: IO () help = putStrLn $ unlines @@ -37,10 +40,12 @@ , " canview - listens to a CAN bus" , "" , "SYNOPSIS" - , " canview {argument}" + , " canview [ --std ] { }" , "" , "ARGUMENTS" , " --std Set to standard CAN with 500K. Default is extended CAN with 250K." + , "" + , " If id filters are included, only matching ids will be displayed." , "" ] diff --git a/src/Commit.hs b/src/Commit.hs new file mode 100644 --- /dev/null +++ b/src/Commit.hs @@ -0,0 +1,59 @@ +module Main (main) where + +import Data.Char +import Data.List +import System.Environment +import System.Exit +import System.Process + +help :: IO () +help = putStrLn $ unlines + [ "" + , "NAME" + , " commit - Git commits with ClearQuest activities" + , "" + , "SYNOPSIS" + , " commit [ --cqact= ] { }" + , "" + , "DESCRIPTION" + , " Performs a git commit with a comment to capture ClearQuest activity." + , " Activity format must be: ETNnnnnnnnn" + , "" + , "OPTIONS" + , " --cqact= Overrides activity id set by CQACT environment variable." + , "" + ] + +main :: IO () +main = do + args <- getArgs + case args of + [] -> help + ("-h":_) -> help + ("--help":_) -> help + (a:args) | isPrefixOf "--cqact=" a -> if isActivity act then commit act args else error $ "invalid activity format: " ++ act + where + act = drop 8 a + args -> do + env <- getEnvironment + case lookup "CQACT" env of + Just a | isActivity a -> commit a args + _ -> error "CQACT not set or not formated correctly" + +isActivity :: String -> Bool +isActivity ('E':'T':'N':a) = length a == 8 && all isDigit a +isActivity _ = False + +commit :: String -> [String] -> IO () +commit activity args = do + putStrLn cmd + system cmd >>= exitWith + where + cmd = "git commit -m " ++ activity ++ " " ++ intercalate " " (map format args) + +format :: String -> String +format a | any (flip elem " \"") a = "\"" ++ concat [ if c == '"' then "\\\"" else [c] | c <- a ] ++ "\"" + | otherwise = a + + + diff --git a/src/Git2CC.hs b/src/Git2CC.hs new file mode 100644 --- /dev/null +++ b/src/Git2CC.hs @@ -0,0 +1,227 @@ +module Main (main) where + +import Control.Monad +import Data.List +import Data.Maybe +import System.Directory +import System.Environment +import System.IO +import System.Process +import Text.Printf + +help :: IO () +help = putStrLn $ unlines + [ "" + , "NAME" + , " git2cc - bridges git repository to ClearCase" + , "" + , "SYNOPSIS" + , " git2cc " + , "" + ] + +{- +Git Notes + +git clone -q -n rcs@foell.org:git/eaton # Index but no working tree. +git checkout -q -f # Populate working tree will to a commit. +git log --decorate # List tags next to commit. + commit 123412341234 (HEAD, 1.0.3, ... + commit 123412341234 (1.0.2) + +git commit -m # Can do multiple -m arguments. Use one for ETN activity number. +-} + +main :: IO () +main = do + args <- getArgs + case args of + [repo, '/':view] -> inDirectory repo $ push $ '/' : view + [repo, view] -> do + d <- getCurrentDirectory + inDirectory repo $ push $ d ++ "/" ++ view + _ -> help + +push :: FilePath -> IO () +push view = do + lastCommit <- lastCommit view + putStrLn $ "last commit: " ++ lastCommit + hFlush stdout + commits <- getCommits >>= return . reverse . takeWhile ((/= lastCommit) . commit) + mapM_ (applyCommit view (status $ length commits)) $ zip [1..] commits + +exec :: String -> IO () +exec cmd = do + putStrLn cmd + hFlush stdout + system cmd + return () + +applyCommit :: FilePath -> (Int -> String) -> (Int, Commit) -> IO () +applyCommit view status (i, c) = do + printf "%s commit %s %s %s\n" (status i) (commit c) (activity c) (intercalate ", " $ tags c) + hFlush stdout + exec $ "git checkout -q -f " ++ commit c + from <- hashDirectory view + to <- hashDirectory "." + let cmds = [SetAct (activity c)] ++ compileCommit "./" from to ++ [CO [".commit"], Version (commit c), CI [".commit"]] ++ map BL (tags c) + mapM_ exec $ commands view cmds + +status :: Int -> Int -> String +status a b = printf f b a + where + l = length $ show a + f = "[%" ++ show l ++ "i of %" ++ show l ++ "i]" + +lastCommit :: FilePath -> IO String +lastCommit view = inDirectory view $ do + d <- getCurrentDirectory + c <- getDirectoryContents d + when (not $ elem ".commit" c) $ do + putStrLn "creating blank .commit file ..." + hFlush stdout + exec "cleartool co -nc ." + exec "touch .commit" + exec "cleartool mkelem -nc .commit" + exec "cleartool ci -identical -nc .commit" + exec "cleartool ci -identical -nc ." + a <- readProcess "cat" [".commit"] "" + return $ if null a then a else init a + +inDirectory :: FilePath -> IO a -> IO a +inDirectory path action = do + home <- getCurrentDirectory + setCurrentDirectory path + a <- action + setCurrentDirectory home + return a + +getCommits :: IO [Commit] +getCommits = readProcess "git" ["log", "--decorate=full"] "" >>= return . parseCommits + + +data Cmd + = SetAct String + | BL String + | CO [FilePath] + | CI [FilePath] + | RM FilePath + | MK FilePath + | Version String + | Mkdir FilePath + | CP FilePath + | Note String + +commands :: FilePath -> [Cmd] -> [String] +commands view cmds = map command cmds + where + command :: Cmd -> String + command cmd = case cmd of + SetAct a -> "cd " ++ view ++ " && cleartool setact " ++ a + BL baseline -> "cd " ++ view ++ " && cleartool mkbl -all -identical -full " ++ baseline ++ " && cleartool chstream -recommended " ++ baseline ++ " -cview" + CO files -> "cd " ++ view ++ " && cleartool co -nc " ++ intercalate " " files + CI files -> "cd " ++ view ++ " && cleartool ci -identical -nc " ++ intercalate " " files + RM file -> "cd " ++ view ++ " && cleartool rmname " ++ file ++ " && rm " ++ file + MK file -> "cd " ++ view ++ " && cleartool mkelem -nc " ++ file + Version commit -> "cd " ++ view ++ " && echo " ++ show commit ++ " > .commit" + Mkdir dir -> "cd " ++ view ++ " && mkdir " ++ dir + CP file -> "cp " ++ file ++ " " ++ view ++ "/" ++ file + Note note -> "echo " ++ show note + + +data Hash = Directory String [Hash] | File String String deriving (Show, Eq) + +hashDirectory :: FilePath -> IO [Hash] +hashDirectory d = inDirectory d $ do + a <- getDirectoryContents "." + a <- mapM hashFile a + return $ catMaybes a + +hashFile :: FilePath -> IO (Maybe Hash) +hashFile file | elem file [".", "..", ".git", ".commit"] = return Nothing +hashFile file = do + d <- doesDirectoryExist file + if d + then do + a <- hashDirectory file + return $ Just $ Directory file a + else do + checksum <- readProcess "md5sum" [file] "" + return $ Just $ File file checksum + +compileCommit :: FilePath -> [Hash] -> [Hash] -> [Cmd] +compileCommit path from to = concatMap patch' (align from to) + where + patch' :: (Maybe Hash, Maybe Hash) -> [Cmd] + patch' (from, to) = case (from, to) of + + -- modifications + (Just (Directory name a), Just (Directory _ b)) -> compileCommit (path ++ name ++ "/") a b + (Just (File name a), Just (File _ b)) | a /= b -> [Note $ "modifying file: " ++ path ++ name, CO [path ++ name], CP (path ++ name), CI [path ++ name]] + | otherwise -> [] + + -- removals + (Just (Directory name _), Nothing) -> [Note $ "removing directory: " ++ path ++ name, CO [path], RM (path ++ name), CI [path]] + (Just (File name _), Nothing) -> [Note $ "removing file: " ++ path ++ name, CO [path], RM (path ++ name), CI [path]] + + -- additions + (Nothing, Just (Directory name a)) -> [Note $ "adding directory: " ++ path ++ name, CO [path], Mkdir (path ++ name), MK (path ++ name), CI [path ++ name, path]] ++ compileCommit (path ++ name ++ "/") [] a + (Nothing, Just (File name _)) -> [Note $ "adding file: " ++ path ++ name, CO [path], CP (path ++ name), MK (path ++ name), CI [path ++ name, path]] + + (a, b) -> error "patch: unexpected diff pair: " $ show (a, b) + + +align :: [Hash] -> [Hash] -> [(Maybe Hash, Maybe Hash)] +align [] a = zip (replicate (length a) Nothing) (map Just a) +align a [] = zip (map Just a) (replicate (length a) Nothing) +align (file@(File name _) : a) b = (Just file, file') : align a b' + where + f (File n _) = n == name + f _ = False + (file', b') = getHash f b +align (dir@(Directory name _) : a) b = (Just dir, dir') : align a b' + where + f (Directory n _) = n == name + f _ = False + (dir', b') = getHash f b + +getHash :: (Hash -> Bool) -> [Hash] -> (Maybe Hash, [Hash]) +getHash _ [] = (Nothing, []) +getHash f (a:b) | f a = (Just a, b) + | otherwise = (a', a:b') where (a', b') = getHash f b + + +data Commit = Commit + { commit :: String + , activity :: String + , tags :: [String] + } deriving Show + +-- Parse string from 'git log --decorate=full'. +parseCommits :: String -> [Commit] +parseCommits = parseCommits . lines + where + + parseCommits :: [String] -> [Commit] + parseCommits [] = [] + parseCommits (a:b) | isPrefixOf "commit " a = Commit { commit = commit', activity = activity', tags = tags' } : commits + | otherwise = parseCommits b + where + commit' = take 40 $ drop 7 $ a + tags' = parseTags $ drop 47 a + (activity', commits) = parseActivityCommits b + + parseTags :: String -> [String] + parseTags [] = [] + parseTags a | isPrefixOf "refs/tags/" a = tag : parseTags rest + | otherwise = parseTags $ tail a + where + tag = takeWhile (flip notElem ",)") $ drop 10 a + rest = drop (10 + length tag) a + + parseActivityCommits :: [String] -> (String, [Commit]) + parseActivityCommits [] = ("ETN00000000", []) -- Misc activity. + parseActivityCommits s@(a:b) | isPrefixOf " ETN" a = (take 11 $ drop 4 a, parseCommits b) + | isPrefixOf "commit " a = (activity $ head $ parseCommits s, parseCommits s) + | otherwise = parseActivityCommits b + diff --git a/src/ToESB.hs b/src/ToESB.hs new file mode 100644 --- /dev/null +++ b/src/ToESB.hs @@ -0,0 +1,86 @@ +module Main (main) where + +import Data.Bits +import qualified Data.ByteString as BS +import Data.Char +import Data.Digest.CRC32 +import Data.List +import Data.Word +import System.Environment +import Text.Printf + +help :: IO () +help = putStrLn $ unlines + [ "" + , " NAME" + , " toesb - converts an s-record ecu image to the Eaton Standard Binary (ESB) format" + , "" + , " SYNOPSIS" + , " toesb [ --nocrc ] " + , "" + , " OPTIONS" + , " --nocrc Ignore CRC checking on s-record." + , "" + ] + + +main :: IO () +main = do + args <- getArgs + case args of + [i] -> readFile i >>= srec2esb (out i) True + ["--nocrc", i] -> readFile i >>= srec2esb (out i) False + _ -> help + +out :: FilePath -> FilePath +out a = takeWhile (/= '.') a ++ ".esb" + +srec2esb :: FilePath -> Bool -> String -> IO () +srec2esb o checkCRC a = do + printf "section address section length\n" + sequence_ [ printf "0x%08X 0x%08X\n" a (length b) | (a, b) <- a3 ] + putStrLn $ "writing " ++ o ++ " ..." + BS.writeFile o $ BS.pack $ map fromIntegral file + where + a1 = [ (dehex $ init $ init $ drop 2 a, head $ dehex $ reverse $ take 2 $ reverse a) | l <- lines a, let a = filter isAlphaNum l, isPrefixOf "S3" a ] + a2 = concatMap (addr checkCRC) a1 + a3 = [ (a, b) | (a, b) <- blocks a2, a >= 0x10000, a <= 0x7FFFF ] + n = length a3 + allBlocks = le n ++ concatMap j1939Block a3 + fileCRC = fromIntegral $ crc32 $ (map fromIntegral allBlocks :: [Word8]) + file = [0xE5, 0x5B, 0xBE, 0xE5, 5, 0, 0, 0] ++ le fileCRC ++ allBlocks + +addr :: Bool -> ([Int], Int) -> [(Int, Int)] -- (addr, byte) +addr checkCRC (a, checksum) = if checkCRC && complement (sum a) .&. 0xFF /= checksum then error $ "failed checksum: " ++ show (a, checksum) else zip addrs bytes + where + base = shiftL (a !! 1) 24 + + shiftL (a !! 2) 16 + + shiftL (a !! 3) 8 + + (a !! 4) + addrs = [base ..] + bytes = drop 5 a + +blocks :: [(Int, a)] -> [(Int, [a])] +blocks [] = [] +blocks ((addr, byte) : rest) = section : blocks rest' + where + (section, rest') = block (addr + 1) (addr, [byte]) rest + +block :: Int -> (Int, [a]) -> [(Int, a)] -> ((Int, [a]), [(Int, a)]) +block nextAddr (startingAddr, sofar) ((a, b):rest) | a == nextAddr = block (nextAddr + 1) (startingAddr, b : sofar) rest +block _ (a, b) rest = ((a, reverse b), rest) + +dehex :: String -> [Int] +dehex "" = [] +dehex (a:b:c) = read ("0x" ++ [a,b]) : dehex c +dehex _ = undefined + + +j1939Block :: (Int, [Int]) -> [Int] +j1939Block (addr, d) = [3, 0, 0, 0] ++ le (shiftL (addr - 0x10000) 8 .&. 0xFFFFFF00 .|. 128) ++ le (length d) ++ d + +le :: Int -> [Int] +le a = [ a .&. 0xFF] + ++ [shiftR a 8 .&. 0xFF] + ++ [shiftR a 16 .&. 0xFF] + ++ [shiftR a 24 .&. 0xFF]