diff --git a/app/CLI/Commands/ChildSA.hs b/app/CLI/Commands/ChildSA.hs --- a/app/CLI/Commands/ChildSA.hs +++ b/app/CLI/Commands/ChildSA.hs @@ -33,6 +33,7 @@ cfgCloseAction cfgIPCompression cfgReqID + cfgMark setChildSA :: Text -> StateT AppState IO Action setChildSA name = do @@ -132,6 +133,12 @@ param "req-id" "" integer $ \reqID -> do ipsecSettings . getChildSAConfig . childSAReqID .= reqID flushIt + +cfgMark :: Commands () +cfgMark = + param "mark" "" string $ \mark -> do + ipsecSettings . getChildSAConfig . childSAMark .= Just mark + flushIt flushChildSA :: StateT AppState IO Action flushChildSA = do diff --git a/app/CLI/Commands/PeerCfg.hs b/app/CLI/Commands/PeerCfg.hs --- a/app/CLI/Commands/PeerCfg.hs +++ b/app/CLI/Commands/PeerCfg.hs @@ -1,7 +1,8 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} module CLI.Commands.PeerCfg where -import Control.Lens ((.=)) +import Control.Lens ((.=), use) import Control.Monad (void, when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) @@ -202,15 +203,17 @@ showPeer' = do AppState{_ipsecSettings = IPSecSettings{_getPeerConfig=PeerConfig{..}}} <- get let iD = _peerCfgId >>= return . show + localId <- fetchIdentity _peerCfgLocalId + remoteId <- fetchIdentity _peerCfgRemoteId liftIO $ do putStr "Peer Config " when (_peerCfgName /= "") $ putStr $ '\'': unpack _peerCfgName ++ "' " putStrLn $ "(ID: " ++ fromMaybe "*uncommitted*" iD ++ ")" putStrLn $ "=================================="; putStrLn $ "IKE version: " ++ show _peerCfgIKEVersion - putStrLn $ "IKE config ID: " ++ show _peerCfgIKEConfigId - putStrLn $ "Local identity: " ++ show _peerCfgLocalId - putStrLn $ "Remote identity: " ++ show _peerCfgRemoteId + putStrLn $ "IKE config ID: " ++ maybe "" show _peerCfgIKEConfigId + putStrLn $ "Local identity: " ++ maybe "" show localId + putStrLn $ "Remote identity: " ++ maybe "" show remoteId putStrLn $ "Cert. policy: " ++ nameOf _peerCfgCertPolicy putStrLn $ "Unique Ids: " ++ nameOf _peerCfgUniqueIds putStrLn $ "Auth method: " ++ nameOf _peerCfgAuthMethod @@ -229,3 +232,7 @@ putStrLn $ "Mediated by: " ++ show _peerCfgMediatedBy putStrLn $ "Peer ID: " ++ show _peerCfgPeerId return NoAction + where fetchIdentity ident = runMaybeT $ do + db <- lift $ use dbContext + iD <- MaybeT $ return ident + findIdentity iD db diff --git a/app/CLI/Types.hs b/app/CLI/Types.hs --- a/app/CLI/Types.hs +++ b/app/CLI/Types.hs @@ -91,25 +91,27 @@ fromName str = failure $ InvalidValue str instance Nameable SQL.EAPType where - nameOf SQL.EAPMD5 = "md5" - nameOf SQL.EAPGTC = "gtc" - nameOf SQL.EAPTLS = "tls" - nameOf SQL.EAPSIM = "sim" - nameOf SQL.EAPTTLS = "ttls" - nameOf SQL.EAPAKA = "aka" - nameOf SQL.EAPMSCHAPV2 = "mschapv2" - nameOf SQL.EAPTNC = "tnc" - nameOf SQL.EAPRADIUS = "radius" - fromName "md5" = return SQL.EAPMD5 - fromName "gtc" = return SQL.EAPGTC - fromName "tls" = return SQL.EAPTLS - fromName "sim" = return SQL.EAPSIM - fromName "ttls" = return SQL.EAPTTLS - fromName "aka" = return SQL.EAPAKA - fromName "mschapv2" = return SQL.EAPMSCHAPV2 - fromName "tnc" = return SQL.EAPTNC - fromName "radius" = return SQL.EAPRADIUS - fromName str = failure $ InvalidValue str + nameOf SQL.EAPUnspecified = "unspecified" + nameOf SQL.EAPMD5 = "md5" + nameOf SQL.EAPGTC = "gtc" + nameOf SQL.EAPTLS = "tls" + nameOf SQL.EAPSIM = "sim" + nameOf SQL.EAPTTLS = "ttls" + nameOf SQL.EAPAKA = "aka" + nameOf SQL.EAPMSCHAPV2 = "mschapv2" + nameOf SQL.EAPTNC = "tnc" + nameOf SQL.EAPRADIUS = "radius" + fromName "md5" = return SQL.EAPMD5 + fromName "gtc" = return SQL.EAPGTC + fromName "tls" = return SQL.EAPTLS + fromName "sim" = return SQL.EAPSIM + fromName "ttls" = return SQL.EAPTTLS + fromName "aka" = return SQL.EAPAKA + fromName "mschapv2" = return SQL.EAPMSCHAPV2 + fromName "tnc" = return SQL.EAPTNC + fromName "radius" = return SQL.EAPRADIUS + fromName "unspecified" = return SQL.EAPUnspecified + fromName str = failure $ InvalidValue str instance Nameable SQL.AuthMethod where nameOf = fmap toLower . show diff --git a/src/StrongSwan/SQL/Encoding.hs b/src/StrongSwan/SQL/Encoding.hs --- a/src/StrongSwan/SQL/Encoding.hs +++ b/src/StrongSwan/SQL/Encoding.hs @@ -116,7 +116,8 @@ toSQL $ toTinyInt _childSADPDAction, toSQL $ toTinyInt _childSACloseAction, toSQL $ toTinyInt _childSAIPCompression, - toSQL $ toInt _childSAReqID ] + toSQL $ toInt _childSAReqID, + toSQL $ toVarChar _childSAMark ] fromValues (iD: name : lifeTime : @@ -130,6 +131,7 @@ closeAction : ipCompression : reqID : + mark : []) = ChildSAConfig { _childSAId = return . fromInt $ fromSQL iD, _childSAName = fromJust . fromVarChar $ fromSQL name, @@ -143,7 +145,8 @@ _childSADPDAction = fromTinyInt $ fromSQL dpdAction, _childSACloseAction = fromTinyInt $ fromSQL closeAction, _childSAIPCompression = fromTinyInt $ fromSQL ipCompression, - _childSAReqID = fromInt $ fromSQL reqID + _childSAReqID = fromInt $ fromSQL reqID, + _childSAMark = fromVarChar $ fromSQL mark } fromValues xs = throw $ SQLValuesMismatch "ChildSAConfig" (show xs) diff --git a/src/StrongSwan/SQL/Statements.hs b/src/StrongSwan/SQL/Statements.hs --- a/src/StrongSwan/SQL/Statements.hs +++ b/src/StrongSwan/SQL/Statements.hs @@ -153,13 +153,13 @@ deleteIKEStatement = "DELETE FROM ike_configs WHERE id = ?;" updateChildSAStatement :: SQL.Query -updateChildSAStatement = "UPDATE child_configs SET name = ?, lifetime = ?, rekeytime = ?, jitter = ?, updown = ?, hostaccess = ?, mode = ?, start_action = ?, dpd_action = ?, close_action = ?, ipcomp = ?, reqid = ? WHERE id = ?" +updateChildSAStatement = "UPDATE child_configs SET name = ?, lifetime = ?, rekeytime = ?, jitter = ?, updown = ?, hostaccess = ?, mode = ?, start_action = ?, dpd_action = ?, close_action = ?, ipcomp = ?, reqid = ?, mark = ? WHERE id = ?" createChildSATableStatement :: SQL.Query -createChildSATableStatement = "CREATE TABLE `child_configs` ( `id` int(10) unsigned NOT NULL auto_increment, `name` varchar(32) collate utf8_unicode_ci NOT NULL, `lifetime` mediumint(8) unsigned NOT NULL default '1500', `rekeytime` mediumint(8) unsigned NOT NULL default '1200', `jitter` mediumint(8) unsigned NOT NULL default '60', `updown` varchar(128) collate utf8_unicode_ci default NULL, `hostaccess` tinyint(1) unsigned NOT NULL default '0', `mode` tinyint(4) unsigned NOT NULL default '2', `start_action` tinyint(4) unsigned NOT NULL default '0', `dpd_action` tinyint(4) unsigned NOT NULL default '0', `close_action` tinyint(4) unsigned NOT NULL default '0', `ipcomp` tinyint(4) unsigned NOT NULL default '0', `reqid` mediumint(8) unsigned NOT NULL default '0', PRIMARY KEY (`id`), INDEX (`name`)) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;" +createChildSATableStatement = "CREATE TABLE `child_configs` ( `id` int(10) unsigned NOT NULL auto_increment, `name` varchar(32) collate utf8_unicode_ci NOT NULL, `lifetime` mediumint(8) unsigned NOT NULL default '1500', `rekeytime` mediumint(8) unsigned NOT NULL default '1200', `jitter` mediumint(8) unsigned NOT NULL default '60', `updown` varchar(128) collate utf8_unicode_ci default NULL, `hostaccess` tinyint(1) unsigned NOT NULL default '0', `mode` tinyint(4) unsigned NOT NULL default '2', `start_action` tinyint(4) unsigned NOT NULL default '0', `dpd_action` tinyint(4) unsigned NOT NULL default '0', `close_action` tinyint(4) unsigned NOT NULL default '0', `ipcomp` tinyint(4) unsigned NOT NULL default '0', `reqid` mediumint(8) unsigned NOT NULL default '0', `mark` varchar(32) collate utf8_unicode_ci default NULL, PRIMARY KEY (`id`), INDEX (`name`)) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;" createChildSAStatement :: SQL.Query -createChildSAStatement = "INSERT INTO child_configs (name, lifetime, rekeytime, jitter, updown, hostaccess, mode, start_action, dpd_action, close_action, ipcomp, reqid) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);" +createChildSAStatement = "INSERT INTO child_configs (name, lifetime, rekeytime, jitter, updown, hostaccess, mode, start_action, dpd_action, close_action, ipcomp, reqid, mark) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);" findChildSAByNameStatement :: SQL.Query findChildSAByNameStatement = "SELECT * FROM child_configs WHERE name = ?;" diff --git a/src/StrongSwan/SQL/Types.hs b/src/StrongSwan/SQL/Types.hs --- a/src/StrongSwan/SQL/Types.hs +++ b/src/StrongSwan/SQL/Types.hs @@ -75,8 +75,17 @@ | IPv6AddrID (Maybe Int) IPv6 -- IPv6 Address | ASN1ID (Maybe Int) [ASN1] -- DER encoded ASN.1 distinguished name | OpaqueID (Maybe Int) ByteString -- Opaque octet string as ID - deriving (Eq, Show) + deriving (Eq) +instance Show Identity where + show (AnyID iD) = "%any (" ++ show iD ++ ")" + show (IPv4AddrID iD ipv4) = "ipv4: " ++ show ipv4 ++ " (" ++ show iD ++ ")" + show (NameID iD name) = "fqdn: " ++ T.unpack name ++ " (" ++ show iD ++ ")" + show (EmailID iD mbox domain) = "email: " ++ T.unpack mbox ++ '@':T.unpack domain ++ " (" ++ show iD ++ ")" + show (IPv6AddrID iD ipv6) = "ipv6: " ++ show ipv6 ++ " (" ++ show iD ++ ")" + show (ASN1ID iD asn1s) = "asn1: " ++ show asn1s ++ " (" ++ show iD ++ ")" + show (OpaqueID iD bytes) = "opaque:" ++ unpack bytes ++ " (" ++ show iD ++ ")" + getIdentityId :: Identity -> Maybe Int getIdentityId (AnyID iD) = iD getIdentityId (IPv4AddrID iD _) = iD @@ -289,7 +298,8 @@ toEnum 4 = XAUTH toEnum x = throw $ UnknownAuthMethod x -data EAPType = EAPMD5 +data EAPType = EAPUnspecified + | EAPMD5 | EAPGTC | EAPTLS | EAPSIM @@ -301,16 +311,18 @@ deriving (Eq, Show) instance Enum EAPType where - fromEnum EAPMD5 = 4 - fromEnum EAPGTC = 6 - fromEnum EAPTLS = 13 - fromEnum EAPSIM = 18 - fromEnum EAPTTLS = 21 - fromEnum EAPAKA = 23 - fromEnum EAPMSCHAPV2 = 26 - fromEnum EAPTNC = 38 - fromEnum EAPRADIUS = 253 + fromEnum EAPUnspecified = 0 + fromEnum EAPMD5 = 4 + fromEnum EAPGTC = 6 + fromEnum EAPTLS = 13 + fromEnum EAPSIM = 18 + fromEnum EAPTTLS = 21 + fromEnum EAPAKA = 23 + fromEnum EAPMSCHAPV2 = 26 + fromEnum EAPTNC = 38 + fromEnum EAPRADIUS = 253 + toEnum 0 = EAPUnspecified toEnum 4 = EAPMD5 toEnum 6 = EAPGTC toEnum 13 = EAPTLS @@ -397,7 +409,8 @@ _childSADPDAction :: SAAction, _childSACloseAction :: SAAction, _childSAIPCompression :: Bool, - _childSAReqID :: Word32 + _childSAReqID :: Word32, + _childSAMark :: Maybe Text } deriving (Eq, Show) instance Default ChildSAConfig where @@ -414,7 +427,8 @@ _childSADPDAction = None, _childSACloseAction = None, _childSAIPCompression = False, - _childSAReqID = 0 + _childSAReqID = 0, + _childSAMark = Nothing } data PeerConfig = PeerConfig { @@ -454,7 +468,7 @@ _peerCfgCertPolicy = SendIfAsked, _peerCfgUniqueIds = True, _peerCfgAuthMethod = PubKey, - _peerCfgEAPType = EAPMSCHAPV2, + _peerCfgEAPType = EAPUnspecified, _peerCfgEAPVendor = 0, _peerCfgKeyingTries = 3, _peerCfgRekeyTime = 7200, diff --git a/strongswan-sql.cabal b/strongswan-sql.cabal --- a/strongswan-sql.cabal +++ b/strongswan-sql.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 8e901b023b4ac4274a0d123daf925a7dbcda18addb33e2bf88f710374ce1813d +-- hash: 6f32d30a00fb61271491341c0c55cdade3033598fbb9b665676f78315947f5ae name: strongswan-sql -version: 1.1.0.0 +version: 1.2.0.0 synopsis: Interface library for strongSwan SQL backend description: Interface library and companion CLI tool to configure strongSwan IPsec over MySQL backend category: Console, Library, Network APIs, SQL @@ -52,7 +52,7 @@ , lens >=4.17 && <4.18 , mtl >=2.2 && <2.3 , mysql-haskell >=0.8.4 && <0.8.5 - , network >=3.0 && <3.1 + , network >=2.8 && <3.1 , structured-cli >=2.5.0.3 && <2.6 , text >=1.2 && <1.3 , transformers >=0.4.2 && <0.6 @@ -86,7 +86,7 @@ , lens >=4.17 && <4.18 , mtl >=2.2 && <2.3 , mysql-haskell >=0.8.4 && <0.8.5 - , network >=3.0 && <3.1 + , network >=2.8 && <3.1 , strongswan-sql , structured-cli >=2.5.0.3 && <2.6 , text >=1.2 && <1.3 @@ -116,7 +116,7 @@ , lens >=4.17 && <4.18 , mtl >=2.2 && <2.3 , mysql-haskell >=0.8.4 && <0.8.5 - , network >=3.0 && <3.1 + , network >=2.8 && <3.1 , strongswan-sql , structured-cli >=2.5.0.3 && <2.6 , text >=1.2 && <1.3