openssl-createkey (empty) → 0.1

raw patch · 4 files changed

+126/−0 lines, 4 filesdep +HsOpenSSLdep +basedep +directorysetup-changed

Dependencies added: HsOpenSSL, base, directory, time, unix

Files

• COPYING +30/−0
• OpenSSL/CreateKey.hs +76/−0
• Setup.hs +4/−0
• openssl-createkey.cabal +16/−0

@@ -0,0 +1,30 @@+Copyright (c) 2009, Taru Karttunen <taruti@taruti.net>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.++Redistributions in binary form must reproduce the above copyright+notice, this list of conditions and the following disclaimer in the+documentation and/or other materials provided with the distribution.++Neither the name of the Taru Karttunen; nor the names of its contributors+may be used to endorse or promote products derived from this software+without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT OWNER OR+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

@@ -0,0 +1,76 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module OpenSSL.CreateKey(createKey, promptPassword, readKeyPair, readCertificate) where++import Control.Monad+import Data.Time+import Foreign.C+import OpenSSL.EVP.Cipher+import OpenSSL.EVP.PKey+import OpenSSL.PEM+import OpenSSL.RSA+import OpenSSL.X509+import System.Directory+import System.IO+import System.Posix++createKey :: String            -- ^ Key name+          -> FilePath          -- ^ Base filepath+          -> Maybe SomeKeyPair -- ^ Key for signing the certificate, otherwise self-signed+          -> PemPasswordSupply -- ^ Method for writing private key file+          -> IO (X509, SomeKeyPair)+createKey name bfp mkey gk = do+    cfile <- return (bfp++".public.cert")+    sfile <- return (bfp++".secret.key")+    e1 <- doesFileExist cfile+    e2 <- doesFileExist sfile+    when (e1 || e2) $ fail "Key exists already!"+    let list = [("CN",name)]+    pkey  <- generateRSAKey 2048 65537 Nothing+    cert  <- newX509+    setVersion cert 2+    setSerialNumber cert 1+    setIssuerName  cert list+    setSubjectName cert list+    setNotBefore cert =<< liftM (addUTCTime (-1)) getCurrentTime+    setNotAfter  cert =<< liftM (addUTCTime (365 * 24 * 60 * 60)) getCurrentTime+    setPublicKey cert pkey+    case mkey of+      Nothing -> signX509 cert pkey Nothing+      Just kp -> signX509 cert kp   Nothing+    Just ciph <- getCipherByName "AES256"+    sdata <- writePKCS8PrivateKey pkey (Just (ciph, gk))+    cdata <- writeX509 cert+    writeFile sfile sdata+    setFileMode sfile 0o400+    writeFile cfile cdata+    setFileMode cfile 0o400+    return (cert, fromKeyPair pkey)++-- | Read Key+readKeyPair :: FilePath -> PemPasswordSupply -> IO (X509, SomeKeyPair)+readKeyPair fp pps = do+  cfile <- return (fp++".public.cert")+  sfile <- return (fp++".secret.key")+  mcert <- readX509 =<< readFile cfile+  key <- (flip readPrivateKey pps =<< readFile sfile)+  return (mcert, key)++readCertificate :: FilePath -> IO X509+readCertificate fp = do+  readX509 =<< readFile (fp++".public.cert")++promptPassword :: PemPasswordSupply+promptPassword = PwCallback ppc++ppc :: Int -> PemPasswordRWState -> IO [Char]+ppc mlen PwRead = take mlen `fmap` getPass "Password: "+ppc mlen PwWrite= take mlen `fmap` loop+    where loop = do c1 <- getPass "Password: "+                    c2 <- getPass "Confirm password: "+                    if (c1 == c2) then return c1 else do+                    hPutStrLn stderr "Passwords do not match!"+                    loop+getPass :: String -> IO String+getPass p = withCString p (\cs -> peekCString =<< getpass cs)+foreign import ccall safe getpass :: CString -> IO CString+

@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain+

@@ -0,0 +1,16 @@+Name:                openssl-createkey+Version:             0.1+Synopsis:            Create OpenSSL keypairs.+Description:         Create OpenSSL keypairs.+License:             BSD3+License-file:        COPYING+Copyright:           Taru Karttunen <taruti@taruti.net>+Author:              Taru Karttunen+Category:            Crypto+Maintainer:          taruti@taruti.net+Build-Depends:       base >= 3 && < 5, unix, directory, HsOpenSSL, time+Exposed-modules:     OpenSSL.CreateKey+Extensions:          ForeignFunctionInterface+GHC-Options:         -Wall+Build-Type:	     Simple+