Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv12259

Modified Files: bdb-controller.lisp Log Message: Updated bdb controller with shell-kill patch by aycan.irican@core.gen.tr

--- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/06/19 00:47:24 1.9 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/07/21 16:28:17 1.10 @@ -168,20 +168,29 @@ (when (find-package :port) (pushnew :port *features*)))

-(defmethod start-deadlock-detector ((ctrlr bdb-store-controller) &key (type :oldest) (time 0.1) log) +(defun launch-background-program (directory program &key (args nil)) + "Launch a program in a specified directory - not all shell interfaces + or OS's support this" + #+(and allegro (not mswindows)) + (apply #'excl:run-shell-command (funcall #'vector directory program) + args) + #-(and allegro (not mswindows)) + nil) + +(defmethod start-deadlock-detector ((ctrl bdb-store-controller) &key (type :oldest) (time 0.1) log) #+port (multiple-value-bind (str errstr pid) - (port:run-prog (namestring - (make-pathname :directory "/usr/local/BerkeleyDB.4.3/bin/" - :name "db_deadlock")) - :args `("-a" ,(lookup-deadlock-type type) - "-t" ,(format nil "~D" time) - ,@(when log - (list "-L" (format nil "~A" log)))) - :wait nil) + (launch-background-program + (second (controller-spec ctrl)) + (namestring + (make-pathname :directory '(:ABSOLUTE "usr" "local" "BerkeleyDB.4.3" "bin") + :name "db_deadlock")) + :args `("-a" ,(lookup-deadlock-type type) + "-t" ,(format nil "~D" time) + ,@(when log (list "-L" (format nil "~A" log))))) (declare (ignore errstr)) - (setf (controller-deadlock-pid ctrlr) pid) - (setf (controller-deadlock-input ctrlr) str))) + (setf (controller-deadlock-pid ctrl) pid) + (setf (controller-deadlock-input ctrl) str))) (defmethod stop-deadlock-detector ((ctrl bdb-store-controller)) (when (controller-deadlock-pid ctrl) @@ -192,9 +201,9 @@ (setf (controller-deadlock-input ctrl) nil)))

(defmethod shell-kill (pid) - #+allegro (sys:reap-os-subprocess :pid pid :wait t) - #+(port (not allegro)) (port:run-prog "kill" :wait t :args (list "-9" (format nil "~A" pid))) - ) + #+allegro (sys:reap-os-subprocess :pid pid :wait t) + #+(and (not allegro) port) (port:run-prog "kill" :wait t :args (list "-9" (format nil "~A" pid))) + #+(and sbcl linux) (sb-ext:process-kill "/bin/kill" (list "-9" (format nil "~A" pid))))

;; ;; Persistent slot protocol