Change how entry point is handled.

Replaces the old main sh bootstrap entry point to one written in C.

The reasons are in the C file, but in short, Guile's command line is
less than ideal.

9 files changed, 207 insertions, 37 deletions

diff --git a/.gitignore b/.gitignore
index b92e0bcf..b7cea985 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,5 @@
 coverage
 obj-*
 localization
+calp
+calp-release
diff --git a/Makefile b/Makefile
index aab3c17a..8e5dbea6 100644
--- a/Makefile
+++ b/Makefile
@@ -25,6 +25,11 @@ GUILE_C_FLAGS = -Lmodule \
 				-Wmacro-use-before-definition -Warity-mismatch \
 				-Wduplicate-case-datum -Wbad-case-datum
 
+CLIBS = guile-3.0
+CFLAGS = -Wall -pedantic -std=c11 $(shell pkg-config --cflags $(CLIBS))
+LDLIBS = $(shell pkg-config --libs $(CLIBS))
+LDFLAGS = -lrt
+
 # All po-files inside po/, except new.po, and hidden files
 PO_FILES = $(shell find po -type f -name \*.po -and -not -name new.po -and -not -name .\*)
 LOCALIZATIONS = $(PO_FILES:po/%.po=localization/%/LC_MESSAGES/calp.mo)
@@ -34,9 +39,15 @@ LIMIT_FILES=$(LIMIT:%=--only %)
 # Skip these files when testing
 SKIP=--skip $(PWD)/tests/test/web-server.scm
 
-all: go_files static $(LOCALIZATIONS)
+all: calp go_files static $(LOCALIZATIONS)
 	$(MAKE) -C doc/ref
 
+calp: calp.c
+	$(CC) -ggdb $(CFLAGS) -DBUILD_ENV $(LDFLAGS) -o $@ $< $(LDLIBS)
+
+calp-release: calp.c
+	$(CC) -O2 $(CFLAGS) $(LDFLAGS) -o $@ $< $(LDLIBS)
+
 XGETTEXT_FLAGS = --from-code=UTF-8 --add-comments --indent -kG_
 
 static:
@@ -63,8 +74,10 @@ localization/%/LC_MESSAGES/calp.mo: po/%.po
 clean:
 	-$(MAKE) -C static clean
 	-rm -r obj-*
+	-rm calp
+	-rm calp-release
 
-install: all
+install: all calp-release
 	install -d $(DESTDIR)$(GUILE_SITE_DIR)  $(DESTDIR)$(GUILE_CCACHE_DIR)
 	rsync -a module/ $(DESTDIR)$(GUILE_SITE_DIR)
 	rsync -a obj-$(GUILE_VERSION)/ $(DESTDIR)$(GUILE_CCACHE_DIR)
@@ -73,7 +86,7 @@ install: all
 	$(MAKE) -C doc/ref install
 	install -m 644 -D -t $(DESTDIR)/usr/share/doc/calp README.md
 	install -m 755 -D -t $(DESTDIR)/usr/lib/calp/ scripts/tzget
-	install -m755 -D production-main $(DESTDIR)/usr/bin/calp
+	install -m755 -D calp-release $(DESTDIR)/usr/bin/calp
 
 lcov.info: $(GO_FILES)
 	env DEBUG=0 tests/run-tests.scm --coverage=$@ $(if $(VERBOSE),--verbose) $(SKIP) $(LIMIT_FILES)
