cl-rw

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

netstring.lisp (2278B)

      1 ;;; Copyright (C) 2016 Tomas Hlavaty <tom@logand.com>
      2 ;;;
      3 ;;; Permission is hereby granted, free of charge, to any person
      4 ;;; obtaining a copy of this software and associated documentation
      5 ;;; files (the "Software"), to deal in the Software without
      6 ;;; restriction, including without limitation the rights to use, copy,
      7 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
      8 ;;; of the Software, and to permit persons to whom the Software is
      9 ;;; furnished to do so, subject to the following conditions:
     10 ;;;
     11 ;;; The above copyright notice and this permission notice shall be
     12 ;;; included in all copies or substantial portions of the Software.
     13 ;;;
     14 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
     15 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
     16 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
     17 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
     18 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
     19 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
     20 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
     21 ;;; DEALINGS IN THE SOFTWARE.
     22 
     23 (defpackage :rw.netstring
     24   (:use :cl)
     25   (:export :next-netstring
     26            :write-netstring))
     27 
     28 (in-package :rw.netstring)
     29 
     30 (defun next-netstring (reader &optional fn)
     31   (when (rw:peek reader)
     32     (let ((n (rw:next-z0 reader)))
     33       (assert (eql #\: (rw:next reader)))
     34       (prog1 (let ((r (rw:peek-reader (rw:shorter-reader reader n))))
     35                (prog1 (funcall (or fn 'rw:till) r)
     36                  (assert (not (rw:peek r)))))
     37         (assert (eql #\, (rw:next reader)))))))
     38 
     39 (defun write-netstring (writer x)
     40   (etypecase x
     41     (string
     42      (let ((n (length x)))
     43        (rw:write-utf8-string writer (princ-to-string n))
     44        (rw:write-octets writer #(#.(char-code #\:)))
     45        (rw:write-utf8-string writer x)
     46        (rw:write-octets writer #(#.(char-code #\,)))))))
     47 
     48 ;;(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)))
     49 #+nil
     50 (let ((b (rw.wire:make-octet-buffer 42)))
     51   (write-netstring (rw:writer b) "hello world!")
     52   (list b (next-netstring (rw:peek-reader (rw:utf8-reader (rw:reader b) :charp t)))))