comparison base/database/database-connect.lisp @ 279:c591a5034da6

New base module for general database functions

Ignore-this: 403f22ca6285cba4a23eeddb1d0a806f

Currently just provides a slightly more secure way of connecting to a database.

darcs-hash:20090519135617-16a00-ce026a38abfb53e5728cd0cbb6c976e403691dde.gz

+(cl:in-package #:amuse-database-admin)
+
+(defparameter *amuse-database* nil)
+
+(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"))