Mercurial > hg > amuse
changeset 191:4d06910b6f0f
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
| author | j.forth <j.forth@gold.ac.uk> |
|---|---|
| date | Tue, 19 May 2009 14:56:17 +0100 |
| parents | 725ce7ce77ba |
| children | 54d79a2c82d2 |
| files | amuse-database-admin.asd amuse-geerdes.asd base/database/database-connect.lisp base/database/package.lisp implementations/geerdes/connect.lisp |
| diffstat | 5 files changed, 117 insertions(+), 1 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/amuse-database-admin.asd Tue May 19 14:56:17 2009 +0100 @@ -0,0 +1,12 @@ +(asdf:defsystem amuse-database-admin + :name "amuse-database-admin" + :description "Basic admin functions for an AMuSE database." + :depends-on ("clsql-mysql" "amuse") + :components + ((:module base + :components + ((:module database + :components + ((:file "package") + (:file "database-connect" :depends-on ("package")) + ))))))
--- a/amuse-geerdes.asd Mon Jan 05 15:03:55 2009 +0000 +++ b/amuse-geerdes.asd Tue May 19 14:56:17 2009 +0100 @@ -1,6 +1,6 @@ (asdf:defsystem amuse-geerdes :name "amuse-geerdes" - :depends-on ("amuse" "amuse-midi" "clsql") + :depends-on ("amuse" "amuse-midi" "amuse-database-admin") :components ((:module implementations :components
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/database/database-connect.lisp Tue May 19 14:56:17 2009 +0100 @@ -0,0 +1,96 @@ +(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"))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/base/database/package.lisp Tue May 19 14:56:17 2009 +0100 @@ -0,0 +1,7 @@ +(cl:defpackage #:amuse-database-admin + (:use #:common-lisp #:amuse) + (:export #:connect-to-database ; database-connect + #:disconnect-from-database + #:*amuse-database* + #:make-db-option-file + ))
--- a/implementations/geerdes/connect.lisp Mon Jan 05 15:03:55 2009 +0000 +++ b/implementations/geerdes/connect.lisp Tue May 19 14:56:17 2009 +0100 @@ -4,6 +4,7 @@ ;; plain text... (defun get-amuse-connection () + (warn "This function should be removed, use connect-to-database instead.") (clsql:connect '("vaughan-williams.doc.gold.ac.uk" "amuse" "LispMidi" "clsql") :if-exists :old :database-type :mysql))