initial upload

2026-04-04 13:11:12 +03:00
commit 49d17a09aa
4 changed files with 277 additions and 0 deletions
@@ -0,0 +1,158 @@
+#!/usr/bin/env janet
+# DaemonTamer v3: a simple and portable way to daemonize any command,
+# now ported to Janet (depends on spork)
+# See README.md for (optional) compilation and usage
+# Created by Luxferre in 2026, released into the public domain
+
+(import spork/json)
+(import spork/path)
+(import spork/sh)
+(import spork/argparse :prefix "")
+
+(def script-path (-> (dyn :current-file) os/realpath path/dirname))
+(def config-path (string/format "%s/.dt.json" (os/getenv "HOME")))
+(def tempdir (sh/exec-slurp "/bin/sh" "-c" "dirname $(mktemp -u)"))
+(def pid-file-template (string/format "%s/dt.%%s.pid" tempdir))
+(def nohup-template "nohup %s >>%s 2>>%s &\necho $! > %s")
+
+(defn- read-config []
+	(if (os/stat config-path) (json/decode (slurp config-path)) @{}))
+
+(defn- write-config [cfg]
+	(spit config-path (json/encode cfg)))
+
+(defn- to-service-entry [params]
+	{
+		:command (get params "command")
+		:directory (or (get params "directory") script-path)
+		:before-start (get params "before-start")
+		:after-stop (get params "after-stop")
+		:stdout-log (or (get params "stdout-log") "/dev/null")
+		:stderr-log (or (get params "stderr-log") "/dev/null")
+	})
+
+(defn- pid-file-path [sname]
+	(string/format pid-file-template sname))
+
+(defn process-exists? [pid]
+  (default pid (os/getpid))
+  (= 0 (os/execute ["kill" "-0" (string pid)] :p)))
+
+# Read a single-letter choice from the stdin
+(defn get-choice [prompt]
+  (let [rawc (getline prompt)]
+    (if (> (length rawc) 0)
+      (string/ascii-lower (string/slice rawc 0 1))
+      nil)))
+
+# Ask user for y/n confirmation (with custom prompt)
+(defn user-confirm [prompt]
+  (var resp nil)
+  (var valid false)
+  (while (not valid)
+    (set resp (get-choice prompt))
+    (set valid (string/check-set "yn" resp)))
+  (= resp "y"))
+
+# command handlers
+
+(defn- service-status [sname]
+	(let [pfile (pid-file-path sname)]
+ 		(if (os/stat pfile) (let [pid (scan-number (string/trim (slurp pfile)))]
+ 			(if (process-exists? pid) "running" "stopped"))
+ 		"stopped")))
+
+(defn- start-service [sname entry]
+  (if (= (service-status sname) "stopped") (do
+		(printf "Starting service %s..." sname)
+		(let [
+			workdir (entry :directory)
+			pre-start (get entry :before-start)
+			cmd (get entry :command)
+			sout (get entry :stdout-log)
+			serr (get entry :stderr-log)
+		]
+			(os/cd workdir)
+			(when pre-start (os/shell pre-start))
+			(os/shell (string/format nohup-template cmd sout serr (pid-file-path sname)))
+			(printf "Service %s started" sname)))
+		# already running service here
+		(eprintf "Service %s is already running!" sname)))	
+
+(defn- stop-service [sname entry]
+	(printf "Stopping service %s..." sname)
+	(let [
+			pfile (pid-file-path sname)
+			post-stop (get entry :after-stop)
+		]
+ 		(when (os/stat pfile) (let [pid (scan-number (string/trim (slurp pfile)))]
+ 			(os/execute ["kill" (string pid)] :p)
+ 			(os/rm pfile)
+ 			(when post-stop (os/shell post-stop))
+ 			(printf "Service %s stopped" sname)
+ 		))))
+
+(defn- restart-service [sname entry]
+	(printf "Restarting service %s..." sname)
+	(stop-service sname entry)
+	(start-service sname entry)
+)
+
+(defn process-action [action service-name params]
+	(let [cfg (read-config)]
+		(case action
+			"add" (let [service-entry (to-service-entry params)]
+					(put cfg service-name service-entry)
+					(write-config cfg)
+					(printf "Service %s registered" service-name) 
+				)
+			"del" (let [service-entry (get cfg service-name)]
+				(if service-entry
+					(when (user-confirm (string/format "Really delete the service %s? (y/n) " service-name))
+						(put cfg service-name nil)
+						(write-config cfg)
+						(printf "Service %s unregistered" service-name)) 
+					(eprint "This service name does not exist!")))
+			"list" (eachp [sname entry] cfg
+				(printf "%s\t%s\t%s\t%s" sname
+					(service-status sname)
+					(entry "command") (entry "directory")))
+			"status" (let [service-entry (get cfg service-name)]
+				(if service-entry
+					(printf "Service %s is %s." service-name (service-status service-name))
+					(eprint "This service name does not exist!")))
+			"start" (let [service-entry (to-service-entry (get cfg service-name))]
+				(if service-entry
+					(start-service service-name service-entry)
+					(eprint "This service name does not exist!")))
+			"stop" (let [service-entry (to-service-entry (get cfg service-name))]
+				(if service-entry
+					(stop-service service-name service-entry)
+					(eprint "This service name does not exist!")))
+			"restart" (let [service-entry (to-service-entry (get cfg service-name))]
+				(if service-entry
+					(restart-service service-name service-entry)
+					(eprint "This service name does not exist!")))			
+			(eprint "Invalid action! Allowed actions: add, del, start, stop, restart, list, status"))))
+
+(def cli-params
+  ["DaemonTamer v3 service manager (by Luxferre, 2026)"
+   :default {:kind :accumulate :required true :help "[action] [name]"} # positional params: action, name
+   "command" {:kind :option :short "c" :help "The command to run"}
+   "directory" {:kind :option :short "d" :help "Working directory"}
+   "stdout-log" {:kind :option :short "o" :help "Log file for stdout (default /dev/null)" :default "/dev/null"}
+   "stderr-log" {:kind :option :short "e" :help "Log file for stderr (default /dev/null)" :default "/dev/null"}
+   "before-start" {:kind :option :short "b" :help "Pre-start hook command"}
+   "after-stop" {:kind :option :short "a" :help "Post-stop hook command"}])
+
+(defn main [&]
+  (let [args (argparse ;cli-params)]
+    (def posargs (get args :default))
+	  (if (and posargs (or (>= (length posargs) 2) (= (posargs 0) "list")))
+	  	(do
+		  	(def [action service-name] (args :default))
+		  	(process-action action service-name args)
+	  ) (do
+	    (eprint "Usage: dt {action} {service-name} [opts]\nAllowed actions: add, del, start, stop, restart, list, status")
+	  	(os/exit 1)
+	  ))))