diff --git a/Changelog b/Changelog
--- a/Changelog
+++ b/Changelog
@@ -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.
diff --git a/Makefile b/Makefile
--- a/Makefile
+++ b/Makefile
@@ -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
diff --git a/html/htmlwrapper.html b/html/htmlwrapper.html
--- a/html/htmlwrapper.html
+++ b/html/htmlwrapper.html
@@ -8,255 +8,10 @@
-
+
+
+
+
!@#content
diff --git a/iptadmin.cabal b/iptadmin.cabal
--- a/iptadmin.cabal
+++ b/iptadmin.cabal
@@ -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
diff --git a/src/IptAdmin/AccessControl.hs b/src/IptAdmin/AccessControl.hs
--- a/src/IptAdmin/AccessControl.hs
+++ b/src/IptAdmin/AccessControl.hs
@@ -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
diff --git a/src/IptAdmin/AddChainPage.hs b/src/IptAdmin/AddChainPage.hs
--- a/src/IptAdmin/AddChainPage.hs
+++ b/src/IptAdmin/AddChainPage.hs
@@ -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
diff --git a/src/IptAdmin/AddPage.hs b/src/IptAdmin/AddPage.hs
--- a/src/IptAdmin/AddPage.hs
+++ b/src/IptAdmin/AddPage.hs
@@ -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 ()
diff --git a/src/IptAdmin/DelChainPage.hs b/src/IptAdmin/DelChainPage.hs
--- a/src/IptAdmin/DelChainPage.hs
+++ b/src/IptAdmin/DelChainPage.hs
@@ -70,4 +70,5 @@
++ show linkedChains
else do
tryChange $ deleteChain tableName chainName
- redir $ "/show?table=" ++ tableName
+ -- redir $ "/show?table=" ++ tableName
+ return $ buildResponse "ok"
diff --git a/src/IptAdmin/DelPage.hs b/src/IptAdmin/DelPage.hs
--- a/src/IptAdmin/DelPage.hs
+++ b/src/IptAdmin/DelPage.hs
@@ -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
diff --git a/src/IptAdmin/EditChainForm/Render.hs b/src/IptAdmin/EditChainForm/Render.hs
--- a/src/IptAdmin/EditChainForm/Render.hs
+++ b/src/IptAdmin/EditChainForm/Render.hs
@@ -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"
diff --git a/src/IptAdmin/EditChainPage.hs b/src/IptAdmin/EditChainPage.hs
--- a/src/IptAdmin/EditChainPage.hs
+++ b/src/IptAdmin/EditChainPage.hs
@@ -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
diff --git a/src/IptAdmin/EditForm/Render.hs b/src/IptAdmin/EditForm/Render.hs
--- a/src/IptAdmin/EditForm/Render.hs
+++ b/src/IptAdmin/EditForm/Render.hs
@@ -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
diff --git a/src/IptAdmin/EditPage.hs b/src/IptAdmin/EditPage.hs
--- a/src/IptAdmin/EditPage.hs
+++ b/src/IptAdmin/EditPage.hs
@@ -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)
diff --git a/src/IptAdmin/EditPolicyForm/Render.hs b/src/IptAdmin/EditPolicyForm/Render.hs
--- a/src/IptAdmin/EditPolicyForm/Render.hs
+++ b/src/IptAdmin/EditPolicyForm/Render.hs
@@ -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"
diff --git a/src/IptAdmin/EditPolicyPage.hs b/src/IptAdmin/EditPolicyPage.hs
--- a/src/IptAdmin/EditPolicyPage.hs
+++ b/src/IptAdmin/EditPolicyPage.hs
@@ -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
diff --git a/src/IptAdmin/InsertPage.hs b/src/IptAdmin/InsertPage.hs
--- a/src/IptAdmin/InsertPage.hs
+++ b/src/IptAdmin/InsertPage.hs
@@ -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 ()
diff --git a/src/IptAdmin/LoginPage.hs b/src/IptAdmin/LoginPage.hs
--- a/src/IptAdmin/LoginPage.hs
+++ b/src/IptAdmin/LoginPage.hs
@@ -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
diff --git a/src/IptAdmin/ShowPage.hs b/src/IptAdmin/ShowPage.hs
--- a/src/IptAdmin/ShowPage.hs
+++ b/src/IptAdmin/ShowPage.hs
@@ -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 =
diff --git a/src/IptAdmin/ShowPage/Render.hs b/src/IptAdmin/ShowPage/Render.hs
--- a/src/IptAdmin/ShowPage/Render.hs
+++ b/src/IptAdmin/ShowPage/Render.hs
@@ -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
diff --git a/src/IptAdmin/Static.hs b/src/IptAdmin/Static.hs
new file mode 100644
--- /dev/null
+++ b/src/IptAdmin/Static.hs
@@ -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")
diff --git a/src/IptAdmin/Types.hs b/src/IptAdmin/Types.hs
--- a/src/IptAdmin/Types.hs
+++ b/src/IptAdmin/Types.hs
@@ -23,6 +23,7 @@
, backup :: Maybe String
, sIptables :: Iptables
}
+ deriving (Show)
type MainState = (SessionId, IORef Sessions, IptAdminConfig)
diff --git a/src/IptAdmin/Utils.hs b/src/IptAdmin/Utils.hs
--- a/src/IptAdmin/Utils.hs
+++ b/src/IptAdmin/Utils.hs
@@ -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)
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -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
diff --git a/src/Template.hs b/src/Template.hs
--- a/src/Template.hs
+++ b/src/Template.hs
@@ -10,255 +10,10 @@
""++" ",
""++" ",
""++" ",
- ""++" ",
+ ""++" ",
+ ""++" ",
+ ""++" ",
+ ""++" ",
""++" ",
""++" ",
""++content,