~amindfv/jmms

8eefc1e4d335f8e2478274da670902200c10de1b — amindfv 5 months ago 9145d1e master
Add "--rm-oldest-stubborn" command for stubborn SMS that fail to arrive and clog modem
1 files changed, 57 insertions(+), 13 deletions(-)

M jmms.hs
M jmms.hs => jmms.hs +57 -13
@@ 45,6 45,8 @@ mainWSend canSend = getArgs >>= \case
             Just x -> x
             Nothing -> error $ "Couldn't read as list of strings: "++show list
      removeMessages ls
   ["--rm-oldest-stubborn"] ->
      removeOldestStubbornSMS
   ["--read"] -> readUnreadMessages canSend
   ["--poll", numMinutesStr] ->
      case readMaybe numMinutesStr of


@@ 55,7 57,7 @@ mainWSend canSend = getArgs >>= \case
            putStrLn $ (printf "%0.2d:%0.2d" (todHour z) (todMin z))++ ": Waiting "++show numMinutes++" minutes..."
            delay (numMinutes * 60 * (10^(6::Int)))
   ["--thread"] -> readThreads canSend
   args -> error $ "not understood: " ++ show args++"; should be (--get | --read | --poll [num minutes] | --rm [msg ids] | --thread)"
   args -> error $ "not understood: " ++ show args++"; should be (--get | --read | --poll [num minutes] | --rm [msg ids] | --rm-oldest-stubborn | --thread)"

-- arg could be list of ints instead of strings:
removeMessages :: [String] -> IO ()


@@ 71,6 73,23 @@ removeMessages ls = do
               notificationAction $ "jmms: error removing sms"
         pure ()

-- Assumption is that "0" is older than "1", etc.:
removeOldestStubbornSMS :: IO ()
removeOldestStubbornSMS = do
   withModemNum $ \modemNum -> do
      messageLinesFromModemNum modemNum >>= \case
         Nothing -> pure ()
         Just messageLines ->
            let smsNums = map parseModemNum $ filter isReceiving messageLines
            in case L.sortOn (read::String->Int) smsNums of
                  [] -> putStrLn "No stubborn SMSes!"
                  (oldestMessageNum:_) -> do
                     nowStr <- getNowString
                     let fName = smsPathFromNowStr nowStr oldestMessageNum
                     putStrLn $ "Attempting to save SMS as "++show fName++"..."
                     print =<< getSMSByNum modemNum oldestMessageNum fName
                     removeMessages [oldestMessageNum]

main' :: IO ()
main' = do
   createDirectoryIfMissing True smsDir


@@ 99,15 118,28 @@ main' = do
-}
   getMessages


getMessages :: IO ()
getMessages = withModemNum $ \modemNum -> do
messageLinesFromModemNum :: String -> IO (Maybe [String])
messageLinesFromModemNum modemNum = do
   -- putStrLn $ "Modem #: "++show modemNum
   putStrLn ""
   readProcessWithExitCode "mmcli" ["-m", modemNum, "--messaging-list-sms"] "" >>= \case
      -- TODO: print _err:
      (ExitSuccess, lines -> messageLines, _err) -> do
         pure (Just messageLines)
      e -> do
         putStrLn $ "Couldn't get sms list: "++show e
         pure Nothing

isReceiving :: String -> Bool
isReceiving = (" (receiving)"  `L.isSuffixOf`)

getMessages :: IO ()
getMessages =  withModemNum $ \modemNum ->
   messageLinesFromModemNum modemNum >>= \case
      Nothing -> pure ()
      Just messageLines -> do
         -- TODO: dedupe this whole thing - or maybe use StateT:
         let (receiving, notReceiving) = L.partition (" (receiving)"  `L.isSuffixOf`) messageLines
         let (receiving, notReceiving) = L.partition isReceiving messageLines
         case receiving of
            [] -> pure ()
            _ -> putStrLn $ show (len receiving) ++ " messages in \"receiving\" state"


@@ 136,14 168,13 @@ getMessages = withModemNum $ \modemNum -> do
               putStrLn $ show (len receivedLines) ++ " messages in \"received\" state - fetching..."
               _ <- getMmMessages -- Do this before 'getMessageNums' because that step `git-annex-save`s
               getMessageNums modemNum $ map parseModemNum receivedLines
      e -> putStrLn $ "Couldn't get sms list: "++show e

-- Monomorphic:
len :: [x] -> Int
len = length

fetchMMS :: FilePath -> IO (Maybe FilePath)
fetchMMS fPath = do
tryToFetchMMS :: FilePath -> IO (Maybe FilePath)
tryToFetchMMS fPath = do
      doesFileExist fPath >>= \case
         True -> do
            contents <- BS.readFile fPath


@@ 232,7 263,7 @@ getMmMessages = do
   let newMmMessages = mmSmsFiles L.\\ fetchedMmMms

   newMessageSuccesses <- (catMaybes <$>) $ (`mapM` newMmMessages) $ \newMmMessage -> do
      r <- fetchMMS (mmMMSDir++"/"++newMmMessage)
      r <- tryToFetchMMS (mmMMSDir++"/"++newMmMessage)
      case r of
         Just _ -> do
            putStrLn $ "Got msg: "++show newMmMessage


@@ 257,15 288,28 @@ gitAnnexAddMMS = do
      ExitSuccess -> pure ()
      e -> notificationAction $ "jmms: unable to save: "++show e

getNowString :: IO String
getNowString =
   (filter (`elem`['0'..'9']) . show) <$> getCurrentTime

-- TODO: newtypes:
getSMSByNum :: String -> String -> FilePath -> IO (ExitCode, String, String)
getSMSByNum modemNum messageNum fPath = do
   readProcessWithExitCode "mmcli" ["-m", modemNum, "-s", messageNum, "--create-file-with-data="++fPath] ""

smsPathFromNowStr :: String -> String -> FilePath
smsPathFromNowStr nowStr messageNum =
   smsDir++"/sms-"++nowStr++"-"++messageNum++".dat"

getMessageNums :: String -> [String] -> IO ()
getMessageNums modemNum messageNums = do
   putStrLn $ "Attempting to get message numbers: "++show messageNums
   nowStr <- (filter (`elem`['0'..'9']) . show) <$> getCurrentTime
   nowStr <- getNowString
   msgSuccesses <- (catMaybes <$>) $ forM messageNums $ \messageNum -> do
      let fPath = smsDir++"/sms-"++nowStr++"-"++messageNum++".dat"
      let fPath = smsPathFromNowStr nowStr messageNum
      -- This will fail if it's a regular SMS - i.e. it's a text message not a binary MMS info message
      print =<< readProcessWithExitCode "mmcli" ["-m", modemNum, "-s", messageNum, "--create-file-with-data="++fPath] ""
      r <- fetchMMS fPath
      print =<< getSMSByNum modemNum messageNum fPath
      r <- tryToFetchMMS fPath
      pure $ (\x-> (messageNum,x)) <$> r

   gitAnnexAddMMS