packages feed

ecu 0.0.0 → 0.0.1

raw patch · 6 files changed

+430/−20 lines, 6 filesdep +directorydep +processnew-component:exe:commitnew-component:exe:git2ccnew-component:exe:toesb

Dependencies added: directory, process

Files

README view
@@ -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
ecu.cabal view
@@ -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
src/CANView.hs view
@@ -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 ] { <id-filter> }"   , ""   , "ARGUMENTS"   , "  --std          Set to standard CAN with 500K.  Default is extended CAN with 250K."+  , ""+  , "  <id-filter>    If id filters are included, only matching ids will be displayed."    , ""   ]
+ src/Commit.hs view
@@ -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=<activity id> ] { <git commit arguments> }"+  , ""+  , "DESCRIPTION"+  , "  Performs a git commit with a comment to capture ClearQuest activity."+  , "  Activity format must be: ETNnnnnnnnn"+  , ""+  , "OPTIONS"+  , "  --cqact=<activity id>    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+++
+ src/Git2CC.hs view
@@ -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-directory> <cc-view-directory>"+  , ""+  ]++{-+Git Notes++git clone -q -n rcs@foell.org:git/eaton  # Index but no working tree.+git checkout -q -f <commit>              # 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 <msg> 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+
+ src/ToESB.hs view
@@ -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 ] <input-file>"+  , ""+  , "  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]