module IptAdmin.EditPage where import Control.Monad.Error import Control.Monad.State import Happstack.Server.SimpleHTTP 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 import Iptables import Iptables.Print import Iptables.Types import Safe import Text.Blaze.Renderer.Pretty (renderHtml) pageHandlers :: IptAdmin Response pageHandlers = msum [ methodSP GET pageHandlerGet , methodSP POST pageHandlerPost ] pageHandlerGet :: IptAdmin Response pageHandlerGet = do tableName <- getInputNonEmptyString "table" chainName <- getInputNonEmptyString "chain" rulePosition <- getInputRead "pos" (table, _, rule) <- checkParams tableName chainName rulePosition (PackedEditForm formParams) <- ruleToSelForm rule tableName chainName let userChainNames = getUserChains formParams chainName table return $ buildResponse $ renderHtml $ editFormHtml (tableName, chainName, rulePosition, userChainNames) formParams Nothing pageHandlerPost :: IptAdmin Response pageHandlerPost = do tableName <- getInputNonEmptyString "table" chainName <- getInputNonEmptyString "chain" rulePosition <- getInputRead "rulePos" (table, _, _) <- checkParams tableName chainName rulePosition (PackedEditForm addFormParams) <- httpInputToSelForm tableName chainName let userChainNames = getUserChains addFormParams chainName table let checkResE = editPageProcessParams addFormParams case checkResE of 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 let rule = Rule (Counters 0 0) opts' tar submit <- getInputString "submit" case submit of "Check" -> return $ buildResponse $ renderHtml (do editFormHtml (tableName, chainName, rulePosition, userChainNames) addFormParams $ Just formResp ) -- ++ printRuleForRun rule "Submit" -> do tryChange (replaceRule tableName chainName rulePosition rule) -- 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) checkParams tableName chainName rulePosition = do table <- getTable tableName let chainMay = getChainByName chainName table chain <- maybe (throwError $ "Invalid chain name: " ++ chainName) return chainMay let ruleMay = cRules chain `atMay` (rulePosition - 1) rule <- maybe (throwError $ "Rule index out of range: " ++ show rulePosition) return ruleMay return (table, chain, rule)