Based on TSN documentation, split XML documents on the </message> tag instead of...

diff --git a/src/Main.hs b/src/Main.hs
index 6b18c8646d311bdcaef94042561299f1a5836241..f2febcb95ced479f1b965e2ea96ef21bf4ab7326 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -4,19 +4,19 @@
 module Main
 where
 
-import Control.Concurrent (threadDelay)
-import Control.Exception.Base (bracket)
-import Control.Monad (when)
-import Data.List (isPrefixOf)
-import Data.Maybe (isNothing)
-import Data.Monoid ((<>))
+import Control.Concurrent ( threadDelay )
+import Control.Exception.Base ( bracket )
+import Control.Monad ( when )
+import Data.List ( isPrefixOf )
+import Data.Maybe ( isNothing )
+import Data.Monoid ( (<>) )
 import Network (
   connectTo,
   PortID (PortNumber) )
-import System.Console.CmdArgs (def)
-import System.Directory (doesFileExist)
-import System.Exit (ExitCode(..), exitWith)
-import System.FilePath ((</>))
+import System.Console.CmdArgs ( def )
+import System.Directory ( doesFileExist )
+import System.Exit ( ExitCode(..), exitWith )
+import System.FilePath ( (</>) )
 import System.IO (
   BufferMode (NoBuffering),
   Handle,
@@ -27,11 +27,11 @@ import System.IO (
   hSetBuffering,
   stderr,
   stdout )
-import System.IO.Error (catchIOError)
-import System.Timeout (timeout)
+import System.IO.Error ( catchIOError )
+import System.Timeout ( timeout )
 
-import CommandLine (get_args)
-import Configuration (Configuration(..), merge_optional)
+import CommandLine ( get_args )
+import Configuration ( Configuration(..), merge_optional )
 import ExitCodes (
   exit_no_feed_hosts,
   exit_no_password,
@@ -51,8 +51,8 @@ import Terminal (
   display_info,
   display_sent,
   display_warning )
-import TSN.FeedHosts (FeedHosts(..))
-import TSN.Xml (parse_xmlfid, xml_prologue)
+import TSN.FeedHosts ( FeedHosts(..) )
+import TSN.Xml ( parse_xmlfid )
 
 
 -- | Warning! This does not automatically append a newline. The output
@@ -119,26 +119,36 @@ save_document cfg doc =
     maybe_path = fmap ((output_directory cfg) </>) filename
 
 
--- | Loop forever, writing the buffer to file whenever a new XML
---   prologue is seen. This is the low-level "loop forever" function
---   that we stay in as long as we are connected to one feed.
+-- | Loop forever, writing the buffer to file whenever a </message>
+--   tag is seen. This is the low-level "loop forever" function that
+--   we stay in as long as we are connected to one feed.
+--
+--   The documentation at
+--   <http://www.sportsnetworkdata.com/feeds/xml-levels.asp> states
+--   that \<message\> will always be the root element of the XML
+--   documents, and \</message\> will be the final line transmitted
+--   for a given document. We therefore rely on this to simplify
+--   processing.
 --
 loop :: Configuration -> Handle -> [String] -> IO ()
 loop !cfg !h !buffer = do
   line <- recv_line h
+  let new_buffer = line : buffer
 
-  if (xml_prologue `isPrefixOf` line && not (null buffer))
+  -- Use isPrefixOf to avoid line-ending issues. Hopefully they won't
+  -- send invalid junk (on the same line) after closing the root
+  -- element.
+  if "</message>" `isPrefixOf` line
   then do
-    -- This is the beginning of a new document, and we have an "old"
-    -- one to save. The buffer is in reverse (newest first) order,
-    -- though, so we have to reverse it first. We then concatenate all
-    -- of its lines into one big string.
-    let document = concat $ reverse buffer
+    -- The buffer is in reverse (newest first) order, though, so we
+    -- have to reverse it first. We then concatenate all of its lines
+    -- into one big string.
+    let document = concat $ reverse new_buffer
     save_document cfg document
-    loop cfg h [line] -- Empty the buffer before looping again.
+    loop cfg h [] -- Empty the buffer before looping again.
   else
     -- Append line to the head of the buffer and loop.
-    loop cfg h (line : buffer)
+    loop cfg h new_buffer
 
 
 log_in :: Configuration -> Handle -> IO ()
@@ -198,8 +208,14 @@ connect_and_loop cfg host = do
       --
       -- If we dump the packets with tcpdump, it looks like their
       -- software is getting confused: they send us some XML in
-      -- the middle of the log-in procedure. In any case, the easiest
-      -- fix is to disconnect and try again.
+      -- the middle of the log-in procedure.
+      --
+      -- On the other hand, the documentation at
+      -- <http://www.sportsnetworkdata.com/feeds/xml-levels.asp>
+      -- states that you can only make one connection per username to
+      -- a given host. So maybe they're simply rejecting the username
+      -- in an unfriendly fashion. In any case, the easiest fix is to
+      -- disconnect and try again.
       --
       login_worked <- timeout five_seconds $ log_in cfg h
       case login_worked of
@@ -270,5 +286,5 @@ main = do
       let hosts = get_feed_hosts $ feed_hosts cfg
       let host = hosts !! feed_host_idx
       catchIOError (connect_and_loop cfg host) (report_error . show)
-      thread_sleep 10 -- Wait 10s before attempting to reconnect.
+      thread_sleep 5 -- Wait 5s before attempting to reconnect.
       round_robin cfg $ (feed_host_idx + 1) `mod` (length hosts)

diff --git a/src/TSN/Xml.hs b/src/TSN/Xml.hs
index ddde728afa9c76727a427c849ee14a0d4a140100..4c1123f0c71f5aa4b20794031b262a862363ccc7 100644 (file)
--- a/src/TSN/Xml.hs
+++ b/src/TSN/Xml.hs
@@ -3,7 +3,6 @@
 --
 module TSN.Xml (
   parse_xmlfid,
-  xml_prologue,
   xml_tests )
 where
 
@@ -35,10 +34,6 @@ parse_xmlfid =
                >>> getText)
 
 
--- | The opening "tag" for the XML prologue.
-xml_prologue :: String
-xml_prologue = "<?xml "
-
 
 -- * Tasty Tests
 xml_tests :: TestTree