From a5fad52f1e1ca6d8ebfcbb448f19014225368777 Mon Sep 17 00:00:00 2001 From: "jim@bo" Date: Sun, 24 Jun 2018 17:18:38 -0400 Subject: new interval comand, modifies all intervals at once session 0 interval -- shows the values of intervals on session 0 session 0 interval 0.5 -- half all the intervals on session 0 --- examples/dhtd.hs | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'examples') diff --git a/examples/dhtd.hs b/examples/dhtd.hs index db56ec24..bf7d7162 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs @@ -764,6 +764,30 @@ clientSession s@Session{..} sock cnum h = do _ -> hPutClient h $ "Invalid " ++ key ++ " value: " ++ val + -- session interval factor + ("session",s) | (idStr,"interval",unstripped) <- twoWords s + , val <- strp unstripped + -> cmd0 $ do + lrSession <- strToSession idStr + let displayIntervals session = atomically $ do + intervals <- forM [Tox.ncRequestInterval,Tox.ncAliveInterval, Tox.ncIdleEvent, Tox.ncTimeOut] $ \i -> readTVar (i session) + let keys = ["ncRequestInterval","ncAliveInterval","ncIdleEvent","ncTimeOut"] + return (intercalate "\n" $ + map (\(key,val) -> "Session " ++ idStr ++ ": " ++ key ++ " = " ++ val) + (zip keys (map show intervals))) + case lrSession of + Left s -> hPutClient h s + Right session -> do + case readMaybe val of + Just (factor::Double) -> do + atomically $ do + modifyTVar (Tox.ncRequestInterval session) (round . (*factor) . fromIntegral) + modifyTVar (Tox.ncAliveInterval session) (round . (*factor) . fromIntegral) + modifyTVar (Tox.ncIdleEvent session) (round . (*factor) . fromIntegral) + modifyTVar (Tox.ncTimeOut session) (round . (*factor) . fromIntegral) + displayIntervals session >>= hPutClient h + _ -> displayIntervals session >>= hPutClient h . (("No parse (" ++ show val ++ ").\n") ++) + -- report error when setting invalid keys ("session",s) | (idStr,"set",unstripped) <- twoWords s , (key,val,unstripped2) <- twoWords unstripped -- cgit v1.2.3