/[radius]/radius/radiusd/scheme.c
ViewVC logotype

Diff of /radius/radiusd/scheme.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.34 by gray, Wed Jul 31 08:07:35 2002 UTC revision 1.35 by gray, Fri Apr 18 05:27:10 2003 UTC
# Line 1  Line 1 
1  /* This file is part of GNU RADIUS.  /* This file is part of GNU Radius.
2     Copyright (C) 2000,2001 Sergey Poznyakoff     Copyright (C) 2001,2002,2003 Sergey Poznyakoff
3        
4     This program is free software; you can redistribute it and/or modify     GNU Radius is free software; you can redistribute it and/or modify
5     it under the terms of the GNU General Public License as published by     it under the terms of the GNU General Public License as published by
6     the Free Software Foundation; either version 2 of the License, or     the Free Software Foundation; either version 2 of the License, or
7     (at your option) any later version.     (at your option) any later version.
8        
9     This program is distributed in the hope that it will be useful,     GNU Radius is distributed in the hope that it will be useful,
10     but WITHOUT ANY WARRANTY; without even the implied warranty of     but WITHOUT ANY WARRANTY; without even the implied warranty of
11     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12     GNU General Public License for more details.     GNU General Public License for more details.
13        
14     You should have received a copy of the GNU General Public License     You should have received a copy of the GNU General Public License
15     along with this program; if not, write to the Free Software Foundation,     along with GNU Radius; if not, write to the Free Software Foundation,
16     Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */     Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
17    
18  #define RADIUS_MODULE_SCHEME_C  #define RADIUS_MODULE_SCHEME_C
19    
 #ifndef lint  
 static char rcsid[] =  
 "@(#) $Id$";  
 #endif  
   
20  #ifdef HAVE_CONFIG_H  #ifdef HAVE_CONFIG_H
21  # include <config.h>  # include <config.h>
22  #endif  #endif
# Line 35  static char rcsid[] = Line 30  static char rcsid[] =
30  #include <setjmp.h>  #include <setjmp.h>
31  #include <errno.h>  #include <errno.h>
32    
 /* Implementation notes and a BIG FIXME:  
   
    Current realisation of libguile (1.6) is not thread-safe in the  
    sense that different threads cannot safely call scheme evaluation  
    procedures. The problem is mainly in the garbage collector, which  
    saves the address of the first automatic variable on the entry to  
    scm_boot_guile_1 and then uses this address as the top of stack.  
    Obviously, when the gc() gets called from another thread this address  
    is not valid anymore and the thread sigfaults miserably.  
   
    So, current workaround is to start a separate thread for processing  
    scheme requests. This thread (let's call it scheme-server one) keeps  
    a queue of tasks. Each thread wishing to execute a scheme procedure  
    (a "client thread") first places it to the queue and then signals the  
    scheme-server thread. Then the client thread waits until the server  
    raises condition variable associated with the task, thereby signalling  
    its completion.  
   
    This creates an obvious buttleneck: assuming that the average time of  
    execution of a scheme procedure is M seconds, the client will wait  
    for the completion of its procedure at least M*(N+1) seconds, where  
    N is the number of the requests in the queue by the time the thread  
    places its task.  
   
    This is hardly acceptable. To avoid possible thread cancellations  
    a timeout is imposed on the execution of scheme requests. The timeout  
    is REQUEST_TYPE_TTL/2 + 1. The value of the configuration variable  
    `task-timeout' overrides this default, provided that  
   
           task-timeout <= REQUEST_TYPE_TTL/2 + 1.  
   
    Possibly, a better approach would be to set timeout to  
   
           REQUEST_TYPE_TTL/N  
   
    where N represents the number of scheme tasks waiting in the queue.  
   
    Anyway, the solution of the bottleneck problem is badly needed. */  
     
