Resolve file descriptor names

cbits/resolve-fd-name.c

@@ -0,0 +1,60 @@
+#include <errno.h>
+#include <sys/param.h>
+
+#ifdef __linux__
+#include <stdio.h>
+#include <unistd.h>
+#else
+#include <libproc.h>
+#include <memory.h>
+#endif
+
+// assert: sizeof(buf) == MAXPATHLEN
+// return:
+//   * -1 = see errno
+//   *  0 = ok
+//   *  1 = File does not exist
+//   *  2 = Something terrible happened
+int resolve_fd_name(int pid, int fd, char buf[]) {
+
+#if defined __linux__
+
+  char proc_path[MAXPATHLEN];
+  snprintf(proc_path, MAXPATHLEN, "/proc/%d/fd/%d", pid, fd);
+
+  int bytes = readlink(proc_path, buf, MAXPATHLEN - 1);
+  if (bytes < 0) {
+    return -1;
+  }
+
+  buf[bytes] = '\0';
+
+  return 0;
+
+#elif defined __APPLE__
+
+  struct vnode_fdinfowithpath vi;
+
+  int nb = proc_pidfdinfo(pid, fd, PROC_PIDFDVNODEPATHINFO, &vi, sizeof(vi));
+
+  if (nb <= 0) {
+    if (errno == ENOENT) {
+      return 1;
+    } else {
+      return -1;
+    }
+  } else if (nb != sizeof(vi)) {
+    return 2;
+  }
+
+  memcpy(buf, vi.pvip.vip_path, MAXPATHLEN);
+
+  return 0;
+
+#else
+
+  return 2
+
+#endif
+
+}

hatrace.cabal

@@ -27,7 +27,9 @@ extra-source-files:
 library
   hs-source-dirs:      src
   c-sources:           cbits/fork-exec-ptrace.c
+                     , cbits/resolve-fd-name.c
   exposed-modules:     System.Hatrace
+                       System.Hatrace.FdNames
                        System.Hatrace.Main
                        System.Hatrace.SignalMap
                        System.Hatrace.SyscallTables

src/System/Hatrace.hs

@@ -129,6 +129,7 @@ import           System.Posix.Waitpid (waitpid, waitpidFullStatus, Status(..), F
 import           UnliftIO.Concurrent (runInBoundThread)
 import           UnliftIO.IORef (newIORef, writeIORef, readIORef)
 
+import           System.Hatrace.FdNames (resolveFdName)
 import           System.Hatrace.SignalMap (signalMap)
 import           System.Hatrace.SyscallTables.Generated (KnownSyscall(..), syscallName, syscallMap_i386, syscallMap_x64_64)
 import           System.Hatrace.Types
@@ -441,6 +442,7 @@ data SyscallEnterDetails_write = SyscallEnterDetails_write
   , buf :: Ptr Void
   , count :: CSize
   -- Peeked details
+  , filePath :: Maybe FilePath
   , bufContents :: ByteString
   } deriving (Eq, Ord, Show)
 
@@ -455,6 +457,8 @@ data SyscallEnterDetails_read = SyscallEnterDetails_read
   { fd :: CInt
   , buf :: Ptr Void
   , count :: CSize
+  -- Peeked details
+  , filePath :: Maybe FilePath
   } deriving (Eq, Ord, Show)
 
 
@@ -468,6 +472,8 @@ data SyscallExitDetails_read = SyscallExitDetails_read
 
 data SyscallEnterDetails_close = SyscallEnterDetails_close
   { fd :: CInt
+  -- Peeked details
+  , filePath :: Maybe FilePath
   } deriving (Eq, Ord, Show)
 
 
@@ -749,21 +755,27 @@ getSyscallEnterDetails syscall syscallArgs pid = let proc = TracedProcess pid in
       }
   Syscall_write -> do
     let SyscallArgs{ arg0 = fd, arg1 = bufAddr, arg2 = count } = syscallArgs
+    let fd' = fromIntegral fd
     let bufPtr = word64ToPtr bufAddr
     bufContents <- peekBytes proc bufPtr (fromIntegral count)
+    filePath <- resolveFdName pid fd'
     pure $ DetailedSyscallEnter_write $ SyscallEnterDetails_write
