wifi-toggle.rkt

#416
Raw
Author
winny
Created
Dec. 31, 2021, 8:17 a.m.
Expires
Never
Size
2.1 KB
Hits
204
Syntax
Racket
Private
No
#lang web-server

(require threading)

#|
TODO Factor out SSH key and target host/user.

Offers the following routes to enable/disable wifi on a RouterOS host.  Can also get status.

/ GET => {"status": "enabled"} or {"status": "disabled"}
/enable POST => {"status": "enabled"}
/disable POST => {"status": "disabled"}
|#

(require json web-server/servlet web-server/servlet-env)

(define (response/json jsexpr #:code [code 200])
  (response/output (curry write-json jsexpr) #:code code))

(define-values (enable-responder disable-responder)
  (let ([make-responder (λ (verb)
                          (λ (req)
                            ;; This uses routeros scripts to disable/enable
                            ;; wireless interfaces.
                            (match (ssh-command (format "/system script run ~a-wifi" verb))
                              [""
                               (response/json (hash 'status (string-append verb "d")))]
                              [non-empty-string
                               (error (string->symbol verb) "Error from command: ~a" non-empty-string)])))])
    (values (make-responder "enable")
            (make-responder "disable"))))

(define (status-responder req)
  (~> (ssh-command "/interface wireless print count-only where disabled")
       string-trim
       string->number
       (match _
         [0 "enabled"]
         [#f "unknown"]
         [other "disabled"])
       (hash 'status _)
       response/json))

(define-values (dispatch w-url)
  (dispatch-rules
   [("enable") #:method "post" enable-responder]
   [("disable") #:method "post" disable-responder]
   [("") status-responder]))

(define (four-oh-four-responder req)
  (response/output (curry displayln "Not found :(") #:code 404))


(define (ssh-command cmd)
  (match-define (list out in pid err proc)
    (process (format "ssh -i/tmp/rkttest toggle@router.lan ~a" cmd)))
  (proc 'wait)
  (port->string (merge-input out err)))

(module+ main
  (serve/servlet dispatch
                 #:file-not-found-responder four-oh-four-responder
                 #:servlet-path "/"
                 #:servlet-regexp #rx""
                 #:port 12341))