33  /* Protos to be moved to radscm */  /* Protos to be moved to radscm */
34  SCM scm_makenum (unsigned long val);  SCM scm_makenum (unsigned long val);
35  SCM radscm_avl_to_list(VALUE_PAIR *pair);  SCM radscm_avl_to_list(VALUE_PAIR *pair);
# Line 81  VALUE_PAIR *radscm_list_to_avl(SCM list) Line 37  VALUE_PAIR *radscm_list_to_avl(SCM list)
37  SCM radscm_avp_to_cons(VALUE_PAIR *pair);  SCM radscm_avp_to_cons(VALUE_PAIR *pair);
38  VALUE_PAIR *radscm_cons_to_avp(SCM scm);  VALUE_PAIR *radscm_cons_to_avp(SCM scm);
39    
 /* Values for rad_scheme_task.state */  
 #define RSCM_TASK_WAITING 0  
 #define RSCM_TASK_READY   1  
 #define RSCM_TASK_DONE    2  
   
 struct rad_scheme_task;  
 typedef int (*scheme_task_fp)(struct rad_scheme_task*);  
   
 struct rad_scheme_task {  
         struct rad_scheme_task *next;  
         pthread_mutex_t mutex;  
         pthread_cond_t cond;  
         int state;  
         int retval;  
         scheme_task_fp fun;  
         char *procname;  
         RADIUS_REQ *request;  
         VALUE_PAIR *user_check;  
         VALUE_PAIR **user_reply_ptr;  
 };  
   
 /* Static declarations */  
 static void *guile_boot0(void *ignored);  
 static void guile_boot1(void *closure, int argc, char **argv);  
 static SCM boot_body(void *data);  
 static SCM boot_handler(void *data, SCM tag, SCM throw_args);  
 static SCM eval_catch_body(void *list);  
 static SCM eval_catch_handler(void *data, SCM tag, SCM throw_args);  
   
 static int scheme_generic_call(int type,  
                                scheme_task_fp fun,  
                                char *procname, RADIUS_REQ *req,  
                                VALUE_PAIR *user_check,  
                                VALUE_PAIR **user_reply_ptr,  
                                u_long timeout);  
 static void rad_scheme_place_task(struct rad_scheme_task *cp);  
 static void rad_scheme_remove_task(struct rad_scheme_task *cp);  
 static int scheme_auth_internal(struct rad_scheme_task *p);  
 static int scheme_acct_internal(struct rad_scheme_task *p);  
 static int scheme_before_config_internal(struct rad_scheme_task *p);  
 static int scheme_after_config_internal(struct rad_scheme_task *p);  
 static int scheme_load_internal(struct rad_scheme_task *p);  
 static int scheme_add_load_path_internal(struct rad_scheme_task *p);  
 static int scheme_read_eval_loop_internal(struct rad_scheme_task *unused);  
 static void scheme_before_config_hook(void *unused1, void *unused2);  
 static void scheme_after_config_hook(void *unused1, void *unused2);  
   
 /* variables */  
 pthread_t guile_tid;  
 static pthread_mutex_t server_mutex = PTHREAD_MUTEX_INITIALIZER;  
 static pthread_cond_t server_cond = PTHREAD_COND_INITIALIZER;  
 struct rad_scheme_task *queue_head, *queue_tail;  
 static int scheme_inited;  
 unsigned scheme_gc_interval = 3600;  
 u_int scheme_task_timeout = 0;  
   
 void  
 rad_scheme_place_task(cp)  
         struct rad_scheme_task *cp;  
 {  
         cp->next = NULL;  
         if (!queue_head)  
                 queue_head = cp;  
         else  
                 queue_tail->next = cp;  
         queue_tail = cp;  
 }  
   
 void  
 rad_scheme_remove_task(cp)  
         struct rad_scheme_task *cp;  
 {  
         struct rad_scheme_task *p, *prev = NULL;  
   
         for (p = queue_head; p; ) {  
                 if (p == cp)  
                         break;  
                 prev = p;  
                 p = p->next;  
         }  
           
         if (p) {  
                 if (prev)  
                         prev->next = p->next;  
                 else  
                         queue_head = p->next;  
                 if (p == queue_tail)  
                         queue_tail = prev;  
         }  
 }  
   
 /* ************************************************************************* */  
 /* Boot up stuff */  
   
 void  
 start_guile()  
 {  
         int rc;  
   
         register_before_config_hook(scheme_before_config_hook, NULL);  
         register_after_config_hook(scheme_after_config_hook, NULL);  
         if (rc = pthread_create(&guile_tid, NULL, guile_boot0, NULL))  
                 radlog(L_ERR, _("Can't spawn guile thread: %s"),  
                        strerror(rc));  
 }  
   
 void *  
 guile_boot0(arg)  
         void *arg;  
 {  
         char *argv[] = { "radiusd", NULL };  
         radiusd_thread_init();  
         scm_boot_guile (1, argv, guile_boot1, arg);  
         return NULL;  
 }        
   
   
 /*ARGSUSED*/  
