~singpolyma/jingle-xmpp

ref: 8e697719004d3b69b6af24a2f0645892cec539a7 jingle-xmpp/Jingle/Socks5Server.hs -rw-r--r-- 2.5 KiB
8e697719Christopher Vollick Complete Uploads Once They Reach Size 1 year, 4 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
module Jingle.Socks5Server (start) where

import Prelude ()
import BasicPrelude
import System.IO (IOMode(ReadMode))
import Network.Socks5.Types
	(SocksReply(SocksReplySuccess), SocksHostAddress(SocksAddrDomainName))
import Network.Socks5.Lowlevel
	(socksListen, requestDstAddr, sendSerialized, SocksResponse(..))
import UnexceptionalIO (UIO, Unexceptional)
import qualified UnexceptionalIO as UIO
import qualified Data.ByteString as ByteString
import qualified Network.Socket as Socket

import StoreChunks
import Util

start :: (Unexceptional m) =>
	   FilePath
	-> [Socket.SockAddr]
	-> (String -> UIO ())
	-> (JingleTSID -> UIO (Maybe Int))
	-> (JingleTSID -> FilePath -> UIO ())
	-> m (Either IOError ())
start storePath ports logger getSize transferFinished = UIO.fromIO' (error.show) $
	forM_ ports $ \port -> do
		Just family <- return $ addrToFamily port
		socket <- Socket.socket family Socket.Stream 0
		Socket.setSocketOption socket Socket.ReuseAddr 1
		Socket.bind socket port
		Socket.listen socket 5
		void $ UIO.fork (threadLoop port socket)
	where
	addrToFamily Socket.SockAddrInet {} = Just Socket.AF_INET
	addrToFamily Socket.SockAddrInet6 {} = Just Socket.AF_INET6
	addrToFamily _ = Nothing

	exceptionLogger :: IOError -> UIO ()
	exceptionLogger = logger . show

	threadLoop port socket =
		afterAccept port socket =<<
		UIO.fromIO' (error.show) (Socket.accept socket)

	afterAccept port socket (Right (conn, _)) = do
		void $ UIO.forkFinally
			(UIO.fromIO' (error.show) $ processConnection conn)
			afterAfterAccept
		threadLoop port socket
	afterAccept port socket (Left e) = do
		exceptionLogger e
		UIO.unsafeFromIO $ Socket.close socket
		-- Should these just get logged, or should the process die if we
		-- cannot restart?
		either exceptionLogger return =<<
			start storePath [port] logger getSize transferFinished

	afterAfterAccept (Right (Right ())) = return ()
	afterAfterAccept (Right (Left e)) = exceptionLogger e
	afterAfterAccept (Left e) = logger $ show e

	processConnection conn = do
		request <- socksListen conn
		let SocksAddrDomainName addr = requestDstAddr request
		let taddr = decodeUtf8 addr
		let saddr = textToString taddr
		size <- UIO.run $ getSize (JingleTSID taddr)
		sendSerialized conn $ SocksResponse
			SocksReplySuccess (SocksAddrDomainName addr) 0
		h <- Socket.socketToHandle conn ReadMode
		(path, _, _, _) <- UIO.runEitherIO $ storeChunks size storePath saddr
			(fromIO_ $ Just <$> ByteString.hGetSome h 4096)
		UIO.run $ transferFinished (JingleTSID taddr) path