DDNS/Client/MakeReq.hs

   1 module DDNS.Client.MakeReq
   2     ( makeReq
   3     )
   4     where
   5
   6 import           Control.Monad
   7 import           Control.Monad.Trans
   8 import           DDNS.Utils
   9 import           OpenSSL.PEM
  10 import           OpenSSL.RSA
  11 import           OpenSSL.X509.Request
  12 import           System.Console.Haskeline
  13 import           System.IO
  14 import           System.Posix.Files
  15 import           System.Posix.Uname
  16
  17 makeReq :: IO ()
  18 makeReq
  19     = do fqdn <- runInputT defaultSettings $
  20                  do defaultFqdn <- liftM uNodeName $ liftIO uname
  21                     fqdn        <- getInputLine ("What's your FQDN? (default: " ++ defaultFqdn ++ "): ")
  22                     case trim fqdn of
  23                       Just s -> return s
  24                       _      -> return defaultFqdn
  25
  26          putStrLn "Generating RSA keypair..."
  27          key <- generateRSAKey 1024 3 Nothing
  28
  29          let pubFile = fqdn ++ ".pub"
  30          withFile pubFile WriteMode $ \ h ->
  31              writePublicKey key >>= hPutStr h
  32          putStrLn ("Wrote " ++ pubFile)
  33
  34          let keyFile = fqdn ++ ".key"
  35          withFile keyFile WriteMode $ \ h ->
  36              writePKCS8PrivateKey key Nothing >>= hPutStr h
  37          setFileMode keyFile ownerReadMode
  38          putStrLn ("Wrote " ++ keyFile ++ " (with no encryption)")
  39
  40          req <- newX509Req
  41          setVersion     req 2
  42          setSubjectName req [("CN", fqdn)]
  43          setPublicKey   req key
  44          signX509Req    req key Nothing
  45          let reqFile = fqdn ++ ".req"
  46          withFile reqFile WriteMode $ \ h ->
  47              writeX509Req req ReqNewFormat >>= hPutStr h
  48          putStrLn ("Wrote " ++ reqFile)
  49          putStrLn ("Now send " ++ reqFile ++ " to the server operator and tell him/her to sign it.")