cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

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

add netstring package

Diffstat:
Mcl-rw.asd | 3++-
Anetstring.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)))))