aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2009-09-24 15:23:10 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2009-09-24 15:23:10 +0300
commitf59aa22f237d6fb0eb928908f8874c8468afa077 (patch)
tree98522114c0dc9e0f04d7b957a14de48286fcdf5c
parent10f9a62f7923e4cf92e2c47748515bc14bef0481 (diff)
downloadanubis-f59aa22f237d6fb0eb928908f8874c8468afa077.tar.gz
anubis-f59aa22f237d6fb0eb928908f8874c8468afa077.tar.bz2
Improve Guile support.
* src/guile.c: Rewrite using "inline" approach. (anubis_boot): Removed. (guile_safe_exec): New function. (init_guile): New function. (guile_load_path_append, guile_load_program) (guile_process_proc): Rewrite using guile_safe_exec. (inner_catch_body): Call guile_ports_open before, and guile_ports_close after execution of the function. * src/headers.h (anubis_boot): Remove. (init_guile): New proto. * src/main.c (anubis_core): Remove. (main) [WITH_GUILE]: Call init_guile. Inline anubis() function.
-rw-r--r--lib/.gitignore2
-rw-r--r--src/guile.c181
-rw-r--r--src/headers.h2
-rw-r--r--src/main.c24
4 files changed, 140 insertions, 69 deletions
diff --git a/lib/.gitignore b/lib/.gitignore
index 628abc5..d10262c 100644
--- a/lib/.gitignore
+++ b/lib/.gitignore
@@ -30,6 +30,8 @@ realloc.c
setenv.c
stdbool.h
stdbool.in.h
+stddef.h
+stddef.in.h
stdint.h
stdint.in.h
stdio-impl.h
diff --git a/src/guile.c b/src/guile.c
index 9b6d4ec..a2ae9b6 100644
--- a/src/guile.c
+++ b/src/guile.c
@@ -2,7 +2,7 @@
guile.c
This file is part of GNU Anubis.
- Copyright (C) 2003, 2004, 2005, 2007, 2008 The Anubis Team.
+ Copyright (C) 2003, 2004, 2005, 2007, 2008, 2009 The Anubis Team.
GNU Anubis is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
@@ -28,23 +28,49 @@ static void guile_ports_open (void);
static void guile_ports_close (void);
static SCM
-catch_body (void *data)
+eval_catch_body(void *list)
{
- scm_init_load_path ();
- anubis (data);
- return SCM_BOOL_F;
+ return scm_primitive_eval ((SCM)list);
}
static SCM
-catch_handler (void *data, SCM tag, SCM throw_args)
+eval_catch_handler (void *data, SCM tag, SCM throw_args)
{
- return scm_handle_by_message_noexit ("anubis", tag, throw_args);
+ scm_handle_by_message_noexit ("anubis", tag, throw_args);
+ longjmp(*(jmp_buf*)data, 1);
}
-void
-anubis_boot (void *closure, int argc, char **argv)
+struct scheme_exec_data
+{
+ SCM (*handler) (void *data);
+ void *data;
+ SCM result;
+};
+
+static SCM
+scheme_safe_exec_body (void *data)
+{
+ struct scheme_exec_data *ed = data;
+ ed->result = ed->handler (ed->data);
+ return SCM_BOOL_F;
+}
+
+static int
+guile_safe_exec (SCM (*handler) (void *data), void *data, SCM *result)
{
- scm_internal_catch (SCM_BOOL_T, catch_body, closure, catch_handler, NULL);
+ jmp_buf jmp_env;
+ struct scheme_exec_data ed;
+
+ if (setjmp(jmp_env))
+ return 1;
+ ed.handler = handler;
+ ed.data = data;
+ scm_internal_lazy_catch (SCM_BOOL_T,
+ scheme_safe_exec_body, (void*)&ed,
+ eval_catch_handler, &jmp_env);
+ if (result)
+ *result = ed.result;
+ return 0;
}
void
@@ -57,12 +83,20 @@ guile_debug (int val)
}
void
-guile_ports_open (void)
+init_guile ()
+{
+ scm_init_guile ();
+ scm_load_goops ();
+}
+
+
+void
+guile_ports_open ()
{
SCM port;
int fd = -1;
char *name = options.glogfile;
-
+
if (topt & (T_FOREGROUND_INIT | T_STDINOUT))
return;
@@ -93,17 +127,20 @@ guile_ports_open (void)
}
void
-guile_ports_close (void)
+guile_ports_close ()
{
- if (topt & (T_FOREGROUND_INIT | T_STDINOUT))
- return;
- scm_close_output_port (scm_current_error_port ());
- scm_close_output_port (scm_current_output_port ());
+ if (!(topt & (T_FOREGROUND_INIT | T_STDINOUT)))
+ {
+ scm_close_output_port (scm_current_error_port ());
+ scm_close_output_port (scm_current_output_port ());
+ }
}
-void
-guile_load_path_append (ANUBIS_LIST *arglist, MESSAGE *msg)
+
+SCM
+guile_load_path_append_handler (void *data)
{
+ ANUBIS_LIST *arglist = data;
char *path = list_item (arglist, 0);
SCM scm, path_scm, *pscm;
path_scm = SCM_VARIABLE_REF (scm_c_lookup ("%load-path"));
@@ -116,7 +153,7 @@ guile_load_path_append (ANUBIS_LIST *arglist, MESSAGE *msg)
int rc = strcmp (p, path);
free (p);
if (rc == 0)
- return;
+ return SCM_UNSPECIFIED;
}
}
@@ -124,22 +161,43 @@ guile_load_path_append (ANUBIS_LIST *arglist, MESSAGE *msg)
*pscm = scm_append (scm_list_3 (path_scm,
scm_list_1 (scm_makfrom0str (path)),
SCM_EOL));
+ return SCM_UNSPECIFIED;
}
void
-guile_load_program (ANUBIS_LIST *arglist, MESSAGE *msg)
+guile_load_path_append (ANUBIS_LIST *arglist, MESSAGE *msg /* unused */)
{
- scm_primitive_load_path (scm_makfrom0str (list_item (arglist, 0)));
+ guile_safe_exec (guile_load_path_append_handler, arglist, NULL);
}
+
+struct load_closure
+{
+ char *filename;
+ int argc;
+ char **argv;
+};
+
static SCM
-eval_catch_handler (void *data, SCM tag, SCM throw_args)
+load_path_handler (void *data)
{
- scm_handle_by_message_noexit ("anubis", tag, throw_args);
- longjmp (*(jmp_buf *) data, 1);
+ struct load_closure *lp = data;
+
+ scm_set_program_arguments (lp->argc, lp->argv, lp->filename);
+ scm_primitive_load_path (scm_makfrom0str (lp->filename));
+ return SCM_UNDEFINED;
}
-
+void
+guile_load_program (ANUBIS_LIST *arglist, MESSAGE *msg /* unused */)
+{
+ struct load_closure clos;
+ clos.filename = list_item (arglist, 0);
+ clos.argc = 0;
+ clos.argv = NULL;
+ guile_safe_exec (load_path_handler, &clos, NULL);
+}
+
static ANUBIS_LIST *
guile_to_anubis (SCM cell)
{
@@ -193,7 +251,7 @@ anubis_to_guile (ANUBIS_LIST * list)
}
static SCM
-list_to_args (ANUBIS_LIST * arglist)
+list_to_args (ANUBIS_LIST *arglist)
{
char *p;
ITERATOR *itr;
@@ -241,18 +299,50 @@ list_to_args (ANUBIS_LIST * arglist)
iterator_destroy (&itr);
return head;
}
-
+
/* (define (postproc header-list body) */
-void
-guile_process_proc (ANUBIS_LIST *arglist, MESSAGE *msg)
+struct proc_handler_closure
{
- char *procname;
+ SCM procsym;
+ ANUBIS_LIST *arglist;
+ MESSAGE *msg;
+};
+
+SCM
+guile_process_proc_handler (void *data)
+{
+ struct proc_handler_closure *clp = data;
+ ANUBIS_LIST *arglist = clp->arglist;
+ MESSAGE *msg = clp->msg;
SCM arg_hdr, arg_body;
SCM invlist, rest_arg;
+
+ /* Prepare the required arguments */
+ arg_hdr = anubis_to_guile (msg->header);
+ arg_body = scm_makfrom0str (msg->body);
+
+ /* Prepare the optional arguments */
+ rest_arg = list_to_args (arglist);
+
+ invlist = scm_append
+ (scm_list_2
+ (scm_list_3 (clp->procsym,
+ scm_cons (SCM_IM_QUOTE, arg_hdr),
+ arg_body),
+ rest_arg));
+
+ return scm_primitive_eval (invlist);
+}
+
+void
+guile_process_proc (ANUBIS_LIST *arglist, MESSAGE *msg)
+{
+ struct proc_handler_closure clos;
SCM procsym;
SCM res;
-
+ char *procname;
+
procname = list_item (arglist, 0);
if (!procname)
{
@@ -260,13 +350,6 @@ guile_process_proc (ANUBIS_LIST *arglist, MESSAGE *msg)
return;
}
- /* Prepare the required arguments */
- arg_hdr = anubis_to_guile (msg->header);
- arg_body = scm_makfrom0str (msg->body);
-
- /* Prepare the optional arguments */
- rest_arg = list_to_args (arglist);
-
/* Evaluate the procedure */
procsym = SCM_VARIABLE_REF (scm_c_lookup (procname));
if (scm_procedure_p (procsym) != SCM_BOOL_T)
@@ -275,14 +358,12 @@ guile_process_proc (ANUBIS_LIST *arglist, MESSAGE *msg)
return;
}
- invlist = scm_append
- (scm_list_2
- (scm_list_3 (procsym,
- scm_cons (SCM_IM_QUOTE, arg_hdr),
- arg_body),
- rest_arg));
-
- res = scm_primitive_eval (invlist);
+ clos.procsym = procsym;
+ clos.arglist = arglist;
+ clos.msg = msg;
+ if (guile_safe_exec (guile_process_proc_handler, &clos, &res))
+ return;
+
if (SCM_IMP (res) && SCM_BOOLP (res))
{
@@ -329,6 +410,7 @@ guile_process_proc (ANUBIS_LIST *arglist, MESSAGE *msg)
anubis_error (0, 0, _("Bad return type from %s"), procname);
}
+
/* RC file stuff */
#define KW_GUILE_OUTPUT 0
@@ -368,7 +450,9 @@ static SCM
inner_catch_body (void *data)
{
struct inner_closure *closure = data;
+ guile_ports_open ();
closure->fun (closure->arglist, closure->msg);
+ guile_ports_close ();
return SCM_BOOL_F;
}
@@ -416,7 +500,6 @@ guile_parser (int method, int key, ANUBIS_LIST * arglist,
return RC_KW_UNKNOWN;
}
- guile_ports_open ();
if (setjmp (jmp_env) == 0)
scm_internal_lazy_catch (SCM_BOOL_T,
inner_catch_body,
@@ -425,8 +508,6 @@ guile_parser (int method, int key, ANUBIS_LIST * arglist,
else
rc = RC_KW_ERROR;
- guile_ports_close ();
-
return rc;
}
diff --git a/src/headers.h b/src/headers.h
index 1c64123..07aa492 100644
--- a/src/headers.h
+++ b/src/headers.h
@@ -481,7 +481,7 @@ void gpg_section_init (void);
/* guile.c */
#ifdef WITH_GUILE
-void anubis_boot (void *, int, char **);
+void init_guile (void);
void guile_debug (int);
void guile_section_init (void);
#endif /* WITH_GUILE */
diff --git a/src/main.c b/src/main.c
index b8e59f3..aebafc8 100644
--- a/src/main.c
+++ b/src/main.c
@@ -37,17 +37,6 @@ char *anubis_domain; /* Local domain for EHLO in authentication mode */
char *incoming_mail_rule; /* Name of section for incoming mail processing */
char *outgoing_mail_rule; /* Name of section for outgoing mail processing */
-#ifdef WITH_GUILE
-void
-anubis_core (void)
-{
- char *argv[] = { "anubis", NULL };
- scm_boot_guile (1, argv, anubis_boot, NULL);
-}
-#else
-# define anubis_core() anubis(NULL)
-#endif /* WITH_GUILE */
-
void
xalloc_die ()
{
@@ -161,17 +150,14 @@ main (int argc, char *argv[])
init_ssl_libs ();
#endif /* USE_SSL */
+#ifdef WITH_GUILE
+ init_guile ();
+#endif
+
/*
Enter the main core...
*/
- anubis_core ();
- return 0;
-}
-
-void
-anubis (char *arg)
-{
if (anubis_mode == anubis_mda) /* Mail Delivery Agent */
mda ();
else if (topt & T_STDINOUT) /* stdin/stdout */
@@ -186,6 +172,8 @@ anubis (char *arg)
daemonize ();
loop (sd_bind);
}
+ return 0;
}
+
/* EOF */

Return to:

Send suggestions and report system problems to the System administrator.