40  static SCM  static SCM
41  boot_body (void *data)  catch_body(void *data)
42  {  {
43          time_t last_gc_time;          scm_init_load_path();
44                    radscm_init();
45          scm_init_load_path();          rscm_radlog_init();
46          radscm_init();          rscm_rewrite_init();
47          rscm_radlog_init();          rad_mainloop(data);
48          rscm_rewrite_init();          return SCM_BOOL_F;
   
           
         time(&last_gc_time);  
         scheme_inited = 1;  
           
         Pthread_mutex_lock(&server_mutex);  
         while (1) {  
                 struct rad_scheme_task *p;  
                 time_t t;  
   
                 if (time(&t) - last_gc_time > scheme_gc_interval) {  
                         debug(1,("starting guile garbage collection"));  
                         scm_gc();  
                         debug(1,("finished guile garbage collection"));  
                         last_gc_time = t;  
                 }  
                   
                 debug(1, ("SRV: Waiting"));  
                 pthread_cond_wait(&server_cond, &server_mutex);  
                   
                 debug(1, ("SRV: Processing queue"));  
                 p = queue_head;  
                 while (p) {  
                         struct rad_scheme_task *next = p->next;  
                         switch (p->state) {  
                         case RSCM_TASK_DONE:  
                                 debug(1, ("SRV: Deleting completed task"));  
                                 rad_scheme_remove_task(p);  
                                 efree(p);  
                                 break;  
   
                         case RSCM_TASK_WAITING:  
                                 debug(1, ("SRV: Handling request"));  
                                 p->retval = p->fun(p);  
                                 p->state = RSCM_TASK_READY;  
                                 /*FALLTHROUGH*/  
   
                         case RSCM_TASK_READY:  
                         default:  
                                 Pthread_mutex_lock(&p->mutex);  
                                 pthread_cond_signal(&p->cond);  
                                 Pthread_mutex_unlock(&p->mutex);  
                         }  
                         p = next;  
                 }  
         }  
         /*NOTREACHED*/  
         return SCM_BOOL_F;  
49  }  }
50    
 /*ARGSUSED*/  
51  static SCM  static SCM
52  boot_handler (void *data, SCM tag, SCM throw_args)  catch_handler(void *data, SCM tag, SCM throw_args)
53  {  {
54          return scm_handle_by_message_noexit("radiusd", tag, throw_args);          return scm_handle_by_message_noexit("radiusd", tag, throw_args);
55  }  }
56    
57  /*ARGSUSED*/  
58  void  void
59  guile_boot1(closure, argc, argv)  rad_boot(void *closure, int argc, char **argv)
60          void *closure;  {
61          int argc;          scm_internal_catch(SCM_BOOL_T,
62          char **argv;                             catch_body, closure,
63  {                             catch_handler, NULL);
         scm_internal_catch(SCM_BOOL_T,  
                            boot_body, closure,  
                            boot_handler, NULL);  
64  }  }
65    
66  void  void
67  scheme_debug(val)  scheme_debug(int val)
         int val;  
68  {  {
69          SCM_DEVAL_P = val;          SCM_DEVAL_P = val;
70          SCM_BACKTRACE_P = val;          SCM_BACKTRACE_P = val;
71          SCM_RECORD_POSITIONS_P = val;          SCM_RECORD_POSITIONS_P = val;
72          SCM_RESET_DEBUG_MODE;          SCM_RESET_DEBUG_MODE;
73  }  }
74                                    
   
 /* ************************************************************************* */  
 /* Functions running in Guile thread stack space */  
