From c2dbb32adf34a9bcef54e913f9bc025d846f056e Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Sun, 10 Apr 2016 17:27:31 -0400 Subject: fix bug where "." as subdomain was not substituted --- acme-certify.hs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/acme-certify.hs b/acme-certify.hs index 3944e2a..73aff51 100644 --- a/acme-certify.hs +++ b/acme-certify.hs @@ -252,20 +252,19 @@ domainToString = unpack . decodeUtf8 . Text.Domain.Validate.toByteString data VHostSpec = VHostSpec DomainName (Either DomainName FilePath) deriving Show makeVHostSpec :: DomainName -> String -> VHostSpec -makeVHostSpec = make +makeVHostSpec parentDomain vhostSpecStr = VHostSpec (domainName' vhostName) (left domainName' spec) where - make (domainToString -> parentDomain) (splitSpec -> (sub, spec)) = - VHostSpec (domainName' $ sub <..> parentDomain) (makeRef spec) - where - makeRef :: Either String FilePath -> Either DomainName FilePath - makeRef = left (\refSub -> domainName' $ refSub <..> parentDomain) + vhostName = appendParent sub + (sub, spec) = splitSpec vhostSpecStr splitSpec :: String -> (String, Either String FilePath) splitSpec (break (== '{') -> (a, b)) = (,) a $ case b of ('{':c@('/':_)) -> Right $ takeWhile (/= '}') c - ('{':c) -> Left $ takeWhile (/= '}') c - _ -> Right $ "/srv" a "public_html" + ('{':c) -> Left $ takeWhile (/= '}') c & appendParent + _ -> Right $ "/srv" vhostName "public_html" + + appendParent = (<..> domainToString parentDomain) data TempRemover = TempRemover { removeTemp :: IO () } remoteTemp :: String -> FilePath -> String -> IO TempRemover -- cgit v1.2.3