/[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.37 by gray, Thu May 22 13:53:18 2003 UTC revision 1.38 by gray, Thu May 29 15:39:52 2003 UTC
# Line 24  Line 24 
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);
# Line 96  scheme_auth(char *procname, RADIUS_REQ * Line 99  scheme_auth(char *procname, RADIUS_REQ *
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"));
# Line 148  scheme_acct(char *procname, RADIUS_REQ * Line 151  scheme_acct(char *procname, RADIUS_REQ *
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);
# Line 200  scheme_read_eval_loop() Line 203  scheme_read_eval_loop()
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    
# Line 275  scheme_cfg_debug(int argc, cfg_value_t * Line 313  scheme_cfg_debug(int argc, cfg_value_t *
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 }

Legend:
Removed from v.1.37  
changed lines
  Added in v.1.38

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