From 1cbf2655db40cd474411b77ece57a287eb85ea2c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 27 Nov 2022 16:57:03 +0100 Subject: Extend memory-info for remote systems * doc/lispref/files.texi (Magic File Names): Add memory-info. * doc/lispref/internals.texi (Garbage Collection): memory-info can also retrieve values from remote systems. * etc/NEWS: Document changes in memory-info. Fix typos. * lisp/files.el (warn-maybe-out-of-memory): Ensure local memory info. * lisp/net/tramp.el (tramp-handle-memory-info): New defun. (tramp-file-name-for-operation) * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): * lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist): * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): * lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist): * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist) * lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist): Add 'memory-info'. * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-exec-path): Let-bind `process-file-side-effects'. * src/alloc.c (Fmemory_info): Support remote systems. (Qmemory_info): Declare. * test/lisp/net/tramp-tests.el (tramp-test31-memory-info): New test. --- lisp/net/tramp.el | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 79 insertions(+), 1 deletion(-) (limited to 'lisp/net/tramp.el') diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e9f30bea7bf..33e5e80d05f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2656,7 +2656,7 @@ Must be handled by the callers." ;; Emacs 27+ only. exec-path make-process ;; Emacs 29+ only. - list-system-processes process-attributes)) + list-system-processes memory-info process-attributes)) default-directory) ;; PROC. ((member operation '(file-notify-rm-watch file-notify-valid-p)) @@ -4884,6 +4884,84 @@ support symbolic links." (tramp-dissect-file-name (expand-file-name linkname)) 'file-error "make-symbolic-link not supported")) +(defun tramp-handle-memory-info () + "Like `memory-info' for Tramp files." + (let ((result '(0 0 0 0)) + process-file-side-effects) + (with-temp-buffer + (cond + ;; GNU/Linux. + ((zerop (process-file "cat" nil '(t) nil "/proc/meminfo")) + (goto-char (point-min)) + (when + (re-search-forward + (rx bol "MemTotal:" (* space) (group (+ digit)) (* space) "kB" eol) + nil 'noerror) + (setcar (nthcdr 0 result) (string-to-number (match-string 1)))) + (goto-char (point-min)) + (when + (re-search-forward + (rx bol "MemFree:" (* space) (group (+ digit)) (* space) "kB" eol) + nil 'noerror) + (setcar (nthcdr 1 result) (string-to-number (match-string 1)))) + (goto-char (point-min)) + (when + (re-search-forward + (rx bol "SwapTotal:" (* space) (group (+ digit)) (* space) "kB" eol) + nil 'noerror) + (setcar (nthcdr 2 result) (string-to-number (match-string 1)))) + (goto-char (point-min)) + (when + (re-search-forward + (rx bol "SwapFree:" (* space) (group (+ digit)) (* space) "kB" eol) + nil 'noerror) + (setcar (nthcdr 3 result) (string-to-number (match-string 1))))) + + ;; BSD. + ;; https://raw.githubusercontent.com/ocochard/myscripts/master/FreeBSD/freebsd-memory.sh + ((zerop (process-file "sysctl" nil '(t) nil "-a")) + (goto-char (point-min)) + (when + (re-search-forward + (rx bol "hw.pagesize:" (* space) (group (+ digit)) eol) + nil 'noerror) + (let ((pagesize (string-to-number (match-string 1)))) + (goto-char (point-min)) + (when + (re-search-forward + (rx bol "vm.stats.vm.v_page_count:" (* space) + (group (+ digit)) eol) + nil 'noerror) + (setcar + (nthcdr 0 result) + (/ (* (string-to-number (match-string 1)) pagesize) 1024))) + (goto-char (point-min)) + (when + (re-search-forward + (rx bol "vm.stats.vm.v_free_count:" (* space) + (group (+ digit)) eol) + nil 'noerror) + (setcar + (nthcdr 1 result) + (/ (* (string-to-number (match-string 1)) pagesize) 1024))))) + (erase-buffer) + (when (zerop (process-file "swapctl" nil '(t) nil "-sk")) + (goto-char (point-min)) + (when + (re-search-forward + (rx bol "Total:" (* space) + (group (+ digit)) (* space) (group (+ digit)) eol) + nil 'noerror) + (setcar (nthcdr 2 result) (string-to-number (match-string 1))) + (setcar + (nthcdr 3 result) + (- (string-to-number (match-string 1)) + (string-to-number (match-string 2))))))))) + + ;; Return result. + (unless (equal result '(0 0 0 0)) + result))) + (defun tramp-handle-process-attributes (pid) "Like `process-attributes' for Tramp files." (catch 'result -- cgit v1.2.3