Mercurial > hg > amuse

(cl:in-package #:amuse-database-admin)

(defvar *amuse-database* nil
  "The default AMuSE-wide database connection is assigned to this
  variable. If for any reason, such as testing database interaction,
  you do not wish to use the default database, this variable can be
  shadowed locally within a particular backend package. For this to
  actually work consistantly, all clsql database functions should
  specify *amuse-database* explicitally as the :database argument. Not
  doing this relies on the value of clsql:*default-database* being the
  connection to the correct database, which in most cases will
  actually be fine so long as you are not connecting to different
  databases.")

(defun connect-to-database (&key (database-name "amuse") username
			    use-tunnel (make-default t))
  "Well, slightly more secure I guess. Requires that an option file
exists containing connection-spec s-expressions. If no such file
exists a skeleton file can be created by calling
make-db-option-file (the password still needs to be added
manually). The path is ~/.amuse.lisp.

A better approach might be to use something like:
http://www.cliki.net/trivial-configuration-parser. Or for slime to
prompt the user for the password something
like (swank::eval-in-emacs `(read-passwd \"Password: \")). However,
this presents other security issues.

If use-tunnel is t, then regardless of the host specified in the
connection-spec, it will be set to localhost. It is assumed that the
tunnel is already set up.

When make-default is t, the newly created connection is assigned to
*amuse-database*. If make-default is nil, then the connection is
returned and is expected to be handled by the caller. This is useful
for connecting to different databases within individual
implementations (mainly for testing purposes)."
  (if (and make-default
	   *amuse-database*
	   (clsql-mysql::is-database-open *amuse-database*))
      (error "A default AMuSE database connection already exists:
~S" (clsql:database-name *amuse-database*))
      (let ((connection-spec (%get-connection-spec database-name
						   username)))
	(when use-tunnel
	  (setf (car connection-spec) "127.0.0.1"))
	(let ((connection (%get-database-connection connection-spec)))
	  (when make-default
	    (setf *amuse-database* connection))
	  connection))))

(defun disconnect-from-database (&optional (database-connection
					    *amuse-database*))
  (clsql:disconnect :database database-connection))

(defun make-db-option-file (&key database-name host username (port "3306"))
  (with-open-file (stream (%make-db-option-file-pathname) :direction :output)
    (sb-ext:run-program "chmod"
			(list "600" (namestring
				     (%make-db-option-file-pathname)))
			:search t)
    (princ "
;;; Option file containing connection-spec s-expressions for connecting
;;; to a database from within AMuSE. You can have multiple specifications,
;;; but they must be uniquely identifiable by database name or a combination
;;; of database and username.

;;; You need to fill in the missing <details>." stream)
    (format stream "~2%(~S ~S ~S \"<pwd>\" ~S)"
	    (if host host "<host>")
	    (if database-name database-name "<db-name>")
	    (if username username "<username>")
	    port))
  (warn "You now need to manually edit ~A."
	(namestring (%make-db-option-file-pathname))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Helper functions

(defun %get-database-connection (connection-spec)
  (clsql:connect connection-spec
		 :if-exists :old
		 :database-type :mysql))

(defun %get-connection-spec (db-name username)
  (let ((option-file (probe-file (%make-db-option-file-pathname))))
    (if option-file
	(with-open-file (stream option-file)
	  (loop for connection-spec = (read stream nil)
	     while connection-spec
	     do (destructuring-bind (host db usr pwd prt)
		    connection-spec
		  (declare (ignore host pwd prt))
		  (when (equal db-name db)
		    (when (or (null username)
			      (equal username usr))
		      (return connection-spec))))
	     finally (error "No connection-spec exists matching
database: ~A and username: ~A" db-name username)))
	;; If file doesn't exist, create it.
	(error "~A option file does not exist.
You need to run: amuse-database-admin:make-db-option-file."
	       (namestring (%make-db-option-file-pathname))))))

(defun %make-db-option-file-pathname ()
  (merge-pathnames (user-homedir-pathname) ".amuse.lisp"))
author	j.forth <j.forth@gold.ac.uk>
date	Thu, 24 Feb 2011 11:23:18 +0000
parents	4d06910b6f0f
children	6a3adca16910