--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/retry.lisp Sun Nov 17 18:33:57 2019 -0500
@@ -0,0 +1,211 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (ql:quickload '(:adopt :iterate :external-program :parse-number :alexandria)
+ :silent t))
+
+(defpackage :retry
+ (:use :cl :iterate)
+ (:export :toplevel :*ui*))
+
+(in-package :retry)
+
+;;;; Configuration ------------------------------------------------------------
+(defparameter *version* "0.0.1")
+
+
+;;;; Functionality ------------------------------------------------------------
+(defun backoff-immediate ()
+ (lambda (try) (declare (ignore try))))
+
+(defun backoff-constant (seconds)
+ (lambda (try)
+ (declare (ignore try))
+ (sleep seconds)))
+
+(defun backoff-exponential (seconds)
+ (lambda (try)
+ (sleep (* try seconds))))
+
+(defun retry (command &key backoff tries)
+ (iterate
+ (with (program . args) = command)
+ (for try :from 1)
+ (for (values nil code) =
+ (external-program:run program args :input t :output t :error t))
+ (finding code :such-that #'zerop :on-failure 1)
+ (while (or (null tries) (< try tries)))
+ (when backoff
+ (funcall backoff try))))
+
+
+;;;; Run ----------------------------------------------------------------------
+(defun run (arguments options)
+ (retry (let ((shell (gethash 'shell options)))
+ (if shell
+ `("sh" "-c" ,shell)
+ arguments))
+ :tries (gethash 'tries options)
+ :backoff (gethash 'backoff options)))
+
+
+;;;; User Interface -----------------------------------------------------------
+(adopt:define-string *help*
+ "retry runs another command, retrying it if it returns a non-zero exit code.~@
+ ~@
+ Options are available for configuring the number of retries and how long ~
+ to wait before retrying. If the command eventually succeeds, retry will ~
+ return an exit code of 0, otherwise it will return an exit code of 1.")
+
+(adopt:define-string *help-command*
+ "By default, any non-option arguments to retry will designate the command ~
+ to be run. If the command itself has options, you'll need to use -- to tell ~
+ retry which options belong to the command, e.g.:~@
+ ~@
+ ~:
+ retry --backoff 5 -- ping -c 1 -w 1 example.com~@
+ ~@
+ You can use the --shell option to specify the command to run as a single ~
+ string, which can be handy if you need to redirect its output:~@
+ ~@
+ ~:
+ retry -t5 -b1 --shell 'curl -Lsf stevelosh.com | grep -q Hello'")
+
+(defparameter *examples*
+ '(("Retry flashing a cheap EEPROM a few times before giving up:"
+ . "retry --tries 3 -- minipro -p AT28C256 -w rom.bin")
+ ("Try to curl a healthcheck endpoint with exponential backoff:"
+ . "retry --backoff 1 --tries 5 --shell \"curl -Lsf 'http://example.com/healthcheck/' >/dev/null\"")))
+
+
+(defparameter *option-shell*
+ (adopt:make-option 'shell
+ :help "Execute `sh -c \"$COMMAND\"`, instead of passing the command as separate arguments to retry."
+ :long "shell"
+ :short #\s
+ :parameter "COMMAND"
+ :reduce #'adopt:last))
+
+(defparameter *option-no-shell*
+ (adopt:make-option 'no-shell
+ :result-key 'shell
+ :help "Execute the non-option arguments to retry as the command (the default)."
+ :long "no-shell"
+ :short #\S
+ :reduce (constantly nil)))
+
+(defparameter *option-immediate*
+ (adopt:make-option 'immediate
+ :result-key 'backoff
+ :help "Retry the command immediately on failure (the default)."
+ :long "immediate"
+ :short #\i
+ :reduce (constantly (backoff-immediate))))
+
+(defparameter *option-wait*
+ (adopt:make-option 'wait
+ :result-key 'backoff
+ :help "Wait N seconds before retrying a failed command."
+ :long "wait"
+ :short #\w
+ :parameter "N"
+ :key (alexandria:compose #'backoff-constant #'parse-number:parse-number)
+ :reduce #'adopt:last))
+
+(defparameter *option-backoff*
+ (adopt:make-option 'backoff
+ :result-key 'backoff
+ :help "Backoff (N * try) seconds before retrying a failed command."
+ :long "backoff"
+ :short #\b
+ :parameter "N"
+ :key (alexandria:compose #'backoff-exponential #'parse-number:parse-number)
+ :reduce #'adopt:last))
+
+(defparameter *option-tries*
+ (adopt:make-option 'tries
+ :help "Maximum number of tries to attempt."
+ :long "tries"
+ :short #\t
+ :parameter "N"
+ :initial-value nil
+ :key #'parse-integer
+ :reduce #'adopt:last))
+
+(defparameter *option-try-forever*
+ (adopt:make-option 'try-forever
+ :result-key 'tries
+ :help "Try forever (the default)."
+ :long "try-forever"
+ :short #\T
+ :reduce (constantly nil)))
+
+(defparameter *option-help*
+ (adopt:make-option 'help
+ :help "Display help and exit."
+ :long "help"
+ :short #\h
+ :reduce (constantly t)))
+
+(defparameter *option-version*
+ (adopt:make-option 'version
+ :help "Display version information and exit."
+ :long "version"
+ :reduce (constantly t)))
+
+
+(defparameter *ui*
+ (adopt:make-interface
+ :name "retry"
+ :usage "[OPTIONS] -- COMMAND [ARG...]"
+ :summary "retry running a command"
+ :help *help*
+ :examples *examples*
+ :contents (list
+ (adopt:make-group
+ 'tries
+ :title "Number of Tries"
+ :options (list
+ *option-tries*
+ *option-try-forever*))
+
+ (adopt:make-group
+ 'backoff-policy
+ :title "Backoff Policy"
+ :options (list
+ *option-immediate*
+ *option-wait*
+ *option-backoff*))
+
+ (adopt:make-group
+ 'command
+ :title "Specifying a Command"
+ :help *help-command*
+ :options (list
+ *option-shell*
+ *option-no-shell*))
+
+ *option-help*
+ *option-version*)))
+
+
+(defmacro quit-on-ctrl-c (&body body)
+ `(handler-case
+ (progn ,@body)
+ #+sbcl (sb-sys:interactive-interrupt (c)
+ (declare (ignore c))
+ (adopt:exit 130))))
+
+(defun parse-options-or-exit (ui)
+ (handler-case (adopt:parse-options ui)
+ (error (c) (adopt:print-error-and-exit c))))
+
+
+(defun toplevel ()
+ #+sbcl (sb-ext:disable-debugger)
+ (quit-on-ctrl-c
+ (multiple-value-bind (arguments options)
+ (parse-options-or-exit *ui*)
+ (cond
+ ((gethash 'help options) (adopt:print-help-and-exit *ui*))
+ ((gethash 'version options) (write-line *version*) (adopt:exit))
+ (t (adopt:exit (run arguments options)))))))
+