Fix package dependencies
[memstore.git] / memcache / util.lisp
1 (in-package #:memcache)
2
3 (defun mc-server-check (&key (memcache *memcache*))
4   "Performs some basic tests on the Memcache instance and outputs a status string"
5   (with-output-to-string (s)
6     (let ((key "MEMCACHESERVERCHECK")
7           (data "IS THE SERVER OK ? PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE")
8           (server-response (mc-make-pool-item :memcache memcache)))
9       (if server-response
10           (progn
11             (format s "Checking Memcached Server ~A running on ~A:~A ..." (name memcache) (ip memcache) (port memcache))
12             (format s "~%Sending data of length ~D with key ~A..." (length data) key)
13             (format s "~%Storage Command Rreturned : ~A" (handler-case (mc-store key data :memcache memcache)
14                                                            (socket-error () (format t "~2%CANNOT CONNECT TO CACHE !~%"))
15                                                            (error (c) (format t "GET COMMAND ERROR ~A" c))))
16             (format s "~%Trying to get back stored data with key ~A" key)
17             (format s "~%Retrieve Command Returned : ~a" (when (handler-case (mc-get (list key) :memcache memcache)
18                                                                  (socket-error () (format t "~2%CANNOT CONNECT TO CACHE !~%"))
19                                                                  (error (c) (format t "GET COMMAND ERROR ~A" c)))
20                                                            "DATA"))
21             (format s "~%Delete Command Returned : ~A" (handler-case (mc-del key :memcache memcache)
22                                                          (socket-error () (format t "~2%CANNOT CONNECT TO CACHE !~%"))
23                                                          (error (c) (format t "DEL COMMAND ERROR ~A" c))))
24             (format s "~2%~a" (mc-stats :memcache memcache)))
25           (format s "~2%CANNOT CONNECT TO CACHE SERVER ! ~%")))))
26
27
28
29 (defun mc-make-benchmark-data (n)
30   (make-array (list n) :initial-element 0))
31
32
33 (defun mc-benchmark (n data-size &key (memcache *memcache*) (use-pool t) (action :write))
34   (let ((data (make-array (list data-size) :initial-element 0)))
35     (dotimes (i n)
36       (let ((key (concatenate 'simple-string "key_" (princ-to-string i))))
37         (case action
38           (:write (mc-store key data :memcache memcache :use-pool use-pool :exptime 600))
39           (:read (mc-get (list key) :memcache memcache :use-pool use-pool)))))))
40
41
42
43 ;; if you have cl-who installed, print a pretty html table for the memcached stats
44
45 #+cl-who
46 (defun memcached-details-table-helper (&key (memcache *memcache*) (stream *standard-output*))
47   ""
48   (cl-who:with-html-output-to-string (stream)
49
50     (:table :border 1 :cellpadding 4 :width "90%" :style "border:solid black 4px;font-family:monospace;font-size:12px"
51             (let ((stats (memcache:mc-stats :memcache memcache :use-pool nil)))
52               (cl-who:htm
53                (:tr (:th :colspan 2 (:h4 (format stream "Name: ~A | Server IP : ~A  |  Port : ~A" (memcache::name memcache) (memcache::ip memcache) (memcache::port memcache)))))
54                (:tr
55                 (:td (format stream "Process ID")) (:td (format stream "~a" (memcache::mc-stats-pid stats))))
56                (:tr
57                 (:td (format stream "Server Uptime")) (:td (format stream "~a" (kmrcl:seconds-to-condensed-time-string
58                                                                                 (memcache::mc-stats-uptime stats)))))
59                (:tr
60                 (:td (format stream "System Time")) (:td (format stream "~a" (memcache::mc-stats-time stats))))
61                (:tr
62                 (:td (format stream "Server Version")) (:td (format stream "~a" (memcache::mc-stats-version stats))))
63                (:tr
64                 (:td (format stream "Accumulated user time")) (:td (format stream "~a" (memcache::mc-stats-rusage-user stats))))
65                (:tr
66                 (:td (format stream "Accumulated system time")) (:td (format stream "~a" (memcache::mc-stats-rusage-system stats))))
67                (:tr
68                 (:td (format stream "Current items stored in server")) (:td (format stream "~a" (memcache::mc-stats-curr-items stats))))
69                (:tr
70                 (:td (format stream "Current items total")) (:td (:b (format stream "~a" (memcache::mc-stats-curr-items-total stats)))))
71                (:tr
72                 (:td (format stream "Number of open connections")) (:td (format stream "~a" (memcache::mc-stats-curr-connections stats))))
73                (:tr
74                 (:td (format stream "Total number of connections opened since server start")) (:td (format stream "~a" (memcache::mc-stats-total-connections stats))))
75                (:tr
76                 (:td (format stream "Number of connection structures allocated by server")) (:td (format stream "~a" (memcache::mc-stats-connection-structures stats))))
77                (:tr
78                 (:td (format stream "Cumulative number of Retrieval requests")) (:td (:b (format stream "~a" (memcache::mc-stats-cmd-get stats)))))
79                (:tr
80                 (:td (format stream "Cumulative number of Storage requests")) (:td (:b (format stream "~a" (memcache::mc-stats-cmd-set stats)))))
81                (:tr
82                 (:td (format stream "Number of keys that have been requested and found present")) (:td (format stream "~a" (memcache::mc-stats-get-hits stats))))
83                (:tr
84                 (:td (format stream "Number of items that have been requested and not found")) (:td (format stream "~a" (memcache::mc-stats-get-misses stats))))
85                (:tr
86                 (:td (format stream "Total number of bytes read by server from network")) (:td (format stream "~a MB" (float (/ (memcache::mc-stats-bytes-read stats) 1048576)))))
87                (:tr
88                 (:td (format stream "Total number of bytes sent by this server to network")) (:td (format stream "~a MB" (float (/ (memcache::mc-stats-bytes-written stats) 1048576)))))
89                (:tr
90                 (:td (format stream "Number of bytes this server is allowed to use for storage")) (:td (format stream "~f MB" (float (/ (memcache::mc-stats-limit-maxbytes stats) 1048576))))))))))
91
92 (defun read-crlf-line (s)
93   "Reads a line from socket s. For platform independence, use read-bytes
94 to avoid differences in line endings across platforms."
95   (with-output-to-string (str)
96     (do* ((byte (read-byte s nil nil) (read-byte s nil nil))
97           (cr nil))
98          ((or (null byte) (eql byte 10))
99           (when (and (eql byte 10) (not cr))
100             (error "Newline with Return character.")))
101       (cond
102         ((eql byte 13)
103          (setq cr t))
104         (t
105          (write-char (code-char byte) str))))))
106