[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit 35e9878022492e1c16e257be6701e6c3aa594d4b
Author: John Goerzen <jgoerzen at complete.org>
Date:   Sat Oct 23 21:32:16 2004 +0100

    Added debugging support to FTP parser
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--1.0--patch-104)

diff --git a/ChangeLog b/ChangeLog
index 33e0bcf..5c9b4b6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,23 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--1.0
 #
 
+2004-10-23 15:32:16 GMT	John Goerzen <jgoerzen at complete.org>	patch-104
+
+    Summary:
+      Added debugging support to FTP parser
+    Revision:
+      missingh--head--1.0--patch-104
+
+
+    new files:
+     debian/libghc6-missingh-dev.postinst.debhelper
+     debian/libghc6-missingh-dev.prerm.debhelper
+
+    modified files:
+     ChangeLog libsrc/MissingH/Logging/Logger.hs
+     libsrc/MissingH/Network/FTP/Parser.hs
+
+
 2004-10-22 22:00:30 GMT	John Goerzen <jgoerzen at complete.org>	patch-103
 
     Summary:
diff --git a/debian/libghc6-missingh-dev.postinst.debhelper b/debian/libghc6-missingh-dev.postinst.debhelper
new file mode 100644
index 0000000..8856549
--- /dev/null
+++ b/debian/libghc6-missingh-dev.postinst.debhelper
@@ -0,0 +1,26 @@
+# Automatically added by dh_haskell
+GHC=ghc-6.2.1
+CONFIGFILE=/usr/lib/haskell-packages/ghc6/lib/MissingH-0.4.0/installed-pkg-config
+
+
+case "$1" in
+    configure)
+    /usr/lib/$GHC/bin/ghc-pkg -g --add-package \
+      < $CONFIGFILE
+
+    ;;
+
+    abort-upgrade|abort-remove|abort-deconfigure)
+
+    ;;
+
+    *)
+        echo "postinst called with unknown argument \`$1'" >&2
+        exit 1
+    ;;
+esac
+
+
+
+# arch-tag: haskell-devscripts generic GHC postinst template
+# End automatically added section
diff --git a/debian/libghc6-missingh-dev.prerm.debhelper b/debian/libghc6-missingh-dev.prerm.debhelper
new file mode 100644
index 0000000..a2b3633
--- /dev/null
+++ b/debian/libghc6-missingh-dev.prerm.debhelper
@@ -0,0 +1,25 @@
+# Automatically added by dh_haskell
+
+GHC=ghc-6.2.1
+CONFIGFILE=/usr/lib/haskell-packages/ghc6/lib/MissingH-0.4.0/installed-pkg-config
+CABALNAME=MissingH
+
+
+
+case "$1" in
+    remove|upgrade|deconfigure)
+      /usr/lib/$GHC/bin/ghc-pkg -r $CABALNAME
+      rm -vf /usr/lib/haskell-packages/ghc6/lib/MissingH-0.4.0/HSMissingH-0.4.0.o
+
+        ;;
+    failed-upgrade)
+        ;;
+    *)
+        echo "prerm called with unknown argument \`$1'" >&2
+        exit 1
+    ;;
+esac
+
+
+# arch-tag: haskell-devscripts generic GHC prerm template
+# End automatically added section
diff --git a/libsrc/MissingH/Logging/Logger.hs b/libsrc/MissingH/Logging/Logger.hs
index 0887638..eb31af5 100644
--- a/libsrc/MissingH/Logging/Logger.hs
+++ b/libsrc/MissingH/Logging/Logger.hs
@@ -356,16 +356,25 @@ logL l pri msg = handle l (pri, msg)
 -- | Handle a log request.
 handle :: Logger -> LogRecord -> IO ()
 handle l (pri, msg) = 
-    if pri >= (level l)
-       then do 
-            sequence_ (handlerActions (handlers l) (pri, msg))
-            -- Send it upstairs if we can
-            case (name l) of
-                "" -> return ()
-                x -> do 
-                     parent <- (getLogger . head . drop 1 . reverse . componentsOfName) x
-                     handle parent (pri, msg)
-       else return ()
+    let parentHandlers [] = return []
+        parentHandlers name =
+            let pname = (head . drop 1 . reverse . componentsOfName) name
+                in
+                do 
+                --putStrLn (join "," foo)
+                --putStrLn pname
+                --putStrLn "1"
+                parent <- getLogger pname
+                --putStrLn "2"
+                next <- parentHandlers pname
+                --putStrLn "3"
+                return ((handlers parent) ++ next)
+        in
+        if pri >= (level l)
+           then do 
+                ph <- parentHandlers (name l)
+                sequence_ (handlerActions (ph ++ (handlers l)) (pri, msg))
+           else return ()
 
 
 -- | Call a handler given a HandlerT.
diff --git a/libsrc/MissingH/Network/FTP/Parser.hs b/libsrc/MissingH/Network/FTP/Parser.hs
index 7b26e29..363cee6 100644
--- a/libsrc/MissingH/Network/FTP/Parser.hs
+++ b/libsrc/MissingH/Network/FTP/Parser.hs
@@ -35,16 +35,23 @@ Written by John Goerzen, jgoerzen\@complete.org
 -}
 
 module MissingH.Network.FTP.Parser(parseReply, parseGoodReply,
-                                  toPortString, fromPortString)
+                                  toPortString, fromPortString,
+                                  debugParseGoodReplyHandle)
 where
 
 import Text.ParserCombinators.Parsec
 import MissingH.Parsec
 import MissingH.List
 import MissingH.Bits
+import MissingH.Str
+import MissingH.Logging.Logger
 import Network.Socket(SockAddr(..), PortNumber(..))
+import System.IO(Handle, hGetContents)
 -- import Control.Exception(Exception(PatternMatchFail), throw)
 
+logit :: String -> IO ()
+logit m = debugM "MissingH.Network.FTP.Parser" ("FTP received: " ++ m)
+
 ----------------------------------------------------------------------
 -- Utilities
 ----------------------------------------------------------------------
@@ -152,6 +159,33 @@ parseGoodReply input =
         then error ((show (fst reply)) ++ ": " ++ (join "\n" (snd reply)))
         else reply
 
+-- | Parse a FTP reply.  Logs debug messages.
+debugParseGoodReply :: String -> IO (Int, [String])
+debugParseGoodReply contents =
+    let logPlugin :: String -> String -> IO String
+        logPlugin [] [] = return []
+        logPlugin [] accum = do
+                             logit accum 
+                             return []
+        logPlugin (x:xs) accum = 
+            case x of
+                   '\n' -> do logit (strip (accum))
+                              next <- logPlugin xs []
+                              return (x : next)
+                   y -> do
+                        next <- logPlugin xs (accum ++ [x])
+                        return (x : next)
+        in
+        do
+        loggedStr <- logPlugin contents []
+        return (parseGoodReply loggedStr)
+
+-- | Parse a FTP reply.  Log debug messages.
+debugParseGoodReplyHandle :: Handle -> IO (Int, [String])
+debugParseGoodReplyHandle h = do
+                              c <- hGetContents h
+                              debugParseGoodReply c
+
 {- | Converts a socket address to a string suitable for a PORT command.
 
 Example:

-- 
haskell-testpack