Split commands off

[blackboard-dns.git] / DDNS / Client / MakeReq.hs

diff --git a/DDNS/Client/MakeReq.hs b/DDNS/Client/MakeReq.hs
new file mode 100644 (file)
index 0000000..b9baa49
--- /dev/null
+++ b/DDNS/Client/MakeReq.hs
@@ -0,0 +1,49 @@
+module DDNS.Client.MakeReq
+    ( makeReq
+    )
+    where
+
+import           Control.Monad
+import           Control.Monad.Trans
+import           DDNS.Utils
+import           OpenSSL.PEM
+import           OpenSSL.RSA
+import           OpenSSL.X509.Request
+import           System.Console.Haskeline
+import           System.IO
+import           System.Posix.Files
+import           System.Posix.Uname
+
+makeReq :: IO ()
+makeReq
+    = do fqdn <- runInputT defaultSettings $
+                 do defaultFqdn <- liftM uNodeName $ liftIO uname
+                    fqdn        <- getInputLine ("What's your FQDN? (default: " ++ defaultFqdn ++ "): ")
+                    case trim fqdn of
+                      Just s -> return s
+                      _      -> return defaultFqdn
+
+         putStrLn "Generating RSA keypair..."
+         key <- generateRSAKey 1024 3 Nothing
+
+         let pubFile = fqdn ++ ".pub"
+         withFile pubFile WriteMode $ \ h ->
+             writePublicKey key >>= hPutStr h
+         putStrLn ("Wrote " ++ pubFile)
+
+         let keyFile = fqdn ++ ".key"
+         withFile keyFile WriteMode $ \ h ->
+             writePKCS8PrivateKey key Nothing >>= hPutStr h
+         setFileMode keyFile ownerReadMode
+         putStrLn ("Wrote " ++ keyFile ++ " (with no encryption)")
+
+         req <- newX509Req
+         setVersion     req 2
+         setSubjectName req [("CN", fqdn)]
+         setPublicKey   req key
+         signX509Req    req key Nothing
+         let reqFile = fqdn ++ ".req"
+         withFile reqFile WriteMode $ \ h ->
+             writeX509Req req ReqNewFormat >>= hPutStr h
+         putStrLn ("Wrote " ++ reqFile)
+         putStrLn ("Now send " ++ reqFile ++ " to the server operator and tell him/her to sign it.")