summaryrefslogtreecommitdiff
path: root/clients/bscmd.scm
blob: 8b574c14dab4964923953883f8db1f77513df1ab (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
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)