home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tclX6.5c / src / tclXprocess.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-19  |  8.1 KB  |  298 lines
  1. /*
  2.  * tclXprocess.c --
  3.  *
  4.  * Tcl command to create and manage processes.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXprocess.c,v 2.2 1992/10/30 03:53:30 markd Exp $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * These are needed for wait command even if waitpid is not available.
  23.  */
  24. #ifndef  WNOHANG
  25. #    define  WNOHANG    1
  26. #endif
  27. #ifndef  WUNTRACED
  28. #    define  WUNTRACED  2
  29. #endif
  30.  
  31.  
  32. /*
  33.  *-----------------------------------------------------------------------------
  34.  *
  35.  * Tcl_ExeclCmd --
  36.  *     Implements the TCL execl command:
  37.  *     execl prog [argList]
  38.  *
  39.  * Results:
  40.  *  Standard TCL results, may return the UNIX system error message.
  41.  *
  42.  *-----------------------------------------------------------------------------
  43.  */
  44. int
  45. Tcl_ExeclCmd (clientData, interp, argc, argv)
  46.     ClientData  clientData;
  47.     Tcl_Interp *interp;
  48.     int         argc;
  49.     char      **argv;
  50. {
  51. #define STATIC_ARG_SIZE   12
  52.     char  *staticArgv [STATIC_ARG_SIZE];
  53.     char **argInList = NULL;
  54.     char **argList   = staticArgv;
  55.     int    argInCnt, idx;
  56.  
  57.     if ((argc < 2) || (argc > 3)) {
  58.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  59.                           " prog [argList]", (char *) NULL);
  60.         return TCL_ERROR;
  61.     }
  62.  
  63.     /*
  64.      * If arg list is supplied, split it and build up the arguments to pass.
  65.      * otherwise, just supply argv[0].  Must be NULL terminated.
  66.      */
  67.     if (argc > 2) {
  68.         if (Tcl_SplitList (interp, argv [2], &argInCnt, &argInList) != TCL_OK)
  69.             return TCL_ERROR;
  70.  
  71.         if (argInCnt > STATIC_ARG_SIZE - 2)
  72.             argList = (char **) ckalloc ((argInCnt + 1) * sizeof (char **));
  73.             
  74.         for (idx = 0; idx < argInCnt; idx++)
  75.             argList [idx + 1] = argInList [idx];
  76.  
  77.         argList [argInCnt + 1] = NULL;
  78.     } else {
  79.         argList [1] = NULL;
  80.     }
  81.  
  82.     argList [0] = argv [1];  /* Program name */
  83.  
  84.     if (execvp (argv[1], argList) < 0) {
  85.         if (argInList != NULL)
  86.             ckfree (argInList);
  87.         if (argList != staticArgv)
  88.             ckfree (argList);
  89.  
  90.         interp->result = Tcl_UnixError (interp);
  91.         return TCL_ERROR;
  92.     }
  93.  
  94. }
  95.  
  96. /*
  97.  *-----------------------------------------------------------------------------
  98.  *
  99.  * Tcl_ForkCmd --
  100.  *     Implements the TCL fork command:
  101.  *     fork
  102.  *
  103.  * Results:
  104.  *  Standard TCL results, may return the UNIX system error message.
  105.  *
  106.  *-----------------------------------------------------------------------------
  107.  */
  108. int
  109. Tcl_ForkCmd (clientData, interp, argc, argv)
  110.     ClientData  clientData;
  111.     Tcl_Interp *interp;
  112.     int         argc;
  113.     char      **argv;
  114. {
  115.     int pid;
  116.  
  117.     if (argc != 1) {
  118.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], (char *) NULL);
  119.         return TCL_ERROR;
  120.     }
  121.  
  122.     pid = Tcl_Fork ();
  123.     if (pid < 0) {
  124.         interp->result = Tcl_UnixError (interp);
  125.         return TCL_ERROR;
  126.     }
  127.  
  128.     sprintf(interp->result, "%d", pid);
  129.     return TCL_OK;
  130. }
  131. #ifndef TCL_HAVE_WAITPID
  132.  
  133. /*
  134.  *-----------------------------------------------------------------------------
  135.  *
  136.  * Tcl_WaitCmd --
  137.  *   Implements the TCL wait command:
  138.  *     wait pid
  139.  *
  140.  * This version is for Tcl 6.4 that does not have the waitpid changes (which
  141.  * have not yet been released).
  142.  * 
  143.  * Results:
  144.  *   Standard TCL results, may return the UNIX system error message.
  145.  *
  146.  *-----------------------------------------------------------------------------
  147.  */
  148. int
  149. Tcl_WaitCmd (clientData, interp, argc, argv)
  150.     ClientData  clientData;
  151.     Tcl_Interp *interp;
  152.     int         argc;
  153.     char      **argv;
  154. {
  155.     WAIT_STATUS_TYPE  status;
  156.     int               pid, returnedPid;
  157.  
  158.  
  159.     if (argc != 2) {
  160.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " pid",
  161.                           (char *) NULL);
  162.         return TCL_ERROR;
  163.     }
  164.     
  165.     if (Tcl_GetInt (interp, argv [1], &pid) != TCL_OK)
  166.         return TCL_ERROR;
  167.  
  168.     returnedPid = Tcl_WaitPids (1, &pid, (WAIT_STATUS_TYPE *) &status);
  169.  
  170.     if (returnedPid < 0) {
  171.         interp->result = Tcl_UnixError (interp);
  172.         return TCL_ERROR;
  173.     }
  174.     
  175.     if (WIFEXITED (status))
  176.         sprintf (interp->result, "%d %s %d", returnedPid, "EXIT", 
  177.                  WEXITSTATUS (status));
  178.     else if (WIFSIGNALED (status))
  179.         sprintf (interp->result, "%d %s %s", returnedPid, "SIG", 
  180.                  Tcl_SignalId (WTERMSIG (status)));
  181.     else if (WIFSTOPPED (status))
  182.         sprintf (interp->result, "%d %s %s", returnedPid, "STOP", 
  183.                  Tcl_SignalId (WSTOPSIG (status)));
  184.  
  185.     return TCL_OK;
  186.  
  187. }
  188. #else
  189.  
  190. /*
  191.  *-----------------------------------------------------------------------------
  192.  *
  193.  * Tcl_WaitCmd --
  194.  *   Implements the TCL wait command:
  195.  *     wait [-nohang] [-untraced] [-pgroup] [pid]
  196.  *
  197.  * Results:
  198.  *   Standard TCL results, may return the UNIX system error message.
  199.  *
  200.  *-----------------------------------------------------------------------------
  201.  */
  202. int
  203. Tcl_WaitCmd (clientData, interp, argc, argv)
  204.     ClientData  clientData;
  205.     Tcl_Interp *interp;
  206.     int         argc;
  207.     char      **argv;
  208. {
  209.     int      pid, returnedPid, status, idx;
  210.     int      options = 0, pgroup = FALSE;
  211.     
  212.     for (idx = 1; idx < argc; idx++) {
  213.         if (argv [idx][0] != '-')
  214.             break;
  215.         if (STREQU ("-nohang", argv [idx])) {
  216.             if (options & WNOHANG)
  217.                 goto usage;
  218.             options |= WNOHANG;
  219.             continue;
  220.         }
  221.         if (STREQU ("-untraced", argv [idx])) {
  222.             if (options & WUNTRACED)
  223.                 goto usage;
  224.             options |= WUNTRACED;
  225.             continue;
  226.         }
  227.         if (STREQU ("-pgroup", argv [idx])) {
  228.             if (pgroup)
  229.                 goto usage;
  230.             pgroup = TRUE;
  231.             continue;
  232.         }
  233.         goto usage;  /* None match */
  234.     }
  235.     /*
  236.      * Check for more than one non-minus argument.  If ok, convert pid,
  237.      * if supplied.
  238.      */
  239.     if (idx < argc - 1)
  240.         goto usage;  
  241.     if (idx < argc) {
  242.         if (Tcl_GetInt (interp, argv [idx], &pid) != TCL_OK)
  243.             return TCL_ERROR;
  244.         if (pid <= 0) {
  245.             Tcl_AppendResult (interp, "pid or process group must be greater ",
  246.                               "than zero", (char *) NULL);
  247.             return TCL_ERROR;
  248.         }
  249.     } else {
  250.         pid = -1;  /* pid not supplied */
  251.     }
  252.  
  253. #if !TCL_HAVE_WAITPID
  254.     /*
  255.      * Versions that don't have real waitpid have limited functionality.
  256.      */
  257.     if ((options != 0) || pgroup) {
  258.         Tcl_AppendResult (interp, "The \"-nohang\", \"-untraced\" and ",
  259.                           "\"-pgroup\" options are not available on this ",
  260.                           "system", (char *) NULL);
  261.         return TCL_ERROR;
  262.     }
  263. #endif
  264.  
  265.     if (pgroup) {
  266.         if (pid > 0)
  267.             pid = -pgroup;
  268.         else
  269.             pid = 0;
  270.     }
  271.  
  272.     returnedPid = waitpid (pid, &status, options);
  273.  
  274.     if (returnedPid < 0) {
  275.         interp->result = Tcl_UnixError (interp);
  276.         return TCL_ERROR;
  277.     }
  278.     
  279.     if (WIFEXITED (status))
  280.         sprintf (interp->result, "%d %s %d", returnedPid, "EXIT", 
  281.                  WEXITSTATUS (status));
  282.     else if (WIFSIGNALED (status))
  283.         sprintf (interp->result, "%d %s %s", returnedPid, "SIG", 
  284.                  Tcl_SignalId (WTERMSIG (status)));
  285.     else if (WIFSTOPPED (status))
  286.         sprintf (interp->result, "%d %s %s", returnedPid, "STOP", 
  287.                  Tcl_SignalId (WSTOPSIG (status)));
  288.  
  289.     return TCL_OK;
  290.  
  291. usage:
  292.     Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " ", 
  293.                       "[-nohang] [-untraced] [-pgroup] [pid]",
  294.                       (char *) NULL);
  295.     return TCL_ERROR;
  296. }
  297. #endif
  298.