lisp/ChangeLog | 5 +++ lisp/proced.el | 10 +++--- lisp/server.el | 2 +- src/ChangeLog | 15 ++++++++++ src/dosfns.c | 8 +---- src/process.c | 86 ++++++++++++++++++++++++++++++++------------------------ src/process.h | 2 +- src/sysdep.c | 18 ++++------- src/w32.c | 6 +-- 9 files changed, 87 insertions(+), 65 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 613a510..aaf7d80 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2009-02-03 Miles Bader + + * proced.el (proced-process-attributes): + * server.el (server-running-p): Use `process-attributes'. + 2009-02-03 Glenn Morris * mail/unrmail.el (unrmail): In the absence of Mail-from, prefer Date diff --git a/lisp/proced.el b/lisp/proced.el index c6ce203..00fec38 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -32,12 +32,12 @@ ;; - allow "sudo kill PID", "renice PID" ;; ;; Thoughts and Ideas -;; - Currently, `system-process-attributes' returns the list of +;; - Currently, `process-attributes' returns the list of ;; command-line arguments of a process as one concatenated string. ;; This format is compatible with `shell-command'. Also, under ;; MS-Windows, the command-line arguments are actually stored as a ;; single string, so that it is impossible to reverse-engineer it back -;; into separate arguments. Alternatively, `system-process-attributes' +;; into separate arguments. Alternatively, `process-attributes' ;; could (try to) return a list of strings that correspond to individual ;; command-line arguments. Then one could feed such a list of ;; command-line arguments into `call-process' or `start-process'. @@ -94,7 +94,7 @@ the external command (usually \"kill\")." ;; It would be neat if one could temporarily override the following ;; predefined rules. (defcustom proced-grammar-alist - '( ;; attributes defined in `system-process-attributes' + '( ;; attributes defined in `process-attributes' (euid "EUID" "%d" right proced-< nil (euid pid) (nil t nil)) (user "USER" nil left proced-string-lessp nil (user pid) (nil t nil)) (egid "EGID" "%d" right proced-< nil (egid euid pid) (nil t nil)) @@ -218,7 +218,7 @@ If REFINER is nil no refinement is done." This variable extends the functionality of `proced-process-attributes'. Each function is called with one argument, the list of attributes of a system process. It returns a cons cell of the form (KEY . VALUE) -like `system-process-attributes'. This cons cell is appended to the list +like `process-attributes'. This cons cell is appended to the list returned by `proced-process-attributes'. If the function returns nil, the value is ignored." :group 'proced @@ -1530,7 +1530,7 @@ the process is ignored." ;; lists are ignored? When would such processes be of interest? (let (process-alist attributes attr) (dolist (pid (or pid-list (list-system-processes)) process-alist) - (when (setq attributes (system-process-attributes pid)) + (when (setq attributes (process-attributes pid)) (setq attributes (cons (cons 'pid pid) attributes)) (dolist (fun proced-custom-attributes) (if (setq attr (funcall fun attributes)) diff --git a/lisp/server.el b/lisp/server.el index 5f7cc50..d2262ac 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -588,7 +588,7 @@ Return values: (insert-file-contents-literally (expand-file-name name server-auth-dir)) (or (and (looking-at "127\\.0\\.0\\.1:[0-9]+ \\([0-9]+\\)") (assq 'comm - (system-process-attributes + (process-attributes (string-to-number (match-string 1)))) t) :other)) diff --git a/src/ChangeLog b/src/ChangeLog index b21fde0..4032baa 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,18 @@ +2009-02-03 Miles Bader + + * process.c (process_pid): New function, code mostly from parse_signal. + (parse_signal): Use process_pid to do process-to-pid mapping. + (Fprocess_attributes): Renamed from "Fsystem_process_attributes". + Use process_pid to do process-to-pid mapping. + (syms_of_process): Update defsubr of Fprocess_attributes. + + * process.h: Update decl of system_process_attributes. + + * sysdep.c (system_process_attributes): + * dosfns.c (system_process_attributes): + * w32.c (system_process_attributes): Change argument type to pid_t. + Remove PID type-checking code. + 2009-02-02 Andreas Schwab * unexelf.c (unexec): Handle unaligned bss offset. diff --git a/src/dosfns.c b/src/dosfns.c index 12c260e..50cf50c 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -552,15 +552,11 @@ list_system_processes () } Lisp_Object -system_process_attributes (Lisp_Object pid) +system_process_attributes (int pid) { - int proc_id; Lisp_Object attrs = Qnil; - CHECK_NUMBER_OR_FLOAT (pid); - proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid); - - if (proc_id == getpid ()) + if (pid == getpid ()) { EMACS_INT uid, gid; char *usr; diff --git a/src/process.c b/src/process.c index 892a779..18b27ac 100644 --- a/src/process.c +++ b/src/process.c @@ -6234,30 +6234,22 @@ traffic. */) return process; } -DEFUN ("signal-process", Fsignal_process, Ssignal_process, - 2, 2, "sProcess (name or number): \nnSignal code: ", - doc: /* Send PROCESS the signal with code SIGCODE. -PROCESS may also be a number specifying the process id of the -process to signal; in this case, the process need not be a child of -this Emacs. -SIGCODE may be an integer, or a symbol whose name is a signal name. */) - (process, sigcode) - Lisp_Object process, sigcode; +/* Return the system process-id associated with PROCESS. PROCESS may + either a number, in which case its value is returned directly, or an + emacs process. In the latter case, an error is signalled if the process + does not have an associated process id (e.g., a network socket), + using the message INVALID_PID_ERR_MSG. */ + +static pid_t +process_pid (Lisp_Object process, const char *invalid_pid_err_msg) { - pid_t pid; - if (INTEGERP (process)) - { - pid = XINT (process); - goto got_it; - } + return XINT (process); if (FLOATP (process)) - { - pid = (pid_t) XFLOAT_DATA (process); - goto got_it; - } + return (pid_t) XFLOAT_DATA (process); + pid_t pid; if (STRINGP (process)) { Lisp_Object tem; @@ -6272,15 +6264,27 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) else process = get_process (process); - if (NILP (process)) - return process; - CHECK_PROCESS (process); pid = XPROCESS (process)->pid; - if (pid <= 0) - error ("Cannot signal process %s", SDATA (XPROCESS (process)->name)); got_it: + if (pid <= 0) + error (invalid_pid_err_msg, SDATA (XPROCESS (process)->name)); + + return pid; +} + +DEFUN ("signal-process", Fsignal_process, Ssignal_process, + 2, 2, "sProcess (name or number): \nnSignal code: ", + doc: /* Send PROCESS the signal with code SIGCODE. +PROCESS may also be a number specifying the process id of the +process to signal; in this case, the process need not be a child of +this Emacs. +SIGCODE may be an integer, or a symbol whose name is a signal name. */) + (process, sigcode) + Lisp_Object process, sigcode; +{ + pid_t pid = process_pid (process, "Cannot signal process %s"); #define parse_signal(NAME, VALUE) \ else if (!xstrcasecmp (name, NAME)) \ @@ -7071,16 +7075,19 @@ DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes, doc: /* Return a list of numerical process IDs of all running processes. If this functionality is unsupported, return nil. -See `system-process-attributes' for getting attributes of a process +See `process-attributes' for getting attributes of a process given its ID. */) () { return list_system_processes (); } -DEFUN ("system-process-attributes", Fsystem_process_attributes, - Ssystem_process_attributes, 1, 1, 0, - doc: /* Return attributes of the process given by its PID, a number. +DEFUN ("process-attributes", Fprocess_attributes, + Sprocess_attributes, 1, 1, 0, + doc: /* Return attributes of PROCESS. +PROCESS may be an emacs subprocess, the name of an emacs subprocess, or an +integer process-id; in the latter case, the process need not be a child of +this Emacs. Value is an alist where each element is a cons cell of the form @@ -7129,10 +7136,11 @@ integer or floating point values. pmem -- percents of total physical memory used by process's resident set (floating-point number) args -- command line which invoked the process (string). */) - (pid) + (process) - Lisp_Object pid; + Lisp_Object process; { + pid_t pid = process_pid (process, "Cannot get status of process %s"); return system_process_attributes (pid); } @@ -7507,7 +7515,7 @@ The variable takes effect when `start-process' is called. */); defsubr (&Sset_process_filter_multibyte); defsubr (&Sprocess_filter_multibyte_p); defsubr (&Slist_system_processes); - defsubr (&Ssystem_process_attributes); + defsubr (&Sprocess_attributes); } @@ -7813,9 +7821,12 @@ given its ID. */) return list_system_processes (); } -DEFUN ("system-process-attributes", Fsystem_process_attributes, - Ssystem_process_attributes, 1, 1, 0, - doc: /* Return attributes of the process given by its PID, a number. +DEFUN ("process-attributes", Fprocess_attributes, + Sprocess_attributes, 1, 1, 0, + doc: /* Return attributes of PROCESS. +PROCESS may be an emacs subprocess, the name of an emacs subprocess, or an +integer process-id; in the latter case, the process need not be a child of +this Emacs. Value is an alist where each element is a cons cell of the form @@ -7864,10 +7875,11 @@ integer or floating point values. pmem -- percents of total physical memory used by process's resident set (floating-point number) args -- command line which invoked the process (string). */) - (pid) + (process) - Lisp_Object pid; + Lisp_Object process; { + pid_t pid = process_pid (pid, "Cannot get status of process %s"); return system_process_attributes (pid); } @@ -7953,7 +7965,7 @@ syms_of_process () defsubr (&Sget_buffer_process); defsubr (&Sprocess_inherit_coding_system_flag); defsubr (&Slist_system_processes); - defsubr (&Ssystem_process_attributes); + defsubr (&Sprocess_attributes); } diff --git a/src/process.h b/src/process.h index 39c7f58..734fcee 100644 --- a/src/process.h +++ b/src/process.h @@ -168,7 +168,7 @@ extern Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtpgid, Qcstime; extern Lisp_Object Qtime, Qctime; extern Lisp_Object list_system_processes (void); -extern Lisp_Object system_process_attributes (Lisp_Object); +extern Lisp_Object system_process_attributes (pid_t); /* arch-tag: dffedfc4-d7bc-4b58-a26f-c16155449c72 (do not change this comment) */ diff --git a/src/sysdep.c b/src/sysdep.c index dfefed7..b0154e2 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3360,7 +3360,7 @@ procfs_get_total_memory (void) } Lisp_Object -system_process_attributes (Lisp_Object pid) +system_process_attributes (pid_t pid) { char procfn[PATH_MAX], fn[PATH_MAX]; struct stat st; @@ -3375,7 +3375,7 @@ system_process_attributes (Lisp_Object pid) char *cmdline = NULL; size_t cmdsize = 0, cmdline_size; unsigned char c; - int proc_id, ppid, uid, gid, pgrp, sess, tty, tpgid, thcount; + int ppid, uid, gid, pgrp, sess, tty, tpgid, thcount; unsigned long long utime, stime, cutime, cstime, start; long priority, nice, rss; unsigned long minflt, majflt, cminflt, cmajflt, vsize; @@ -3388,9 +3388,7 @@ system_process_attributes (Lisp_Object pid) struct gcpro gcpro1, gcpro2; EMACS_INT uid_eint, gid_eint; - CHECK_NUMBER_OR_FLOAT (pid); - proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid); - sprintf (procfn, "/proc/%lu", proc_id); + sprintf (procfn, "/proc/%lu", pid); if (stat (procfn, &st) < 0) return attrs; @@ -3632,7 +3630,7 @@ system_process_attributes (Lisp_Object pid) #endif /* PROCFS_FILE_OFFSET_BITS_HACK == 1 */ Lisp_Object -system_process_attributes (Lisp_Object pid) +system_process_attributes (pid_t pid) { char procfn[PATH_MAX], fn[PATH_MAX]; struct stat st; @@ -3642,15 +3640,13 @@ system_process_attributes (Lisp_Object pid) struct psinfo pinfo; int fd; ssize_t nread; - int proc_id, uid, gid; + int uid, gid; Lisp_Object attrs = Qnil; Lisp_Object decoded_cmd, tem; struct gcpro gcpro1, gcpro2; EMACS_INT uid_eint, gid_eint; - CHECK_NUMBER_OR_FLOAT (pid); - proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid); - sprintf (procfn, "/proc/%u", proc_id); + sprintf (procfn, "/proc/%u", pid); if (stat (procfn, &st) < 0) return attrs; @@ -3764,7 +3760,7 @@ system_process_attributes (Lisp_Object pid) #elif !defined (WINDOWSNT) && !defined (MSDOS) Lisp_Object -system_process_attributes (Lisp_Object pid) +system_process_attributes (pid_t pid) { return Qnil; } diff --git a/src/w32.c b/src/w32.c index 999541b..7a64b2d 100644 --- a/src/w32.c +++ b/src/w32.c @@ -3819,8 +3819,7 @@ process_times (h_proc, ctime, etime, stime, utime, ttime, pcpu) } Lisp_Object -system_process_attributes (pid) - Lisp_Object pid; +system_process_attributes (pid_t pid) { struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object attrs = Qnil; @@ -3850,8 +3849,7 @@ system_process_attributes (pid) double pcpu; BOOL result = FALSE; - CHECK_NUMBER_OR_FLOAT (pid); - proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid); + proc_id = pid; h_snapshot = create_toolhelp32_snapshot (TH32CS_SNAPPROCESS, 0);