Improvements

This commit is contained in:
Mikhail Kiselev 2023-08-08 00:31:09 -05:00
parent 644bf9f16c
commit ca3050a9db

72
lsmd.cl
View file

@ -1,6 +1,7 @@
#!/usr/bin/env -S sbcl --script #!/usr/bin/env -S sbcl --script
(load "~/.local/share/common-lisp/quicklisp/setup.lisp") (load "~/.local/share/common-lisp/quicklisp/setup.lisp")
(ql:quickload "sb-posix")
(ql:quickload "uiop") (ql:quickload "uiop")
(ql:quickload "bordeaux-threads") (ql:quickload "bordeaux-threads")
(ql:quickload "usocket") (ql:quickload "usocket")
@ -8,7 +9,9 @@
(defconstant *unix-epoch-offset* (defconstant *unix-epoch-offset*
(encode-universal-time 0 0 0 1 1 1970 0)) (encode-universal-time 0 0 0 1 1 1970 0))
(defun universal-to-unix-time (universal-time) (defconstant *current-millennium-AD* 2000)
(defun universal-to-unix-time(universal-time)
(- universal-time *unix-epoch-offset*) (- universal-time *unix-epoch-offset*)
) )
@ -16,6 +19,15 @@
(universal-to-unix-time (get-universal-time)) (universal-to-unix-time (get-universal-time))
) )
(defun unix-to-universal-time(unix-time)
(+ unix-time *unix-epoch-offset*)
)
(defun unix-to-timedate(unix-time)
(multiple-value-bind (seconds minutes hours day month year) (decode-universal-time (unix-to-universal-time unix-time))
(format nil "~D/~D/~D; ~D:~D.~D" month day (- year *current-millennium-AD*) hours minutes seconds))
)
(defun err(errno &optional str) (defun err(errno &optional str)
(case errno (case errno
(1 (format t "lsmd: Failed to open configuration file: ~A. Do I have correct permissions?" str)) (1 (format t "lsmd: Failed to open configuration file: ~A. Do I have correct permissions?" str))
@ -99,13 +111,11 @@
nil) nil)
(t (t
(multiple-value-bind (rets nenv) (start progs env req) (multiple-value-bind (rets nenv) (start progs env req)
(format t "~A" nenv)
(cond ((not (string= "0" rets)) (cond ((not (string= "0" rets))
(return-from start rets))) (return-from start rets)))
(setf env nenv))))) (setf env nenv)))))
(t (t
(multiple-value-bind (rets nenv) (start progs env req) (multiple-value-bind (rets nenv) (start progs env req)
(format t "~A" nenv)
(cond ((not (string= "0" rets)) (cond ((not (string= "0" rets))
(return-from start rets))) (return-from start rets)))
(setf env nenv)))))) (setf env nenv))))))
@ -153,20 +163,21 @@
(let* ((envline (select-db env :prog (getf progline :prog))) (let* ((envline (select-db env :prog (getf progline :prog)))
(nfo (getf envline :nfo)) (nfo (getf envline :nfo))
(alive (uiop:process-alive-p nfo))) (alive (uiop:process-alive-p nfo)))
(concatenate 'string (cond (alive (let ((esc (code-char 27)))
"running") (concatenate 'string
(t (let ((exitcode (slot-value nfo 'uiop/launch-program::exit-code))) (cond (alive
(cond ((plusp exitcode) (format nil "~C[92mrunning~C[0m" esc esc))
"dead") (t (let ((exitcode (slot-value nfo 'uiop/launch-program::exit-code)))
((zerop exitcode) (cond ((plusp exitcode)
"finished") (format nil "~C[31mdead~C[0m" esc esc))
(t "not started"))))) ((zerop exitcode)
"; " (format nil "~C[32mfinished~C[0m" esc esc))
(let ((launchtime (getf envline :time))) (t "not started")))))
(cond ((and (not notime) launchtime) (let ((launchtime (getf envline :time)))
(format nil "started at ~D" launchtime)) (cond ((and (not notime) launchtime)
(t nil))))) (format nil "; started at ~D" launchtime))
(sb-pcl::missing-slot (c) "not started")) (t nil))))))
(sb-pcl::missing-slot (c) "not started"))
) )
(defun status(progs env &optional progr) (defun status(progs env &optional progr)
@ -176,21 +187,32 @@
(return-from status (neterr 12 "status" progr)))) (return-from status (neterr 12 "status" progr))))
(concatenate 'string (concatenate 'string
(handler-case (handler-case
(format nil "0@\~A:~%~Cstatus: ~A~%~Cstart: ~A~%~Cprocess: ~D~%" progr #\tab (statusline progline env) #\tab (getf progline :start) #\tab (uiop:process-info-pid (select-dbp env progr :nfo))) (format nil "0@\~A:~%~Cstatus: ~A~%~Cstart: ~A~%~Cprocess: ~D~%~%" progr #\tab (statusline progline env) #\tab (getf progline :start) #\tab (uiop:process-info-pid (select-dbp env progr :nfo)))
(sb-pcl::missing-slot (c) (format nil "0@\~A:~%~Cstatus: ~A~%~Cstart: ~A~%~Cprocess: NIL~%" progr #\tab (statusline progline env) #\tab (getf progline :start) #\tab))) (sb-pcl::missing-slot (c) (format nil "0@\~A:~%~Cstatus: ~A~%~Cstart: ~A~%~Cprocess: NIL~%~%" progr #\tab (statusline progline env) #\tab (getf progline :start) #\tab)))
(let ((output (make-string-output-stream))) (let ((output (make-string-output-stream)))
(uiop:run-program (format nil "tail -n 5 ~A" (or (getf progline :stderr) (concatenate 'string (uiop:getenv "HOME") "/.var/log/" progr ".log"))) :output output) ;TODO: unsafe (uiop:run-program (format nil "tail -n 5 ~A" (or (getf progline :stderr) (concatenate 'string (uiop:getenv "HOME") "/.var/log/" progr ".log"))) :output output) ;TODO: unsafe
(get-output-stream-string output)))) (get-output-stream-string output))))
) )
(t (t
(let ((globalstatus "0@")) (let ((globalstatus "0@"))
(loop for progline in progs (loop for progline in (delete-db progs :prog "lsm")
do (setq globalstatus (concatenate 'string globalstatus (format nil "~A: ~A~%" (getf progline :prog) (statusline progline env))))) do (let ((progr (getf progline :prog))
globalstatus) (status (statusline progline env t)))
)) (setq globalstatus (concatenate 'string globalstatus
(format nil "~&~A:~A~C~A~C"
progr
(format nil "~v{~a~:*~}" (- 79 (+ (+ (length progr) 1) (+ (length status)
(cond ((find #\m status)
-7)
(t 2))
))) '(#\space))
#\[
status
#\])))))
globalstatus)))
) )
(defun run_command(command &optional args &key progs env) (defun run_command(command &optional args &key progs env) ;TODO: Shutdown all command to exit session gracefully
(cond ((string= command "start") (cond ((string= command "start")
(start progs env args)) (start progs env args))
((string= command "stop") ((string= command "stop")
@ -238,6 +260,4 @@
do (setf env (server_listen (select-dbp progs "lsm" :addr) (parse-integer (select-dbp progs "lsm" :port)) progs env)))) do (setf env (server_listen (select-dbp progs "lsm" :addr) (parse-integer (select-dbp progs "lsm" :port)) progs env))))
) )
(run) (run)