-      { fd = fromIntegral fd
+      { fd = fd'
       , buf = bufPtr
       , count = fromIntegral count
+      , filePath
       , bufContents
       }
   Syscall_read -> do
     let SyscallArgs{ arg0 = fd, arg1 = bufAddr, arg2 = count } = syscallArgs
+    let fd' = fromIntegral fd
     let bufPtr = word64ToPtr bufAddr
+    filePath <- resolveFdName pid fd'
     pure $ DetailedSyscallEnter_read $ SyscallEnterDetails_read
-      { fd = fromIntegral fd
+      { fd = fd'
       , buf = bufPtr
       , count = fromIntegral count
+      , filePath
       }
   Syscall_execve -> do
     let SyscallArgs{ arg0 = filenameAddr, arg1 = argvPtrsAddr, arg2 = envpPtrsAddr } = syscallArgs
@@ -803,8 +815,11 @@ getSyscallEnterDetails syscall syscallArgs pid = let proc = TracedProcess pid in
       }
   Syscall_close -> do
     let SyscallArgs{ arg0 = fd } = syscallArgs
+    let fd' = fromIntegral fd
+    filePath <- resolveFdName pid fd'
     pure $ DetailedSyscallEnter_close $ SyscallEnterDetails_close
-      { fd = fromIntegral fd
+      { fd = fd'
+      , filePath
       }
   Syscall_rename -> do
     let SyscallArgs{ arg0 = oldpathAddr, arg1 = newpathAddr } = syscallArgs
@@ -1088,16 +1103,16 @@ formatDetailedSyscallEnter = \case
       "faccessat(" ++ show dirfd ++ ", " ++ show pathnameBS ++ ", " ++ hShow accessMode ++ ", " ++ show flags ++")"
 
   DetailedSyscallEnter_write
-    SyscallEnterDetails_write{ fd, bufContents, count } ->
-      "write(" ++ show fd ++ ", " ++ show bufContents ++ ", " ++ show count ++ ")"
+    SyscallEnterDetails_write{ fd, filePath, bufContents, count } ->
+      "write(" ++ show fd ++ ", " ++ show filePath ++ ", " ++ show bufContents ++ ", " ++ show count ++ ")"
 
   DetailedSyscallEnter_read
-    SyscallEnterDetails_read{ fd, count } ->
-      "read(" ++ show fd ++ ", void *buf, " ++ show count ++ ")"
+    SyscallEnterDetails_read{ fd, filePath, count } ->
+      "read(" ++ show fd ++ ", " ++ show filePath ++ ", void *buf, " ++ show count ++ ")"
 
   DetailedSyscallEnter_close
-    SyscallEnterDetails_close{ fd } ->
-      "close(" ++ show fd ++ ")"
+    SyscallEnterDetails_close{ fd, filePath } ->
+      "close(" ++ show fd ++ ", " ++ show filePath ++ ")"
 
   DetailedSyscallEnter_rename
     SyscallEnterDetails_rename{ oldpathBS, newpathBS } ->

src/System/Hatrace/FdNames.hsc

@@ -0,0 +1,26 @@
+{-# LANGUAGE LambdaCase #-}
+
+#include <sys/param.h>
+
+module System.Hatrace.FdNames
+  ( resolveFdName
+  ) where
+
+import           Control.Exception (AssertionFailed (..), throwIO)
+import           Foreign.C.Error (throwErrnoIfMinus1)
+import           Foreign.C.String (CString, peekCString)
+import           Foreign.C.Types (CInt (..))
+import           Foreign.Marshal.Alloc (allocaBytes)
+import           GHC.Stack (HasCallStack)
+import           System.Posix.Types (CPid (..))
+
+
+foreign import ccall safe "resolve_fd_name" c_resolve_fd_name :: CPid -> CInt -> CString -> IO CInt
+
+resolveFdName :: (HasCallStack) => CPid -> CInt -> IO (Maybe FilePath)
+resolveFdName pid fd =
+  allocaBytes (#const MAXPATHLEN) $ \ptr -> do
+    throwErrnoIfMinus1 "resolve_fd_name" (c_resolve_fd_name pid fd ptr) >>= \case
+      0 -> Just <$> peekCString ptr
+      1 -> pure Nothing
+      _ -> throwIO $ AssertionFailed "resolveFdName: something terrible happened"