ClientMain.hs

   1 module Main where
   2
   3 import           Control.Monad
   4 import           Control.Monad.Trans
   5 import           OpenSSL
   6 import           OpenSSL.PEM
   7 import           OpenSSL.RSA
   8 import           OpenSSL.X509.Request
   9 import           System.Console.Haskeline
  10 import           System.Console.ParseArgs
  11 import           System.IO
  12 import           System.Posix.Files
  13 import           System.Posix.Uname
  14
  15
  16 data Options
  17     = Help
  18     | Command
  19     deriving (Show, Eq, Ord)
  20
  21 arginfo :: [Arg Options]
  22 arginfo = [ Arg {
  23               argIndex = Help
  24             , argAbbr  = Just 'h'
  25             , argName  = Nothing
  26             , argData  = Nothing
  27             , argDesc  = "print this help."
  28             }
  29           , Arg {
  30               argIndex = Command
  31             , argAbbr  = Nothing
  32             , argName  = Nothing
  33             , argData  = argDataDefaulted "COMMAND" ArgtypeString "update"
  34             , argDesc  = "command to the client (default: \"update\")."
  35             }
  36           ]
  37
  38 main :: IO ()
  39 main = withOpenSSL $
  40        do m <- parseArgsIO ArgsComplete arginfo
  41           when (gotArg m Help)
  42                    $ usageError m ""
  43
  44           case getRequiredArg m Command of
  45             "makereq"
  46                 -> makeReq
  47             _   -> usageError m ""
  48
  49
  50 makeReq :: IO ()
  51 makeReq
  52     = do fqdn <- runInputT defaultSettings $
  53                  do defaultFqdn <- liftM uNodeName $ liftIO uname
  54                     fqdn        <- getInputLine ("What's your FQDN? (default: " ++ defaultFqdn ++ "): ")
  55                     case fqdn of
  56                       Just s@(_:_) -> return s
  57                       _            -> return defaultFqdn
  58
  59          putStrLn "Generating keypair..."
  60          key <- generateRSAKey 1024 3 Nothing
  61
  62          let pubFile = fqdn ++ ".pub"
  63          withFile pubFile WriteMode $ \ h ->
  64              writePublicKey key >>= hPutStr h
  65          putStrLn ("Wrote " ++ pubFile)
  66
  67          let keyFile = fqdn ++ ".key"
  68          withFile keyFile WriteMode $ \ h ->
  69              writePKCS8PrivateKey key Nothing >>= hPutStr h
  70          setFileMode keyFile (ownerReadMode `unionFileModes` ownerWriteMode)
  71          putStrLn ("Wrote " ++ keyFile ++ " (with no encryption)")
  72
  73          req <- newX509Req
  74          setVersion     req 2
  75          setSubjectName req [("CN", fqdn)]
  76          setPublicKey   req key
  77          let reqFile = fqdn ++ ".req"
  78          withFile reqFile WriteMode $ \ h ->
  79              writeX509Req req ReqNewFormat >>= hPutStr h
  80          putStrLn ("Wrote " ++ reqFile)
  81          putStrLn ("Now send " ++ reqFile ++ " to the server operator and tell him/her to sign it.")