diff options
Diffstat (limited to 'lib/KeyRing.hs')
-rw-r--r-- | lib/KeyRing.hs | 87 |
1 files changed, 1 insertions, 86 deletions
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index c40eba7..3b9afd7 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs | |||
@@ -14,7 +14,6 @@ | |||
14 | -- Typically, a client to this module would prepare a 'KeyRingOperation' | 14 | -- Typically, a client to this module would prepare a 'KeyRingOperation' |
15 | -- describing what he wants done, and then invoke 'runKeyRing' to make it | 15 | -- describing what he wants done, and then invoke 'runKeyRing' to make it |
16 | -- happen. | 16 | -- happen. |
17 | {-# LANGUAGE CPP #-} | ||
18 | {-# LANGUAGE DeriveFunctor #-} | 17 | {-# LANGUAGE DeriveFunctor #-} |
19 | {-# LANGUAGE DoAndIfThenElse #-} | 18 | {-# LANGUAGE DoAndIfThenElse #-} |
20 | {-# LANGUAGE ForeignFunctionInterface #-} | 19 | {-# LANGUAGE ForeignFunctionInterface #-} |
@@ -49,41 +48,16 @@ import Data.Bits ((.&.), shiftR ) | |||
49 | import qualified Data.Map as Map | 48 | import qualified Data.Map as Map |
50 | import qualified Data.ByteString.Lazy as L | 49 | import qualified Data.ByteString.Lazy as L |
51 | import qualified Data.ByteString as S | 50 | import qualified Data.ByteString as S |
52 | #if defined(VERSION_memory) | ||
53 | import qualified Data.ByteString.Char8 as S8 | 51 | import qualified Data.ByteString.Char8 as S8 |
54 | import Data.ByteArray.Encoding | 52 | import Data.ByteArray.Encoding |
55 | #elif defined(VERSION_dataenc) | ||
56 | import qualified Codec.Binary.Base32 as Base32 | ||
57 | import qualified Codec.Binary.Base64 as Base64 | ||
58 | #endif | ||
59 | #if !defined(VERSION_cryptonite) | ||
60 | import qualified Crypto.Hash.SHA1 as SHA1 | ||
61 | import qualified Crypto.Types.PubKey.ECC as ECC | ||
62 | #else | ||
63 | #endif | ||
64 | import qualified Codec.Compression.GZip as GZip | 53 | import qualified Codec.Compression.GZip as GZip |
65 | import qualified System.Posix.Types as Posix | 54 | import qualified System.Posix.Types as Posix |
66 | import System.Posix.Files (setFileCreationMask, setFileTimes ) | 55 | import System.Posix.Files (setFileCreationMask, setFileTimes ) |
67 | |||
68 | #if MIN_VERSION_x509(1,5,0) | ||
69 | #endif | ||
70 | #if MIN_VERSION_unix(2,7,0) | ||
71 | import System.Posix.Files ( setFdTimesHiRes ) | 56 | import System.Posix.Files ( setFdTimesHiRes ) |
72 | #else | 57 | |
73 | import Foreign.C.Types ( CTime(..), CLong, CInt(..) ) | ||
74 | import Foreign.Marshal.Array ( withArray ) | ||
75 | import Foreign.Ptr | ||
76 | import Foreign.C.Error ( throwErrnoIfMinus1_ ) | ||
77 | import Foreign.Storable | ||
78 | #endif | ||
79 | import System.FilePath ( takeDirectory ) | 58 | import System.FilePath ( takeDirectory ) |
80 | import System.IO (hPutStrLn,withFile,IOMode(..), Handle, hPutStr, stderr, hClose) | 59 | import System.IO (hPutStrLn,withFile,IOMode(..), Handle, hPutStr, stderr, hClose) |
81 | import System.Posix.IO ( fdToHandle ) | 60 | import System.Posix.IO ( fdToHandle ) |
82 | #if ! MIN_VERSION_base(4,6,0) | ||
83 | import GHC.Exts ( Down(..) ) | ||
84 | #endif | ||
85 | #if MIN_VERSION_binary(0,7,0) | ||
86 | #endif | ||
87 | import qualified Data.ByteString.Lazy.Char8 as Char8 | 61 | import qualified Data.ByteString.Lazy.Char8 as Char8 |
88 | import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor | 62 | import qualified Codec.Encryption.OpenPGP.ASCIIArmor as ASCIIArmor |
89 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types | 63 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types |
@@ -877,11 +851,7 @@ pemFromPacket Sec packet = | |||
877 | rsa <- rsaPrivateKeyFromPacket packet -- RSAPrivateKey | 851 | rsa <- rsaPrivateKeyFromPacket packet -- RSAPrivateKey |
878 | let asn1 = toASN1 rsa [] | 852 | let asn1 = toASN1 rsa [] |
879 | bs = encodeASN1 DER asn1 | 853 | bs = encodeASN1 DER asn1 |
880 | #if defined(VERSION_memory) | ||
881 | dta = S8.unpack $ convertToBase Base64 (L.toStrict bs) | 854 | dta = S8.unpack $ convertToBase Base64 (L.toStrict bs) |
882 | #elif defined(VERSION_dataenc) | ||
883 | dta = Base64.encode (L.unpack bs) | ||
884 | #endif | ||
885 | output = writePEM PemPrivateKey dta | 855 | output = writePEM PemPrivateKey dta |
886 | Just output | 856 | Just output |
887 | algo -> Nothing | 857 | algo -> Nothing |
@@ -891,11 +861,7 @@ pemFromPacket Pub packet = | |||
891 | rsa <- rsaKeyFromPacket packet | 861 | rsa <- rsaKeyFromPacket packet |
892 | let asn1 = toASN1 (pkcs8 rsa) [] | 862 | let asn1 = toASN1 (pkcs8 rsa) [] |
893 | bs = encodeASN1 DER asn1 | 863 | bs = encodeASN1 DER asn1 |
894 | #if defined(VERSION_memory) | ||
895 | dta = S8.unpack $ convertToBase Base64 (L.toStrict bs) | 864 | dta = S8.unpack $ convertToBase Base64 (L.toStrict bs) |
896 | #elif defined(VERSION_dataenc) | ||
897 | dta = Base64.encode (L.unpack bs) | ||
898 | #endif | ||
899 | output = writePEM PemPublicKey dta | 865 | output = writePEM PemPublicKey dta |
900 | Just output | 866 | Just output |
901 | algo -> Nothing | 867 | algo -> Nothing |
@@ -927,11 +893,7 @@ writeKeyToFile StreamInfo { typ = DNSPresentation } fname packet = do | |||
927 | let -- asn1 = toASN1 rsa [] | 893 | let -- asn1 = toASN1 rsa [] |
928 | -- bs = encodeASN1 DER asn1 | 894 | -- bs = encodeASN1 DER asn1 |
929 | -- dta = Base64.encode (L.unpack bs) | 895 | -- dta = Base64.encode (L.unpack bs) |
930 | #if defined(VERSION_memory) | ||
931 | b64 ac rsa = S8.unpack $ convertToBase Base64 $ i2bs_unsized i | 896 | b64 ac rsa = S8.unpack $ convertToBase Base64 $ i2bs_unsized i |
932 | #elif defined(VERSION_dataenc) | ||
933 | b64 ac rsa = Base64.encode (S.unpack $ i2bs_unsized i) | ||
934 | #endif | ||
935 | where | 897 | where |
936 | MPI i = ac rsa | 898 | MPI i = ac rsa |
937 | i2bs_unsized :: Integer -> S.ByteString | 899 | i2bs_unsized :: Integer -> S.ByteString |
@@ -1239,19 +1201,6 @@ getHomeDir protohome = do | |||
1239 | where topair (x:xs) = (x,xs) | 1201 | where topair (x:xs) = (x,xs) |
1240 | return $ lookup "default-key" config >>= listToMaybe | 1202 | return $ lookup "default-key" config >>= listToMaybe |
1241 | 1203 | ||
1242 | #if MIN_VERSION_base(4,6,0) | ||
1243 | #else | ||
1244 | lookupEnv :: String -> IO (Maybe String) | ||
1245 | lookupEnv var = | ||
1246 | handleIO_ (return Nothing) $ fmap Just (getEnv var) | ||
1247 | #endif | ||
1248 | |||
1249 | |||
1250 | |||
1251 | |||
1252 | |||
1253 | |||
1254 | |||
1255 | {- | 1204 | {- |
1256 | onionName :: KeyData -> (SockAddr,L.ByteString) | 1205 | onionName :: KeyData -> (SockAddr,L.ByteString) |
1257 | onionName kd = (addr,name) | 1206 | onionName kd = (addr,name) |
@@ -1259,37 +1208,3 @@ onionName kd = (addr,name) | |||
1259 | (addr,(name:_,_)) = getHostnames kd | 1208 | (addr,(name:_,_)) = getHostnames kd |
1260 | -} | 1209 | -} |
1261 | 1210 | ||
1262 | |||
1263 | |||
1264 | |||
1265 | |||
1266 | |||
1267 | |||
1268 | |||
1269 | #if ! MIN_VERSION_unix(2,7,0) | ||
1270 | setFdTimesHiRes :: Posix.Fd -> POSIXTime -> POSIXTime -> IO () | ||
1271 | setFdTimesHiRes (Posix.Fd fd) atime mtime = | ||
1272 | withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times -> | ||
1273 | throwErrnoIfMinus1_ "setFdTimesHiRes" (c_futimens fd times) | ||
1274 | |||
1275 | data CTimeSpec = CTimeSpec Posix.EpochTime CLong | ||
1276 | instance Storable CTimeSpec where | ||
1277 | sizeOf _ = (16) | ||
1278 | alignment _ = alignment (undefined :: CInt) | ||
1279 | poke p (CTimeSpec sec nsec) = do | ||
1280 | ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p sec | ||
1281 | ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p nsec | ||
1282 | peek p = do | ||
1283 | sec <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p | ||
1284 | nsec <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p | ||
1285 | return $ CTimeSpec sec nsec | ||
1286 | |||
1287 | toCTimeSpec :: POSIXTime -> CTimeSpec | ||
1288 | toCTimeSpec t = CTimeSpec (CTime sec) (truncate $ 10^(9::Int) * frac) | ||
1289 | where | ||
1290 | (sec, frac) = if (frac' < 0) then (sec' - 1, frac' + 1) else (sec', frac') | ||
1291 | (sec', frac') = properFraction $ toRational t | ||
1292 | |||
1293 | foreign import ccall unsafe "futimens" | ||
1294 | c_futimens :: CInt -> Ptr CTimeSpec -> IO CInt | ||
1295 | #endif | ||