1 files changed, 157 insertions, 15 deletions

diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index ec34542..1682811 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -1,26 +1,29 @@
 {-# LANGUAGE CPP #-}
 module Kiki where
 
-import Control.Monad
 import Control.Applicative
+import Control.Arrow
+import Control.Monad
+import Data.ASN1.BinaryEncoding
+import Data.ASN1.Encoding
+import Data.ASN1.Types
+import Data.Binary
 import Data.List
 import Data.Maybe
+import Data.OpenPGP
+import Data.OpenPGP.Util
 import Data.Ord
 import System.Directory
 import System.FilePath.Posix
 import System.IO
-import Data.OpenPGP
-import Data.OpenPGP.Util
-import qualified Data.Map.Strict as Map
+import System.Posix.User
 import qualified Codec.Binary.Base64 as Base64
-import Data.ASN1.BinaryEncoding
-import Data.ASN1.Encoding
-import Data.ASN1.Types
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as Char8
+import qualified Data.Map.Strict as Map
+import qualified SSHKey as SSH
 
 import CommandLine
-import qualified SSHKey as SSH
 import KeyRing
 
 -- |
@@ -70,6 +73,139 @@ minimalOp cap = op
         , opHome = cap_homespec cap
         }
 
+run :: [String] -> Args (IO ()) -> IO ()
+run args x =
+    case runArgs (parseInvocation (uncurry fancy kikiOptions "") args) x of
+        Left e   -> hPutStrLn stderr $ usageErrorMessage e
+        Right io -> io
+
+importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO ()
+importAndRefresh root cmn = do
+    let rootdir = do guard (root "x" /= "x")
+                     Just $ root ""
+
+    me <- getEffectiveUserID
+
+    let noChrootArg = rootdir == Nothing
+        bUnprivileged = (me/=0) && noChrootArg
+    if rootdir==Just "" then error "--chroot requires an argument" else do
+
+    let homespec = mplus (slash <$> rootdir <*> cap_homespec cmn)
+                         (fmap (++"/root/.gnupg") rootdir)
+        sshkeygen size = Just $ concat [ "mkdir -p \"$(dirname $file)\" && "
+                                       , "ssh-keygen -P \"\" -q -f $file -b "
+                                       , show size ]
+        mkdirFor path = do
+            let dir = takeDirectory path
+            -- putStrLn $ "mkdirFor " ++ show dir
+            createDirectoryIfMissing True dir
+        -- ssl = Just "mkdir -p \"$(dirname $file)\" && openssl genrsa -out $file 1024"
+    (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec
+    osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root"
+    putStrLn $ "gnupg home = " ++ show (home,secring,pubring,mbwk)
+    putStrLn $ "os    home = " ++ show osHomeDir
+    -- gnupg home = ("TESTS/tmpgh","TESTS/tmpgh/secring.gpg","TESTS/tmpgh/pubring.gpg",Nothing)
+    -- os    home = "/root"
+
+
+    -- Generate secring.gpg if it does not exist...
+    gotsec <- doesFileExist secring
+    when (not gotsec) $ do
+        {-  ssh-keygen to create master key...
+        let mkpath = home ++ "/master-key"
+        mkdirFor mkpath
+        e <- systemEnv [ ("file",mkpath) ] (fromJust $ sshkeygen 4096)
+        case e of
+            ExitFailure num -> error "ssh-keygen failed to create master key"
+            ExitSuccess     -> return ()
+        [PEMPacket mk] <- readSecretPEMFile (ArgFile mkpath)
+        writeInputFileL (InputFileContext secring pubring)
+                        HomeSec
+                        ( encode $ Message [mk { is_subkey = False }] )
+        -}
+        master <- (\k -> k { is_subkey = False }) <$> generateKey (GenRSA $ 4096 `div` 8 )
+        mkdirFor secring
+        writeInputFileL (InputFileContext secring pubring)
+                        HomeSec
+                        $ encode $ Message [master { is_subkey = False}]
+
+    gotpub <- doesFileExist pubring
+    when (not gotpub) $ do
+        mkdirFor pubring
+        writeInputFileL (InputFileContext secring pubring)
+                        HomePub
+                        ( encode $ Message [] )
+
+    -- Old paths..
+    --
+    -- Private
+    -- pem tor        /var/lib/tor/samizdat/private_key
+    -- pem ssh-client %(home)/.ssh/id_rsa
+    -- pem ssh-server /etc/ssh/ssh_host_rsa_key
+    -- pem ipsec      /etc/ipsec.d/private/%(onion).pem
+
+    -- Public
+    -- ssh-client %(home)/.ssh/id_rsa.pub
+    -- ssh-server /etc/ssh/ssh_host_rsa_key.pub
+    -- ipsec      /etc/ipsec.d/certs/%(onion).pem
+
+    -- First, we ensure that the tor key exists and is imported
+    -- so that we know where to put the strongswan key.
+    let passfd = cap_passfd cmn
+        strm = StreamInfo { typ = KeyRingFile
+                          , fill = KF_None
+                          , spill = KF_All
+                          , access = AutoAccess
+                          , initializer = NoCreate
+                          , transforms = [] }
+        buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp
+                                               , fill = rtyp
+                                               , spill = KF_All
+                                               , access = AutoAccess
+                                               , initializer = NoCreate
+                                               , transforms = [] }
+        peminfo bits usage =
+                  StreamInfo { typ = PEMFile
+                             , fill = KF_None -- KF_Match usage
+                             , spill = KF_Match usage
+                             , access = Sec
+                             , initializer = Internal (GenRSA $ bits `div` 8)
+                             , transforms = []
+                             }
+        sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa"
+        sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key"
+        op = KeyRingOperation
+             { opFiles = Map.fromList $
+                [ ( HomeSec, buildStreamInfo KF_All KeyRingFile )
+                , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } )
+                , ( Generate 0 (GenRSA (1024 `div` 8)), strm { spill = KF_Match "tor" })
+                , ( Generate 1 (GenRSA (1024 `div` 8)), strm { spill = KF_Match "ipsec" })
+                , ( ArgFile sshcpath, (peminfo 2048 "ssh-client") )
+                , ( ArgFile sshspath, (peminfo 2048 "ssh-server") )
+                ]
+             , opPassphrases = do pfd <- maybeToList passfd
+                                  return $ PassphraseSpec Nothing Nothing pfd
+             , opHome = homespec
+             , opTransforms = []
+             }
+        -- doNothing = return ()
+        nop = KeyRingOperation
+            { opFiles = Map.empty
+            , opPassphrases = do pfd <- maybeToList passfd
+                                 return $ PassphraseSpec Nothing Nothing pfd
+            , opHome=homespec, opTransforms = []
+            }
+    -- if bUnprivileged then doNothing else mkdirFor torpath
+    KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op)
+    forM_ report $ \(fname,act) -> do
+        putStrLn $ fname ++ ": " ++ reportString act
+    rt <- case rt of
+        BadPassphrase ->
+            error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)"
+        _ -> unconditionally $ return rt
+
+    when (not bUnprivileged) $ refreshCache rt rootdir
+
 
 refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO ()
 refreshCache rt rootdir = do
