webapp: Initial support for setting up encrypted removable drives.

No support yet for generating new gpg keys.
No support yet for adding existing encrypted repos from removable drives.

Assistant/WebApp/Configurators/Local.hs

@@ -34,10 +34,15 @@ import Logs.PreferredContent
 import Logs.UUID
 import Utility.UserInfo
 import Config
+import Utility.Gpg
+import qualified Annex.Branch
+import qualified Remote.GCrypt as GCrypt
+import qualified Types.Remote
 
 import qualified Data.Text as T
 import qualified Data.Map as M
 import Data.Char
+import Data.Ord
 import qualified Text.Hamlet as Hamlet
 
 data RepositoryPath = RepositoryPath Text
@@ -236,43 +241,63 @@ postAddDriveR = page "Add a removable drive" (Just Configuration) $ do
 {- The repo may already exist, when adding removable media
  - that has already been used elsewhere. If so, check
  - the UUID of the repo and see if it's one we know. If not,
- - the user must confirm the repository merge. -}
+ - the user must confirm the repository merge.
+ -
+ - If the repo does not already exist on the drive, prompt about
+ - encryption. -}
 getConfirmAddDriveR :: RemovableDrive -> Handler Html
-getConfirmAddDriveR drive = do
+getConfirmAddDriveR drive = ifM (liftIO $ doesDirectoryExist dir)
-	ifM (needconfirm)
+	( do
-		( page "Combine repositories?" (Just Configuration) $
+		mu <- liftIO $ catchMaybeIO $ inDir dir $ getUUID
-			$(widgetFile "configurators/adddrive/confirm")
+		case mu of
-		, do
+			Nothing -> knownrepo
-			getFinishAddDriveR drive
+			Just driveuuid -> 
-		)
+				ifM (M.member driveuuid <$> liftAnnex uuidMap)
+					( knownrepo
+					, askcombine
+					)
+	, newrepo
+	)
   where
   	dir = removableDriveRepository drive
-	needconfirm = ifM (liftIO $ doesDirectoryExist dir)
+  	newrepo = do
-		( liftAnnex $ do
+		secretkeys <- sortBy (comparing snd) . M.toList
-			mu <- liftIO $ catchMaybeIO $
+			<$> liftIO secretKeys
-				inDir dir $ getUUID
+		page "Encrypt repository?" (Just Configuration) $
-			case mu of
+			$(widgetFile "configurators/adddrive/encrypt")
-				Nothing -> return False
+	knownrepo = getFinishAddDriveR (RemovableDriveKey drive Nothing)
-				Just driveuuid -> not .
+	askcombine = page "Combine repositories?" (Just Configuration) $
-					M.member driveuuid <$> uuidMap
+		$(widgetFile "configurators/adddrive/combine")
-		, return False
-		)
 
 cloneModal :: Widget
 cloneModal = $(widgetFile "configurators/adddrive/clonemodal")
 
-getFinishAddDriveR :: RemovableDrive -> Handler Html
+getFinishAddDriveR :: RemovableDriveKey -> Handler Html
-getFinishAddDriveR drive = make >>= redirect . EditNewRepositoryR
+getFinishAddDriveR (RemovableDriveKey drive mkeyid) =
+	make >>= redirect . EditNewRepositoryR
   where
   	make = do
 		liftIO $ createDirectoryIfMissing True dir
 		isnew <- liftIO $ makeRepo dir True
-		u <- liftIO $ initRepo isnew False dir $ Just remotename
 		{- Removable drives are not reliable media, so enable fsync. -}
 		liftIO $ inDir dir $
 			setConfig (ConfigKey "core.fsyncobjectfiles")
 				(Git.Config.boolConfig True)
+		maybe (setupclear isnew) setupencrypted mkeyid
+	setupclear isnew = do
+		u <- liftIO $ initRepo isnew False dir $ Just remotename
 		r <- combineRepos dir remotename
+		finishsetup u r
+	setupencrypted keyid = do
+		r <- liftAnnex $ addRemote $ 
+			initSpecialRemote remotename GCrypt.remote $ M.fromList
+				[ ("type", "gcrypt")
+				, ("gitrepo", dir)
+				, configureEncryption HybridEncryption
+				, ("keyid", keyid)
+				]
+		finishsetup (Types.Remote.uuid r) r
+	finishsetup u r = do
 		liftAnnex $ setStandardGroup u TransferGroup
 		liftAssistant $ syncRemote r
 		return u
@@ -361,7 +386,7 @@ makeRepo path bare = ifM alreadyexists
 		| bare = baseparams ++ [Param "--bare", File path]
 		| otherwise = baseparams ++ [File path]
 
-{- Runs an action in the git-annex repository in the specified directory. -}
+{- Runs an action in the git repository in the specified directory. -}
 inDir :: FilePath -> Annex a -> IO a
 inDir dir a = do
 	state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir

Assistant/WebApp/Form.hs

