summaryrefslogtreecommitdiffhomepage
path: root/keysafe.hs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2016-09-22 11:55:10 -0400
committerJoey Hess <joeyh@joeyh.name>2016-09-22 11:59:12 -0400
commit9eeb584342d1f29415065efc5ba34a7045b2259b (patch)
tree39ab33f724a7061fc6ebe9cf37917dd273b857d4 /keysafe.hs
parent44c4f503ae4c79739c52c73fdfa35e754621011c (diff)
downloadkeysafe-9eeb584342d1f29415065efc5ba34a7045b2259b.tar.gz
Added --autostart mode and install FDO autostart file
--autostart mode currently only uploads queued keys, but it will later be expanded to do more. Including checking the BackupRecord for problems when necessary. The autostart file is installed by keysafe --backup, so that when keysafe is installed with stack, and used, it will make sure it autostarts in the future. The autostart file is installed by the Makefile too. This will later let --autostart check for keys that have not been backed up and prompt about backing them up. This way, the user won't need to remember to run keysafe to back things up. Reused Utility.FreeDesktop from git-annex, and had to add some stuff it depends on. This commit was sponsored by Fernando Jimenez on Patreon.
Diffstat (limited to 'keysafe.hs')
-rw-r--r--keysafe.hs27
1 files changed, 21 insertions, 6 deletions
diff --git a/keysafe.hs b/keysafe.hs
index be5850b..6d5186a 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -20,6 +20,7 @@ import SecretKey
import Share
import Storage
import BackupRecord
+import AutoStart
import HTTP.Server
import ServerBackup
import qualified Gpg
@@ -64,11 +65,10 @@ dispatch cmdline ui storagelocations tunables possibletunables = do
=<< Gpg.getKeyToBackup ui
go CmdLine.Restore Nothing =
restore cmdline storagelocations ui possibletunables Gpg.anyKey
- go CmdLine.UploadQueued _ = do
- problems <- uploadQueued (CmdLine.localstoragedirectory cmdline)
- if null problems
- then return ()
- else showError ui ("Problem uploading queued data to servers:\n\n" ++ unlines problems ++ "\n\nYour secret keys have not yet been backed up.")
+ go CmdLine.UploadQueued _ =
+ uploadQueued ui (CmdLine.localstoragedirectory cmdline)
+ go CmdLine.AutoStart _ =
+ autoStart ui (CmdLine.localstoragedirectory cmdline)
go (CmdLine.Server) _ =
runServer
(CmdLine.localstoragedirectory cmdline)
@@ -86,6 +86,7 @@ dispatch cmdline ui storagelocations tunables possibletunables = do
backup :: CmdLine.CmdLine -> StorageLocations -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO ()
backup cmdline storagelocations ui tunables secretkeysource secretkey = do
+ installAutoStartFile
username <- userName
Name theirname <- case CmdLine.name cmdline of
Just n -> pure n
@@ -118,7 +119,10 @@ backup cmdline storagelocations ui tunables secretkeysource secretkey = do
StoreSuccess -> do
storeBackupRecord backuprecord
if queued
- then showInfo ui "Backup queued" "Some data was not sucessfully uploaded to servers, and has been queued for later upload. Run keysafe --uploadqueued at a later point to finish the backup."
+ then do
+ willautostart <- isAutoStartFileInstalled
+ showInfo ui "Backup queued" $ "Some data was not sucessfully uploaded to servers, and has been queued for later upload."
+ ++ if willautostart then "" else " Run keysafe --uploadqueued at a later point to finish the backup."
else showInfo ui "Backup success" "Your secret key was successfully encrypted and backed up."
StoreFailure s -> showError ui ("There was a problem storing your encrypted secret key: " ++ s)
StoreAlreadyExists -> do
@@ -326,3 +330,14 @@ userName :: IO Name
userName = do
u <- getUserEntryForID =<< getEffectiveUserID
return $ Name $ BU8.fromString $ takeWhile (/= ',') (userGecos u)
+
+uploadQueued :: UI -> Maybe LocalStorageDirectory -> IO ()
+uploadQueued ui d = do
+ problems <- tryUploadQueued d
+ if null problems
+ then return ()
+ else showError ui ("Problem uploading queued data to servers:\n\n" ++ unlines problems ++ "\n\nYour secret keys have not yet been backed up.")
+
+autoStart :: UI -> Maybe LocalStorageDirectory -> IO ()
+autoStart ui d = do
+ uploadQueued ui d