1 /* This file is part of GNU Radius.
2 Copyright (C) 2001,2002,2003,2004,2005,2007,
3 2008 Free Software Foundation, Inc.
4
5 Written by Sergey Poznyakoff
6
7 GNU Radius is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3 of the License, or
10 (at your option) any later version.
11
12 GNU Radius is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Radius; if not, write to the Free Software Foundation,
19 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
20
21 #ifdef HAVE_CONFIG_H
22 # include <config.h>
23 #endif
24
25 #include <unistd.h>
26 #include <fcntl.h>
27 #include <radiusd.h>
28 #include <setjmp.h>
29 #include <errno.h>
30
31 #ifdef USE_SERVER_GUILE
32 #include <libguile.h>
33 #include <radius/radscm.h>
34
35 static unsigned scheme_gc_interval = 3600;
36 static char *scheme_outfile = NULL;
37 static SCM scheme_error_port = SCM_EOL;
38
39 /* Protos to be moved to radscm */
40 SCM scm_makenum (unsigned long val);
41 SCM radscm_avl_to_list(grad_avp_t *pair);
42 grad_avp_t *radscm_list_to_avl(SCM list);
43 SCM radscm_avp_to_cons(grad_avp_t *pair);
44 grad_avp_t *radscm_cons_to_avp(SCM scm);
45
46 static void scheme_before_config_hook(void *a, void *b);
47
48
49 /* General-purpose eval handlers */
50
51 static SCM
eval_catch_body(void * list)52 eval_catch_body (void *list)
53 {
54 return RAD_SCM_EVAL((SCM)list);
55 }
56
57 static SCM
eval_catch_handler(void * data,SCM tag,SCM throw_args)58 eval_catch_handler (void *data, SCM tag, SCM throw_args)
59 {
60 scm_handle_by_message_noexit("radiusd", tag, throw_args);
61 longjmp(*(jmp_buf*)data, 1);
62 }
63
64
65 /* Configuration handlers and auxiliary functions */
66
67 static void
scheme_debug(int val)68 scheme_debug(int val)
69 {
70 SCM_DEVAL_P = val;
71 SCM_BACKTRACE_P = val;
72 SCM_RECORD_POSITIONS_P = val;
73 SCM_RESET_DEBUG_MODE;
74 }
75
76 static void
scheme_add_load_path(char * path)77 scheme_add_load_path(char *path)
78 {
79 rscm_add_load_path(path);
80 }
81
82 struct scheme_exec_data {
83 SCM (*handler) (void *data);
84 void *data;
85 SCM result;
86 };
87
88 static SCM
scheme_safe_exec_body(void * data)89 scheme_safe_exec_body (void *data)
90 {
91 struct scheme_exec_data *ed = data;
92 ed->result = ed->handler (ed->data);
93 return SCM_BOOL_F;
94 }
95
96 static int
scheme_safe_exec(SCM (* handler)(void * data),void * data,SCM * result)97 scheme_safe_exec(SCM (*handler) (void *data), void *data, SCM *result)
98 {
99 jmp_buf jmp_env;
100 struct scheme_exec_data ed;
101
102 if (setjmp(jmp_env))
103 return 1;
104 ed.handler = handler;
105 ed.data = data;
106 scm_internal_lazy_catch(SCM_BOOL_T,
107 scheme_safe_exec_body, (void*)&ed,
108 eval_catch_handler, &jmp_env);
109 if (result)
110 *result = ed.result;
111 return 0;
112 }
113
114 static SCM
load_path_handler(void * data)115 load_path_handler(void *data)
116 {
117 scm_primitive_load_path((SCM)data);
118 return SCM_UNDEFINED;
119 }
120
121 static int
scheme_load(char * filename)122 scheme_load(char *filename)
123 {
124 return scheme_safe_exec(load_path_handler, scm_makfrom0str(filename),
125 NULL);
126 }
127
128 static SCM
load_module_handler(void * data)129 load_module_handler(void *data)
130 {
131 scm_c_use_module(data);
132 return SCM_UNDEFINED;
133 }
134
135 static int
scheme_load_module(char * filename)136 scheme_load_module(char *filename)
137 {
138 return scheme_safe_exec(load_module_handler, filename, NULL);
139 }
140
141 static SCM
eval_expr(void * data)142 eval_expr(void *data)
143 {
144 return scm_eval_string((SCM)data);
145 }
146
147 static int
scheme_eval_expression(char * exp,SCM * result)148 scheme_eval_expression(char *exp, SCM *result)
149 {
150 return scheme_safe_exec(eval_expr, scm_makfrom0str(exp), result);
151 }
152
153 static void
scheme_end_reconfig()154 scheme_end_reconfig()
155 {
156 scm_gc();
157 }
158
159 void
scheme_read_eval_loop()160 scheme_read_eval_loop()
161 {
162 SCM list;
163 int status;
164 SCM sym_top_repl = RAD_SCM_SYMBOL_VALUE("top-repl");
165 SCM sym_begin = RAD_SCM_SYMBOL_VALUE("begin");
166
167 list = scm_cons(sym_begin, scm_list_1(scm_cons(sym_top_repl, SCM_EOL)));
168 status = scm_exit_status(RAD_SCM_EVAL_X(list));
169 printf("%d\n", status);
170 }
171
172 static SCM
close_port_handler(void * port)173 close_port_handler(void *port)
174 {
175 scm_close_port((SCM)port);
176 return SCM_UNDEFINED;
177 }
178
179 static void
silent_close_port(SCM port)180 silent_close_port(SCM port)
181 {
182 scheme_safe_exec(close_port_handler, port, NULL);
183 }
184
185 void
scheme_redirect_output()186 scheme_redirect_output()
187 {
188 SCM port;
189 char *mode = "a";
190 int fd = 2;
191
192 if (scheme_outfile) {
193 char *filename;
194
195 if (scheme_outfile[0] == '/')
196 filename = grad_estrdup(scheme_outfile);
197 else
198 filename = grad_mkfilename(grad_log_dir ?
199 grad_log_dir : RADLOG_DIR,
200 scheme_outfile);
201 fd = open(filename, O_RDWR|O_CREAT|O_APPEND, 0600);
202 if (fd == -1) {
203 grad_log(GRAD_LOG_ERR|GRAD_LOG_PERROR,
204 _("can't open file `%s'"),
205 filename);
206 fd = 2;
207 }
208 grad_free(filename);
209 }
210
211 port = scheme_error_port;
212 scheme_error_port = scm_fdes_to_port(fd, mode,
213 scm_makfrom0str("<standard error>"));
214 scm_set_current_output_port(scheme_error_port);
215 scm_set_current_error_port(scheme_error_port);
216 if (port != SCM_EOL)
217 silent_close_port(port);
218 }
219
220 int
scheme_call_proc(SCM * result,char * procname,SCM arglist)221 scheme_call_proc(SCM *result, char *procname, SCM arglist)
222 {
223 SCM procsym;
224 jmp_buf jmp_env;
225 SCM cell;
226
227 /* Evaluate the procedure */
228 procsym = RAD_SCM_SYMBOL_VALUE(procname);
229 if (scm_procedure_p(procsym) != SCM_BOOL_T) {
230 grad_log(GRAD_LOG_ERR,
231 _("%s is not a procedure object"), procname);
232 return 1;
233 }
234 if (setjmp(jmp_env)) {
235 grad_log(GRAD_LOG_NOTICE,
236 _("Procedure `%s' failed: see error output for details"),
237 procname);
238 return 1;
239 }
240 cell = scm_cons(procsym, arglist);
241 *result = scm_internal_lazy_catch(SCM_BOOL_T,
242 eval_catch_body, cell,
243 eval_catch_handler, &jmp_env);
244 return 0;
245 }
246
247 void
scheme_eval_unspecified_expr(char * expr)248 scheme_eval_unspecified_expr(char *expr)
249 {
250 scheme_eval_expression(expr, NULL);
251 }
252
253 int
scheme_eval_boolean_expr(char * expr)254 scheme_eval_boolean_expr(char *expr)
255 {
256 SCM result;
257 if (scheme_eval_expression(expr, &result))
258 return -1;
259 return result != SCM_BOOL_F;
260 }
261
262
263 /* Main loop */
264
265 static SCM
catch_body(void * data)266 catch_body(void *data)
267 {
268 SCM orig_load_path;
269
270 scheme_redirect_output();
271 scm_init_load_path();
272 grad_scm_init();
273 orig_load_path = RAD_SCM_SYMBOL_VALUE("%load-path");
274 radiusd_set_preconfig_hook(scheme_before_config_hook, orig_load_path,
275 0);
276 rscm_server_init();
277 scheme_load_module("radiusd");
278 radiusd_main();
279 return SCM_BOOL_F;
280 }
281
282 static SCM
catch_handler(void * data,SCM tag,SCM throw_args)283 catch_handler(void *data, SCM tag, SCM throw_args)
284 {
285 return scm_handle_by_message_noexit("radiusd", tag, throw_args);
286 }
287
288
289 static void
scheme_before_config_hook(void * data,void * b ARG_UNUSED)290 scheme_before_config_hook(void *data, void *b ARG_UNUSED)
291 {
292 SCM *pscm;
293 pscm = SCM_VARIABLE_LOC(scm_c_lookup("%load-path"));
294 *pscm = (SCM) data;
295 }
296
297 void
scheme_boot(void * closure,int argc,char ** argv)298 scheme_boot(void *closure, int argc, char **argv)
299 {
300 scm_internal_catch(SCM_BOOL_T,
301 catch_body, closure,
302 catch_handler, NULL);
303 }
304
305
306 void
scheme_main()307 scheme_main()
308 {
309 char *argv[] = { "radiusd", NULL };
310 scm_boot_guile (1, argv, scheme_boot, NULL);
311 }
312
313
314 /* Entry points for main Radius tasks */
315
316 int
scheme_try_auth(int auth_type,radiusd_request_t * req,grad_avp_t * user_check,grad_avp_t ** user_reply_ptr)317 scheme_try_auth(int auth_type, radiusd_request_t *req,
318 grad_avp_t *user_check,
319 grad_avp_t **user_reply_ptr)
320 {
321 SCM s_request, s_check, s_reply;
322 SCM res;
323 grad_avp_t *tmp =
324 radius_decrypt_request_pairs(req,
325 grad_avl_dup(req->request->avlist));
326 static char *try_auth = "radiusd-try-auth";
327
328 s_request = radscm_avl_to_list(tmp);
329 radius_destroy_pairs(&tmp);
330 s_check = radscm_avl_to_list(user_check);
331 s_reply = radscm_avl_to_list(*user_reply_ptr);
332
333 if (scheme_call_proc(&res,
334 try_auth,
335 scm_list_4(scm_cons(SCM_IM_QUOTE, auth_type),
336 scm_cons(SCM_IM_QUOTE, s_request),
337 scm_cons(SCM_IM_QUOTE, s_check),
338 scm_cons(SCM_IM_QUOTE, s_reply))))
339 return 1;
340
341 if (SCM_IMP(res) && SCM_BOOLP(res))
342 return res == SCM_BOOL_F;
343 if (SCM_NIMP(res) && SCM_CONSP(res)) {
344 SCM code = SCM_CAR(res);
345 grad_avp_t *list = radscm_list_to_avl(SCM_CDR(res));
346 grad_avl_merge(user_reply_ptr, &list);
347 grad_avl_free(list);
348 return code == SCM_BOOL_F;
349 }
350 grad_log(GRAD_LOG_ERR,
351 _("Unexpected return value from Guile authentication function `%s'"),
352 try_auth);
353 return 1;
354 }
355
356 int
scheme_auth(char * procname,radiusd_request_t * req,grad_avp_t * user_check,grad_avp_t ** user_reply_ptr)357 scheme_auth(char *procname, radiusd_request_t *req,
358 grad_avp_t *user_check,
359 grad_avp_t **user_reply_ptr)
360 {
361 SCM s_request, s_check, s_reply;
362 SCM res;
363 grad_avp_t *tmp =
364 radius_decrypt_request_pairs(req,
365 grad_avl_dup(req->request->avlist));
366
367 s_request = radscm_avl_to_list(tmp);
368 radius_destroy_pairs(&tmp);
369 s_check = radscm_avl_to_list(user_check);
370 s_reply = radscm_avl_to_list(*user_reply_ptr);
371
372 if (scheme_call_proc(&res,
373 procname,
374 scm_list_3(scm_cons(SCM_IM_QUOTE, s_request),
375 scm_cons(SCM_IM_QUOTE, s_check),
376 scm_cons(SCM_IM_QUOTE, s_reply))))
377 return 1;
378
379 if (SCM_IMP(res) && SCM_BOOLP(res))
380 return res == SCM_BOOL_F;
381 if (SCM_NIMP(res) && SCM_CONSP(res)) {
382 SCM code = SCM_CAR(res);
383 grad_avp_t *list = radscm_list_to_avl(SCM_CDR(res));
384 grad_avl_merge(user_reply_ptr, &list);
385 grad_avl_free(list);
386 return code == SCM_BOOL_F;
387 }
388 grad_log(GRAD_LOG_ERR,
389 _("Unexpected return value from Guile authentication function `%s'"),
390 procname);
391 return 1;
392 }
393
394 int
scheme_acct(char * procname,radiusd_request_t * req)395 scheme_acct(char *procname, radiusd_request_t *req)
396 {
397 SCM res;
398 SCM s_request = radscm_avl_to_list(req->request->avlist);
399
400 if (scheme_call_proc(&res,
401 procname,
402 scm_list_1(scm_cons(SCM_IM_QUOTE, s_request))))
403 return 1;
404
405 if (SCM_IMP(res) && SCM_BOOLP(res))
406 return res == SCM_BOOL_F;
407 else
408 grad_log(GRAD_LOG_ERR,
409 _("Unexpected return value from Guile accounting function `%s'"),
410 procname);
411
412 return 1;
413 }
414
415
416 /* *************************** Configuration ******************************* */
417
418 int
guile_cfg_handler(int argc ARG_UNUSED,cfg_value_t * argv ARG_UNUSED,void * block_data ARG_UNUSED,void * handler_data ARG_UNUSED)419 guile_cfg_handler(int argc ARG_UNUSED, cfg_value_t *argv ARG_UNUSED,
420 void *block_data ARG_UNUSED, void *handler_data ARG_UNUSED)
421 {
422 use_guile = 1;
423 return 0;
424 }
425
426 static int
scheme_cfg_add_load_path(int argc,cfg_value_t * argv,void * block_data,void * handler_data)427 scheme_cfg_add_load_path(int argc, cfg_value_t *argv,
428 void *block_data, void *handler_data)
429 {
430 if (argc > 2) {
431 cfg_argc_error(0);
432 return 0;
433 }
434
435 if (argv[1].type != CFG_STRING) {
436 cfg_type_error(CFG_STRING);
437 return 0;
438 }
439
440 scheme_add_load_path(argv[1].v.string);
441 return 0;
442 }
443
444 static int
scheme_cfg_load(int argc,cfg_value_t * argv,void * block_data,void * handler_data)445 scheme_cfg_load(int argc, cfg_value_t *argv, void *block_data,
446 void *handler_data)
447 {
448 if (argc > 2) {
449 cfg_argc_error(0);
450 return 0;
451 }
452
453 if (argv[1].type != CFG_STRING) {
454 cfg_type_error(CFG_STRING);
455 return 0;
456 }
457 scheme_load(argv[1].v.string);
458 return 0;
459 }
460
461 static SCM
arglist_to_scm(int argc,cfg_value_t * argv)462 arglist_to_scm(int argc, cfg_value_t *argv)
463 {
464 SCM head = SCM_EOL,
465 tail; /* Don't let gcc fool you: tail cannot be used
466 uninitialized */
467 SCM val;
468 int i;
469 unsigned long num;
470
471 for (i = 1; i < argc; i++) {
472 SCM cell;
473
474 switch (argv[i].type) {
475 case CFG_INTEGER:
476 val = scm_from_long(argv[i].v.number);
477 break;
478
479 case CFG_BOOLEAN:
480 val = argv[i].v.bool ? SCM_BOOL_T : SCM_BOOL_F;
481 break;
482
483 case CFG_STRING:
484 {
485 char *p = argv[i].v.string;
486 if (p[0] == '#') {
487 switch (p[1]) {
488 case ':':
489 val = scm_c_make_keyword(p + 2);
490 break;
491 case 'f':
492 val = SCM_BOOL_F;
493 break;
494
495 case 't':
496 val = SCM_BOOL_T;
497 break;
498 case 'x':
499 num = strtoul(p+1, &p, 16);
500 if (*p) {
501 grad_log(GRAD_LOG_ERR,
502 _("Invalid hex number: %s"),
503 argv[i].v.string);
504 return SCM_BOOL_F;
505 }
506 val = scm_from_long(num);
507 default:
508 val = scm_makfrom0str(p);
509 }
510 } else if (p[0] == '-')
511 val = scm_c_make_keyword(p + 1);
512 else
513 val = scm_makfrom0str(p);
514 }
515 break;
516
517 case CFG_NETWORK:
518 val = scm_cons(scm_from_ulong(argv[i].v.network.ipaddr),
519 scm_from_ulong(argv[i].v.network.netmask));
520 break;
521
522 case CFG_IPADDR:
523 case CFG_PORT:
524 grad_insist_fail("Such CFG_ value should never be returned");
525 break;
526
527 case CFG_CHAR:
528 val = SCM_MAKE_CHAR(argv[i].v.ch);
529 break;
530
531 case CFG_HOST:
532 val = scm_cons(scm_from_long(argv[i].v.host.ipaddr),
533 scm_from_long(argv[i].v.host.port));
534 }
535
536 cell = scm_cons(scm_cons(SCM_IM_QUOTE, val), SCM_EOL);
537
538 if (head == SCM_EOL)
539 head = cell;
540 else
541 SCM_SETCDR(tail, cell);
542 tail = cell;
543 }
544
545 if (head != SCM_EOL)
546 SCM_SETCDR(tail, SCM_EOL);
547 return head;
548 }
549
550 #define INIT_SUFFIX "-init"
551 static void
call_module_init(const char * modname,SCM arglist)552 call_module_init(const char *modname, SCM arglist)
553 {
554 char *p = grad_emalloc(strlen(modname) + sizeof(INIT_SUFFIX));
555 SCM res;
556
557 strcat(strcpy(p, modname), INIT_SUFFIX);
558 scheme_call_proc(&res, p, arglist);
559 grad_free(p);
560 }
561
562 static int
scheme_cfg_load_module(int argc,cfg_value_t * argv,void * block_data,void * handler_data)563 scheme_cfg_load_module(int argc, cfg_value_t *argv, void *block_data,
564 void *handler_data)
565 {
566 if (argc < 2) {
567 cfg_argc_error(0);
568 return 0;
569 }
570
571 if (argv[1].type != CFG_STRING) {
572 cfg_type_error(CFG_STRING);
573 return 0;
574 }
575
576 if (scheme_load_module(argv[1].v.string) == 0) {
577 if (argc > 2) {
578 SCM arglist = arglist_to_scm(argc - 1, argv + 1);
579 call_module_init(argv[1].v.string, arglist);
580 }
581 }
582 return 0;
583 }
584
585 static int
scheme_cfg_eval(int argc,cfg_value_t * argv,void * block_data,void * handler_data)586 scheme_cfg_eval(int argc, cfg_value_t *argv, void *block_data,
587 void *handler_data)
588 {
589 int i;
590
591 if (argc < 2) {
592 cfg_argc_error(0);
593 return 0;
594 }
595
596 for (i = 1; i < argc; i++) {
597 if (argv[i].type != CFG_STRING)
598 cfg_type_error(CFG_STRING);
599 else
600 scheme_eval_expression(argv[i].v.string, NULL);
601 }
602 return 0;
603 }
604
605 static int
scheme_cfg_debug(int argc,cfg_value_t * argv,void * block_data,void * handler_data)606 scheme_cfg_debug(int argc, cfg_value_t *argv,
607 void *block_data, void *handler_data)
608 {
609 if (argc > 2) {
610 cfg_argc_error(0);
611 return 0;
612 }
613
614 if (argv[1].type != CFG_BOOLEAN) {
615 cfg_type_error(CFG_BOOLEAN);
616 return 0;
617 }
618 scheme_debug(argv[1].v.bool);
619 return 0;
620 }
621
622 static int
scheme_cfg_outfile(int argc,cfg_value_t * argv,void * block_data,void * handler_data)623 scheme_cfg_outfile(int argc, cfg_value_t *argv,
624 void *block_data, void *handler_data)
625 {
626 if (argc > 2) {
627 cfg_argc_error(0);
628 return 0;
629 }
630
631 if (argv[1].type != CFG_STRING) {
632 cfg_type_error(CFG_STRING);
633 return 0;
634 }
635 grad_free(scheme_outfile);
636 scheme_outfile = grad_estrdup(argv[1].v.string);
637 return 0;
638 }
639
640 struct cfg_stmt guile_stmt[] = {
641 { "load-path", CS_STMT, NULL, scheme_cfg_add_load_path, NULL, NULL, NULL },
642 { "load", CS_STMT, NULL, scheme_cfg_load, NULL, NULL, NULL },
643 { "load-module", CS_STMT, NULL, scheme_cfg_load_module, NULL, NULL, NULL },
644 { "eval", CS_STMT, NULL, scheme_cfg_eval, NULL, NULL, NULL },
645 { "debug", CS_STMT, NULL, scheme_cfg_debug, NULL, NULL, NULL },
646 { "outfile", CS_STMT, NULL, scheme_cfg_outfile, NULL, NULL, NULL },
647 { "gc-interval", CS_STMT, NULL, cfg_get_unsigned, &scheme_gc_interval,
648 NULL, NULL },
649 { NULL }
650 };
651
652 #else
653
654 #include <radius/radius.h>
655
656 int
scheme_try_auth(int auth_type,radiusd_request_t * req,grad_avp_t * user_check,grad_avp_t ** user_reply_ptr)657 scheme_try_auth(int auth_type, radiusd_request_t *req,
658 grad_avp_t *user_check,
659 grad_avp_t **user_reply_ptr)
660 {
661 return 1;
662 }
663
664 void
scheme_eval_unspecified_expr(char * expr)665 scheme_eval_unspecified_expr(char *expr)
666 {
667 }
668
669 int
scheme_eval_boolean_expr(char * expr)670 scheme_eval_boolean_expr(char *expr)
671 {
672 return -1;
673 }
674
675 #endif
676
677 int
scheme_eval_avl(radiusd_request_t * request,grad_avp_t * lhs,grad_avp_t * rhs,grad_avp_t ** reply,grad_avp_t ** pfailed)678 scheme_eval_avl (radiusd_request_t *request,
679 grad_avp_t *lhs, grad_avp_t *rhs,
680 grad_avp_t **reply,
681 grad_avp_t **pfailed)
682 {
683 #ifdef USE_SERVER_GUILE
684 int rc = 0;
685 grad_avp_t *p;
686
687 if (!use_guile) {
688 grad_log_req(GRAD_LOG_ERR, request->request,
689 _("Guile authentication disabled in config"));
690 return -1;
691 }
692
693 for (p = rhs; p; p = p->next) {
694 if (p->attribute == DA_SCHEME_PROCEDURE) {
695 rc = scheme_auth(p->avp_strvalue, request, lhs,
696 reply);
697 if (rc) {
698 if (pfailed)
699 *pfailed = p;
700 break;
701 }
702 }
703 }
704
705 return rc;
706 #else
707 grad_log_req(GRAD_LOG_ERR, request->request,
708 _("Guile authentication not available"));
709 return -1;
710 #endif
711 }
712