diff options
| -rw-r--r-- | examples/whoisd.scm | 30 | ||||
| -rw-r--r-- | src/Makefile.am | 30 | ||||
| -rw-r--r-- | src/gsql_conn.c | 98 | ||||
| -rw-r--r-- | src/gsql_lib.c | 65 | ||||
| -rw-r--r-- | src/guile-sql.h | 22 | ||||
| -rw-r--r-- | src/mysql.c | 77 | ||||
| -rw-r--r-- | src/pgsql.c | 39 | ||||
| -rw-r--r-- | src/sql.sci | 17 |
8 files changed, 264 insertions, 114 deletions
diff --git a/examples/whoisd.scm b/examples/whoisd.scm index a5bb68e..058136a 100644 --- a/examples/whoisd.scm +++ b/examples/whoisd.scm @@ -1,7 +1,7 @@ #! /usr/local/bin/guile -s !# ;;;; This is Scheme whoisd daemon -;;;; Copyright (C) 2002, 2007, Sergey Poznyakoff +;;;; Copyright (C) 2002, 2007, 2010 Sergey Poznyakoff ;;;; ;;;; This program is free software; you can redistribute it and/or modify it ;;;; under the terms of the GNU General Public License as published by the @@ -17,18 +17,20 @@ ;;;; with this program. If not, see <http://www.gnu.org/licenses/>. ;;;; -(set! %load-path (append %load-path (list "/usr/local/share/guile-sql"))) -(use-modules (ice-9 getopt-long)) -(use-modules (ice-9 format)) -(use-modules (sql)) +(use-modules (ice-9 getopt-long) + (ice-9 format) + (gamma sql)) ;;; User-definable variables -(define sql-iface "mysql") -(define sql-host "") -(define sql-port 3306) -(define sql-database "whois") -(define sql-username "whois") -(define sql-password "secret") +(define sql-param + (list + (cons #:iface "mysql") + (cons #:host "host.name.com") + (cons #:port 3306) + (cons #:db "whois") + (cons #:username "whois") + (cons #:pass "secret"))) + (define base-domain-list (list "domain.com" "domain.net")) ;;; End of user-definable variables @@ -284,13 +286,11 @@ WHERE domain=\"" key "\"")))) (throw 'whoisd-unknown-option)))))))) (getopt-long (cons "whoisd" command-list) whoisd-grammar)) - (let ((conn (sql-connect - sql-iface sql-host sql-port sql-database - sql-username sql-password))) + (let ((conn (sql-open-connection sql-paramd))) (cond (conn (whois-query out conn key args) - (sql-connect-close conn)) + (sql-close-connection conn)) (else (whois-error out 500 "Database is not available"))))) diff --git a/src/Makefile.am b/src/Makefile.am index 29bf9cb..3f05164 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -1,5 +1,5 @@ -# This file is part of guile-sql. -# Copyright (C) 2002, 2007, Sergey Poznyakoff +# This file is part of Gamma. +# Copyright (C) 2002, 2007, 2010 Sergey Poznyakoff # # This file is free software; as a special exception the author gives # unlimited permission to copy and/or distribute it, with or without @@ -11,17 +11,17 @@ INCLUDES =-I$(top_builddir) -I$(srcdir) -I. @GUILE_INCLUDES@ @INCLUDEPATH@ -LIB_SQL=libguile-sql.la +LIB_SQL=libgamma-sql.la -EXTRA_LTLIBRARIES=libguile-sql.la +EXTRA_LTLIBRARIES=libgamma-sql.la lib_LTLIBRARIES=@BUILD_LIBS@ -libguile_sql_la_LIBADD = @LTLIBOBJS@ @GUILE_LIBS@ -libguile_sql_la_SOURCES=\ +libgamma_sql_la_LIBADD = @LTLIBOBJS@ @GUILE_LIBS@ +libgamma_sql_la_SOURCES=\ gsql_conn.c\ gsql_lib.c -libguile_sql_la_LDFLAGS = -rpath $(libdir) -version-info 0:0:0 +libgamma_sql_la_LDFLAGS = -rpath $(libdir) -version-info 0:0:0 noinst_HEADERS=guile-sql.h app.h EXTRA_DIST=sql.sci @@ -30,7 +30,7 @@ EXTRA_DIST=sql.sci m4 -DVERSION=$(VERSION) -DLIBDIR=$(libdir) \ -DBUILDDIR="`pwd`" $< > $@ -sql.scm: Makefile $(libguile_sql_la_SOURCES:.c=.inc) +sql.scm: Makefile $(libgamma_sql_la_SOURCES:.c=.inc) SCM_SQL=sql.scm X_SQL=gsql_conn.x @@ -74,18 +74,10 @@ MKDEP = $(CC) -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) install-sql-hook: @here=`pwd` cd $(DESTDIR)$(libdir);\ - if test -f libguile-sql.so; then \ - $(LN_S) -f libguile-sql.so libguile-sql-v-$(VERSION).so; \ + if test -f libgamma-sql.so; then \ + $(LN_S) -f libgamma-sql.so libgamma-sql-v-$(VERSION).so; \ fi; \ cd $$here -install-gettext-hook: - @here=`pwd` - cd $(DESTDIR)$(libdir);\ - if test -f libguile-gettext.so; then \ - $(LN_S) -f libguile-gettext.so libguile-gettext-v-$(VERSION).so; \ - fi; \ - cd $$here - install-data-hook: @INSTALL_HOOKS@ - + diff --git a/src/gsql_conn.c b/src/gsql_conn.c index 4a78094..c10b197 100644 --- a/src/gsql_conn.c +++ b/src/gsql_conn.c @@ -63,13 +63,14 @@ sql_connect_print (SCM connect_smob, SCM port, scm_print_state * pstate) if (!conn->data) scm_puts("not connected", port); else { - scm_puts(conn->username, port); + static const char *unspecified = "<unspecified>"; + scm_puts(conn->username ? conn->username : unspecified, port); scm_puts("@", port); - scm_puts(conn->hostname, port); + scm_puts(conn->hostname ? conn->hostname : unspecified, port); scm_puts(":", port); scm_intprint(conn->port, 10, port); scm_puts(" ", port); - scm_puts(conn->database, port); + scm_puts(conn->database ? conn->database : unspecified, port); }; scm_puts (">", port); return 1; @@ -110,70 +111,58 @@ scm_is_sql_connect (SCM scm) /* Interface */ -SCM_DEFINE (sql_connect, "sql-connect", 5, 1, 0, - (SCM IFACE, SCM HOST, SCM PORT, SCM DB, SCM USER, SCM PASS), - "Connect to a database.") -#define FUNC_NAME s_sql_connect +static void +gamma_cvt_iface(SCM inval, void *outval, const char *func_name) { - SCM smob; - const char *hostname; - int port; - const char *dbname; - const char *user; - const char *pass; int iface; - struct sql_connect *conn; - if (scm_is_integer(IFACE)) - iface = scm_to_int(IFACE); - else if (scm_is_string(IFACE)) - iface = sql_find_iface(scm_i_string_chars(IFACE)); - else { - SCM_ASSERT(IFACE == SCM_BOOL_T || IFACE == SCM_BOOL_F, - IFACE, SCM_ARG1, FUNC_NAME); - iface = 0; - } + if (scm_is_integer(inval)) + iface = scm_to_int(inval); + else if (scm_is_string(inval)) { + char *s = scm_to_locale_string(inval); + iface = sql_find_iface(s); + free(s); + } else + SCM_ASSERT(0, inval, SCM_ARG1, func_name); + if (iface < 0 || iface >= num_iface) - scm_misc_error(FUNC_NAME, + scm_misc_error(func_name, "Argument ~S (~S) out of range", scm_list_2(scm_from_int(1), - IFACE)); - - SCM_ASSERT(scm_is_string(HOST), HOST, SCM_ARG1, FUNC_NAME); - hostname = scm_i_string_chars(HOST); + inval)); + *(int*)outval = iface; +} - SCM_ASSERT(scm_is_number(PORT), PORT, SCM_ARG2, FUNC_NAME); - port = scm_to_int(PORT); - - SCM_ASSERT(scm_is_string(DB), DB, SCM_ARG3, FUNC_NAME); - dbname = scm_i_string_chars(DB); - SCM_ASSERT(scm_is_string(USER), USER, SCM_ARG4, FUNC_NAME); - user = scm_i_string_chars(USER); +SCM_DEFINE (sql_open_connection, "sql-open-connection", 1, 0, 0, + (SCM PARAM), + "Connect to a database.") +#define FUNC_NAME s_sql_open_connection +{ + int iface; + + struct gamma_parmdcl dcltab[] = { + { "iface", &iface, gamma_cvt_iface }, + { NULL } + }; + + SCM smob; + struct sql_connect *conn; - if (SCM_UNBNDP(PASS)) - pass = NULL; - else if (scm_is_string(USER)) - pass = scm_i_string_chars(PASS); + SCM_ASSERT(scm_is_pair(PARAM), PARAM, SCM_ARG1, FUNC_NAME); + gamma_parmlist_parse (PARAM, dcltab, + GAMMA_PARMLIST_IGNORE_UNKNOWN, FUNC_NAME); - smob = sql_iftab[iface].connect(hostname, port, - dbname, user, pass, - FUNC_NAME); - - conn = (struct sql_connect *)SCM_CDR(smob); - conn->hostname = strdup(hostname); - conn->port = port; - conn->username = strdup(user); - conn->database = strdup(dbname); + smob = sql_iftab[iface].connect(PARAM, FUNC_NAME); return smob; } #undef FUNC_NAME -SCM_DEFINE (sql_connect_close, "sql-connect-close", 1, 0, 0, +SCM_DEFINE (sql_close_connection, "sql-close-connection", 1, 0, 0, (SCM CONN), "Close connection to a database.") -#define FUNC_NAME s_sql_connect_close +#define FUNC_NAME s_sql_close_connection { struct sql_connect *conn; SCM_ASSERT(scm_is_sql_connect(CONN), CONN, SCM_ARG1, FUNC_NAME); @@ -190,13 +179,16 @@ SCM_DEFINE (sql_query, "sql-query", 2, 0, 0, { struct sql_connect *conn; void *ptr; - const char *query; + char *query; + SCM ret; SCM_ASSERT(scm_is_sql_connect(CONN), CONN, SCM_ARG1, FUNC_NAME); SCM_ASSERT(scm_is_string(QUERY), QUERY, SCM_ARG2, FUNC_NAME); conn = (struct sql_connect *)SCM_CDR(CONN); - query = scm_i_string_chars(QUERY); - return sql_iftab[conn->iface].query(conn, query); + query = scm_to_locale_string(QUERY); + ret = sql_iftab[conn->iface].query(conn, query); + free(query); + return ret; } #undef FUNC_NAME diff --git a/src/gsql_lib.c b/src/gsql_lib.c index a6103b2..842d09a 100644 --- a/src/gsql_lib.c +++ b/src/gsql_lib.c @@ -39,6 +39,71 @@ scm_makenum (unsigned long val) } #endif +static struct gamma_parmdcl * +find_parmdcl(struct gamma_parmdcl *dcl, const char *name) +{ + for (; dcl->name; dcl++) + if (strcmp(dcl->name, name) == 0) + return dcl; + return 0; +} + +void +gamma_parmlist_parse(SCM parmlist, struct gamma_parmdcl *dcltab, + int flags, const char *func_name) +{ + SCM elt; + + for (elt = parmlist; elt != SCM_EOL; elt = SCM_CDR(elt)) { + SCM pair = SCM_CAR(elt); + SCM kw; + char *str; + struct gamma_parmdcl *p; + + SCM_ASSERT(scm_is_pair(pair), pair, SCM_ARG1, func_name); + + kw = SCM_CAR(pair); + SCM_ASSERT(scm_is_keyword(kw), kw, SCM_ARG1, func_name); + + str = scm_to_locale_string + (scm_symbol_to_string(scm_keyword_to_symbol(kw))); + + p = find_parmdcl(dcltab, str); + free(str); + if (!p) { + if (flags & GAMMA_PARMLIST_IGNORE_UNKNOWN) + continue; + if (flags & GAMMA_PARMLIST_WARN_UNKNOWN) { + scm_simple_format + (scm_current_error_port (), + scm_makfrom0str("~S: undefined keyword: ~S~%"), + scm_list_2(scm_makfrom0str(func_name), + kw)); + continue; + } + scm_misc_error(func_name, + "Unknown keyword: ~S", + scm_list_1(kw)); + } + if (p->cvt) + p->cvt(SCM_CDR(pair), p->valptr, func_name); + } +} + +void +gamma_cvt_string(SCM inval, void *outval, const char *func_name) +{ + SCM_ASSERT(scm_is_string(inval), inval, SCM_ARGn, func_name); + *(char**)outval = scm_to_locale_string(inval); +} + +void +gamma_cvt_int(SCM inval, void *outval, const char *func_name) +{ + SCM_ASSERT(scm_is_number(inval), inval, SCM_ARGn, func_name); + *(int*)outval = scm_to_int(inval); +} + extern void sql_init() { diff --git a/src/guile-sql.h b/src/guile-sql.h index 3c32326..6bf3924 100644 --- a/src/guile-sql.h +++ b/src/guile-sql.h @@ -40,15 +40,27 @@ struct sql_iface { char *name; SCM (*mark) (struct sql_connect *); scm_sizet (*free) (struct sql_connect *); - SCM (*connect) (const char *hostname, int port, - const char *dbname, const char *user, - const char *pass, const char *why); + SCM (*connect) (SCM parmlist, const char *func_name); void (*close) (struct sql_connect *); SCM (*query) (struct sql_connect *, const char *query); }; extern SCM gsql_error; -SCM sql_connect_create (char *name); -SCM scm_makenum (unsigned long val); +struct gamma_parmdcl { + const char *name; + void *valptr; + void (*cvt) (SCM inval, void *outval, const char *func_name); +}; + +#define GAMMA_PARMLIST_IGNORE_UNKNOWN 0x0001 +#define GAMMA_PARMLIST_WARN_UNKNOWN 0x0002 + +SCM sql_connect_create(char *name); +SCM scm_makenum(unsigned long val); +void gamma_parmlist_parse(SCM parmlist, + struct gamma_parmdcl *dcltab, int flags, + const char *func_name); +void gamma_cvt_string(SCM inval, void *outval, const char *func_name); +void gamma_cvt_int(SCM inval, void *outval, const char *func_name); diff --git a/src/mysql.c b/src/mysql.c index ac7e0f7..3d63ec3 100644 --- a/src/mysql.c +++ b/src/mysql.c @@ -38,36 +38,89 @@ s_mysql_free(struct sql_connect *conn) } static SCM -s_mysql_connect (const char *hostname, int port, - const char *dbname, const char *user, const char *pass, - const char *why) +s_mysql_connect (SCM parmlist, const char *func_name) { - MYSQL *mysql; + char *hostname = NULL; + int port = 0; + char *dbname = NULL; + char *user = NULL; + char *pass = NULL; + char *socket_path = NULL; + char *ssl_cert = NULL; + char *config_file = NULL; + char *config_group = NULL; + struct gamma_parmdcl dcltab[] = { + { "iface", NULL, NULL }, + { "host", &hostname, gamma_cvt_string }, + { "socket", &socket_path, gamma_cvt_string }, + { "port", &port, gamma_cvt_int }, + { "db", &dbname, gamma_cvt_string }, + { "user", &user, gamma_cvt_string }, + { "pass", &pass, gamma_cvt_string }, + { "ssl-cert", &ssl_cert, gamma_cvt_string }, + { "config-file", &config_file, gamma_cvt_string }, + { "config-group", &config_group, gamma_cvt_string }, + { NULL } + }; + + MYSQL *mysql, *mp; SCM smob; struct sql_connect *conn; - const char *socket_path = NULL; + + gamma_parmlist_parse (parmlist, dcltab, 0, func_name); mysql = mysql_init(NULL); + if (!mysql) scm_throw(gsql_error, scm_list_2(scm_makfrom0str("mysql_init() failed"), scm_makfrom0str(""))); - - if (hostname[0] == '/') { + + if (hostname && hostname[0] == '/') { socket_path = hostname; - hostname = "localhost"; + hostname = strdup ("localhost"); + } + + if (config_file) { + mysql_options (mysql, MYSQL_READ_DEFAULT_FILE, config_file); + free(config_file); + } + if (config_group) { + mysql_options (mysql, MYSQL_READ_DEFAULT_GROUP, config_group); + free(config_group); + } + if (ssl_cert) { + mysql_ssl_set (mysql, NULL, NULL, ssl_cert, NULL, NULL); + free(ssl_cert); } - if (!mysql_real_connect(mysql, hostname, + + mp = mysql_real_connect(mysql, hostname, user, pass, dbname, - port, socket_path, 0)) { - SCM args = scm_list_2(scm_makfrom0str("Cannot connect to the database"), - scm_makfrom0str(mysql_error(mysql))); + port, socket_path, + CLIENT_MULTI_RESULTS); + free(socket_path); + + if (!mp) { + SCM args; + + free(hostname); + free(user); + free(pass); + free(dbname); + + args = scm_list_2(scm_makfrom0str("Cannot connect to the database"), + scm_makfrom0str(mysql_error(mysql))); mysql_close(mysql); + scm_throw(gsql_error, args); } smob = sql_connect_create("mysql"); conn = (struct sql_connect *)SCM_CDR(smob); + conn->hostname = hostname; + conn->port = port; + conn->username = user; + conn->database = dbname; conn->data = mysql; return smob; } diff --git a/src/pgsql.c b/src/pgsql.c index 011a4b7..398cacc 100644 --- a/src/pgsql.c +++ b/src/pgsql.c @@ -38,26 +38,49 @@ s_pgsql_free(struct sql_connect *conn) } static SCM -s_pgsql_connect (const char *hostname, int port, - const char *dbname, const char *user, const char *pass, - const char *why) +s_pgsql_connect (SCM parmlist, const char *func_name) { + char *hostname = NULL; + char *port = NULL; + char *dbname = NULL; + char *user = NULL; + char *pass = NULL; + struct gamma_parmdcl dcltab[] = { + { "iface", NULL, NULL }, + { "host", &hostname, gamma_cvt_string }, + { "port", &port, gamma_cvt_string }, + { "db", &dbname, gamma_cvt_string }, + { "user", &user, gamma_cvt_string }, + { "pass", &pass, gamma_cvt_string }, + { NULL } + }; + PGconn *pgconn; - char buf[24]; SCM smob; struct sql_connect *conn; - snprintf(buf, sizeof buf, "%d", port); - pgconn = PQsetdbLogin(hostname, buf, NULL, NULL, dbname, user, pass); + pgconn = PQsetdbLogin(hostname, port, NULL, NULL, dbname, user, pass); + if (PQstatus(pgconn) == CONNECTION_BAD) { - SCM args = scm_list_2(scm_makfrom0str("Cannot connect to the database"), - scm_makfrom0str(PQerrorMessage(pgconn))); + SCM args; + + free(hostname); + free(port); + free(user); + free(pass); + + args = scm_list_2(scm_makfrom0str("Cannot connect to the database"), + scm_makfrom0str(PQerrorMessage(pgconn))); PQfinish(pgconn); scm_throw(gsql_error, args); } smob = sql_connect_create("pgsql"); conn = (struct sql_connect *)SCM_CDR(smob); + conn->hostname = hostname; + conn->port = atoi (port); + conn->username = user; + conn->database = dbname; conn->data = pgconn; return smob; } diff --git a/src/sql.sci b/src/sql.sci index dff0abb..573e059 100644 --- a/src/sql.sci +++ b/src/sql.sci @@ -1,6 +1,6 @@ ;;;; -*- scheme -*- ;;;; This file is part of guile-sql. -;;;; Copyright (C) 2002, 2008 Sergey Poznyakoff +;;;; Copyright (C) 2002, 2008, 2010 Sergey Poznyakoff ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -24,7 +24,7 @@ changequote([,])dnl (let ((lib-path "LIBDIR/")) (load-extension (string-append - lib-path "libguile-sql-v-VERSION") "sql_init")) + lib-path "libgamma-sql-v-VERSION") "sql_init")) include(BUILDDIR/gsql_lib.inc) include(BUILDDIR/gsql_conn.inc) @@ -50,4 +50,17 @@ include(BUILDDIR/gsql_conn.inc) ((sql-ignore-failure expr) (sql-ignore-failure (#f) expr)))) +;;;; For compatibility with v. 1.1 +(define-public (sql-connect iface host port db user pass) + (sql-open-connection (list + (cons #:iface iface) + (cons #:host host) + (cons #:port port) + (cons #:db db) + (cons #:user user) + (cons #:pass pass)))) + +(define-public (sql-connect-close conn) + (sql-close-connection conn)) + ;;;; End of sql.scm |