iptadmin 1.2.1 → 1.3.0
raw patch · 20 files changed
+296/−73 lines, 20 filesdep +augeasdep +blaze-markupdep +happstack-server-tlsdep −happstack-statedep −happstack-utildep −haskell98dep ~blaze-htmldep ~containersdep ~happstack-server
Dependencies added: augeas, blaze-markup, happstack-server-tls
Dependencies removed: happstack-state, happstack-util, haskell98
Dependency ranges changed: blaze-html, containers, happstack-server, old-time
Files
- Changelog +7/−0
- doc/examples/config/iptadmin.conf +6/−0
- iptadmin.cabal +10/−10
- src/IptAdmin/Config.hs +16/−3
- src/IptAdmin/DelChainPage/Render.hs +1/−1
- src/IptAdmin/DelPage/Render.hs +1/−1
- src/IptAdmin/EditChainForm/Render.hs +2/−2
- src/IptAdmin/EditForm/Render.hs +10/−10
- src/IptAdmin/EditPolicyForm/Render.hs +3/−3
- src/IptAdmin/LoginPage.hs +1/−1
- src/IptAdmin/Render.hs +13/−13
- src/IptAdmin/ShowPage.hs +4/−2
- src/IptAdmin/ShowPage/Render.hs +19/−4
- src/IptAdmin/Types.hs +6/−0
- src/IptAdmin/Utils.hs +36/−1
- src/Main.hs +81/−18
- static/css/iptadmin.css +12/−1
- static/js/showpage.js +67/−1
- util/ptmpl/ptmpl.cabal +0/−1
- util/ptmpl/src/Main.hs +1/−1
Changelog view
@@ -1,3 +1,10 @@+iptadmin 1.3.0 22.10.2012:+ * Add https support+ * Add dialog for configuring ipv4 forwarding+ * Fix js error related to inserting iptables rule+ * Fix frontend markup for firefox 16+ * Update dependenicy list: base-4, happstack-7, blaze-markup-0.5+ iptadmin 1.2.1 17.09.2011: * Add static files to iptadmin.cabal and source tarball.
doc/examples/config/iptadmin.conf view
@@ -1,3 +1,9 @@ save command = /etc/init.d/iptables save port = 8000 pam name = iptadmin+ssl = enabled++[SSL]+create pair if does not exist = true+crt path = /etc/iptadmin/iptadmin.crt+key path = /etc/iptadmin/iptadmin.key
iptadmin.cabal view
@@ -1,5 +1,5 @@ Name: iptadmin-Version: 1.2.1+Version: 1.3.0 Cabal-Version: >= 1.4 Author: Evgeny Tarasov Build-type: Simple@@ -11,7 +11,7 @@ Stability: Stable Synopsis: web-interface for iptables Description: web-interface for iptables with PAM authorization-Category: System, Tools, Web+Category: System, Tools, Web, Application Extra-source-files: html/htmlwrapper.html, util/ptmpl/Setup.hs, util/ptmpl/ptmpl.cabal,@@ -44,19 +44,18 @@ Executable iptadmin Build-Depends: base >= 4 && < 5,- haskell98, utf8-string >= 0.3, bytestring >= 0.9,- happstack-server >= 6.2 && < 6.3,- happstack-state >= 6.1 && < 6.2,- happstack-util >= 6 && < 6.1,+ happstack-server >= 7.0 && < 7.1,+ happstack-server-tls >= 7.0 && < 7.1, mtl >= 1.1, safe >= 0.3, iptables-helpers >= 0.4 && < 0.5, process >= 1.0 && < 2,- blaze-html >= 0.4,+ blaze-html >= 0.5,+ blaze-markup >= 0.5 && < 0.6, parsec >= 2.1,- containers >= 0.3,+ containers >= 0.4 && < 6, time >= 1.1 && < 2, random >= 1.0 && < 2, pam >= 0.1 && < 1,@@ -67,8 +66,9 @@ hsyslog >= 1.4 && < 2, 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+ old-time >= 1.0.0.3 && < 1.2,+ template-haskell >= 2.4,+ augeas >= 0.6 && < 0.7 Main-Is: Main.hs Other-modules: IptAdmin.AccessControl IptAdmin.AddChainPage
src/IptAdmin/Config.hs view
@@ -19,9 +19,22 @@ saveCommand <- get cp "DEFAULT" "save command" port <- get cp "DEFAULT" "port" pamName <- get cp "DEFAULT" "pam name"- return $ IptAdminConfig saveCommand- port- pamName+ sslEnabled <- get cp "DEFAULT" "ssl"+ if sslEnabled then do+ createPair <- get cp "SSL" "create pair if does not exist"+ crtPath <- get cp "SSL" "crt path"+ keyPath <- get cp "SSL" "key path"+ return $ IptAdminConfig saveCommand+ port+ pamName+ $ Just $ SSLConfig createPair+ crtPath+ keyPath+ else+ return $ IptAdminConfig saveCommand+ port+ pamName+ Nothing case configE of Left (_, err) -> throwError ("Error on reading " ++ cONFpATHd </> cONFIGURATIONf ++ "\n" ++ err) Right config -> return config
src/IptAdmin/DelChainPage/Render.hs view
@@ -7,7 +7,7 @@ import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A -delChainForm :: String -> String -> Html+delChainForm :: String -> String -> Markup delChainForm tableName chainName = H.div ! A.class_ "editForm" $ H.form ! A.id "delChainform" ! A.method "post" $ do
src/IptAdmin/DelPage/Render.hs view
@@ -7,7 +7,7 @@ import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A -delPageForm :: (String, String, Int) -> String -> Html+delPageForm :: (String, String, Int) -> String -> Markup delPageForm (tableName, chainName, rulePos) rule = H.div ! A.class_ "editForm" $ H.form ! A.id "delform" ! A.method "post" $ do
src/IptAdmin/EditChainForm/Render.hs view
@@ -8,7 +8,7 @@ import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A -editChainForm :: (String, String) -> String -> Maybe String -> Html+editChainForm :: (String, String) -> String -> Maybe String -> Markup editChainForm (tableName, chainName) newChainName mesMay = H.div ! A.class_ "editForm" $ H.form ! A.id "editChainForm" ! A.method "post" $ do@@ -19,6 +19,6 @@ H.td $ H.input ! A.type_ "text" ! A.name "newChainName" ! A.value (fromString newChainName) ! A.maxlength "20" case mesMay of- Nothing -> mempty :: Html+ Nothing -> mempty :: Markup Just mes -> H.td $ fromString mes
src/IptAdmin/EditForm/Render.hs view
@@ -12,7 +12,7 @@ import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A -checkBox :: String -> Bool -> Html+checkBox :: String -> Bool -> Markup checkBox name on = do let chBox = H.input ! A.type_ "checkbox" ! A.id (fromString name)@@ -21,7 +21,7 @@ if on then chBox ! A.checked "checked" else chBox -printMesTd :: ResMessage -> Html+printMesTd :: ResMessage -> Markup printMesTd rm = H.td $ fromString $ case rm of RMError mes -> mes RMSucc mes -> "ok " ++ mes@@ -31,7 +31,7 @@ maybeListToListMaybe (Just list) = map Just list maybeListToListMaybe Nothing = repeat Nothing -editFormHtml :: EditForm a => (String,String,Int,[String]) -> a -> Maybe [ResMessage] -> Html+editFormHtml :: EditForm a => (String,String,Int,[String]) -> a -> Maybe [ResMessage] -> Markup editFormHtml (tableName, chainName, rulePos, userChainNames) form errorListMay = let entryList = toEntryList form mesListMay = maybeListToListMaybe errorListMay@@ -49,7 +49,7 @@ maybe mempty (\_-> H.th "Message") errorListMay mapM_ (renderFormEntry userChainNames) $ zip entryList mesListMay -renderFormEntry :: [String] -> (FormEntry, Maybe ResMessage) -> Html+renderFormEntry :: [String] -> (FormEntry, Maybe ResMessage) -> Markup renderFormEntry _ (FESrc en inv str, resMesMay) = H.tr $ do H.td $ do@@ -351,7 +351,7 @@ maybe mempty printMesTd resMesMay renderFormEntry _ a = H.tr $ fromString $ "Unknown form entry: " ++ show a -renderDNat :: Bool -> String -> Bool -> Bool -> Html+renderDNat :: Bool -> String -> Bool -> Bool -> Markup renderDNat checked dnatAddr dnatRand dnatPersist = H.tr $ do H.td ! A.class_ "target" $ do@@ -371,7 +371,7 @@ $ "persistent:" checkBox "dnatpersistent" dnatPersist >> H.br -renderRedirect :: Bool -> String -> Bool -> Html+renderRedirect :: Bool -> String -> Bool -> Markup renderRedirect checked redirPort redirRand = H.tr $ do H.td ! A.class_ "target" $ do@@ -388,7 +388,7 @@ $ "random:" checkBox "redirrandom" redirRand -renderSNat :: Bool -> String -> Bool -> Bool -> Html+renderSNat :: Bool -> String -> Bool -> Bool -> Markup renderSNat checked snatAddr snatRand snatPersist = H.tr $ do H.td ! A.class_ "target" $ do@@ -407,7 +407,7 @@ H.label ! A.for "snatpersistent" $ "persistent:" checkBox "snatpersistent" snatPersist >> H.br-renderMasq :: Bool -> String -> Bool -> Html+renderMasq :: Bool -> String -> Bool -> Markup renderMasq checked masqPort masqRand = H.tr $ do H.td ! A.class_ "target" $ do@@ -424,7 +424,7 @@ $ "random:" checkBox "masqrandom" masqRand -renderUserChain :: Bool -> [String] -> String -> Html+renderUserChain :: Bool -> [String] -> String -> Markup renderUserChain checked allChains chain = H.tr $ do H.td ! A.class_ "target" $ do@@ -437,7 +437,7 @@ H.select ! A.id "userChain" ! A.name "userChain" $ mapM_ (renderOption chain) allChains where- renderOption :: String -> String -> Html+ renderOption :: String -> String -> Markup renderOption selName optName = do let opt = H.option ! A.value (fromString optName) $ fromString optName let optSel = if optName == selName then opt ! A.selected "selected"
src/IptAdmin/EditPolicyForm/Render.hs view
@@ -9,11 +9,11 @@ import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A -editPolicyForm :: (String, String) -> Policy -> Html+editPolicyForm :: (String, String) -> Policy -> Markup editPolicyForm (tableName, chainName) policy = do case policy of- ACCEPT -> mempty :: Html- DROP -> mempty :: Html+ ACCEPT -> mempty :: Markup+ DROP -> mempty a -> fromString ("Unsupported policy type: " ++ show a) H.div ! A.class_ "editForm" $ H.form ! A.id "editPolicyForm" ! A.method "post" $ do
src/IptAdmin/LoginPage.hs view
@@ -68,7 +68,7 @@ -- 4. Редиректим на /show redir "/show" -loginForm :: String -> Maybe String -> Html+loginForm :: String -> Maybe String -> Markup loginForm login mesMay = H.div ! A.class_ "loginForm" $ do H.div ! A.class_ "loginForm2" $
src/IptAdmin/Render.hs view
@@ -13,7 +13,7 @@ import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A -header :: String -> String -> Html+header :: String -> String -> Markup header tableName pageHeader = do let filterB = tableName == "filter" let mangleB = tableName == "mangle"@@ -24,7 +24,7 @@ H.div ! A.class_ "pageHeader" $ fromString pageHeader -title :: Html+title :: Markup title = H.div ! A.id "title" $ do H.a ! A.class_ "title" ! A.href "/" $ "IptAdmin"@@ -32,7 +32,7 @@ fromString $ intercalate "." $ map show $ versionBranch version -- Booleans says which link should be distinguished-links :: Bool -> Bool -> Bool -> Html+links :: Bool -> Bool -> Bool -> Markup links filt nat mangle = let filtA = H.a ! A.href "/show?table=filter" $ "Filter"@@ -52,12 +52,12 @@ if mangle then mangleA ! A.class_ "activeTableLink" else mangleA ! A.class_ "tableLink" -logout :: Html+logout :: Markup logout = H.div ! A.class_ "logout" $ H.a ! A.href "/logout" $ "Logout" -renderTarget :: RuleTarget -> (Html, Html)+renderTarget :: RuleTarget -> (Markup, Markup) renderTarget target = case target of TAccept -> (H.span ! A.class_ "acceptTarget" $ "ACCEPT", mempty) TDrop -> (H.span ! A.class_ "dropTarget" $ "DROP", mempty)@@ -81,10 +81,10 @@ fromString (printNatAddr natAddr) " " if rand then "random"- else mempty :: Html+ else mempty :: Markup " " if persist then "persist"- else mempty :: Html+ else mempty :: Markup in (target', param) TDNat natAddr rand persist ->@@ -93,34 +93,34 @@ fromString (printNatAddr natAddr) " " if rand then "random"- else mempty :: Html+ else mempty :: Markup " " if persist then "persist"- else mempty :: Html+ else mempty :: Markup in (target', param) TMasquerade natPort rand -> let target' = H.span ! A.class_ "masqueradeTarget" $ "MASQUERADE" param = do case natPort of- NatPortDefault -> mempty :: Html+ NatPortDefault -> mempty :: Markup _ -> fromString (printNatPort natPort) if rand then do " " "random"- else mempty :: Html+ else mempty :: Markup in (target', param) TRedirect natPort rand -> let target' = H.span ! A.class_ "redirectTarget" $ "REDIRECT" param = do case natPort of- NatPortDefault -> mempty :: Html+ NatPortDefault -> mempty :: Markup _ -> fromString (printNatPort natPort) if rand then do " " "random"- else mempty :: Html+ else mempty :: Markup in (target', param) TUChain chainName ->
src/IptAdmin/ShowPage.hs view
@@ -159,9 +159,11 @@ refreshString (sortNatTable $ tNat iptables) (sortNatTable $ tNat iptables')+ forwState <- getForwardingState return $ buildResponse $ Template.htmlWrapper $ renderHtml $ do includeJs header "nat" "Iptables Nat table"+ renderIpForwarding forwState showPageHtml nat showMangle :: CountersType -> Iptables -> Iptables -> IptAdmin Response@@ -178,13 +180,13 @@ header "mangle" "Iptables Mangle table. Rule editing is not supported for Mangle yet." showPageHtml mangle -includeJs :: Html+includeJs :: Markup includeJs = H.script H.! A.type_ "text/javascript" H.! A.src "/static/js/showpage.js" $ "" -showPageHtml :: Html -> Html+showPageHtml :: Markup -> Markup showPageHtml table = H.div H.! A.id "rules" $ table
src/IptAdmin/ShowPage/Render.hs view
@@ -11,6 +11,7 @@ import Iptables.Print import Iptables.Types import Text.Blaze+import Text.Blaze.Internal import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A @@ -27,7 +28,7 @@ -> String -- ^ random string for 'refresh' link -> [Chain] -- ^ table's chains -> [Chain] -- ^ chains with relative start counters state- -> Html+ -> Markup 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"@@ -37,8 +38,8 @@ ! A.id "addChainButton" $ "Add chain" --- | Table name -> counters type -> max counter -> refresh string -> Chain -> Html-renderChain :: String -> CountersType -> Integer -> String -> (Chain,Chain) -> Html+-- | Table name -> counters type -> max counter -> refresh string -> Chain -> Markup+renderChain :: String -> CountersType -> Integer -> String -> (Chain,Chain) -> Markup renderChain tableName countType maxCounterDiff refreshString (Chain n p counters rs, Chain _ _ counters' rs') = H.table ! A.class_ "rules" ! A.id (fromString $ "chain-table-" ++ tableName ++ "-" ++ n) $ do H.tr $ do@@ -149,7 +150,7 @@ $ "Add rule" -- | (Table name, Chain name) -> Counters type -> max counter -> Rule -> Html-renderRule :: (String, String) -> CountersType -> Integer -> (Int, (Rule, Rule)) -> Html+renderRule :: (String, String) -> CountersType -> Integer -> (Int, (Rule, Rule)) -> Markup renderRule (tableName, chainName) countType maxCounterDiff (ruleNum, (Rule counters opts tar, Rule counters2 _ _)) = let mainTr = if even ruleNum then H.tr ! A.class_ "even" ! A.id (fromString $ "rule-tr-" ++ tableName ++ "-" ++ chainName ++ "-" ++ show ruleNum)@@ -241,3 +242,17 @@ show b ++ x else bytesToPrefix' xs nextLevel++renderIpForwarding :: Bool -> Markup+renderIpForwarding forwState = do+ H.button ! A.id "forwStateButton"+ ! A.class_ "bigActionButton editIpForwButton"+ $ "IPv4 Forwarding:"+ H.span ! A.id (case forwState of+ True -> "ipForwardOn"+ False -> "ipForwardOff"+ )+ $ do+ toMarkup $ case forwState of+ True -> "On" :: String+ False -> "Off"
src/IptAdmin/Types.hs view
@@ -30,7 +30,13 @@ data IptAdminConfig = IptAdminConfig { cSaveCommand :: String , cPort :: Int , cPamName :: String+ , cSSL :: Maybe SSLConfig }++data SSLConfig = SSLConfig { scCreatePair :: Bool+ , scCrtPath :: String+ , scKeyPath :: String+ } -- | Display bytes or packets on show page data CountersType = CTBytes
src/IptAdmin/Utils.hs view
@@ -3,13 +3,17 @@ import Control.Concurrent import Control.Monad.Error import Control.Monad.State+import Data.ByteString(empty)+import Data.ByteString.UTF8(fromString) import Data.IORef-import Data.Map+import Data.Map hiding (empty)+import Foreign.ForeignPtr.Safe import Happstack.Server import Iptables.Types import IptAdmin.System import IptAdmin.Types import Safe+import System.Augeas import Text.ParserCombinators.Parsec.Prim hiding (State (..)) import Text.ParserCombinators.Parsec.Char import Text.ParserCombinators.Parsec.Combinator@@ -120,3 +124,34 @@ "#" ++ chainName ++ "_" ++ show (ruleNum - 15) else "#chain_" ++ chainName++getForwardingState :: MonadIO m => ServerPartT (ErrorT String m) Bool+getForwardingState = do+ forwStateStr <- liftIO $ readFile "/proc/sys/net/ipv4/ip_forward"+ let forwState = read forwStateStr :: Integer+ case forwState of+ 0 -> return False+ 1 -> return True+ a -> throwError $ "get " ++ show a ++ " from /proc/sys/net/ipv4/ip_foward"++setForwardingState :: MonadIO m => Bool -> ServerPartT (ErrorT String m) ()+setForwardingState forwState = do+ -- 1. /proc/...+ let forwState' = case forwState of+ True -> "1"+ False -> "0"+ liftIO $ writeFile "/proc/sys/net/ipv4/ip_forward" forwState'++ -- 2. /etc/sysctl.conf @ augeas+ augMay <- liftIO $ aug_init empty empty []+ aug <- case augMay of+ Just a -> return a+ Nothing -> throwError "Error on augeas init"++ res <- liftIO $ withForeignPtr aug (\a -> aug_set a (fromString "files/etc/sysctl.conf/net.ipv4.ip_forward") (fromString forwState'))+ when (res /= success) $+ throwError $ "Error on augeas run: " ++ show res++ res <- liftIO $ withForeignPtr aug aug_save+ when (res /= success) $+ throwError $ "Error on augeas run: " ++ show res
src/Main.hs view
@@ -12,7 +12,7 @@ import Data.Version import Happstack.Server.Internal.Monads import Happstack.Server.SimpleHTTP-import Happstack.State.Control+import Happstack.Server.SimpleHTTPS import IptAdmin.AccessControl import IptAdmin.AddChainPage as AddChainPage import IptAdmin.AddPage as AddPage@@ -20,6 +20,7 @@ import IptAdmin.DelChainPage as DelChainPage import IptAdmin.DelPage as DelPage import IptAdmin.EditChainPage as EditChainPage+import IptAdmin.EditIpForwPage as EditIpForwPage import IptAdmin.EditPage as EditPage import IptAdmin.EditPolicyPage as EditPolicyPage import IptAdmin.InsertPage as InsertPage@@ -32,7 +33,10 @@ import Prelude hiding (catch) import System.Exit import System.Environment+import System.IO+import System.Process import System.Posix.Daemonize+import System.Posix.Files import System.Posix.User import System.Posix.Syslog @@ -63,26 +67,38 @@ startDaemon :: IptAdminConfig -> a -> IO () startDaemon config _ = do sessions <- newIORef empty- 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- setSocketOption sock ReuseAddr 1- loopbackIp <- inet_addr "127.0.0.1"- bindSocket sock $- SockAddrInet (fromInteger $ toInteger $ cPort config) loopbackIp- listen sock (max 1024 maxListenQueue)+ case cSSL config of+ Nothing -> do+ let httpConf = Conf (cPort config) Nothing Nothing 60 Nothing - httpTid <- forkIO $ simpleHTTPWithSocket' unpackErrorT- sock- httpConf- $ decodeBody (defaultBodyPolicy "/tmp/" 4096 20000 40000 )- >> authorize sessions config control- waitForTermination- syslog Notice "Shutting down..."- killThread httpTid- syslog Notice "Shutdown complete"+ -- create socket manually because we must listen only on 127.0.0.1+ sock <- socket AF_INET Stream defaultProtocol+ setSocketOption sock ReuseAddr 1+ loopbackIp <- inet_addr "127.0.0.1"+ bindSocket sock $+ SockAddrInet (fromInteger $ toInteger $ cPort config) loopbackIp+ listen sock (max 1024 maxListenQueue) + httpTid <- forkIO $ simpleHTTPWithSocket' unpackErrorT+ sock+ httpConf+ $ decodeBody (defaultBodyPolicy "/tmp/" 4096 20000 40000 )+ >> authorize sessions config control+ waitForTermination+ syslog Notice "Shutting down..."+ killThread httpTid+ syslog Notice "Shutdown complete"+ Just sslConfig -> do+ checkAndCreatePair sslConfig+ let tlsConf = nullTLSConf { tlsPort = cPort config+ , tlsCert = scCrtPath sslConfig+ , tlsKey = scKeyPath sslConfig+ }+ simpleHTTPS' unpackErrorT+ tlsConf+ $ decodeBody (defaultBodyPolicy "/tmp/" 4096 20000 40000 ) >> authorize sessions config control+ unpackErrorT :: (Monad m) => UnWebT (ErrorT String m) a -> UnWebT m a unpackErrorT handler = do resE <- runErrorT handler@@ -103,6 +119,7 @@ , dir "editchain" EditChainPage.pageHandlers , dir "delchain" DelChainPage.pageHandlers , dir "editpolicy" EditPolicyPage.pageHandlers+ , dir "editipforw" EditIpForwPage.pageHandlers ] {- | Save changes if user have changed something@@ -130,3 +147,49 @@ when (userID_ /= 0) $ do putStrLn "the program have to be run under root privileges" exitFailure++checkAndCreatePair :: SSLConfig -> IO ()+checkAndCreatePair sslConfig = do+ crtExist <- fileExist $ scCrtPath sslConfig+ keyExist <- fileExist $ scKeyPath sslConfig++ let checkRegFile filePath = do+ st <- getFileStatus $ filePath+ if isRegularFile st then return False+ else return True++ crtWrongType <- if crtExist+ then checkRegFile $ scCrtPath sslConfig+ else return False+ when crtWrongType $ do+ syslog Critical $ "crt path already exists and it's not a regular file: " ++ scCrtPath sslConfig+ exitFailure++ keyWrongType <- if keyExist+ then checkRegFile $ scKeyPath sslConfig+ else return False++ when keyWrongType $ do+ syslog Critical $ "key path already exists and it's not a regular file: " ++ scKeyPath sslConfig+ exitFailure++ when (not crtExist || not keyExist) $+ do+ if scCreatePair sslConfig+ then do+ -- TODO: check for parent directory+ syslog Notice $ "Creating selfsigned key pair: " ++ scCrtPath sslConfig ++ ", " ++ scKeyPath sslConfig+ (_, _, _, h) <- liftIO $ runInteractiveCommand $ "openssl req -new -x509 -nodes -out "+ ++ scCrtPath sslConfig+ ++ " -keyout "+ ++ scKeyPath sslConfig+ ++ " -batch"+ ec <- liftIO $ waitForProcess h+ case ec of+ ExitSuccess -> return () -- hGetContents o+ ExitFailure a -> do+ syslog Critical $ "error while running openssl: " ++ show a+ exitFailure+ else do+ syslog Critical $ "key and crt pair doesn't exist"+ exitFailure
static/css/iptadmin.css view
@@ -183,7 +183,7 @@ width : 60px; } th.col6 {- width : 64px;+ width : 69px; } /* Цвета для различных targets@@ -341,3 +341,14 @@ padding: 5px; } +/* Цвета флага ip forwarding+ */+span#ipForwardOn{+ padding-left: 4px;+ color: green;+}++span#ipForwardOff{+ padding-left: 4px;+ color: red;+}
static/js/showpage.js view
@@ -31,6 +31,7 @@ $(".addChainButton").click(addChainButtonHandler); $(".delChainButton").click(delChainButtonHandler); $(".editPolicyButton").click(editPolicyButtonHandler);+ $(".editIpForwButton").click(editIpForwButtonHandler); }; var ajaxError = function (x, t, m) {@@ -246,7 +247,7 @@ }); } else {- dialog1.html(ans2);+ dialog1.html(ans9); dialog1.dialog("option","width",'auto'); dialog1.dialog("option","height",'auto'); dialog1.dialog("option","position","center");@@ -624,6 +625,71 @@ $('#dialog1').html(""); dialog1 = $('#dialog1').dialog({ title: 'Select policy',+ modal: true,+ resizable: false,+ buttons: dialogButtons,+ });+ dialog1.html(ans);+ dialog1.dialog("option","width",'auto');+ dialog1.dialog("option","height",'auto');+ dialog1.dialog("option","position","center");+ },+ });+ };+ var editIpForwButtonHandler = function () {+ $.ajax({+ url: '/editipforw',+ dataType: 'html',+ error: ajaxError,+ success: function (ans) {+ var dialogButtons = [+ {+ text: "Submit",+ click: function () {+ dialog1.dialog("option","buttons",[]);+ var str = $("#editIpForwForm").serialize();+ $.ajax({+ type: "POST",+ url: "/editipforw",+ data: str,+ error: ajaxError,+ success: function (ans) {+ dialog1.dialog("option", "buttons", dialogButtons);+ if (ans.split(':')[0] == "ok") {+ dialog1.dialog("destroy");+ newSpan = "";+ switch(ans.split(':')[1]){+ case "on":+ newSpan = '<span id="ipForwardOn">On</span>';+ $('#ipForwardOff').replaceWith(newSpan);+ break;+ case "off":+ newSpan = '<span id="ipForwardOff">Off</span>';+ $('#ipForwardOn').replaceWith(newSpan);+ break;+ default: alert("wrong value: " + ans.split(':')[1]);+ };+ }+ else {+ dialog1.html(ans);+ dialog1.dialog("option","width",'auto');+ dialog1.dialog("option","height",'auto');+ dialog1.dialog("option","position","center");+ }+ },+ });+ },+ },+ {+ text: "Cancel",+ click: function() {+ dialog1.dialog("destroy");+ },+ },+ ];+ $('#dialog1').html("");+ dialog1 = $('#dialog1').dialog({+ title: 'Select forwarding state', modal: true, resizable: false, buttons: dialogButtons,
util/ptmpl/ptmpl.cabal view
@@ -13,7 +13,6 @@ Executable ptmpl Build-Depends: base >= 3 && < 5,- haskell98, parsec >= 2.1 Main-Is: Main.hs Hs-Source-Dirs: src
util/ptmpl/src/Main.hs view
@@ -1,7 +1,7 @@ module Main where -import System+import System.Environment import Text.ParserCombinators.Parsec main :: IO ()