cl-rw

commit 3c76e21af80b1a9c7799d9401bd93801c62c2602
parent c87dae16f8fb32057362822d7cc15cac903f125c
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun, 13 Mar 2016 18:07:47 +0100

add netstring package

Diffstat:
M
cl-rw.asd
 | 
3
++-
A
netstring.lisp
 | 
52
++++++++++++++++++++++++++++++++++++++++++++++++++++

2 files changed, 54 insertions(+), 1 deletion(-)
diff --git a/cl-rw.asd b/cl-rw.asd
@@ -52,4 +52,5 @@
                (:file "wire")
                (:file "dns")
                (:file "tls")
-               (:file "sock")))
+               (:file "sock")
+               (:file "netstring")))
diff --git a/netstring.lisp b/netstring.lisp
@@ -0,0 +1,52 @@
+;;; Copyright (C) 2016 Tomas Hlavaty <tom@logand.com>
+;;;
+;;; 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.
+
+(defpackage :rw.netstring
+  (:use :cl)
+  (:export :next-netstring
+           :write-netstring))
+
+(in-package :rw.netstring)
+
+(defun next-netstring (reader &optional fn)
+  (when (rw:peek reader)
+    (let ((n (rw:next-z0 reader)))
+      (assert (eql #\: (rw:next reader)))
+      (prog1 (let ((r (rw:peek-reader (rw:shorter-reader reader n))))
+               (prog1 (funcall (or fn 'rw:till) r)
+                 (assert (not (rw:peek r)))))
+        (assert (eql #\, (rw:next reader)))))))
+
+(defun write-netstring (writer x)
+  (etypecase x
+    (string
+     (let ((n (length x)))
+       (rw:write-utf8-string writer (princ-to-string n))
+       (rw:write-octets writer #(#.(char-code #\:)))
+       (rw:write-utf8-string writer x)
+       (rw:write-octets writer #(#.(char-code #\,)))))))
+
+;;(next-netstring (rw:peek-reader (rw:utf8-reader (rw:reader #(#x31 #x32 #x3a #x68 #x65 #x6c #x6c #x6f #x20 #x77 #x6f #x72 #x6c #x64 #x21 #x2c)) :charp t)))
+#+nil
+(let ((b (rw.wire:make-octet-buffer 42)))
+  (write-netstring (rw:writer b) "hello world!")
+  (list b (next-netstring (rw:peek-reader (rw:utf8-reader (rw:reader b) :charp t)))))