diff --git a/calp.c b/calp.c
new file mode 100644
index 00000000..98d883f5
--- /dev/null
+++ b/calp.c
@@ -0,0 +1,176 @@
+#define _XOPEN_SOURCE 500
+#define _POSIX_C_SOURCE 200112L
+
+/**
+ * Primary entry point for calp.
+ *
+ * This is a C file, rather than a shellscript for 2 reasons:
+ * 1. It makes the binary show up with the proper name in process
+ *    listings
+ * 2. Guile's default command line handling leaves a lot to be
+ *    desired.
+ *
+ * The following pre-processor variables are checked during compilation:
+ *
+ * BUILD_ENV
+ *	   If defined then the environment is fetched from where the file
+ *	   resides. This is for development when all dependencies are in the
+ *	   repo alongside this file.
+ * MAIN_MODULE
+ *     Guile module containing the programs entry point. Note that it
+ *     should be given without parenthesis.
+ *
+ *     Defaults to "calp main"
+ * MAIN_PROC
+ *     Procedure within the MAIN_MODULE which is the programs entry
+ *     point.
+ *
+ *     Default to "main"
+ *
+ * During runtime, the environment variable "__PRINT_ENVIRONMENT" is
+ * checked, and if its set then a environment variables suitable for
+ * guile is printed instead of running anything. This is mainly used
+ * by the test runners.
+ *
+ * Parts of this file is noted as being "borrowed from Guile". Guile
+ * is covered under LGPL3, this file is covered under AGPL, which
+ * means it is ok.
+ */
+
+#ifndef MAIN_MODULE
+#define MAIN_MODULE "calp main"
+#endif
+
+#ifndef MAIN_PROC
+#define MAIN_PROC "main"
+#endif
+
+#include <libgen.h>
+
+#include <libguile.h>
+#include <string.h>
+#include <stdio.h>
+#include <locale.h>
+#include <errno.h>
+#include <limits.h>
+
+/** Definitions to ensure each instance is correctly spelled below */
+#define GUILE_LOAD_PATH "GUILE_LOAD_PATH"
+#define GUILE_LOAD_COMPILED_PATH "GUILE_LOAD_COMPILED_PATH"
+#define GUILE_AUTO_COMPILE "GUILE_AUTO_COMPILE"
+
+#define PRINT_ENVIRONMENT "__PRINT_ENVIRONMENT"
+
+/** Borrowed from Guile 3.0.9 libguile/guile.c */
+static int
+get_integer_from_environment (const char *var, int def)
+{
+	char *end = 0;
+	char *val = getenv (var);
+	long res = def;
+	if (!val)
+		return def;
+	res = strtol (val, &end, 10);
+	if (end == val)
+	{
+		fprintf (stderr, "guile: warning: invalid %s: %s\n", var, val);
+		return def;
+	}
+	return res;
+}
+
+static void inner_main (void *closure, int argc, char **argv) {
+	SCM main = scm_c_public_ref(MAIN_MODULE, MAIN_PROC);
+	SCM scm_args = scm_c_make_vector (argc, SCM_UNDEFINED);
+	for (size_t i = 0; i < (size_t) argc; i++) {
+		scm_c_vector_set_x (scm_args, i, scm_from_locale_string(argv[i]));
+	}
+	scm_call_1(main, scm_vector_to_list(scm_args));
+}
+
+/** Procedure marked unused since GCC dosen't understand function
+ * pointers when checking usage */
+__attribute__((__unused__))
+static void *get_guile_version (void *data) {
+	(void) data;
+	return scm_to_locale_string(scm_version());
+}
+
+
+static void export (const char *key, const char *val) {
+	printf("export %s=%s;\n", key, val);
+}
+
+
+int main(int argc, char *argv[]) {
+
+	/* Locale initialization code borrowed from Guile 3.0.9 libguile/guile.c */
+	if (get_integer_from_environment("GUILE_INSTALL_LOCALE", 1) && setlocale(LC_ALL, "") == NULL) {
+		fprintf(stderr, "calp: warning: failed to install locale\n");
+	}
+
+#ifdef BUILD_ENV
+
+	char *bin_path = realpath(argv[0], NULL);
+	if (bin_path == NULL) {
+		fprintf(stderr, "%s\n", strerror(errno));
+		return 1;
+	}
+	char *here = dirname(bin_path);
+
+	{
+		const char *load_path = getenv(GUILE_LOAD_PATH);
+		size_t len = PATH_MAX + strlen("module") + 1;
+		if (load_path) len += strlen(load_path);
+
+		char *buf = malloc(len);
+
+		if (load_path) {
+			sprintf(buf, "%s:%s/module", load_path, here);
+		} else {
+			sprintf(buf, "%s/module", here);
+		}
+
+		setenv(GUILE_LOAD_PATH, buf, 1);
+
+		free(buf);
+	}
+
+	{
+		char *version = scm_with_guile(&get_guile_version, NULL);
+
+		const char *load_path = getenv(GUILE_LOAD_COMPILED_PATH);
+		size_t len = PATH_MAX + strlen("module") + strlen(version) + 1;
+		if (load_path) len += strlen(load_path);
+
+		char *buf = malloc(len);
+
+		if (load_path) {
+			sprintf(buf, "%s:%s/obj-%s", load_path, here, version);
+		} else {
+			sprintf(buf, "%s/obj-%s", here, version);
+		}
+
+		setenv(GUILE_LOAD_COMPILED_PATH, buf, 1);
+
+		free(buf);
+		free(version);
+	}
+
+	setenv(GUILE_AUTO_COMPILE, "0", 1);
+
+	free(bin_path);
+#endif
+
+	if (getenv(PRINT_ENVIRONMENT)) {
+		export(GUILE_LOAD_PATH, getenv(GUILE_LOAD_PATH));
+		export(GUILE_LOAD_COMPILED_PATH, getenv(GUILE_LOAD_COMPILED_PATH));
+		export(GUILE_AUTO_COMPILE, "0");
+		export("GUILE", "${GUILE:-guile}");
+		export("CALP_TEST_ENVIRONMENT", "1");
+		return 0;
+	}
+
+	scm_boot_guile (argc, argv, inner_main, 0);
+	return 0; /* never reacher */
+}
diff --git a/env b/env
deleted file mode 100644
index 31ff2281..00000000
--- a/env
+++ /dev/null
@@ -1,17 +0,0 @@
-# -*- mode: sh -*-
-
-_here=$(dirname "$(realpath "${BASH_SOURCE[0]}")")
-
-export GUILE=${GUILE:-guile}
-guile_version=$($GUILE -c '(display (version))')
-
-export GUILE_LOAD_COMPILED_PATH=${_here}/obj-${guile_version}:${GUILE_LOAD_COMPILED_PATH}
-export GUILE_LOAD_PATH=${_here}/module:${GUILE_LOAD_PATH}
-export GUILE_AUTO_COMPILE=0
-
-# TODO why is this set?
-export LIBEXEC=${_here}/scripts/
-
-#export GUILE_AUTO_COMPILE=0
-
-# exec "$@"
diff --git a/main b/main
deleted file mode 100755
index fb3a1e03..00000000
--- a/main
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/bin/bash
-
-here=$(dirname $(realpath $0))
-. $here/env
-
-make GUILE="$GUILE" go_files
-
-exec $GUILE -e '(@ (calp main) main)' "$@"
diff --git a/production-main b/production-main
deleted file mode 100644
index 69939def..00000000
--- a/production-main
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/bash
-GUILE=${GUILE:-guile}
-exec "$GUILE" -e '(@ (calp main) main)' "$@"
diff --git a/start b/start
index 2363d428..48d2c0e0 100755
--- a/start
+++ b/start
@@ -19,7 +19,7 @@ port=`find_port {8080..9000}`
 
 echo "Starting on $port"
 
