1 files changed, 83 insertions, 0 deletions
diff --git a/clients/bscmd.scm b/clients/bscmd.scm
new file mode 100755
index 0000000..8b574c1
--- /dev/null
+++ b/clients/bscmd.scm
@@ -0,0 +1,83 @@
+#!/usr/bin/csi -s
+;;; A tiny little control utility for baresip, written in CHICKEN Scheme.
+;;; This won't work out of the box right now, because the port of
+;;; netstring to CHICKEN 5 hasn't been published.
+;;; Usage:
+;;; bscmd COMMAND [parameter-string]
+;;; bscmd
+;;; With called without arguments, displays the stream of events from baresip.
+
+(import base64 brev (chicken random) json matchable netstring socket)
+
+(define (generate-token) (base64-encode (random-bytes (make-string 9))))
+
+(define (write-object-json-netstring obj . rest) (apply netstring-write (with-output-to-string (fn (json-write obj))) rest))
+
+(define (maybe-cons key value lst)
+  (if value (cons (cons key value) lst) lst))
+
+(define (send-baresip-command command #!key params port token)
+  (let ((obj
+	 (maybe-cons 'params params
+		     (maybe-cons 'token token
+				 `((command . ,command))))))
+    (
+     (if port
+	 (cut write-object-json-netstring <> port)
+	 write-object-json-netstring)
+     (list->vector obj))))
+
+(define-options (bscmd bscmd.scm)
+  '((host
+     "Hostname or IP address."
+     (default "localhost")
+     (single-char #\H)
+     (value #t))
+    (port
+     "Port where baresip is listening."
+     (default "4444")
+     (single-char #\p)
+     (value #t))))
+
+(define (make-socket h p)
+  (let* ((addrinfo (car (address-information h p)))
+	(sock (socket (addrinfo-family addrinfo) (addrinfo-socktype addrinfo) (addrinfo-protocol addrinfo))))
+    (socket-connect sock (addrinfo-address addrinfo)) sock))
+
+(define (json-netstring-read port)
+  (vector->list (with-input-from-string (netstring-read port) json-read)))
+
+(define (with-baresip-connection proc)
+  (let ((client-socket (make-socket host (string->number port))))
+    (call-with-values (fn (socket-i/o-ports client-socket)) proc)))
+
+(define (process-events handler)
+  (fn
+    (let loop ()
+      (when (handler (json-netstring-read x))
+	(loop)))))
+
+(define (watch-events)
+  (with-baresip-connection (process-events (fn (print x) #t))))
+
+(define (baresip-transact command params)
+  (with-baresip-connection
+   (lambda (inp outp)
+     (let ((token (generate-token)))
+       (send-baresip-command
+	command params: params token: token port: outp) 
+       ((process-events
+	 (fn
+	  (if (aand (assoc "token" x) (string=? token (cdr it)))
+	      (begin (print x) #f)
+	      #t))) inp outp)))))
+
+(define (main . ignored-args)
+  (match (cdr argument-stragglers)
+    (((? string? command) (? string? params))
+     (baresip-transact command params))
+    (((? string? command)) (print (baresip-transact command #f)))
+    (() (watch-events))
+    (_ (print "Expected: COMMAND PARAMS"))))
+
+(main)