@@ -75,7 +75,7 @@ withExpandableNote field (toggle, note) = withNote field $ [whamlet|
   where
   	ident = "toggle_" ++ toggle
 
-data EnableEncryption = SharedEncryption | NoEncryption
+data EnableEncryption = HybridEncryption | SharedEncryption | NoEncryption
 	deriving (Eq)
 
 {- Adds a check box to an AForm to control encryption. -}
@@ -96,3 +96,4 @@ enableEncryptionField = areq (selectFieldList choices) "Encryption" (Just Shared
 configureEncryption :: EnableEncryption -> (RemoteConfigKey, String)
 configureEncryption SharedEncryption = ("encryption", "shared")
 configureEncryption NoEncryption = ("encryption", "none")
+configureEncryption HybridEncryption = ("encryption", "hybrid")

Assistant/WebApp/Types.hs

@@ -21,6 +21,7 @@ import Utility.NotificationBroadcaster
 import Utility.WebApp
 import Utility.Yesod
 import Logs.Transfer
+import Utility.Gpg (KeyId)
 import Build.SysConfig (packageversion)
 
 import Yesod.Static
@@ -159,6 +160,9 @@ data RemovableDrive = RemovableDrive
 	}
 	deriving (Read, Show, Eq, Ord)
 
+data RemovableDriveKey = RemovableDriveKey RemovableDrive (Maybe KeyId)
+	deriving (Read, Show, Eq, Ord)
+
 {- Only needed to work around old-yesod bug that emits a warning message
  - when a route has two parameters. -}
 data FilePathAndUUID = FilePathAndUUID FilePath UUID
@@ -172,6 +176,10 @@ instance PathPiece RemovableDrive where
 	toPathPiece = pack . show
 	fromPathPiece = readish . unpack
 
+instance PathPiece RemovableDriveKey where
+	toPathPiece = pack . show
+	fromPathPiece = readish . unpack
+
 instance PathPiece SshData where
 	toPathPiece = pack . show
 	fromPathPiece = readish . unpack

Assistant/WebApp/routes

@@ -37,7 +37,7 @@
 
 /config/repository/add/drive AddDriveR GET POST
 /config/repository/add/drive/confirm/#RemovableDrive ConfirmAddDriveR GET
-/config/repository/add/drive/finish/#RemovableDrive FinishAddDriveR GET
+/config/repository/add/drive/finish/#RemovableDriveKey FinishAddDriveR GET
 /config/repository/add/ssh AddSshR GET POST
 /config/repository/add/ssh/confirm/#SshData ConfirmSshR GET
 /config/repository/add/ssh/retry/#SshData RetrySshR GET

debian/changelog

@@ -1,5 +1,8 @@
 git-annex (4.20130912) UNRELEASED; urgency=low
 
+  * webapp: Initial support for setting up encrypted removable drives.
+  * Recommend using my patched gcrypt, which fixes some bugs:
+    https://github.com/joeyh/git-remote-gcrypt
   * Support hot-swapping of removable drives containing gcrypt repositories.
   * remotes: New command, displays a compact table of remotes that
     contain files.

doc/install/fromscratch.mdwn

@@ -62,7 +62,7 @@ quite a lot.
   * [gpg](http://gnupg.org/) (optional; needed for encryption)
   * [lsof](ftp://lsof.itap.purdue.edu/pub/tools/unix/lsof/)
     (optional; recommended for watch mode)
-  * [gcrypt](https://github.com/blake2-ppc/git-remote-gcrypt)
+  * [gcrypt](https://github.com/joeyh/git-remote-gcrypt)
     (optional)
   * multicast DNS support, provided on linux by [nss-mdns](http://www.0pointer.de/lennart/projects/nss-mdns/)
     (optional; recommended for the assistant to support pairing well)

templates/configurators/adddrive.hamlet

@@ -29,4 +29,3 @@
         <button .btn .btn-primary type=submit onclick="$('#clonemodal').modal('show');">Use this drive</button> #
         <a .btn href="@{AddDriveR}">
           Rescan for removable drives
-^{cloneModal}

templates/configurators/adddrive/combine.hamlet

@@ -7,7 +7,7 @@
   <p>
     Do you want to combine these files into your repository?
   <p>
-    <a .btn href="@{FinishAddDriveR drive}">
+    <a .btn href="@{FinishAddDriveR (RemovableDriveKey drive Nothing)}">
       <i .icon-resize-small></i> Combine the repositories #
     The combined repositories will sync and share their files.
   <p>

templates/configurators/adddrive/encrypt.hamlet

@@ -0,0 +1,30 @@
+<div .span9 .hero-unit>
+  <h2>
+    Encrypt this drive?
+  <p>
+    Encrypting the repository stored on the removable drive at #
+    <tt>#{mountPoint drive}</tt> #
+    will prevent the data stored in it from being exposed if the drive #
+    falls into the wrong hands. However, encryption #
+    will also prevent you from sharing the drive with friends, or #
+    easily accessing its contents on another computer.
+  <p>
+    <a .btn href="@{FinishAddDriveR (RemovableDriveKey drive Nothing)}">
+      <i .icon-minus-sign></i> Do not encrypt repository #
+    Anyone who has the drive can see the files stored on it.
+    $forall (keyid, name) <- secretkeys
+      <p>
+        <a .btn href="@{FinishAddDriveR (RemovableDriveKey drive (Just keyid))}">
+          <i .icon-ok-sign></i> Encrypt repository #
+        to
+        <span title="key id #{keyid}">
+          <i .icon-user></i> #
+          $if null name
+            key id #{keyid}
+          $else
+            #{name}
+  <p>
+    <a .btn href="">
+      <i .icon-plus-sign></i> Encrypt repository #
+    with a new encryption key
+^{cloneModal}