75    
76  static SCM  static SCM
77  eval_catch_body (void *list)  eval_catch_body (void *list)
78  {  {
79          return scm_primitive_eval_x((SCM)list);          return scm_eval((SCM)list);
80  }  }
81    
 /*ARGSUSED*/  
82  static SCM  static SCM
83  eval_catch_handler (void *data, SCM tag, SCM throw_args)  eval_catch_handler (void *data, SCM tag, SCM throw_args)
84  {  {
85          scm_handle_by_message_noexit("radiusd", tag, throw_args);          scm_handle_by_message_noexit("radiusd", tag, throw_args);
86          longjmp(*(jmp_buf*)data, 1);          longjmp(*(jmp_buf*)data, 1);
87  }  }
88    
89  int  int
90  scheme_auth_internal(p)  scheme_auth(char *procname, RADIUS_REQ *req,
91          struct rad_scheme_task *p;              VALUE_PAIR *user_check,
92                VALUE_PAIR **user_reply_ptr)
93  {  {
94          SCM s_request, s_check, s_reply;          SCM s_request, s_check, s_reply;
95          SCM res;          SCM res, env;
96          SCM procsym;          SCM procsym;
97          jmp_buf jmp_env;          jmp_buf jmp_env;
98                    
99          s_request = radscm_avl_to_list(p->request->request);          s_request = radscm_avl_to_list(req->request);
100          s_check = radscm_avl_to_list(p->user_check);          s_check = radscm_avl_to_list(user_check);
101          s_reply = radscm_avl_to_list(*p->user_reply_ptr);          s_reply = radscm_avl_to_list(*user_reply_ptr);
102    
103          /* Evaluate the procedure */          /* Evaluate the procedure */
104          procsym = RAD_SCM_SYMBOL_VALUE(p->procname);          procsym = scm_symbol_value0 (procname);
105          if (scm_procedure_p(procsym) != SCM_BOOL_T) {          if (scm_procedure_p(procsym) != SCM_BOOL_T) {
106                  radlog(L_ERR,                  radlog(L_ERR,
107                         _("%s is not a procedure object"), p->procname);                         _("procname is not a procedure object"));
108                  return 1;                  return 1;
109          }          }
110          if (setjmp(jmp_env))          if (setjmp(jmp_env))
111                  return 1;                  return 1;
   
         res = scm_internal_lazy_catch(  
                 SCM_BOOL_T,  
                 eval_catch_body,  
                 (void*) scm_list_4(procsym,  
                                   scm_list_2(scm_copy_tree(SCM_IM_QUOTE),  
                                              s_request),  
                                   scm_list_2(scm_copy_tree(SCM_IM_QUOTE),  
                                              s_check),  
                                   scm_list_2(scm_copy_tree(SCM_IM_QUOTE),  
                                              s_reply)),  
                 eval_catch_handler, &jmp_env);  
           
         if (SCM_IMP(res) && SCM_BOOLP(res))  
                 return res == SCM_BOOL_F;  
         if (SCM_NIMP(res) && SCM_CONSP(res)) {  
                 int code = SCM_CAR(res);  
                 VALUE_PAIR *list = radscm_list_to_avl(SCM_CDR(res));  
                 avl_merge(p->user_reply_ptr, &list);  
                 avl_free(list);  
                 return code == SCM_BOOL_F;  
         }  
         /*FIXME: message*/  
         return 1;  
 }  
   
   
 int  
 scheme_acct_internal(p)  
         struct rad_scheme_task *p;  
 {  
         SCM procsym, res;  
         jmp_buf jmp_env;  
         SCM s_request = radscm_avl_to_list(p->request->request);  
   
         /* Evaluate the procedure */  
         procsym = RAD_SCM_SYMBOL_VALUE(p->procname);  
         if (scm_procedure_p(procsym) != SCM_BOOL_T) {  
                 radlog(L_ERR,  
                        _("%s is not a procedure object"), p->procname);  
                 return 1;  
         }  
         if (setjmp(jmp_env))  
                 return 1;  
         res = scm_internal_lazy_catch(  
                 SCM_BOOL_T,  
                 eval_catch_body,  
                 (void*) scm_list_2(procsym,  
                                   scm_list_2(SCM_IM_QUOTE,  
                                              s_request)),  
                 eval_catch_handler, &jmp_env);  
         if (SCM_IMP(res) && SCM_BOOLP(res))  
                 return res == SCM_BOOL_F;  
         return 1;  
 }  
   
 /*ARGSUSED*/  
 int  
 scheme_before_config_internal(p)  
         struct rad_scheme_task *p;  
 {  
 }  
   
 /*ARGSUSED*/  
 int  
 scheme_after_config_internal(p)  
         struct rad_scheme_task *p;  
 {  
         scm_gc();  
         return 0;  
 }  
   
 int  
 scheme_load_internal(p)  
         struct rad_scheme_task *p;  
 {  
         scm_primitive_load_path(scm_makfrom0str(p->procname));  
         return 0;  
 }  
   
112    
113  int          res = scm_internal_lazy_catch(
114  scheme_add_load_path_internal(p)                  SCM_BOOL_T,
115          struct rad_scheme_task *p;                  eval_catch_body,
116  {                  (void*) SCM_LIST4(procsym,
117          rscm_add_load_path(p->procname);                                    scm_listify(scm_copy_tree(SCM_IM_QUOTE),
118          return 0;                                                s_request,
119                                                  SCM_UNDEFINED),
120                                      scm_listify(scm_copy_tree(SCM_IM_QUOTE),
121                                                  s_check,
122                                                  SCM_UNDEFINED),
123                                      scm_listify(scm_copy_tree(SCM_IM_QUOTE),
124                                                  s_reply,
125                                                  SCM_UNDEFINED)),
126                    eval_catch_handler, &jmp_env);
127            
128            if (SCM_IMP(res) && SCM_BOOLP(res))
129                    return res == SCM_BOOL_F;
130            if (SCM_NIMP(res) && SCM_CONSP(res)) {
131                    int code = SCM_CAR(res);
132                    VALUE_PAIR *list = radscm_list_to_avl(SCM_CDR(res));
133                    avl_merge(user_reply_ptr, &list);
134                    avl_free(list);
135                    return code == SCM_BOOL_F;
136            }
137            /*FIXME: message*/
138            return 1;
139  }  }
140    
 /*ARGSUSED*/  
