24 |
#ifdef USE_SERVER_GUILE |
#ifdef USE_SERVER_GUILE |
25 |
|
|
26 |
#include <unistd.h> |
#include <unistd.h> |
27 |
|
#include <fcntl.h> |
28 |
#include <radiusd.h> |
#include <radiusd.h> |
29 |
#include <libguile.h> |
#include <libguile.h> |
30 |
#include <radscm.h> |
#include <radscm.h> |
31 |
#include <setjmp.h> |
#include <setjmp.h> |
32 |
#include <errno.h> |
#include <errno.h> |
33 |
|
|
34 |
unsigned scheme_gc_interval = 3600; |
static unsigned scheme_gc_interval = 3600; |
35 |
|
static char *scheme_outfile = NULL; |
36 |
|
static SCM scheme_error_port = SCM_EOL; |
37 |
|
|
38 |
/* Protos to be moved to radscm */ |
/* Protos to be moved to radscm */ |
39 |
SCM scm_makenum (unsigned long val); |
SCM scm_makenum (unsigned long val); |
99 |
SCM s_request, s_check, s_reply; |
SCM s_request, s_check, s_reply; |
100 |
SCM res, env; |
SCM res, env; |
101 |
SCM procsym; |
SCM procsym; |
102 |
jmp_buf jmp_env; |
jmp_buf jmp_env; |
103 |
|
|
104 |
s_request = radscm_avl_to_list(req->request); |
s_request = radscm_avl_to_list(req->request); |
105 |
s_check = radscm_avl_to_list(user_check); |
s_check = radscm_avl_to_list(user_check); |
106 |
s_reply = radscm_avl_to_list(*user_reply_ptr); |
s_reply = radscm_avl_to_list(*user_reply_ptr); |
107 |
|
|
108 |
/* Evaluate the procedure */ |
/* Evaluate the procedure */ |
109 |
procsym = scm_symbol_value0 (procname); |
procsym = RAD_SCM_SYMBOL_VALUE(procname); |
110 |
if (scm_procedure_p(procsym) != SCM_BOOL_T) { |
if (scm_procedure_p(procsym) != SCM_BOOL_T) { |
111 |
radlog(L_ERR, |
radlog(L_ERR, |
112 |
_("procname is not a procedure object")); |
_("procname is not a procedure object")); |
151 |
SCM s_request = radscm_avl_to_list(req->request); |
SCM s_request = radscm_avl_to_list(req->request); |
152 |
|
|
153 |
/* Evaluate the procedure */ |
/* Evaluate the procedure */ |
154 |
procsym = scm_symbol_value0 (procname); |
procsym = RAD_SCM_SYMBOL_VALUE(procname); |
155 |
if (scm_procedure_p(procsym) != SCM_BOOL_T) { |
if (scm_procedure_p(procsym) != SCM_BOOL_T) { |
156 |
radlog(L_ERR, |
radlog(L_ERR, |
157 |
_("%s is not a procedure object"), procname); |
_("%s is not a procedure object"), procname); |
203 |
printf("%d\n", status); |
printf("%d\n", status); |
204 |
} |
} |
205 |
|
|
206 |
|
void |
207 |
|
silent_close_port(SCM port) |
208 |
|
{ |
209 |
|
jmp_buf jmp_env; |
210 |
|
|
211 |
|
if (setjmp(jmp_env)) |
212 |
|
return; |
213 |
|
scm_internal_lazy_catch(SCM_BOOL_T, |
214 |
|
scm_close_port, (void*)port, |
215 |
|
eval_catch_handler, &jmp_env); |
216 |
|
} |
217 |
|
|
218 |
void |
void |
219 |
scheme_redirect_output() |
scheme_redirect_output() |
220 |
{ |
{ |
221 |
SCM port; |
SCM port; |
222 |
char *mode = "a"; |
char *mode = "a"; |
223 |
|
int fd = 2; |
224 |
|
|
225 |
|
if (scheme_outfile) { |
226 |
|
char *filename; |
227 |
|
|
228 |
|
if (scheme_outfile[0] == '/') |
229 |
|
filename = estrdup(scheme_outfile); |
230 |
|
else |
231 |
|
filename = mkfilename(radlog_dir ? |
232 |
|
radlog_dir : RADLOG_DIR, |
233 |
|
scheme_outfile); |
234 |
|
fd = open(filename, O_RDWR|O_CREAT|O_APPEND, 0600); |
235 |
|
if (fd == -1) { |
236 |
|
radlog(L_ERR|L_PERROR, |
237 |
|
_("can't open file `%s'"), |
238 |
|
filename); |
239 |
|
fd = 2; |
240 |
|
} |
241 |
|
efree(filename); |
242 |
|
} |
243 |
|
|
244 |
port = scm_fdes_to_port(2, mode, scm_makfrom0str("outport")); |
port = scheme_error_port; |
245 |
scm_set_current_output_port(port); |
scheme_error_port = scm_fdes_to_port(fd, mode, |
246 |
scm_set_current_error_port(port); |
scm_makfrom0str("<standard error>")); |
247 |
|
scm_set_current_output_port(scheme_error_port); |
248 |
|
scm_set_current_error_port(scheme_error_port); |
249 |
|
if (port != SCM_EOL) |
250 |
|
silent_close_port(port); |
251 |
} |
} |
252 |
|
|
253 |
|
|
313 |
return 0; |
return 0; |
314 |
} |
} |
315 |
|
|
316 |
|
static int |
317 |
|
scheme_cfg_outfile(int argc, cfg_value_t *argv, |
318 |
|
void *block_data, void *handler_data) |
319 |
|
{ |
320 |
|
if (argc > 2) { |
321 |
|
cfg_argc_error(0); |
322 |
|
return 0; |
323 |
|
} |
324 |
|
|
325 |
|
if (argv[1].type != CFG_STRING) { |
326 |
|
cfg_type_error(CFG_STRING); |
327 |
|
return 0; |
328 |
|
} |
329 |
|
efree(scheme_outfile); |
330 |
|
scheme_outfile = estrdup(argv[1].v.string); |
331 |
|
return 0; |
332 |
|
} |
333 |
|
|
334 |
struct cfg_stmt guile_stmt[] = { |
struct cfg_stmt guile_stmt[] = { |
335 |
{ "load-path", CS_STMT, NULL, scheme_cfg_add_load_path, NULL, NULL, NULL }, |
{ "load-path", CS_STMT, NULL, scheme_cfg_add_load_path, NULL, NULL, NULL }, |
336 |
{ "load", CS_STMT, NULL, scheme_cfg_load, NULL, NULL, NULL }, |
{ "load", CS_STMT, NULL, scheme_cfg_load, NULL, NULL, NULL }, |
337 |
{ "debug", CS_STMT, NULL, scheme_cfg_debug, NULL, NULL, NULL }, |
{ "debug", CS_STMT, NULL, scheme_cfg_debug, NULL, NULL, NULL }, |
338 |
|
{ "outfile", CS_STMT, NULL, scheme_cfg_outfile, NULL, NULL, NULL }, |
339 |
{ "gc-interval", CS_STMT, NULL, cfg_get_integer, &scheme_gc_interval, |
{ "gc-interval", CS_STMT, NULL, cfg_get_integer, &scheme_gc_interval, |
340 |
NULL, NULL }, |
NULL, NULL }, |
341 |
{ NULL } |
{ NULL } |