3 files changed, 50 insertions(+), 15 deletions(-)

M Jingle.hs
M Jingle/Socks5Server.hs
M StoreChunks.hs

@@ 2,7 2,9 @@ module Jingle (
 	setupJingleHandlers,
 	jingleHandler,
 	ibbHandler,
-	tsidToSidMap
+	tsidToSidMap,
+	JingleSID,
+	JingleTSID
 ) where
 
 import Prelude ()


@@ 196,6 198,9 @@ jingleHandler' hostPort newSession newTransport iq@XMPP.IQ {
 	| jingleAction (s"transport-info") iq,
 	  (_:_) <- jingleTransport `overChildrenOf` content =
 		XMPP.putStanza $ iqReply Nothing iq
+	| jingleAction (s"session-info") iq,
+	  (_:_) <- XML.isNamed (s"{urn:xmpp:jingle:apps:file-transfer:5}checksum") =<< children =
+		XMPP.putStanza $ iqReply Nothing iq
 	| jingleAction (s"transport-replace") iq,
 	  [tsid] <- elementAttributeText
 	            (s"sid")


@@ 307,19 312,39 @@ tsidToSidMap notifyBySid =
 				Just sid -> notifyBySid sid path
 	)
 
+sidToIqMap :: (Unexceptional m) =>
+	   (XMPP.IQ -> FilePath -> UIO ())
+	-> m (
+		JingleSID -> XMPP.IQ -> UIO (),
+		JingleSID -> FilePath -> UIO ()
+	)
+sidToIqMap notifyByIq =
+	fromIO_ (Cache.newCache (Just $ TimeSpec 900 0)) >>= \cache ->
+	return (
+		\(JingleSID sid) iq -> do
+			fromIO_ $ Cache.purgeExpired cache
+			fromIO_ $ Cache.insert cache sid iq
+		,
+		\(JingleSID sid) path -> do
+			miq <- fromIO_ $ Cache.lookup' cache sid
+			case miq of
+				Nothing -> return ()
+				Just iq -> notifyByIq iq path
+	)
+
 -- | Probably you want this
 setupJingleHandlers :: (Unexceptional m) =>
 	   FilePath
 	-> [Socket.SockAddr]
 	-> (Text, Socket.PortNumber)
-	-> (JingleSID -> XMPP.IQ -> UIO ())
-	-> (JingleSID -> FilePath -> UIO ())
+	-> (String -> UIO ())
+	-> (XMPP.IQ -> FilePath -> UIO ())
 	-> m (Either IOError (XMPP.IQ -> XMPP.XMPP ()))
-setupJingleHandlers storePath ports hostPort newSession transferDone = do
+setupJingleHandlers storePath ports hostPort logger transferDoneIq = do
+	(newSession, transferDone) <- sidToIqMap transferDoneIq
 	(newTransport, transportDone) <- tsidToSidMap transferDone
 	(fmap.fmap) (\() ->
 			iqSetHandler storePath hostPort
 				newSession newTransport transportDone
 		) $
-		Socks5Server.start storePath ports
-			(fromIO_ . print) transportDone
+		Socks5Server.start storePath ports logger transportDone

@@ 18,13 18,14 @@ import Util
 start :: (Unexceptional m) =>
 	   FilePath
 	-> [Socket.SockAddr]
-	-> (IOError -> UIO ())
+	-> (String -> UIO ())
 	-> (JingleTSID -> FilePath -> UIO ())
 	-> m (Either IOError ())
 start storePath ports logger 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)


@@ 33,22 34,30 @@ start storePath ports logger transferFinished = UIO.fromIO' (error.show) $
 	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.fork $ (either logger return =<<) $
-			UIO.fromIO' (error.show) $ processConnection conn
+		void $ UIO.forkFinally
+			(UIO.fromIO' (error.show) $ processConnection conn)
+			afterAfterAccept
 		threadLoop port socket
 	afterAccept port socket (Left e) = do
-		logger e
+		exceptionLogger e
 		UIO.unsafeFromIO $ Socket.close socket
 		-- Should these just get logged, or should the process die if we
 		-- cannot restart?
-		either logger return =<<
+		either exceptionLogger return =<<
 			start storePath [port] logger 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

@@ 5,7 5,7 @@ import BasicPrelude
 import Crypto.Hash
 	(Digest, SHA1, SHA256, SHA512, hashUpdate, hashFinalize, hashInit)
 import System.Directory
-	(createDirectoryIfMissing, renameFile, createFileLink, doesPathExist)
+	(createDirectoryIfMissing, renameFile, createFileLink, doesFileExist)
 import UnexceptionalIO (Unexceptional, UIO)
 import qualified UnexceptionalIO as UIO
 import qualified Data.ByteString as ByteString


@@ 17,7 17,7 @@ digestCID = CID.cidToText . CID.newCidV1 CID.Raw
 
 createLinkIfNotExist :: FilePath -> FilePath -> IO ()
 createLinkIfNotExist target link = do
-	exist <- doesPathExist link
+	exist <- doesFileExist link
 	when (not exist) $ createFileLink target link
 
 storeChunks :: (Unexceptional m) =>


@@ 57,8 57,9 @@ storeChunks storePath tmpName getChunk = loop hashInit hashInit hashInit
 		let sha256f = hashFinalize sha256
 		let sha512f = hashFinalize sha512
 		let finalPath = cidPath sha512f
+		let finalCID = textToString (digestCID sha512f)
 		(fmap.fmap) (const (finalPath, sha1f, sha256f, sha512f)) $
 			UIO.fromIO' (error.show) $ do
 				renameFile tmpPath finalPath
-				createLinkIfNotExist finalPath (cidPath sha1f)
-				createLinkIfNotExist finalPath (cidPath sha256f)
+				createLinkIfNotExist finalCID (cidPath sha1f)
+				createLinkIfNotExist finalCID (cidPath sha256f)