@@ -172,10 +308,6 @@ sshblobFromPacket k = blob
     bs = SSH.keyblob (n,e)
     blob = Char8.unpack bs
 
-ㄧhomedir = Kiki.CommonArgsParsed
-                <$> optional (arg "--homedir")
-                <*> optional (FileDesc <$> read <$> arg "--passphrase-fd")
-
 replaceSshServerKeys root cmn = do
     let homepass' = cmn { cap_homespec = fmap root (cap_homespec cmn) }
         replaceSSH op = op { opFiles = files }
@@ -194,12 +326,22 @@ replaceSshServerKeys root cmn = do
                                                     pth -> Just pth
         err            -> hPutStrLn stderr $ errorString err
 
-ㄧchroot :: Args (FilePath -> FilePath)
-ㄧchroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id
-
 slash :: String -> String -> String
 slash "/"    ('/':xs) = '/':xs
 slash ""     ('/':xs) = '/':xs
 slash ""     xs       = '/':xs
 slash (y:ys) xs       = y:slash ys xs
 
+ㄧchroot :: Args (FilePath -> FilePath)
+ㄧchroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id
+
+ㄧhomedir :: Args CommonArgsParsed
+ㄧhomedir = CommonArgsParsed
+                <$> optional (arg "--homedir")
+                <*> optional (FileDesc <$> read <$> arg "--passphrase-fd")
+
+kikiOptions :: ( [(String,Int)], [String] )
+kikiOptions = ( ss, ps )
+ where
+    ss = [("--chroot",1),("--passphrase-fd",1),("--homedir",1)]
+    ps = []