;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;;;; Machines and executing on them...


(in-package :philip-jose)

(defparameter *hostname* nil)
(def*fun gethostname ()
  (or *hostname* (setf *hostname* (sb-unix:unix-gethostname))))

;;(defparameter *domainname* nil)
;;(defun getdomainname ()
;;  (or *domainname* (setf *domainname* (sb-unix:unix-getdomainname))))

(defparameter *localhost-names* nil)
(def*fun get-localhost-names ()
  (or *localhost-names* (setf *localhost-names* (compute-localhost-names))))
(defun compute-localhost-names ()
  (list nil
        "localhost"
        (gethostname)))
;;;  (concatenate 'string (gethostname) "." (getdomainname))))

(defun machine-localhost-p (m)
  ;;--- the most correct way would be to resolve and then compare to 127.0.0.1/8 and other local addresses from ifconfig output...
  (member m (get-localhost-names) :test #'equal))



(def*fun spawn-process-on (machine &rest process-spec)
  (if (machine-localhost-p machine)
    (apply #'spawn-process process-spec)
    (apply #'spawn-remote-process machine process-spec)))

;;;---*** make less SBCL-dependent?
#-sbcl (error "Philip-Jose requires SBCL at this point")
(def*fun spawn-process (program &rest args)
  (sb-ext:run-program (->string program) (mapcar #'->string args)
                      :wait nil :pty nil :input nil :output nil :error nil))

(defun ->string (x)
  (typecase x
    (string x)
    (symbol (string-downcase (symbol-name x)))
    (t (format nil "~A" x))))

(def*fun spawn-remote-process (machine program &rest args)
  (spawn-process *ssh-path*
                 machine (command-line-from-strings
                          (mapcar #'->string (cons program args)))))

(defun kill-machine-process (machine pid)
  (spawn-process-on machine "/bin/kill" -9 pid))

(defun pts-old-p (p)
  (let ((mtime (nth-value 11 (et:stat (namestring p)))))
    (< mtime (- (et:gettimeofday) 3600))))

(defun all-pts-old-p ()
  (every #'pts-old-p
         (directory (make-pathname :directory "/dev/pts/" :name :wild))))

(defun low-loadavg-p ()
  (< (nth-value 2 (read-loadavg)) .38))

(cffi:defcfun getloadavg :int (loadavg :pointer) (nelem :int))

(defun read-loadavg ()
  (values-list
   (cffi:with-foreign-object (loadavg :double 3)
     (getloadavg loadavg 3)
     (loop for i below 3 collect
           (cffi:mem-aref loadavg :double i)))))

(defun get-id ()
  (or *id*
      (setf *id* (list (gethostname) (iolib-posix:getpid) (get-real-time)))))

(defun validate-and-start-client (server port)
  (let* ((all-pts-old-p (all-pts-old-p))
         (low-loadavg-p (low-loadavg-p))
         (valid (and all-pts-old-p low-loadavg-p)))
    (simple-client `(:register-client ,(get-id) :valid t ;;,valid
                     ;; :explanation (:all-pts-old-p ,all-pts-old-p :low-loadavg-p ,low-loadavg-p)
                     )
                   server port)
    (if t ;valid
        (worker-loop :server server :port port)
        (logger "~&Client not taking part in the farm: ~S"
                (list :all-pts-old-p all-pts-old-p :low-loadavg-p low-loadavg-p)))))

(def*fun simple-client (message target port)
  (let* ((address (ensure-address target))
         (socket (make-tcp-connection address port)))
    (unwind-protect
         (progn
           (safe-write message :stream socket)
           (princ +crlf+ socket)
           (finish-output socket)
           ;;(shutdown socket :write)
           (read socket))
      (close socket))))

(defun spawn-client (machine &optional (server (gethostname)) (port *port*))
  (logger "~&Spawning client on ~S" machine)
  (spawn-process-on machine *farmer-path* "client" server port))

(def*fun start-clients ()
  (spawn-all-clients)
  nil)

(def*fun spawn-all-clients ()
  (dolist (machine (process-registry-log))
    (loop repeat *workers-per-machine* do
      (spawn-client machine))))