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(a)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
