diff options
| -rwxr-xr-x | clients/bscmd.brev | 72 | ||||
| -rwxr-xr-x | clients/bscmd.scm | 78 |
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") |