diff options
Diffstat (limited to 'validatecert.hs')
-rw-r--r-- | validatecert.hs | 13 |
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 | ||
59 | data ValidationError = ValidationError | 59 | data 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 | ||
72 | certSubject :: Cert -> S.ByteString | 72 | certSubject :: Cert -> S.ByteString |
73 | certSubject cert = maybe "" X509.getCharacterStringRawData cn | 73 | certSubject 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 | ||
78 | data ValidationRequest = ValidationRequest | 81 | data 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 | ||
131 | createResponse :: ValidationRequest -> Map S.ByteString ValidationError -> S.ByteString | 136 | createResponse :: ValidationRequest -> Map S.ByteString ValidationError -> S.ByteString |