iptadmin 1.1.0 → 1.2.0
raw patch · 24 files changed
+475/−707 lines, 24 filesdep +file-embeddep +old-timedep +template-haskelldep ~happstack-serverdep ~happstack-statedep ~happstack-util
Dependencies added: file-embed, old-time, template-haskell
Dependency ranges changed: happstack-server, happstack-state, happstack-util
Files
- Changelog +8/−3
- Makefile +5/−1
- html/htmlwrapper.html +4/−249
- iptadmin.cabal +9/−5
- src/IptAdmin/AccessControl.hs +28/−19
- src/IptAdmin/AddChainPage.hs +6/−9
- src/IptAdmin/AddPage.hs +6/−12
- src/IptAdmin/DelChainPage.hs +2/−1
- src/IptAdmin/DelPage.hs +3/−1
- src/IptAdmin/EditChainForm/Render.hs +1/−3
- src/IptAdmin/EditChainPage.hs +7/−13
- src/IptAdmin/EditForm/Render.hs +105/−53
- src/IptAdmin/EditPage.hs +6/−14
- src/IptAdmin/EditPolicyForm/Render.hs +0/−1
- src/IptAdmin/EditPolicyPage.hs +5/−4
- src/IptAdmin/InsertPage.hs +7/−18
- src/IptAdmin/LoginPage.hs +3/−3
- src/IptAdmin/ShowPage.hs +71/−8
- src/IptAdmin/ShowPage/Render.hs +68/−28
- src/IptAdmin/Static.hs +107/−0
- src/IptAdmin/Types.hs +1/−0
- src/IptAdmin/Utils.hs +14/−10
- src/Main.hs +5/−3
- src/Template.hs +4/−249
Changelog view
@@ -1,13 +1,18 @@-Iptadmin 1.1.0 07.09.2011:+iptadmin 1.2.0 17.09.2011:+ * Add jquery-ui dialogs and background requests.+ * Improve appearance.+ * Upgrade code to Happstack 6.++iptadmin 1.1.0 07.09.2011: * Display counters in show page. -Iptadmin 1.0.1 14.07.2011:+iptadmin 1.0.1 14.07.2011: * Add command line options --version, --help. * Syslog logging. * Daemonize properly. * Check that iptadmin is run under root. -Iptadmin 1.0.0 05.07.2011:+iptadmin 1.0.0 05.07.2011: * First public release. * Program core.
Makefile view
@@ -1,6 +1,6 @@ all: dist/build/iptadmin/iptadmin -dist/build/iptadmin/iptadmin: src/Template.hs src/IptAdmin/AddPage.hs src/IptAdmin/EditForm/Utils.hs src/IptAdmin/EditForm/Render.hs src/IptAdmin/EditForm/Class.hs src/IptAdmin/EditForm/Types.hs src/IptAdmin/Utils.hs src/IptAdmin/Render.hs src/IptAdmin/EditPage.hs src/IptAdmin/InsertPage.hs src/IptAdmin/EditChainForm/Render.hs src/IptAdmin/EditChainForm/Parse.hs src/IptAdmin/DelPage.hs src/IptAdmin/EditForm.hs src/IptAdmin/DelPage/Render.hs src/IptAdmin/ShowPage/Render.hs src/IptAdmin/EditPolicyPage.hs src/IptAdmin/EditPolicyForm/Render.hs src/IptAdmin/EditChainPage.hs src/IptAdmin/AccessControl.hs src/IptAdmin/DelChainPage.hs src/IptAdmin/LoginPage.hs src/IptAdmin/Types.hs src/IptAdmin/System.hs src/IptAdmin/DelChainPage/Render.hs src/IptAdmin/Config.hs src/IptAdmin/AddChainPage.hs src/IptAdmin/ShowPage.hs src/Main.hs+dist/build/iptadmin/iptadmin: src/Template.hs src/IptAdmin/AddPage.hs src/IptAdmin/EditForm/Utils.hs src/IptAdmin/EditForm/Render.hs src/IptAdmin/EditForm/Class.hs src/IptAdmin/EditForm/Types.hs src/IptAdmin/Utils.hs src/IptAdmin/Render.hs src/IptAdmin/EditPage.hs src/IptAdmin/InsertPage.hs src/IptAdmin/EditChainForm/Render.hs src/IptAdmin/EditChainForm/Parse.hs src/IptAdmin/DelPage.hs src/IptAdmin/EditForm.hs src/IptAdmin/DelPage/Render.hs src/IptAdmin/ShowPage/Render.hs src/IptAdmin/EditPolicyPage.hs src/IptAdmin/EditPolicyForm/Render.hs src/IptAdmin/EditChainPage.hs src/IptAdmin/AccessControl.hs src/IptAdmin/DelChainPage.hs src/IptAdmin/LoginPage.hs src/IptAdmin/Types.hs src/IptAdmin/System.hs src/IptAdmin/DelChainPage/Render.hs src/IptAdmin/Config.hs src/IptAdmin/AddChainPage.hs src/IptAdmin/ShowPage.hs src/IptAdmin/Static.hs src/Main.hs iptadmin.cabal cabal install src/Template.hs: html/htmlwrapper.html@@ -34,3 +34,7 @@ rm /etc/pam.d/iptadmin || true rm /etc/init.d/iptadmin echo "uninstalled"++htmlrebuild:+ touch src/IptAdmin/Static.hs+ make
html/htmlwrapper.html view
@@ -8,255 +8,10 @@ <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> <meta name="DESCRIPTION" content="iptables web interface"/> <meta name="KEYWORDS" content="iptables, haskell" />- <style type="text/css">- body {- font-family:Arial,Helvetica,sans-serif;- background-color: #f7f7f7;- color: #5b5b5b;- }- tr.even {- background-color:#f0f0f0;- }- table {- border-collapse : collapse;- background-color: #ffffff;- }- th {- background-color: #b7b7b7;- color: #f7f7f7;- }- table, th, td {- border: 1px dotted black;- padding: 5px;- }- td.rightAlign {- text-align:right;- }- a:link, a:visited {- color: #856767;- }- a:hover {- color: #bb1010;- }- a:active {- color: #666666;- }- a.title:link, a.title:visited {- color: #856767;- text-decoration: none;- }- a.title:active, a.title:hover {- text-decoration: underline;- }- a.button:link, a.button:visited {- display: block;- float: right;- font-weigth: bold;- color: #f7f7f7;- background-color: #b5aaaa;- width: 10px;- padding: 0px 4px 0px 4px;- margin: 0px 3px 0px 0px;- text-decoration: none;- text-align: center;- }- a.button:hover, a.button:active {- background-color: #bb1010;- }- div.logout {- float:right;- padding: 20px;- }- #title {- float: left;- padding: 15px;- color: #bbbbbb;- font-size: 26px;- }- span.version {- margin-left: 0.5em;- font-size: 0.5em;- }- #links {- margin-left: auto;- margin-right: auto;- width: 9.5em;- padding: 20px;- /*padding-left: 65px;- */- text-align: center;- /*- margin-left: 200px;- */- }- a.activeTableLink:link, a.activeTableLink:visited {- display: block;- float:left;- color: #f7f7f7;- background-color: #b5aaaa;- padding: 4px;- margin: 0px 3px 0px 0px;- text-decoration: none;- }- a.activeTableLink:hover, a.activeTableLink:active {- background-color: #bb1010;- }- a.tableLink:link, a.tableLink:visited {- display: block;- float:left;- color: #856767;- background-color: #f7f7f7;- padding: 4px;- margin: 0px 3px 0px 0px;- text-decoration: none;- }- a.tableLink:hover, a.tableLink:active {- color: #bb1010;- }- #localLinks {- float: left;- background: #deeeee;- margin-left: 100px;- padding: 10px;- }- div.pageHeader {- width: 50%;- margin-top: 10px;- margin-left: auto;- margin-right: auto;- text-align: center;- }- #rules {- margin-left: auto;- margin-right: auto;- width: 100%;- max-width: 1000px;- padding-top: 10px;- }- input.resetButton {- padding: 0;- }- div.loginForm {- /*float: left;- margin-left: auto;- margin-right: auto;- */- position: absolute;- top: 50%;- left: 50%;- margin-top: -40px;- margin-left: -130px;- }- div.loginForm2 {- height: 80px;- width: 280px;- background: #ffffff;- border: 1px solid #666666;- border-radius: 15px;- -moz-border-radius: 15px;- padding: 15px;- text-align: center;- }- span.loginForm {- color: #ababab;- }- table.loginForm, td.loginForm {- border: none;- padding: 0px;- }- td.loginForm {- padding: 2px;- }- div.editForm {- padding-top: 20px;- margin-left: auto;- margin-right: auto;- max-width: 700px- }- table.rules {- margin-top: 10px;- border: 1px solid #666666;- width: 100%;- }- table.editForm {- border: 1px solid #666666;- }- th.col0 {- width : 5px;- padding: 0;- }- th.col1 {- width : 15px;- }- th.col4 {- width : 60px;- }- th.col6 {- width : 64px;- }- /*- Цвета для различных targets- */- span.acceptTarget {- color: #4e994f;- }- span.dropTarget {- color: #dd2222;- }- span.rejectTarget {- color: #a54638;- }- span.snatTarget {- color: #7a997b;- }- span.masqueradeTarget {- color: #4e994f;- }- span.dnatTarget {- color: #77aac5;- }- span.redirectTarget {- color: #7783c5;- }- span.chainTarget {- color: #000000;- }- span.unknownTarget {- color: #ababab;- }- /*- Стили для вложенной таблицы и элемента таблицы,- в которой вкладывается таблица- */- td.inline {- margin: 0;- padding: 0;- }- table.inline {- border-style: none;- width: 100%- }- /*- Стили элементов таблиц для скрытия рамки вокруг таблицы,- это приводило к утолщению сетки в местах сопряжения- */- th.target {- border-left: none;- border-top: none;- }- th.targetParam {- border-right: none;- border-top: none;- }- td.target {- border-bottom: none;- border-left: none;- }- td.targetParam {- border-bottom: none;- border-right: none;- }- </style>+ <link rel="stylesheet" type="text/css" href="/static/css/iptadmin-theme/jquery-ui-1.8.16.custom.css" />+ <script type="text/javascript" src="/static/js/jquery-1.6.2.min.js"></script>+ <script type="text/javascript" src="/static/js/jquery-ui-1.8.16.custom.min.js"></script>+ <link href="/static/css/iptadmin.css" rel="stylesheet" type="text/css" title="Iptadmin" /> </head> <body> !@#content
iptadmin.cabal view
@@ -1,5 +1,5 @@ Name: iptadmin-Version: 1.1.0+Version: 1.2.0 Cabal-Version: >= 1.4 Author: Evgeny Tarasov Build-type: Simple@@ -29,9 +29,9 @@ haskell98, utf8-string >= 0.3, bytestring >= 0.9,- happstack-server >= 0.5 && < 0.5.1,- happstack-state >= 0.5 && < 0.5.1,- happstack-util >= 0.5 && < 0.5.1,+ happstack-server >= 6.2 && < 6.3,+ happstack-state >= 6.1 && < 6.2,+ happstack-util >= 6 && < 6.1, mtl >= 1.1, safe >= 0.3, iptables-helpers >= 0.4 && < 0.5,@@ -47,7 +47,10 @@ filepath >= 1.1 && < 2, network >= 2.2 && < 3, hsyslog >= 1.4 && < 2,- hdaemonize >= 0.4.4 && < 0.5+ hdaemonize >= 0.4.4 && < 0.5,+ file-embed >= 0.0.4 && < 0.1,+ old-time >= 1.0.0.3 && < 1.1,+ template-haskell >= 2.4 Main-Is: Main.hs Other-modules: IptAdmin.AccessControl IptAdmin.AddChainPage@@ -73,6 +76,7 @@ IptAdmin.Render IptAdmin.ShowPage IptAdmin.ShowPage.Render+ IptAdmin.Static IptAdmin.System IptAdmin.Types IptAdmin.Utils
src/IptAdmin/AccessControl.hs view
@@ -9,33 +9,42 @@ import Data.Maybe import Happstack.Server.SimpleHTTP import IptAdmin.LoginPage as LoginPage (pageHandlers)+import IptAdmin.Static as Static import IptAdmin.Types import IptAdmin.Utils import Prelude hiding (catch) import System.Posix.PAM as PAM+-- import System.Posix.Syslog import System.Posix.User -- verify that client is allowed to access server authorize :: IORef Sessions -> IptAdminConfig -> IptAdmin Response -> IptAdminAuth Response-authorize sessionsIORef config requestHandler = do- clientIdMay <- getDataFn $ lookCookieValue "sessionId"- isAuthorised <- case clientIdMay of- Nothing -> return False- Just a -> do- sessions <- liftIO $ readIORef sessionsIORef- let session = Data.Map.lookup a sessions- case session of- Nothing -> return False- Just _ -> return True- if isAuthorised- then- -- Run IptAdmin monad with state- mapServerPartT (addStateToStack (fromJust clientIdMay, sessionsIORef, config)) requestHandler- else- msum [ dir "login" $ LoginPage.pageHandlers (IptAdmin.AccessControl.authenticate $ cPamName config)- sessionsIORef- , redir "/login"- ]+authorize sessionsIORef config requestHandler =+ -- allow 'static' dir without authorisation+ (dir "static" Static.pageHandlers) `mplus` do+ clientIdE <- getDataFn $ lookCookieValue "sessionId"+ isAuthorised <- case clientIdE of+ Left _ ->+ -- liftIO $ syslog Notice $ "sessionId cookie get error: " ++ show e+ return False+ Right a -> do+ sessions <- liftIO $ readIORef sessionsIORef+ let session = Data.Map.lookup a sessions+ case session of+ Nothing ->+ -- liftIO $ syslog Notice $ "session was not found: " ++ a+ -- liftIO $ syslog Notice $ "sessions: " ++ show sessions+ return False+ Just _ -> return True+ if isAuthorised+ then+ -- Run IptAdmin monad with state+ mapServerPartT (addStateToStack (either undefined id clientIdE, sessionsIORef, config)) requestHandler+ else+ msum [ dir "login" $ LoginPage.pageHandlers (IptAdmin.AccessControl.authenticate $ cPamName config)+ sessionsIORef+ , redir "/login"+ ] where addStateToStack :: (Monad m) => MainState -> UnWebT (ErrorT String (StateT MainState m)) a
src/IptAdmin/AddChainPage.hs view
@@ -23,8 +23,7 @@ pageHandlerGet :: IptAdmin Response pageHandlerGet = do tableName <- getInputNonEmptyString "table"- return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Add user defined chain in '" ++ tableName ++ "' table"+ return $ buildResponse $ renderHtml $ do editChainForm (tableName, "") "" Nothing pageHandlerPost :: IptAdmin Response@@ -33,8 +32,7 @@ newChainName <- getInputString "newChainName" let newChainNameE = parse parseChainName "chain name" newChainName case newChainNameE of- Left e -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Add user defined chain in '" ++ tableName ++ "' table"+ Left e -> return $ buildResponse $ renderHtml $ do editChainForm (tableName, "") newChainName $ Just $ "Parameter error: " ++ show e Right newChainName' -> do iptables <- getIptables@@ -46,16 +44,15 @@ a -> throwError $ "Invalid table parameter: " ++ a let checkChainMay = getChainByName newChainName' table case checkChainMay of- Just _ -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Add user defined chain in '" ++ tableName ++ "' table"+ Just _ -> return $ buildResponse $ renderHtml $ do editChainForm (tableName, "") newChainName' $ Just "A chain with the same name already exists" Nothing -> do submit <- getInputString "submit" case submit of- "Check" -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Add user defined chain in '" ++ tableName ++ "' table"+ "Check" -> return $ buildResponse $ renderHtml $ do editChainForm (tableName, "") newChainName' $ Just "The name is valid" "Submit" -> do tryChange $ addChain tableName newChainName'- redir $ "/show?table=" ++ tableName ++ bookmarkForJump newChainName' Nothing+ -- redir $ "/show?table=" ++ tableName ++ bookmarkForJump newChainName' Nothing+ return $ buildResponse $ "ok:" ++ newChainName' a -> throwError $ "Invalid value for 'submit' parameter: " ++ a
src/IptAdmin/AddPage.hs view
@@ -4,12 +4,10 @@ import Control.Monad.Error import Control.Monad.State import Happstack.Server.SimpleHTTP-import Template import IptAdmin.EditForm import IptAdmin.EditForm.Class import IptAdmin.EditForm.Render import IptAdmin.EditForm.Utils-import IptAdmin.Render import IptAdmin.System import IptAdmin.Types import IptAdmin.Utils@@ -34,8 +32,7 @@ (PackedEditForm form) <- nullSelForm tableName chainName let userChainNames = getUserChains form chainName table- return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Add rule at the end of '" ++ chainName ++ "' chain in '" ++ tableName ++ "' table"+ return $ buildResponse $ renderHtml $ do editFormHtml (tableName, chainName, 0, userChainNames) form Nothing pageHandlerPost :: IptAdmin Response@@ -52,8 +49,7 @@ let checkResE = editPageProcessParams addFormParams case checkResE of- Left formMes -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Add rule at the end of '" ++ chainName ++ "' chain in '" ++ tableName ++ "' table"+ Left formMes -> return $ buildResponse $ renderHtml $ do editFormHtml (tableName, chainName, 0, userChainNames) addFormParams $ Just formMes Right (options, target, formMes) -> do let (_, options') = runState (mapM_ completeModules options) options@@ -61,15 +57,13 @@ submit <- getInputString "submit" case submit of- "Check" -> return $ buildResponse $ Template.htmlWrapper $ renderHtml (do- header tableName $ "Add rule at the end of '"- ++ chainName ++ "' chain in '"- ++ tableName ++ "' table"+ "Check" -> return $ buildResponse $ renderHtml (do editFormHtml (tableName, chainName, 0, userChainNames) addFormParams $ Just formMes- ) ++ printRuleForRun rule+ ) -- ++ printRuleForRun rule "Submit" -> do tryChange (appendRule tableName chainName rule)- redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName Nothing+ -- redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName Nothing+ return $ buildResponse "ok" a -> throwError $ "Wrong value for 'submit' parameter: " ++ a checkParams :: [Chain] -> String -> IptAdmin ()
src/IptAdmin/DelChainPage.hs view
@@ -70,4 +70,5 @@ ++ show linkedChains else do tryChange $ deleteChain tableName chainName- redir $ "/show?table=" ++ tableName+ -- redir $ "/show?table=" ++ tableName+ return $ buildResponse "ok"
src/IptAdmin/DelPage.hs view
@@ -20,6 +20,7 @@ , methodSP POST pageHandlerPost ] +-- | Deprecated. Was used before jquery-ui integration. pageHandlerGet :: IptAdmin Response pageHandlerGet = do tableName <- getInputNonEmptyString "table"@@ -44,7 +45,8 @@ _ <- checkParams tableName chainName rulePosition tryChange (deleteRule tableName chainName rulePosition)- redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName (Just rulePosition)+ -- redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName (Just rulePosition)+ return $ buildResponse "ok" checkParams :: String -> String -> Int -> IptAdmin (Chain, Rule) checkParams tableName chainName rulePosition = do
src/IptAdmin/EditChainForm/Render.hs view
@@ -11,7 +11,7 @@ editChainForm :: (String, String) -> String -> Maybe String -> Html editChainForm (tableName, chainName) newChainName mesMay = H.div ! A.class_ "editForm" $- H.form ! A.id "addChainForm" ! A.method "post" $ do+ H.form ! A.id "editChainForm" ! 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 chainName) H.table $@@ -22,5 +22,3 @@ Nothing -> mempty :: Html Just mes -> H.td $ fromString mes- H.input ! A.id "check" ! A.name "submit" ! A.type_ "submit" ! A.value "Check"- H.input ! A.id "submit" ! A.name "submit" ! A.type_ "submit" ! A.value "Submit"
src/IptAdmin/EditChainPage.hs view
@@ -29,8 +29,7 @@ let chainMay = getChainByName chainName table case chainMay of Nothing -> throwError $ "Invalid chain name: " ++ chainName- Just _ -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Edit name of '" ++ chainName ++ "' chain in '" ++ tableName ++ "' table"+ Just _ -> return $ buildResponse $ renderHtml $ do editChainForm (tableName, chainName) chainName Nothing pageHandlerPost :: IptAdmin Response@@ -42,31 +41,26 @@ let newChainNameE = parse parseChainName "chain name" newChainName case newChainNameE of- Left e -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Edit name of '" ++ chainName ++ "' chain in '" ++ tableName ++ "' table"+ Left e -> return $ buildResponse $ renderHtml $ do editChainForm (tableName, chainName) newChainName $ Just $ "Parameter error: " ++ show e Right newChainName' -> if chainName == newChainName'- then return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Edit name of '" ++ chainName ++ "' chain in '" ++ tableName ++ "' table"+ then return $ buildResponse $ renderHtml $ do editChainForm (tableName, chainName) newChainName' $ Just "The name was not changed" else do table <- getTable tableName let checkChainMay = getChainByName newChainName' table case checkChainMay of- Just _ -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Edit name of '" ++ chainName ++ "' chain in '" ++ tableName ++ "' table"+ Just _ -> return $ buildResponse $ renderHtml $ do editChainForm (tableName, chainName) newChainName' $ Just "A chain with the same name already exists" Nothing -> do submit <- getInputString "submit" case submit of- "Check" -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Edit name of '" ++ chainName- ++ "' chain in '" ++ tableName- ++ "' table"+ "Check" -> return $ buildResponse $ renderHtml $ do editChainForm (tableName, chainName) newChainName' $ Just "The name is valid" "Submit" -> do tryChange $ renameChain tableName chainName newChainName'- redir $ "/show?table=" ++ tableName ++ bookmarkForJump newChainName' Nothing+ -- redir $ "/show?table=" ++ tableName ++ bookmarkForJump newChainName' Nothing+ return $ buildResponse $ "ok:" ++ newChainName' a -> throwError $ "Invalid value for 'submit' parameter: " ++ a
src/IptAdmin/EditForm/Render.hs view
@@ -14,7 +14,10 @@ checkBox :: String -> Bool -> Html checkBox name on = do- let chBox = H.input ! A.type_ "checkbox" ! A.name (fromString name) ! A.value "on"+ let chBox = H.input ! A.type_ "checkbox"+ ! A.id (fromString name)+ ! A.name (fromString name)+ ! A.value "on" if on then chBox ! A.checked "checked" else chBox @@ -45,17 +48,18 @@ H.th "Parameter" maybe mempty (\_-> H.th "Message") errorListMay mapM_ (renderFormEntry userChainNames) $ zip entryList mesListMay- H.input ! A.id "check" ! A.name "submit" ! A.type_ "submit" ! A.value "Check"- H.input ! A.id "submit" ! A.name "submit" ! A.type_ "submit" ! A.value "Submit" renderFormEntry :: [String] -> (FormEntry, Maybe ResMessage) -> Html renderFormEntry _ (FESrc en inv str, resMesMay) = H.tr $ do H.td $ do- "Source" >> H.br+ H.label ! A.for "sourceEnable"+ $ "Source"+ H.br checkBox "sourceEnable" en H.td $ do- "!"+ H.label ! A.for "sourceInv"+ $ "!" checkBox "sourceInv" inv H.td $ H.input ! A.type_ "text" ! A.name "source" ! A.value (fromString str)@@ -63,10 +67,13 @@ renderFormEntry _ (FEDst en inv str, resMesMay) = H.tr $ do H.td $ do- "Destination" >> H.br+ H.label ! A.for "destinationEnable"+ $ "Destination"+ H.br checkBox "destinationEnable" en H.td $ do- "!"+ H.label ! A.for "destinationInv"+ $ "!" checkBox "destinationInv" inv H.td $ H.input ! A.type_ "text" ! A.name "destination" ! A.value (fromString str)@@ -74,10 +81,13 @@ renderFormEntry _ (FEProt en inv prot, resMesMay) = H.tr $ do H.td $ do- "Protocol" >> H.br+ H.label ! A.for "protocolEnable"+ $ "Protocol"+ H.br checkBox "protocolEnable" en H.td $ do- "!"+ H.label ! A.for "protocolInv"+ $ "!" checkBox "protocolInv" inv H.td $ H.select ! A.id "protocol" ! A.name "protocol" $ do@@ -99,10 +109,13 @@ renderFormEntry _ (FESPort en inv str, resMesMay) = H.tr $ do H.td $ do- "Source port" >> H.br+ H.label ! A.for "sportEnable"+ $ "Source port"+ H.br checkBox "sportEnable" en H.td $ do- "!"+ H.label ! A.for "sportInv"+ $ "!" checkBox "sportInv" inv H.td $ H.input ! A.type_ "text" ! A.name "sport" ! A.value (fromString str)@@ -110,10 +123,13 @@ renderFormEntry _ (FEDPort en inv str, resMesMay) = H.tr $ do H.td $ do- "Destination port" >> H.br+ H.label ! A.for "dportEnable"+ $ "Destination port"+ H.br checkBox "dportEnable" en H.td $ do- "!"+ H.label ! A.for "dportInv"+ $ "!" checkBox "dportInv" inv H.td $ H.input ! A.type_ "text" ! A.name "dport" ! A.value (fromString str)@@ -121,10 +137,13 @@ renderFormEntry _ (FEInput en inv str, resMesMay) = H.tr $ do H.td $ do- "Input interface" >> H.br+ H.label ! A.for "inputEnable"+ $ "Input interface"+ H.br checkBox "inputEnable" en H.td $ do- "!"+ H.label ! A.for "inputInv"+ $ "!" checkBox "inputInv" inv H.td $ H.input ! A.type_ "text" ! A.name "input" ! A.value (fromString str)@@ -132,10 +151,13 @@ renderFormEntry _ (FEOutput en inv str, resMesMay) = H.tr $ do H.td $ do- "Output interface" >> H.br+ H.label ! A.for "outputEnable"+ $ "Output interface"+ H.br checkBox "outputEnable" en H.td $ do- "!"+ H.label ! A.for "outputInv"+ $ "!" checkBox "outputInv" inv H.td $ H.input ! A.type_ "text" ! A.name "output" ! A.value (fromString str)@@ -143,20 +165,32 @@ renderFormEntry _ (FEState en stateSet, resMesMay) = H.tr $ do H.td $ do- "State" >> H.br+ H.label ! A.for "stateEnable"+ $ "State"+ H.br checkBox "stateEnable" en H.td "" H.td $ do checkBox "stateNew" $ CStNew `member` stateSet- "New" >> H.br+ H.label ! A.for "stateNew"+ $ "New"+ H.br checkBox "stateEstablished" $ CStEstablished `member` stateSet- "Established" >> H.br+ H.label ! A.for "stateEstablished"+ $ "Established"+ H.br checkBox "stateRelated" $ CStRelated `member` stateSet- "Related" >> H.br+ H.label ! A.for "stateRelated"+ $ "Related"+ H.br checkBox "stateInvalid" $ CStInvalid `member` stateSet- "Invalid" >> H.br+ H.label ! A.for "stateInvalid"+ $ "Invalid"+ H.br checkBox "stateUntracked" $ CStUntracked `member` stateSet- "Untracked" >> H.br+ H.label ! A.for "stateUntracked"+ $ "Untracked"+ H.br maybe mempty printMesTd resMesMay renderFormEntry userChainNames (FEFiltTar filtTar rejectType userChain, resMesMay) =@@ -168,27 +202,30 @@ H.th ! A.class_ "targetParam" $ "Parameters" H.tr $ do H.td ! A.class_ "target" $ do- let acceptRadio = H.input ! A.type_ "radio" ! A.name "target" ! A.value "accept"+ let acceptRadio = H.input ! A.id "accept" ! A.type_ "radio" ! A.name "target" ! A.value "accept" case filtTar of FAccept -> acceptRadio ! A.checked "checked" _ -> acceptRadio- "Acccept"+ H.label ! A.for "accept"+ $ "Acccept" H.td ! A.class_ "targetParam" $ "" H.tr $ do H.td ! A.class_ "target" $ do- let dropRadio = H.input ! A.type_ "radio" ! A.name "target" ! A.value "drop"+ let dropRadio = H.input ! A.type_ "radio" ! A.id "drop" ! A.name "target" ! A.value "drop" case filtTar of FDrop -> dropRadio ! A.checked "checked" _ -> dropRadio- "Drop"+ H.label ! A.for "drop"+ $ "Drop" H.td ! A.class_ "targetParam" $ "" H.tr $ do H.td ! A.class_ "target" $ do- let rejectRadio = H.input ! A.type_ "radio" ! A.name "target" ! A.value "reject"+ let rejectRadio = H.input ! A.type_ "radio" ! A.id "reject" ! A.name "target" ! A.value "reject" case filtTar of FReject -> rejectRadio ! A.checked "checked" _ -> rejectRadio- "Reject" >> H.br+ H.label ! A.for "reject"+ $ "Reject" H.td ! A.class_ "targetParam" $ H.select ! A.id "rejectType" ! A.name "rejectType" $ let@@ -318,69 +355,84 @@ renderDNat checked dnatAddr dnatRand dnatPersist = H.tr $ do H.td ! A.class_ "target" $ do- let dnatRadio = H.input ! A.type_ "radio" ! A.name "target" ! A.value "dnat"+ let dnatRadio = H.input ! A.type_ "radio" ! A.id "dnat" ! A.name "target" ! A.value "dnat" if checked then dnatRadio ! A.checked "checked" else dnatRadio- "Destination Nat"+ H.label ! A.for "dnat"+ $ "Destination Nat" H.td ! A.class_ "targetParam" $ do- "dnat address:"- H.input ! A.type_ "text" ! A.name "dnataddress" ! A.value (fromString dnatAddr) >> H.br- "random:"+ H.label ! A.for "dnataddress"+ $ "dnat address:"+ H.input ! A.type_ "text" ! A.id "dnataddress" ! A.name "dnataddress" ! A.value (fromString dnatAddr) >> H.br+ H.label ! A.for "dnatrandom"+ $ "random:" checkBox "dnatrandom" dnatRand >> H.br- "persistent:"+ H.label ! A.for "dnatpersistent"+ $ "persistent:" checkBox "dnatpersistent" dnatPersist >> H.br renderRedirect :: Bool -> String -> Bool -> Html renderRedirect checked redirPort redirRand = H.tr $ do H.td ! A.class_ "target" $ do- let redirRadio = H.input ! A.type_ "radio" ! A.name "target" ! A.value "redirect"+ let redirRadio = H.input ! A.type_ "radio" ! A.id "redirect" ! A.name "target" ! A.value "redirect" if checked then redirRadio ! A.checked "checked" else redirRadio- "Redirect"+ H.label ! A.for "redirect"+ $ "Redirect" H.td ! A.class_ "targetParam" $ do- "port:"- H.input ! A.type_ "text" ! A.name "redirport" ! A.value (fromString redirPort) >> H.br- "random:"+ H.label ! A.for "redirport"+ $ "port:"+ H.input ! A.type_ "text" ! A.id "redirport" ! A.name "redirport" ! A.value (fromString redirPort) >> H.br+ H.label ! A.for "redirrandom"+ $ "random:" checkBox "redirrandom" redirRand renderSNat :: Bool -> String -> Bool -> Bool -> Html renderSNat checked snatAddr snatRand snatPersist = H.tr $ do H.td ! A.class_ "target" $ do- let snatRadio = H.input ! A.type_ "radio" ! A.name "target" ! A.value "snat"+ let snatRadio = H.input ! A.type_ "radio" ! A.id "snat" ! A.name "target" ! A.value "snat" if checked then snatRadio ! A.checked "checked" else snatRadio- "Source Nat"+ H.label ! A.for "snat"+ $ "Source Nat" H.td ! A.class_ "targetParam" $ do- "snat address:"- H.input ! A.type_ "text" ! A.name "snataddress" ! A.value (fromString snatAddr) >> H.br- "random:"+ H.label ! A.for "snataddress"+ $ "snat address:"+ H.input ! A.type_ "text" ! A.id "snataddress" ! A.name "snataddress" ! A.value (fromString snatAddr) >> H.br+ H.label ! A.for "snatrandom"+ $ "random:" checkBox "snatrandom" snatRand >> H.br- "persistent:"+ H.label ! A.for "snatpersistent"+ $ "persistent:" checkBox "snatpersistent" snatPersist >> H.br renderMasq :: Bool -> String -> Bool -> Html renderMasq checked masqPort masqRand = H.tr $ do H.td ! A.class_ "target" $ do- let masqRadio = H.input ! A.type_ "radio" ! A.name "target" ! A.value "masquerade"+ let masqRadio = H.input ! A.type_ "radio" ! A.id "masquerade" ! A.name "target" ! A.value "masquerade" if checked then masqRadio ! A.checked "checked" else masqRadio- "Masquerade"+ H.label ! A.for "masquerade"+ $ "Masquerade" H.td ! A.class_ "targetParam" $ do- "port:"- H.input ! A.type_ "text" ! A.name "masqport" ! A.value (fromString masqPort) >> H.br- "random:"+ H.label ! A.for "masqport"+ $ "port:"+ H.input ! A.type_ "text" ! A.id "masqport" ! A.name "masqport" ! A.value (fromString masqPort) >> H.br+ H.label ! A.for "masqrandom"+ $ "random:" checkBox "masqrandom" masqRand renderUserChain :: Bool -> [String] -> String -> Html renderUserChain checked allChains chain = H.tr $ do H.td ! A.class_ "target" $ do- let userChainRadio = H.input ! A.type_ "radio" ! A.name "target" ! A.value "userChain"+ let userChainRadio = H.input ! A.type_ "radio" ! A.id "userChain" ! A.name "target" ! A.value "userChain" if checked then userChainRadio ! A.checked "checked" else userChainRadio- "User chain"+ H.label ! A.for "userChain"+ $ "User chain" H.td ! A.class_ "targetParam" $ H.select ! A.id "userChain" ! A.name "userChain" $ mapM_ (renderOption chain) allChains
src/IptAdmin/EditPage.hs view
@@ -35,10 +35,7 @@ let userChainNames = getUserChains formParams chainName table - return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Edit rule in '" ++ tableName- ++ "' table in '" ++ chainName- ++ "' chain in position " ++ show rulePosition+ return $ buildResponse $ renderHtml $ editFormHtml (tableName, chainName, rulePosition, userChainNames) formParams Nothing pageHandlerPost :: IptAdmin Response@@ -54,10 +51,7 @@ let checkResE = editPageProcessParams addFormParams case checkResE of- Left formResp -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Edit rule in '" ++ tableName- ++ "' table in '" ++ chainName- ++ "' chain in position " ++ show rulePosition+ Left formResp -> return $ buildResponse $ renderHtml $ do editFormHtml (tableName, chainName, rulePosition, userChainNames) addFormParams $ Just formResp Right (opts, tar, formResp) -> do let (_, opts') = runState (mapM_ completeModules opts) opts@@ -65,15 +59,13 @@ submit <- getInputString "submit" case submit of- "Check" -> return $ buildResponse $ Template.htmlWrapper $ renderHtml (do- header tableName $ "Edit rule in '" ++ tableName- ++ "' table in '" ++ chainName- ++ "' chain in position " ++ show rulePosition+ "Check" -> return $ buildResponse $ renderHtml (do editFormHtml (tableName, chainName, rulePosition, userChainNames) addFormParams $ Just formResp- ) ++ printRuleForRun rule+ ) -- ++ printRuleForRun rule "Submit" -> do tryChange (replaceRule tableName chainName rulePosition rule)- redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName (Just rulePosition)+ -- redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName (Just rulePosition)+ return $ buildResponse "ok" a -> throwError $ "Invalid value for 'submit' parameter: " ++ a checkParams :: String -> String -> Int -> IptAdmin ([Chain], Chain, Rule)
src/IptAdmin/EditPolicyForm/Render.hs view
@@ -34,4 +34,3 @@ DROP -> dropRadio ! A.checked "checked" _ -> dropRadio "Drop"- H.input ! A.id "submit" ! A.name "submit" ! A.type_ "submit" ! A.value "Submit"
src/IptAdmin/EditPolicyPage.hs view
@@ -31,8 +31,7 @@ PUNDEFINED -> throwError $ "Not builtin chain: " ++ show chain a -> return a -- 2. Отрисовка формы- return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Change policy for '" ++ chainName ++ "' chain in '" ++ tableName ++ "' table"+ return $ buildResponse $ renderHtml $ do editPolicyForm (tableName, chainName) policy @@ -58,7 +57,9 @@ -- 3. Если изменилось, применить изменения if newPolicy == policy- then redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName Nothing+ then -- redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName Nothing+ return $ buildResponse $ "ok:" ++ show newPolicy else do tryChange (setPolicy tableName chainName newPolicy)- redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName Nothing+ -- redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName Nothing+ return $ buildResponse $ "ok:" ++ show newPolicy
src/IptAdmin/InsertPage.hs view
@@ -33,18 +33,14 @@ (PackedEditForm form) <- nullSelForm tableName chainName let userChainNames = getUserChains form chainName table- return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Insert rule in '"- ++ tableName ++ "' table in '"- ++ chainName ++ "' chain in position "- ++ show rulePosition+ return $ buildResponse $ renderHtml $ do editFormHtml (tableName, chainName, rulePosition, userChainNames) form Nothing pageHandlerPost :: IptAdmin Response pageHandlerPost = do tableName <- getInputNonEmptyString "table" chainName <- getInputNonEmptyString "chain"- rulePosition <- getInputRead "pos"+ rulePosition <- getInputRead "rulePos" table <- getTable tableName checkParams table chainName rulePosition @@ -53,11 +49,7 @@ let checkResE = editPageProcessParams editFormParams case checkResE of- Left formResp -> return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do- header tableName $ "Insert rule in '"- ++ tableName ++ "' table in '"- ++ chainName ++ "' chain in position "- ++ show rulePosition+ Left formResp -> return $ buildResponse $ renderHtml $ do editFormHtml (tableName, chainName, rulePosition, userChainNames) editFormParams $ Just formResp Right (opts, tar, formResp) -> do let (_, opts') = runState (mapM_ completeModules opts) opts@@ -65,16 +57,13 @@ submit <- getInputString "submit" case submit of- "Check" -> return $ buildResponse $ Template.htmlWrapper $ renderHtml (do- header tableName $ "Insert rule in '"- ++ tableName ++ "' table in '"- ++ chainName ++ "' chain in position "- ++ show rulePosition+ "Check" -> return $ buildResponse $ renderHtml (do editFormHtml (tableName, chainName, rulePosition, userChainNames) editFormParams $ Just formResp- ) ++ printRuleForRun rule+ ) -- ++ printRuleForRun rule "Submit" -> do tryChange (insertRule tableName chainName rulePosition rule)- redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName (Just rulePosition)+ -- redir $ "/show?table=" ++ tableName ++ bookmarkForJump chainName (Just rulePosition)+ return $ buildResponse "ok" a -> throwError $ "Invalid value for 'submit' parameter: " ++ a checkParams :: [Chain] -> String -> Int -> IptAdmin ()
src/IptAdmin/LoginPage.hs view
@@ -8,7 +8,7 @@ import Data.Monoid import Data.String import Data.Time-import Happstack.Server.SimpleHTTP+import Happstack.Server.SimpleHTTP hiding (Session) import Template import IptAdmin.Render import IptAdmin.System@@ -49,11 +49,11 @@ loginForm login $ Just errorMsg Nothing -> do -- 1. Генерируем рандомный id- sessionId <- liftIO $ replicateM 50 $ randomRIO ('A', 'z')+ sessionId <- liftIO $ replicateM 50 $ randomRIO ('a', 'z') -- 2. Добавляем установку кукиса в заголовок -- 2.1. Собариаем cookie let sessionIdCookie = mkCookie "sessionId" sessionId- addCookie (60 * 60 * 24 * 365 * 10) sessionIdCookie+ addCookie (MaxAge $ 60 * 60 * 24 * 365 * 10) sessionIdCookie -- 3. Обновляем состояние curTime <- liftIO getCurrentTime iptables <- getIptables
src/IptAdmin/ShowPage.hs view
@@ -5,7 +5,7 @@ import Control.Monad.Error import Control.Monad.State import Data.IORef-import Data.Map+import Data.Map hiding (filter) import Happstack.Server.SimpleHTTP import Template import IptAdmin.Render@@ -22,10 +22,64 @@ import Text.Blaze.Renderer.String (renderHtml) pageHandlers :: IptAdmin Response-pageHandlers = msum [ methodSP GET pageHandlerGet+pageHandlers = msum [ dir "rule" (methodSP GET getRule)+ , dir "chain" (methodSP GET getChain)+ , methodSP GET pageHandlerGet , methodSP POST pageHandlerPost ] +-- TODO: проверка изменений в iptables, синхронизация информации о правилах iptables+getRule :: IptAdmin Response+getRule = do+ table <- getInputString "table"+ chain <- getInputString "chain"+ pos <- getInputRead "pos"++ iptables <- getIptables++ countTypeE <- getDataFn $ lookCookieValue "countersType"+ let countType = case countTypeE of+ Left _ -> CTPackets+ Right "Bytes" -> CTBytes+ _ -> CTPackets++ rule <- case table of+ "filter" -> return $ cRules (head (filter (\c -> cName c == chain) $ tFilter iptables)) !! (pos - 1)+ "nat" -> return $ cRules (head (filter (\c -> cName c == chain) $ tNat iptables)) !! (pos - 1)+ "mangle" -> return $ cRules (head (filter (\c -> cName c == chain) $ tMangle iptables)) !! (pos - 1)+ "raw" -> return $ cRules (head (filter (\c -> cName c == chain) $ tRaw iptables)) !! (pos - 1)+ a -> throwError $ "invalid table: " ++ a+-- renderRule (tableName, chainName) countType maxCounterDiff (ruleNum, (Rule counters opts tar, Rule counters2 _ _)) =+ let ruleHtml = renderRule (table, chain) countType 0 (pos, (rule, rule))++ return $ buildResponse $ renderHtml ruleHtml++getChain :: IptAdmin Response+getChain = do+ table <- getInputString "table"+ chainName <- getInputString "chain"++ iptables <- getIptables++ countTypeE <- getDataFn $ lookCookieValue "countersType"+ let countType = case countTypeE of+ Left _ -> CTPackets+ Right "Bytes" -> CTBytes+ _ -> CTPackets++ chain <- case table of+ "filter" -> return $ head (filter (\c -> cName c == chainName) $ tFilter iptables)+ "nat" -> return $ head (filter (\c -> cName c == chainName) $ tNat iptables)+ "mangle" -> return $ head (filter (\c -> cName c == chainName) $ tMangle iptables)+ "raw" -> return $ head (filter (\c -> cName c == chainName) $ tRaw iptables)+ a -> throwError $ "invalid table: " ++ a++ refreshString <- liftIO $ show `fmap` (randomRIO (1,100000) :: IO Int)++ let chainHtml = renderChain table countType 0 refreshString (chain, chain)++ return $ buildResponse $ renderHtml chainHtml+ pageHandlerGet :: IptAdmin Response pageHandlerGet = do table <- getInputOrEmptyString "table"@@ -37,17 +91,17 @@ case setCountType of "bytes" -> do let countTypeCookie = mkCookie "countersType" "Bytes"- addCookie (60 * 60 * 24 * 365 * 10) countTypeCookie+ addCookie (MaxAge $ 60 * 60 * 24 * 365 * 10) countTypeCookie return CTBytes "packets" -> do let countTypeCookie = mkCookie "countersType" "Packets"- addCookie (60 * 60 * 24 * 365 * 10) countTypeCookie+ addCookie (MaxAge $ 60 * 60 * 24 * 365 * 10) countTypeCookie return CTPackets _ -> do- countTypeMay <- getDataFn $ lookCookieValue "countersType"- case countTypeMay of- Nothing -> return CTPackets- Just "Bytes" -> return CTBytes+ countTypeE <- getDataFn $ lookCookieValue "countersType"+ case countTypeE of+ Left _ -> return CTPackets+ Right "Bytes" -> return CTBytes _ -> return CTPackets (sessionId, sessionsIO, _) <- lift get@@ -92,6 +146,7 @@ (sortFilterTable $ tFilter iptables) (sortFilterTable $ tFilter iptables') return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do+ includeJs header "filter" "Iptables Filter table" showPageHtml filter' @@ -105,6 +160,7 @@ (sortNatTable $ tNat iptables) (sortNatTable $ tNat iptables') return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do+ includeJs header "nat" "Iptables Nat table" showPageHtml nat @@ -118,8 +174,15 @@ (sortMangleTable $ tMangle iptables) (sortMangleTable $ tMangle iptables') return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do+ includeJs header "mangle" "Iptables Mangle table. Rule editing is not supported for Mangle yet." showPageHtml mangle++includeJs :: Html+includeJs =+ H.script H.! A.type_ "text/javascript"+ H.! A.src "/static/js/showpage.js"+ $ "" showPageHtml :: Html -> Html showPageHtml table =
src/IptAdmin/ShowPage/Render.hs view
@@ -30,12 +30,17 @@ -> Html 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"+ -- H.a ! A.href (fromString $ "/addchain?table="++tableName) $ "Add chain"+ H.button ! A.class_ "button addChainButton bigActionButton"+ ! A.title "Add user defined chain"+ ! dataAttribute "table" (fromString tableName)+ ! A.id "addChainButton"+ $ "Add chain" -- | 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.table ! A.class_ "rules" ! A.id (fromString $ "chain-table-" ++ tableName ++ "-" ++ n) $ do H.tr $ do H.td ! A.colspan "4" $ H.div ! A.id "chainName" $ do@@ -47,18 +52,38 @@ 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- H.a ! A.class_ "button"- ! A.title "Edit chain name"- ! A.href (fromString $ "/editchain?table="++tableName++"&chain="++n)- $ "✎" -- e+ H.button ! A.class_ "button editChainButton actionButton"+ ! A.title "Edit chain name"+ -- ! A.href (fromString $ "/editchain?table="++tableName++"&chain="++n)+ ! dataAttribute "table" (fromString tableName)+ ! dataAttribute "chain" (fromString n)+ $ "✎" -- e+ if null rs+ then+ H.button ! A.class_ "button delChainButton actionButton"+ ! A.title "Delete chain"+ ! dataAttribute "table" (fromString tableName)+ ! dataAttribute "chain" (fromString n)+ $ "✘" -- X+ else+ H.button ! A.class_ "button disabledButton actionButton"+ ! A.title "Only empty chain can be deleted"+ ! dataAttribute "table" (fromString tableName)+ ! dataAttribute "chain" (fromString n)+ $ "✘" -- X a -> do- "Policy: "- H.a ! A.href (fromString $ "/editpolicy?table="++tableName++"&chain="++n) $- fromString $ show a+ if tableName == "filter"+ then+ H.button ! A.class_ "button editPolicyButton bigActionButton"+ ! A.title "Change policy"+ ! dataAttribute "table" (fromString tableName)+ ! dataAttribute "chain" (fromString n)+ $ "Policy:"+ else+ "Policy: "+ -- H.a ! A.href (fromString $ "/editpolicy?table="++tableName++"&chain="++n) $+ H.span ! A.id (fromString $ "policy-" ++ tableName ++ "-" ++ n)+ $ fromString $ show a " " case countType of CTBytes -> do@@ -115,14 +140,20 @@ H.th ! A.class_ "col6" $ "" 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"+ H.td ! A.colspan "7" $+ -- H.a ! A.href (fromString $ "/add?table="++tableName++"&chain="++n) $ "Add rule"+ H.button ! A.class_ "button addButton bigActionButton"+ ! A.title "Add rule"+ ! dataAttribute "chain" (fromString n)+ ! dataAttribute "table" (fromString tableName)+ $ "Add rule" -- | (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+ ! A.id (fromString $ "rule-tr-" ++ tableName ++ "-" ++ chainName ++ "-" ++ show ruleNum)+ else H.tr ! A.id (fromString $ "rule-tr-" ++ tableName ++ "-" ++ chainName ++ "-" ++ show ruleNum) mods' = filter isModule opts opts' = filter isOption opts mods'' = unwords $ map printOption mods'@@ -172,21 +203,30 @@ H.td target' H.td targetParam H.td $ do- H.a ! A.class_ "button"- ! A.title "Delete Rule"- ! A.href (fromString $ "/del?table="++tableName++"&chain="++chainName++"&pos=" ++ show ruleNum)- $ "✘" -- "X"+ H.button ! A.class_ "button insertButton actionButton"+ ! A.title "Insert Rule"+ -- ! A.href (fromString $ "/insert?table="++tableName++"&chain="++chainName++"&pos=" ++ show ruleNum)+ ! dataAttribute "rulePos" (fromString $ show ruleNum)+ ! dataAttribute "chain" (fromString chainName)+ ! dataAttribute "table" (fromString tableName)+ $ "+" if ruleEditable then- H.a ! A.class_ "button"- ! A.title "Edit Rule"- ! A.href (fromString $ "/edit?table="++tableName++"&chain="++chainName++"&pos=" ++ show ruleNum)- $ "✎" -- "e"+ H.button ! A.class_ "button editButton actionButton"+ ! A.title "Edit Rule"+ -- ! A.href (fromString $ "/edit?table="++tableName++"&chain="++chainName++"&pos=" ++ show ruleNum)+ ! dataAttribute "rulePos" (fromString $ show ruleNum)+ ! dataAttribute "chain" (fromString chainName)+ ! dataAttribute "table" (fromString tableName)+ $ "✎" -- "e" else mempty- H.a ! A.class_ "button"- ! A.title "Insert Rule"- ! A.href (fromString $ "/insert?table="++tableName++"&chain="++chainName++"&pos=" ++ show ruleNum)- $ "+"+ H.button ! A.class_ "button delButton actionButton"+ ! A.title "Delete Rule"+ -- ! A.href (fromString $ "/del?table="++tableName++"&chain="++chainName++"&pos=" ++ show ruleNum)+ ! dataAttribute "rulePos" (fromString $ show ruleNum)+ ! dataAttribute "chain" (fromString chainName)+ ! dataAttribute "table" (fromString tableName)+ $ "✘" -- "X" bytesToPrefix :: Integer -> String bytesToPrefix bytes = bytesToPrefix' ["","K","M","G","T","P","E","Z","Y"] bytes
+ src/IptAdmin/Static.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE TemplateHaskell #-}++module IptAdmin.Static where++import Control.Monad.Error hiding (lift)+import qualified Data.ByteString as B+import Data.FileEmbed+import Happstack.Server.FileServe.BuildingBlocks+import Happstack.Server.Types+import Happstack.Server.SimpleHTTP+import IptAdmin.Types+import Language.Haskell.TH.Syntax+import System.IO.Unsafe (unsafePerformIO)+import System.Time++pageHandlers :: IptAdminAuth Response+pageHandlers = msum [ dirs "css/iptadmin.css" $ returnCss $ $(embedFile "static/css/iptadmin.css")+ , dirs "js/showpage.js" $ returnJs $ $(embedFile "static/js/showpage.js")+ , dirs "js/jquery-1.6.2.min.js" $ returnJs jquery162minjs+ , dirs "js/jquery-ui-1.8.16.custom.min.js" $ returnJs jqueryUi1816customMinJs+ , dirs "css/iptadmin-theme/jquery-ui-1.8.16.custom.css" $ returnCss jqueryUi1816customCss+ , dirs "css/iptadmin-theme/images/ui-bg_flat_0_aaaaaa_40x100.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-bg_flat_0_aaaaaa_40x100.png")+ , dirs "css/iptadmin-theme/images/ui-bg_flat_75_ffffff_40x100.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-bg_flat_75_ffffff_40x100.png")+ , dirs "css/iptadmin-theme/images/ui-bg_glass_55_fbf9ee_1x400.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-bg_glass_55_fbf9ee_1x400.png")+ , dirs "css/iptadmin-theme/images/ui-bg_glass_65_ffffff_1x400.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-bg_glass_65_ffffff_1x400.png")+ , dirs "css/iptadmin-theme/images/ui-bg_glass_75_f0f0f0_1x400.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-bg_glass_75_f0f0f0_1x400.png")+ , dirs "css/iptadmin-theme/images/ui-bg_glass_75_fafafa_1x400.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-bg_glass_75_fafafa_1x400.png")+ , dirs "css/iptadmin-theme/images/ui-bg_glass_95_fef1ec_1x400.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-bg_glass_95_fef1ec_1x400.png")+ , dirs "css/iptadmin-theme/images/ui-bg_highlight-hard_75_d7d7d7_1x100.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-bg_highlight-hard_75_d7d7d7_1x100.png")+ , dirs "css/iptadmin-theme/images/ui-icons_000000_256x240.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-icons_000000_256x240.png")+ , dirs "css/iptadmin-theme/images/ui-icons_222222_256x240.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-icons_222222_256x240.png")+ , dirs "css/iptadmin-theme/images/ui-icons_2e83ff_256x240.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-icons_2e83ff_256x240.png")+ , dirs "css/iptadmin-theme/images/ui-icons_5b5b5b_256x240.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-icons_5b5b5b_256x240.png")+ , dirs "css/iptadmin-theme/images/ui-icons_cd0a0a_256x240.png" $ returnPng $+ $(embedFile "static/css/iptadmin-theme/images/ui-icons_cd0a0a_256x240.png")+ ]++returnJs :: B.ByteString -> IptAdminAuth Response+returnJs file = do+ request <- askRq+ return $ strictByteStringResponse "text/javascript; charset=utf8"+ file+ (Just (updateTime, request))+ 0+ (toInteger $ B.length file)++returnCss :: B.ByteString -> IptAdminAuth Response+returnCss file = do+ request <- askRq+ return $ strictByteStringResponse "text/css; charset=utf8"+ file+ (Just (updateTime, request))+ 0+ (toInteger $ B.length file)++returnPng :: B.ByteString -> IptAdminAuth Response+returnPng file = do+ request <- askRq+ return $ strictByteStringResponse "image/png"+ file+ (Just (updateTime, request))+ 0+ (toInteger $ B.length file)++-- | Get date and time of compilation+updateClockTime1 = $(lift $ let TOD a _ = unsafePerformIO getClockTime in a)+updateClockTime2 = $(lift $ let TOD _ b = unsafePerformIO getClockTime in b)++updateTime :: CalendarTime+updateTime = unsafePerformIO $ toCalendarTime $ TOD updateClockTime1 updateClockTime2++{-+updateTime :: CalendarTime+updateTime = CalendarTime 2011+ September+ 13+ 0+ 0+ 0+ 0+ Tuesday+ 250+ "GMT"+ 0+ False+ -}++jquery162minjs :: B.ByteString+jquery162minjs = $(embedFile "static/js/jquery-1.6.2.min.js")++jqueryUi1816customMinJs :: B.ByteString+jqueryUi1816customMinJs = $(embedFile "static/js/jquery-ui-1.8.16.custom.min.js")++jqueryUi1816customCss :: B.ByteString+jqueryUi1816customCss = $(embedFile "static/css/iptadmin-theme/jquery-ui-1.8.16.custom.css")
src/IptAdmin/Types.hs view
@@ -23,6 +23,7 @@ , backup :: Maybe String , sIptables :: Iptables }+ deriving (Show) type MainState = (SessionId, IORef Sessions, IptAdminConfig)
src/IptAdmin/Utils.hs view
@@ -6,6 +6,7 @@ import Data.IORef import Data.Map import Happstack.Server+import Iptables.Types import IptAdmin.System import IptAdmin.Types import Safe@@ -20,12 +21,12 @@ redir :: Monad m => String -> ServerPartT m Response redir url = seeOther url (toResponse "") -getInputString :: Monad m => String -> ServerPartT (ErrorT String m) String+getInputString :: MonadIO m => String -> ServerPartT (ErrorT String m) String getInputString input = do- resM <- getDataFn $ look input- case resM of- Nothing -> throwError $ "Parameter not found: " ++ input- Just res -> return res+ resE <- getDataFn $ look input+ case resE of+ Left _ -> throwError $ "Parameter not found: " ++ input+ Right res -> return res getInputNonEmptyString :: String -> IptAdmin String getInputNonEmptyString input = do@@ -53,10 +54,10 @@ isThereInput :: String -> IptAdmin Bool isThereInput input = do- resM <- getDataFn $ look input- return $ case resM of- Nothing -> False- Just _ -> True+ resE <- getDataFn $ look input+ return $ case resE of+ Left _ -> False+ Right _ -> True -- | Parser wrapper that checks eof pWrapper :: GenParser Char st a -> GenParser Char st a@@ -93,7 +94,10 @@ case backup session of Nothing -> (m, Nothing) Just iptablesStr ->- let session' = session {backup = Nothing}+ let session' = session { backup = Nothing+ -- сбрасываем счётчики iptables+ , sIptables = Iptables [] [] [] []+ } m' = insert sessionId session' m in (m', Just iptablesStr)
src/Main.hs view
@@ -10,8 +10,9 @@ import Data.Map hiding (map) import Data.Monoid import Data.Version+import Happstack.Server.Internal.Monads import Happstack.Server.SimpleHTTP-import Happstack.State+import Happstack.State.Control import IptAdmin.AccessControl import IptAdmin.AddChainPage as AddChainPage import IptAdmin.AddPage as AddPage@@ -62,7 +63,7 @@ startDaemon :: IptAdminConfig -> a -> IO () startDaemon config _ = do sessions <- newIORef empty- let httpConf = Conf (cPort config) Nothing+ let httpConf = Conf (cPort config) Nothing Nothing 60 -- create socket manually because we must listen only on 127.0.0.1 sock <- socket AF_INET Stream defaultProtocol@@ -75,7 +76,8 @@ httpTid <- forkIO $ simpleHTTPWithSocket' unpackErrorT sock httpConf- $ authorize sessions config control+ $ decodeBody (defaultBodyPolicy "/tmp/" 4096 20000 40000 )+ >> authorize sessions config control waitForTermination syslog Notice "Shutting down..." killThread httpTid
src/Template.hs view
@@ -10,255 +10,10 @@ ""++" <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />", ""++" <meta name=\"DESCRIPTION\" content=\"iptables web interface\"/>", ""++" <meta name=\"KEYWORDS\" content=\"iptables, haskell\" />",- ""++" <style type=\"text/css\">",- ""++" body {",- ""++" font-family:Arial,Helvetica,sans-serif;",- ""++" background-color: #f7f7f7;",- ""++" color: #5b5b5b;",- ""++" }",- ""++" tr.even {",- ""++" background-color:#f0f0f0;",- ""++" }",- ""++" table {",- ""++" border-collapse : collapse;",- ""++" background-color: #ffffff;",- ""++" }",- ""++" th {",- ""++" background-color: #b7b7b7;",- ""++" color: #f7f7f7;",- ""++" }",- ""++" table, th, td {",- ""++" border: 1px dotted black;",- ""++" padding: 5px;",- ""++" }",- ""++" td.rightAlign {",- ""++" text-align:right;",- ""++" }",- ""++" a:link, a:visited {",- ""++" color: #856767;",- ""++" }",- ""++" a:hover {",- ""++" color: #bb1010;",- ""++" }",- ""++" a:active {",- ""++" color: #666666;",- ""++" }",- ""++" a.title:link, a.title:visited {",- ""++" color: #856767;",- ""++" text-decoration: none;",- ""++" }",- ""++" a.title:active, a.title:hover {",- ""++" text-decoration: underline;",- ""++" }",- ""++" a.button:link, a.button:visited {",- ""++" display: block;",- ""++" float: right;",- ""++" font-weigth: bold;",- ""++" color: #f7f7f7;",- ""++" background-color: #b5aaaa;",- ""++" width: 10px;",- ""++" padding: 0px 4px 0px 4px;",- ""++" margin: 0px 3px 0px 0px;",- ""++" text-decoration: none;",- ""++" text-align: center;",- ""++" }",- ""++" a.button:hover, a.button:active {",- ""++" background-color: #bb1010;",- ""++" }",- ""++" div.logout {",- ""++" float:right;",- ""++" padding: 20px;",- ""++" }",- ""++" #title {",- ""++" float: left;",- ""++" padding: 15px;",- ""++" color: #bbbbbb;",- ""++" font-size: 26px;",- ""++" }",- ""++" span.version {",- ""++" margin-left: 0.5em;",- ""++" font-size: 0.5em;",- ""++" }",- ""++" #links {",- ""++" margin-left: auto;",- ""++" margin-right: auto;",- ""++" width: 9.5em;",- ""++" padding: 20px;",- ""++" /*padding-left: 65px;",- ""++" */",- ""++" text-align: center;",- ""++" /*",- ""++" margin-left: 200px;",- ""++" */",- ""++" }",- ""++" a.activeTableLink:link, a.activeTableLink:visited {",- ""++" display: block;",- ""++" float:left;",- ""++" color: #f7f7f7;",- ""++" background-color: #b5aaaa;",- ""++" padding: 4px;",- ""++" margin: 0px 3px 0px 0px;",- ""++" text-decoration: none;",- ""++" }",- ""++" a.activeTableLink:hover, a.activeTableLink:active {",- ""++" background-color: #bb1010;",- ""++" }",- ""++" a.tableLink:link, a.tableLink:visited {",- ""++" display: block;",- ""++" float:left;",- ""++" color: #856767;",- ""++" background-color: #f7f7f7;",- ""++" padding: 4px;",- ""++" margin: 0px 3px 0px 0px;",- ""++" text-decoration: none;",- ""++" }",- ""++" a.tableLink:hover, a.tableLink:active {",- ""++" color: #bb1010;",- ""++" }",- ""++" #localLinks {",- ""++" float: left;",- ""++" background: #deeeee;",- ""++" margin-left: 100px;",- ""++" padding: 10px;",- ""++" }",- ""++" div.pageHeader {",- ""++" width: 50%;",- ""++" margin-top: 10px;",- ""++" margin-left: auto;",- ""++" margin-right: auto;",- ""++" text-align: center;",- ""++" }",- ""++" #rules {",- ""++" margin-left: auto;",- ""++" margin-right: auto;",- ""++" width: 100%;",- ""++" max-width: 1000px;",- ""++" padding-top: 10px;",- ""++" }",- ""++" input.resetButton {",- ""++" padding: 0;",- ""++" }",- ""++" div.loginForm {",- ""++" /*float: left;",- ""++" margin-left: auto;",- ""++" margin-right: auto;",- ""++" */",- ""++" position: absolute;",- ""++" top: 50%;",- ""++" left: 50%;",- ""++" margin-top: -40px;",- ""++" margin-left: -130px;",- ""++" }",- ""++" div.loginForm2 {",- ""++" height: 80px;",- ""++" width: 280px;",- ""++" background: #ffffff;",- ""++" border: 1px solid #666666;",- ""++" border-radius: 15px;",- ""++" -moz-border-radius: 15px;",- ""++" padding: 15px;",- ""++" text-align: center;",- ""++" }",- ""++" span.loginForm {",- ""++" color: #ababab;",- ""++" }",- ""++" table.loginForm, td.loginForm {",- ""++" border: none;",- ""++" padding: 0px;",- ""++" }",- ""++" td.loginForm {",- ""++" padding: 2px;",- ""++" }",- ""++" div.editForm {",- ""++" padding-top: 20px;",- ""++" margin-left: auto;",- ""++" margin-right: auto;",- ""++" max-width: 700px",- ""++" }",- ""++" table.rules {",- ""++" margin-top: 10px;",- ""++" border: 1px solid #666666;",- ""++" width: 100%;",- ""++" }",- ""++" table.editForm {",- ""++" border: 1px solid #666666;",- ""++" }",- ""++" th.col0 {",- ""++" width : 5px;",- ""++" padding: 0;",- ""++" }",- ""++" th.col1 {",- ""++" width : 15px;",- ""++" }",- ""++" th.col4 {",- ""++" width : 60px;",- ""++" }",- ""++" th.col6 {",- ""++" width : 64px;",- ""++" }",- ""++" /*",- ""++" Цвета для различных targets",- ""++" */",- ""++" span.acceptTarget {",- ""++" color: #4e994f;",- ""++" }",- ""++" span.dropTarget {",- ""++" color: #dd2222;",- ""++" }",- ""++" span.rejectTarget {",- ""++" color: #a54638;",- ""++" }",- ""++" span.snatTarget {",- ""++" color: #7a997b;",- ""++" }",- ""++" span.masqueradeTarget {",- ""++" color: #4e994f;",- ""++" }",- ""++" span.dnatTarget {",- ""++" color: #77aac5;",- ""++" }",- ""++" span.redirectTarget {",- ""++" color: #7783c5;",- ""++" }",- ""++" span.chainTarget {",- ""++" color: #000000;",- ""++" }",- ""++" span.unknownTarget {",- ""++" color: #ababab;",- ""++" }",- ""++" /*",- ""++" Стили для вложенной таблицы и элемента таблицы,",- ""++" в которой вкладывается таблица",- ""++" */",- ""++" td.inline {",- ""++" margin: 0;",- ""++" padding: 0;",- ""++" }",- ""++" table.inline {",- ""++" border-style: none;",- ""++" width: 100%",- ""++" }",- ""++" /*",- ""++" Стили элементов таблиц для скрытия рамки вокруг таблицы,",- ""++" это приводило к утолщению сетки в местах сопряжения",- ""++" */",- ""++" th.target {",- ""++" border-left: none;",- ""++" border-top: none;",- ""++" }",- ""++" th.targetParam {",- ""++" border-right: none;",- ""++" border-top: none;",- ""++" }",- ""++" td.target {",- ""++" border-bottom: none;",- ""++" border-left: none;",- ""++" }",- ""++" td.targetParam {",- ""++" border-bottom: none;",- ""++" border-right: none;",- ""++" }",- ""++" </style>",+ ""++" <link rel=\"stylesheet\" type=\"text/css\" href=\"/static/css/iptadmin-theme/jquery-ui-1.8.16.custom.css\" />",+ ""++" <script type=\"text/javascript\" src=\"/static/js/jquery-1.6.2.min.js\"></script>",+ ""++" <script type=\"text/javascript\" src=\"/static/js/jquery-ui-1.8.16.custom.min.js\"></script>",+ ""++" <link href=\"/static/css/iptadmin.css\" rel=\"stylesheet\" type=\"text/css\" title=\"Iptadmin\" />", ""++" </head>", ""++" <body>", ""++content,