more work on cokiki (ssh-client)

1 files changed, 1 insertions, 123 deletions

diff --git a/kiki.hs b/kiki.hs
index 0284ff9..842e697 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -66,14 +66,9 @@ import qualified SSHKey as SSH
 import Text.Printf
 import qualified DNSKey as DNS
 import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
+import Kiki
 import Debug.Trace
 
-#if !MIN_VERSION_base(4,8,0)
-sortOn :: Ord b => (a -> b) -> [a] -> [a]
-sortOn f =
-    map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))
-#endif
-
 -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-}
 -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-}
 
@@ -134,8 +129,6 @@ sortOn f =
  -
  -}
 
-warn str = hPutStrLn stderr str
-
 
 isCertificationSig (CertificationSignature {}) = True
 isCertificationSig _                           = True
@@ -307,21 +300,6 @@ show_whose_key input_key db =
 
 show_dns keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db dnsPresentationFromPacket
 
-show_pem keyspec wkgrip db = either warn putStrLn $ show_pem' keyspec wkgrip db pemFromPacket
-
-show_pem' keyspec wkgrip db keyfmt = do
-    let s = parseSpec wkgrip keyspec
-    flip (maybe . Left $ keyspec ++ ": not found")
-         (selectPublicKey s db)
-         keyfmt
-
-pemFromPacket k = do
-    let rsa = pkcs8 . fromJust $ rsaKeyFromPacket k
-        der = encodeASN1 DER (toASN1 rsa [])
-        qq  = Base64.encode (L.unpack der)
-    return $
-        writePEM "PUBLIC KEY" qq -- ("TODO "++show keyspec)
-
 dnsPresentationFromPacket k = do
     let RSAKey (MPI n) (MPI e)  = fromJust $ rsaKeyFromPacket k
         dnskey = DNS.RSA n e
@@ -341,20 +319,6 @@ dnsPresentationFromPacket k = do
         ,qq
         ]
 
-show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db
-
-show_ssh' keyspec wkgrip db = do
-    let s = parseSpec wkgrip keyspec
-    flip (maybe . Left $ keyspec ++ ": not found")
-         (selectPublicKey s db)
-         $ return . sshblobFromPacket
-
-sshblobFromPacket k = blob
- where
-    Just (RSAKey (MPI n) (MPI e)) = rsaKeyFromPacket k
-    bs = SSH.keyblob (n,e)
-    blob = Char8.unpack bs
-
 show_id keyspec wkgrip db = do
     let s = parseSpec "" keyspec
     let ps = do
@@ -1029,8 +993,6 @@ processArgs sargspec polyVariadicArgs defaultPoly args_raw = (sargs,margs)
                               else error . unlines $ [ "unrecognized option "++k
                                                      , "Use --help for usage." ]
 
-data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile }
-
 parseCommonArgs margs = CommonArgsParsed { cap_homespec = homespec, cap_passfd = passfd }
     where
         passphrase_fd = concat <$> Map.lookup "--passphrase-fd" margs
@@ -1658,55 +1620,6 @@ kiki "tar" args = do
         ["-A":_] -> putStrLn "unimplemented." -- import tar file?
         _ -> kiki "tar" ["--help"]
 
-refreshCache rt rootdir = do
-
-    let mkpath pth = fromMaybe "" rootdir ++ "/var/cache/kiki/"++pth
-
-        write f bs = do
-            createDirectoryIfMissing True $ takeDirectory f
-            writeFile f bs
-
-    let oname' = do wk <- rtWorkingKey rt
-                    -- XXX unnecessary signature check
-                    onionNameForContact (keykey wk) (rtKeyDB rt)
-        bUnprivileged = False -- TODO
-    if (oname' == Nothing) && (not bUnprivileged) then error "Missing tor key" else do
-    let oname = fromMaybe "" oname'
-    -- sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </> "id_rsa.pub"
-    -- sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub"
-    -- contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem"
-
-    -- Finally, export public keys if they do not exist.
-    flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do
-    either warn (write $ mkpath "root/.ssh/id_rsa.pub")
-            $ show_ssh' "ssh-client" grip (rtKeyDB rt)
-    either warn (write $ mkpath "ssh_host_rsa_key.pub")
-        $ show_ssh' "ssh-server" grip (rtKeyDB rt)
-    either warn (write $ mkpath "ipsec.d/certs/" ++ oname++".pem")
-        $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket
-
-    let cs = filter notme (Map.elems $ rtKeyDB rt)
-        kk = keykey (fromJust $ rtWorkingKey rt)
-        notme kd = keykey (keyPacket kd) /= kk
-
-        installConctact kd = do
-            -- The getHostnames command requires a valid cross-signed tor key
-            -- for each onion name returned in (_,(ns,_)).
-            let (_,(ns,_)) = getHostnames kd
-                contactname = fmap Char8.unpack $ listToMaybe ns -- only first onion name.
-            flip (maybe $ return ()) contactname $ \contactname -> do
-
-            let cpath = interp (Map.singleton "onion" contactname) "ipsec.d/certs/%(onion).pem"
-                their_master = packet $ keyMappedPacket kd
-                -- We find all cross-certified ipsec keys for the given cross-certified onion name.
-                ipsecs = sortOn (Down . timestamp)
-                         $ getCrossSignedSubkeys their_master (keySubKeys kd) "ipsec"
-            forM_ (take 1 ipsecs) $ \k -> do
-            either warn (write $ mkpath cpath) $ pemFromPacket k
-
-    mapM_ installConctact cs
-
-
 tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root"
  where
     ipsecs = do
@@ -1811,27 +1724,6 @@ tarC (sargs,margs) = do
                 hPutStrLn stderr $ "Failed to decrypt "++fingerprint k++"."
                 return Nothing
 
-minimalOp :: CommonArgsParsed -> KeyRingOperation
-minimalOp cap = op
- where
-    streaminfo = StreamInfo { fill = KF_None
-                            , typ = KeyRingFile
-                            , spill = KF_All
-                            , initializer = NoCreate
-                            , access = AutoAccess
-                            , transforms = []
-                            }
-    op = KeyRingOperation
-        { opFiles = Map.fromList $
-            [ ( HomeSec, streaminfo { access = Sec })
-            , ( HomePub, streaminfo { access = Pub })
-            ]
-        , opPassphrases = do pfile <- maybeToList (cap_passfd cap)
-                             return $ PassphraseSpec Nothing Nothing pfile
-        , opTransforms = []
-        , opHome = cap_homespec cap
-        }
-
 -- |
 --
 -- no leading hyphen, returns Right (input string).
@@ -1872,20 +1764,6 @@ commands =
  , ( "tar", "import or export system key files in tar format" )
  ]
 
--- |
--- interpolate %var patterns in a string.
-interp vars raw = es >>= interp1
- where
-    gs = groupBy (\_ c -> c/='%') raw
-    es = dropWhile null $ gobbleEscapes ("":gs)
-            where gobbleEscapes :: [String] -> [String]
-                  gobbleEscapes (a:"%":b:bs) = (a++b) : gobbleEscapes bs
-                  gobbleEscapes (g:gs)       = g : gobbleEscapes gs
-                  gobbleEscapes []           = []
-    interp1 ('%':'(':str) = fromMaybe "" (Map.lookup key vars) ++ drop 1 rest
-                            where (key,rest) = break (==')') str
-    interp1 plain = plain
-
 main = do
     dotlock_init
     args_raw <- getArgs