141  int  int
142  scheme_read_eval_loop_internal(unused)  scheme_acct(char *procname, RADIUS_REQ *req)
         struct rad_scheme_task *unused;  
143  {  {
144          SCM list;          SCM procsym, res;
145          int status;          jmp_buf jmp_env;
146          SCM sym_top_repl = RAD_SCM_SYMBOL_VALUE("top-repl");          SCM s_request = radscm_avl_to_list(req->request);
         SCM sym_begin = RAD_SCM_SYMBOL_VALUE("begin");  
           
         list = scm_cons(sym_begin, scm_list_1(scm_cons(sym_top_repl, SCM_EOL)));  
         status = scm_exit_status(scm_primitive_eval_x(list));  
         printf("%d\n", status);  
         return 0;  
 }  
   
 /* ************************************************************************* */  
 /* Functions running in arbitrary stack space */  
147    
148  void          /* Evaluate the procedure */
149  scheme_client_cleanup(arg)          procsym = scm_symbol_value0 (procname);
150          void *arg;          if (scm_procedure_p(procsym) != SCM_BOOL_T) {
151  {                  radlog(L_ERR,
152          struct rad_scheme_task *p = arg;                         _("%s is not a procedure object"), procname);
153                            return 1;
154          Pthread_mutex_unlock(&p->mutex);          }
155          pthread_mutex_destroy(&p->mutex);          if (setjmp(jmp_env))
156          pthread_cond_destroy(&p->cond);                  return 1;
157          p->state = RSCM_TASK_DONE;          res = scm_internal_lazy_catch(
158                    SCM_BOOL_T,
159                    eval_catch_body,
160                    (void*) SCM_LIST2(procsym,
161                                      scm_listify(SCM_IM_QUOTE,
162                                                  s_request,
163                                                  SCM_UNDEFINED)),
164                    eval_catch_handler, &jmp_env);
165            if (SCM_IMP(res) && SCM_BOOLP(res))
166                    return res == SCM_BOOL_F;
167            return 1;
168  }  }
169    
 int  
 scheme_generic_call(type, fun, procname, req, user_check, user_reply_ptr, timeout)  
         int type;  
         int (*fun)();  
         char *procname;  
         RADIUS_REQ *req;  
         VALUE_PAIR *user_check;  
         VALUE_PAIR **user_reply_ptr;  
         u_long timeout;  
 {  
         struct timespec atime;  
         struct timeval now;  
         struct rad_scheme_task *p = emalloc(sizeof(*p));  
         int rc;  
       
         while (!scheme_inited)  
                 sleep(1);  
         p->fun = fun;  
         p->procname = procname;  
         p->request = req;  
         p->user_check = user_check;  
         p->user_reply_ptr = user_reply_ptr;  
         p->state = RSCM_TASK_WAITING;  
         pthread_cond_init(&p->cond, NULL);  
         pthread_mutex_init(&p->mutex, NULL);  
           
         if (radiusd_mutex_lock(&server_mutex, type) == 0) {  
                 rad_scheme_place_task(p);  
                 debug(1, ("APP: Placed call"));  
   
                 Pthread_mutex_lock(&p->mutex);  
   
                 debug(50, ("APP: Signalling"));  
                 pthread_cond_signal(&server_cond);  
                 radiusd_mutex_unlock(&server_mutex);  
   
                 pthread_cleanup_push(scheme_client_cleanup, p);  
   
                 gettimeofday(&now, NULL);  
                 atime.tv_sec = now.tv_sec + timeout;  
                 atime.tv_nsec = 0;  
                   
                 while (p->state == RSCM_TASK_WAITING) {  
                         debug(50, ("APP: Waiting"));  
                         if (timeout) {  
                                 if (pthread_cond_timedwait(&p->cond, &p->mutex, &atime)  
                                     == ETIMEDOUT)  
                                         break;  
                         } else  
                                 pthread_cond_wait(&p->cond, &p->mutex);  
                 }  
   
                 if (p->state == RSCM_TASK_WAITING) {  
                         radlog(L_NOTICE, "%s: %s",  
                                 _("scheme task timed out"), procname);  
                 }  
                 rc = p->retval; /*FIXME*/  
                 pthread_cleanup_pop(1);  
         }        
           
         return rc;  
 }  
