-
- case getRequiredArg m Command of
- "signreq"
- -> signReq key cert
- _ -> usageError m ""
-
-ensureWeHaveKeypair :: FilePath -> IO (SomeKeyPair, X509)
-ensureWeHaveKeypair lsdir
- = do let keyFile = lsdir </> "server.key"
- certFile = lsdir </> "server.cert"
- keyExi <- doesFileExist keyFile
- cerExi <- doesFileExist certFile
- if keyExi && cerExi then
- do key <- flip readPrivateKey PwNone =<< readFile keyFile
- cert <- readX509 =<< readFile certFile
- return (key, cert)
- else
- do fqdn <- runInputT defaultSettings $
- do defaultFqdn <- liftM uNodeName $ liftIO uname
- fqdn <- getInputLine ("What's your FQDN? (default: " ++ defaultFqdn ++ "): ")
- case fqdn of
- Just s@(_:_) -> return s
- _ -> return defaultFqdn
-
- putStrLn "Generating RSA keypair..."
- key <- generateRSAKey 1024 3 Nothing
- withFile keyFile WriteMode $ \ h ->
- writePKCS8PrivateKey key Nothing >>= hPutStr h
- setFileMode keyFile ownerReadMode
- putStrLn ("Wrote " ++ keyFile)
-
- cert <- newX509
- X509.setVersion cert 2
- X509.setSerialNumber cert 1
- X509.setIssuerName cert [("CN", fqdn)]
- X509.setSubjectName cert [("CN", fqdn)]
- X509.setNotBefore cert =<< liftM (addUTCTime (-1)) getCurrentTime
- X509.setNotAfter cert =<< liftM (addUTCTime (20 * 365 * 24 * 60 * 60)) getCurrentTime
- X509.setPublicKey cert key
- X509.signX509 cert key Nothing
- withFile certFile WriteMode $ \ h ->
- writeX509 cert >>= hPutStr h
- putStrLn ("Wrote " ++ certFile)
-
- return (fromKeyPair key, cert)
-
-signReq :: KeyPair k => k -> X509 -> IO ()
-signReq sKey sCert
- = runInputT (setComplete completeFilename defaultSettings) $
- do file <- getInputLine "Which X.509 request do you want to sign?: "
- case file of
- Just file'@(_:_)
- -> liftIO $
- do req <- readX509Req =<< readFile file'
- key <- Req.getPublicKey req
- vst <- verifyX509Req req key
- unless (vst == VerifySuccess)
- $ fail "Invalid X.509 request"
-
- cert <- makeX509FromReq req sCert
- setSerialNumber cert 1 -- FIXME: This nasty behavior makes revocation-list unusable.
- setNotBefore cert =<< liftM (addUTCTime (-1)) getCurrentTime
- setNotAfter cert =<< liftM (addUTCTime (20 * 365 * 24 * 60 * 60)) getCurrentTime
- signX509 cert sKey Nothing
-
- let certFile = file' `replaceExtension` ".cert"
- withFile certFile WriteMode $ \ h ->
- writeX509 cert >>= hPutStr h
- putStrLn ("Wrote " ++ certFile)
-
- Just (_, fqdn) <- liftM (find ((== "CN") . fst)) $ X509.getSubjectName cert False
- putStrLn ("Now send " ++ certFile ++ " back to " ++ fqdn ++ ".")
- _ -> return ()
-
-{-
-main = do sqliteConnect "ddns.db" $ \ db ->
- dbSpecToDatabase db dbinfo
-
- rawCon <- RAW.connectSqlite3 "ddns.db"
- mapM_ (\ sql -> RAW.run rawCon sql []) indexDeclarations
- RAW.commit rawCon
- RAW.disconnect rawCon
--}
\ No newline at end of file