38d691a10f
Running git-annex linux builds in termux seems to work well enough that the only reason to keep the Android app would be to support Android 4-5, which the old Android app supported, and which I don't know if the termux method works on (although I see no reason why it would not). According to [1], Android 4-5 remains on around 29% of devices, down from 51% one year ago. [1] https://www.statista.com/statistics/271774/share-of-android-platforms-on-mobile-devices-with-android-os/ This is a rather large commit, but mostly very straightfoward removal of android ifdefs and patches and associated cruft. Also, removed support for building with very old ghc < 8.0.1, and with yesod < 1.4.3, and without concurrent-output, which were only being used by the cross build. Some documentation specific to the Android app (screenshots etc) needs to be updated still. This commit was sponsored by Brett Eisenberg on Patreon.
97 lines
2.7 KiB
Haskell
97 lines
2.7 KiB
Haskell
{- git-annex assistant repo pairing, core data types
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Assistant.Pairing where
|
|
|
|
import Annex.Common
|
|
import Utility.Verifiable
|
|
import Assistant.Ssh
|
|
|
|
import Control.Concurrent
|
|
import Network.Socket
|
|
import Data.Char
|
|
import qualified Data.Text as T
|
|
|
|
data PairStage
|
|
{- "I'll pair with anybody who shares the secret that can be used
|
|
- to verify this request." -}
|
|
= PairReq
|
|
{- "I've verified your request, and you can verify this to see
|
|
- that I know the secret. I set up your ssh key already.
|
|
- Here's mine for you to set up." -}
|
|
| PairAck
|
|
{- "I saw your PairAck; you can stop sending them." -}
|
|
| PairDone
|
|
deriving (Eq, Read, Show, Ord, Enum)
|
|
|
|
newtype PairMsg = PairMsg (Verifiable (PairStage, PairData, SomeAddr))
|
|
deriving (Eq, Read, Show)
|
|
|
|
verifiedPairMsg :: PairMsg -> PairingInProgress -> Bool
|
|
verifiedPairMsg (PairMsg m) pip = verify m $ inProgressSecret pip
|
|
|
|
fromPairMsg :: PairMsg -> Verifiable (PairStage, PairData, SomeAddr)
|
|
fromPairMsg (PairMsg m) = m
|
|
|
|
pairMsgStage :: PairMsg -> PairStage
|
|
pairMsgStage (PairMsg (Verifiable (s, _, _) _)) = s
|
|
|
|
pairMsgData :: PairMsg -> PairData
|
|
pairMsgData (PairMsg (Verifiable (_, d, _) _)) = d
|
|
|
|
pairMsgAddr :: PairMsg -> SomeAddr
|
|
pairMsgAddr (PairMsg (Verifiable (_, _, a) _)) = a
|
|
|
|
data PairData = PairData
|
|
-- uname -n output, not a full domain name
|
|
{ remoteHostName :: Maybe HostName
|
|
, remoteUserName :: UserName
|
|
, remoteDirectory :: FilePath
|
|
, remoteSshPubKey :: SshPubKey
|
|
, pairUUID :: UUID
|
|
}
|
|
deriving (Eq, Read, Show)
|
|
|
|
checkSane :: PairData -> Bool
|
|
checkSane p = all (not . any isControl)
|
|
[ fromMaybe "" (remoteHostName p)
|
|
, remoteUserName p
|
|
, remoteDirectory p
|
|
, remoteSshPubKey p
|
|
, fromUUID (pairUUID p)
|
|
]
|
|
|
|
type UserName = String
|
|
|
|
{- A pairing that is in progress has a secret, a thread that is
|
|
- broadcasting pairing messages, and a SshKeyPair that has not yet been
|
|
- set up on disk. -}
|
|
data PairingInProgress = PairingInProgress
|
|
{ inProgressSecret :: Secret
|
|
, inProgressThreadId :: Maybe ThreadId
|
|
, inProgressSshKeyPair :: SshKeyPair
|
|
, inProgressPairData :: PairData
|
|
, inProgressPairStage :: PairStage
|
|
}
|
|
deriving (Show)
|
|
|
|
data AddrClass = IPv4AddrClass | IPv6AddrClass
|
|
|
|
data SomeAddr = IPv4Addr HostAddress
|
|
| IPv6Addr HostAddress6
|
|
deriving (Ord, Eq, Read, Show)
|
|
|
|
{- This contains the whole secret, just lightly obfuscated to make it not
|
|
- too obvious. It's only displayed in the user's web browser. -}
|
|
newtype SecretReminder = SecretReminder [Int]
|
|
deriving (Show, Eq, Ord, Read)
|
|
|
|
toSecretReminder :: T.Text -> SecretReminder
|
|
toSecretReminder = SecretReminder . map ord . T.unpack
|
|
|
|
fromSecretReminder :: SecretReminder -> T.Text
|
|
fromSecretReminder (SecretReminder s) = T.pack $ map chr s
|