1 (in-package #:memcache)
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)))
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)))
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 ! ~%")))))
29 (defun mc-make-benchmark-data (n)
30 (make-array (list n) :initial-element 0))
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)))
36 (let ((key (concatenate 'simple-string "key_" (princ-to-string i))))
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)))))))
43 ;; if you have cl-who installed, print a pretty html table for the memcached stats
46 (defun memcached-details-table-helper (&key (memcache *memcache*) (stream *standard-output*))
48 (cl-who:with-html-output-to-string (stream)
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)))
53 (:tr (:th :colspan 2 (:h4 (format stream "Name: ~A | Server IP : ~A | Port : ~A" (memcache::name memcache) (memcache::ip memcache) (memcache::port memcache)))))
55 (:td (format stream "Process ID")) (:td (format stream "~a" (memcache::mc-stats-pid stats))))
57 (:td (format stream "Server Uptime")) (:td (format stream "~a" (kmrcl:seconds-to-condensed-time-string
58 (memcache::mc-stats-uptime stats)))))
60 (:td (format stream "System Time")) (:td (format stream "~a" (memcache::mc-stats-time stats))))
62 (:td (format stream "Server Version")) (:td (format stream "~a" (memcache::mc-stats-version stats))))
64 (:td (format stream "Accumulated user time")) (:td (format stream "~a" (memcache::mc-stats-rusage-user stats))))
66 (:td (format stream "Accumulated system time")) (:td (format stream "~a" (memcache::mc-stats-rusage-system stats))))
68 (:td (format stream "Current items stored in server")) (:td (format stream "~a" (memcache::mc-stats-curr-items stats))))
70 (:td (format stream "Current items total")) (:td (:b (format stream "~a" (memcache::mc-stats-curr-items-total stats)))))
72 (:td (format stream "Number of open connections")) (:td (format stream "~a" (memcache::mc-stats-curr-connections stats))))
74 (:td (format stream "Total number of connections opened since server start")) (:td (format stream "~a" (memcache::mc-stats-total-connections stats))))
76 (:td (format stream "Number of connection structures allocated by server")) (:td (format stream "~a" (memcache::mc-stats-connection-structures stats))))
78 (:td (format stream "Cumulative number of Retrieval requests")) (:td (:b (format stream "~a" (memcache::mc-stats-cmd-get stats)))))
80 (:td (format stream "Cumulative number of Storage requests")) (:td (:b (format stream "~a" (memcache::mc-stats-cmd-set stats)))))
82 (:td (format stream "Number of keys that have been requested and found present")) (:td (format stream "~a" (memcache::mc-stats-get-hits stats))))
84 (:td (format stream "Number of items that have been requested and not found")) (:td (format stream "~a" (memcache::mc-stats-get-misses stats))))
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)))))
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)))))
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))))))))))
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))
98 ((or (null byte) (eql byte 10))
99 (when (and (eql byte 10) (not cr))
100 (error "Newline with Return character.")))
105 (write-char (code-char byte) str))))))