Improvements
This commit is contained in:
Mikhail Kiselev
parent
644bf9f16c
commit
ca3050a9db
1 changed files with 46 additions and 26 deletions
72
lsmd.cl
72
lsmd.cl
|
|
@ -1,6 +1,7 @@
|
|||
#!/usr/bin/env -S sbcl --script
|
||||
|
||||
(load "~/.local/share/common-lisp/quicklisp/setup.lisp")
|
||||
(ql:quickload "sb-posix")
|
||||
(ql:quickload "uiop")
|
||||
(ql:quickload "bordeaux-threads")
|
||||
(ql:quickload "usocket")
|
||||
|
|
@ -8,7 +9,9 @@
|
|||
(defconstant *unix-epoch-offset*
|
||||
(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*)
|
||||
)
|
||||
|
||||
|
|
@ -16,6 +19,15 @@
|
|||
(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)
|
||||
(case errno
|
||||
(1 (format t "lsmd: Failed to open configuration file: ~A. Do I have correct permissions?" str))
|
||||
|
|
@ -99,13 +111,11 @@
|
|||
nil)
|
||||
(t
|
||||
(multiple-value-bind (rets nenv) (start progs env req)
|
||||
(format t "~A" nenv)
|
||||
(cond ((not (string= "0" rets))
|
||||
(return-from start rets)))
|
||||
(setf env nenv)))))
|
||||
(t
|
||||
(multiple-value-bind (rets nenv) (start progs env req)
|
||||
(format t "~A" nenv)
|
||||
(cond ((not (string= "0" rets))
|
||||
(return-from start rets)))
|
||||
(setf env nenv))))))
|
||||
|
|
@ -153,20 +163,21 @@
|
|||
(let* ((envline (select-db env :prog (getf progline :prog)))
|
||||
(nfo (getf envline :nfo))
|
||||
(alive (uiop:process-alive-p nfo)))
|
||||
(concatenate 'string (cond (alive
|
||||
"running")
|
||||
(t (let ((exitcode (slot-value nfo 'uiop/launch-program::exit-code)))
|
||||
(cond ((plusp exitcode)
|
||||
"dead")
|
||||
((zerop exitcode)
|
||||
"finished")
|
||||
(t "not started")))))
|
||||
"; "
|
||||
(let ((launchtime (getf envline :time)))
|
||||
(cond ((and (not notime) launchtime)
|
||||
(format nil "started at ~D" launchtime))
|
||||
(t nil)))))
|
||||
(sb-pcl::missing-slot (c) "not started"))
|
||||
(let ((esc (code-char 27)))
|
||||
(concatenate 'string
|
||||
(cond (alive
|
||||
(format nil "~C[92mrunning~C[0m" esc esc))
|
||||
(t (let ((exitcode (slot-value nfo 'uiop/launch-program::exit-code)))
|
||||
(cond ((plusp exitcode)
|
||||
(format nil "~C[31mdead~C[0m" esc esc))
|
||||
((zerop exitcode)
|
||||
(format nil "~C[32mfinished~C[0m" esc esc))
|
||||
(t "not started")))))
|
||||
(let ((launchtime (getf envline :time)))
|
||||
(cond ((and (not notime) launchtime)
|
||||
(format nil "; started at ~D" launchtime))
|
||||
(t nil))))))
|
||||
(sb-pcl::missing-slot (c) "not started"))
|
||||
)
|
||||
|
||||
(defun status(progs env &optional progr)
|
||||
|
|
@ -176,21 +187,32 @@
|
|||
(return-from status (neterr 12 "status" progr))))
|
||||
(concatenate 'string
|
||||
(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)))
|
||||
(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)))
|
||||
(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)))
|
||||
(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
|
||||
(get-output-stream-string output))))
|
||||
)
|
||||
(t
|
||||
(let ((globalstatus "0@"))
|
||||
(loop for progline in progs
|
||||
do (setq globalstatus (concatenate 'string globalstatus (format nil "~A: ~A~%" (getf progline :prog) (statusline progline env)))))
|
||||
globalstatus)
|
||||
))
|
||||
(loop for progline in (delete-db progs :prog "lsm")
|
||||
do (let ((progr (getf progline :prog))
|
||||
(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")
|
||||
(start progs env args))
|
||||
((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))))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(run)
|
||||
|
|
|
|||
Loading…
Reference in a new issue