first push

.gitignore

@@ -0,0 +1,2 @@
+*.config
+!example.config

Makefile

@@ -0,0 +1,19 @@
+SYSTEM_NAME = media-bot
+define LISP_CMDS
+"(handler-case                    \
+    (progn (ql:quickload :SYSTEM) \
+           (asdf:make :SYSTEM))   \
+  (error (e)                      \
+    (format t \"~A~%\" e)         \
+    (uiop:quit 1)))"
+endef
+
+CMDS = --eval $(subst SYSTEM,$(SYSTEM_NAME),$(LISP_CMDS))
+
+.PHONY: clean all
+
+all:
+	ros $(CMDS)
+
+clean: 
+	rm -ri bin/

README.md

@@ -0,0 +1,45 @@
+# media-bot
+### _a. fox_
+
+a mastodon bot that will post provided media files at specified days and times
+
+## Usage
+
+```
+Usage: media-bot [-c|--config ARG] [-h|--help] [-a|--alt-text ALT-TEXT]
+                 [-m|--media MEDIA] [-d|--day DAY] [-t|--time TIME] [-v|--visibility VISIBILITY]
+                 [-s|--sensitive] [--version]
+
+Available options:
+  -c, --config ARG            config file to use
+  -h, --help                  prints this help
+  -a, --alt-text ALT-TEXT     alt text to post for supplied media
+  -m, --media MEDIA           media to post
+  -d, --day DAY               day to make the post
+  -t, --time TIME             time to make the post in the format HH:MM
+  -v, --visibility VISIBILITY
+                              visibility of post (defaults to unlisted)
+  -s, --sensitive             if provided, the media will be marked as sensitive when posted
+  --version                   prints the version
+```
+
+## Example Usage 
+
+To post a video with alt text every thursday at 11:00am:
+
+`$ ./media-bot -c your.config --day thursday --time 11:00 --media video.mp4 --alt-text "this is the media alt text"`
+
+To post a photo publically, but mark it sensitive: 
+
+`$ ./media-bot -c your.config -d Sunday -t 20:00 -m photo.png --visibility public --sensitive`
+
+## Building
+
+1. Install [roswell](https://github.com/roswell/roswell)
+2. `$ mkdir ~/common-lisp && git clone https://dev.focks.website/focks/media-bot ~/common-lisp/media-bot`
+3. `$ cd ~/common-lisp/media-bot && make`
+
+## License
+
+NVPLv1+
+

example.config

@@ -0,0 +1,2 @@
+mastodon-instance = https://cool-server.tld
+mastodon-token    = somethingSomething_&Lorem-Ipsum

media-bot.asd

@@ -0,0 +1,17 @@
+;;;; media-bot.asd
+
+(asdf:defsystem #:media-bot
+  :description "mastodon bot that posts provided media file(s) at specified days & times"
+  :author "a. fox"
+  :license  "NVPLv1+"
+  :version "0.1.0"
+  :serial t
+  :depends-on (#:glacier #:simple-config #:with-user-abort #:unix-opts)
+  :components ((:file "media-bot"))
+  :entry-point "media-bot:main"
+  :build-operation "program-op"
+  :build-pathname "bin/media-bot")
+
+#+sb-core-compression
+(defmethod asdf:perform ((o asdf:image-op) (c asdf:system))
+  (uiop:dump-image (asdf:output-file o c) :executable t :compression t))

media-bot.lisp

@@ -0,0 +1,124 @@
+;;;; media-bot.lisp
+
+(defpackage #:media-bot
+  (:use #:cl #:with-user-abort)
+  (:import-from :simple-config
+   :config)
+  (:import-from :unix-opts
+   :define-opts
+   :get-opts)
+  (:import-from :glacier
+   :on
+   :post
+   :run-bot
+   :mastodon-bot)
+  (:export :main))
+
+(in-package #:media-bot)
+
+(defmacro print-and-quit (status message &rest args)
+  `(progn
+     (format t (concatenate 'string ,message "~%") ,@args)
+     (uiop:quit ,status)))
+
+(defun string->keyword (str)
+  (intern (string-upcase str) :keyword))
+
+(defun validate-day (day)
+  (car
+   (member (string->keyword day)
+           '(:sunday :monday :tuesday :wednesday
+             :thursday :friday :saturday))))
+
+(defun validate-visibility (vis)
+  (car
+   (member (string->keyword vis)
+           '(:public :unlisted :private :direct))))
+
+(define-opts
+  (:name :config
+   :short #\c
+   :long "config"
+   :description "config file to use"
+   :arg-parser #'identity)
+  (:name :help
+   :short #\h
+   :long "help"
+   :description "prints this help")
+  (:name :alt-text
+   :short #\a
+   :long "alt-text"
+   :description "alt text to post for supplied media (enclose in quotes)"
+   :arg-parser #'identity
+   :meta-var "ALT-TEXT")
+  (:name :media
+   :short #\m
+   :long "media"
+   :description "media to post"
+   :arg-parser #'pathname
+   :meta-var "MEDIA")
+  (:name :day
+   :short #\d
+   :long "day"
+   :description "day to make the post"
+   :arg-parser #'validate-day
+   :meta-var "DAY")
+  (:name :time
+   :short #\t
+   :long "time"
+   :description "time to make the post in the format HH:MM"
+   :arg-parser #'identity
+   :meta-var "TIME")
+  (:name :visibility
+   :short #\v
+   :long "visibility"
+   :description "visibility of post (defaults to unlisted)"
+   :arg-parser #'validate-visibility
+   :meta-var "VISIBILITY")
+  (:name :is-sensitive
+   :short #\s
+   :long "sensitive"
+   :description "if provided, the media will be marked as sensitive when posted")
+  (:name :version
+   :long "version"
+   :description "prints the version"))
+
+(defun main ()
+  (multiple-value-bind (opts args) (get-opts)
+    (when (getf opts :version)
+      (print-and-quit 0 "media-bot v~A"
+                      #.(asdf:component-version (asdf:find-system :media-bot))))
+
+    (when (getf opts :help)
+      (opts:describe :usage-of "media-bot")
+      (uiop:quit 0))
+
+    (unless (getf opts :config)
+      (print-and-quit 1 "please specify path to config file"))
+
+    (unless (getf opts :day)
+      (print-and-quit 1 "please specify a proper day"))
+
+    (unless (getf opts :time)
+      (print-and-quit 1 "please specify a proper timestring (see help)"))
+
+    (unless (getf opts :media)
+      (print-and-quit 1 "please specify media to post"))
+
+    (handler-case
+        (with-user-abort
+          (run-bot ((make-instance 'mastodon-bot :config-file (getf opts :config))
+                    :with-websocket nil)
+            (on ((getf opts :day) :at (getf opts :time))
+              (post (config :post-status)
+                    :visibility (getf opts :visibility :unlisted)
+                    :media (if (getf opts :alt-text)
+                               `((,(getf opts :media) ,(getf opts :alt-text)))
+                               (getf opts :media))
+                    :sensitive (getf opts :is-sensitive)))))
+      
+      (user-abort ()
+        (uiop:quit 0))
+
+      (error (e)
+        (print-and-quit 1 "~A" e)))))