From 9339b8ad47f5ae70ac1567a3b87caadd78ed022a Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Thu, 6 Dec 2001 17:36:21 +0000 Subject: Initial revision --- m4/guile.m4 | 67 ++++++++++++++ m4/lib.m4 | 26 ++++++ scripts/Makefile.am | 16 ++++ scripts/Makefile.in | 201 +++++++++++++++++++++++++++++++++++++++++ scripts/guile-doc-snarf | 57 ++++++++++++ scripts/guile-func-name-check | 64 +++++++++++++ scripts/guile-snarf.awk | 98 ++++++++++++++++++++ src/app.h | 6 ++ src/gsql_conn.c | 205 ++++++++++++++++++++++++++++++++++++++++++ src/gsql_lib.c | 47 ++++++++++ src/guile-sql.h | 33 +++++++ src/mysql.c | 131 +++++++++++++++++++++++++++ src/pgsql.c | 140 +++++++++++++++++++++++++++++ 13 files changed, 1091 insertions(+) create mode 100644 m4/guile.m4 create mode 100644 m4/lib.m4 create mode 100644 scripts/Makefile.am create mode 100644 scripts/Makefile.in create mode 100755 scripts/guile-doc-snarf create mode 100755 scripts/guile-func-name-check create mode 100755 scripts/guile-snarf.awk create mode 100644 src/app.h create mode 100644 src/gsql_conn.c create mode 100644 src/gsql_lib.c create mode 100644 src/guile-sql.h create mode 100644 src/mysql.c create mode 100644 src/pgsql.c diff --git a/m4/guile.m4 b/m4/guile.m4 new file mode 100644 index 0000000..bec442e --- /dev/null +++ b/m4/guile.m4 @@ -0,0 +1,67 @@ +dnl This file is part of GNU RADIUS. +dnl Copyright (C) 2001, Sergey Poznyakoff +dnl +dnl This program is free software; you can redistribute it and/or modify +dnl it under the terms of the GNU General Public License as published by +dnl the Free Software Foundation; either version 2 of the License, or +dnl (at your option) any later version. +dnl +dnl This program is distributed in the hope that it will be useful, +dnl but WITHOUT ANY WARRANTY; without even the implied warranty of +dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +dnl GNU General Public License for more details. +dnl +dnl You should have received a copy of the GNU General Public License +dnl along with this program; if not, write to the Free Software +dnl Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +dnl +AC_DEFUN(rad_CHECK_GUILE, +[ + if test "x$rad_cv_lib_guile" = x; then + cached="" + AC_PATH_PROG(GUILE_CONFIG, guile-config, no, $PATH) + if test $GUILE_CONFIG = no; then + rad_cv_lib_guile=no + else + GUILE_INCLUDES=`guile-config compile` + GUILE_LIBS=`guile-config link` + fi + + if test $GUILE_CONFIG != no; then + AC_MSG_CHECKING(for guile version 1.4 or higher) + GV=`$GUILE_CONFIG --version 2>&1|sed -n 's/guile-config - Guile version \([[0-9]][[0-9]]*\)\.\([[0-9]][[0-9]]*\).*/\1\2/p'` + case "x$GV" in + x[[0-9]]*) + if test $GV -lt 14; then + AC_MSG_RESULT(Nope. Version number too low.) + rad_cv_lib_guile=no + else + AC_MSG_RESULT(OK) + save_LIBS=$LIBS + save_CFLAGS=$CFLAGS + LIBS="$LIBS $GUILE_LIBS" + CFLAGS="$CFLAGS $GUILE_INCLUDES" + AC_TRY_LINK([#include ], + void main(argc, argv) int argc; char **argv; + { ifelse([$1], , scm_shell(argc, argv);, [$1]) }, + [rad_cv_lib_guile=yes], + [rad_cv_lib_guile=no]) + LIBS=$save_LIBS + CFLAGS=$save_CFLAGS + fi ;; + *) AC_MSG_RESULT(Nope. Unknown version number) + rad_cv_lib_guile=no;; + esac + fi + else + cached=" (cached) " + GUILE_INCLUDES=`guile-config compile` + GUILE_LIBS=`guile-config link` + fi + AC_MSG_CHECKING(whether to build guile support) + rad_RESULT_ACTIONS([rad_cv_lib_guile],[LIBGUILE],[$2],[$3]) + AC_MSG_RESULT(${cached}$rad_cv_lib_guile) +]) + + + diff --git a/m4/lib.m4 b/m4/lib.m4 new file mode 100644 index 0000000..684d6be --- /dev/null +++ b/m4/lib.m4 @@ -0,0 +1,26 @@ +dnl Arguments: +dnl $1 -- Library to look for +dnl $2 -- Function to check in the library +dnl $3 -- Any additional libraries that might be needed +dnl $4 -- Action to be taken when test succeeds +dnl $5 -- Action to be taken when test fails +dnl $6 -- Directories where the library may reside +AC_DEFUN(rad_CHECK_LIB, +[ + save_LIBS=$LIBS + AC_CACHE_CHECK([for -l$1], rad_cv_lib_$1, + [ + for path in $6 + do + LIBS="$save_LIBS -L$path" + AC_CHECK_LIB($1, $2, + [rad_cv_lib_$1="$3 -L$path -l$1" + break], + [rad_cv_lib_$1=no],$3) + done + ]) + rad_RESULT_ACTIONS([rad_cv_lib_$1],[LIB$1],[$4],[$5]) + LIBS=$save_LIBS +]) + + diff --git a/scripts/Makefile.am b/scripts/Makefile.am new file mode 100644 index 0000000..f3d32f6 --- /dev/null +++ b/scripts/Makefile.am @@ -0,0 +1,16 @@ +# $Id: Makefile.am,v 1.1 2001/12/06 17:36:21 gray Exp $ +# This file is part of GNU RADIUS. +# Copyright (C) 2000,2001, 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 +# modifications, as long as this notice is preserved. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY, to the extent permitted by law; without even the +# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +EXTRA_DIST = \ + guile-doc-snarf\ + guile-func-name-check\ + guile-snarf.awk diff --git a/scripts/Makefile.in b/scripts/Makefile.in new file mode 100644 index 0000000..fb4af45 --- /dev/null +++ b/scripts/Makefile.in @@ -0,0 +1,201 @@ +# Makefile.in generated automatically by automake 1.4 from Makefile.am + +# Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +# $Id: Makefile.in,v 1.1 2001/12/06 17:36:21 gray Exp $ +# This file is part of GNU RADIUS. +# Copyright (C) 2000,2001, 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 +# modifications, as long as this notice is preserved. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY, to the extent permitted by law; without even the +# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + +SHELL = @SHELL@ + +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ +VPATH = @srcdir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ + +bindir = @bindir@ +sbindir = @sbindir@ +libexecdir = @libexecdir@ +datadir = @datadir@ +sysconfdir = @sysconfdir@ +sharedstatedir = @sharedstatedir@ +localstatedir = @localstatedir@ +libdir = @libdir@ +infodir = @infodir@ +mandir = @mandir@ +includedir = @includedir@ +oldincludedir = /usr/include + +DESTDIR = + +pkgdatadir = $(datadir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ + +top_builddir = .. + +ACLOCAL = @ACLOCAL@ +AUTOCONF = @AUTOCONF@ +AUTOMAKE = @AUTOMAKE@ +AUTOHEADER = @AUTOHEADER@ + +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ $(AM_INSTALL_PROGRAM_FLAGS) +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +transform = @program_transform_name@ + +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_alias = @build_alias@ +build_triplet = @build@ +host_alias = @host_alias@ +host_triplet = @host@ +target_alias = @target_alias@ +target_triplet = @target@ +AS = @AS@ +AWK = @AWK@ +CC = @CC@ +CPP = @CPP@ +DLLTOOL = @DLLTOOL@ +GUILE_CONFIG = @GUILE_CONFIG@ +GUILE_INCLUDES = @GUILE_INCLUDES@ +GUILE_LIBS = @GUILE_LIBS@ +INCLUDEPATH = @INCLUDEPATH@ +LIBOBJS = @LIBOBJS@ +LIBTOOL = @LIBTOOL@ +LN_S = @LN_S@ +MAKEINFO = @MAKEINFO@ +OBJDUMP = @OBJDUMP@ +PACKAGE = @PACKAGE@ +RANLIB = @RANLIB@ +U = @U@ +VERSION = @VERSION@ + +EXTRA_DIST = guile-doc-snarf guile-func-name-check guile-snarf.awk + +mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs +CONFIG_HEADER = ../config.h +CONFIG_CLEAN_FILES = +DIST_COMMON = Makefile.am Makefile.in + + +DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST) + +TAR = tar +GZIP_ENV = --best +all: all-redirect +.SUFFIXES: +$(srcdir)/Makefile.in: Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) + cd $(top_srcdir) && $(AUTOMAKE) --gnu --include-deps scripts/Makefile + +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + cd $(top_builddir) \ + && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status + +tags: TAGS +TAGS: + + +distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir) + +subdir = scripts + +distdir: $(DISTFILES) + @for file in $(DISTFILES); do \ + d=$(srcdir); \ + if test -d $$d/$$file; then \ + cp -pr $$d/$$file $(distdir)/$$file; \ + else \ + test -f $(distdir)/$$file \ + || ln $$d/$$file $(distdir)/$$file 2> /dev/null \ + || cp -p $$d/$$file $(distdir)/$$file || :; \ + fi; \ + done +info-am: +info: info-am +dvi-am: +dvi: dvi-am +check-am: all-am +check: check-am +installcheck-am: +installcheck: installcheck-am +install-exec-am: +install-exec: install-exec-am + +install-data-am: +install-data: install-data-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am +install: install-am +uninstall-am: +uninstall: uninstall-am +all-am: Makefile +all-redirect: all-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) AM_INSTALL_PROGRAM_FLAGS=-s install +installdirs: + + +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -rm -f Makefile $(CONFIG_CLEAN_FILES) + -rm -f config.cache config.log stamp-h stamp-h[0-9]* + +maintainer-clean-generic: +mostlyclean-am: mostlyclean-generic + +mostlyclean: mostlyclean-am + +clean-am: clean-generic mostlyclean-am + +clean: clean-am + +distclean-am: distclean-generic clean-am + -rm -f libtool + +distclean: distclean-am + +maintainer-clean-am: maintainer-clean-generic distclean-am + @echo "This command is intended for maintainers to use;" + @echo "it deletes files that may require special tools to rebuild." + +maintainer-clean: maintainer-clean-am + +.PHONY: tags distdir info-am info dvi-am dvi check check-am \ +installcheck-am installcheck install-exec-am install-exec \ +install-data-am install-data install-am install uninstall-am uninstall \ +all-redirect all-am all installdirs mostlyclean-generic \ +distclean-generic clean-generic maintainer-clean-generic clean \ +mostlyclean distclean maintainer-clean + + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/scripts/guile-doc-snarf b/scripts/guile-doc-snarf new file mode 100755 index 0000000..16f739c --- /dev/null +++ b/scripts/guile-doc-snarf @@ -0,0 +1,57 @@ +#! /bin/sh +# Extract the initialization actions for builtin things. +# +# Copyright (C) 1999, 2000 Free Software Foundation, Inc. +# +# 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 Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this software; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place, Suite 330, +# Boston, MA 02111-1307 USA +# +## For some obscure reason, the original guile-doc-snarf distributed +## with guile up to version 1.4, passes guile-func-name-check +## to awk without absolute path spec. Consequently the script bails +## out unless guile-func-name-check is in the current directory. +## This version assumes that both scripts live in the same directory +## and deduces the path to guile-func-name-check from the own pathname. +## --gray + +fullfilename=$1; shift + +# strip path to source directory +filename=`basename $fullfilename` + +# we need to be sure that the .x file exists +# since the .c/.cc file may include it +# (the old guile-snarf did not have this problem +# because the makefile redirects output to the .x file +# which creates the file before the inclusion occurs) +# --12/12/99 gjb +no_ext=`echo $filename | sed 's/\.[^.]*$//g'` +dot_doc=${no_ext}.doc + +temp="/tmp/snarf.$$" +trap "rm -f $temp" 0 1 2 15 + +## Let the user override the preprocessor & awk autoconf found. +test -n "${CPP+set}" || CPP="gcc -E" +test -n "${AWK+set}" || AWK="gawk" + +## Must run guile-func-name-check on the unpreprocessed source +${AWK} -f `dirname $0`/guile-func-name-check "$fullfilename" + +## We must use a temporary file here, instead of a pipe, because we +## need to know if CPP exits with a non-zero status. +${CPP} -DSCM_MAGIC_SNARFER "$@" > ${temp} || exit $? +cat ${temp} | sed 's/^\(.\{128\}.\{128\}.\{128\}.\{128\}.\{128\}.\{128\}.\{128\}.\{128\}\).*/\1/g' | \ +${AWK} -f `dirname $0`/guile-snarf.awk `basename ${dot_doc}` diff --git a/scripts/guile-func-name-check b/scripts/guile-func-name-check new file mode 100755 index 0000000..86b00ae --- /dev/null +++ b/scripts/guile-func-name-check @@ -0,0 +1,64 @@ +#! /usr/bin/awk -f +# +# Copyright (C) 2000 Free Software Foundation, Inc. +# +# 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 Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this software; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place, Suite 330, +# Boston, MA 02111-1307 USA +# +# Written by Greg J. Badros, +# 11-Jan-2000 + +BEGIN { + filename = ARGV[1]; +} + +/^SCM_DEFINE/ { + func_name = $0; + sub(/^[^\(\n]*\([ \t]*/,"", func_name); + sub(/[ \t]*,.*/,"", func_name); +# print func_name; # GJB:FIXME:: flag to do this to list primitives? + in_a_func = 1; +} + +in_a_func && /^\{/ { + if (!match(last_line,/^#define[ \t]+FUNC_NAME[ \t]+/)) { + printf filename ":" NR ":***" > "/dev/stderr"; + print "Missing or erroneous `#define FUNC_NAME s_" func_name "'" > "/dev/stderr"; + } else { + sub(/^#define[ \t]+FUNC_NAME[ \t]+s_/, "", last_line); + sub(/[ \t]*$/,"",last_line); + if (last_line != func_name) { + printf filename ":" NR ":***" > "/dev/stderr"; + print "Mismatching FUNC_NAME. Should be: `#define FUNC_NAME s_" func_name "'" > "/dev/stderr"; + } + } +} + +1 == next_line_better_be_undef { + if (!match($0,/^#undef FUNC_NAME[ \t]*$/)) { + printf filename ":" NR ":***" > "/dev/stderr"; + print "Missing or erroneous #undef for " func_name ": " + "Got `" $0 "' instead." > "/dev/stderr"; + } + in_a_func = ""; + func_name = ""; + next_line_better_be_undef = 0; +} + +in_a_func && /^\}/ { + next_line_better_be_undef = 1; +} + +{ last_line = $0; } diff --git a/scripts/guile-snarf.awk b/scripts/guile-snarf.awk new file mode 100755 index 0000000..bd016ef --- /dev/null +++ b/scripts/guile-snarf.awk @@ -0,0 +1,98 @@ +# Copyright (C) 1999, 2000 Free Software Foundation, Inc. +# +# 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 Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this software; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place, Suite 330, +# Boston, MA 02111-1307 USA +# +# Written by Greg J. Badros, +# 12-Dec-1999 + +BEGIN { FS="|"; + dot_doc_file = ARGV[1]; ARGV[1] = "-"; + std_err = "/dev/stderr"; + # be sure to put something in the files to help make out + print ""; + printf "" > dot_doc_file; +} + +/^[ \t]*SCM__I/ { copy = $0; + gsub(/[ \t]*SCM__I/, "", copy); + gsub(/SCM__D.*$/, "", copy); + print copy; } + +/SCM__D/,/SCM__S/ { copy = $0; + if (match(copy,/SCM__DR/)) { registering = 1; } + else {registering = 0; } + gsub(/.*SCM__D./,"", copy); + gsub(/SCM__S.*/,"",copy); + gsub(/[ \t]+/," ", copy); + sub(/^[ \t]*/,"(", copy); + gsub(/\"/,"",copy); + sub(/\([ \t]*void[ \t]*\)/,"()", copy); + sub(/ \(/," ",copy); + numargs = gsub(/SCM /,"", copy); + numcommas = gsub(/,/,"", copy); + numactuals = $2 + $3 + $4; + location = $5; + gsub(/\"/,"",location); + sub(/^[ \t]*/,"",location); + sub(/[ \t]*$/,"",location); + sub(/: /,":",location); + # Now whittle copy down to just the $1 field + # (but do not use $1, since it hasn't been + # altered by the above regexps) + gsub(/[ \t]*\|.*$/,"",copy); + sub(/ \)/,")",copy); + # Now `copy' contains the nice scheme proc "prototype", e.g. + # (set-car! pair value) + # print copy > "/dev/stderr"; # for debugging + proc_and_args = copy; + curr_function_proto = copy; + sub(/[^ \n]* /,"",proc_and_args); + sub(/\)[ \t]*/,"",proc_and_args); + split(proc_and_args,args," "); + # now args is an array of the arguments + # args[1] is the formal name of the first argument, etc. + if (numargs != numactuals && !registering) + { print location ":*** `" copy "' is improperly registered as having " numactuals " arguments" > std_err; } + print " \n" copy (registering?")":"") > dot_doc_file ; } + +/SCM__S/,/SCM__E.*$/ { copy = $0; + gsub(/.*SCM__S/,"",copy); + sub(/^[ \t]*"?/,"", copy); + sub(/\"?[ \t]*SCM__E.*$/,"", copy); + gsub(/\\n\\n"?/,"\n",copy); + gsub(/\\n"?[ \t]*$/,"",copy); + gsub(/\\\"[ \t]*$/,"\"",copy); + gsub(/[ \t]*$/,"", copy); + if (copy != "") { print copy > dot_doc_file } + } + +/SCM__E[ \t]/ { print "[" location "]" >> dot_doc_file; } + +/\*&\*&\*&\*SCM_ARG_BETTER_BE_IN_POSITION/ { copy = $0; + sub(/.*\*&\*&\*&\*SCM_ARG_BETTER_BE_IN_POSITION\([ \t]*/,"",copy); + if (copy ~ /\"/) { next } + gsub(/[ \t]*,[ \t]*/,":",copy); + sub(/[ \t]*\).*/,"",copy); + split(copy,argpos,":"); + argname = argpos[1]; + pos = argpos[2]; + if (pos ~ /[A-Za-z]/) { next } + if (pos ~ /^[ \t]*$/) { next } + if (argname ~ / /) { next } + line = argpos[3]; +# print pos " " args[pos] " vs. " argname > "/dev/stderr"; + if (args[pos] != argname) { print filename ":" line ":*** Argument name/number mismatch in `" curr_function_proto "' -- " argname " is not formal #" pos > "/dev/stderr"; } + } diff --git a/src/app.h b/src/app.h new file mode 100644 index 0000000..7b7358a --- /dev/null +++ b/src/app.h @@ -0,0 +1,6 @@ +#ifdef USE_SQL_MYSQL +extern struct sql_iface mysql_iface; +#endif +#ifdef USE_SQL_PGSQL +extern struct sql_iface pgsql_iface; +#endif diff --git a/src/gsql_conn.c b/src/gsql_conn.c new file mode 100644 index 0000000..a61f8f6 --- /dev/null +++ b/src/gsql_conn.c @@ -0,0 +1,205 @@ +#ifdef HAVE_CONFIG_H +# include +#endif +#include +#include +#include + +int num_iface; +struct sql_iface sql_iftab[MAX_IFACES]; + +long sql_connect_tag; + +/* SMOB functions: */ +static SCM +sql_connect_mark (SCM connect_smob) +{ + struct sql_connect *conn = (struct sql_connect *)SCM_CDR(connect_smob); + return sql_iftab[conn->iface].mark(conn); +} + +static scm_sizet +sql_connect_free (SCM connect_smob) +{ + scm_sizet size = sizeof(struct sql_connect); + struct sql_connect *conn = (struct sql_connect *)SCM_CDR(connect_smob); + size += sql_iftab[conn->iface].free(conn); + if (conn->hostname) + free(conn->hostname); + if (conn->username) + free(conn->username); + if (conn->database) + free(conn->database); + free(conn); + return size; +} + +static int +sql_connect_print (SCM connect_smob, SCM port, scm_print_state * pstate) +{ + struct sql_connect *conn = (struct sql_connect *)SCM_CDR(connect_smob); + scm_puts("#iface].name, port); + scm_puts(")", port); + if (!conn->data) + scm_puts("not connected", port); + else { + scm_puts(conn->username, port); + scm_puts("@", port); + scm_puts(conn->hostname, port); + scm_puts(":", port); + scm_intprint(conn->port, 10, port); + scm_puts(" ", port); + scm_puts(conn->database, port); + }; + scm_puts (">", port); + return 1; +} + +int +sql_find_iface(char *name) +{ + int iface; + + for (iface = 0; iface < num_iface; iface++) + if (strcmp(sql_iftab[iface].name, name) == 0) + return iface; + return -1; +} + +SCM +sql_connect_create (char *name) +{ + struct sql_connect *conn; + int iface = sql_find_iface(name); + if (iface < 0) + scm_misc_error("sql_connect_create", + "Unknown SQL interface ~S", + SCM_LIST1(scm_makfrom0str(name))); + + conn = scm_must_malloc (sizeof (*conn), "sql_connect"); + memset(conn, 0, sizeof *conn); + conn->iface = iface; + SCM_RETURN_NEWSMOB (sql_connect_tag, conn); +} + +int +scm_is_sql_connect (SCM scm) +{ + return SCM_NIMP (scm) && SCM_CAR (scm) == sql_connect_tag; +} + +/* Interface */ + +SCM_DEFINE (sql_connect_internal, "sql-connect-internal", 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_internal +{ + SCM smob; + char *hostname; + int port; + char *dbname; + char *user; + char *pass; + int iface; + + if (SCM_IMP(IFACE) && SCM_INUMP(IFACE)) + iface = SCM_INUM(IFACE); + else if (SCM_STRINGP(IFACE)) + iface = sql_find_iface(SCM_CHARS(IFACE)); + else { + SCM_ASSERT(IFACE == SCM_BOOL_T || IFACE == SCM_BOOL_F, + IFACE, SCM_ARG1, FUNC_NAME); + iface = 0; + } + if (iface < 0 || iface >= num_iface) + scm_misc_error(FUNC_NAME, + "Argument ~S (~S) out of range", + SCM_LIST2(SCM_MAKINUM(1), + IFACE)); + + SCM_ASSERT(SCM_STRINGP(HOST), HOST, SCM_ARG1, FUNC_NAME); + hostname = SCM_ROCHARS(HOST); + + SCM_ASSERT(SCM_IMP(PORT) && SCM_INUMP(PORT), + PORT, SCM_ARG2, FUNC_NAME); + port = SCM_INUM(PORT); + + SCM_ASSERT(SCM_STRINGP(DB), DB, SCM_ARG3, FUNC_NAME); + dbname = SCM_ROCHARS(DB); + + SCM_ASSERT(SCM_STRINGP(USER), USER, SCM_ARG4, FUNC_NAME); + user = SCM_ROCHARS(USER); + + if (SCM_UNBNDP(PASS)) + pass = NULL; + else if (SCM_STRINGP(USER)) + pass = SCM_ROCHARS(PASS); + + smob = sql_iftab[iface].connect(hostname, port, + dbname, user, pass, + FUNC_NAME); + if (smob != SCM_BOOL_F) { + struct sql_connect *conn = (struct sql_connect *)SCM_CDR(smob); + conn->hostname = strdup(hostname); + conn->port = port; + conn->username = strdup(user); + conn->database = strdup(dbname); + } + return smob; +} +#undef FUNC_NAME + +SCM_DEFINE (sql_connect_close, "sql-connect-close", 1, 0, 0, + (SCM CONN), + "Close connection to a database.") +#define FUNC_NAME s_sql_connect_close +{ + struct sql_connect *conn; + SCM_ASSERT(scm_is_sql_connect(CONN), CONN, SCM_ARG1, FUNC_NAME); + conn = (struct sql_connect *)SCM_CDR(CONN); + sql_iftab[conn->iface].close(conn); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +SCM_DEFINE (sql_query_internal, "sql-query-internal", 2, 0, 0, + (SCM CONN, SCM QUERY), + "Run an SQL query") +#define FUNC_NAME s_sql_query_internal +{ + struct sql_connect *conn; + void *ptr; + char *query; + + SCM_ASSERT(scm_is_sql_connect(CONN), CONN, SCM_ARG1, FUNC_NAME); + SCM_ASSERT(SCM_STRINGP(QUERY), QUERY, SCM_ARG2, FUNC_NAME); + conn = (struct sql_connect *)SCM_CDR(CONN); + query = SCM_ROCHARS(QUERY); + return sql_iftab[conn->iface].query(conn, query); +} +#undef FUNC_NAME + +int +sql_register_iface(struct sql_iface *ifp) +{ + if (num_iface >= MAX_IFACES) + scm_misc_error("sql_register_iface", + "Too many ifaces registered", + SCM_EOL); + memcpy(&sql_iftab[num_iface], ifp, sizeof sql_iftab[0]); + sql_iftab[num_iface].name = strdup(ifp->name); + return num_iface++; +} + +void +gsql_conn_init() +{ + sql_connect_tag = scm_make_smob_type ("sql_connect", + sizeof (struct sql_connect)); + scm_set_smob_mark (sql_connect_tag, sql_connect_mark); + scm_set_smob_free (sql_connect_tag, sql_connect_free); + scm_set_smob_print (sql_connect_tag, sql_connect_print); +#include +} diff --git a/src/gsql_lib.c b/src/gsql_lib.c new file mode 100644 index 0000000..fa28047 --- /dev/null +++ b/src/gsql_lib.c @@ -0,0 +1,47 @@ +#ifdef HAVE_CONFIG_H +# include +#endif +#include +#include + +SCM +scm_makenum (unsigned long val) +{ + if (SCM_FIXABLE ((long) val)) + return SCM_MAKINUM (val); + +#ifdef SCM_BIGDIG + return scm_long2big (val); +#else /* SCM_BIGDIG */ + return scm_make_real ((double) val); +#endif /* SCM_BIGDIG */ +} + +/* + * Chop off trailing whitespace. Return length of the resulting string + */ +int +chop(char *str) +{ + int len; + + for (len = strlen(str); len > 0 && isspace(str[len-1]); len--) + ; + str[len] = 0; + return len; +} + + + +extern void +gsql_init() +{ + gsql_conn_init(); +#ifdef USE_SQL_MYSQL + sql_register_iface(&mysql_iface); +#endif +#ifdef USE_SQL_PGSQL + sql_register_iface(&pgsql_iface); +#endif +} + diff --git a/src/guile-sql.h b/src/guile-sql.h new file mode 100644 index 0000000..64fd0eb --- /dev/null +++ b/src/guile-sql.h @@ -0,0 +1,33 @@ +#include +#include +#include +#include + +#define MAX_IFACES 32 + +struct sql_connect { + int iface; + char *hostname; + struct in_addr hostaddr; + int port; + char *username; + char *database; + void *data; +}; + +struct sql_result { + SCM owner; + void *data; +}; + +struct sql_iface { + char *name; + SCM (*mark) (struct sql_connect *); + scm_sizet (*free) (struct sql_connect *); + SCM (*connect) (char *hostname, int port, + char *dbname, char *user, char *pass, char *why); + void (*close) (struct sql_connect *); + SCM (*query) (struct sql_connect *, char *query); +}; + +extern struct sql_iface sql_iftab[]; diff --git a/src/mysql.c b/src/mysql.c new file mode 100644 index 0000000..8491bb4 --- /dev/null +++ b/src/mysql.c @@ -0,0 +1,131 @@ +#ifdef HAVE_CONFIG_H +# include +#endif +#include +#include +#include + +SCM +s_mysql_mark(struct sql_connect *conn) +{ + return SCM_BOOL_F; +} + +scm_sizet +s_mysql_free(struct sql_connect *conn) +{ + MYSQL *mysql = (MYSQL*) conn->data; + if (!mysql) + return 0; + mysql_close(mysql); + free(mysql); + return sizeof(MYSQL); +} + +SCM +s_mysql_connect (char *hostname, int port, + char *dbname, char *user, char *pass, char *why) +{ + MYSQL *mysql; + SCM smob; + struct sql_connect *conn; + + mysql = mysql_init(NULL); + if (!mysql) + return SCM_BOOL_F; + if (!mysql_real_connect(mysql, hostname, + user, pass, dbname, + port, NULL, 0)) { + mysql_close(mysql); + return SCM_BOOL_F; + } + + smob = sql_connect_create("mysql"); + conn = (struct sql_connect *)SCM_CDR(smob); + conn->data = mysql; + return smob; +} + +SCM +s_mysql_query(struct sql_connect *conn, char *query) +{ + MYSQL *mysql = conn->data; + MYSQL_RES *result; + SCM cell; + + if (mysql_query(mysql, query)) + scm_misc_error("s_mysql_query", + "MySQL error: ~S", + SCM_LIST1(scm_makfrom0str(mysql_error(mysql)))); + + result = mysql_store_result(mysql); + + if (result) { + int nfields = mysql_num_fields(result); + int nrows = mysql_num_rows(result); + int i, j; + SCM row_head = SCM_EOL, row_tail; + + for (i = 0; i < nrows; i++) { + SCM new_row; + SCM head = SCM_EOL, tail; + MYSQL_ROW row = mysql_fetch_row(result); + + if (!row) + break; + for (j = 0; j < nfields; j++) { + SCM new_elt; + SCM_NEWCELL(new_elt); + SCM_SETCAR(new_elt, scm_makfrom0str(row[j])); + if (head == SCM_EOL) + head = new_elt; + else + SCM_SETCDR(tail, new_elt); + tail = new_elt; + } + + if (head != SCM_EOL) + SCM_SETCDR(tail, SCM_EOL); + + SCM_NEWCELL(new_row); + SCM_SETCAR(new_row, head); + + if (row_head == SCM_EOL) + row_head = new_row; + else + SCM_SETCDR(row_tail, new_row); + row_tail = new_row; + } + if (row_head != SCM_EOL) + SCM_SETCDR(row_tail, SCM_EOL); + cell = row_head; + mysql_free_result(result); + } else { /* should it have returned something? */ + if (mysql_field_count(mysql) == 0) { + cell = scm_makenum(mysql_affected_rows(mysql)); + } else { /* mysql_store_result() should have returned data */ + scm_misc_error("s_mysql_query", + "MySQL error: ~S", + SCM_LIST1(scm_makfrom0str(mysql_error(mysql)))); + } + } + return cell; +} + +void +s_mysql_close(struct sql_connect *conn) +{ + if (conn->data) + mysql_close(conn->data); + conn->data = NULL; +} + +struct sql_iface mysql_iface = { + "mysql", + s_mysql_mark, + s_mysql_free, + s_mysql_connect, + s_mysql_close, + s_mysql_query, +}; + diff --git a/src/pgsql.c b/src/pgsql.c new file mode 100644 index 0000000..956f517 --- /dev/null +++ b/src/pgsql.c @@ -0,0 +1,140 @@ +#ifdef HAVE_CONFIG_H +# include +#endif +#include +#include +#include + +SCM +s_pgsql_mark(struct sql_connect *conn) +{ + return SCM_BOOL_F; +} + +scm_sizet +s_pgsql_free(struct sql_connect *conn) +{ + PGconn *pgconn = (PGconn*) conn->data; + if (!pgconn) + return 0; + PQfinish(pgconn); + return sizeof(pgconn); +} + +SCM +s_pgsql_connect (char *hostname, int port, + char *dbname, char *user, char *pass, char *why) +{ + 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); + if (PQstatus(pgconn) == CONNECTION_BAD) + return SCM_BOOL_F; + + smob = sql_connect_create("pgsql"); + conn = (struct sql_connect *)SCM_CDR(smob); + conn->data = pgconn; + return smob; +} + +SCM +result_to_list(PGresult *res) +{ + int i, j; + int ntuples = PQntuples(res); + int nfields = PQnfields(res); + SCM row_head = SCM_EOL, row_tail; + + for (i = 0; i < ntuples; i++) { + SCM new_row; + SCM head = SCM_EOL, tail; + + for (j = 0; j < nfields; j++) { + SCM new_elt; + char *val = PQgetvalue(res, i, j); + SCM_NEWCELL(new_elt); + SCM_SETCAR(new_elt, scm_makfrom0str(val)); + if (head == SCM_EOL) + head = new_elt; + else + SCM_SETCDR(tail, new_elt); + tail = new_elt; + } + + if (head != SCM_EOL) + SCM_SETCDR(tail, SCM_EOL); + + SCM_NEWCELL(new_row); + SCM_SETCAR(new_row, head); + + if (row_head == SCM_EOL) + row_head = new_row; + else + SCM_SETCDR(row_tail, new_row); + row_tail = new_row; + } + if (row_head != SCM_EOL) + SCM_SETCDR(row_tail, SCM_EOL); + return row_head; +} + +SCM +s_pgsql_query(struct sql_connect *conn, char *query) +{ + PGconn *pgconn = (PGconn*) conn->data; + PGresult *res; + SCM cell; + ExecStatusType stat; + + res = PQexec(pgconn, query); + if (!res) + scm_misc_error("s_mgsql_query", + "pgSQL error: ~S", + SCM_LIST1(scm_makfrom0str(PQerrorMessage(pgconn)))); + + stat = PQresultStatus(res); + + switch (stat) { + case PGRES_COMMAND_OK: + /* Successful completion of a command returning no data */ + cell = scm_makenum(strtoul(PQcmdTuples(res), NULL, 0)); + break; + case PGRES_TUPLES_OK: + /* The query successfully executed */ + cell = result_to_list(res); + PQclear(res); + break; + default: + scm_misc_error("s_mgsql_query", + "pgSQL error: ~S", + SCM_LIST1(scm_makfrom0str(PQresStatus(stat)))); + } + + return cell; +} + +void +s_pgsql_close(struct sql_connect *conn) +{ + PGconn *pgconn = (PGconn*) conn->data; + if (!pgconn) + return; + PQfinish(pgconn); + conn->data = NULL; +} + +struct sql_iface pgsql_iface = { + "pgsql", + s_pgsql_mark, + s_pgsql_free, + s_pgsql_connect, + s_pgsql_close, + s_pgsql_query, +}; + + + -- cgit v1.2.1