(module netstring

(netstring-write netstring-read string->netstring netstring->string)

(import chicken scheme)
(use (only extras read-string read-token) 
     (only ports 
           with-output-to-port
           with-output-to-string 
           with-input-from-string))

(define (netstring-write str #!optional (port (current-output-port)) (terminator #\,))
  (with-output-to-port port
    (lambda ()
      (display (string-length str))
      (display #\:)
      (display str)
      (display terminator))))

(define (netstring-read #!optional (port (current-input-port)) (check-terminator? #t))
  (if (eof-object? (peek-char port))
      (read-char port)
      (let* ((len (or (string->number (read-token char-numeric? port))
                      (error 'netstring-read "missing length header")))
             (string (if (eq? #\: (read-char port))
                         (read-string len port)
                         (error 'netstring-read "missing length delimiter"))))

        (cond ((not (= (string-length string) len))
               (error 'netstring-read 
                      (format "wrong length, expected ~A but got ~A"
                              len 
                              (string-length string))))
              (check-terminator? 
               (if (eq? #\, (read-char port))
                   string
                   (error 'netstring-read "missing terminator")))
              (else string)))))

(define (string->netstring str)
  (with-output-to-string 
      (lambda () 
        (netstring-write str))))


(define (netstring->string ns)
  (with-input-from-string ns netstring-read))

)