home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Extensions / process.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-06-16  |  16.5 KB  |  622 lines
  1. /******************************************************************************
  2.  *
  3.  * Process extended type definition
  4.  *
  5.  ******************************************************************************/
  6.  
  7. #include "stk.h"
  8. #include <fcntl.h>
  9. #include <errno.h>
  10. #include <sys/param.h>
  11. #include <sys/wait.h>
  12. #include <sys/stat.h>
  13. #include <unistd.h>
  14. #include <signal.h>
  15.  
  16. static int tc_process;                /* Process signature */
  17.  
  18. /*
  19.  * Data 
  20.  */
  21.  
  22. #define MAX_PROC_NUM      40         /* (simultaneous processes) enough? */
  23.  
  24. struct process_info {
  25.   int pid;                      /* Process id */
  26.   int index;            /* index of process in the table of processes */
  27.   SCM stream[3];        /* Redirections for stdin stdout and stderr */
  28.   int exited;            /* Process is terminated */
  29.   int exit_status;        /* Exit status of the processus */
  30. };
  31.  
  32. #define PROCESS(x)        ((struct process_info *)((x)->storage_as.extension.data))
  33. #define LPROCESS(x)      ((x)->storage_as.extension.data)
  34. #define PROCESSP(x)       (TYPEP ((x), tc_process))
  35. #define NPROCESSP(x)      (NTYPEP ((x), tc_process))
  36. #define PROCPID(x)        (PROCESS(x)->pid)
  37.  
  38. static SCM proc_arr[MAX_PROC_NUM];       /* for registering processes */
  39.  
  40. static char *stdStreams[3] = {
  41.   "input",    
  42.   "output",    
  43.   "error",
  44. };
  45.  
  46. static char key_inp[] = ":input";
  47. static char key_out[] = ":output";
  48. static char key_err[] = ":error";
  49. static char key_wit[] = ":wait";
  50. static char key_hst[] = ":host";
  51.  
  52. #if defined(SIGCHLD) && !defined(HPUX)
  53. #  define USE_SIGCHLD 1 /* What's the problem with HP? */
  54. #endif
  55.  
  56. #ifdef USE_SIGCHLD
  57. #define PURGE_PROCESS_TABLE()    /* Nothing to do */
  58. #else
  59. #define PURGE_PROCESS_TABLE() process_terminate_handler(0) /* Simulate a SIGCHLD */
  60. #endif
  61.  
  62.  
  63.  
  64. /******************************************************************************/
  65.  
  66. static void init_proc_table(void)
  67. {
  68.   int i;
  69.  
  70.   for(i = 0; i<MAX_PROC_NUM; i++) proc_arr[i] = Ntruth;
  71. }
  72.  
  73.  
  74. static int find_process(SCM prc)
  75. {
  76.   int i;
  77.  
  78.   for(i = 0; i<MAX_PROC_NUM; i++)
  79.     if(prc==proc_arr[i]) return i;
  80.   return (-1);
  81. }
  82.  
  83. static int internal_process_alivep(SCM process)
  84. {
  85.   int info, res;
  86.  
  87.   if (PROCESS(process)->exited) 
  88.     return FALSE;
  89.   else {
  90.     /* Use waitpid to gain the info. */
  91.     res = waitpid(PROCPID(process), &info, WNOHANG);
  92.     if (res == 0) 
  93.       /* process is still running */
  94.       return TRUE;
  95.     else {
  96.       /* process has terminated and we must save this information */
  97.       PROCESS(process)->exited      = TRUE;
  98.       PROCESS(process)->exit_status = info;
  99.       return FALSE;
  100.     }
  101.   }
  102. }
  103.  
  104. static void process_terminate_handler(int sig) /* called when a child dies */
  105. {
  106.   register int i;
  107.   SCM proc;
  108.  
  109. #if defined(USE_SIGCHLD) && !defined(HAVE_SIGACTION)
  110.   static int in_handler = 0;
  111.  
  112.   signal(SIGCHLD, process_terminate_handler); /* Necessary on System V */
  113.   if (in_handler++) /* Execution is re-entrant */ return;
  114.   
  115.   do {
  116. #endif
  117.     /* Find the process which is terminated 
  118.      * Note that this loop can find:
  119.      *      - nobody: if the process has been destroyed by GC
  120.      *      - 1 process: This is the normal case
  121.      *        - more than one process: This can arise when:
  122.      *           - we use signal rather than sigaction 
  123.      *           - we don't have SIGCHLD and this function is called by
  124.      *             PURGE_PROCESS_TABLE
  125.      * Sometimes I think that life is a little bit complicated.... 
  126.      */
  127.     for(i = 0; i<MAX_PROC_NUM; i++) {
  128.       proc = proc_arr[i];
  129.       if (PROCESSP(proc) && !internal_process_alivep(proc))
  130.     /* This process has exited. We can delete it from the table */
  131.     proc_arr[i] = Ntruth;
  132.     }
  133.  
  134. #if defined(USE_SIGCHLD) && !defined(HAVE_SIGACTION)
  135.     /* Since we can be called recursively, we have perhaps forgot to delete 
  136.      * some dead process from the table. So, we have perhaps to scan 
  137.      * the process array another time
  138.      */
  139.   } while (--in_handler > 0);
  140. #endif
  141. }
  142.  
  143.  
  144. static SCM make_process(void)
  145. {
  146.   int i;
  147.   SCM z;
  148.  
  149.   PURGE_PROCESS_TABLE();
  150.  
  151.   /* find slot */
  152.   i = find_process(Ntruth);
  153.   if (i < 0){
  154.     STk_gc_for_newcell();
  155.     i = find_process(Ntruth);
  156.   }
  157.   if (i < 0) Err("Too many processes", NIL);
  158.  
  159.   NEWCELL(z, tc_process);
  160.   LPROCESS(z) = (struct process_info *) must_malloc(sizeof(struct process_info));
  161.   PROCESS(z)->index = i;
  162.   PROCESS(z)->stream[0] =  PROCESS(z)->stream[1] = PROCESS(z)->stream[2] = Ntruth;
  163.   PROCESS(z)->exit_status = PROCESS(z)->exited = 0;
  164.   /* Enter this process in the process table */
  165.   proc_arr[i] = z;
  166.   return z;
  167. }
  168.  
  169.  
  170. static void cannot_run(int pipes[3][2], char **argv, char *msg, SCM obj)
  171. {
  172.   int i;
  173.  
  174.   for (i=0; i<3; i++) {
  175.     if (pipes[i][0] != -1) close(pipes[i][0]);
  176.     if (pipes[i][1] != -1) close(pipes[i][1]);
  177.   }
  178.   free(argv);
  179.   Err(msg, obj);
  180. }
  181.  
  182.  
  183. static PRIMITIVE run_process(SCM l, int len)
  184. {
  185.   SCM proc, tmp, redirection[3];
  186.   int pid, i, argc, waiting, pipes[3][2];
  187.   struct process_info *info;
  188.   char host[100], msg[256], **argv, **argv_start;
  189.  
  190.   /* Initializations */
  191.   argc = 0; waiting = FALSE;
  192.   argv_start = (char**)must_malloc((len+3)*sizeof(char *)); /* 3= NULL+rsh+host */
  193.   argv = argv_start + 2;
  194.   
  195.   for (i = 0; i < 3; i++) {
  196.     redirection[i] = NIL;
  197.     pipes[i][0] =  pipes[i][1] = -1;
  198.   }
  199.  
  200.   /* Checking arguments and creating UNIX-style arguments list */
  201.   for (  ; NNULLP(l); l = CDR(l)) {
  202.     tmp = CAR(l);
  203.     if (KEYWORDP(tmp)) {
  204.       /* Manage :input, :output, :error and :no-wait keywords */
  205.       int i = -1;
  206.  
  207.       if (NCONSP(CDR(l))) 
  208.     cannot_run(pipes, argv_start,"run-process: no argument after keyword", tmp);
  209.       
  210.       l = CDR(l); /* Go to next item */
  211.       
  212.       if (STk_eqv(tmp, STk_makekey(key_hst)) == Truth) {
  213.     /* :host keyword processing */
  214.     if (NSTRINGP(CAR(l)))
  215.       cannot_run(pipes, argv_start, 
  216.              "run-process: string expected. It was", CAR(l));
  217.     strcpy(host, CHARS(CAR(l))); /* to avoid GC problems */
  218.     /* Shift argv to point the start of allocated zone. This avoid a copy
  219.      * of arguments already processed.
  220.      */
  221.     argv    = argv_start;
  222.     argc   += 2;
  223.     argv[0] = "rsh";
  224.     argv[1] = host;
  225.       }
  226.       else {
  227.     if (STk_eqv(tmp, STk_makekey(key_wit)) == Truth) {
  228.       /* :wait option processing */
  229.       if (NBOOLEANP(CAR(l))) 
  230.         cannot_run(pipes, argv_start,
  231.                "run-process: boolean expected. It was", CAR(l));
  232.       
  233.       waiting = (CAR(l) == Truth);
  234.     }
  235.     else {
  236.       /* :input, :output, :error option processing */
  237.       if (STk_eqv(tmp, STk_makekey(key_inp)) == Truth) i = 0; else
  238.       if (STk_eqv(tmp, STk_makekey(key_out)) == Truth) i = 1; else
  239.       if (STk_eqv(tmp, STk_makekey(key_err)) == Truth) i = 2;
  240.       
  241.       if (i < 0) cannot_run(pipes, argv_start, "run-process: bad keyword", tmp);
  242.       redirection[i] = CAR(l);
  243.       
  244.       if (STRINGP(redirection[i])) {
  245.         /* Redirection in a file */
  246.         int j;
  247.  
  248.         /* 
  249.          * First try to look if this redirecttion has not already done
  250.          * This can arise by doing
  251.          *     :output "out" :error "out"       which is correct
  252.          *     :output "out" :input "out"       which is obviously incorrect
  253.          */
  254.         for (j = 0; j < 3; j++) {
  255.           if (j != i && STRINGP(redirection[j])) {
  256.         struct stat stat_i, stat_j;
  257.         
  258.         /* Do a stat to see if we try to open the same file 2 times     */
  259.         /* if stat == -1 this is probably because file doen't exist yet */
  260.         if (stat(CHARS(redirection[i]), &stat_i) == -1) continue;
  261.         if (stat(CHARS(redirection[j]), &stat_j) == -1) continue;
  262.         
  263.         if (stat_i.st_dev==stat_j.st_dev && stat_i.st_ino==stat_j.st_ino) {
  264.           /* Same file was cited 2 times */
  265.           if (i == 0 || j == 0) {
  266.             sprintf(msg, "run-process: read/write on the same file: %s",
  267.                      CHARS(redirection[i]));
  268.             cannot_run(pipes, argv_start, msg, NIL);
  269.           }
  270.           
  271.           /* assert(i == 1 && j == 2 || i == 2 && j == 1); */
  272.           pipes[i][0] = dup(pipes[j][0]);
  273.           break;
  274.         }
  275.           }
  276.         }        
  277.  
  278.         /* 
  279.          * Two cases are possible here:
  280.          *       - We have stdout and stderr redirected on the same file (j != 3)
  281.          *      - We have not found current file in list of redirections (j == 3)
  282.          */
  283.         if (j == 3) {
  284.           pipes[i][0] = open(CHARS(redirection[i]), 
  285.                  i==0 ? O_RDONLY:(O_WRONLY|O_CREAT|O_TRUNC),
  286.                  0666);
  287.         }
  288.         
  289.         if(pipes[i][0] < 0) {
  290.           sprintf(msg, "run-process: can't redirect standard %s to file %s",
  291.               stdStreams[i], CHARS(redirection[i]));
  292.           cannot_run(pipes, argv_start, msg, NIL);
  293.         }
  294.       }
  295.       else 
  296.         if (KEYWORDP(redirection[i])) {
  297.           /* Redirection in a pipe */
  298.           if (pipe(pipes[i]) < 0) {
  299.         sprintf(msg, "run-process: can't create stream for standard %s",
  300.             stdStreams[i]);
  301.         cannot_run(pipes, argv_start, msg, NIL);
  302.           }
  303.         }
  304.     }
  305.       }
  306.     }
  307.     else {
  308.       /* Normal arg. Put it in argv */
  309.       if (NSTRINGP(tmp)) 
  310.     cannot_run(pipes, argv_start, "run-process: bad string", tmp);
  311.       argv[argc++] = CHARS(tmp);
  312.     }
  313.   }
  314.   argv[argc] = NULL;
  315.   
  316.   if (argc == 0) cannot_run(pipes, argv_start,"run-process: no command given", NIL);
  317.  
  318.   /* Build a process object */
  319.   proc = make_process();
  320.   info  = PROCESS(proc);
  321.   
  322.   /* Fork another process */
  323.   switch (pid = fork()) {
  324.     case -1: cannot_run(pipes,argv,"run-process: can't create child process", NIL);
  325.     case 0:  /* Child */
  326.                for(i = 0; i < 3; i++) {
  327.            if (STRINGP(redirection[i])) {
  328.          /* Redirection in a file */
  329.          close(i);
  330.          dup(pipes[i][0]);
  331.          close(pipes[i][0]);
  332.            }
  333.            else 
  334.          if (KEYWORDP(redirection[i])) {
  335.            /* Redirection in a pipe */
  336.            close(i);
  337.            dup(pipes[i][i==0? 0 : 1]);
  338.            close(pipes[i][0]);
  339.            close(pipes[i][1]);
  340.          }
  341.          }
  342.  
  343.          for(i = 3; i < NOFILE; i++) close(i);
  344.  
  345.          /*  And then, EXEC'ing...  */
  346.          execvp(*argv, argv);
  347.          
  348.          /* Cannot exec if we are here */
  349.          fprintf(stderr, "**** Cannot  exec %s!\n", *argv);
  350.          exit(1);
  351.     default: /* Father */
  352.                info->pid = pid;
  353.                for(i = 0; i < 3; i++) {
  354.            if (STRINGP(redirection[i]))
  355.          /* Redirection in a file */
  356.          close(pipes[i][0]);
  357.            else 
  358.          if (KEYWORDP(redirection[i])) {
  359.            /* Redirection in a pipe */
  360.            close(pipes[i][i == 0 ? 0 : 1]);
  361.            
  362.            /* Make a new file descriptor to access the pipe */
  363.            {
  364.              char *s;
  365.              FILE *f;
  366.  
  367.              f = (i == 0)? fdopen(pipes[i][1],"w"):fdopen(pipes[i][0],"r");
  368.              if (f == NULL)
  369.                cannot_run(pipes, argv, "run-process: cannot fdopen", proc);
  370.  
  371.              sprintf(msg, "pipe-%s-%d", stdStreams[i], pid);
  372.  
  373.              STk_disallow_sigint();
  374.  
  375.              s = (char *) must_malloc(strlen(msg)+1);
  376.              strcpy(s, msg);
  377.  
  378.              info->stream[i] = STk_Cfile2port(s,
  379.                               f,
  380.                               (i==0) ? tc_oport : tc_iport,
  381.                               0);
  382.              STk_allow_sigint();
  383.            }
  384.          }
  385.          }
  386.          if    (waiting) {
  387.            waitpid(pid, &(info->exit_status), 0);
  388.            info->exited = TRUE;
  389.          }
  390.   }
  391.   free(argv_start);
  392.   return proc;
  393. }
  394.  
  395.  
  396. static PRIMITIVE processp(SCM process) 
  397. {
  398.   return PROCESSP(process) ? Truth : Ntruth;
  399. }
  400.  
  401. static PRIMITIVE process_alivep(SCM process)
  402. {
  403.   if (NPROCESSP(process)) Err("process-alive?: bad process", process);
  404.   return internal_process_alivep(process)? Truth: Ntruth;
  405. }
  406.  
  407. static PRIMITIVE process_pid(SCM process)
  408. {
  409.   if (NPROCESSP(process)) Err("process-pid: bad process", process);
  410.   return  STk_makeinteger(PROCPID(process));
  411. }
  412.  
  413. static PRIMITIVE process_list(void)
  414. {
  415.   int i;
  416.   SCM lst = NIL;
  417.  
  418.   PURGE_PROCESS_TABLE();
  419.  
  420.   for(i = 0; i < MAX_PROC_NUM; i++)
  421.     if (proc_arr[i] != Ntruth)
  422.       lst = Cons(proc_arr[i], lst);
  423.   return lst;
  424. }
  425.  
  426.  
  427. static PRIMITIVE process_input(SCM process)
  428. {
  429.   if(NPROCESSP(process)) Err("process-input: bad process", process);
  430.  
  431.   return PROCESS(process)->stream[0];
  432. }
  433.  
  434. static PRIMITIVE process_output(SCM process)
  435. {
  436.   if(NPROCESSP(process)) Err("process-output: bad process", process);
  437.  
  438.   return PROCESS(process)->stream[1];
  439. }
  440.  
  441. static PRIMITIVE process_error(SCM process)
  442. {
  443.   if(NPROCESSP(process)) Err("process-error: bad process", process);
  444.  
  445.   return PROCESS(process)->stream[2];
  446. }
  447.  
  448. static PRIMITIVE process_wait(SCM process)
  449. {
  450.   PURGE_PROCESS_TABLE();
  451.  
  452.   if(NPROCESSP(process)) Err("process-wait: bad process", process);
  453.   
  454.   if (PROCESS(process)->exited) return Ntruth;
  455.   else {
  456.     int ret = waitpid(PROCPID(process), &PROCESS(process)->exit_status, 0);
  457.  
  458.     PROCESS(process)->exited = TRUE;
  459.     return (ret == 0) ? Ntruth : Truth;
  460.   }
  461. }
  462.  
  463.  
  464. static PRIMITIVE process_xstatus(SCM process)
  465. {
  466.   int info, n;
  467.  
  468.   PURGE_PROCESS_TABLE();
  469.  
  470.   if (NPROCESSP(process)) Err("process-exit-status: bad process", process);
  471.   
  472.   if (PROCESS(process)->exited) n = PROCESS(process)->exit_status;
  473.   else {
  474.     if (waitpid(PROCPID(process), &info, WNOHANG) == 0) {
  475.       /* Process is still running */
  476.       return Ntruth;
  477.     }
  478.     else {
  479.       /* Process is now terminated */
  480.       PROCESS(process)->exited      = TRUE;
  481.       PROCESS(process)->exit_status = info;
  482.       n = WEXITSTATUS(info);
  483.     }
  484.   }
  485.   return STk_makeinteger((long) n);
  486. }
  487.  
  488. static PRIMITIVE process_send_signal(SCM process, SCM signal)
  489. {
  490.   PURGE_PROCESS_TABLE();
  491.  
  492.   if (NPROCESSP(process)) Err("process-send-signal: bad process", process);
  493.   if (NINTEGERP(signal))  Err("process-send-signal: bad integer", signal);
  494.  
  495.   kill(PROCPID(process), STk_integer_value(signal));
  496.   return UNDEFINED;
  497. }
  498.  
  499. static PRIMITIVE process_kill(SCM process)
  500. {
  501.   if (NPROCESSP(process)) Err("process-kill: bad process", process);
  502.   return process_send_signal(process, STk_makeinteger(SIGTERM));
  503. }
  504.  
  505. #ifdef SIGSTOP
  506. static PRIMITIVE process_stop(SCM process)
  507. {
  508.   if (NPROCESSP(process)) Err("process-stop: bad process", process);
  509.   return process_send_signal(process, STk_makeinteger(SIGSTOP));
  510. }
  511. #endif
  512.  
  513. #ifdef SIGCONT
  514. static PRIMITIVE process_continue(SCM process)
  515. {
  516.   if (NPROCESSP(process)) Err("process-continue: bad process", process);
  517.   return process_send_signal(process, STk_makeinteger(SIGCONT));
  518. }
  519. #endif
  520.  
  521.  
  522. /******************************************************************************/
  523. static void mark_process(SCM process)
  524. {
  525.   struct process_info *info;
  526.   
  527.   info = PROCESS(process);
  528.   STk_gc_mark(info->stream[0]); 
  529.   STk_gc_mark(info->stream[1]); 
  530.   STk_gc_mark(info->stream[2]);
  531. }
  532.   
  533. static void free_process(SCM process)
  534. {
  535.   int i;
  536.  
  537.   /* Kill process; close its associated file, delete it from the process table 
  538.    * and free the memory it uses 
  539.    */
  540.   process_kill(process);
  541.   for(i = 0; i < 3; i++) {
  542.     SCM p = PROCESS(process)->stream[i];
  543.     if (IPORTP(p) || OPORTP(p)) STk_freeport(p);
  544.   }
  545.   proc_arr[PROCESS(process)->index] = Ntruth;
  546.   free(PROCESS(process));
  547. }
  548.  
  549. static void process_display(SCM obj, SCM port, int mode)
  550. {
  551.   sprintf(STk_tkbuffer, "#<process PID=%d>", PROCPID(obj));
  552.   Puts(STk_tkbuffer, PORT_FILE(port));
  553. }
  554.  
  555.  
  556. static STk_extended_scheme_type process_type = {
  557.   "process",        /* name */
  558.   0,            /* is_procp */
  559.   mark_process,        /* gc_mark_fct */
  560.   free_process,            /* gc_sweep_fct */
  561.   NULL,            /* apply_fct */
  562.   process_display    /* display_fct */
  563. };
  564.  
  565.  
  566.  
  567. /******************************************************************************/
  568.  
  569.  
  570. PRIMITIVE STk_init_process(void)
  571. {
  572.   tc_process = STk_add_new_type(&process_type);
  573.   init_proc_table();
  574.  
  575. #ifdef USE_SIGCHLD
  576.   /* 
  577.    * On systems which support SIGCHLD, the processes table is cleaned up
  578.    * as soon as a process terminate. On other systems this is done from time
  579.    * to time to avoid filling the table too fast
  580.    */
  581.  
  582. # ifdef HAVE_SIGACTION
  583.   {
  584.     /* Use the secure Posix.1 way */
  585.     struct sigaction sigact;
  586.     
  587.     sigemptyset(&(sigact.sa_mask));
  588.     sigact.sa_handler = process_terminate_handler;
  589.     sigact.sa_flags   = SA_NOCLDSTOP;     /* Ignore SIGCHLD generated by SIGSTOP */
  590. #  ifdef SA_RESTART
  591.     /* Thanks to Harvey J. Stein <hjstein@MATH.HUJI.AC.IL> for the fix */
  592.     sigact.sa_flags  |= SA_RESTART;
  593. #  endif
  594.     sigaction(SIGCHLD, &sigact, NULL);
  595.   }
  596. # else
  597.   /* Use "classical" way. (Only Solaris 2 seems to have problem with it */
  598.   signal(SIGCHLD, process_terminate_handler);
  599. # endif
  600. #endif
  601.  
  602.   STk_add_new_primitive("run-process",              tc_lsubr,  run_process);       
  603.   STk_add_new_primitive("process?",               tc_subr_1, processp);           
  604.   STk_add_new_primitive("process-alive?",        tc_subr_1, process_alivep);       
  605.   STk_add_new_primitive("process-pid",               tc_subr_1, process_pid);       
  606.   STk_add_new_primitive("process-list",        tc_subr_0, process_list);       
  607.   STk_add_new_primitive("process-input",        tc_subr_1, process_input);      
  608.   STk_add_new_primitive("process-output",        tc_subr_1, process_output);     
  609.   STk_add_new_primitive("process-error",        tc_subr_1, process_error);
  610.   STk_add_new_primitive("process-wait",        tc_subr_1, process_wait);       
  611.   STk_add_new_primitive("process-exit-status",        tc_subr_1, process_xstatus);    
  612.   STk_add_new_primitive("process-send-signal",     tc_subr_2, process_send_signal);
  613.   STk_add_new_primitive("process-kill",        tc_subr_1, process_kill);       
  614. #ifdef SIGSTOP
  615.   STk_add_new_primitive("process-stop",        tc_subr_1, process_stop);       
  616. #endif
  617. #ifdef SIGCONT
  618.   STk_add_new_primitive("process-continue",       tc_subr_1, process_continue);   
  619. #endif
  620.   return UNDEFINED;
  621. }
  622.