[Q3A] Q3Arena server log watcher/monitoring

plugins/q3a.lisp

@@ -0,0 +1,168 @@
+(in-package :cl-user)
+(defpackage chatikbot.plugins.q3a
+  (:use :cl :chatikbot.common :alexandria))
+(in-package :chatikbot.plugins.q3a)
+
+(defsetting *server-log* "/home/gamer/.q3a/baseq3/server.log" "Path to Q3Arena server log file to watch")
+(defvar *watcher* nil "Log watcher thread if set")
+(defvar *lock-game* (bordeaux-threads:make-recursive-lock "Q3A lock"))
+
+(defun watch-file (filespec thunk &optional (start-at :end))
+  "This will block forever, waiting for new data"
+  (with-open-file (s filespec)
+    (file-position s start-at)
+    (loop
+       with last-pos = (file-position s)
+       for line = (read-line s nil nil)
+       when line do (progn
+                      (funcall thunk line)
+                      (setf last-pos (file-position s)))
+       else do (progn
+                 (sleep 0.1)
+                 (when (> last-pos (file-length s))
+                   (file-position s :start))))))
+
+(defun parse-bslash-list (str)
+  (loop for (key val) on
+       (loop for pos = 0 then (1+ next-pos)
+          for next-pos = (position #\\ str :start pos)
+          collect (subseq str pos next-pos)
+          while next-pos) by 'cddr
+       collect (cons key val)))
+
+(defstruct game info players last-time is-active)
+(defstruct player name info kills began)
+(defstruct kill whom how)
+
+(defvar *game* (make-game) "Currently active game")
+(defun max-players (&optional (game *game*))
+  (length (game-players game)))
+
+(defun map-name (&optional (game *game*))
+  (agets (game-info game) "mapname"))
+
+(defun suicidep (player kill)
+  (or (null (kill-whom kill))
+      (equal (kill-whom kill) player)))
+
+(defun player-score (player)
+  (loop for kill in (player-kills player)
+     when (suicidep player kill) sum -1 else sum 1))
+
+(defun get-rankings (&optional (game *game*))
+  (sort (loop for player across (game-players game)
+           when (player-began player)
+           collect (cons (player-score player) player))
+        #'> :key #'car))
+
+(defun game-status (&optional (game *game*))
+  (let ((ranks (get-rankings)))
+    (if ranks
+        (format nil (if (game-is-active game)
+                        "[Q3] Match *~A* is on for ~A~%~{~A~^~%~}"
+                        "[Q3] Match *~A* has ended after ~A~%~{~A~^~%~}")
+                (map-name) (game-last-time *game*)
+                (loop for (score . player) in ranks
+                   collect (format nil "*~A* ~A" score (player-name player))))
+        "[Q3] War awaits")))
+
+(defun say (fmt &rest args)
+  (let ((words (apply #'format nil fmt args)))
+    (write words) (terpri)
+    (dolist (*chat-id* (lists-get :q3a))
+      (bot-send-message words))))
+
+(defun weapon (kill)
+  (kill-how kill))
+
+(defun on-init ())
+
+(defun on-begin (player)
+  (unless (player-began player)
+    (say "[Q3] ~A joined the server on ~A" (player-name player) (map-name))))
+
+;; (defun on-kill (player kill)
+;;   (let* ((name (player-name player))
+;;          (who (kill-whom kill)))
+;;     (if (suicidep player kill)
+;;         (say "[Q3] ~A suicides with score ~A" name (player-score player))
+;;         (say "[Q3] ~A frags ~A with score ~A" name (player-name who) (player-score player)))))
+(defun on-kill (player kill)
+  (declare (ignorable player kill)))
+
+(defun on-disconnect (player)
+  (when (player-began player)
+    (say "[Q3] ~A has left the match with ~A frags" (player-name player) (player-score player))))
+
+(defun on-exit ()
+  (say (game-status)))
+
+(defun process-log (line)
+  (bordeaux-threads:with-recursive-lock-held (*lock-game*)
+    (let* ((time (subseq line 0 7))
+           (sep (position #\: line :start 7))
+           (action (keyify (subseq line 7 sep)))
+           (args (when (and sep (> (length line) (+ 2 sep))) (subseq line (+ 2 sep))))
+           (client (when args (parse-integer args :junk-allowed t)))
+           (player (when (and client (<= 0 client (1- (max-players)))) (elt (game-players *game*) client))))
+      (setf (game-last-time *game*) (trim-nil time))
+      (case action
+        (:initgame (with-slots (info players is-active) *game*
+                     (setf info (parse-bslash-list (subseq args 1))
+                           is-active t
+                           players (or players
+                                       (let ((count (parse-integer (agets info "sv_maxclients"))))
+                                         (make-array count :element-type 'player
+                                                     :initial-contents (loop for i below count collect (make-player))))))
+                     (on-init)))
+        (:clientuserinfochanged (with-slots (info name) player
+                                  (setf info (parse-bslash-list
+                                              (subseq args (1+ (position #\Space args))))
+                                        name (agets info "n"))))
+        (:clientbegin (progn
+                        (on-begin player)
+                        (setf (player-began player) t)))
+        (:clientdisconnect (progn
+                             (on-disconnect player)
+                             (setf (player-began player) nil)))
+        (:kill (destructuring-bind (a1 a2 how)
+                   (mapcar 'parse-integer (split-sequence:split-sequence
+                                           #\Space (subseq args 0 (position #\: args))))
+                 (let* ((killee (when (<= a1 (max-players))
+                                  (elt (game-players *game*) a2)))
+                        (killer (elt (game-players *game*) (if killee a1 a2)))
+                        (kill (make-kill :whom killee :how how)))
+                   (push kill (player-kills killer))
+                   (on-kill killer kill))))
+        (:exit (progn
+                 (setf (game-is-active *game*) nil)
+                 (on-exit)))
+        (:shutdowngame (loop for player across (game-players *game*)
+                          do (setf (player-kills player) nil))))))
+  (values))
+
+(defun ensure-watcher ()
+  (bt:with-recursive-lock-held (*lock-game*)
+    (if (lists-get :q3a)
+        (unless *watcher*
+          (setf *watcher* (bt:make-thread (lambda () (watch-file *server-log* #'process-log)) :name "q3a watch")))
+        (when *watcher*
+          (bt:destroy-thread *watcher*)
+          (setf *watcher* nil))))
+  (values))
+
+(defun handle-set-watch (enable)
+  (lists-set-entry :q3a *chat-id* enable)
+  (ensure-watcher)
+  (bot-send-message (if enable "[Q3] Шлём войну!" "[Q3] Миру-мир!")))
+
+(defun handle-active ()
+  (bot-send-message (game-status)))
+
+(def-message-cmd-handler handle-cmd-q3a (:q3a)
+  (cond
+    ((= 1 (length *args*))
+     (handle-set-watch (equal "on" (car *args*))))
+    (:otherwise (handle-active))))
+
+(add-hook :starting #'ensure-watcher)