170    
171  void  void
172  scheme_load(filename)  scheme_load(char *filename)
         char *filename;  
173  {  {
174          scheme_generic_call(R_AUTH, scheme_load_internal, filename,          scm_primitive_load_path(scm_makfrom0str(filename));
                             NULL, NULL, NULL, 0);  
175  }  }
176    
177  void  void
178  scheme_before_config_hook(unused1, unused2)  scheme_end_reconfig()
         void *unused1;  
         void *unused2;  
179  {  {
180          scheme_generic_call(R_AUTH, scheme_before_config_internal,          scm_gc();
                             NULL, NULL, NULL, NULL, 0);  
 }  
   
 void  
 scheme_after_config_hook(unused1, unused2)  
         void *unused1;  
         void *unused2;  
 {  
         scheme_generic_call(R_AUTH, scheme_after_config_internal,  
                             NULL, NULL, NULL, NULL, 0);  
 }  
   
 u_long  
 scheme_compute_timeout(type)  
         int type;  
 {  
         u_long timeout = request_class[type].ttl/2 + 1;  
         if (scheme_task_timeout && scheme_task_timeout < timeout)  
                 timeout = scheme_task_timeout;  
         return timeout;  
 }  
   
 int  
 scheme_auth(procname, req, user_check, user_reply_ptr)  
         char *procname;  
         RADIUS_REQ *req;  
         VALUE_PAIR *user_check;  
         VALUE_PAIR **user_reply_ptr;  
 {  
         return scheme_generic_call(R_AUTH,  
                                    scheme_auth_internal,  
                                    procname, req, user_check, user_reply_ptr,  
                                    scheme_compute_timeout(R_AUTH));  
 }  
   
 int  
 scheme_acct(procname, req)  
         char *procname;  
         RADIUS_REQ *req;  
 {  
         return scheme_generic_call(R_ACCT,  
                                    scheme_acct_internal,  
                                    procname, req, NULL, NULL,  
                                    scheme_compute_timeout(R_ACCT));  
181  }  }
182    
183  void  void
184  scheme_read_eval_loop()  scheme_read_eval_loop()
185  {  {
186          scheme_generic_call(R_AUTH,          SCM list;
187                              scheme_read_eval_loop_internal,          int status;
188                              NULL, NULL, NULL, NULL, 0);          SCM sym_top_repl = scm_symbol_value0("top-repl");
189  }          SCM sym_begin = scm_symbol_value0("begin");
190            
191  void              list = scm_cons(sym_begin, SCM_LIST1(scm_cons(sym_top_repl, SCM_EOL)));
192  scheme_add_load_path(path)          status = scm_exit_status(scm_eval_x(list));
193          char *path;          printf("%d\n", status);
 {  
         scheme_generic_call(R_AUTH, scheme_add_load_path_internal,  
                             path, NULL, NULL, NULL, 0);  
194  }  }
195    
196  /* ************************************************************************* */  
197  /* Configuration issues */  /* *************************** Configuration ******************************* */
198    
199  int  int
200  guile_cfg_handler(argc, argv, block_data, handler_data)  guile_cfg_handler(int argc ARG_UNUSED, cfg_value_t *argv ARG_UNUSED,
201          int argc;                    void *block_data ARG_UNUSED, void *handler_data ARG_UNUSED)
         cfg_value_t *argv;  
         void *block_data;  
         void *handler_data;  
