8 import Control.Monad.Trans
11 import Data.Time.Clock
12 import qualified Database.HDBC as RAW
13 import qualified Database.HDBC.Sqlite3 as RAW
14 import Database.HaskellDB
15 import Database.HaskellDB.DBSpec
16 import Database.HaskellDB.HDBC.SQLite3
17 import OpenSSL.EVP.PKey
20 import OpenSSL.X509 as X509
21 import System.Console.Haskeline
22 import System.Directory
23 import System.FilePath
25 import System.Posix.Files
26 import System.Posix.Uname
28 ensureWeHaveKeypair :: FilePath -> IO (SomeKeyPair, X509)
29 ensureWeHaveKeypair lsdir
30 = do let keyFile = lsdir </> "server.key"
31 certFile = lsdir </> "server.cert"
32 keyExi <- doesFileExist keyFile
33 cerExi <- doesFileExist certFile
34 if keyExi && cerExi then
35 do key <- flip readPrivateKey PwNone =<< readFile keyFile
36 cert <- readX509 =<< readFile certFile
39 do fqdn <- runInputT defaultSettings $
40 do defaultFqdn <- liftM uNodeName $ liftIO uname
41 getInputLineWithDefault
42 ("What is the server FQDN? (default: " ++ defaultFqdn ++ "): ")
45 putStrLn "Generating RSA keypair..."
46 key <- generateRSAKey 1024 3 Nothing
47 withFile keyFile WriteMode $ \ h ->
48 writePKCS8PrivateKey key Nothing >>= hPutStr h
49 setFileMode keyFile ownerReadMode
50 putStrLn ("Wrote " ++ keyFile)
53 X509.setVersion cert 2
54 X509.setSerialNumber cert 1
55 X509.setIssuerName cert [("CN", fqdn)]
56 X509.setSubjectName cert [("CN", fqdn)]
57 X509.setNotBefore cert =<< liftM (addUTCTime (-1)) getCurrentTime
58 X509.setNotAfter cert =<< liftM (addUTCTime (20 * 365 * 24 * 60 * 60)) getCurrentTime
59 X509.setPublicKey cert key
60 X509.signX509 cert key Nothing
61 withFile certFile WriteMode $ \ h ->
62 writeX509 cert >>= hPutStr h
63 putStrLn ("Wrote " ++ certFile)
65 return (fromKeyPair key, cert)
67 type WithDB a = (Database -> IO a) -> IO a
69 ensureWeHaveDB :: FilePath -> IO (WithDB a)
71 = do let dbFile = lsdir </> "server.db"
72 dbExist <- doesFileExist dbFile
74 do sqliteConnect dbFile $ \ db ->
75 dbSpecToDatabase db dbinfo
77 rawCon <- RAW.connectSqlite3 dbFile
78 mapM_ (\ sql -> RAW.run rawCon sql []) indexDeclarations
81 return $ sqliteConnect dbFile