module Propellor.Ssh where

import Propellor.Base
import Utility.UserInfo
import Utility.FileSystemEncoding

import System.Posix
import Data.Time.Clock.POSIX
import Data.Hashable

-- Parameters can be passed to both ssh and scp, to enable a ssh connection
-- caching socket.
--
-- If the socket already exists, check if its mtime is older than 10
-- minutes, and if so stop that ssh process, in order to not try to
-- use an old stale connection. (atime would be nicer, but there's
-- a good chance a laptop uses noatime)
sshCachingParams :: HostName -> IO [CommandParam]
sshCachingParams :: HostName -> IO [CommandParam]
sshCachingParams HostName
hn = do
	home <- IO HostName
myHomeDir
	let socketfile = HostName -> HostName -> HostName
socketFile HostName
home HostName
hn
	createDirectoryIfMissing True (takeDirectory socketfile)
	let ps =
		[ HostName -> CommandParam
Param HostName
"-o"
		, HostName -> CommandParam
Param (HostName
"ControlPath=" HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
socketfile)
		, HostName -> CommandParam
Param HostName
"-o", HostName -> CommandParam
Param HostName
"ControlMaster=auto"
		, HostName -> CommandParam
Param HostName
"-o", HostName -> CommandParam
Param HostName
"ControlPersist=yes"
		]

	maybe noop (expireold ps socketfile)
		=<< catchMaybeIO (getFileStatus socketfile)
	
	return ps
		
  where
	expireold :: [CommandParam] -> HostName -> FileStatus -> IO ()
expireold [CommandParam]
ps HostName
f FileStatus
s = do
		now <- POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (POSIXTime -> Integer) -> IO POSIXTime -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime
getPOSIXTime :: IO Integer
		if modificationTime s > fromIntegral now - tenminutes
			then touchFile f
			else do
				void $ boolSystem "ssh" $
					[ Param "-O", Param "stop" ] ++ ps ++
					[ Param "localhost" ]
				nukeFile f
	tenminutes :: EpochTime
tenminutes = EpochTime
600

-- Generate a socket filename inside the home directory.
--
-- There's a limit in the size of unix domain sockets, of approximately
-- 100 bytes. Try to never construct a filename longer than that.
--
-- When space allows, include the full hostname in the socket filename.
-- Otherwise, a checksum of the hostname is included in the name, to
-- avoid using the same socket file for multiple hosts.
socketFile :: FilePath -> HostName -> FilePath
socketFile :: HostName -> HostName -> HostName
socketFile HostName
home HostName
hn = [HostName] -> HostName -> HostName
selectSocketFile
	[ HostName
sshdir HostName -> HostName -> HostName
</> HostName
hn HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
".sock"
	, HostName
sshdir HostName -> HostName -> HostName
</> HostName
hn
	, HostName
sshdir HostName -> HostName -> HostName
</> Int -> HostName -> HostName
forall a. Int -> [a] -> [a]
take Int
10 HostName
hn HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
"-" HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
checksum
	, HostName
sshdir HostName -> HostName -> HostName
</> HostName
checksum
	]
	(HostName
home HostName -> HostName -> HostName
</> HostName
".propellor-" HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
checksum)
  where
	sshdir :: HostName
sshdir = HostName
home HostName -> HostName -> HostName
</> HostName
".ssh" HostName -> HostName -> HostName
</> HostName
"propellor"
	checksum :: HostName
checksum = Int -> HostName -> HostName
forall a. Int -> [a] -> [a]
take Int
9 (HostName -> HostName) -> HostName -> HostName
forall a b. (a -> b) -> a -> b
$ Int -> HostName
forall a. Show a => a -> HostName
show (Int -> HostName) -> Int -> HostName
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ HostName -> Int
forall a. Hashable a => a -> Int
hash HostName
hn

selectSocketFile :: [FilePath] -> FilePath -> FilePath
selectSocketFile :: [HostName] -> HostName -> HostName
selectSocketFile [] HostName
d = HostName
d
selectSocketFile (HostName
f:[HostName]
fs) HostName
d
	| HostName -> Bool
valid_unix_socket_path HostName
f = HostName
f
	| Bool
otherwise = [HostName] -> HostName -> HostName
selectSocketFile [HostName]
fs HostName
d

valid_unix_socket_path :: FilePath -> Bool
valid_unix_socket_path :: HostName -> Bool
valid_unix_socket_path HostName
f = [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (HostName -> [Word8]
decodeW8 HostName
f) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
reservedbyssh
  where
	-- ssh tacks on 17 or so characters when making a socket
	reservedbyssh :: Int
reservedbyssh = Int
18