M Jingle.hs => Jingle.hs +31 -6
@@ 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
M Jingle/Socks5Server.hs => Jingle/Socks5Server.hs +14 -5
@@ 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
M StoreChunks.hs => StoreChunks.hs +5 -4
@@ 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)