module Net.TFTP_Client(tftpGet,tftpPut) where
import Net.Concurrent
import Net.UDP_Client as UDP(Packet(..),template,listenAny,unlisten)
import qualified Net.PortNumber as Port
import Net.TFTP
import qualified Net.Interface as Net
import Net.Packet(listArray)
import Net.PacketParsing(doUnparse,doParse)
import Net.Utils(arraySize)
tftpGet debug udp serverIP filename mode =
do (tftp,close) <- initialize udp serverIP
result <- getBlocks tftp [] 0
close
return result
where
rrq = RRQ filename mode
getBlocks tftp bs last =
do p <- txRetry tftp (if last==0 then rrq else Ack last)
case p of
Nothing -> return $ Left "Timeout"
Just (Data nr b) ->
if nr==last+1
then if arraySize b<512
then do Net.txT tftp (Ack nr)
return (Right (reverse (b:bs)))
else getBlocks tftp (b:bs) nr
else if nr==last
then getBlocks tftp bs last
else return (Left "unexpected data block")
Just (Error c msg) ->
return $ Left $ "Server said: "++show c++" "++msg
Just msg -> return $ Left $ "Unexpected packet: "++show msg
tftpPut debug udp serverIP filename mode contents =
do (tftp,close) <- initialize udp serverIP
result <- putBlocks tftp (blocks contents) (WRQ filename mode) 0
close
return result
where
putBlocks tftp bs packet current =
do
p <- txRetry tftp packet
case p of
Nothing -> return $ Left "Timeout"
Just (Ack nr) ->
if nr==current
then case bs of
[] -> return (Right ())
b:bs -> putBlocks tftp bs (Data nr b) nr
where nr=current+1
else if nr==current1
then putBlocks tftp bs packet current
else return (Left "unexpected ack")
Just (Error c msg) ->
return $ Left $ "Server said: "++show c++" "++msg
Just msg -> return $ Left $ "Unexpected packet: "++show msg
blocks :: String -> [Data]
blocks s =
case splitAt 512 s of
([],_) -> []
(s1,s2) -> listArray (1,length s1) (conv s1):blocks s2
where
conv = map (fromIntegral.fromEnum)
txRetry tftp packet = rx 2
where
rx n =
do Net.txT tftp packet
maybe retry (return . Just) =<< Net.rxT tftp (Just t)
where
retry = if n>0 then rx (n1) else return Nothing
t = 2000000
initialize udp serverIP =
do (port,uclient) <- UDP.listenAny udp
portM <- newMVar Nothing
let rx t =
do r <- Net.rxT uclient t
case r of
Nothing -> return Nothing
Just (fromIP,udpP) ->
let sPort = sourcePort udpP in
case doParse (content udpP) of
Nothing -> rx t
Just p -> if fromIP==serverIP
then do optsp <- takeMVar portM
case optsp of
Nothing ->
do putMVar portM (Just sPort)
return (Just p)
Just port ->
do putMVar portM optsp
if port==sPort
then return (Just p)
else rx t
else rx t
tx msg =
do sPort <- maybe serverPort id `fmap` readMVar portM
Net.txT uclient (serverIP,udpP sPort)
where
udpP sPort = UDP.template port sPort bs
bs = doUnparse msg
return (Net.TimedInterface rx tx,unlisten udp port)
serverPort = Port.tftp