lispdoc: implemented the whole URI syntax; updated URIs in all docstrings to be writt...
[com-informatimago:com-informatimago.git] / clmisc / resource-utilization.lisp
1 ;;;; -*- mode:lisp; coding:utf-8 -*-
2 ;;;;**************************************************************************
3 ;;;;FILE:               resource-utilization.lisp
4 ;;;;LANGUAGE:           Common-Lisp
5 ;;;;SYSTEM:             Common-Lisp
6 ;;;;USER-INTERFACE:     NONE
7 ;;;;DESCRIPTION
8 ;;;;    
9 ;;;;    See defpackage documentation string.
10 ;;;;
11 ;;;;AUTHORS
12 ;;;;    <PJB> Pascal Bourguignon <pjb@informatimago.com>
13 ;;;;MODIFICATIONS
14 ;;;;    2006-11-10 <PJB> Created.
15 ;;;;BUGS
16 ;;;;LEGAL
17 ;;;;    AGPL3
18 ;;;;    
19 ;;;;    Copyright Pascal Bourguignon 2006 - 2012
20 ;;;;    
21 ;;;;    This program is free software: you can redistribute it and/or modify
22 ;;;;    it under the terms of the GNU Affero General Public License as published by
23 ;;;;    the Free Software Foundation, either version 3 of the License, or
24 ;;;;    (at your option) any later version.
25 ;;;;    
26 ;;;;    This program is distributed in the hope that it will be useful,
27 ;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
28 ;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
29 ;;;;    GNU Affero General Public License for more details.
30 ;;;;    
31 ;;;;    You should have received a copy of the GNU Affero General Public License
32 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>
33 ;;;;**************************************************************************
34
35
36 (in-package "COMMON-LISP-USER")
37 (defpackage "COM.INFORMATIMAGO.CLMISC.RESOURCE-UTILIZATION"
38   (:use "COMMON-LISP")
39   (:export "REPORTING-SRU"
40            "SUMMARY-RESOURCE-UTILIZATION" )
41   (:documentation
42    "
43 Gather resource utilization statistics and report them.
44
45 Usage:
46
47     (reporting-sru (:job-origin (remote-client) :stream (remote-stream))
48        (do-something-lengthy))
49
50     (reporting-sru (:job-origin (remote-client) :stream (remote-stream)
51                     :report-to (lambda (cpu-time sys-time device-i/o paging-i/o
52                                    job-origin &key (stream t))
53                                 (SUMMARY-RESOURCE-UTILIZATION
54                                    cpu-time sys-time device-i/o paging-i/o
55                                    job-origin :stream stream)))
56        (do-something-lengthy))
57
58 Example:
59
60     (reporting-sru (:job-origin \"REPL\")
61        (asdf-load :com.informatimago.clext))
62
63     prints:
64
65     Summary of resource utilization
66     -------------------------------
67      CPU time:       0.300 sec                Device I/O:      175
68      Overhead CPU:   0.012 sec                Paging I/O:        1
69      CPU model:   AMD Athlon(tm) Processor 6.4.2 1200.303 MHz (2402.66 bogomips)
70      Job origin:  REPL
71
72
73 License:
74
75     AGPL3
76
77     Copyright Pascal Bourguignon 2006 - 2012
78
79     This program is free software: you can redistribute it and/or modify
80     it under the terms of the GNU Affero General Public License as published by
81     the Free Software Foundation, either version 3 of the License, or
82     (at your option) any later version.
83
84     This program is distributed in the hope that it will be useful,
85     but WITHOUT ANY WARRANTY; without even the implied warranty of
86     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
87     GNU Affero General Public License for more details.
88
89     You should have received a copy of the GNU Affero General Public License
90     along with this program.  If not, see <http://www.gnu.org/licenses/>
91 "))
92 (in-package "COM.INFORMATIMAGO.CLMISC.RESOURCE-UTILIZATION")
93
94
95 (defun cpu-info ()
96   "
97 RETURN: An A-list containing the data from /proc/cpuinfo.
98 "
99   (cond
100    ((with-open-file (info "/proc/cpuinfo" :if-does-not-exist nil)
101       (and info
102            (loop
103               :for line = (read-line info nil nil)
104               :for colon = (and line (position #\: line))
105               :for var = (and colon (string-trim "      " (subseq line 0 colon)))
106               :for val = (and colon (string-trim "      " (subseq line (1+ colon))))
107               :while line
108               :when var
109               :collect (cons (intern
110                               (string-upcase
111                                (substitute-if #\- (lambda (ch) (position ch "_ ")) var))
112                               "KEYWORD") val)))))))
113
114
115 (defun cpu-short-description ()
116   "
117 RETURN: A short description of the CPU.
118 "
119   (let ((info (cpu-info)))
120     (flet ((gac (x) (or (cdr (assoc x info)) "")))
121       (format nil "~A ~A.~A.~A ~A MHz (~A bogomips)" (gac :model-name)
122               (gac :cpu-family) (gac :model) (gac :stepping)
123               (gac :cpu-mhz) (gac :bogomips)))))
124
125
126
127 (defun read-parenthesized-string (&optional (stream t)
128                                   (eof-error-p t) (eof-value nil)
129                                   (recursive-p nil))
130   "
131 DO:     Skip spaces, and read a string in parentheses (like in Postscript).
132 RETURN: The string read (without the external parentheses), or the EOF-VALUE 
133         if EOF occured and EOF-ERROR-P is NIL. 
134         NIL is returned if the next non whitespace character is not a left 
135         parenthesis.
136 NOTE:   Parentheses inside the string must be escaped by \ unless balanced.
137 "
138   (let ((token (peek-char t stream  nil :eof recursive-p)))
139     (cond
140       ((eq :eof token) (if eof-error-p
141                            (error 'end-of-file :stream stream)
142                             eof-value))
143       ((eql #\( token)
144        (read-char stream)
145        (loop
146           :with buffer = (make-array 8 :adjustable t :fill-pointer 0
147                                      :element-type 'character
148                                      :initial-element #\space)
149           :with level = 0
150           :with escape = nil
151           :for ch = (read-char stream nil nil recursive-p)
152           :while ch
153           :do (cond
154                 (escape          (vector-push-extend ch buffer) (setf escape nil))
155                 ((char= #\( ch)  (vector-push-extend ch buffer) (incf level))
156                 ((char= #\) ch)  (decf level) (if (minusp level)
157                                                   (loop-finish)
158                                                   (vector-push-extend ch buffer)))
159                 ((char= #\\ ch)  (setf escape t))
160                 (t               (vector-push-extend ch buffer)))
161           :finally (if ch
162                        (return buffer)
163                        (if eof-error-p
164                            (error 'end-of-file :stream stream)
165                            (return eof-value))))))))
166
167
168 (defun test/read-parenthesized-string ()
169   (loop
170      :with success = 0
171      :for tcount :from 0
172      :for (input . output)
173      :in '(("" :eof) ("  " :eof) ("(" :eof) (" ( " :eof)
174            (" (a(b)" :eof) (" (a(b)c" :eof) (" (a\\" :eof)  (" (a\\b" :eof)
175            ("  (howdy doo ?)" "howdy doo ?")
176            ("(howdy \\( doo ?)" "howdy ( doo ?")
177            ("(howdy \\) doo ?)" "howdy ) doo ?")
178            ("(a(b(c(d)e)f)g)h" "a(b(c(d)e)f)g")
179            )
180      :for result = (with-input-from-string (stream input)
181                      (multiple-value-list
182                       (ignore-errors
183                         (read-parenthesized-string stream nil :eof))))
184      :do (if (equal result output)
185              (incf success)
186              (format t "~2%Reading parenthesized string ~S~
187                          ~%     --> ~S~%expected ~S~%"
188                      input result output))
189      :finally  (format t "~&~30A ~4D cases, ~4D successful  (~6,1F %)~%"
190                        'read-parenthesized-string
191                        tcount success (/ success tcount 0.01))))
192
193
194 (defun process-status (&optional (pid "self"))
195   "
196 PID:  Normally it's a small integer, pid_t number. 
197       But for /proc/, we can also use ''self'', as in '/proc/self/stat'.
198 RETURN: The status of the specified process.
199 "
200   (loop
201      :for input :in '(("/proc/~A/stat"
202                        :pid (:comm read-parenthesized-string)
203                        :state :ppid :pgrp :session :tty-nr
204                        :tpgid :flags :minflt :cminflt :majflt :cmajflt
205                        :utime :stime :cutime :cstime :priority
206                        :nice nil :it-real-value :start-time
207                        :vsize :rss :rlim :start-code :end-code :start-stack
208                        :ktskesp :kstkeip :signal :blocked :sigignore :sigcatch
209                        :wchan :nswap :cnswap :exit-signal :processor)
210                       ("/proc/~A/statm"
211                        :size :resident :share :trs :drs :lrs :dt))
212      :nconc (with-open-file (info (format nil (pop input) pid)
213                                   :if-does-not-exist nil)
214               (and info
215                    (loop
216                       :for field :in input
217                       :for tag    = (if (atom field) field (first field))
218                       :for reader = (if (atom field) 'read (second field))
219                       :when tag :collect (cons tag (funcall reader info)))))))
220
221
222 (defun disk-statistics (&optional disk)
223   "
224 RETURN: Statistics from the DISK usage, obtained from /proc/diskstats.
225 "
226   (declare (ignore disk))
227   ;; TODO: Implement disk filter.
228   (with-open-file (info "/proc/diskstats"
229                         :if-does-not-exist nil)
230     (and info
231          (let ((*readtable* (copy-readtable)))
232            (setf (readtable-case *readtable*) :preserve)
233            (loop
234               :with part-keys = '(:device-major :device-minor :device-name
235                                   :completed-reads  :merged-reads
236                                   :read-sectors     :read-time
237                                   :completed-writes :merged-writes
238                                   :written-sectors  :write-time
239                                   :current-i/os     :current-i/o-time
240                                   :current-i/o-load)
241               :with part-nfields = (length part-keys)
242               :with disk-keys = '(:device-major :device-minor :device-name
243                                   :completed-reads  :read-sectors
244                                   :completed-writes :written-sectors)
245               :with disk-nfields = (length disk-keys)
246               :for line = (read-line info nil nil)
247               :while line
248               :collect (let* ((nfields 0)
249                               (data (with-input-from-string (fields line)
250                                       (loop
251                                          :for item = (read fields nil nil)
252                                          :while item
253                                          :do (incf nfields)
254                                          :collect (if (symbolp item)
255                                                       (string item)
256                                                       item)))))
257                          (cond
258                            ((= nfields part-nfields)
259                             (pairlis part-keys data '((:type . :partition))))
260                            ((= nfields disk-nfields)
261                             (pairlis disk-keys data '((:type . :disk)))))))))))
262
263
264 (defun device-i/o ()
265   "
266 RETURN: The number of disk I/O collected by (DISK-STATISTICS).
267 "
268   (reduce (function +)
269           (remove-if (lambda (entry) (eq  :partition (cdr (assoc :type entry))))
270                      (disk-statistics))
271           :key (lambda (entry)
272                  (+ (or (cdr (assoc :written-sectors entry)) 0)
273                     (or (cdr (assoc :read-sectors    entry)) 0)))
274           :initial-value 0))
275
276
277 (defparameter *jiffy*
278   ;; TODO: Use a CL implementation of gzip/zlib.
279  #-(and clisp #.(cl:if (cl:find-package "LINUX") '(and) '(or))) 1/250
280  #+(and clisp #.(cl:if (cl:find-package "LINUX") '(and) '(or)))
281   (or (ignore-errors
282         (with-open-stream (config (ext:run-program "gzip" :arguments '("-d")
283                                                    :input  "/proc/config.gz"
284                                                    :output :stream))
285           (and config
286                (loop
287                   :with target = "CONFIG_HZ="
288                   :for line = (read-line config nil nil)
289                   :while (and line
290                               (or (< (length line) (length target))
291                                   (not (string-equal line target
292                                                      :end1 (length target)))))
293                   :finally (return (when line
294                                      (/ (parse-integer line :start (length target)
295                                                        :junk-allowed t))))))))
296       1/250)
297   "The JIFFY value of the Linux kernel (1/CONFIG_HZ)")
298
299
300
301 (defun summary-resource-utilization (cpu-time sys-time device-i/o paging-i/o
302                                      job-origin &key (stream t))
303   "
304 DO:         Reports resource utilisaty summary.
305 CPU-TIME:   CPU time used, in seconds.
306 SYS-TIME:   System time used, in seconds.
307 DEVICE-I/O: Number of Disk I/O.
308 PAGING-I/O: Number of Swap I/O.
309 JOB-ORIGIN: Label of the originator of the job.
310 STREAM:     Output stream (the default T means *standard-output*).
311 "
312   (format stream
313     "Summary of resource utilization
314 -------------------------------
315  CPU time:    ~8,3F sec                Device I/O: ~8D
316  Overhead CPU:~8,3F sec                Paging I/O: ~8D
317  CPU model:   ~A
318  Job origin:  ~A
319 "
320     cpu-time device-i/o
321     sys-time paging-i/o
322     (cpu-short-description)
323     job-origin))
324
325
326 (defmacro reporting-sru ((&key (job-origin '(short-site-name)) (stream t)
327                                (report-to nil report-to-p))
328                          &body body)
329   "
330 DO:         Execute the BODY collecting resource usage statistics, and
331             finally reporting them.
332 JOB-ORIGIN: Label of the originator of the job; defaults to (SHORT-SITE-NAME).
333 STREAM:     Output stream (the default T means *standard-output*).
334 REPORT-TO:  If provided, it's a function with the same signature as
335             SUMMARY-RESOURCE-UTILIZATION, ie.:
336             (cpu-time sys-time device-i/o paging-i/o job-origin &key (stream t))
337             which is called to report the collected statistics.
338             The default is SUMMARY-RESOURCE-UTILIZATION.
339 "
340   (let ((vstart-run   'sr)
341         (vend-run     'er)
342         (vstat-before 'sb)
343         (vstat-after  'sa)
344         (vdeio-before 'db)
345         (vdeio-after  'da))
346     `(let ((,vstat-before (process-status))
347            (,vstat-after)
348            (,vstart-run  (get-internal-run-time))
349            (,vend-run)
350            (,vdeio-before (device-i/o))
351            (,vdeio-after))
352        (unwind-protect (progn ,@body)
353          (setf ,vend-run  (get-internal-run-time)
354                ,vstat-after (process-status)
355                ,vdeio-after (device-i/o))
356          (flet ((before (x) (or (cdr (assoc x ,vstat-before)) 0))
357                 (after  (x) (or (cdr (assoc x ,vstat-after))  0)))
358            (let* ((page-io (+ (- (after :majflt) (before :majflt))
359                               #|(- (after :minflt) (before :minflt))|#))
360                   (devi-io (max 0 (- ,vdeio-after ,vdeio-before page-io))))
361              (,@(if report-to-p
362                     (list 'funcall report-to)
363                     '(summary-resource-utilization))
364                 (/ (- ,vend-run ,vstart-run) internal-time-units-per-second)
365                 (* *jiffy* (- (after :stime) (before :stime)))
366                 devi-io page-io ,job-origin :stream ,stream)))))))
367
368
369
370 #||
371
372 (test/read-parenthesized-string)
373 (reporting-sru ()
374   (with-open-file (input "/usr/share/dict/words")
375     (loop :for line = (read-line input nil nil) :while line))
376   (loop :repeat 5000 :collect (make-string 1000) :finally (terpri) (return  nil)))
377
378 ||#
379
380
381 ;;;; THE END ;;;;