reddit1.0/memcached.lisp

;;;; Copyright 2018 Reddit, Inc.
;;;; 
;;;; Permission is hereby granted, free of charge, to any person obtaining a copy of
;;;; this software and associated documentation files (the "Software"), to deal in
;;;; the Software without restriction, including without limitation the rights to
;;;; use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
;;;; of the Software, and to permit persons to whom the Software is furnished to do
;;;; so, subject to the following conditions:
;;;; 
;;;; The above copyright notice and this permission notice shall be included in all
;;;; copies or substantial portions of the Software.
;;;; 
;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;;;; SOFTWARE.

(in-package :reddit)

(defparameter *STORED* "STORED")
(defparameter *NOTSTORED* "NOT_STORED")
(defparameter *END* "END")
(defparameter *DELETED* "DELETED")
(defparameter *NOTFOUND* "NOT_FOUND")
(defparameter *OK* "OK")
(defparameter *ERROR* "ERROR")
(defparameter *CLIENTERROR* "CLIENT_ERROR")
(defparameter *SERVERERROR* "SERVER_ERROR")
(defparameter *VALUE* "VALUE")

(defparameter *cache* (make-hash-table :test 'equal))

(defmacro cached ((key &optional (exp 0)) &body body) 
  (let ((k (gensym)))
    `(let ((,k ,key))
        (or (mc-get ,k)
            (let ((val (progn ,@body)))
              (mc-set ,k val ,exp)
              val)))))

;;TODO more servers
(defun get-stream ()
  (ignore-errors
    (sys:make-fd-stream (ext:connect-to-inet-socket "127.0.0.1" 11211)
                        :input t :output t 
                        :buffering :none
                        :auto-close t)))

(defun mc-write-str (str stream)
  (write-string str stream)
  (write-char #\Return stream)
  (write-char #\Newline stream))

(defun mc-read-str (stream &optional len)
  ;(force-output stream)
  (if len
      ;;read len bytes in as few reads as possible
      (let ((val (read stream)))
        (read-char stream) (read-char stream)
        val)
      ;;everything else is read as one line
      (let ((str (read-line stream)))
        (subseq str 0 (1- (length str))))))
  
;;TODO locking!
(defun mc-store (cmd key val &optional (exp 0))
  (with-open-stream (s (get-stream))
    (when s
      (let ((cmd-str (case cmd
                   (:add "add")
                   (:replace "replace")
                   (t "set")))
          (val-str (with-output-to-string (s) (prin1 val s))))
      (mc-write-str (format nil "~a ~a ~a ~a ~a" cmd-str key 0 exp (length val-str)) s)
      (mc-write-str val-str s)
      (let ((response (mc-read-str s)))
        (cond
          ((string= *STORED* response) :STORED)
          ((string= *NOTSTORED* response) :NOTSTORED)
          (t response)))))))

(defun mc-set (key val &optional (exp 0))
  (mc-store :set key val exp))

(defun mc-add (key val &optional (exp 0))
  (mc-store :add key val exp))
                
(defun mc-replace (key val &optional (exp 0))
  (mc-store :replace key val exp))

(defun parse-value (value-str)
  (let* ((s1 (position #\space value-str :start 6))
         (s2 (position #\space value-str :start (1+ s1)))
         (key (subseq value-str 6 s1))
         (flags (parse-integer (subseq value-str (1+ s1) s2)))
         (len (parse-integer (subseq value-str (1+ s2)))))
    (list key flags len)))

(defun mc-read-val (stream)
  (let ((response (mc-read-str stream)))
        (when (string= response "VALUE" :end1 (min (length response) 5))
          (destructuring-bind (key flags len) (parse-value response)
            (values
             (mc-read-str stream len)
             key flags)))))

(defun mc-get (key)
  (with-open-stream (stream (get-stream))
    (when stream
      (mc-write-str (format nil "get ~a" key) stream)
      (let ((val (mc-read-val stream)))
        (when val
          ;;read END
          (mc-read-str stream)
          val)))))

(defun mc-delete (key &optional (time 0))
  (with-open-stream (stream (get-stream))
    (when stream
    (mc-write-str (format nil "delete ~a ~a" key time) stream)
    (let ((response (mc-read-str stream)))
      (cond
        ((string= response *DELETED*) :DELETED)
        ((string= response *NOTFOUND*) :NOTFOUND)
        (t response))))))