ndwarshuis
/
rofi-extras
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ADD options for cifs

This commit is contained in:
Nathan Dwarshuis 2021-03-26 00:17:13 -04:00
parent c034952771
commit 9fc0e8df29
1 changed files with 49 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
app/rofi-dev.hs
View File

@ -306,6 +306,22 @@ instance FromJSON PasswordConfig where
<*> o .:? "libsecret" <*> o .:? "libsecret"
<*> o .:? "prompt" <*> o .:? "prompt"
data CIFSOptsConfig = CIFSOptsConfig
{ cifsoptsUsername :: Maybe String
, cifsoptsWorkgroup :: Maybe String
, cifsoptsUID :: Maybe Integer
, cifsoptsGID :: Maybe Integer
, cifsoptsIocharset :: Maybe String
} deriving Show
instance FromJSON CIFSOptsConfig where
parseJSON = withObject "options" $ \o -> CIFSOptsConfig
<$> o .:? "username"
<*> o .:? "workgroup"
<*> o .:? "uid"
<*> o .:? "gid"
<*> o .:? "isocharset"
data DataConfig = VeracryptConfig data DataConfig = VeracryptConfig
{ veracryptVolume :: String { veracryptVolume :: String
, veracryptPassword :: Maybe PasswordConfig , veracryptPassword :: Maybe PasswordConfig
@ -315,6 +331,7 @@ data DataConfig = VeracryptConfig
{ cifsRemote :: String { cifsRemote :: String
, cifsSudo :: Bool , cifsSudo :: Bool
, cifsPassword :: Maybe PasswordConfig , cifsPassword :: Maybe PasswordConfig
, cifsOpts :: Maybe CIFSOptsConfig
} deriving Show } deriving Show
data DeviceConfig = DeviceConfig data DeviceConfig = DeviceConfig
@ -337,6 +354,7 @@ instance FromJSON TreeConfig where
<$> o .: "remote" <$> o .: "remote"
<*> o .:? "sudo" .!= False <*> o .:? "sudo" .!= False
<*> o .:? "password" <*> o .:? "password"
<*> o .:? "options"
"sshfs" -> SSHFSConfig "sshfs" -> SSHFSConfig
<$> o .: "remote" <$> o .: "remote"
"veracrypt" -> VeracryptConfig "veracrypt" -> VeracryptConfig
@ -429,7 +447,12 @@ instance Mountable DeviceConfig where
$ io $ io
$ case devData of $ case devData of
SSHFSConfig{ sshfsRemote = r } -> mountSSHFS m' r SSHFSConfig{ sshfsRemote = r } -> mountSSHFS m' r
CIFSConfig{ cifsPassword = p, cifsSudo = s } -> mountCIFS s m' p CIFSConfig
{ cifsRemote = r
, cifsSudo = s
, cifsPassword = p
, cifsOpts = o
} -> mountCIFS s r m' o p
VeracryptConfig{ veracryptPassword = p, veracryptVolume = v } -> VeracryptConfig{ veracryptPassword = p, veracryptVolume = v } ->
mountVeracrypt m' p v mountVeracrypt m' p v
@ -457,11 +480,25 @@ instance Mountable DeviceConfig where
mountSSHFS :: FilePath -> String -> IO MountResult mountSSHFS :: FilePath -> String -> IO MountResult
mountSSHFS mountpoint remote = runMount "sshfs" [remote, mountpoint] "" mountSSHFS mountpoint remote = runMount "sshfs" [remote, mountpoint] ""
mountCIFS :: Bool -> FilePath -> Maybe PasswordConfig -> IO MountResult mountCIFS :: Bool -> String -> FilePath -> Maybe CIFSOptsConfig
mountCIFS useSudo mountpoint pwdConfig = withPasswordGetter pwdConfig runPwd run -> Maybe PasswordConfig -> IO MountResult
mountCIFS useSudo remote mountpoint opts pwdConfig =
withPasswordGetter pwdConfig runPwd run
where where
run = runMountSudoMaybe useSudo "mount" [mountpoint] run = runMountSudoMaybe useSudo "mount.cifs" args
runPwd p = runMountSudoMaybe' useSudo "mount" [mountpoint] [("PASSWD", p)] runPwd p = runMountSudoMaybe' useSudo "mount.cifs" args [("PASSWD", p)]
args = [remote, mountpoint] ++ maybe [] (\o -> ["-o", fromCIFSOpts o]) opts
fromCIFSOpts :: CIFSOptsConfig -> String
fromCIFSOpts o = intercalate "," $ mapMaybe concatMaybe fs
where
fs = [ ("username", cifsoptsUsername)
, ("workgroup", cifsoptsWorkgroup)
, ("uid", fmap show . cifsoptsUID)
, ("gid", fmap show . cifsoptsGID)
, ("iocharset", cifsoptsIocharset)
]
concatMaybe (k, f) = (\v -> k ++ "=" ++ v) <$> f o
mountVeracrypt :: FilePath -> Maybe PasswordConfig -> String -> IO MountResult mountVeracrypt :: FilePath -> Maybe PasswordConfig -> String -> IO MountResult
mountVeracrypt mountpoint pwdConfig volume = mountVeracrypt mountpoint pwdConfig volume =