Initial revision

13 files changed, 1091 insertions, 0 deletions

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 <libguile.h>],
+                     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, <gjb@cs.washington.edu>
+# 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, <gjb@cs.washington.edu>
+# 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 <config.h>
+#endif
+#include <string.h>
+#include <guile-sql.h>
+#include <app.h>
+
+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("#<SQL connection (", port);
+	scm_puts(sql_iftab[conn->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 <gsql_conn.x>
+}
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 <config.h>
+#endif
+#include <guile-sql.h>
+#include <app.h>
+
+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 <sys/socket.h>
+#include <netinet/in.h>
+#include <arpa/inet.h>
+#include <libguile.h>
+
+#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 <config.h>
+#endif
+#include <string.h>
+#include <guile-sql.h>
+#include <mysql/mysql.h>
+
+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 <config.h>
+#endif
+#include <string.h>
+#include <guile-sql.h>
+#include <libpq-fe.h>
+
+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_l