-$(dirname $(realpath $0))/main \
+$(dirname $(realpath $0))/calp \
 	--repl=$XDG_RUNTIME_DIR/calp \
 	--debug \
 	--edit-mode \
diff --git a/tests/run-tests.scm b/tests/run-tests.scm
index ca8f9de4..4bb34ce8 100755
--- a/tests/run-tests.scm
+++ b/tests/run-tests.scm
@@ -1,9 +1,8 @@
 #!/usr/bin/env bash
 # -*- mode: scheme; geiser-scheme-implementation: guile -*-
 
-here=$(dirname $(realpath $0))
-
-. "$(dirname "$here")/env"
+root=$(dirname "$(dirname "$(realpath "$0")")")
+eval "$(env __PRINT_ENVIRONMENT=1 ${root}/calp)"
 
 if [ "$DEBUG" = '' ]; then
   exec $GUILE -s "$0" "$@"
@@ -12,6 +11,10 @@ else
 fi
 !#
 
+(unless (getenv "CALP_TEST_ENVIRONMENT")
+  (format (current-error-port) "Not running in test environment, abandoning~%")
+  (exit 1))
+
 (format #t "current-filename = ~s~%" (current-filename))
 
 (define here (dirname (current-filename)))
diff --git a/tests/validate-html/run-validator.scm b/tests/validate-html/run-validator.scm
index 0c4ee0bc..b363e3ea 100755
--- a/tests/validate-html/run-validator.scm
+++ b/tests/validate-html/run-validator.scm
@@ -1,12 +1,16 @@
 #!/usr/bin/bash
 # -*- mode: scheme; geiser-scheme-implementation: guile -*-
-here=$(dirname $(realpath $0))
+root=$(dirname "$(dirname "$(dirname "$(realpath "$0")")")")
 
-. "$(dirname "$(dirname "$here")")/env"
+eval "$(env __PRINT_ENVIRONMENT=1 ${root}/calp)"
 
 exec $GUILE -e main -s "$0" -- "$@"
 !#
 
+(unless (getenv "CALP_TEST_ENVIRONMENT")
+  (format (current-error-port) "Not running in test environment, abandoning~%")
+  (exit 1))
+
 (use-modules (sxml simple)
              ((sxml xpath) :select (sxpath))
              (sxml match)