Added sysctl support to resource-utilization.

Pascal J. Bourguignon [2020-11-04 19:05]
Added sysctl support to resource-utilization.
Moved shell-command-to-string to com.informatimago.clext.shell.
Filename
clext/com.informatimago.clext.asd
clext/com.informatimago.clext.shell.asd
clext/shell.lisp
clmisc/com.informatimago.clmisc.asd
clmisc/resource-utilization.lisp
tools/com.informatimago.tools.manifest.asd
tools/manifest.lisp
diff --git a/clext/com.informatimago.clext.asd b/clext/com.informatimago.clext.asd
index 15f5294..72b7051 100644
--- a/clext/com.informatimago.clext.asd
+++ b/clext/com.informatimago.clext.asd
@@ -60,7 +60,8 @@ specifications, like GRAY or other portability libraries.
                #+(or ccl clisp sbcl cmu) "com.informatimago.clext.pipe"
                "com.informatimago.clext.queue"
                "com.informatimago.clext.filter-stream"
-               "com.informatimago.clext.redirecting-stream")
+               "com.informatimago.clext.redirecting-stream"
+               "com.informatimago.clext.shell")
   :components ()
   #+adsf3 :in-order-to
   #+adsf3 ((asdf:test-op (asdf:test-op "com.informatimago.clext.test")