202  {  {
203          use_guile = 1;          use_guile = 1;
204          return 0;          return 0;
205  }  }
206    
207  static int  static int
208  scheme_cfg_add_load_path(argc, argv, block_data, handler_data)  scheme_cfg_add_load_path(int argc, cfg_value_t *argv,
209          int argc;                           void *block_data, void *handler_data)
         cfg_value_t *argv;  
         void *block_data;  
         void *handler_data;  
210  {  {
211          if (argc > 2) {          if (argc > 2) {
212                  cfg_argc_error(0);                  cfg_argc_error(0);
# Line 620  scheme_cfg_add_load_path(argc, argv, blo Line 221  scheme_cfg_add_load_path(argc, argv, blo
221          scheme_add_load_path(argv[1].v.string);          scheme_add_load_path(argv[1].v.string);
222          return 0;          return 0;
223  }  }
224            
225  static int  static int
226  scheme_cfg_load(argc, argv, block_data, handler_data)  scheme_cfg_load(int argc, cfg_value_t *argv, void *block_data,
227          int argc;                  void *handler_data)
         cfg_value_t *argv;  
         void *block_data;  
         void *handler_data;  
228  {  {
229          if (argc > 2) {          if (argc > 2) {
230                  cfg_argc_error(0);                  cfg_argc_error(0);
# Line 642  scheme_cfg_load(argc, argv, block_data, Line 240  scheme_cfg_load(argc, argv, block_data,
240  }  }
241    
242  static int  static int
243  scheme_cfg_debug(argc, argv, block_data, handler_data)  scheme_cfg_debug(int argc, cfg_value_t *argv,
244          int argc;                   void *block_data, void *handler_data)
         cfg_value_t *argv;  
         void *block_data;  
         void *handler_data;  
245  {  {
246          if (argc > 2) {          if (argc > 2) {
247                  cfg_argc_error(0);                  cfg_argc_error(0);
# Line 671  struct cfg_stmt guile_stmt[] = { Line 266  struct cfg_stmt guile_stmt[] = {
266            NULL, NULL},            NULL, NULL},
267          { NULL }          { NULL }
268  };  };
269      
270    
271  #endif  #endif

Legend:
Removed from v.1.34  
changed lines
  Added in v.1.35

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26