summaryrefslogtreecommitdiff
path: root/validatecert.hs
diff options
context:
space:
mode:
Diffstat (limited to 'validatecert.hs')
-rw-r--r--validatecert.hs13
1 files changed, 9 insertions, 4 deletions
diff --git a/validatecert.hs b/validatecert.hs
index 19df9fc..efbf84a 100644
--- a/validatecert.hs
+++ b/validatecert.hs
@@ -54,7 +54,7 @@ parseHeader first_line = parseHeaderWords $ S.words first_line
54 parseHeaderWords (channelId:_) 54 parseHeaderWords (channelId:_)
55 = Left $ channelId <> " BH message=\"Insufficient words in message.\"\1" 55 = Left $ channelId <> " BH message=\"Insufficient words in message.\"\1"
56 parseHeaderWords [] 56 parseHeaderWords []
57 = Left $ "what: " <> bshow first_line <> "\n" 57 = Left ""
58 58
59data ValidationError = ValidationError 59data ValidationError = ValidationError
60 { veName :: S.ByteString 60 { veName :: S.ByteString
@@ -70,10 +70,13 @@ pemToCert pem = either (const Nothing) Just $ decodeSignedObject obj
70 obj = foldl1' (<>) $ L.toChunks $ pemBlob pem 70 obj = foldl1' (<>) $ L.toChunks $ pemBlob pem
71 71
72certSubject :: Cert -> S.ByteString 72certSubject :: Cert -> S.ByteString
73certSubject cert = maybe "" X509.getCharacterStringRawData cn 73certSubject cert = maybe "" X509.getCharacterStringRawData
74 $ foldr1 mplus [cn,ou,o]
74 where 75 where
75 dn = X509.certSubjectDN $ X509.getCertificate cert 76 dn = X509.certSubjectDN $ X509.getCertificate cert
76 cn = X509.getDnElement X509.DnCommonName dn 77 cn = X509.getDnElement X509.DnCommonName dn
78 ou = X509.getDnElement X509.DnOrganizationUnit dn
79 o = X509.getDnElement X509.DnOrganization dn
77 80
78data ValidationRequest = ValidationRequest 81data ValidationRequest = ValidationRequest
79 { vrHostname :: S.ByteString 82 { vrHostname :: S.ByteString
@@ -99,7 +102,8 @@ main = do
99 continue e $ \first_line -> do 102 continue e $ \first_line -> do
100 when (S.all isSpace first_line) 103 when (S.all isSpace first_line)
101 next 104 next
102 let wlog' s | debug = wlog s 105 let wlog' s | S.null s = return ()
106 | debug = wlog s
103 | otherwise = return () 107 | otherwise = return ()
104 flip (either wlog') (parseHeader first_line) $ \(channelId,code,bodylen,body0) -> do 108 flip (either wlog') (parseHeader first_line) $ \(channelId,code,bodylen,body0) -> do
105 when debug $ wlog $ "GOT " <> "Code=" <> code <> " " <> bshow bodylen <> "\n" 109 when debug $ wlog $ "GOT " <> "Code=" <> code <> " " <> bshow bodylen <> "\n"
@@ -125,7 +129,8 @@ main = do
125 else channelId <> " ERR " <> len <> " " <> response0 <> "\1" 129 else channelId <> " ERR " <> len <> " " <> response0 <> "\1"
126 S.putStr response 130 S.putStr response
127 hFlush stdout 131 hFlush stdout
128 when debug $ wlog $ ">> " <> S.init response <> "\n" 132 when debug $ forM_ (S.lines $ S.init response) $ \msg -> do
133 wlog $ ">> " <> msg <> "\n"
129 next 134 next
130 135
131createResponse :: ValidationRequest -> Map S.ByteString ValidationError -> S.ByteString 136createResponse :: ValidationRequest -> Map S.ByteString ValidationError -> S.ByteString