iptadmin 1.0.1 → 1.1.0
raw patch · 18 files changed
+286/−74 lines, 18 filesdep ~iptables-helpers
Dependency ranges changed: iptables-helpers
Files
- Changelog +3/−0
- html/htmlwrapper.html +9/−2
- iptadmin.cabal +3/−3
- src/IptAdmin/AccessControl.hs +3/−3
- src/IptAdmin/AddChainPage.hs +1/−1
- src/IptAdmin/AddPage.hs +3/−3
- src/IptAdmin/DelPage.hs +1/−1
- src/IptAdmin/EditChainPage.hs +1/−1
- src/IptAdmin/EditPage.hs +3/−3
- src/IptAdmin/EditPolicyPage.hs +2/−2
- src/IptAdmin/InsertPage.hs +3/−3
- src/IptAdmin/LoginPage.hs +9/−1
- src/IptAdmin/ShowPage.hs +98/−18
- src/IptAdmin/ShowPage/Render.hs +110/−24
- src/IptAdmin/System.hs +8/−7
- src/IptAdmin/Types.hs +6/−0
- src/IptAdmin/Utils.hs +14/−0
- src/Template.hs +9/−2
Changelog view
@@ -1,3 +1,6 @@+Iptadmin 1.1.0 07.09.2011:+ * Display counters in show page.+ Iptadmin 1.0.1 14.07.2011: * Add command line options --version, --help. * Syslog logging.
html/htmlwrapper.html view
@@ -3,10 +3,10 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml"> <head>- <title>Iptables Manager</title>+ <title>IptAdmin</title> <meta name="AUTHOR" content="Evgeny Tarasov" /> <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />- <meta name="DESCRIPTION" content="description"/>+ <meta name="DESCRIPTION" content="iptables web interface"/> <meta name="KEYWORDS" content="iptables, haskell" /> <style type="text/css"> body {@@ -133,6 +133,9 @@ max-width: 1000px; padding-top: 10px; }+ input.resetButton {+ padding: 0;+ } div.loginForm { /*float: left; margin-left: auto;@@ -177,6 +180,10 @@ } table.editForm { border: 1px solid #666666;+ }+ th.col0 {+ width : 5px;+ padding: 0; } th.col1 { width : 15px;
iptadmin.cabal view
@@ -1,5 +1,5 @@ Name: iptadmin-Version: 1.0.1+Version: 1.1.0 Cabal-Version: >= 1.4 Author: Evgeny Tarasov Build-type: Simple@@ -10,7 +10,7 @@ HomePage: http://iptadmin.confmgr.org Stability: Stable Synopsis: web-interface for iptables-Description: web-interface for iptables based on happstack with PAM authorisation+Description: web-interface for iptables with PAM authorization Category: System, Tools, Web Extra-source-files: html/htmlwrapper.html, util/ptmpl/Setup.hs,@@ -34,7 +34,7 @@ happstack-util >= 0.5 && < 0.5.1, mtl >= 1.1, safe >= 0.3,- iptables-helpers >= 0.3 && < 0.4,+ iptables-helpers >= 0.4 && < 0.5, process >= 1.0 && < 2, blaze-html >= 0.4, parsec >= 2.1,
src/IptAdmin/AccessControl.hs view
@@ -30,17 +30,17 @@ if isAuthorised then -- Run IptAdmin monad with state- mapServerPartT (addStateToTheStack (fromJust clientIdMay, sessionsIORef, config)) requestHandler+ mapServerPartT (addStateToStack (fromJust clientIdMay, sessionsIORef, config)) requestHandler else msum [ dir "login" $ LoginPage.pageHandlers (IptAdmin.AccessControl.authenticate $ cPamName config) sessionsIORef , redir "/login" ] where- addStateToTheStack :: (Monad m) => MainState+ addStateToStack :: (Monad m) => MainState -> UnWebT (ErrorT String (StateT MainState m)) a -> UnWebT (ErrorT String m) a- addStateToTheStack mainState statefulAction =+ addStateToStack mainState statefulAction = mapErrorT (addStateToStack' mainState) statefulAction addStateToStack' :: (Monad m) => MainState
src/IptAdmin/AddChainPage.hs view
@@ -57,5 +57,5 @@ editChainForm (tableName, "") newChainName' $ Just "The name is valid" "Submit" -> do tryChange $ addChain tableName newChainName'- redir $ "/show?table=" ++ tableName+ redir $ "/show?table=" ++ tableName ++ bookmarkForJump newChainName' Nothing a -> throwError $ "Invalid value for 'submit' parameter: " ++ a
src/IptAdmin/AddPage.hs view
@@ -57,7 +57,7 @@ editFormHtml (tableName, chainName, 0, userChainNames) addFormParams $ Just formMes Right (options, target, formMes) -> do let (_, options') = runState (mapM_ completeModules options) options- let rule = Rule options' target+ let rule = Rule (Counters 0 0) options' target submit <- getInputString "submit" case submit of@@ -66,10 +66,10 @@ ++ chainName ++ "' chain in '" ++ tableName ++ "' table" editFormHtml (tableName, chainName, 0, userChainNames) addFormParams $ Just formMes- ) ++ printRuleCanonical rule+ ) ++ printRuleForRun rule "Submit" -> do tryChange (appendRule tableName chainName rule)- redir $ "/show?table=" ++ tableName+ redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName Nothing a -> throwError $ "Wrong value for 'submit' parameter: " ++ a checkParams :: [Chain] -> String -> IptAdmin ()
src/IptAdmin/DelPage.hs view
@@ -44,7 +44,7 @@ _ <- checkParams tableName chainName rulePosition tryChange (deleteRule tableName chainName rulePosition)- redir $ "/show?table=" ++ tableName+ redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName (Just rulePosition) checkParams :: String -> String -> Int -> IptAdmin (Chain, Rule) checkParams tableName chainName rulePosition = do
src/IptAdmin/EditChainPage.hs view
@@ -68,5 +68,5 @@ editChainForm (tableName, chainName) newChainName' $ Just "The name is valid" "Submit" -> do tryChange $ renameChain tableName chainName newChainName'- redir $ "/show?table=" ++ tableName+ redir $ "/show?table=" ++ tableName ++ bookmarkForJump newChainName' Nothing a -> throwError $ "Invalid value for 'submit' parameter: " ++ a
src/IptAdmin/EditPage.hs view
@@ -61,7 +61,7 @@ editFormHtml (tableName, chainName, rulePosition, userChainNames) addFormParams $ Just formResp Right (opts, tar, formResp) -> do let (_, opts') = runState (mapM_ completeModules opts) opts- let rule = Rule opts' tar+ let rule = Rule (Counters 0 0) opts' tar submit <- getInputString "submit" case submit of@@ -70,10 +70,10 @@ ++ "' table in '" ++ chainName ++ "' chain in position " ++ show rulePosition editFormHtml (tableName, chainName, rulePosition, userChainNames) addFormParams $ Just formResp- ) ++ printRuleCanonical rule+ ) ++ printRuleForRun rule "Submit" -> do tryChange (replaceRule tableName chainName rulePosition rule)- redir $ "/show?table=" ++ tableName+ redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName (Just rulePosition) a -> throwError $ "Invalid value for 'submit' parameter: " ++ a checkParams :: String -> String -> Int -> IptAdmin ([Chain], Chain, Rule)
src/IptAdmin/EditPolicyPage.hs view
@@ -58,7 +58,7 @@ -- 3. Если изменилось, применить изменения if newPolicy == policy- then redir $ "/show?table=" ++ tableName+ then redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName Nothing else do tryChange (setPolicy tableName chainName newPolicy)- redir $ "/show?table=" ++ tableName+ redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName Nothing
src/IptAdmin/InsertPage.hs view
@@ -61,7 +61,7 @@ editFormHtml (tableName, chainName, rulePosition, userChainNames) editFormParams $ Just formResp Right (opts, tar, formResp) -> do let (_, opts') = runState (mapM_ completeModules opts) opts- let rule = Rule opts' tar+ let rule = Rule (Counters 0 0)opts' tar submit <- getInputString "submit" case submit of@@ -71,10 +71,10 @@ ++ chainName ++ "' chain in position " ++ show rulePosition editFormHtml (tableName, chainName, rulePosition, userChainNames) editFormParams $ Just formResp- ) ++ printRuleCanonical rule+ ) ++ printRuleForRun rule "Submit" -> do tryChange (insertRule tableName chainName rulePosition rule)- redir $ "/show?table=" ++ tableName+ redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName (Just rulePosition) a -> throwError $ "Invalid value for 'submit' parameter: " ++ a checkParams :: [Chain] -> String -> Int -> IptAdmin ()
src/IptAdmin/LoginPage.hs view
@@ -11,6 +11,7 @@ import Happstack.Server.SimpleHTTP import Template import IptAdmin.Render+import IptAdmin.System import IptAdmin.Types import IptAdmin.Utils import System.Random@@ -55,8 +56,15 @@ addCookie (60 * 60 * 24 * 365 * 10) sessionIdCookie -- 3. Обновляем состояние curTime <- liftIO getCurrentTime+ iptables <- getIptables _ <- liftIO $ atomicModifyIORef sessionsIORef- (\ m -> (insert sessionId (Session curTime Nothing) m, ()))+ (\ m -> ( insert sessionId (Session curTime+ Nothing+ iptables+ ) m+ , ()+ )+ ) -- 4. Редиректим на /show redir "/show"
src/IptAdmin/ShowPage.hs view
@@ -3,6 +3,9 @@ module IptAdmin.ShowPage where import Control.Monad.Error+import Control.Monad.State+import Data.IORef+import Data.Map import Happstack.Server.SimpleHTTP import Template import IptAdmin.Render@@ -12,6 +15,7 @@ import IptAdmin.Utils import Iptables import Iptables.Types+import System.Random import Text.Blaze import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A@@ -28,39 +32,115 @@ iptables <- getIptables + countType <- do+ setCountType <- getInputOrEmptyString "countersType"+ case setCountType of+ "bytes" -> do+ let countTypeCookie = mkCookie "countersType" "Bytes"+ addCookie (60 * 60 * 24 * 365 * 10) countTypeCookie+ return CTBytes+ "packets" -> do+ let countTypeCookie = mkCookie "countersType" "Packets"+ addCookie (60 * 60 * 24 * 365 * 10) countTypeCookie+ return CTPackets+ _ -> do+ countTypeMay <- getDataFn $ lookCookieValue "countersType"+ case countTypeMay of+ Nothing -> return CTPackets+ Just "Bytes" -> return CTBytes+ _ -> return CTPackets++ (sessionId, sessionsIO, _) <- lift get+ sessions <- liftIO $ readIORef sessionsIO+ let session = sessions Data.Map.! sessionId++ iptables' <- if sIptables session /= iptables+ then+ liftIO $ atomicModifyIORef sessionsIO $+ \ sessions' ->+ ( insert sessionId (session {sIptables = iptables}) sessions'+ , iptables)+ else+ return $ sIptables session+ case table of- "" -> showFilter iptables- "filter" -> showFilter iptables- "nat" -> showNat iptables- "mangle" -> showMangle iptables+ "" -> showFilter countType iptables iptables'+ "filter" -> showFilter countType iptables iptables'+ "nat" -> showNat countType iptables iptables'+ "mangle" -> showMangle countType iptables iptables' "raw" -> throwError "We're sorry, the Raw table is not supported yet" a -> throwError $ "Invalid table parameter: " ++ a -showFilter :: Iptables -> IptAdmin Response-showFilter iptables = do- let filter' = renderTable ("filter", "Filter") $ sortFilterTable $ tFilter iptables+maxPacketCounterDiff :: [(Chain, Chain)] -> Integer+maxPacketCounterDiff [] = 0+maxPacketCounterDiff ((x,x'):xs) = max (maxPacketCounterDiff' (x,x')) (maxPacketCounterDiff xs)+ where+ maxPacketCounterDiff' :: (Chain, Chain) -> Integer+ maxPacketCounterDiff' (Chain _ _ (Counters p _) rs, Chain _ _ (Counters p' _) rs') = max (p - p') (maxPacketCounterDiff'' $ zip rs rs')++ maxPacketCounterDiff'' :: [(Rule, Rule)] -> Integer+ maxPacketCounterDiff'' [] = 0+ maxPacketCounterDiff'' ((Rule (Counters p _) _ _, Rule (Counters p' _) _ _):rs) = max (p - p') (maxPacketCounterDiff'' rs)++showFilter :: CountersType -> Iptables -> Iptables -> IptAdmin Response+showFilter countType iptables iptables' = do+ refreshString <- liftIO $ show `fmap` (randomRIO (1,100000) :: IO Int)+ let filter' = renderTable ("filter", "Filter")+ countType+ (maxPacketCounterDiff $ zip (sortFilterTable $ tFilter iptables) (sortFilterTable $ tFilter iptables'))+ refreshString+ (sortFilterTable $ tFilter iptables)+ (sortFilterTable $ tFilter iptables') return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do header "filter" "Iptables Filter table" showPageHtml filter' -showNat :: Iptables -> IptAdmin Response-showNat iptables = do- let nat = renderTable ("nat", "Nat") $ sortNatTable $ tNat iptables+showNat :: CountersType -> Iptables -> Iptables -> IptAdmin Response+showNat countType iptables iptables' = do+ refreshString <- liftIO $ show `fmap` (randomRIO (1,100000) :: IO Int)+ let nat = renderTable ("nat", "Nat")+ countType+ (maxPacketCounterDiff $ zip (sortNatTable $ tNat iptables) (sortNatTable $ tNat iptables'))+ refreshString+ (sortNatTable $ tNat iptables)+ (sortNatTable $ tNat iptables') return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do header "nat" "Iptables Nat table" showPageHtml nat -showMangle :: Iptables -> IptAdmin Response-showMangle iptables = do- let mangle = renderTable ("mangle", "Mangle") $ sortMangleTable $ tMangle iptables+showMangle :: CountersType -> Iptables -> Iptables -> IptAdmin Response+showMangle countType iptables iptables' = do+ refreshString <- liftIO $ show `fmap` (randomRIO (1,100000) :: IO Int)+ let mangle = renderTable ("mangle", "Mangle")+ countType+ (maxPacketCounterDiff $ zip (sortMangleTable $ tMangle iptables) (sortMangleTable $ tMangle iptables'))+ refreshString+ (sortMangleTable $ tMangle iptables)+ (sortMangleTable $ tMangle iptables') return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header "mangle" "Iptables Mangle table. Unfortunately rule editing is not supported for Mangle yet."+ header "mangle" "Iptables Mangle table. Rule editing is not supported for Mangle yet." showPageHtml mangle -pageHandlerPost :: IptAdmin Response-pageHandlerPost = undefined- showPageHtml :: Html -> Html showPageHtml table =- H.div ! A.id "rules" $+ H.div H.! A.id "rules" $ table++pageHandlerPost :: IptAdmin Response+pageHandlerPost = do+ actionS <- getInputOrEmptyString "action"+ case actionS of+ "reset" -> do+ tableName <- getInputOrEmptyString "table"+ chainName <- getInputString "chain"+ iptables <- getIptables+ (sessionId, sessionsIO, _) <- lift get+ sessions <- liftIO $ readIORef sessionsIO+ let session = sessions Data.Map.! sessionId+ liftIO $ atomicModifyIORef sessionsIO $+ \ sessions' ->+ ( insert sessionId (session {sIptables = iptables}) sessions'+ , ())+ redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName Nothing+ "" -> throwError "'action' parameter is not specified"+ a -> throwError $ "unknown value of 'action' parameter: " ++ a
src/IptAdmin/ShowPage/Render.hs view
@@ -2,9 +2,12 @@ module IptAdmin.ShowPage.Render where +import Control.Monad.Error import Data.Monoid import Data.String import IptAdmin.Render+import IptAdmin.Types+import IptAdmin.Utils import Iptables.Print import Iptables.Types import Text.Blaze@@ -16,59 +19,108 @@ isModule _ = False isOption :: RuleOption -> Bool-isOption = not. isModule--renderIptables :: Iptables -> Html-renderIptables (Iptables f n m r) =- renderTable ("filter", "Filter") f- >> renderTable ("nat", "Nat") n- >> renderTable ("mangle", "Mangle") m- >> renderTable ("raw", "Raw") r+isOption = not . isModule renderTable :: (String, String) -- ^ (table name, table name for rendering)+ -> CountersType -- ^ display bytes or packets counters+ -> Integer -- ^ Max counter diff+ -> String -- ^ random string for 'refresh' link -> [Chain] -- ^ table's chains+ -> [Chain] -- ^ chains with relative start counters state -> Html-renderTable (tableName, _) chains = do- mapM_ (renderChain tableName) chains+renderTable (tableName, _) countType maxCounter refreshString chains chains' = do+ mapM_ (renderChain tableName countType maxCounter refreshString) $ zip chains chains' H.a ! A.href (fromString $ "/addchain?table="++tableName) $ "Add chain" --- | Table name -> Chain -> Html-renderChain :: String -> Chain -> Html-renderChain tableName (Chain n p _ rs) =+-- | Table name -> counters type -> max counter -> refresh string -> Chain -> Html+renderChain :: String -> CountersType -> Integer -> String -> (Chain,Chain) -> Html+renderChain tableName countType maxCounterDiff refreshString (Chain n p counters rs, Chain _ _ counters' rs') = H.table ! A.class_ "rules" $ do H.tr $ do- H.td ! A.colspan "3" $- H.div ! A.id "chainName" $ fromString n+ H.td ! A.colspan "4" $+ H.div ! A.id "chainName" $ do+ H.a ! A.name (fromString $ "chain" ++ "_" ++ n) $ fromString n+ " "+ H.a ! A.href (fromString $ "/show?table=" ++ tableName ++ "&refresh=" ++ refreshString ++ bookmarkForJump n Nothing)+ ! A.title "Refresh page"+ $ "↻" H.td ! A.class_ "rightAlign" ! A.colspan "3" $ case p of PUNDEFINED -> do H.a ! A.class_ "button" ! A.title "Delete chain" ! A.href (fromString $ "/delchain?table="++tableName++"&chain="++n)- $ "X"+ $ "✘" -- X H.a ! A.class_ "button" ! A.title "Edit chain name" ! A.href (fromString $ "/editchain?table="++tableName++"&chain="++n)- $ "e"+ $ "✎" -- e a -> do "Policy: " H.a ! A.href (fromString $ "/editpolicy?table="++tableName++"&chain="++n) $ fromString $ show a+ " "+ case countType of+ CTBytes -> do+ H.a ! A.href (fromString $ "/show?table=" ++ tableName ++ "&countersType=packets" ++ bookmarkForJump n Nothing)+ $ "Bytes: "+ H.span ! A.title (fromString $ show $ cBytes counters)+ $ fromString $ bytesToPrefix $ cBytes counters++ CTPackets -> do+ let relativeCounter = cPackets counters - cPackets counters'+ let heatRate = (fromInteger relativeCounter) / (fromInteger maxCounterDiff)+ let red = "255"+ let green = case relativeCounter of+ 0 -> "255"+ _ -> show $ round $ 219 - ((219 - 108) * heatRate)+ let blue = case relativeCounter of+ 0 -> "255"+ _ -> show $ round $ 193 - (193 * heatRate)+ H.a ! A.href (fromString $ "/show?table=" ++ tableName ++ "&countersType=bytes" ++ bookmarkForJump n Nothing)+ $ "Packets: "+ H.span ! A.style (fromString $ "color:#000000;background-color:rgb("++red++","++green++","++blue++")") $+ fromString $ show relativeCounter H.tr $ do+ H.th ! A.class_ "col0" $+ case countType of+ CTPackets -> do+ H.span ! A.title "Packets indicator" $+ H.a ! A.href (fromString $ "/show?table=" ++ tableName ++ "&countersType=bytes" ++ bookmarkForJump n Nothing)+ $ "P"+ H.form ! A.id "resetForm" ! A.method "post" $ do+ H.input ! A.type_ "hidden"+ ! A.name "table"+ ! A.value (fromString tableName)+ H.input ! A.type_ "hidden"+ ! A.name "chain"+ ! A.value (fromString n)+ H.input ! A.type_ "hidden"+ ! A.name "action"+ ! A.value "reset"+ H.input ! A.title "Reset packets counters"+ ! A.class_ "resetButton"+ ! A.id "submit"+ ! A.name "reset"+ ! A.type_ "submit"+ ! A.value "⚡" -- "r"+ CTBytes -> H.span ! A.title "Bytes" $+ H.a ! A.href (fromString $ "/show?table=" ++ tableName ++ "&countersType=packets" ++ bookmarkForJump n Nothing)+ $ "B" H.th ! A.class_ "col1" $ "#" H.th ! A.class_ "col2" $ "Modules" H.th ! A.class_ "col3" $ "Options" H.th ! A.class_ "col4" $ "Target" H.th ! A.class_ "col5" $ "Target params" H.th ! A.class_ "col6" $ ""- mapM_ (renderRule (tableName, n)) $ zip rs [1..]+ mapM_ (renderRule (tableName, n) countType maxCounterDiff) $ zip [1..] $ zip rs rs' H.tr $ H.td ! A.colspan "6" $ H.a ! A.href (fromString $ "/add?table="++tableName++"&chain="++n) $ "Add rule" --- | (Table name, Chain name) -> Rule -> Html-renderRule :: (String, String) -> (Rule, Int) -> Html-renderRule (tableName, chainName) (Rule opts tar , ruleNum) =+-- | (Table name, Chain name) -> Counters type -> max counter -> Rule -> Html+renderRule :: (String, String) -> CountersType -> Integer -> (Int, (Rule, Rule)) -> Html+renderRule (tableName, chainName) countType maxCounterDiff (ruleNum, (Rule counters opts tar, Rule counters2 _ _)) = let mainTr = if even ruleNum then H.tr ! A.class_ "even" else H.tr mods' = filter isModule opts@@ -92,9 +144,29 @@ ODestPort _ _ -> True OModule _ -> True _ -> False+ counters' = case countType of+ CTBytes ->+ H.span ! A.title (fromString $ (show $ cBytes counters) ++ " bytes")+ $ fromString $ bytesToPrefix $ cBytes counters+ CTPackets -> do+ let relativeCounter = cPackets counters - cPackets counters2+ let heatRate = (fromInteger relativeCounter) / (fromInteger maxCounterDiff)+ let red = "255"+ let green = case relativeCounter of+ 0 -> "255"+ _ -> show $ round $ 219 - ((219 - 108) * heatRate)+ let blue = case relativeCounter of+ 0 -> "255"+ _ -> show $ round $ 193 - (193 * heatRate)+ H.span ! A.style (fromString $ "color:#000000;background-color:rgb("++red++","++green++","++blue++")")+ ! A.title (fromString $ show relativeCounter ++ " packet(s)")+ $ preEscapedText " " in mainTr $ do- H.td (fromString $ show ruleNum)+ H.td counters'+ H.td $+ H.a ! A.name (fromString $ chainName ++ "_" ++ show ruleNum)+ $ fromString $ show ruleNum H.td $ fromString mods'' H.td $ fromString opts'' H.td target'@@ -103,15 +175,29 @@ H.a ! A.class_ "button" ! A.title "Delete Rule" ! A.href (fromString $ "/del?table="++tableName++"&chain="++chainName++"&pos=" ++ show ruleNum)- $ "X"+ $ "✘" -- "X" if ruleEditable then H.a ! A.class_ "button" ! A.title "Edit Rule" ! A.href (fromString $ "/edit?table="++tableName++"&chain="++chainName++"&pos=" ++ show ruleNum)- $ "e"+ $ "✎" -- "e" else mempty H.a ! A.class_ "button" ! A.title "Insert Rule" ! A.href (fromString $ "/insert?table="++tableName++"&chain="++chainName++"&pos=" ++ show ruleNum) $ "+"++bytesToPrefix :: Integer -> String+bytesToPrefix bytes = bytesToPrefix' ["","K","M","G","T","P","E","Z","Y"] bytes+ where+ bytesToPrefix' :: [String] -> Integer -> String+ bytesToPrefix' [] _ = "more than yottabyte"+ bytesToPrefix' (x:xs) b =+ let nextLevel = b `div` 1024+ in+ if nextLevel == 0+ then+ show b ++ x+ else+ bytesToPrefix' xs nextLevel
src/IptAdmin/System.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} module IptAdmin.System where @@ -14,9 +15,9 @@ -- TODO: change waitForProcess to nonblocking version with timeout -getIptablesSave :: IptAdmin String+getIptablesSave :: (MonadError String m, MonadIO m) => m String getIptablesSave = do- (_, o, _, h) <- liftIO $ runInteractiveCommand "iptables-save"+ (_, o, _, h) <- liftIO $ runInteractiveCommand "iptables-save -c" ec <- liftIO $ waitForProcess h case ec of ExitSuccess -> liftIO $ hGetContents o@@ -29,13 +30,13 @@ _ <- waitForProcess h return () -getIptables :: IptAdmin Iptables+getIptables :: (MonadError String m, MonadIO m) => m Iptables getIptables = do iprules <- getIptablesSave let rE = parseIptables iprules either (throwError . show) return rE -getTable :: String -> IptAdmin [Chain]+getTable :: (MonadError String m, MonadIO m) => String -> m [Chain] getTable tableName = do iptables <- getIptables case tableName of@@ -51,7 +52,7 @@ -> Rule -- ^ Rule -> IptAdmin () appendRule table chain rule = do- let rule' = printRuleCanonical rule+ let rule' = printRuleForRun rule (_, _, e, h) <- liftIO $ runInteractiveCommand $ "iptables -t " ++ table ++ " -A " ++ chain ++ " " ++ rule' ec <- liftIO $ waitForProcess h case ec of@@ -83,7 +84,7 @@ -> Rule -- ^ Rule -> IptAdmin () insertRule table chain rulePos rule = do- let rule' = printRuleCanonical rule+ let rule' = printRuleForRun rule (_, _, e, h) <- liftIO $ runInteractiveCommand $ "iptables -t " ++ table ++ " -I " ++ chain ++ " " ++ show rulePos@@ -101,7 +102,7 @@ -> Rule -- ^ Rule -> IptAdmin () replaceRule table chain rulePos rule = do- let rule' = printRuleCanonical rule+ let rule' = printRuleForRun rule (_, _, e, h) <- liftIO $ runInteractiveCommand $ "iptables -t " ++ table ++ " -R " ++ chain ++ " " ++ show rulePos
src/IptAdmin/Types.hs view
@@ -7,6 +7,7 @@ import Data.Map import Data.Time import Happstack.Server.SimpleHTTP+import Iptables.Types -- | Authorization monad type IptAdminAuth = ServerPartT (ErrorT String IO)@@ -20,6 +21,7 @@ data Session = Session { lastVisit :: UTCTime , backup :: Maybe String+ , sIptables :: Iptables } type MainState = (SessionId, IORef Sessions, IptAdminConfig)@@ -28,3 +30,7 @@ , cPort :: Int , cPamName :: String }++-- | Display bytes or packets on show page+data CountersType = CTBytes+ | CTPackets
src/IptAdmin/Utils.hs view
@@ -102,3 +102,17 @@ Nothing -> return () Just iptablesStr -> iptablesRestore iptablesStr++bookmarkForJump :: String -- ^ Chain name+ -> Maybe Int -- ^ Rule number+ -> String -- ^ Bookmark with "#"+bookmarkForJump chainName ruleNumMay =+ case ruleNumMay of+ Nothing ->+ "#chain_" ++ chainName+ Just ruleNum ->+ if ruleNum > 20+ then+ "#" ++ chainName ++ "_" ++ show (ruleNum - 15)+ else+ "#chain_" ++ chainName
src/Template.hs view
@@ -5,10 +5,10 @@ ""++"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">", ""++"<html xmlns=\"http://www.w3.org/1999/xhtml\">", ""++" <head>",- ""++" <title>Iptables Manager</title>",+ ""++" <title>IptAdmin</title>", ""++" <meta name=\"AUTHOR\" content=\"Evgeny Tarasov\" />", ""++" <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />",- ""++" <meta name=\"DESCRIPTION\" content=\"description\"/>",+ ""++" <meta name=\"DESCRIPTION\" content=\"iptables web interface\"/>", ""++" <meta name=\"KEYWORDS\" content=\"iptables, haskell\" />", ""++" <style type=\"text/css\">", ""++" body {",@@ -135,6 +135,9 @@ ""++" max-width: 1000px;", ""++" padding-top: 10px;", ""++" }",+ ""++" input.resetButton {",+ ""++" padding: 0;",+ ""++" }", ""++" div.loginForm {", ""++" /*float: left;", ""++" margin-left: auto;",@@ -179,6 +182,10 @@ ""++" }", ""++" table.editForm {", ""++" border: 1px solid #666666;",+ ""++" }",+ ""++" th.col0 {",+ ""++" width : 5px;",+ ""++" padding: 0;", ""++" }", ""++" th.col1 {", ""++" width : 15px;",