mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-23 22:20:24 -08:00
Code Issues Projects Releases Wiki Activity

Extend memory-info for remote systems

Browse source 
* 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.
This commit is contained in:
Michael Albinus 2022-11-27 16:57:03 +01:00
parent ca42ff5f0e
commit 1cbf2655db
16 changed files with 153 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

80
lisp/net/tramp.el
View file

@ -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