diff options
-rw-r--r-- | kiki.hs | 441 |
1 files changed, 0 insertions, 441 deletions
@@ -2557,17 +2557,6 @@ main = do | |||
2557 | return() | 2557 | return() |
2558 | where | 2558 | where |
2559 | 2559 | ||
2560 | {- | ||
2561 | getPGPEnviron cmd = do | ||
2562 | (homedir,secring,pubring,grip) <- getHomeDir (homedir cmd) | ||
2563 | (Message sec) <- readPacketsFromFile secring | ||
2564 | let (keys,_) = partition (\k -> case k of | ||
2565 | { SecretKeyPacket {} -> True | ||
2566 | ; _ -> False }) | ||
2567 | sec | ||
2568 | return (homedir,sec, grip `mplus` fmap fingerprint (listToMaybe keys)) | ||
2569 | -} | ||
2570 | |||
2571 | getTorKeys pub = do | 2560 | getTorKeys pub = do |
2572 | xs <- groupBindings pub | 2561 | xs <- groupBindings pub |
2573 | (_,(top,sub),us,_,_) <- xs | 2562 | (_,(top,sub),us,_,_) <- xs |
@@ -2575,18 +2564,6 @@ main = do | |||
2575 | let torhash = maybe "" id $ derToBase32 <$> derRSA sub | 2564 | let torhash = maybe "" id $ derToBase32 <$> derRSA sub |
2576 | return (top,(torhash,sub)) | 2565 | return (top,(torhash,sub)) |
2577 | 2566 | ||
2578 | {- | ||
2579 | uidScan pub = scanl (\(mkey,u) w -> | ||
2580 | case () of | ||
2581 | _ | isPublicMaster w -> (w,u) | ||
2582 | _ | isUserID w -> (mkey,w) | ||
2583 | _ | otherwise -> (mkey,u) | ||
2584 | ) | ||
2585 | (w0,w0) | ||
2586 | ws | ||
2587 | where | ||
2588 | w0:ws = pub | ||
2589 | -} | ||
2590 | 2567 | ||
2591 | signTorIds selfkey keys kd@(KeyData k ksigs umap submap) = do | 2568 | signTorIds selfkey keys kd@(KeyData k ksigs umap submap) = do |
2592 | umap' <- Traversable.mapM signIfTor (Map.mapWithKey (,) umap) | 2569 | umap' <- Traversable.mapM signIfTor (Map.mapWithKey (,) umap) |
@@ -2620,15 +2597,6 @@ main = do | |||
2620 | subdom = Char8.unpack subdom0 | 2597 | subdom = Char8.unpack subdom0 |
2621 | len = T.length (uid_subdomain parsed) | 2598 | len = T.length (uid_subdomain parsed) |
2622 | 2599 | ||
2623 | {- | ||
2624 | signSelfAuthTorKeys selfkey g sec grip timestamp xs = ys | ||
2625 | where | ||
2626 | keys = filter isKey sec | ||
2627 | mainpubkey = fst (head xs) | ||
2628 | uidxs0 = map snd xs | ||
2629 | (uidxs, additional, xs'',g') = signSelfAuthTorKeys' selfkey g keys grip timestamp mainpubkey uidxs0 | ||
2630 | ys = uidxs++ additional++xs'' | ||
2631 | -} | ||
2632 | 2600 | ||
2633 | signSelfAuthTorKeys' selfkey keys grip mainpubkey (uid:xs') = do | 2601 | signSelfAuthTorKeys' selfkey keys grip mainpubkey (uid:xs') = do |
2634 | new_sig <- let wkun = fromJust selfkey | 2602 | new_sig <- let wkun = fromJust selfkey |
@@ -2652,12 +2620,6 @@ main = do | |||
2652 | let ov = verify (Message [k]) $ o | 2620 | let ov = verify (Message [k]) $ o |
2653 | signatures_over ov | 2621 | signatures_over ov |
2654 | return (sig,Just ov,k) | 2622 | return (sig,Just ov,k) |
2655 | {- | ||
2656 | mainsigs = filter (\(sig,v,whosign) -> isJust (v >> Just mainpubkey >>= guard | ||
2657 | . (== keykey whosign) | ||
2658 | . keykey)) | ||
2659 | vs | ||
2660 | -} | ||
2661 | selfsigs = filter (\(sig,v,whosign) -> isJust (v >> selfkey >>= guard | 2623 | selfsigs = filter (\(sig,v,whosign) -> isJust (v >> selfkey >>= guard |
2662 | . (== keykey whosign) | 2624 | . (== keykey whosign) |
2663 | . keykey)) | 2625 | . keykey)) |
@@ -2696,417 +2658,14 @@ main = do | |||
2696 | flgs = if keykey mainpubkey == keykey (fromJust selfkey) | 2658 | flgs = if keykey mainpubkey == keykey (fromJust selfkey) |
2697 | then keyFlags0 mainpubkey (map (\(x,_,_)->x) selfsigs) | 2659 | then keyFlags0 mainpubkey (map (\(x,_,_)->x) selfsigs) |
2698 | else [] | 2660 | else [] |
2699 | -- (new_sig,g') = todo g mainpubkey (fromJust selfkey) uid timestamp flgs | ||
2700 | {- | ||
2701 | new_sig <- let wkun = fromJust selfkey | ||
2702 | in pgpSign (Message [wkun]) | ||
2703 | tor_ov | ||
2704 | SHA1 | ||
2705 | (fingerprint wkun) | ||
2706 | -} | ||
2707 | 2661 | ||
2708 | -- ys = uid:sigs++ additional++xs'' | ||
2709 | 2662 | ||
2710 | {- | ||
2711 | doCmd cmd@(List {}) = do | ||
2712 | (homedir,secring,grip) <- getHomeDir cmd | ||
2713 | (Message sec) <- readPacketsFromFile secring | ||
2714 | putStrLn $ listKeys sec | ||
2715 | |||
2716 | doCmd cmd@(WorkingKey {}) = do | ||
2717 | (homedir,secring,grip) <- getHomeDir cmd | ||
2718 | (Message sec) <- readPacketsFromFile secring | ||
2719 | -- let s2k' = map s2k (filter isKey sec) | ||
2720 | -- putStrLn $ "s2k = " ++ show s2k' | ||
2721 | putStrLn $ listKeysFiltered (maybeToList grip) sec | ||
2722 | return () | ||
2723 | |||
2724 | doCmd cmd@(AutoSign {}) = do | ||
2725 | ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome | ||
2726 | , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg | ||
2727 | , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" | ||
2728 | ) <- getPGPEnviron cmd | ||
2729 | flip (maybe (error "No working key?")) grip $ \grip -> do | ||
2730 | pw <- getPassphrase cmd | ||
2731 | let (pre, wk:subs) = seek_key (KeyGrip grip) sec | ||
2732 | wkun = if symmetric_algorithm wk == Unencrypted | ||
2733 | then Just wk | ||
2734 | else do | ||
2735 | k <- decryptSecretKey pw wk | ||
2736 | guard (symmetric_algorithm k == Unencrypted) | ||
2737 | return k | ||
2738 | flip (maybe (error "Bad passphrase?")) wkun$ \wkun -> do | ||
2739 | -- putStrLn $ "getPGPEnviron -> " ++ show (homedir,length sec,grip) | ||
2740 | (Message pub) <- readPacketsFromFile (input cmd) | ||
2741 | putStrLn $ listKeys pub | ||
2742 | -- forM_ (zip [1..] pub) $ \(i,k) -> do | ||
2743 | -- putStrLn $ show i ++ ": " ++ show k | ||
2744 | let torbindings = getTorKeys pub | ||
2745 | keyed = uidScan pub | ||
2746 | marked = zipWith doit keyed pub | ||
2747 | doit (mkey,u) packet = (isTorID packet, (mkey,u,packet)) | ||
2748 | where | ||
2749 | isTorID (UserIDPacket str) = | ||
2750 | and [ uid_topdomain parsed == "onion" | ||
2751 | , uid_realname parsed `elem` ["","Anonymous"] | ||
2752 | , uid_user parsed == "root" | ||
2753 | , fmap (match . fst) (lookup mkey torbindings) | ||
2754 | == Just True ] | ||
2755 | where parsed = parseUID str | ||
2756 | match = ( (==subdom) . take (fromIntegral len)) | ||
2757 | subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)] | ||
2758 | subdom = Char8.unpack subdom0 | ||
2759 | len = T.length (uid_subdomain parsed) | ||
2760 | |||
2761 | isTorID _ = False | ||
2762 | |||
2763 | g <- newGenIO | ||
2764 | timestamp <- now | ||
2765 | -- timestamp <- epochTime | ||
2766 | let xs:xss = groupBy (\_ (b,_)->not b) marked | ||
2767 | pub' = map (snd . cleanup) xs | ||
2768 | ++ concatMap (signSelfAuthTorKeys (Just wkun) (g::SystemRandom) sec grip timestamp) | ||
2769 | (map (map cleanup) xss) | ||
2770 | cleanup (_,(topkey,_,pkt)) = (topkey,pkt) | ||
2771 | putStrLn $ "-------- signed ------> " -- ++ show (length pub, length pub') | ||
2772 | putStrLn "" | ||
2773 | putStrLn $ listKeysFiltered (map fingerprint (filter isPublicMaster pub')) (sec++pub') | ||
2774 | |||
2775 | let signed_bs = encode (Message pub') | ||
2776 | L.writeFile (output cmd) signed_bs | ||
2777 | |||
2778 | doCmd cmd@(Public {}) = do | ||
2779 | ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome | ||
2780 | , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg | ||
2781 | , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" | ||
2782 | ) <- getPGPEnviron cmd | ||
2783 | let pub = map secretToPublic sec | ||
2784 | bs = encode (Message pub) | ||
2785 | L.writeFile (output cmd) bs | ||
2786 | |||
2787 | doCmd cmd@(DumpPackets {}) = do | ||
2788 | ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome | ||
2789 | , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg | ||
2790 | , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" | ||
2791 | ) <- getPGPEnviron cmd | ||
2792 | p <- case files cmd of | ||
2793 | [] -> return sec | ||
2794 | fs -> do | ||
2795 | ms <- mapM readPacketsFromFile fs | ||
2796 | let unwrap (Message ps) = ps | ||
2797 | return (concatMap unwrap ms) | ||
2798 | if map toLower (marshal_test cmd) `elem` ["y","yes"] | ||
2799 | then L.putStr $ encode (Message p) | ||
2800 | else putStrLn $ PP.ppShow p | ||
2801 | |||
2802 | doCmd cmd@(MergeSecrets {}) = do | ||
2803 | ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome | ||
2804 | , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg | ||
2805 | , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" | ||
2806 | ) <- getPGPEnviron cmd | ||
2807 | let db = merge Map.empty "%secring" (Message sec) | ||
2808 | ms <- mapM readPacketsFromFile' (files cmd) | ||
2809 | let db' = foldl' (uncurry . merge) db ms | ||
2810 | m = flattenKeys False db' | ||
2811 | L.putStr (encode m) | ||
2812 | return () | ||
2813 | |||
2814 | -} | ||
2815 | |||
2816 | {- | ||
2817 | doCmd cmd@(Cross_Merge {}) = do | ||
2818 | (homedir,secring,pubring,grip0) <- getHomeDir (homedir cmd) | ||
2819 | -- grip0 may be empty, in which case we should use the first key | ||
2820 | cross_merge (secring:pubring:files cmd) $ \_ db -> return $ (Just db,db) | ||
2821 | |||
2822 | doCmd cmd@(CatPub {}) = do | ||
2823 | let spec:files = catpub_args cmd | ||
2824 | let (topspec,subspec) = unprefix '/' spec | ||
2825 | (toptyp,top) = unprefix ':' topspec | ||
2826 | (subtyp,sub) = unprefix ':' subspec | ||
2827 | |||
2828 | {- | ||
2829 | putStrLn $ "files = " ++ show files | ||
2830 | putStrLn $ "topspec = " ++show (toptyp,top) | ||
2831 | putStrLn $ "subspec = " ++show (subtyp,sub) | ||
2832 | -} | ||
2833 | ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome | ||
2834 | , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg | ||
2835 | , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" | ||
2836 | ) <- getPGPEnviron cmd | ||
2837 | |||
2838 | flip (maybe (error "No working key?")) grip $ \grip -> do | ||
2839 | |||
2840 | ms <- mapM readPacketsFromFile' files | ||
2841 | let db = merge Map.empty "%secring" (Message sec) | ||
2842 | db' = foldl' (uncurry . merge) db ms | ||
2843 | m = flattenKeys True db' | ||
2844 | Message allpkts = m | ||
2845 | |||
2846 | let topspec = case () of | ||
2847 | _ | null top && (subtyp=="fp" || (null subtyp && is40digitHex sub)) | ||
2848 | -> KeyGrip sub | ||
2849 | _ | null top -> KeyGrip grip | ||
2850 | _ | toptyp=="fp" || (null toptyp && is40digitHex top) | ||
2851 | -> {- trace "using top" $ -} KeyGrip top | ||
2852 | _ | toptyp=="u" -> KeyUidMatch top | ||
2853 | _ | otherwise -> KeyUidMatch top | ||
2854 | (pre, wksubs) = seek_key topspec allpkts | ||
2855 | if null wksubs then error ("No match for "++spec) else do | ||
2856 | let wk:subs = wksubs | ||
2857 | (_,wksubs') = seek_key topspec subs -- ambiguity check | ||
2858 | (_,ys) = case subtyp of | ||
2859 | "t" -> seek_key (KeyTag wk sub) subs | ||
2860 | "fp" | top=="" -> ([],wk:subs) | ||
2861 | "" | top=="" && is40digitHex sub -> ([],wk:subs) | ||
2862 | "" -> seek_key (KeyTag wk sub) subs | ||
2863 | when (not (null ys)) $ do | ||
2864 | let (_,ys') = seek_key (KeyTag wk sub) (tail ys) -- ambiguity check | ||
2865 | k = head ys | ||
2866 | rsa = pkcs8 . fromJust $ rsaKeyFromPacket k | ||
2867 | der = encodeASN1 DER (toASN1 rsa []) | ||
2868 | qq = Base64.encode (L.unpack der) | ||
2869 | split64 [] = [] | ||
2870 | split64 qq = as : split64 bs where (as,bs) = splitAt 64 qq | ||
2871 | -- putStrLn $ "top = " ++ show top | ||
2872 | -- putStrLn $ "wk = " ++ fingerprint wk | ||
2873 | -- putStrLn $ fingerprint k | ||
2874 | {- | ||
2875 | putStrLn $ show rsa | ||
2876 | putStrLn $ show der | ||
2877 | -} | ||
2878 | if null ys' && null wksubs' | ||
2879 | then | ||
2880 | putStr $ unlines (["-----BEGIN PUBLIC KEY-----"] | ||
2881 | ++split64 qq | ||
2882 | ++["-----END PUBLIC KEY-----"]) | ||
2883 | else | ||
2884 | error "Key specification is ambiguous." | ||
2885 | |||
2886 | doCmd cmd@(Add {}) = do | ||
2887 | ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome | ||
2888 | , sec -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg | ||
2889 | , grip -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321" | ||
2890 | ) <- getPGPEnviron cmd | ||
2891 | pw <- getPassphrase cmd | ||
2892 | |||
2893 | flip (maybe (error "No working key?")) grip $ \grip -> do | ||
2894 | |||
2895 | let (pre, wk:subs) = seek_key (KeyGrip grip) sec | ||
2896 | wkun = if symmetric_algorithm wk == Unencrypted | ||
2897 | then Just wk | ||
2898 | else do | ||
2899 | k <- decryptSecretKey pw wk | ||
2900 | guard (symmetric_algorithm k == Unencrypted) | ||
2901 | return k | ||
2902 | |||
2903 | flip (maybe (error "Bad passphrase?")) wkun$ \wkun -> do | ||
2904 | |||
2905 | let (uids,subkeys) = break isSubkey subs | ||
2906 | isSubkey p = isKey p && is_subkey p | ||
2907 | |||
2908 | (subkeys',remainder) = break isTopKey subkeys | ||
2909 | isTopKey p@(SecretKeyPacket {}) | not (is_subkey p) = True | ||
2910 | isTopKey _ = False | ||
2911 | |||
2912 | let parseKeySpec hint spec = case break (==':') spec of | ||
2913 | (fmt,_:file) -> (fmt,file) | ||
2914 | (file,"") -> (guessKeyFormat hint (key_usage cmd), file) | ||
2915 | (secfmt,secfile) = parseKeySpec 'S' $ seckey cmd | ||
2916 | -- (pubfmt,pubfile) = parseKeySpec 'P' $ pubkey cmd | ||
2917 | Message parsedkey <- readKeyFromFile False secfmt secfile | ||
2918 | |||
2919 | let pkf = fingerprint (head parsedkey) | ||
2920 | (prepk,pks) = seek_key (KeyGrip pkf) subkeys' | ||
2921 | |||
2922 | g <- newGenIO | ||
2923 | timestamp <- now | ||
2924 | let uids' = do | ||
2925 | torkey <- parsedkey | ||
2926 | if key_usage cmd /= "tor" | ||
2927 | then uids | ||
2928 | else let ps = makeTorUID (g::SystemRandom) | ||
2929 | timestamp | ||
2930 | wkun | ||
2931 | (keyFlags wkun uids) | ||
2932 | wk | ||
2933 | torkey | ||
2934 | toruid = head ps | ||
2935 | in if toruid `elem` uids then uids else uids ++ ps | ||
2936 | if not (null pks) | ||
2937 | then existingKey (prepk,pks) remainder wkun wk parsedkey (key_usage cmd) pre uids' subkeys (output cmd) grip | ||
2938 | else newKey wkun wk parsedkey (key_usage cmd) pre uids' subkeys (output cmd) grip | ||
2939 | |||
2940 | doCmd cmd@(PemFP {}) = do | ||
2941 | let parseKeySpec hint spec = case break (==':') spec of | ||
2942 | (fmt,_:file) -> (fmt,file) | ||
2943 | (file,"") -> (guessKeyFormat hint ("ssh-host"), file) | ||
2944 | (secfmt,secfile) = parseKeySpec 'S' $ seckey cmd | ||
2945 | Message seckey <- readKeyFromFile False secfmt secfile | ||
2946 | -- Message pubkey <- readKeyFromFile True pubfmt pubfile | ||
2947 | -- Tor requires public key file... TODO | ||
2948 | -- let torhash sub = maybe "" id $ derToBase32 <$> derRSA sub | ||
2949 | putStrLn $ fingerprint (head seckey) -- ++ " " ++ torhash (head seckey) | ||
2950 | |||
2951 | -} | ||
2952 | 2663 | ||
2953 | isSameKey a b = sort (key apub) == sort (key bpub) | 2664 | isSameKey a b = sort (key apub) == sort (key bpub) |
2954 | where | 2665 | where |
2955 | apub = secretToPublic a | 2666 | apub = secretToPublic a |
2956 | bpub = secretToPublic b | 2667 | bpub = secretToPublic b |
2957 | 2668 | ||
2958 | {- | ||
2959 | existingKey (prepk,pks) remainder wkun wk parsedkey tag pre uids subkeys output_file grip = do | ||
2960 | -- putStrLn "Key already present." | ||
2961 | let pk:trail = pks | ||
2962 | (trailsigs,trail') = span isSignaturePacket trail | ||
2963 | (mysigs,notmines) = partition (endsWith grip . maybe "%bad%" id . signature_issuer) | ||
2964 | trailsigs | ||
2965 | endsWith big small = drop (length big - length small) big == small | ||
2966 | vs = map (\sig -> | ||
2967 | (sig, map (verify (Message [wk])) | ||
2968 | (signatures $ Message [wk,pk,sig]))) | ||
2969 | mysigs | ||
2970 | (verified,unverified) = partition (not . null . snd) vs | ||
2971 | sorted = sortBy (comparing (Down . signature_time . head . snd)) verified | ||
2972 | -- Note: format allows for signatures of type 0x28 Subkey revocation signature. | ||
2973 | case sorted of | ||
2974 | [] -> do | ||
2975 | putStrLn "Adding valid signature to existing key..." | ||
2976 | newKey wkun wk [pk] tag pre uids (trail++prepk++remainder) output_file grip | ||
2977 | (sig,ov):vs -> do | ||
2978 | -- sig exists. | ||
2979 | -- update sig to contain usage@ = tag | ||
2980 | let hs = filter (\p->isNotation p && notation_name p=="usage@") (hashed_subpackets sig) | ||
2981 | ks = map notation_value hs | ||
2982 | isNotation (NotationDataPacket {}) = True | ||
2983 | isNotation _ = False | ||
2984 | noop = do | ||
2985 | -- Nothing to do | ||
2986 | let sec' = pre ++ [wk] ++ uids ++ subkeys | ||
2987 | putStrLn $ tag ++ " key already present." | ||
2988 | L.writeFile output_file (encode (Message sec')) | ||
2989 | if tag `elem` ks | ||
2990 | then noop | ||
2991 | else do | ||
2992 | g <- newGenIO | ||
2993 | timestamp <- now | ||
2994 | let isCreation (SignatureCreationTimePacket {}) = True | ||
2995 | isCreation _ = False | ||
2996 | isExpiration (SignatureExpirationTimePacket {}) = True | ||
2997 | isExpiration _ = False | ||
2998 | (cs,ps) = partition isCreation (hashed_subpackets sig) | ||
2999 | (es,qs) = partition isExpiration ps | ||
3000 | stamp = listToMaybe . sortBy (comparing Down) $ | ||
3001 | map unwrap cs where unwrap (SignatureCreationTimePacket x) = x | ||
3002 | exp = listToMaybe $ sort $ | ||
3003 | map unwrap es where unwrap (SignatureExpirationTimePacket x) = x | ||
3004 | expires = liftA2 (+) stamp exp | ||
3005 | if fmap ( (< timestamp) . fromIntegral) expires == Just True then do | ||
3006 | putStrLn $ "Unable to update expired signature" | ||
3007 | noop | ||
3008 | else do | ||
3009 | let new_sig = fst $ sign (Message [wkun]) | ||
3010 | (SubkeySignature wk | ||
3011 | (head parsedkey) | ||
3012 | [sig'] ) | ||
3013 | SHA1 | ||
3014 | grip | ||
3015 | timestamp | ||
3016 | (g::SystemRandom) | ||
3017 | times = (:) (SignatureExpirationTimePacket (fromIntegral timestamp)) | ||
3018 | $ maybeToList $ do | ||
3019 | e <- expires | ||
3020 | return $ SignatureExpirationTimePacket (e - fromIntegral timestamp) | ||
3021 | notation = NotationDataPacket | ||
3022 | { notation_name = "usage@" | ||
3023 | , notation_value = tag | ||
3024 | , human_readable = True } | ||
3025 | sig' = sig { hashed_subpackets = times ++ [notation] ++ qs } | ||
3026 | |||
3027 | -- noop let sec' = pre ++ [wk] ++ uids ++ subkeys | ||
3028 | sec' = pre | ||
3029 | ++ [wk] | ||
3030 | ++ uids | ||
3031 | ++ prepk | ||
3032 | ++ [pk] | ||
3033 | ++ signatures_over new_sig | ||
3034 | ++ map fst vs | ||
3035 | ++ map fst unverified | ||
3036 | ++ notmines | ||
3037 | ++ trail' | ||
3038 | ++ remainder | ||
3039 | putStrLn $ "Adding usage@="++tag | ||
3040 | L.writeFile output_file (encode (Message sec')) | ||
3041 | |||
3042 | newKey wkun wk parsedkey tag pre uids subkeys output_file grip = do | ||
3043 | g <- newGenIO | ||
3044 | timestamp <- now | ||
3045 | |||
3046 | let | ||
3047 | new_sig = fst $ sign (Message [wkun]) | ||
3048 | (SubkeySignature wk | ||
3049 | (head parsedkey) | ||
3050 | (sigpackets 0x18 | ||
3051 | hashed0 | ||
3052 | ( IssuerPacket (fingerprint wk) | ||
3053 | : map EmbeddedSignaturePacket (signatures_over back_sig)))) | ||
3054 | SHA1 | ||
3055 | grip | ||
3056 | timestamp | ||
3057 | (g::SystemRandom) | ||
3058 | |||
3059 | hashed0 = | ||
3060 | [ KeyFlagsPacket | ||
3061 | { certify_keys = False | ||
3062 | , sign_data = False | ||
3063 | , encrypt_communication = False | ||
3064 | , encrypt_storage = False | ||
3065 | , split_key = False | ||
3066 | , authentication = True | ||
3067 | , group_key = False } | ||
3068 | , NotationDataPacket | ||
3069 | { human_readable = True | ||
3070 | , notation_name = "usage@" | ||
3071 | , notation_value = tag | ||
3072 | } | ||
3073 | , SignatureCreationTimePacket (fromIntegral timestamp) | ||
3074 | ] | ||
3075 | |||
3076 | subgrip = fingerprint (head parsedkey) | ||
3077 | |||
3078 | back_sig = fst $ sign (Message parsedkey) | ||
3079 | (SubkeySignature wk | ||
3080 | (head parsedkey) | ||
3081 | (sigpackets 0x19 | ||
3082 | hashed0 | ||
3083 | [IssuerPacket subgrip])) | ||
3084 | SHA1 | ||
3085 | subgrip | ||
3086 | timestamp | ||
3087 | (g::SystemRandom) | ||
3088 | |||
3089 | let sec' = pre ++ [wk] ++ uids ++ parsedkey ++ signatures_over new_sig ++ subkeys | ||
3090 | putStrLn $ listKeys sec' | ||
3091 | |||
3092 | L.writeFile output_file (encode (Message sec')) | ||
3093 | |||
3094 | {- | ||
3095 | let backsigs = do | ||
3096 | sig <- signatures (Message sec') | ||
3097 | sigover <- signatures_over sig | ||
3098 | subp <- unhashed_subpackets sigover | ||
3099 | -- guard (isEmbeddedSignature subp) | ||
3100 | subp <- maybeToList (backsig subp) | ||
3101 | over <- signatures (Message (filter isKey sec ++ [subp])) | ||
3102 | return over | ||
3103 | |||
3104 | -- putStrLn $ PP.ppShow backsigs | ||
3105 | -} | ||
3106 | |||
3107 | return () | ||
3108 | -} | ||
3109 | |||
3110 | 2669 | ||
3111 | 2670 | ||
3112 | groupBindings pub = | 2671 | groupBindings pub = |