[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 20821e132b4ec902a115c094bfcbb77c788c7257
Author: John Goerzen <jgoerzen at complete.org>
Date:   Fri Dec 24 00:59:37 2004 +0100

    Checkpointing lsl work
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-159)

diff --git a/ChangeLog b/ChangeLog
index dffe768..f380eec 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,18 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-23 17:59:37 GMT	John Goerzen <jgoerzen at complete.org>	patch-159
+
+    Summary:
+      Checkpointing lsl work
+    Revision:
+      missingh--head--0.7--patch-159
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVFS/Utils.hs
+
+
 2004-12-23 17:48:25 GMT	John Goerzen <jgoerzen at complete.org>	patch-158
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVFS/Utils.hs b/libsrc/MissingH/IO/HVFS/Utils.hs
index 6bd0a0b..a27d2fa 100644
--- a/libsrc/MissingH/IO/HVFS/Utils.hs
+++ b/libsrc/MissingH/IO/HVFS/Utils.hs
@@ -44,6 +44,8 @@ module MissingH.IO.HVFS.Utils (recurseDir,
 where
 
 import MissingH.IO.HVFS
+import System.Posix.Files
+import MissingH.Printf
 
 {- | Obtain a recursive listing of all files\/directories beneath 
 the specified directory.  The traversal is depth-first and the original
@@ -88,10 +90,26 @@ recursiveRemove h fn =
         recurseDirStat h fn >>= worker
 
 {- | Provide a result similar to the command ls -l over a directory.
+
+Known bug: setuid bit semantics are inexact compared with standard ls.
 -}
 lsl :: HVFS a => a -> FilePath -> IO String
 lsl fs fp =
-    let showentry (state, fp) = 
+    let showmodes mode = 
+            let i m = (intersectFileModes mode m /= 0)
+                in
+                (if i ownerReadMode then 'r' else '-') :
+                (if i ownerWriteMode then 'w' else '-') :
+                (if i setUserIDMode then 's' else
+                    if i ownerExecuteMode then 'x' else '-') :
+                (if i groupReadMode then 'r' else '-') :
+                (if i groupWriteMode then 'w' else '-') :
+                (if i setGroupIDMode then 's' else
+                    if i groupExecuteMode then 'x' else '-') :
+                (if i otherReadMode then 'r' else '-') :
+                (if i otherWriteMode then 'w' else '-') :
+                (if i otherExecuteMode then 'x' else '-') : []
+        showentry (state, fp) = 
             case state of
               HVFSStatEncap se -> 
                let typechar = 
@@ -102,7 +120,7 @@ lsl fs fp =
                        else if vIsSocket se then 's'
                        else if vIsNamedPipe se then 's'
                        else '-'
-                   in [typechar]
+                   in [typechar] ++ showmodes (vFileMode se)
                                            
         in do c <- vGetDirectoryContents fs fp
               pairs <- mapM (\x -> do ss <- vGetSymbolicLinkStatus fs x

-- 
haskell-testpack