summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Brannon <chris@the-brannons.com>2021-06-29 01:37:05 -0700
committerChristopher Brannon <chris@the-brannons.com>2021-06-29 01:37:05 -0700
commit048fbd3c1df855cffdc8d39469bb93d8c7a82c0c (patch)
treec0a367a242821cb51c64887a7a69da1798dc08a8
parent853e48fc160251bbffee489f4d641b1650a4bd98 (diff)
downloadrandom-things-048fbd3c1df855cffdc8d39469bb93d8c7a82c0c.tar
random-things-048fbd3c1df855cffdc8d39469bb93d8c7a82c0c.tar.gz
random-things-048fbd3c1df855cffdc8d39469bb93d8c7a82c0c.tar.bz2
random-things-048fbd3c1df855cffdc8d39469bb93d8c7a82c0c.tar.lz
random-things-048fbd3c1df855cffdc8d39469bb93d8c7a82c0c.tar.xz
random-things-048fbd3c1df855cffdc8d39469bb93d8c7a82c0c.tar.zst
random-things-048fbd3c1df855cffdc8d39469bb93d8c7a82c0c.zip
bscmd: use brev2scm.
-rwxr-xr-xclients/bscmd.brev72
-rwxr-xr-xclients/bscmd.scm78
2 files changed, 75 insertions, 75 deletions
diff --git a/clients/bscmd.brev b/clients/bscmd.brev
new file mode 100755
index 0000000..9fee95c
--- /dev/null
+++ b/clients/bscmd.brev
@@ -0,0 +1,72 @@
+(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)
diff --git a/clients/bscmd.scm b/clients/bscmd.scm
index 8b574c1..9ac39bd 100755
--- a/clients/bscmd.scm
+++ b/clients/bscmd.scm
@@ -1,83 +1,11 @@
-#!/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.
+;;; When called without arguments, displays the stream of events from baresip.
-(import base64 brev (chicken random) json matchable netstring socket)
+(import (chicken random) srfi-1 (chicken port) define-options anaphora 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)
+(include "bscmd.brev")