Some Racket "shell" scripts

deploy-and-restart.rkt

#!/usr/bin/env racket
#lang rkshell

(require racket/date
         "service.rkt"
         "ssh.rkt")

(define-logger deploy)

(date-display-format 'iso-8601)

(define (->string v)
  (cond
    [(path? v) (path->string v)]
    [else v]))

(define (deploy-file file-bytes dest-path)
  (define dp (~a "of=" (->string dest-path)))
  (with-input-from-bytes file-bytes
    (lambda () #{dd $dp})))

(match-define
  (vector filename dest-filename hostish ...)
  (current-command-line-arguments))

(define file-bytes
  (file->bytes filename))

(define hosts
  (for/fold ([h null]) ([h-ish (in-list hostish)])
    (append h (string-split h-ish ","))))

(for ([a-host (in-list hosts)])
  (with-ssh a-host
    (log-deploy-info "~a - deploying ~a to ~a"
                     (date->string (current-date) #t) filename a-host)
    (deploy-file file-bytes dest-filename)
    (service-stop   "myservice")
    (service-start  "myservice")
    (log-deploy-info "status: ~a" (service-status "myservice")))
  (sleep 300))

secret.rkt

#lang racket/base

(provide make-secret
         secret?
         unsecret)

;; dumb opaque struct to keep from accidentally printing a secret
(struct secret (value))

(define make-secret secret)

(define (unsecret v)
  (if (secret? v) (secret-value v) v))

service.rkt

#lang rkshell/base

(require racket/match
         "util.rkt")

(provide (all-defined-out))

(define (service-stop service-name)
  #{systemctl stop $service-name})

(define (service-start service-name)
  #{systemctl start $service-name})

(define (service-status service-name)
  (define-values (result s)
    (with-output-to-string*
      (λ () #{systemctl show -p SubState $service-name})))
  (match* (result s)
   [(#t (regexp #px"SubState=(\\S+)" (list _ state))) state]
   [(#f _) #f]))

ssh.rkt

#lang racket/base

(require (for-syntax racket/base)
         racket/system
         rkshell/private/runtime
         syntax/parse/define
         "secret.rkt")

(provide ssh-runner
         with-ssh)

(define-logger ssh)

(define ssh-cmd
  (find-executable-path "ssh"))

(define (ssh-runner hostname)
  (λ args
    (log-ssh-info "running: ~s ~s ~s" ssh-cmd hostname args)
    (apply system* ssh-cmd "-o" "ConnectTimeout 5" hostname "sudo" (map unsecret args))))

(define-syntax-parse-rule (with-ssh hostname body ...)
  #:declare hostname (expr/c #'string?)
  (parameterize ([rkexec-runner (ssh-runner hostname.c)])
    body ...))

util.rkt

#lang racket/base

(require racket/port)

(provide with-output-to-string*)

(define (with-output-to-string* thunk)
  (define p (open-output-string))
  (define result
    (parameterize ([current-output-port (dup-output-port p)])
      (thunk)))
  (values result (get-output-string p)))