diff --git a/clext/com.informatimago.clext.shell.asd b/clext/com.informatimago.clext.shell.asd
new file mode 100644
index 0000000..4c27772
--- /dev/null
+++ b/clext/com.informatimago.clext.shell.asd
@@ -0,0 +1,63 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               com.informatimago.clext.shell.asd
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    ASD file to load the com.informatimago.clext.shell library.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2020-11-05 <PJB> Created this .asd file.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2015 - 2020
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see http://www.gnu.org/licenses/
+;;;;**************************************************************************
+
+(asdf:defsystem "com.informatimago.clext.shell"
+  ;; system attributes:
+  :description "Informatimago Common Lisp Extensions: Shells."
+  :long-description "
+
+This system provides functions to run commands using an externa shell.
+
+
+"
+  :author     "Pascal J. Bourguignon <pjb@informatimago.com>"
+  :maintainer "Pascal J. Bourguignon <pjb@informatimago.com>"
+  :licence "AGPL3"
+  ;; component attributes:
+  :version "1.0.0"
+  :properties ((#:author-email                   . "pjb@informatimago.com")
+               (#:date                           . "Autumn 2020")
+               ((#:albert #:output-dir)          . "/tmp/documentation/com.informatimago.clext/")
+               ((#:albert #:formats)             . ("docbook"))
+               ((#:albert #:docbook #:template)  . "book")
+               ((#:albert #:docbook #:bgcolor)   . "white")
+               ((#:albert #:docbook #:textcolor) . "black"))
+  :depends-on ("asdf")
+  :components ((:file "shell"))
+  ;; #+adsf3 :in-order-to
+  ;; #+adsf3 ((asdf:test-op (asdf:test-op "com.informatimago.clext.shell.test")))
+  #+asdf-unicode :encoding #+asdf-unicode :utf-8)
+
+
+;;;; THE END ;;;;
diff --git a/clext/shell.lisp b/clext/shell.lisp
new file mode 100644
index 0000000..873f801
--- /dev/null
+++ b/clext/shell.lisp
@@ -0,0 +1,117 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               shell.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Exports shell functions.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2020-11-04 <PJB> Extracted from tools.manifest.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2020 - 2020
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+(defpackage "COM.INFORMATIMAGO.CLEXT.SHELL"
+  (:use "COMMON-LISP")
+  (:export "SHELL-COMMAND-TO-STRING"
+           "MKTEMP-PATH"))
+(in-package "COM.INFORMATIMAGO.CLEXT.SHELL")
+
+(defun mktemp-path (&key
+                      (kind :file)
+                      (stem "TEMP")
+                      (type "TXT")
+                      base-directory)
+  (check-type kind (member :file :directory))
+  (check-type stem string)
+  (check-type type (or null string))
+  (check-type base-directory (or null string pathname))
+  (let ((name (format nil "~:@(~A~36,8,'0R~)"
+                      stem (random (expt 2 32))))
+        (type (when type (string-upcase type))))
+    (namestring
+     (translate-logical-pathname
+      (ecase kind
+        (:file
+         (cond
+           (base-directory
+            (merge-pathnames
+             (make-pathname :name name :type type :version nil
+                            :case :common)
+             base-directory))
+           ((ignore-errors (logical-pathname-translations "TMP"))
+            (make-pathname :host "TMP" :directory '(:absolute)
+                           :name name :type type :version nil
+                           :case :common))
+           (t
+            (merge-pathnames
+             (make-pathname :directory '(:relative)
+                            :name name :type type :version nil
+                            :case :common)
+             (user-homedir-pathname)))))
+        (:directory
+         (cond
+           (base-directory
+            (merge-pathnames
+             (make-pathname :directory (list :relative name)
+                            :name nil :type nil :version nil
+                            :case :common)
+             base-directory))
+           ((ignore-errors (logical-pathname-translations "TMP"))
+            (make-pathname :host "TMP" :directory (list :absolute name)
+                           :name nil :type nil :version nil
+                           :case :common))
+           (t
+            (merge-pathnames
+             (make-pathname :directory (list :relative name)
+                            :name nil :type nil :version nil
+                            :case :common)
+             (user-homedir-pathname))))))))))
+
+#-(and)
+(list
+ (mktemp-path)
+ (mktemp-path :kind :file)
+ (mktemp-path :kind :file :stem "foo" :type "bar")
+ (mktemp-path :kind :file :base-directory "/var/tmp/")
+ (mktemp-path :kind :directory)
+ (mktemp-path :kind :directory  :stem "foo" :type "bar")
+ (mktemp-path :kind :directory :base-directory "/var/tmp/"))
+
+
+(defun shell-command-to-string (command &rest arguments)
+  "Execute the COMMAND with asdf:run-shell-command and returns its
+stdout in a string (going thru a file)."
+  (let* ((*default-pathname-defaults* #P"")
+         (path (mktemp-path :stem "OUT-")))
+    (unwind-protect
+         (when (zerop (asdf:run-shell-command
+                       (format nil "~? > ~S" command arguments path)))
+           (with-output-to-string (out)
+             (with-open-file (file path)
+               (loop
+                 :for line = (read-line file nil nil)
+                 :while line :do (write-line line out)))))
+      (ignore-errors (delete-file path)))))
+
+;;;; THE END ;;;;
diff --git a/clmisc/com.informatimago.clmisc.asd b/clmisc/com.informatimago.clmisc.asd
index 728c37e..6d9387e 100644
--- a/clmisc/com.informatimago.clmisc.asd
+++ b/clmisc/com.informatimago.clmisc.asd
@@ -56,7 +56,8 @@ a format similar to what is used by LISTSERV.
                ((#:albert #:docbook #:bgcolor)   . "white")
                ((#:albert #:docbook #:textcolor) . "black"))
   #+asdf-unicode :encoding #+asdf-unicode :utf-8
-  :depends-on ()
+  :depends-on ("split-sequence"
+               "com.informatimago.clext.shell")
   :components ((:file "resource-utilization"))
   #+adsf3 :in-order-to #+adsf3 ((asdf:test-op (asdf:test-op "com.informatimago.clmisc.test"))))

diff --git a/clmisc/resource-utilization.lisp b/clmisc/resource-utilization.lisp
index e08236e..2fa20d4 100644
--- a/clmisc/resource-utilization.lisp
+++ b/clmisc/resource-utilization.lisp
@@ -34,7 +34,11 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf *readtable* (copy-readtable nil)))
 (defpackage "COM.INFORMATIMAGO.CLMISC.RESOURCE-UTILIZATION"
-  (:use "COMMON-LISP")
+  (:use "COMMON-LISP"
+        "SPLIT-SEQUENCE"
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SYMBOL"
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.FILE"
+        "COM.INFORMATIMAGO.CLEXT.SHELL")
   (:export "REPORTING-SRU"
            "SUMMARY-RESOURCE-UTILIZATION" )
   (:documentation
@@ -90,37 +94,68 @@ License:
 "))
 (in-package "COM.INFORMATIMAGO.CLMISC.RESOURCE-UTILIZATION")

+(defun split-attribute-line (line)
+  (let* ((colon (position #\: line))
+         (var   (and colon (string-trim " 	" (subseq line 0 colon))))
+         (val   (and colon (string-trim " 	" (subseq line (1+ colon))))))
+    (when (and var val)
+      (cons (keywordize
+             (string-upcase
+              (substitute-if #\- (lambda (ch) (position ch "_ ")) var)))
+            (multiple-value-bind (n p) (parse-integer val :junk-allowed t)
+              (if (= p (length val))
+                  n
+                  val))))))
+
+(defun sysctl-info ()
+  "
+RETURN: An A-list containing the data from sysctl -a.
+"
+  (let ((text (shell-command-to-string "sysctl -a")))
+    (when text
+      (delete nil
+              (mapcar (function split-attribute-line)
+                      (split-sequence #\newline text))))))

 (defun cpu-info ()
   "
 RETURN: An A-list containing the data from /proc/cpuinfo.
 "
-  (cond
-   ((with-open-file (info "/proc/cpuinfo" :if-does-not-exist nil)
-      (and info
-           (loop
-              :for line = (read-line info nil nil)
-              :for colon = (and line (position #\: line))
-              :for var = (and colon (string-trim " 	" (subseq line 0 colon)))
-              :for val = (and colon (string-trim " 	" (subseq line (1+ colon))))
-              :while line
-              :when var
-              :collect (cons (intern
-                              (string-upcase
-                               (substitute-if #\- (lambda (ch) (position ch "_ ")) var))
-                              "KEYWORD") val)))))))
-
+  (let ((text (text-file-contents "/proc/cpuinfo"
+                                  :if-does-not-exist nil)))
+    (when text
+      (when text
+        (delete nil
+                (mapcar (function split-attribute-line)
+                        (split-sequence #\newline text)))))))

 (defun cpu-short-description ()
   "
 RETURN: A short description of the CPU.
 "
-  (let ((info (cpu-info)))
-    (flet ((gac (x) (or (cdr (assoc x info)) "")))
-      (format nil "~A ~A.~A.~A ~A MHz (~A bogomips)" (gac :model-name)
-              (gac :cpu-family) (gac :model) (gac :stepping)
-              (gac :cpu-mhz) (gac :bogomips)))))
-
+  (let ((info (append (cpu-info) (sysctl-info))))
+    (flet ((gac (x) (cdr (assoc x info))))
+      (format nil "~A ~A.~A.~A ~A MHz (~A bogomips)"
+              (or (gac :model-name)
+                  (gac :machdep.cpu.brand-string)
+                  "")
+              (or (gac :cpu-family)
+                  (gac :machdep.cpu.family)
+                  "")
+              (or (gac :model)
+                  (gac :machdep.cpu.model)
+                  "")
+              (or (gac :stepping)
+                  (gac :machdep.cpu.stepping)
+                  "")
+              (or (gac :cpu-mhz)
+                  (truncate (gac :hw.cpufrequency) 1e6)
+                  "")
+              (or (gac :bogomips)
+                  (let ((freq (gac :hw.cpufrequency)))
+                    (if freq
+                        (* 2.5e-6 freq )
+                        0)))))))


 (defun read-parenthesized-string (&optional (stream t)
diff --git a/tools/com.informatimago.tools.manifest.asd b/tools/com.informatimago.tools.manifest.asd
index d0707d6..d421742 100644
--- a/tools/com.informatimago.tools.manifest.asd
+++ b/tools/com.informatimago.tools.manifest.asd
@@ -37,8 +37,9 @@
   :author "Pascal J. Bourguignon"
   :version "1.2.0"
   :license "AGPL3"
-  :depends-on ("com.informatimago.common-lisp.cesarum"
-               "split-sequence")
+  :depends-on ("split-sequence"
+               "com.informatimago.common-lisp.cesarum"
+               "com.informatimago.clext.shell")
   :components ((:file "manifest"))
   #+asdf-unicode :encoding #+asdf-unicode :utf-8)

diff --git a/tools/manifest.lisp b/tools/manifest.lisp
index 45a8c5f..823b55b 100644
--- a/tools/manifest.lisp
+++ b/tools/manifest.lisp
@@ -39,11 +39,12 @@
 (declaim (also-use-packages "ASDF"))
 (defpackage "COM.INFORMATIMAGO.TOOLS.MANIFEST"
   (:use "COMMON-LISP"
+        "SPLIT-SEQUENCE"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.VERSION"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.FILE"
-        "SPLIT-SEQUENCE")
+        "COM.INFORMATIMAGO.CLEXT.SHELL")
   (:export "ASDF-SYSTEM-NAME"
            "ASDF-SYSTEM-LICENSE"
            "SYSTEM-DEPENDS-ON"
@@ -114,28 +115,6 @@
 ;; larissa  10.9.2       Darwin larissa.home 13.1.0 Darwin Kernel Version 13.1.0: Thu Jan 16 19:40:37 PST 2014; root:xnu-2422.90.20~2/RELEASE_X86_64 x86_64 i386 MacBookAir6,2 Darwin


-
-(defun shell-command-to-string (command &rest arguments)
-  "Execute the COMMAND with asdf:run-shell-command and returns its
-stdout in a string (going thru a file)."
-  (let* ((*default-pathname-defaults* #P"")
-         (name (format nil "~:@(OUT-~36,8,'0R~)" (random (expt 2 32))))
-         (path (namestring (translate-logical-pathname
-                            (if (ignore-errors (logical-pathname-translations "TMP"))
-                                (make-pathname :host "TMP" :directory '(:absolute)
-                                               :name name :type "TXT")
-                                (merge-pathnames (user-homedir-pathname)
-                                                 (make-pathname :name name :type "TXT")))))))
-    (unwind-protect
-         (when (zerop (asdf:run-shell-command (format nil "~? > ~S" command arguments path)))
-           (with-output-to-string (out)
-             (with-open-file (file path)
-               (loop
-                 :for line = (read-line file nil nil)
-                 :while line :do (write-line line out)))))
-      (ignore-errors (delete-file path)))))
-
-
 (defun prepare-options (options)
   (mapcar (lambda (option)
             (typecase option
ViewGit