j@191: (cl:in-package #:amuse-database-admin)
j@191: 
j@191: (defparameter *amuse-database* nil)
j@191: 
j@191: (defun connect-to-database (&key (database-name "amuse") username
j@191: 			    use-tunnel (make-default t))
j@191:   "Well, slightly more secure I guess. Requires that an option file
j@191: exists containing connection-spec s-expressions. If no such file
j@191: exists a skeleton file can be created by calling
j@191: make-db-option-file (the password still needs to be added
j@191: manually). The path is ~/.amuse.lisp.
j@191: 
j@191: A better approach might be to use something like:
j@191: http://www.cliki.net/trivial-configuration-parser. Or for slime to
j@191: prompt the user for the password something
j@191: like (swank::eval-in-emacs `(read-passwd \"Password: \")). However,
j@191: this presents other security issues.
j@191: 
j@191: If use-tunnel is t, then regardless of the host specified in the
j@191: connection-spec, it will be set to localhost. It is assumed that the
j@191: tunnel is already set up.
j@191: 
j@191: When make-default is t, the newly created connection is assigned to
j@191: *amuse-database*. If make-default is nil, then the connection is
j@191: returned and is expected to be handled by the caller. This is useful
j@191: for connecting to different databases within individual
j@191: implementations (mainly for testing purposes)."
j@191:   (if (and make-default
j@191: 	   *amuse-database*
j@191: 	   (clsql-mysql::is-database-open *amuse-database*))
j@191:       (error "A default AMuSE database connection already exists:
j@191: ~S" (clsql:database-name *amuse-database*))
j@191:       (let ((connection-spec (%get-connection-spec database-name
j@191: 						   username)))
j@191: 	(when use-tunnel
j@191: 	  (setf (car connection-spec) "127.0.0.1"))
j@191: 	(let ((connection (%get-database-connection connection-spec)))
j@191: 	  (when make-default
j@191: 	    (setf *amuse-database* connection))
j@191: 	  connection))))
j@191: 
j@191: (defun disconnect-from-database (&optional (database-connection
j@191: 					    *amuse-database*))
j@191:   (clsql:disconnect :database database-connection))
j@191: 
j@191: (defun make-db-option-file (&key database-name host username (port "3306"))
j@191:   (with-open-file (stream (%make-db-option-file-pathname) :direction :output)
j@191:     (sb-ext:run-program "chmod"
j@191: 			(list "600" (namestring
j@191: 				     (%make-db-option-file-pathname)))
j@191: 			:search t)
j@191:     (princ "
j@191: ;;; Option file containing connection-spec s-expressions for connecting
j@191: ;;; to a database from within AMuSE. You can have multiple specifications,
j@191: ;;; but they must be uniquely identifiable by database name or a combination
j@191: ;;; of database and username.
j@191: 
j@191: ;;; You need to fill in the missing <details>." stream)
j@191:     (format stream "~2%(~S ~S ~S \"<pwd>\" ~S)"
j@191: 	    (if host host "<host>")
j@191: 	    (if database-name database-name "<db-name>")
j@191: 	    (if username username "<username>")
j@191: 	    port))
j@191:   (warn "You now need to manually edit ~A."
j@191: 	(namestring (%make-db-option-file-pathname))))
j@191: 
j@191: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
j@191: ;;; Helper functions
j@191: 
j@191: (defun %get-database-connection (connection-spec)
j@191:   (clsql:connect connection-spec
j@191: 		 :if-exists :old
j@191: 		 :database-type :mysql))
j@191: 
j@191: (defun %get-connection-spec (db-name username)
j@191:   (let ((option-file (probe-file (%make-db-option-file-pathname))))
j@191:     (if option-file
j@191: 	(with-open-file (stream option-file)
j@191: 	  (loop for connection-spec = (read stream nil)
j@191: 	     while connection-spec
j@191: 	     do (destructuring-bind (host db usr pwd prt)
j@191: 		    connection-spec
j@191: 		  (declare (ignore host pwd prt))
j@191: 		  (when (equal db-name db)
j@191: 		    (when (or (null username)
j@191: 			      (equal username usr))
j@191: 		      (return connection-spec))))
j@191: 	     finally (error "No connection-spec exists matching
j@191: database: ~A and username: ~A" db-name username)))
j@191: 	;; If file doesn't exist, create it.
j@191: 	(error "~A option file does not exist.
j@191: You need to run: amuse-database-admin:make-db-option-file."
j@191: 	       (namestring (%make-db-option-file-pathname))))))
j@191: 
j@191: (defun %make-db-option-file-pathname ()
j@191:   (merge-pathnames (user-homedir-pathname) ".amuse.lisp"))